From 146174a91a192983720a158796dc066226ad0e55 Mon Sep 17 00:00:00 2001 From: Charles Bailey Date: Thu, 20 Jan 2000 00:25:30 +0000 Subject: [PATCH] Quick integration of mainline changes to date p4raw-id: //depot/vmsperl@4821 p4raw-branched: from //depot/perl@4249 'branch in' eg/cgi/dna_small_gif.uu eg/cgi/wilogo_gif.uu epoc/config.sh epoc/epocish.c epoc/link.pl ext/DB_File/hints/sco.pl ext/DynaLoader/XSLoader_pm.PL ext/DynaLoader/hints/aix.pl ext/DynaLoader/hints/openbsd.pl ext/File/Glob/Makefile.PL ext/File/Glob/TODO ext/IPC/SysV/hints/cygwin.pl ext/NDBM_File/hints/cygwin.pl ext/NDBM_File/hints/sco.pl ext/ODBM_File/hints/cygwin.pl lib/byte.pm lib/byte_heavy.pl lib/unicode/Jamo.txt lib/unicode/NamesList.html lib/unicode/UCD300.html lib/unicode/Unicode.300 lib/unicode/Unicode3.html os2/OS2/REXX/DLL/Changes os2/OS2/REXX/DLL/DLL.pm os2/OS2/REXX/DLL/DLL.xs os2/OS2/REXX/DLL/MANIFEST os2/OS2/REXX/DLL/Makefile.PL os2/OS2/REXX/t/rx_emxrv.t t/lib/glob-case.t t/lib/glob-taint.t t/pod/multiline_items.xr t/pod/pod2usage.xr t/pod/podselect.xr win32/vmem.h t/pod/multiline_items.t t/pod/pod2usage.t t/pod/podselect.t (@4280..) pod/perlhack.pod (@4340..) ext/File/Glob/Changes ext/File/Glob/Glob.xs t/lib/glob-global.t (@4356..) t/lib/glob-basic.t (@4393..) lib/Pod/Man.pm (@4404..) pod/perlfilter.pod (@4406..) t/io/nargv.t (@4503..) ext/File/Glob/bsd_glob.c ext/File/Glob/bsd_glob.h (@4514..) epoc/createpkg.pl epoc/epoc_stubs.c (@4556..) lib/unicode/Eq/Latin1.pl lib/unicode/Eq/Unicode.pl lib/unicode/In/BopomofoExtended.pl lib/unicode/In/BraillePatterns.pl lib/unicode/In/CJKRadicalsSupplement.pl lib/unicode/In/CJKUnifiedIdeographsExtensionA.pl lib/unicode/In/Cherokee.pl lib/unicode/In/IdeographicDescriptionCharacters.pl lib/unicode/In/KangxiRadicals.pl lib/unicode/In/Khmer.pl lib/unicode/In/Mongolian.pl lib/unicode/In/Myanmar.pl lib/unicode/In/Ogham.pl lib/unicode/In/Runic.pl lib/unicode/In/Sinhala.pl lib/unicode/In/Syriac.pl lib/unicode/In/Thaana.pl lib/unicode/In/UnifiedCanadianAboriginalSyllabics.pl lib/unicode/In/YiRadicals.pl lib/unicode/In/YiSyllables.pl (@4573..) pod/perlfork.pod (@4602..) ext/File/Glob/Glob.pm (@4615..) win32/genmk95.pl (@4653..) win32/vdir.h (@4702..) win32/perlhost.h (@4789..) p4raw-deleted: from //depot/perl@4249 'delete in' eg/cgi/dna.small.gif.uu eg/cgi/wilogo.gif.uu (@2830..) os2/POSIX.mkfifo (@3518..) lib/warning.pm warning.h (@4008..) lib/unicode/Jamo-2.txt lib/unicode/UnicodeData-Latest.txt (@4184..) lib/unicode/Unicode.html (@4209..) lib/unicode/Eq/Latin1 lib/unicode/Eq/Unicode (@4228..) lib/Pod/PlainText.pm (@4280..) ext/DynaLoader/dl_cygwin.xs (@4302..) epoc/config.h (@4475..) epoc/perl.mmp epoc/perl.pkg (@4556..) p4raw-integrated: from //depot/perl@4249 'copy in' ext/B/NOTES ext/B/ramblings/runtime.porting (@562..) hints/amigaos.sh (@575..) lib/Net/Ping.pm (@854..) lib/strict.pm (@988..) ext/Thread/Thread/Queue.pm (@1085..) ext/Thread/Thread/Semaphore.pm (@1086..) lib/ExtUtils/Installed.pm (@1315..) plan9/plan9ish.h (@1451..) mpeix/mpeixish.h (@1478..) Porting/p4d2p (@1485..) ext/ODBM_File/hints/sco.pl ext/Thread/sync.t ext/Thread/sync2.t hints/lynxos.sh lib/Text/Tabs.pm os2/OS2/REXX/Changes os2/OS2/REXX/t/rx_dllld.t os2/OS2/REXX/t/rx_objcall.t os2/OS2/REXX/t/rx_tievar.t os2/OS2/REXX/t/rx_tieydb.t os2/OS2/REXX/t/rx_vrexx.t os2/dl_os2.c t/comp/term.t t/io/print.t t/op/glob.t util.h win32/bin/perlglob.pl (@1575..) ext/B/O.pm (@1617..) ext/Thread/typemap lib/File/DosGlob.pm (@1760..) t/op/substr.t (@1780..) vos/vosish.h (@1838..) lib/ExtUtils/Mkbootstrap.pm (@1932..) Porting/genlog (@1978..) lib/constant.pm (@2029..) t/op/array.t (@2210..) lib/Math/Complex.pm (@2219..) hints/dynixptx.sh (@2318..) ext/IO/IO.pm (@2354..) hints/mint.sh lib/Tie/Array.pm lib/Tie/Hash.pm (@2620..) os2/Changes (@2695..) globvar.sym (@2746..) t/comp/bproto.t (@2817..) lib/DB.pm (@2820..) hints/mpeix.sh lib/FindBin.pm (@2830..) ext/IO/lib/IO/Select.pm (@2882..) t/lib/english.t (@2891..) t/op/subst.t (@2892..) t/op/range.t (@2923..) pod/perl5005delta.pod (@2929..) hints/next_3.sh hints/next_3_0.sh (@3023..) lib/Getopt/Std.pm (@3034..) lib/File/Spec.pm (@3042..) t/pragma/warn/1global (@3096..) t/pod/emptycmd.t t/pod/for.t t/pod/for.xr t/pod/headings.t t/pod/headings.xr t/pod/include.t t/pod/include.xr t/pod/included.t t/pod/included.xr t/pod/lref.t t/pod/lref.xr t/pod/nested_items.t t/pod/nested_items.xr t/pod/nested_seqs.t t/pod/nested_seqs.xr t/pod/oneline_cmds.t t/pod/oneline_cmds.xr t/pod/testcmp.pl (@3129..) README.hurd (@3148..) ext/re/re.pm (@3152..) lib/ExtUtils/Liblist.pm t/comp/require.t (@3153..) Porting/p4desc (@3183..) Porting/pumpkin.pod hints/linux.sh myconfig.SH (@3267..) t/op/readdir.t (@3299..) t/pod/special_seqs.t t/pod/special_seqs.xr (@3304..) t/lib/fields.t (@3335..) t/op/taint.t (@3357..) lib/File/Copy.pm (@3362..) installhtml (@3371..) ext/Socket/Socket.pm (@3391..) t/lib/ipc_sysv.t t/op/nothread.t (@3399..) lib/CPAN/FirstTime.pm (@3458..) pod/perlfaq8.pod (@3459..) pod/perlcall.pod pod/perlipc.pod pod/perltie.pod pod/perlxs.pod (@3460..) t/pragma/strict-subs (@3514..) ext/ByteLoader/ByteLoader.pm lib/Math/BigFloat.pm (@3516..) x2p/walk.c (@3518..) win32/win32thread.c win32/win32thread.h (@3525..) os2/OS2/REXX/REXX.xs (@3531..) utf8.h (@3537..) lib/ExtUtils/Embed.pm (@3553..) ext/Thread/Thread/Specific.pm (@3564..) ext/POSIX/Makefile.PL lib/Cwd.pm (@3582..) hv.h (@3602..) ext/NDBM_File/NDBM_File.pm ext/ODBM_File/ODBM_File.pm ext/SDBM_File/SDBM_File.pm (@3603..) lib/Sys/Hostname.pm (@3631..) os2/os2.c (@3640..) emacs/ptags miniperlmain.c (@3660..) ext/IO/IO.xs win32/config_h.PL win32/dl_win32.xs win32/runperl.c win32/win32sck.c (@3667..) pod/Win32.pod pod/perlfaq4.pod pod/perltodo.pod (@3676..) lib/vars.pm (@3686..) lib/ExtUtils/Manifest.pm (@3693..) hints/README.hints hints/epix.sh hints/esix4.sh hints/next_4.sh (@3753..) ext/GDBM_File/GDBM_File.pm lib/CPAN.pm pod/perllocale.pod (@3754..) lib/bigfloat.pl (@3759..) lib/Pod/Text/Color.pm lib/Pod/Text/Termcap.pm pod/pod2text.PL (@3788..) ext/POSIX/POSIX.pm lib/AutoLoader.pm (@3794..) Porting/makerel (@3797..) t/lib/io_unix.t (@3825..) EXTERN.h Porting/patchls ext/SDBM_File/sdbm/pair.c makedepend.SH (@3852..) lib/File/Spec/Unix.pm unixish.h (@3855..) lib/ExtUtils/Mksymlists.pm (@3856..) t/pragma/utf8.t (@3892..) README (@3901..) t/op/eval.t (@3988..) MAINTAIN ext/B/B/Stash.pm ext/ByteLoader/ByteLoader.xs ext/Fcntl/Fcntl.xs ext/SDBM_File/Makefile.PL lib/Math/Trig.pm os2/OS2/REXX/Makefile.PL perlsdio.h regnodes.h utils/perlbug.PL (@4008..) epoc/epoc.c pod/perltoc.pod pod/perlvar.pod regexp.h t/lib/attrs.t t/op/time.t t/pragma/warn/2use t/pragma/warn/3both t/pragma/warn/7fatal universal.c warnings.h warnings.pl (@4076..) ext/Opcode/Opcode.pm ext/attrs/attrs.xs t/pragma/warn/pp_ctl (@4081..) t/pragma/warn/pp_sys (@4088..) t/pragma/sub_lval.t (@4090..) t/TEST (@4092..) xsutils.c (@4101..) pod/buildtoc (@4120..) djgpp/config.over djgpp/djgppsed.sh pod/pod2usage.PL pod/podselect.PL (@4121..) lib/Pod/Html.pm (@4122..) av.h (@4123..) t/pragma/locale.t (@4130..) pod/perldata.pod (@4131..) pod/perllexwarn.pod (@4132..) ext/B/typemap ext/DB_File/DB_File.pm lib/ExtUtils/typemap (@4142..) ext/B/Makefile.PL t/lib/bigfltpm.t (@4149..) lib/ExtUtils/MM_VMS.pm vms/descrip_mms.template (@4182..) ext/DynaLoader/dl_vmesa.xs ext/DynaLoader/dl_vms.xs lib/unicode/ReadMe.txt pod/perlsyn.pod t/op/groups.t (@4184..) t/pragma/warn/op (@4189..) thrdvar.h (@4197..) ext/B/B/Terse.pm (@4199..) t/lib/posix.t (@4223..) keywords.h keywords.pl pod/perlfaq3.pod pod/perlsub.pod t/pragma/strict-vars (@4227..) pod/perlfaq9.pod (@4228..) djgpp/configure.bat lib/Exporter/Heavy.pm (@4242..) Porting/findvars lib/ExtUtils/xsubpp pod/perlguts.pod t/lib/filecopy.t (@4271..) ext/attrs/attrs.pm (@4278..) t/op/avhv.t (@4279..) lib/Pod/Checker.pm lib/Pod/InputObjects.pm t/pod/testp2pt.pl (@4280..) lib/Pod/Usage.pm pod/podchecker.PL t/pod/poderrs.t t/pod/poderrs.xr t/pod/testpchk.pl (@4281..) lib/Pod/Text.pm pod/pod2man.PL (@4282..) ext/Devel/Peek/Peek.xs ext/DynaLoader/dl_beos.xs ext/DynaLoader/dl_dld.xs ext/DynaLoader/dl_mpeix.xs ext/DynaLoader/dlutils.c perlio.c (@4302..) ext/B/defsubs_h.PL t/pragma/constant.t (@4303..) ext/Thread/Thread.xs (@4316..) ext/Thread/Thread.pm (@4328..) lib/Exporter.pm (@4331..) ext/DynaLoader/dl_aix.xs (@4336..) pod/Makefile pod/roffitall (@4340..) lib/lib.pm (@4343..) pod/perlref.pod (@4345..) perly.y perly_c.diff (@4350..) t/lib/safe2.t (@4353..) hints/svr5.sh (@4377..) pod/perlfaq2.pod (@4383..) lib/Benchmark.pm (@4384..) win32/include/dirent.h (@4385..) pod/perlopentut.pod (@4390..) hints/os2.sh os2/Makefile.SHs (@4393..) lib/Pod/Parser.pm lib/Pod/Select.pm (@4400..) malloc.c (@4402..) pod/perlmodlib.pod (@4404..) perlvars.h (@4409..) t/op/sort.t (@4418..) t/op/int.t (@4430..) os2/OS2/REXX/REXX.pm t/io/fs.t t/op/magic.t (@4432..) lib/File/Path.pm (@4433..) t/op/lex_assign.t (@4436..) lib/attributes.pm (@4437..) pod/perlop.pod (@4438..) ext/POSIX/POSIX.xs (@4448..) Policy_sh.SH ext/Data/Dumper/Dumper.xs hints/dec_osf.sh t/lib/charnames.t (@4475..) lib/Time/Local.pm (@4481..) cv.h ext/B/B/Xref.pm (@4485..) doop.c handy.h hints/irix_6.sh pp.h taint.c (@4496..) deb.c (@4505..) dosish.h os2/os2ish.h perly.c vms/perly_c.vms (@4511..) ext/B/B/Lint.pm pod/perlmod.pod pod/perlrun.pod (@4515..) bytecode.pl ext/B/B.pm ext/B/B/Asmdata.pm ext/B/B/CC.pm ext/B/B/Debug.pm ext/B/B/Deparse.pm ext/ByteLoader/bytecode.h ext/ByteLoader/byterun.c ext/ByteLoader/byterun.h ext/Devel/Peek/Peek.pm gv.h (@4545..) README.epoc epoc/epocish.h ext/B/B.xs ext/Fcntl/Fcntl.pm hints/hpux.sh t/lib/syslfs.t t/op/lfs.t t/op/pat.t (@4556..) ext/DynaLoader/DynaLoader_pm.PL hints/solaris_2.sh lib/unicode/Is/SylA.pl lib/unicode/Is/SylC.pl lib/unicode/Is/SylE.pl lib/unicode/Is/SylI.pl lib/unicode/Is/SylO.pl lib/unicode/Is/SylU.pl lib/unicode/Is/SylV.pl lib/unicode/Is/SylWA.pl lib/unicode/Is/SylWC.pl lib/unicode/Is/SylWE.pl lib/unicode/Is/SylWI.pl lib/unicode/Is/SylWV.pl lib/unicode/mktables.PL t/op/pack.t t/op/regexp.t utils/h2xs.PL utils/perldoc.PL vms/vms.c vms/vmsish.h win32/win32iop.h (@4573..) t/lib/dumper.t t/pragma/overload.t (@4574..) ext/Errno/Errno_pm.PL ext/IO/lib/IO/Socket.pm (@4575..) t/op/misc.t (@4578..) ext/Opcode/Opcode.xs (@4579..) cop.h (@4588..) lib/perl5db.pl (@4601..) XSUB.h globals.c pod/perl.pod run.c scope.c (@4602..) op.h win32/perllib.c (@4603..) AUTHORS pod/perlport.pod t/op/runlevel.t (@4604..) scope.h (@4605..) README.vms hints/aix.sh vms/subconfigure.com (@4606..) pod/perlxstut.pod (@4620..) regcomp.h (@4622..) ext/Devel/DProf/DProf.pm ext/DynaLoader/Makefile.PL (@4623..) pod/perltrap.pod (@4630..) ext/B/B/Bytecode.pm (@4631..) opcode.h opcode.pl t/pragma/warn/4lint t/pragma/warn/doio t/pragma/warn/pp_hot (@4641..) mg.c (@4658..) iperlsys.h (@4660..) ext/B/B/C.pm (@4662..) pod/perlre.pod (@4666..) embedvar.h (@4668..) t/lib/filefind.t (@4671..) intrpvar.h (@4672..) ext/DynaLoader/dl_hpux.xs ext/DynaLoader/dl_next.xs ext/DynaLoader/dl_rhapsody.xs (@4686..) lib/File/Find.pm (@4687..) cygwin/Makefile.SHs (@4688..) t/op/re_tests (@4693..) hv.c (@4694..) t/op/delete.t (@4695..) utf8.c (@4698..) thread.h (@4704..) pod/perldiag.pod pp_sys.c (@4709..) Makefile.SH (@4712..) hints/cygwin.sh t/op/stat.t (@4717..) README.os2 lib/ExtUtils/Install.pm (@4720..) t/pragma/warn/doop t/pragma/warn/pp t/pragma/warn/regcomp t/pragma/warn/sv t/pragma/warn/toke t/pragma/warn/utf8 (@4721..) lib/diagnostics.pm (@4722..) regcomp.c (@4724..) configpm pp_ctl.c sv.h (@4726..) global.sym (@4727..) INTERN.h README.win32 lib/ExtUtils/MM_Win32.pm makedef.pl (@4729..) t/io/argv.t (@4732..) doio.c pp_hot.c (@4736..) toke.c (@4740..) gv.c (@4742..) win32/win32.h (@4743..) ext/Devel/DProf/DProf.xs objXSUB.h (@4744..) ext/Data/Dumper/Dumper.pm (@4745..) embed.h embed.pl ext/DynaLoader/dl_dlopen.xs proto.h (@4746..) pp.c (@4747..) sv.c (@4749..) lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MakeMaker.pm (@4754..) util.c utils/perlcc.PL (@4755..) t/io/open.t (@4757..) regexec.c (@4759..) MANIFEST installman (@4769..) Porting/Glossary (@4771..) t/lib/thread.t (@4772..) Changes INSTALL Porting/config.sh Porting/config_H config_h.SH installperl patchlevel.h win32/config.bc win32/config.gc win32/config.vc win32/config_sh.PL win32/win32.c (@4773..) win32/Makefile win32/config_H.bc win32/config_H.gc win32/config_H.vc win32/makefile.mk (@4774..) perl.c (@4779..) t/op/fork.t (@4791..) av.c pod/perldelta.pod (@4796..) pod/perlfunc.pod (@4799..) dump.c (@4800..) op.c (@4801..) perl.h (@4805..) Configure (@4814..) 'merge in' configure.com (@4767..) --- AUTHORS | 6 +- Changes | 4498 +++++++++++++- Configure | 6197 ++++++++++++-------- EXTERN.h | 2 +- INSTALL | 145 +- INTERN.h | 17 +- MAINTAIN | 1 - MANIFEST | 115 +- Makefile.SH | 64 +- Policy_sh.SH | 149 +- Porting/Glossary | 504 +- Porting/config.sh | 137 +- Porting/config_H | 2157 +++---- Porting/findvars | 21 +- Porting/genlog | 2 +- Porting/makerel | 4 +- Porting/p4d2p | 2 +- Porting/p4desc | 2 +- Porting/patchls | 7 +- Porting/pumpkin.pod | 114 +- README | 43 +- README.epoc | 168 +- README.hurd | 30 +- README.os2 | 6 +- README.vms | 80 +- README.win32 | 91 +- XSUB.h | 11 +- av.c | 109 +- av.h | 2 +- bytecode.pl | 14 +- config_h.SH | 2157 +++---- configure.com | 169 +- cop.h | 195 +- cv.h | 10 +- cygwin/Makefile.SHs | 15 +- deb.c | 51 +- djgpp/config.over | 6 +- djgpp/configure.bat | 1 - djgpp/djgppsed.sh | 5 - doio.c | 104 +- doop.c | 14 +- dosish.h | 2 +- dump.c | 367 +- eg/cgi/{dna.small.gif.uu => dna_small_gif.uu} | 2 +- eg/cgi/{wilogo.gif.uu => wilogo_gif.uu} | 0 emacs/ptags | 31 +- embed.h | 347 +- embed.pl | 335 +- embedvar.h | 506 +- epoc/config.h | 2556 -------- epoc/config.sh | 764 +++ epoc/createpkg.pl | 40 + epoc/epoc.c | 59 +- epoc/epoc_stubs.c | 69 + epoc/epocish.c | 34 + epoc/epocish.h | 21 +- epoc/link.pl | 25 + epoc/perl.mmp | 20 - epoc/perl.pkg | 139 - ext/B/B.pm | 22 +- ext/B/B.xs | 70 +- ext/B/B/Asmdata.pm | 12 +- ext/B/B/Bytecode.pm | 43 +- ext/B/B/C.pm | 94 +- ext/B/B/CC.pm | 8 +- ext/B/B/Debug.pm | 24 +- ext/B/B/Deparse.pm | 6 +- ext/B/B/Lint.pm | 14 +- ext/B/B/Stash.pm | 2 +- ext/B/B/Terse.pm | 5 +- ext/B/B/Xref.pm | 6 +- ext/B/Makefile.PL | 2 +- ext/B/NOTES | 4 +- ext/B/O.pm | 4 +- ext/B/defsubs_h.PL | 5 +- ext/B/ramblings/runtime.porting | 9 +- ext/B/typemap | 3 +- ext/ByteLoader/ByteLoader.pm | 6 +- ext/ByteLoader/ByteLoader.xs | 26 +- ext/ByteLoader/bytecode.h | 3 + ext/ByteLoader/byterun.c | 44 +- ext/ByteLoader/byterun.h | 12 +- ext/DB_File/DB_File.pm | 6 +- ext/DB_File/hints/sco.pl | 2 + ext/Data/Dumper/Dumper.pm | 48 +- ext/Data/Dumper/Dumper.xs | 11 +- ext/Devel/DProf/DProf.pm | 9 +- ext/Devel/DProf/DProf.xs | 909 ++- ext/Devel/Peek/Peek.pm | 10 +- ext/Devel/Peek/Peek.xs | 30 +- ext/DynaLoader/DynaLoader_pm.PL | 77 +- ext/DynaLoader/Makefile.PL | 7 +- ext/DynaLoader/XSLoader_pm.PL | 158 + ext/DynaLoader/dl_aix.xs | 33 +- ext/DynaLoader/dl_beos.xs | 16 +- ext/DynaLoader/dl_cygwin.xs | 148 - ext/DynaLoader/dl_dld.xs | 22 +- ext/DynaLoader/dl_dlopen.xs | 31 +- ext/DynaLoader/dl_hpux.xs | 20 +- ext/DynaLoader/dl_mpeix.xs | 12 +- ext/DynaLoader/dl_next.xs | 20 +- ext/DynaLoader/dl_rhapsody.xs | 18 +- ext/DynaLoader/dl_vmesa.xs | 10 +- ext/DynaLoader/dl_vms.xs | 36 +- ext/DynaLoader/dlutils.c | 7 +- ext/DynaLoader/hints/aix.pl | 10 + ext/DynaLoader/hints/openbsd.pl | 3 + ext/Errno/Errno_pm.PL | 7 +- ext/Fcntl/Fcntl.pm | 8 +- ext/Fcntl/Fcntl.xs | 12 + ext/File/Glob/Changes | 47 + ext/File/Glob/Glob.pm | 373 ++ ext/File/Glob/Glob.xs | 209 + ext/File/Glob/Makefile.PL | 11 + ext/File/Glob/TODO | 21 + ext/File/Glob/bsd_glob.c | 930 +++ ext/File/Glob/bsd_glob.h | 82 + ext/GDBM_File/GDBM_File.pm | 6 +- ext/IO/IO.pm | 8 +- ext/IO/IO.xs | 3 +- ext/IO/lib/IO/Select.pm | 4 +- ext/IO/lib/IO/Socket.pm | 3 +- ext/IPC/SysV/hints/cygwin.pl | 2 + ext/NDBM_File/NDBM_File.pm | 6 +- ext/NDBM_File/hints/cygwin.pl | 2 + ext/NDBM_File/hints/sco.pl | 4 + ext/ODBM_File/ODBM_File.pm | 6 +- ext/ODBM_File/hints/cygwin.pl | 2 + ext/ODBM_File/hints/sco.pl | 8 +- ext/Opcode/Opcode.pm | 6 +- ext/Opcode/Opcode.xs | 4 +- ext/POSIX/Makefile.PL | 4 +- ext/POSIX/POSIX.pm | 8 +- ext/POSIX/POSIX.xs | 36 +- ext/SDBM_File/Makefile.PL | 19 +- ext/SDBM_File/SDBM_File.pm | 6 +- ext/SDBM_File/sdbm/pair.c | 1 - ext/Socket/Socket.pm | 6 +- ext/Thread/Thread.pm | 12 +- ext/Thread/Thread.xs | 55 +- ext/Thread/Thread/Queue.pm | 12 +- ext/Thread/Thread/Semaphore.pm | 6 +- ext/Thread/Thread/Specific.pm | 6 +- ext/Thread/sync.t | 3 +- ext/Thread/sync2.t | 3 +- ext/Thread/typemap | 2 +- ext/attrs/attrs.pm | 26 +- ext/attrs/attrs.xs | 6 +- ext/re/re.pm | 5 +- global.sym | 65 +- globals.c | 21 +- globvar.sym | 2 - gv.c | 79 +- gv.h | 15 +- handy.h | 44 +- hints/README.hints | 56 +- hints/aix.sh | 153 +- hints/amigaos.sh | 11 +- hints/cygwin.sh | 53 +- hints/dec_osf.sh | 34 +- hints/dynixptx.sh | 10 +- hints/epix.sh | 6 +- hints/esix4.sh | 8 +- hints/hpux.sh | 76 +- hints/irix_6.sh | 11 +- hints/linux.sh | 9 + hints/lynxos.sh | 3 + hints/mint.sh | 3 +- hints/mpeix.sh | 23 +- hints/next_3.sh | 2 +- hints/next_3_0.sh | 6 +- hints/next_4.sh | 6 +- hints/os2.sh | 10 +- hints/solaris_2.sh | 32 +- hints/svr5.sh | 249 +- hv.c | 79 +- hv.h | 10 + installhtml | 2 - installman | 49 +- installperl | 68 +- intrpvar.h | 67 +- iperlsys.h | 157 +- keywords.h | 467 +- keywords.pl | 1 + lib/AutoLoader.pm | 2 +- lib/Benchmark.pm | 404 +- lib/CPAN.pm | 3 +- lib/CPAN/FirstTime.pm | 3 +- lib/Cwd.pm | 2 +- lib/DB.pm | 2 +- lib/Exporter.pm | 18 +- lib/Exporter/Heavy.pm | 3 +- lib/ExtUtils/Embed.pm | 6 +- lib/ExtUtils/Install.pm | 9 +- lib/ExtUtils/Installed.pm | 2 +- lib/ExtUtils/Liblist.pm | 6 +- lib/ExtUtils/MM_Unix.pm | 69 +- lib/ExtUtils/MM_VMS.pm | 7 - lib/ExtUtils/MM_Win32.pm | 61 +- lib/ExtUtils/MakeMaker.pm | 96 +- lib/ExtUtils/Manifest.pm | 1 - lib/ExtUtils/Mkbootstrap.pm | 4 +- lib/ExtUtils/Mksymlists.pm | 2 +- lib/ExtUtils/typemap | 2 +- lib/ExtUtils/xsubpp | 134 +- lib/File/Copy.pm | 23 +- lib/File/DosGlob.pm | 2 +- lib/File/Find.pm | 726 ++- lib/File/Path.pm | 19 +- lib/File/Spec.pm | 5 +- lib/File/Spec/Unix.pm | 2 +- lib/FindBin.pm | 2 +- lib/Getopt/Std.pm | 2 +- lib/Math/BigFloat.pm | 11 +- lib/Math/Complex.pm | 2 +- lib/Math/Trig.pm | 2 +- lib/Net/Ping.pm | 2 +- lib/Pod/Checker.pm | 795 ++- lib/Pod/Html.pm | 2 +- lib/Pod/InputObjects.pm | 46 +- lib/Pod/Man.pm | 1194 ++++ lib/Pod/Parser.pm | 392 +- lib/Pod/PlainText.pm | 650 -- lib/Pod/Select.pm | 9 +- lib/Pod/Text.pm | 214 +- lib/Pod/Text/Color.pm | 21 +- lib/Pod/Text/Termcap.pm | 19 +- lib/Pod/Usage.pm | 20 +- lib/Sys/Hostname.pm | 4 + lib/Text/Tabs.pm | 6 +- lib/Tie/Array.pm | 37 +- lib/Tie/Hash.pm | 2 + lib/Time/Local.pm | 53 +- lib/attributes.pm | 47 +- lib/bigfloat.pl | 7 +- lib/byte.pm | 33 + lib/byte_heavy.pl | 8 + lib/constant.pm | 201 +- lib/diagnostics.pm | 21 +- lib/lib.pm | 49 +- lib/perl5db.pl | 70 +- lib/strict.pm | 3 + lib/unicode/Eq/{Latin1 => Latin1.pl} | 5 + lib/unicode/Eq/{Unicode => Unicode.pl} | 5 + lib/unicode/In/BopomofoExtended.pl | 6 + lib/unicode/In/BraillePatterns.pl | 6 + lib/unicode/In/CJKRadicalsSupplement.pl | 6 + lib/unicode/In/CJKUnifiedIdeographsExtensionA.pl | 6 + lib/unicode/In/Cherokee.pl | 6 + lib/unicode/In/IdeographicDescriptionCharacters.pl | 6 + lib/unicode/In/KangxiRadicals.pl | 6 + lib/unicode/In/Khmer.pl | 6 + lib/unicode/In/Mongolian.pl | 6 + lib/unicode/In/Myanmar.pl | 6 + lib/unicode/In/Ogham.pl | 6 + lib/unicode/In/Runic.pl | 6 + lib/unicode/In/Sinhala.pl | 6 + lib/unicode/In/Syriac.pl | 6 + lib/unicode/In/Thaana.pl | 6 + .../In/UnifiedCanadianAboriginalSyllabics.pl | 6 + lib/unicode/In/YiRadicals.pl | 6 + lib/unicode/In/YiSyllables.pl | 6 + lib/unicode/Is/SylA.pl | 3 + lib/unicode/Is/SylC.pl | 3 + lib/unicode/Is/SylE.pl | 3 + lib/unicode/Is/SylI.pl | 3 + lib/unicode/Is/SylO.pl | 3 + lib/unicode/Is/SylU.pl | 3 + lib/unicode/Is/SylV.pl | 3 + lib/unicode/Is/SylWA.pl | 3 + lib/unicode/Is/SylWC.pl | 3 + lib/unicode/Is/SylWE.pl | 3 + lib/unicode/Is/SylWI.pl | 3 + lib/unicode/Is/SylWV.pl | 3 + lib/unicode/{Jamo-2.txt => Jamo.txt} | 0 lib/unicode/NamesList.html | 226 + lib/unicode/ReadMe.txt | 33 +- lib/unicode/{Unicode.html => UCD300.html} | 0 .../{UnicodeData-Latest.txt => Unicode.300} | 0 lib/unicode/Unicode3.html | 1988 +++++++ lib/unicode/mktables.PL | 49 +- lib/vars.pm | 6 +- lib/warning.pm | 163 - makedef.pl | 973 +-- makedepend.SH | 3 + malloc.c | 58 +- mg.c | 109 +- miniperlmain.c | 2 +- mpeix/mpeixish.h | 2 +- myconfig.SH | 5 +- objXSUB.h | 284 +- op.c | 713 ++- op.h | 116 +- opcode.h | 1438 ++--- opcode.pl | 66 +- os2/Changes | 26 + os2/Makefile.SHs | 18 +- os2/OS2/REXX/Changes | 3 + os2/OS2/REXX/DLL/Changes | 2 + os2/OS2/REXX/DLL/DLL.pm | 136 + os2/OS2/REXX/DLL/DLL.xs | 72 + os2/OS2/REXX/DLL/MANIFEST | 5 + os2/OS2/REXX/DLL/Makefile.PL | 9 + os2/OS2/REXX/Makefile.PL | 2 +- os2/OS2/REXX/REXX.pm | 69 +- os2/OS2/REXX/REXX.xs | 43 - os2/OS2/REXX/t/rx_dllld.t | 2 +- os2/OS2/REXX/t/rx_emxrv.t | 24 + os2/OS2/REXX/t/rx_objcall.t | 3 +- os2/OS2/REXX/t/rx_tievar.t | 3 +- os2/OS2/REXX/t/rx_tieydb.t | 4 +- os2/OS2/REXX/t/rx_vrexx.t | 2 +- os2/POSIX.mkfifo | 16 - os2/dl_os2.c | 28 +- os2/os2.c | 44 +- os2/os2ish.h | 49 +- patchlevel.h | 20 +- perl.c | 534 +- perl.h | 715 ++- perlio.c | 11 +- perlsdio.h | 6 +- perlvars.h | 4 + perly.c | 7 +- perly.y | 4 +- perly_c.diff | 5 +- plan9/plan9ish.h | 2 +- pod/Makefile | 8 + pod/Win32.pod | 15 +- pod/buildtoc | 2 +- pod/perl.pod | 4 +- pod/perl5005delta.pod | 2 +- pod/perlcall.pod | 2 +- pod/perldata.pod | 8 +- pod/perldelta.pod | 1504 ++++- pod/perldiag.pod | 178 +- pod/perlfaq2.pod | 26 +- pod/perlfaq3.pod | 2 +- pod/perlfaq4.pod | 2 +- pod/perlfaq8.pod | 2 +- pod/perlfaq9.pod | 4 +- pod/perlfilter.pod | 571 ++ pod/perlfork.pod | 232 + pod/perlfunc.pod | 653 ++- pod/perlguts.pod | 18 +- pod/perlhack.pod | 275 + pod/perlipc.pod | 4 + pod/perllexwarn.pod | 4 +- pod/perllocale.pod | 15 +- pod/perlmod.pod | 37 +- pod/perlmodlib.pod | 485 +- pod/perlop.pod | 30 +- pod/perlopentut.pod | 6 +- pod/perlport.pod | 23 +- pod/perlre.pod | 146 +- pod/perlref.pod | 33 +- pod/perlrun.pod | 18 +- pod/perlsub.pod | 7 +- pod/perlsyn.pod | 2 + pod/perltie.pod | 10 +- pod/perltoc.pod | 918 ++- pod/perltodo.pod | 3 +- pod/perltrap.pod | 42 +- pod/perlvar.pod | 2 +- pod/perlxs.pod | 624 +- pod/perlxstut.pod | 253 +- pod/pod2man.PL | 1401 +---- pod/pod2text.PL | 72 +- pod/pod2usage.PL | 5 +- pod/podchecker.PL | 54 +- pod/podselect.PL | 5 +- pod/roffitall | 2 + pp.c | 200 +- pp_ctl.c | 471 +- pp_hot.c | 171 +- pp_sys.c | 224 +- proto.h | 1494 ++--- regcomp.c | 1610 +++-- regcomp.h | 53 +- regexec.c | 1038 ++-- regexp.h | 2 +- run.c | 21 +- scope.c | 153 +- scope.h | 91 +- sv.c | 1946 +++++- sv.h | 111 +- t/TEST | 2 +- t/comp/bproto.t | 5 +- t/comp/require.t | 52 +- t/comp/term.t | 8 +- t/io/argv.t | 90 +- t/io/fs.t | 31 +- t/io/nargv.t | 63 + t/io/open.t | 331 +- t/io/print.t | 8 +- t/lib/bigfltpm.t | 16 +- t/lib/charnames.t | 24 +- t/lib/dumper.t | 17 + t/lib/english.t | 2 +- t/lib/fields.t | 2 +- t/lib/filecopy.t | 175 +- t/lib/filefind.t | 97 +- t/lib/glob-basic.t | 112 + t/lib/glob-case.t | 48 + t/lib/glob-global.t | 106 + t/lib/glob-taint.t | 21 + t/lib/io_unix.t | 4 + t/lib/ipc_sysv.t | 52 +- t/lib/posix.t | 3 + t/lib/safe2.t | 4 +- t/lib/syslfs.t | 45 +- t/lib/thread.t | 49 +- t/op/array.t | 7 +- t/op/avhv.t | 33 +- t/op/delete.t | 82 +- t/op/eval.t | 8 +- t/op/fork.t | 307 +- t/op/glob.t | 5 +- t/op/groups.t | 2 +- t/op/int.t | 17 +- t/op/lex_assign.t | 9 +- t/op/lfs.t | 37 +- t/op/magic.t | 25 +- t/op/misc.t | 14 +- t/op/nothread.t | 2 +- t/op/pack.t | 62 +- t/op/pat.t | 20 +- t/op/range.t | 11 +- t/op/re_tests | 23 +- t/op/readdir.t | 5 + t/op/runlevel.t | 24 +- t/op/sort.t | 131 +- t/op/stat.t | 5 +- t/op/subst.t | 5 +- t/op/substr.t | 8 +- t/op/taint.t | 3 +- t/op/time.t | 2 +- t/pod/emptycmd.t | 6 +- t/pod/for.t | 6 +- t/pod/for.xr | 16 +- t/pod/headings.t | 6 +- t/pod/headings.xr | 29 +- t/pod/include.t | 6 +- t/pod/include.xr | 15 +- t/pod/included.t | 6 +- t/pod/included.xr | 4 +- t/pod/lref.t | 6 +- t/pod/lref.xr | 14 +- t/pod/multiline_items.t | 31 + t/pod/multiline_items.xr | 5 + t/pod/nested_items.t | 6 +- t/pod/nested_items.xr | 4 +- t/pod/nested_seqs.t | 6 +- t/pod/nested_seqs.xr | 4 +- t/pod/oneline_cmds.t | 6 +- t/pod/oneline_cmds.xr | 29 +- t/pod/pod2usage.t | 18 + t/pod/pod2usage.xr | 55 + t/pod/poderrs.t | 83 +- t/pod/poderrs.xr | 46 +- t/pod/podselect.t | 18 + t/pod/podselect.xr | 42 + t/pod/special_seqs.t | 6 +- t/pod/special_seqs.xr | 14 +- t/pod/testcmp.pl | 1 + t/pod/testp2pt.pl | 30 +- t/pod/testpchk.pl | 23 +- t/pragma/constant.t | 45 +- t/pragma/locale.t | 8 + t/pragma/overload.t | 16 +- t/pragma/strict-subs | 18 + t/pragma/strict-vars | 32 + t/pragma/sub_lval.t | 46 +- t/pragma/utf8.t | 4 + t/pragma/warn/1global | 24 +- t/pragma/warn/2use | 32 +- t/pragma/warn/3both | 20 +- t/pragma/warn/4lint | 20 +- t/pragma/warn/7fatal | 24 +- t/pragma/warn/doio | 6 +- t/pragma/warn/doop | 12 +- t/pragma/warn/op | 2 +- t/pragma/warn/pp | 14 +- t/pragma/warn/pp_ctl | 2 +- t/pragma/warn/pp_hot | 12 +- t/pragma/warn/pp_sys | 50 +- t/pragma/warn/regcomp | 92 +- t/pragma/warn/sv | 34 +- t/pragma/warn/toke | 8 +- t/pragma/warn/utf8 | 24 +- taint.c | 9 +- thrdvar.h | 1 - thread.h | 172 +- toke.c | 483 +- universal.c | 4 - unixish.h | 2 +- utf8.c | 6 +- utf8.h | 1 + util.c | 298 +- util.h | 24 + utils/h2xs.PL | 718 ++- utils/perlbug.PL | 2 +- utils/perlcc.PL | 20 +- utils/perldoc.PL | 19 +- vms/descrip_mms.template | 94 +- vms/perly_c.vms | 7 +- vms/subconfigure.com | 395 +- vms/vms.c | 9 +- vms/vmsish.h | 6 +- vos/vosish.h | 2 +- warning.h | 103 - warnings.h | 4 +- warnings.pl | 4 +- win32/Makefile | 175 +- win32/bin/perlglob.pl | 2 +- win32/config.bc | 197 +- win32/config.gc | 207 +- win32/config.vc | 197 +- win32/config_H.bc | 2163 +++---- win32/config_H.gc | 2165 +++---- win32/config_H.vc | 2163 +++---- win32/config_h.PL | 4 +- win32/config_sh.PL | 83 +- win32/dl_win32.xs | 10 +- win32/genmk95.pl | 85 + win32/include/dirent.h | 43 +- win32/makefile.mk | 383 +- win32/perlhost.h | 2307 ++++++++ win32/perllib.c | 1554 +---- win32/runperl.c | 4 - win32/vdir.h | 505 ++ win32/vmem.h | 703 +++ win32/win32.c | 1182 +++- win32/win32.h | 229 +- win32/win32iop.h | 18 +- win32/win32sck.c | 32 +- win32/win32thread.c | 4 +- win32/win32thread.h | 5 +- x2p/walk.c | 6 +- xsutils.c | 4 - 539 files changed, 52173 insertions(+), 25713 deletions(-) rename eg/cgi/{dna.small.gif.uu => dna_small_gif.uu} (99%) rename eg/cgi/{wilogo.gif.uu => wilogo_gif.uu} (100%) delete mode 100644 epoc/config.h create mode 100644 epoc/config.sh create mode 100644 epoc/createpkg.pl create mode 100644 epoc/epoc_stubs.c create mode 100644 epoc/epocish.c create mode 100644 epoc/link.pl delete mode 100644 epoc/perl.mmp delete mode 100644 epoc/perl.pkg create mode 100644 ext/DB_File/hints/sco.pl create mode 100644 ext/DynaLoader/XSLoader_pm.PL delete mode 100644 ext/DynaLoader/dl_cygwin.xs create mode 100644 ext/DynaLoader/hints/aix.pl create mode 100644 ext/DynaLoader/hints/openbsd.pl create mode 100644 ext/File/Glob/Changes create mode 100644 ext/File/Glob/Glob.pm create mode 100644 ext/File/Glob/Glob.xs create mode 100644 ext/File/Glob/Makefile.PL create mode 100644 ext/File/Glob/TODO create mode 100644 ext/File/Glob/bsd_glob.c create mode 100644 ext/File/Glob/bsd_glob.h create mode 100644 ext/IPC/SysV/hints/cygwin.pl create mode 100644 ext/NDBM_File/hints/cygwin.pl create mode 100644 ext/NDBM_File/hints/sco.pl create mode 100644 ext/ODBM_File/hints/cygwin.pl create mode 100644 lib/Pod/Man.pm delete mode 100644 lib/Pod/PlainText.pm create mode 100644 lib/byte.pm create mode 100644 lib/byte_heavy.pl rename lib/unicode/Eq/{Latin1 => Latin1.pl} (69%) rename lib/unicode/Eq/{Unicode => Unicode.pl} (98%) create mode 100644 lib/unicode/In/BopomofoExtended.pl create mode 100644 lib/unicode/In/BraillePatterns.pl create mode 100644 lib/unicode/In/CJKRadicalsSupplement.pl create mode 100644 lib/unicode/In/CJKUnifiedIdeographsExtensionA.pl create mode 100644 lib/unicode/In/Cherokee.pl create mode 100644 lib/unicode/In/IdeographicDescriptionCharacters.pl create mode 100644 lib/unicode/In/KangxiRadicals.pl create mode 100644 lib/unicode/In/Khmer.pl create mode 100644 lib/unicode/In/Mongolian.pl create mode 100644 lib/unicode/In/Myanmar.pl create mode 100644 lib/unicode/In/Ogham.pl create mode 100644 lib/unicode/In/Runic.pl create mode 100644 lib/unicode/In/Sinhala.pl create mode 100644 lib/unicode/In/Syriac.pl create mode 100644 lib/unicode/In/Thaana.pl create mode 100644 lib/unicode/In/UnifiedCanadianAboriginalSyllabics.pl create mode 100644 lib/unicode/In/YiRadicals.pl create mode 100644 lib/unicode/In/YiSyllables.pl rename lib/unicode/{Jamo-2.txt => Jamo.txt} (100%) create mode 100644 lib/unicode/NamesList.html rename lib/unicode/{Unicode.html => UCD300.html} (100%) rename lib/unicode/{UnicodeData-Latest.txt => Unicode.300} (100%) create mode 100644 lib/unicode/Unicode3.html delete mode 100644 lib/warning.pm create mode 100644 os2/OS2/REXX/DLL/Changes create mode 100644 os2/OS2/REXX/DLL/DLL.pm create mode 100644 os2/OS2/REXX/DLL/DLL.xs create mode 100644 os2/OS2/REXX/DLL/MANIFEST create mode 100644 os2/OS2/REXX/DLL/Makefile.PL create mode 100644 os2/OS2/REXX/t/rx_emxrv.t delete mode 100644 os2/POSIX.mkfifo create mode 100644 pod/perlfilter.pod create mode 100644 pod/perlfork.pod create mode 100644 pod/perlhack.pod create mode 100755 t/io/nargv.t create mode 100755 t/lib/glob-basic.t create mode 100755 t/lib/glob-case.t create mode 100755 t/lib/glob-global.t create mode 100755 t/lib/glob-taint.t create mode 100755 t/pod/multiline_items.t create mode 100644 t/pod/multiline_items.xr create mode 100755 t/pod/pod2usage.t create mode 100644 t/pod/pod2usage.xr create mode 100755 t/pod/podselect.t create mode 100644 t/pod/podselect.xr delete mode 100644 warning.h create mode 100644 win32/genmk95.pl create mode 100644 win32/perlhost.h create mode 100644 win32/vdir.h create mode 100644 win32/vmem.h diff --git a/AUTHORS b/AUTHORS index 3ed8133..f978b51 100644 --- a/AUTHORS +++ b/AUTHORS @@ -18,7 +18,7 @@ gbarr Graham Barr gbarr@ti.com gerti Gerd Knops gerti@BITart.com gibreel Stephen Zander gibreel@pobox.com gnat Nathan Torkington gnat@frii.com -gsar Gurusamy Sarathy gsar@umich.edu +gsar Gurusamy Sarathy gsar@activestate.com hansmu Hans Mulder hansmu@xs4all.nl ilya Ilya Zakharevich ilya@math.ohio-state.edu jbuehler Joe Buehler jbuehler@hekimian.com @@ -46,12 +46,12 @@ neale Neale Ferguson neale@VMA.TABNSW.COM.AU nik Nick Ing-Simmons nik@tiuk.ti.com okamoto Jeff Okamoto okamoto@corp.hp.com paul_green Paul Green Paul_Green@stratus.com -pmarquess Paul Marquess pmarquess@bfsec.bt.co.uk +pmarquess Paul Marquess Paul.Marquess@btinternet.com pomeranz Hal Pomeranz pomeranz@netcom.com pudge Chris Nandor pudge@pobox.com pueschel Norbert Pueschel pueschel@imsdd.meb.uni-bonn.de pvhp Peter Prymmer pvhp@forte.com -raphael Raphael Manfredi Raphael_Manfredi@grenoble.hp.com +raphael Raphael Manfredi Raphael_Manfredi@pobox.com rdieter Rex Dieter rdieter@math.unl.edu rsanders Robert Sanders Robert.Sanders@linux.org roberto Ollivier Robert roberto@keltia.freenix.fr diff --git a/Changes b/Changes index 6ac09ad..7f0b267 100644 --- a/Changes +++ b/Changes @@ -29,7 +29,7 @@ current addresses (as of July 1998): Nick Ing-Simmons Andreas Koenig Doug MacEachern - Paul Marquess + Paul Marquess Stephen McCamant Laszlo Molnar Hans Mulder @@ -54,7 +54,7 @@ And the Keepers of the Patch Pumpkin: Malcolm Beattie Tim Bunce Andy Dougherty - Gurusamy Sarathy + Gurusamy Sarathy Chip Salzenberg And, of course, the Author of Perl: @@ -75,10 +75,4419 @@ indicator: ---------------- -Version 5.005_62 Development release working toward 5.006 +Version v5.5.640 Development release working toward 5.6 ---------------- ____________________________________________________________________________ +[ 4813] By: jhi on 2000/01/18 19:41:33 + Log: metaconfig todo note from Andy. + Branch: cfgperl + ! Configure config_h.SH + Branch: metaconfig + ! U/installdirs/inc_version_list.U +____________________________________________________________________________ +[ 4812] By: jhi on 2000/01/18 15:02:55 + Log: More -V. + Branch: cfgperl + ! perl.c +____________________________________________________________________________ +[ 4811] By: jhi on 2000/01/18 10:35:30 + Log: More compile-time options shown with -V. + Branch: cfgperl + ! perl.c +____________________________________________________________________________ +[ 4810] By: jhi on 2000/01/17 08:35:49 + Log: Add -D_GNU_SOURCE into ccflags for gcc (for now to expose + the strtold() and qgcvt() prototypes for long doubles, but + it should be okay in any case); fix bad assumptions in the + test suite about string->float conversions; though the out + parameter of strtold() (and strtoll()) is unused, it is nicer + to have it in correct type. + Branch: cfgperl + ! Configure config_h.SH perl.h t/lib/posix.t t/op/pack.t + Branch: metaconfig + ! U/modified/cc.U +____________________________________________________________________________ +[ 4809] By: jhi on 2000/01/16 19:21:18 + Log: strtoll works better ternary. + Branch: cfgperl + ! perl.h +____________________________________________________________________________ +[ 4808] By: jhi on 2000/01/16 19:12:58 + Log: Know strtoll. + Branch: cfgperl + ! Configure Porting/Glossary Porting/config.sh Porting/config_H + ! config_h.SH perl.h +____________________________________________________________________________ +[ 4807] By: jhi on 2000/01/16 17:57:03 + Log: Integrate with Sarathy. + Branch: cfgperl + !> dump.c gv.c gv.h lib/vars.pm op.c op.h perl.h pod/perlfunc.pod + !> sv.c sv.h t/pragma/strict-vars toke.c util.c +____________________________________________________________________________ +[ 4806] By: jhi on 2000/01/16 16:37:47 + Log: Continue qgcvt work; closer now but not yet there. + Branch: cfgperl + ! Configure Porting/Glossary Porting/config.sh Porting/config_H + ! config_h.SH doop.c utf8.c + Branch: metaconfig + ! U/compline/d_gconvert.U + Branch: metaconfig/U/perl + ! d_qgcvt.U +____________________________________________________________________________ +[ 4805] By: jhi on 2000/01/15 22:26:16 + Log: Metaconfig and Porting patches from Andy; start using the new + long long and long double thingies from #4804; regen Configure. + Branch: cfgperl + ! Configure Porting/Glossary Porting/config.sh Porting/config_H + ! Porting/pumpkin.pod config_h.SH patchlevel.h perl.h util.c + Branch: metaconfig + + U/dist_patches/dist-p70a U/dist_patches/dist-p70b + + U/dist_patches/dist-p70c U/installdirs/inc_version_list.U + + U/modified/myhostname.U U/modified/nis.U U/nullified/fpu.U + + U/nullified/lib.U + ! U/README U/compline/d_gconvert.U U/installdirs/sitearch.U + ! U/installdirs/sitelib.U U/installdirs/vendorarch.U + ! U/installdirs/vendorlib.U U/modified/Cppsym.U U/modified/Loc.U + ! U/modified/Oldconfig.U U/modified/Signal.U + ! U/modified/sig_name.U U/threads/usethreads.U + Branch: metaconfig/U/perl + ! d_qgcvt.U d_strtold.U d_strtoll.U d_strtoq.U d_strtoull.U + ! d_strtouq.U dlsrc.U i_db.U libperl.U patchlevel.U + ! usemultiplicity.U + Branch: perl + ! perl.h util.c +____________________________________________________________________________ +[ 4804] By: jhi on 2000/01/14 14:22:24 + Log: Add more quad/long long/long double sciency. + Branch: metaconfig/U/perl + + d_qgcvt.U d_strtold.U d_strtoll.U d_strtoq.U d_strtoull.U + + d_strtouq.U +____________________________________________________________________________ +[ 4803] By: gsar on 2000/01/14 04:40:49 + Log: minor optimization (avoid double sv_upgrade() for "our Foo $bar;") + Branch: perl + ! op.c +____________________________________________________________________________ +[ 4802] By: gsar on 2000/01/14 04:35:55 + Log: add note about "our" + Branch: perl + ! lib/vars.pm +____________________________________________________________________________ +[ 4801] By: gsar on 2000/01/14 04:16:51 + Log: nailed "our" declarations, and better warnings on duplicate + "our" declarations + Branch: perl + ! dump.c gv.c gv.h op.c pod/perlfunc.pod sv.c sv.h + ! t/pragma/strict-vars toke.c +____________________________________________________________________________ +[ 4800] By: gsar on 2000/01/14 01:27:13 + Log: avoid spurious "Useless use of variable" warning on C + Branch: perl + ! dump.c op.c op.h +____________________________________________________________________________ +[ 4799] By: gsar on 2000/01/14 01:17:15 + Log: doc typo + Branch: perl + ! pod/perlfunc.pod +____________________________________________________________________________ +[ 4798] By: jhi on 2000/01/13 16:31:34 + Log: Integrate with Sarathy. + Branch: cfgperl + +> epoc/config.sh epoc/epocish.c epoc/link.pl + +> ext/DynaLoader/XSLoader_pm.PL ext/DynaLoader/hints/openbsd.pl + +> ext/IPC/SysV/hints/cygwin.pl ext/NDBM_File/hints/cygwin.pl + +> ext/ODBM_File/hints/cygwin.pl lib/byte.pm lib/byte_heavy.pl + +> lib/unicode/Unicode.300 pod/perlfork.pod t/lib/glob-case.t + +> win32/perlhost.h win32/vdir.h win32/vmem.h + - epoc/Config.pm epoc/autosplit.pl epoc/config.h epoc/perl.mmp + - epoc/perl.pkg ext/DynaLoader/dl_cygwin.xs + - lib/unicode/UnicodeData-Latest.txt os2/POSIX.mkfifo + !> (integrate 282 files) +____________________________________________________________________________ +[ 4797] By: gsar on 2000/01/13 08:12:56 + Log: clearer docs for change#4796; faster av_exists() + Branch: perl + ! av.c pod/perldelta.pod pod/perldiag.pod pod/perlfunc.pod +____________________________________________________________________________ +[ 4796] By: gsar on 2000/01/13 06:49:03 + Log: support delete() and exists() on array, tied array, and pseudo-hash + elements or slices + Branch: perl + ! av.c embed.h embed.pl global.sym lib/Tie/Array.pm + ! lib/Tie/Hash.pm objXSUB.h op.c perlapi.c pod/perldelta.pod + ! pod/perlfunc.pod pod/perlref.pod pod/perltie.pod pp.c proto.h + ! t/op/avhv.t t/op/delete.t +____________________________________________________________________________ +[ 4795] By: gsar on 2000/01/11 20:52:30 + Log: extend site_perl changes change#4773 to vendor_perl as well + Branch: perl + ! Configure +____________________________________________________________________________ +[ 4794] By: gsar on 2000/01/11 19:18:50 + Log: rework INSTALL to reflect new logic for versioning sitelibs + Branch: perl + ! INSTALL +____________________________________________________________________________ +[ 4793] By: gsar on 2000/01/11 01:44:00 + Log: test for change#4792 + Branch: perl + ! t/op/fork.t +____________________________________________________________________________ +[ 4792] By: gsar on 2000/01/11 01:22:36 + Log: pseudo forked children inherit environment correctly + Branch: perl + ! win32/perlhost.h +____________________________________________________________________________ +[ 4791] By: gsar on 2000/01/10 19:14:03 + Log: test tweak + Branch: perl + ! t/op/fork.t +____________________________________________________________________________ +[ 4790] By: gsar on 2000/01/10 18:56:16 + Log: check for USE_ITHREADS sanity was too restrictive + Branch: perl + ! perl.h +____________________________________________________________________________ +[ 4789] By: gsar on 2000/01/10 18:30:24 + Log: add workaround for textmode read() bug in MSVCRT; make chdir() do + a real SetCurrentDirectory() in toplevel host + Branch: perl + ! README.win32 win32/Makefile win32/makefile.mk win32/perlhost.h + ! win32/vdir.h win32/win32.c +____________________________________________________________________________ +[ 4788] By: chip on 2000/01/10 17:52:39 + Log: Integrate #4779 from mainline: + terminate -s switch processing only on C<-->, not on C<--foo> + Branch: maint-5.005/perl + ! perl.c +____________________________________________________________________________ +[ 4787] By: chip on 2000/01/10 17:51:17 + Log: Tweak change #4785. + Branch: maint-5.005/perl + ! win32/win32.c +____________________________________________________________________________ +[ 4786] By: chip on 2000/01/10 17:11:40 + Log: Make automatically-generated files +w (type "text+w"). + Branch: maint-5.005/perl + ! embed.h embedvar.h ext/B/B/Asmdata.pm keywords.h objXSUB.h + ! opcode.h pod/perltoc.pod pp_proto.h regnodes.h + ! win32/config_H.bc win32/config_H.gc win32/config_H.vc +____________________________________________________________________________ +[ 4785] By: chip on 2000/01/10 17:08:48 + Log: Patch from Sarathy to integrate changes from mainline: 2751, + 2821, 2916, 2930, 2931, 2937 2990, 3033, 3036, 3042, 3061, 3097, + 3123, 3134, 3135, 3269, 3270, 3300, 3316, 3345 3350, 3353, 3362, + 3363, 3396, 3419, 3423, 3445, 3446, 3447, 3449, 3450, 3451, 3487 + 3493, 3514, 3533, 3548, 3549, 3588, 3682, 3685, 3699, 3785, + 3804, 3811, 3897, 4057 4102, 4103, 4230, 4401, 4420, 4504 + -- + enable better Win32::DomainName() by demand loading netapi32.dll + (from Jan Dubois) + -- + win32_utime() on directories should use localtime() rather + than gmtime() (from Jan Dubois) + -- + serious bug introduced by G_VOID changes in 5.003_96: scalar + eval"" did not pop stack correctly; C<$a = eval "(1,2)x1"> + is one symptom of the problem + -- + add $installarchlib/CORE to default linker search path on windows + -- + fix memory leak in C + -- + fix memory leak in C + -- + avoid hiding child process window + -- + optimizations could sometimes bypass bareword check + -- + fix typo that caused INSTALLPRIVLIB to have doubled 'perl5' + -- + Pod::Html tweak + From: jan.dubois@ibm.net (Jan Dubois) + To: perl5-porters@perl.org + Subject: [PATCH 5.005_58] pod2html: Missing chunk for VMS filenames + Date: Tue, 27 Jul 1999 22:14:12 +0200 + Message-ID: <37a50af0.46171380@smtp1.ibm.net> + -- + don't quit if =head* wasn't found (suggested by Roland Bauer + ) + -- + avoid bug in win32_str_os_error() (from Jan Dubois) + -- + applied suggested patch, along with later tweak + From: jan.dubois@ibm.net (Jan Dubois) + Date: Wed, 14 Jul 1999 23:53:43 +0200 + Message-ID: <37a902e7.15977234@smtp1.ibm.net> + Subject: Merge ActivePerl Stylesheet support etc into Pod::Html.pm + -- + use a better prefixify() heuristic than m/perl/ (prefix/lib/perl5 + and prefix/lib/perl5/man are ass_u_med only if those directories + actually exist; else prefix/{lib,man} are used) + -- + allow C<-foo> under C (behavior of C<-$string> + is unchanged still) + -- + avoid race condition in the CAPI extension bootstrap handler + -- + sanity check to cover the case when perl is installed into the + X:\ (drive root) + -- + truncate() has a peculiar exemption from strict barewords, even + though it has a non-filehandle prototype + -- + change#3447 didn't do enough to exempt Foo->bar(qw/.../) from + strict 'subs' + -- + change#3449 wasn't doing enough + -- + make win32_spawnvp() inherit standard handles even when they + may be redirected + -- + minor logic tweak for reserved word warning + -- + oops, some files missing in change#3449 + -- + allow '*' prototype to autoquote even barewords that happen to be + function names; parens or ampersand continue to force the other + interpretation; makes C + do the right thing, for example + -- + redo change#2061 and parts of change#1169 with code in the + parser; PL_last_proto hackery gone, strict 'subs' in now + implemented in the optimizer where specifying the exceptional + cases is much more robust; '*' (bareword) prototype now works + reliably when used in second and subsequent arguments + -- + remove redundant part of change#1169 superceded by change#2061; + avoid "future reserved word" warning on prototypical bearwords + -- + s/isspace/isSPACE/g and make sure the CRT version is always + passed an unsigned char (fixes random occurrence of spaces in + arguments containing high-bit chars passed to spawned children, + on win32) + -- + on win32, look for "site/5.XXX/lib" if "site/5.XXXYY/lib" isn't + found (brings sitelib intuition in line with privlib) + -- + mortalize string allocations by win32_get_{priv,site}lib() + (fixes small memory leak in interpreter) + -- + opendir(D,"x:") on win32 opens cwd() for drive rather than root; + stat() behaves similarly + -- + documentation for Win32 builtins (somewhat modified) + From: jan.dubois@ibm.net (Jan Dubois) + Date: Tue, 30 Mar 1999 08:05:03 +0200 + Message-ID: <37006783.1926460@smtp1.ibm.net> + Subject: Re: Issues with build 509 + -- + provide File::Copy::syscopy() via Win32::CopyFile() on win32 + -- + more bulletproof workaround for mangled paths; + provide Win32::GetLongPathName() + -- + normalize $^X to full pathname on win32 + -- + work around mangled archname on win32 while finding privlib/sitelib; + normalize lib paths to forward slashes internally + -- + avoid negative return value from Win32::GetTickCount() + From: jan.dubois@ibm.net (Jan Dubois) + Date: Sat, 03 Apr 1999 19:04:18 +0200 + Message-ID: <37084742.22824479@smtp1.ibm.net> + Subject: Re: Win32::GetTickCount + -- + adjust win32_stat() to cope with FindFirstFile() and stat() bugs + (makes opendir(D,"c:") work reliably) + -- + fix buggy reference count on refs to SVs with autoviv magic + (resulted in C and Data::Dumper + accessing free()d memory) + -- + fix bug in change#3123 (off-by-one, caused C to fail + on win32) + -- + flip release & version in win32_uname() + -- + support POSIX::uname() via win32_uname() + -- + implement win32_spawnvp() internally, making it return true PIDs + for asynchronous spawns; fix win32_kill() to always deal with + PIDs + -- + use yyerror() instead of croak() so that compile-time failures in + my(LIST) don't confuse globals with lexicals + -- + allow custom comparison function in File::Compare::compare_text() + From: jan.dubois@ibm.net (Jan Dubois) + Date: Fri, 26 Feb 1999 21:56:09 +0100 + Message-ID: <36db0838.8805651@smtp1.ibm.net> + Subject: Re: PodParser 1.07 (was: RE: C vs stuff()) + -- + slightly edited version of suggested patch + From: jan.dubois@ibm.net (Jan Dubois) + Date: Mon, 01 Mar 1999 00:32:05 +0100 + Message-ID: <36dbcf2c.12325433@smtp1.ibm.net> + Subject: Re: [PATCH 5.005_55] Cleanup of File::Spec module + -- + revert parts of change#2990 to preserve predictable usage of + Win32::Foo() as stacked list values + From: jan.dubois@ibm.net (Jan Dubois) + Date: Sat, 27 Feb 1999 18:24:17 +0100 + Message-ID: <36e22849.36531259@smtp1.ibm.net> + Subject: Re: resend [PATCH 5.005_55] Various win32/win32.c cleanup + -- + add File::Compare::compare_text() + From: jan.dubois@ibm.net (Jan Dubois) + Date: Fri, 26 Feb 1999 00:20:41 +0100 + Message-ID: <36dcd8ab.20195659@smtp1.ibm.net> + Subject: Re: PodParser 1.07 (was: RE: C vs stuff()) + -- + From: jan.dubois@ibm.net (Jan Dubois) + Date: Thu, 18 Feb 1999 19:14:07 +0100 + Message-ID: <36d15809.40853323@smtp1.ibm.net> + Subject: resend [PATCH 5.005_55] Various win32/win32.c cleanup + -- + support Win32::GetFullPathName() and Win32::SetLastError() + From: jan.dubois@ibm.net (Jan Dubois) + Date: Tue, 09 Feb 1999 22:27:31 +0100 + Message-ID: <36c1a2ed.8007554@smtp1.ibm.net> + Subject: [PATCH _54] Win32::GetFullPathName + -- + backout change#2811 and add newer version based on File::Spec + From: Barrie Slaymaker + Date: Thu, 11 Feb 1999 16:29:24 -0500 + Message-ID: <36C34BB4.A62090E0@telerama.com> + Subject: (pod2html) Relative URLs using new File::Spec + -- + From: Barrie Slaymaker + Date: Thu, 11 Feb 1999 19:39:48 -0500 + Message-ID: <36C37854.707D139@telerama.com> + Subject: Merging File::PathConvert in to File::Spec + -- + back out change#2751, apply updated version + From: jan.dubois@ibm.net (Jan Dubois) + Date: Sat, 06 Feb 1999 01:06:29 +0100 + Message-ID: <36bc844c.18763049@smtp1.ibm.net> + Subject: [PATCH] Cleanup of File::Spec module + -- + pod2html misinterprets Foo::Bar as a URL + (fix suggested by Alexander Barilo + ) + -- + devnull() support from Jan Dubois and others + Branch: maint-5.005/perl + + lib/File/Spec/Functions.pm pod/Win32.pod + ! MANIFEST cop.h dump.c embed.h ext/SDBM_File/sdbm/dbe.c + ! global.sym iperlsys.h lib/CGI.pm lib/CGI/Carp.pm + ! lib/ExtUtils/MM_Unix.pm lib/ExtUtils/xsubpp + ! lib/File/Compare.pm lib/File/Copy.pm lib/File/Spec.pm + ! lib/File/Spec/Mac.pm lib/File/Spec/OS2.pm + ! lib/File/Spec/Unix.pm lib/File/Spec/VMS.pm + ! lib/File/Spec/Win32.pm lib/Pod/Html.pm objXSUB.h objpp.h op.c + ! op.h perl.h pp.c pp_ctl.c pp_hot.c proto.h t/comp/proto.t + ! t/io/fs.t t/lib/fatal.t t/op/eval.t t/op/magic.t t/op/ref.t + ! t/pragma/strict-subs toke.c utils/perldoc.PL win32/GenCAPI.pl + ! win32/Makefile win32/config.bc win32/config.gc win32/config.vc + ! win32/config_H.bc win32/config_H.gc win32/config_H.vc + ! win32/makedef.pl win32/makefile.mk win32/perlhost.h + ! win32/runperl.c win32/win32.c win32/win32.h win32/win32iop.h + ! win32/win32sck.c +____________________________________________________________________________ +[ 4784] By: chip on 2000/01/10 09:04:34 + Log: various documentation tweaks suggested by M. J. T. Guy + Branch: maint-5.005/perl + ! INSTALL lib/strict.pm pod/perlfunc.pod pod/perlsyn.pod +____________________________________________________________________________ +[ 4783] By: chip on 2000/01/10 08:11:39 + Log: Refresh Getopt::Long to v2.20. + Branch: maint-5.005/perl + ! lib/Getopt/Long.pm +____________________________________________________________________________ +[ 4782] By: gsar on 2000/01/10 05:27:03 + Log: EPOC port update (from Olaf Flebbe ) + Branch: perl + + epoc/config.sh epoc/epocish.c epoc/link.pl + - epoc/Config.pm epoc/autosplit.pl epoc/config.h epoc/perl.mmp + - epoc/perl.pkg + ! MANIFEST README.epoc epoc/createpkg.pl epoc/epoc.c + ! epoc/epoc_stubs.c epoc/epocish.h ext/IO/lib/IO/Socket.pm + ! lib/Sys/Hostname.pm +____________________________________________________________________________ +[ 4781] By: gsar on 2000/01/10 05:11:03 + Log: pod typos (from Abigail ) + Branch: perl + ! pod/perl.pod pod/perllexwarn.pod pod/perlxstut.pod +____________________________________________________________________________ +[ 4780] By: gsar on 2000/01/10 05:07:35 + Log: failing RE test added (from Robert Cunningham ) + Branch: perl + ! t/lib/thread.t +____________________________________________________________________________ +[ 4779] By: gsar on 2000/01/10 05:06:16 + Log: terminate -s switch processing only on C<-->, not on C<--foo> + Branch: perl + ! perl.c +____________________________________________________________________________ +[ 4778] By: gsar on 2000/01/10 04:38:45 + Log: useithreads needs usemultiplicity + Branch: perl + ! Configure perl.h +____________________________________________________________________________ +[ 4777] By: gsar on 2000/01/10 01:18:04 + Log: use $Config{version} rather than $] where appropriate + Branch: perl + ! lib/CPAN.pm lib/ExtUtils/Installed.pm lib/ExtUtils/MM_Unix.pm + ! lib/ExtUtils/Mksymlists.pm lib/Pod/Man.pm lib/diagnostics.pm + ! lib/lib.pm +____________________________________________________________________________ +[ 4776] By: gsar on 2000/01/10 00:11:34 + Log: enable fork.t on windows + Branch: perl + ! t/op/fork.t +____________________________________________________________________________ +[ 4775] By: gsar on 2000/01/10 00:07:29 + Log: broken test for use5005threads + Branch: perl + ! t/lib/safe2.t +____________________________________________________________________________ +[ 4774] By: gsar on 2000/01/09 23:56:37 + Log: more windows build tweaks + Branch: perl + ! installperl makedef.pl win32/Makefile win32/config_H.bc + ! win32/config_H.gc win32/config_H.vc win32/config_sh.PL + ! win32/makefile.mk +____________________________________________________________________________ +[ 4773] By: gsar on 2000/01/09 22:27:19 + Log: more changes for new-style version numbers (versions numbers on + the filesystem look like 5.5.640, except on DOS-DJGPP and VMS where + they look like 5_5_640; delete @Config{pm_apiversion,xs_apiversion}; + split $Config{apiversion} into three, @Config{apirevision,apiversion, + apisubversion} for CPP friendliness; $Config{sitelib} now defaults + to .../site_perl/$version, just like $Config{privlib}, making sitelib + completely independent across versions and substantially eliminating + chances of breaking older installations by overwriting newly built + extensions; all this means compatibility inclusions for @INC will need + to take into account older sitelib versions (this still TODO) + + windows, vms, dos tweaks for the above + Branch: perl + ! Changes Configure INSTALL Porting/config.sh Porting/config_H + ! config_h.SH configure.com dosish.h installman installperl + ! patchlevel.h perl.c perl.h vms/vmsish.h win32/Makefile + ! win32/config.bc win32/config.gc win32/config.vc + ! win32/config_H.bc win32/config_H.gc win32/config_H.vc + ! win32/config_h.PL win32/config_sh.PL win32/makefile.mk + ! win32/win32.c +____________________________________________________________________________ +[ 4772] By: gsar on 2000/01/09 19:05:33 + Log: s/usethreads/use5005threads/g + Branch: perl + ! myconfig.SH t/lib/english.t t/lib/thread.t t/op/nothread.t +____________________________________________________________________________ +[ 4771] By: gsar on 2000/01/09 18:51:50 + Log: Configure changes for new-style version numbers (from Andy Dougherty, + slightly altered) + Branch: perl + ! Configure INSTALL Porting/Glossary Porting/config.sh + ! Porting/config_H config_h.SH perl.h win32/Makefile + ! win32/config.bc win32/config.gc win32/config.vc + ! win32/makefile.mk +____________________________________________________________________________ +[ 4770] By: gsar on 2000/01/07 22:18:54 + Log: fix for 'make utest' failures (from Ilya Zakharevich) + Branch: perl + ! regexec.c +____________________________________________________________________________ +[ 4769] By: gsar on 2000/01/07 18:23:16 + Log: cygwin update (from Eric Fifer ) + Branch: perl + + ext/IPC/SysV/hints/cygwin.pl ext/NDBM_File/hints/cygwin.pl + + ext/ODBM_File/hints/cygwin.pl + ! Configure INSTALL MANIFEST ext/POSIX/Makefile.PL + ! hints/cygwin.sh installman installperl lib/Cwd.pm + ! lib/ExtUtils/MakeMaker.pm lib/File/Spec/Unix.pm lib/perl5db.pl + ! perlsdio.h t/op/magic.t t/op/stat.t utils/perlcc.PL +____________________________________________________________________________ +[ 4768] By: gsar on 2000/01/07 18:12:15 + Log: typo on h2xs.PL (from Helmut Jarausch) + Branch: perl + ! utils/h2xs.PL +____________________________________________________________________________ +[ 4767] By: gsar on 2000/01/07 17:58:45 + Log: VMS update (from Peter Prymmer ) + Branch: perl + ! README.vms configure.com vms/subconfigure.com +____________________________________________________________________________ +[ 4766] By: gsar on 2000/01/07 17:54:05 + Log: os2/POSIX.mkfifo not needed (from Yitzchak Scott-Thoennes + ) + Branch: perl + - os2/POSIX.mkfifo + ! MANIFEST README.os2 +____________________________________________________________________________ +[ 4765] By: gsar on 2000/01/06 20:11:46 + Log: add workaround for dlopen() bug on OpenBSD (relative paths that + match /^lib/ won't load properly) + Branch: perl + + ext/DynaLoader/hints/openbsd.pl + ! Changes MANIFEST ext/DynaLoader/dl_dlopen.xs +____________________________________________________________________________ +[ 4764] By: gsar on 2000/01/06 19:51:08 + Log: add undocumented globals for compatibility--find.pl, and find2perl + generated code need them (from Helmut Jarausch ) + Branch: perl + ! lib/File/Find.pm +____________________________________________________________________________ +[ 4763] By: gsar on 2000/01/06 10:51:07 + Log: fix various C-backend shenanigans + Branch: perl + ! ext/B/B/C.pm +____________________________________________________________________________ +[ 4762] By: gsar on 2000/01/06 04:09:00 + Log: tweak test in change#4757 for Windows + Branch: perl + ! t/io/open.t +____________________________________________________________________________ +[ 4761] By: gsar on 2000/01/06 02:55:30 + Log: USE_ITHREADS tweak (reused pad values could be SvREADONLY if + they belonged to freed OP_CONSTs) + Branch: perl + ! op.c +____________________________________________________________________________ +[ 4760] By: gsar on 2000/01/06 00:22:40 + Log: constant ranges could escape bareword check in list context + Branch: perl + ! op.c t/pragma/strict-subs +____________________________________________________________________________ +[ 4759] By: gsar on 2000/01/05 20:52:50 + Log: From: Ilya Zakharevich + Date: Wed, 05 Jan 2000 15:23:18 EST + Message-Id: <20000105152318.A7400@monk.mps.ohio-state.edu> + Subject: Re: minimal m//g matches appear busted + Branch: perl + ! regexec.c t/op/pat.t +____________________________________________________________________________ +[ 4758] By: gsar on 2000/01/05 12:49:40 + Log: various nits identified by warnings unmasked by recent changes + Branch: perl + ! ext/B/Makefile.PL lib/ExtUtils/Install.pm pod/perlfunc.pod +____________________________________________________________________________ +[ 4757] By: gsar on 2000/01/05 12:48:10 + Log: severe bugs in change#3786 fixed + Branch: perl + ! doio.c t/io/open.t +____________________________________________________________________________ +[ 4756] By: gsar on 2000/01/05 11:25:10 + Log: tweak change#4745 to make ebcdic output match for chars <= 037 + Branch: perl + ! ext/Data/Dumper/Dumper.pm +____________________________________________________________________________ +[ 4755] By: gsar on 2000/01/05 06:56:05 + Log: cygwin support tweaks (from Eric Fifer ) + Branch: perl + ! Configure util.c utils/perlcc.PL +____________________________________________________________________________ +[ 4754] By: gsar on 2000/01/05 06:52:25 + Log: avoid expensive Version_check (from Andreas Koenig) + Branch: perl + ! Changes lib/ExtUtils/MM_Unix.pm lib/ExtUtils/MM_VMS.pm + ! lib/ExtUtils/MM_Win32.pm lib/ExtUtils/MakeMaker.pm +____________________________________________________________________________ +[ 4753] By: gsar on 2000/01/05 06:48:22 + Log: From: andreas.koenig@anima.de (Andreas J. Koenig) + Date: 03 Jan 2000 21:56:02 +0100 + Message-ID: + Subject: Reloading File::Copy + Branch: perl + ! Changes lib/File/Copy.pm t/lib/filecopy.t +____________________________________________________________________________ +[ 4752] By: gsar on 2000/01/04 01:19:20 + Log: s/USE_TEXTMODE_SCRIPTS/PERL_TEXTMODE_SCRIPTS/g + Branch: perl + ! win32/Makefile win32/makefile.mk win32/win32.h +____________________________________________________________________________ +[ 4751] By: gsar on 2000/01/03 18:26:08 + Log: avoid using (custom) autoloader in MakeMaker (from Andreas Koenig) + Branch: perl + ! lib/ExtUtils/MakeMaker.pm +____________________________________________________________________________ +[ 4750] By: gsar on 2000/01/02 21:58:02 + Log: make DProf look at $ENV{PERL_DPROF_OUT_FILE_NAME} to make it possible + to write to a file other than tmon.out (suggested by Haakon Alstadheim + ) + Branch: perl + ! ext/Devel/DProf/DProf.pm ext/Devel/DProf/DProf.xs +____________________________________________________________________________ +[ 4749] By: gsar on 2000/01/02 21:37:29 + Log: disable optimization in change#3612 for join() and quotemeta()--this + removes all the gross hacks for the special cases in that change; fix + pp_concat() for when TARG == arg (modified version of patch suggested + by Ilya Zakharevich) + Branch: perl + ! op.c opcode.h opcode.pl pp_hot.c sv.c t/op/lex_assign.t +____________________________________________________________________________ +[ 4748] By: gsar on 2000/01/02 20:26:06 + Log: MakeMaker should attempt to "require" rather than "use" prerequisites + to avoid imports (from Michael G Schwern ) + Branch: perl + ! lib/ExtUtils/MakeMaker.pm +____________________________________________________________________________ +[ 4747] By: gsar on 2000/01/02 20:17:36 + Log: fix 4-arg substr() when used as argument to subroutine + Branch: perl + ! pp.c t/op/substr.t +____________________________________________________________________________ +[ 4746] By: gsar on 2000/01/02 18:45:58 + Log: usethreads build fixups for NeXTstep (as suggested by Hans Mulder) + Branch: perl + ! embed.h embed.pl ext/DynaLoader/dl_beos.xs + ! ext/DynaLoader/dl_dlopen.xs ext/DynaLoader/dl_hpux.xs + ! ext/DynaLoader/dl_next.xs ext/DynaLoader/dl_rhapsody.xs + ! perlapi.c proto.h thread.h util.c +____________________________________________________________________________ +[ 4745] By: gsar on 2000/01/02 18:15:44 + Log: ebcdic fix for Data::Dumper from Peter Prymmer + Branch: perl + ! ext/Data/Dumper/Dumper.pm regcomp.c +____________________________________________________________________________ +[ 4744] By: gsar on 1999/12/31 22:42:23 + Log: missing files in previous submit + Branch: perl + ! embed.h embed.pl ext/Devel/DProf/DProf.xs globals.c + ! lib/ExtUtils/MM_Unix.pm objXSUB.h perlapi.c proto.h +____________________________________________________________________________ +[ 4743] By: gsar on 1999/12/31 06:47:18 + Log: various Windows build tweaks + Branch: perl + ! win32/win32.h +____________________________________________________________________________ +[ 4742] By: gsar on 1999/12/30 21:32:36 + Log: change#4705 breaks code that interpolates $], so leave string value + of $] as it was for compatibility (and perhaps introduce $^V or similar + for the utf8 representation, maybe?) + Branch: perl + ! configpm gv.c +____________________________________________________________________________ +[ 4741] By: gsar on 1999/12/30 19:36:21 + Log: avoid CRLF in byteloadable files created by perlcc + Branch: perl + ! utils/perlcc.PL +____________________________________________________________________________ +[ 4740] By: gsar on 1999/12/30 19:35:07 + Log: leave DATA open in binmode if __END__ line doesn't have CRLF + Branch: perl + ! pod/perldelta.pod toke.c +____________________________________________________________________________ +[ 4739] By: gsar on 1999/12/30 05:44:21 + Log: enable the PERL_BINMODE_SCRIPTS behavior by default on Windows + to allow ByteLoader to work; the DATA filehandles continue to + be left open in text mode for compatibility + Branch: perl + ! embed.h embed.pl objXSUB.h pod/perldelta.pod proto.h sv.c + ! toke.c win32/Makefile win32/makefile.mk win32/win32.c + ! win32/win32.h +____________________________________________________________________________ +[ 4738] By: gsar on 1999/12/30 04:36:12 + Log: CR-LF support broken for formats + Branch: perl + ! toke.c +____________________________________________________________________________ +[ 4737] By: gsar on 1999/12/29 22:30:52 + Log: make DProf functional under pseudo-fork() + Branch: perl + ! ext/Devel/DProf/DProf.xs +____________________________________________________________________________ +[ 4736] By: gsar on 1999/12/29 21:04:59 + Log: slurp mode fix in change#2910 wasn't quite right (spotted by Hans + Mulder) + Branch: perl + ! doio.c pp_hot.c t/io/argv.t +____________________________________________________________________________ +[ 4735] By: gsar on 1999/12/29 18:12:40 + Log: re.pm is needed earlier, xsubpp now uses it (spotted by Andreas + Koenig) + Branch: perl + ! Makefile.SH +____________________________________________________________________________ +[ 4734] By: gsar on 1999/12/28 21:10:37 + Log: Windows build tweaks + Branch: perl + ! INTERN.h sv.c +____________________________________________________________________________ +[ 4733] By: gsar on 1999/12/28 20:45:15 + Log: remove never-taken branch for making getc() operate on ARGV (spotted + by Ralph Corderoy ) + Branch: perl + ! pp_sys.c +____________________________________________________________________________ +[ 4732] By: gsar on 1999/12/28 20:42:13 + Log: tests for change#4642 and pod fixups suggested by Ralph Corderoy + + Branch: perl + ! pod/perldelta.pod pod/perlfunc.pod pod/perlre.pod t/io/argv.t +____________________________________________________________________________ +[ 4731] By: gsar on 1999/12/28 20:23:17 + Log: optimize XSUBs to use targets if the -nooptimize xsubpp option is + not supplied (variant of patch suggested by Ilya Zakharevich) + Branch: perl + ! XSUB.h lib/ExtUtils/xsubpp +____________________________________________________________________________ +[ 4730] By: gsar on 1999/12/28 19:55:56 + Log: range operator does magical string increment iff both operands + are non-numbers, from Tom Phoenix ; fixed + the "foreach (RANGE)" case as well + Branch: perl + ! pp_ctl.c t/op/range.t +____________________________________________________________________________ +[ 4729] By: gsar on 1999/12/28 18:40:19 + Log: Win9x + GCC update from Benjamin Stuhl + Branch: perl + - win32/PerlCRT.def win32/gstartup.c win32/oldnames.def + ! EXTERN.h INTERN.h MANIFEST README.win32 iperlsys.h + ! lib/ExtUtils/MM_Win32.pm makedef.pl win32/Makefile + ! win32/config.gc win32/genmk95.pl win32/makefile.mk + ! win32/perlhost.h win32/perllib.c win32/runperl.c win32/win32.c + ! win32/win32.h +____________________________________________________________________________ +[ 4728] By: gsar on 1999/12/28 07:44:19 + Log: typecasts needed + Branch: perl + ! toke.c +____________________________________________________________________________ +[ 4727] By: gsar on 1999/12/28 06:23:08 + Log: change#4721 needed line number adjustments + Branch: perl + ! MANIFEST global.sym proto.h t/pragma/warn/doop + ! t/pragma/warn/pp t/pragma/warn/regcomp t/pragma/warn/sv + ! t/pragma/warn/toke t/pragma/warn/utf8 +____________________________________________________________________________ +[ 4726] By: gsar on 1999/12/28 04:18:15 + Log: integrate utfperl contents into mainline + Branch: perl + +> lib/byte.pm lib/byte_heavy.pl + !> configpm embed.h embed.pl embedvar.h gv.c intrpvar.h objXSUB.h + !> patchlevel.h perl.c perl.h perlapi.c pp_ctl.c pp_hot.c proto.h + !> regnodes.h sv.c sv.h t/comp/require.t toke.c utf8.h +____________________________________________________________________________ +[ 4725] By: gsar on 1999/12/28 04:08:09 + Log: integrate mainline contents + Branch: utfperl + - ext/DynaLoader/dl_cygwin.xs lib/unicode/Eq/Latin1 + - lib/unicode/Eq/Unicode + !> (integrate 60 files) +____________________________________________________________________________ +[ 4724] By: gsar on 1999/12/28 03:44:10 + Log: fix for /(^|a)b/ breakage from Ilya Zakharevich + Branch: perl + ! regcomp.c t/op/re_tests +____________________________________________________________________________ +[ 4723] By: gsar on 1999/12/28 03:28:39 + Log: more ebcdic testsuite fixups (from Peter Prymmer) + Branch: perl + ! Changes lib/bigfloat.pl t/lib/charnames.t t/lib/dumper.t + ! t/pragma/overload.t t/pragma/utf8.t +____________________________________________________________________________ +[ 4722] By: gsar on 1999/12/28 03:14:48 + Log: avoid "used once" warning + Branch: perl + ! lib/diagnostics.pm +____________________________________________________________________________ +[ 4721] By: gsar on 1999/12/28 03:10:32 + Log: ebcdic tweaks for tests from Peter Prymmer + Branch: perl + ! t/pragma/warn/doop t/pragma/warn/pp t/pragma/warn/regcomp + ! t/pragma/warn/sv t/pragma/warn/toke t/pragma/warn/utf8 +____________________________________________________________________________ +[ 4720] By: gsar on 1999/12/28 03:08:39 + Log: pod nits from Simon Cozens and others + Branch: perl + ! README.os2 lib/ExtUtils/Embed.pm lib/ExtUtils/Install.pm + ! lib/ExtUtils/Liblist.pm lib/ExtUtils/MakeMaker.pm + ! lib/ExtUtils/Mkbootstrap.pm pod/perlop.pod +____________________________________________________________________________ +[ 4719] By: gsar on 1999/12/28 03:01:04 + Log: perlport v1.45 from Chris Nandor + Branch: perl + ! pod/perlport.pod +____________________________________________________________________________ +[ 4718] By: gsar on 1999/12/28 02:59:16 + Log: newer version of constant.pm from Tom Phoenix; added Tom's notes to + perldelta; added STOP, DESTROY and AUTOLOAD to specials list + Branch: perl + ! lib/constant.pm pod/perldelta.pod pod/perlvar.pod + ! t/pragma/constant.t +____________________________________________________________________________ +[ 4717] By: gsar on 1999/12/28 02:47:04 + Log: cygwin update from Eric Fifer + Branch: perl + - ext/DynaLoader/dl_cygwin.xs + ! MAINTAIN MANIFEST ext/POSIX/POSIX.xs ext/SDBM_File/sdbm/pair.c + ! hints/cygwin.sh installperl mg.c pod/perlfaq3.pod t/op/stat.t + ! util.c +____________________________________________________________________________ +[ 4716] By: gsar on 1999/12/28 02:40:51 + Log: tweak to show up db-linked-with-libpthread-but-not-perl problem + (from Andy Dougherty) + Branch: perl + ! Configure +____________________________________________________________________________ +[ 4715] By: gsar on 1999/12/28 02:38:44 + Log: better variant of change#4644 (from Andy Dougherty) + Branch: perl + ! Configure +____________________________________________________________________________ +[ 4714] By: gsar on 1999/12/28 02:36:40 + Log: be defensive about setting {host,group,pass}cat (from Andy Dougherty) + Branch: perl + ! Configure +____________________________________________________________________________ +[ 4713] By: gsar on 1999/12/28 02:35:15 + Log: $sitelib should be $prefix/lib/perl5/site_perl, as documented in + INSTALL (from Andy Dougherty) + Branch: perl + ! Configure +____________________________________________________________________________ +[ 4712] By: gsar on 1999/12/28 02:30:55 + Log: avoid creating new files during make install + Branch: perl + ! Makefile.SH +____________________________________________________________________________ +[ 4711] By: gsar on 1999/12/28 02:24:44 + Log: pod edits from Paul Marquess and Mark-Jason Dominus + Branch: perl + ! AUTHORS Changes ext/DynaLoader/dl_aix.xs + ! ext/DynaLoader/dl_dlopen.xs lib/Net/Ping.pm pod/perlcall.pod + ! pod/perldelta.pod +____________________________________________________________________________ +[ 4710] By: gsar on 1999/12/28 02:05:23 + Log: miniperl build fixes for os2 (from Yitzchak Scott-Thoennes + ); add explicit target for opmini.o + Branch: perl + ! Makefile.SH cygwin/Makefile.SHs os2/Makefile.SHs +____________________________________________________________________________ +[ 4709] By: gsar on 1999/12/28 01:20:39 + Log: partly fix perldiag regressions identified by Tom Christiansen + Branch: perl + ! doio.c lib/diagnostics.pm pod/perldiag.pod pp_hot.c pp_sys.c + ! t/pragma/warn/4lint t/pragma/warn/doio t/pragma/warn/pp_hot + ! t/pragma/warn/pp_sys +____________________________________________________________________________ +[ 4708] By: gsar on 1999/12/27 23:33:24 + Log: update perldiag for change#4707 + Branch: perl + ! perl.c pod/perldiag.pod +____________________________________________________________________________ +[ 4707] By: gsar on 1999/12/27 23:23:39 + Log: allow spaces in -I switch argument + Branch: perl + ! perl.c +____________________________________________________________________________ +[ 4706] By: gsar on 1999/12/26 23:44:53 + Log: fix typos + Branch: utfperl + ! sv.h toke.c +____________________________________________________________________________ +[ 4705] By: gsar on 1999/12/24 04:02:35 + Log: support for v5.5.640 style version numbers + Branch: utfperl + ! configpm embedvar.h gv.c intrpvar.h objXSUB.h patchlevel.h + ! perl.c perl.h pp_ctl.c sv.c sv.h t/comp/require.t toke.c +____________________________________________________________________________ +[ 4704] By: gsar on 1999/12/23 08:54:27 + Log: bring in basic threads stuff under USE_ITHREADS + Branch: perl + ! makedef.pl op.c perl.c perl.h perlvars.h pp_sys.c thread.h + ! util.c +____________________________________________________________________________ +[ 4703] By: gsar on 1999/12/23 00:10:06 + Log: integrate mainline contents into utfperl + Branch: utfperl + !> (integrate 33 files) +____________________________________________________________________________ +[ 4702] By: gsar on 1999/12/20 17:18:23 + Log: virtual directory handling broken on paths with trailing slash + Branch: perl + ! win32/Makefile win32/makefile.mk win32/vdir.h +____________________________________________________________________________ +[ 4701] By: gsar on 1999/12/20 17:09:55 + Log: revert optimization in change#4700 (it appears OPpRUNTIME flag + isn't set for all m/$foo/o) + Branch: perl + ! pp_ctl.c +____________________________________________________________________________ +[ 4700] By: gsar on 1999/12/20 16:28:51 + Log: avoid pp_regcomp() changing optree at run time under USE_*THREADS (or + we have a race on our hands) + Branch: perl + ! pp_ctl.c +____________________________________________________________________________ +[ 4699] By: gsar on 1999/12/20 16:19:00 + Log: pod tweaks + Branch: perl + ! pod/perldelta.pod pod/perlfilter.pod pod/perlopentut.pod +____________________________________________________________________________ +[ 4698] By: gsar on 1999/12/20 07:55:07 + Log: uv_to_utf8() could lose 37th bit on HAS_QUAD platforms + Branch: perl + ! utf8.c +____________________________________________________________________________ +[ 4697] By: gsar on 1999/12/18 01:35:50 + Log: fix from Larry for parsing C<{ 0x1 => 'foo'}> as an + anon hash rather than a block; test case for the same + Branch: perl + ! t/comp/term.t toke.c +____________________________________________________________________________ +[ 4696] By: gsar on 1999/12/17 19:55:03 + Log: leak in change#4694 spotted by Larry + Branch: perl + ! hv.c +____________________________________________________________________________ +[ 4695] By: gsar on 1999/12/17 18:14:11 + Log: test case for change#4694 + Branch: perl + ! t/op/delete.t +____________________________________________________________________________ +[ 4694] By: gsar on 1999/12/17 18:09:08 + Log: delete() should return the value as is, not a copy thereof + Branch: perl + ! hv.c pod/perldelta.pod +____________________________________________________________________________ +[ 4693] By: gsar on 1999/12/17 17:45:58 + Log: fix for C<"\nx\taa\n" =~ /^\S\s+aa$/m> (from Ilya Zakharevich) + Branch: perl + ! regexec.c t/op/re_tests +____________________________________________________________________________ +[ 4692] By: gsar on 1999/12/17 17:41:10 + Log: credits tweak + Branch: perl + ! lib/File/Spec.pm +____________________________________________________________________________ +[ 4691] By: gsar on 1999/12/17 07:12:53 + Log: DynaLoader doesn't build properly when $(DLSRC) changes + (fix suggested by Hans Mulder) + Branch: perl + ! ext/DynaLoader/Makefile.PL +____________________________________________________________________________ +[ 4690] By: gsar on 1999/12/17 06:26:34 + Log: add missing new ops + Branch: perl + ! ext/B/ramblings/runtime.porting +____________________________________________________________________________ +[ 4689] By: gsar on 1999/12/17 06:16:49 + Log: test harness tweak from Hans Mulder + Branch: perl + ! t/TEST +____________________________________________________________________________ +[ 4688] By: gsar on 1999/12/17 06:14:23 + Log: miniperl build fixes for NeXTstep and cygwin (from Hans Mulder + and Lucian CIONCA ) + Branch: perl + ! Makefile.SH cygwin/Makefile.SHs +____________________________________________________________________________ +[ 4687] By: gsar on 1999/12/17 06:06:46 + Log: applied suggested patch with whitespace adjustments + From: Helmut Jarausch + Date: Thu, 16 Dec 1999 08:57:55 +0100 + Message-id: <38589B82.C4668E10@numa1.igpm.rwth-aachen.de> + Subject: Re: [ID 19991215.001] patch 5.005_63: Find::Fill cannot handle / + Branch: perl + ! lib/File/Find.pm +____________________________________________________________________________ +[ 4686] By: gsar on 1999/12/17 05:48:53 + Log: avoid warnings due to symbols unintroduced by XSLoader (spotted + by Hans Mulder) + Branch: perl + ! ext/DynaLoader/dl_dld.xs ext/DynaLoader/dl_hpux.xs + ! ext/DynaLoader/dl_mpeix.xs ext/DynaLoader/dl_next.xs + ! ext/DynaLoader/dl_rhapsody.xs +____________________________________________________________________________ +[ 4685] By: gsar on 1999/12/17 05:37:51 + Log: fix bug when one of the operands is +0E+0 (from Ronald J Kimball + ) + Branch: perl + ! lib/Math/BigFloat.pm t/lib/bigfltpm.t +____________________________________________________________________________ +[ 4684] By: gsar on 1999/12/16 09:32:48 + Log: spell out how to get 4-digit year (from Micheal G Schwern + ) + Branch: perl + ! pod/perlfunc.pod +____________________________________________________________________________ +[ 4683] By: gsar on 1999/12/16 09:26:53 + Log: type mismatch for %c format argument (spotted by Robin Barker + ) + Branch: perl + ! regcomp.c +____________________________________________________________________________ +[ 4682] By: gsar on 1999/12/16 08:33:28 + Log: mingw32 doesn't have anonymous union (from Benjamin Stuhl + ) + Branch: perl + ! win32/win32.c +____________________________________________________________________________ +[ 4681] By: gsar on 1999/12/16 08:31:15 + Log: missing backslash (spotted by Johan Vromans) + Branch: perl + ! perl.c +____________________________________________________________________________ +[ 4680] By: gsar on 1999/12/16 08:26:00 + Log: avoid coredump on diagnostics when STDERR is closed + Branch: perl + ! perl.h +____________________________________________________________________________ +[ 4679] By: gsar on 1999/12/12 18:09:41 + Log: integrate mainline changes + Branch: utfperl + +> (branch 39 files) + - lib/unicode/Jamo-2.txt lib/unicode/Unicode.html + - lib/unicode/UnicodeData-Latest.txt + !> (integrate 447 files) +____________________________________________________________________________ +[ 4678] By: gsar on 1999/12/10 01:39:13 + Log: interpreter structure should be nulled under -DMULTIPLICITY + Branch: perl + ! perl.c +____________________________________________________________________________ +[ 4677] By: gsar on 1999/12/09 11:10:27 + Log: update Changes + Branch: perl + ! Changes + +---------------- +Version 5.005_63 +---------------- + +____________________________________________________________________________ +[ 4676] By: gsar on 1999/12/09 10:51:43 + Log: fix File::Find testsuite bugs in symlink-less places + Branch: perl + ! t/lib/filefind.t +____________________________________________________________________________ +[ 4675] By: gsar on 1999/12/09 10:22:31 + Log: USE_ITHREADS tweaks and notes + Branch: perl + ! op.c pod/perldelta.pod sv.c +____________________________________________________________________________ +[ 4674] By: gsar on 1999/12/09 10:21:53 + Log: allow new style sort subs to work under usethreads + Branch: perl + ! pp_ctl.c +____________________________________________________________________________ +[ 4673] By: gsar on 1999/12/09 04:00:23 + Log: document compatibility issue with literal list slices and NOTOP + (C is now a syntax error) + Branch: perl + ! pod/perldelta.pod +____________________________________________________________________________ +[ 4672] By: gsar on 1999/12/09 01:14:46 + Log: avoid mismatched expectation <-> int types for C++ builds + Branch: perl + ! embed.pl intrpvar.h proto.h toke.c +____________________________________________________________________________ +[ 4671] By: gsar on 1999/12/09 00:36:24 + Log: newer version of File::Find with support for following symlinks and + other features, from Helmut Jarausch + Branch: perl + ! lib/File/Find.pm pod/perldelta.pod t/lib/filefind.t +____________________________________________________________________________ +[ 4670] By: gsar on 1999/12/09 00:13:06 + Log: avoid initializing GvCV slot for autovivified filehandles + Branch: perl + ! pp.c +____________________________________________________________________________ +[ 4669] By: gsar on 1999/12/08 19:09:27 + Log: apply change#4618 again along with Ilya's patch to fix bugs + in it (see change#4622) + Branch: perl + ! embed.h embed.pl perl.h proto.h regcomp.c regcomp.h regexec.c + ! t/op/re_tests t/op/subst.t +____________________________________________________________________________ +[ 4668] By: gsar on 1999/12/08 18:56:53 + Log: patch to fix parser bug in C<${h{${a[0]}}} = 13> + From: Larry Wall + Date: Tue, 7 Dec 1999 12:39:30 -0800 (PST) + Message-Id: <199912072039.MAA13257@kiev.wall.org> + Subject: Re: [ID 19991204.002] Inconsistency of ${hash{key}} + Branch: perl + ! embedvar.h intrpvar.h objXSUB.h sv.c toke.c +____________________________________________________________________________ +[ 4667] By: gsar on 1999/12/08 18:47:37 + Log: patch to fix aix hints from ortmann@vnet.ibm.com + Branch: perl + ! hints/aix.sh +____________________________________________________________________________ +[ 4666] By: gsar on 1999/12/08 18:29:02 + Log: documentation tweaks from M. J. T. Guy, Micheal Schwern, and + Tim Meadowcroft + Branch: perl + ! Changes lib/Benchmark.pm pod/perlipc.pod pod/perlre.pod +____________________________________________________________________________ +[ 4665] By: gsar on 1999/12/08 02:22:31 + Log: introduce save_I8() for saving byte values + Branch: perl + ! embed.h embed.pl global.sym objXSUB.h perlapi.c proto.h + ! regcomp.c regexec.c scope.c scope.h sv.c +____________________________________________________________________________ +[ 4664] By: gsar on 1999/12/08 02:02:33 + Log: use SAVEINT() rather than SAVEDESTRUCTOR() for saving PL_expect etc. + Branch: perl + ! toke.c +____________________________________________________________________________ +[ 4663] By: gsar on 1999/12/08 01:11:44 + Log: longstanding typo in lexer: PL_lex_expect was not properly + saved on reentry + Branch: perl + ! toke.c +____________________________________________________________________________ +[ 4662] By: gsar on 1999/12/07 23:16:21 + Log: typos in change#4546 + Branch: perl + ! ext/B/B.xs ext/B/B/Bytecode.pm ext/B/B/C.pm sv.c +____________________________________________________________________________ +[ 4661] By: gsar on 1999/12/07 09:33:50 + Log: typos in change#4660 + Branch: perl + ! embed.h embed.pl objXSUB.h perl.h perlapi.c pp_sys.c proto.h +____________________________________________________________________________ +[ 4660] By: gsar on 1999/12/06 23:42:55 + Log: tweaks for building with -DUSE_ITHREADS on !WIN32 platforms; + fix bug where lc($readonly) could result in bogus errors + Branch: perl + ! embed.h embed.pl iperlsys.h makedef.pl objXSUB.h perlapi.c + ! pp.c pp_sys.c proto.h sv.c +____________________________________________________________________________ +[ 4659] By: gsar on 1999/12/06 15:24:31 + Log: allow IRIX 6.5 to build perl (from Helmut Jarausch + ) + Branch: perl + ! perl.h +____________________________________________________________________________ +[ 4658] By: gsar on 1999/12/06 15:18:30 + Log: fix for -Dp via $^D (suggested by Stephane Payrard + ) + Branch: perl + ! mg.c +____________________________________________________________________________ +[ 4657] By: gsar on 1999/12/06 06:50:01 + Log: change#4641 needs perldiag.pod edit + Branch: perl + - lib/unicode/UnicodeData-Latest.txt + ! pod/perldiag.pod +____________________________________________________________________________ +[ 4656] By: gsar on 1999/12/06 01:36:56 + Log: Makefile tweak for change#4649 + Branch: perl + ! Makefile.SH +____________________________________________________________________________ +[ 4655] By: gsar on 1999/12/05 17:23:57 + Log: change#4653 was missing a patch reject + Branch: perl + ! win32/makefile.mk +____________________________________________________________________________ +[ 4654] By: gsar on 1999/12/05 11:41:04 + Log: windows build tweaks for Borland compiler + Branch: perl + ! win32/makefile.mk win32/perlhost.h win32/win32.c win32/win32.h +____________________________________________________________________________ +[ 4653] By: gsar on 1999/12/05 11:07:37 + Log: applied somewhat modified version of suggested patch + From: "Benjamin Stuhl" + Date: Thu, 18 Nov 1999 18:45:27 PST + Message-ID: <19991119024527.72749.qmail@hotmail.com> + Subject: [PATCH 5.005_62] Perl on Win95, Mark IIB + Branch: perl + + win32/PerlCRT.def win32/gstartup.c win32/oldnames.def + ! MANIFEST ext/SDBM_File/Makefile.PL lib/ExtUtils/MM_Unix.pm + ! lib/ExtUtils/MM_Win32.pm win32/config_sh.PL win32/genmk95.pl + ! win32/makefile.mk win32/win32.h +____________________________________________________________________________ +[ 4652] By: gsar on 1999/12/05 09:24:45 + Log: From: Mike Hopkirk (hops) + Date: Thu, 4 Nov 1999 16:34:23 -0800 (PST) + Message-Id: <199911050034.QAA06499@scoot.pdev.sco.com> + Subject: [ID 19991104.005] modified hints file for UnixWare7 ( svr5) + Branch: perl + ! Changes hints/svr5.sh +____________________________________________________________________________ +[ 4651] By: gsar on 1999/12/05 09:01:19 + Log: on dosish platforms, avoid infinite recursion in File::Path::mkpath() + when given non-existent drive names + Branch: perl + ! lib/File/Path.pm +____________________________________________________________________________ +[ 4650] By: gsar on 1999/12/05 08:47:11 + Log: windows build tweaks for change#4649 + Branch: perl + ! win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 4649] By: gsar on 1999/12/05 07:49:28 + Log: make File::Glob::glob() the default for CORE::glob() + (old csh glob can still be had with -DPERL_EXTERNAL_GLOB) + Branch: perl + ! Makefile.SH op.c pod/perldelta.pod win32/Makefile + ! win32/makefile.mk +____________________________________________________________________________ +[ 4648] By: gsar on 1999/12/05 00:33:34 + Log: fix bug in processing L<> tags (from j.vavruska@post.cz) + Branch: perl + ! lib/Pod/Html.pm +____________________________________________________________________________ +[ 4647] By: gsar on 1999/12/05 00:14:01 + Log: remove outdated entry + Branch: perl + ! pod/perltrap.pod +____________________________________________________________________________ +[ 4646] By: gsar on 1999/12/04 22:48:51 + Log: s/block/loop block/ in diagnostics about next, last, redo + Branch: perl + ! pod/perldiag.pod pp_ctl.c t/op/runlevel.t t/pragma/warn/pp_ctl +____________________________________________________________________________ +[ 4645] By: gsar on 1999/12/04 22:25:32 + Log: readability tweak suggested by GRommel@sears.com + Branch: perl + ! pp.c +____________________________________________________________________________ +[ 4644] By: gsar on 1999/12/04 22:05:00 + Log: Configure tweak from Peter Prymmer + Branch: perl + ! Configure +____________________________________________________________________________ +[ 4643] By: gsar on 1999/12/04 21:55:27 + Log: make weak keyword check look for defined(&lock), not + merely defined(*lock) + Branch: perl + ! toke.c +____________________________________________________________________________ +[ 4642] By: gsar on 1999/12/04 21:11:51 + Log: make eof() open ARGV if it isn't open already; also fixes bug + where eof() would operate on any last-read filehandle, not + just ARGV + Branch: perl + ! pp_sys.c +____________________________________________________________________________ +[ 4641] By: gsar on 1999/12/04 04:42:25 + Log: make uninitialized value warnings report opcode + Branch: perl + ! doio.c embed.h embed.pl global.sym objXSUB.h opcode.h + ! opcode.pl perl.h perlapi.c pp.c pp_hot.c proto.h sv.c + ! t/op/misc.t t/pragma/warn/1global t/pragma/warn/2use + ! t/pragma/warn/3both t/pragma/warn/4lint t/pragma/warn/7fatal + ! t/pragma/warn/doio t/pragma/warn/pp t/pragma/warn/pp_hot + ! t/pragma/warn/sv +____________________________________________________________________________ +[ 4640] By: gsar on 1999/12/04 02:40:44 + Log: provide explicit functions timegm_nocheck() and timelocal_nocheck() + that don't do range checking + Branch: perl + ! lib/Time/Local.pm +____________________________________________________________________________ +[ 4639] By: gsar on 1999/12/04 01:00:49 + Log: better implementation of change#3326; open(local $foo,...) now + allowed in addition to any uninitialized variable, for consistency + with how autovivification works elsewhere; add code to use the + variable name as the name of the handle for simple variables, so + that diagnostics report the handle: "... at - line 1, <$foo> line 10." + Branch: perl + ! op.c pod/perldelta.pod pp.c t/io/open.t +____________________________________________________________________________ +[ 4638] By: gsar on 1999/12/03 21:20:00 + Log: pod nits + Branch: perl + ! pod/perlfunc.pod pod/perlrun.pod +____________________________________________________________________________ +[ 4637] By: gsar on 1999/12/03 08:59:04 + Log: change#4431 was flawed + Branch: perl + ! Makefile.SH +____________________________________________________________________________ +[ 4636] By: gsar on 1999/12/03 07:59:52 + Log: pod embellishments from Nathan Torkington + Branch: perl + ! pod/perlfaq2.pod pod/perlhack.pod +____________________________________________________________________________ +[ 4635] By: gsar on 1999/12/03 07:56:04 + Log: perlfaq4 typo (from Jeff Pinyan ) + Branch: perl + ! pod/perlfaq4.pod +____________________________________________________________________________ +[ 4634] By: gsar on 1999/12/03 07:47:47 + Log: test tweak for VMS (from Craig A. Berry) + Branch: perl + ! t/io/nargv.t +____________________________________________________________________________ +[ 4633] By: gsar on 1999/12/03 07:44:52 + Log: patchls tweak from Andreas Koenig + Branch: perl + ! Porting/patchls +____________________________________________________________________________ +[ 4632] By: gsar on 1999/12/03 07:42:23 + Log: don't mess with the umask() + Branch: perl + ! installhtml installman installperl lib/ExtUtils/Install.pm + ! lib/ExtUtils/Manifest.pm +____________________________________________________________________________ +[ 4631] By: gsar on 1999/12/03 06:52:50 + Log: support -a switch to append bytecode to an existing file and make + perlcc use it (from Tom Hughes ) + Branch: perl + ! ext/B/B/Bytecode.pm utils/perlcc.PL +____________________________________________________________________________ +[ 4630] By: gsar on 1999/12/03 06:46:16 + Log: document incompatible perl4 vec() vs bitwise ops interaction trap + (from Tom Phoenix) + Branch: perl + ! pod/perltrap.pod +____________________________________________________________________________ +[ 4629] By: gsar on 1999/12/03 06:40:15 + Log: use PerlIO abstraction rather than straight stdio (from + Chip Salzenberg) + Branch: perl + ! ext/ByteLoader/ByteLoader.xs +____________________________________________________________________________ +[ 4628] By: gsar on 1999/12/03 06:15:54 + Log: avoid warning in IO::Select::exists() if socket doesn't exist + Branch: perl + ! ext/IO/lib/IO/Select.pm +____________________________________________________________________________ +[ 4627] By: gsar on 1999/12/03 06:05:19 + Log: two small patches from Peter Prymmer + Branch: perl + ! makedepend.SH win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 4626] By: gsar on 1999/12/03 05:36:38 + Log: From: Peter Prymmer + Date: Thu, 25 Nov 1999 21:06:19 -0800 (PST) + Message-Id: <199911260506.VAA17230@brio.forte.com> + Subject: [PATCH: 5.005_62] implement /[:ascii:]/ on ebcdic machines + Branch: perl + ! regcomp.c +____________________________________________________________________________ +[ 4625] By: gsar on 1999/12/03 05:20:21 + Log: Windows build tweaks due to change#4623 + Branch: perl + ! win32/Makefile win32/makefile.mk win32/perlhost.h +____________________________________________________________________________ +[ 4624] By: gsar on 1999/12/03 04:58:30 + Log: add missing file + Branch: perl + + ext/DynaLoader/XSLoader_pm.PL +____________________________________________________________________________ +[ 4623] By: gsar on 1999/12/03 04:47:03 + Log: applied suggested patch; removed $VERSION = $VERSION hack + (change#4043 fixed the need for that) + From: Ilya Zakharevich + Date: Tue, 16 Nov 1999 01:50:31 EST + Message-Id: <199911160650.BAA18874@monk.mps.ohio-state.edu> + Subject: [PATCH 5.005_62] XSLoader.pm + Branch: perl + ! MANIFEST ext/B/B.pm ext/ByteLoader/ByteLoader.pm + ! ext/DB_File/DB_File.pm ext/Data/Dumper/Dumper.pm + ! ext/Devel/DProf/DProf.pm ext/Devel/Peek/Peek.pm + ! ext/DynaLoader/DynaLoader_pm.PL ext/DynaLoader/Makefile.PL + ! ext/DynaLoader/dlutils.c ext/Fcntl/Fcntl.pm + ! ext/File/Glob/Glob.pm ext/GDBM_File/GDBM_File.pm ext/IO/IO.pm + ! ext/NDBM_File/NDBM_File.pm ext/ODBM_File/ODBM_File.pm + ! ext/Opcode/Opcode.pm ext/POSIX/POSIX.pm + ! ext/SDBM_File/SDBM_File.pm ext/Socket/Socket.pm + ! ext/Thread/Thread.pm ext/attrs/attrs.pm ext/re/re.pm + ! lib/AutoLoader.pm lib/FindBin.pm lib/Getopt/Std.pm +____________________________________________________________________________ +[ 4622] By: gsar on 1999/12/03 04:02:39 + Log: revert change#4618 (breaks C<$_ = 'A:B'; s/^[a-z]:/x/>) + Branch: perl + ! Changes embed.h embed.pl perl.h proto.h regcomp.c regcomp.h +____________________________________________________________________________ +[ 4621] By: gsar on 1999/12/02 22:24:53 + Log: caveat about thread-safety of extensions + Branch: perl + ! pod/perlfork.pod +____________________________________________________________________________ +[ 4620] By: gsar on 1999/12/02 20:31:02 + Log: XS documentation patches suggested by Ilya, severally adjusted + Branch: perl + ! pod/perlxs.pod pod/perlxstut.pod +____________________________________________________________________________ +[ 4619] By: gsar on 1999/12/02 17:52:50 + Log: re-add missing Unicode database master + Branch: perl + + lib/unicode/Unicode.300 +____________________________________________________________________________ +[ 4618] By: gsar on 1999/12/02 06:56:18 + Log: applied suggested patch with prototype changes + From: Ilya Zakharevich + Date: Tue, 23 Nov 1999 22:55:55 EST + Message-Id: <199911240355.WAA23033@monk.mps.ohio-state.edu> + Subject: [PATCH 5.005_62] First char cognizance + Branch: perl + ! embed.h embed.pl perl.h proto.h regcomp.c regcomp.h +____________________________________________________________________________ +[ 4617] By: gsar on 1999/12/02 06:04:57 + Log: fixes for bugs in change#4586 and OS/2 pod tweak, from Ilya + Branch: perl + ! os2/OS2/REXX/REXX.pm regexec.c t/op/re_tests +____________________________________________________________________________ +[ 4616] By: gsar on 1999/12/02 04:30:22 + Log: various documentation tweaks suggested by M. J. T. Guy + Branch: perl + ! INSTALL lib/strict.pm pod/perlfunc.pod pod/perlsyn.pod +____________________________________________________________________________ +[ 4615] By: gsar on 1999/12/02 04:17:43 + Log: various File::Glob fixes for DOSISH platforms + From: "Moore, Paul" + Date: Tue, 02 Nov 1999 11:11:25 GMT + Message-Id: <714DFA46B9BBD0119CD000805FC1F53BDC38E3@UKRUX002.rundc.uk.origin-it.com> + Subject: File::Glob again. Final patch, honest! + Branch: perl + + t/lib/glob-case.t + ! MANIFEST ext/File/Glob/Changes ext/File/Glob/Glob.pm + ! ext/File/Glob/Glob.xs ext/File/Glob/bsd_glob.c + ! ext/File/Glob/bsd_glob.h op.c t/lib/glob-global.t +____________________________________________________________________________ +[ 4614] By: gsar on 1999/12/02 03:42:55 + Log: allow XSUBs and prototyped subroutines to be used with sort() (tweaked + variant of patch suggested by Peter Haworth ) + Branch: perl + ! pod/perldelta.pod pod/perlfunc.pod pp_ctl.c t/op/sort.t +____________________________________________________________________________ +[ 4613] By: gsar on 1999/12/02 01:59:19 + Log: ignore yet another known scalar leak + Branch: perl + ! t/pragma/warn/regcomp +____________________________________________________________________________ +[ 4612] By: gsar on 1999/12/02 01:15:02 + Log: avoid potential stack extension bug in pp_unpack() (spotted by Ilya) + Branch: perl + ! pp.c +____________________________________________________________________________ +[ 4611] By: gsar on 1999/12/02 00:31:43 + Log: a somewhat tweaked version of suggested patch + From: Ilya Zakharevich + Date: Wed, 27 Oct 1999 18:57:41 -0400 (EDT) + Message-Id: <199910272257.SAA29928@monk.mps.ohio-state.edu> + Subject: [PATCH 5.005_62] Another round of pack/vec docs patches + Branch: perl + ! pod/perlfunc.pod +____________________________________________________________________________ +[ 4610] By: gsar on 1999/12/01 19:09:31 + Log: more accurate require() pseudocode (from James P. Williams + ) + Branch: perl + ! pod/perlfunc.pod +____________________________________________________________________________ +[ 4609] By: gsar on 1999/12/01 18:43:49 + Log: avoid "Callback called exit" error on intentional exit() + Branch: perl + ! embedvar.h intrpvar.h objXSUB.h perl.c perl.h pp_ctl.c +____________________________________________________________________________ +[ 4608] By: gsar on 1999/12/01 18:42:38 + Log: find_byclass() prototype was incoherent + Branch: perl + ! regexec.c +____________________________________________________________________________ +[ 4607] By: gsar on 1999/12/01 05:45:10 + Log: better documentation for goto &NAME (from M. J. T. Guy) + Branch: perl + ! pod/perlfunc.pod +____________________________________________________________________________ +[ 4606] By: gsar on 1999/12/01 05:33:14 + Log: integrate cfgperl contents into mainline + Branch: perl + +> lib/unicode/Jamo.txt lib/unicode/NamesList.html + +> lib/unicode/UCD300.html lib/unicode/Unicode3.html + - lib/unicode/Jamo-2.txt lib/unicode/Unicode.html + ! Changes + !> (integrate 210 files) +____________________________________________________________________________ +[ 4605] By: gsar on 1999/12/01 05:15:27 + Log: avoid PTR->IV cast warnings + Branch: perl + ! mg.c op.c scope.h +____________________________________________________________________________ +[ 4604] By: gsar on 1999/12/01 03:59:56 + Log: email address changes + Branch: perl + ! AUTHORS Changes Porting/genlog Porting/p4d2p Porting/p4desc + ! README.win32 ext/Data/Dumper/Dumper.pm lib/DB.pm + ! lib/File/DosGlob.pm lib/Math/Complex.pm lib/Math/Trig.pm + ! pod/perl5005delta.pod pod/perlport.pod t/op/runlevel.t + ! utils/perlbug.PL utils/perldoc.PL win32/bin/perlglob.pl +____________________________________________________________________________ +[ 4603] By: gsar on 1999/12/01 03:45:13 + Log: minor USE_ITHREADS tweaks + Branch: perl + ! doio.c op.c op.h pp_hot.c pp_sys.c run.c win32/Makefile + ! win32/perllib.c win32/win32.h +____________________________________________________________________________ +[ 4602] By: gsar on 1999/12/01 01:00:09 + Log: more complete pseudo-fork() support for Windows + Branch: perl + + pod/perlfork.pod win32/perlhost.h win32/vdir.h win32/vmem.h + ! MANIFEST XSUB.h cop.h dump.c embed.h embed.pl embedvar.h + ! ext/B/B/CC.pm ext/Opcode/Opcode.xs global.sym globals.c + ! globvar.sym gv.c hv.c intrpvar.h iperlsys.h makedef.pl mg.c + ! mpeix/mpeixish.h objXSUB.h op.c op.h os2/os2ish.h perl.c + ! perl.h perlapi.c plan9/plan9ish.h pod/Makefile pod/buildtoc + ! pod/perl.pod pod/roffitall pp.c pp_ctl.c pp_hot.c pp_sys.c + ! proto.h regcomp.c run.c scope.c scope.h sv.c t/op/fork.t + ! toke.c unixish.h util.c vos/vosish.h win32/Makefile + ! win32/makefile.mk win32/perllib.c win32/win32.c win32/win32.h + ! win32/win32iop.h win32/win32thread.h +____________________________________________________________________________ +[ 4601] By: gsar on 1999/12/01 00:45:38 + Log: rudimentary support for remote debugging, from aeons ago (somewhat + modified) + From: Graham TerMarsch + Date: Sat, 12 Sep 1998 10:46:55 -0700 + Message-ID: <35FAB38F.EA9AAC50@activestate.com> + Subject: Re: Patches to perl5db.pl to allow for remote debugging + Branch: perl + ! lib/perl5db.pl +____________________________________________________________________________ +[ 4600] By: chip on 1999/11/19 21:16:00 + Log: Document known limitations of fdopen() on some systems, + as they apply to open() and sysopen(). + Branch: perl + ! pod/perlfunc.pod +____________________________________________________________________________ +[ 4599] By: chip on 1999/11/19 17:20:19 + Log: Undef printf before redirecting it to PerlIO_stdoutf. + (Avoids an irritating warning when compiling with PerlIO.) + Branch: perl + ! perl.h +____________________________________________________________________________ +[ 4598] By: jhi on 1999/11/22 21:30:17 + Log: Small VMS nits from Craig A. Berry, . + Branch: cfgperl + ! README.vms t/io/open.t +____________________________________________________________________________ +[ 4597] By: jhi on 1999/11/21 16:21:21 + Log: Replace #4596 with the change done in 5.005_03. + Branch: cfgperl + ! ext/Errno/Errno_pm.PL +____________________________________________________________________________ +[ 4596] By: jhi on 1999/11/21 16:07:20 + Log: Skip processing a file if the file to be opened is '-' + (can happen in UNICOS) + Branch: cfgperl + ! ext/Errno/Errno_pm.PL +____________________________________________________________________________ +[ 4595] By: jhi on 1999/11/21 14:05:10 + Log: VMS patches from Peter Prymmer. + Branch: cfgperl + ! doio.c mg.c taint.c vms/subconfigure.com vms/vms.c +____________________________________________________________________________ +[ 4594] By: jhi on 1999/11/18 17:07:14 + Log: The find_byclass prototype is already in proto.h. + Branch: cfgperl + ! regexec.c +____________________________________________________________________________ +[ 4593] By: gsar on 1999/11/16 21:25:21 + Log: typo in flag checks + Branch: utfperl + ! sv.h +____________________________________________________________________________ +[ 4592] By: jhi on 1999/11/16 21:17:25 + Log: Regen Configure. + Branch: cfgperl + ! Configure config_h.SH pp.c pp.h vms/subconfigure.com + Branch: metaconfig + ! U/a_dvisory/quadtype.U +____________________________________________________________________________ +[ 4591] By: jhi on 1999/11/16 14:53:19 + Log: Integrate with Sarathy. + Branch: cfgperl + !> cop.h deb.c embed.h embed.pl global.sym lib/Pod/Checker.pm + !> lib/Pod/InputObjects.pm lib/Pod/Parser.pm lib/Pod/Select.pm + !> lib/Pod/Usage.pm makedef.pl objXSUB.h perl.c perlapi.c + !> pod/podchecker.PL pp_sys.c proto.h sv.c t/pod/poderrs.t + !> t/pod/poderrs.xr +____________________________________________________________________________ +[ 4590] By: gsar on 1999/11/16 05:57:56 + Log: Pod::Parser updates (v1.091) from Brad Appleton + Branch: perl + ! lib/Pod/Checker.pm lib/Pod/InputObjects.pm lib/Pod/Parser.pm + ! lib/Pod/Select.pm lib/Pod/Usage.pm pod/podchecker.PL + ! t/pod/poderrs.t t/pod/poderrs.xr +____________________________________________________________________________ +[ 4589] By: gsar on 1999/11/15 18:47:34 + Log: add a synchronous stub fork() for USE_ITHREADS to prove that a simple + C works on + Windows (incidentally running a cloned^2 interpreter :) + Branch: perl + ! embed.h embed.pl global.sym makedef.pl objXSUB.h perlapi.c + ! pp_sys.c proto.h sv.c +____________________________________________________________________________ +[ 4588] By: gsar on 1999/11/15 14:34:36 + Log: cloning the stack (part 1) + Branch: perl + ! cop.h deb.c perl.c sv.c +____________________________________________________________________________ +[ 4587] By: jhi on 1999/11/15 00:22:20 + Log: Integrate with Sarathy. + Branch: cfgperl + !> Changes embed.h embed.pl embedvar.h global.sym intrpvar.h + !> makedef.pl objXSUB.h op.c perl.h perlapi.c proto.h run.c sv.c + !> win32/perllib.c +____________________________________________________________________________ +[ 4586] By: jhi on 1999/11/14 21:17:26 + Log: Ilya's "hopscotch" patch, reworked by Ilya to fit. + Branch: cfgperl + ! embed.h embed.pl embedvar.h proto.h regexec.c t/op/re_tests +____________________________________________________________________________ +[ 4585] By: gsar on 1999/11/14 20:01:45 + Log: tweak for win32 build + Branch: perl + ! embed.h embed.pl op.c proto.h +____________________________________________________________________________ +[ 4584] By: gsar on 1999/11/14 19:46:25 + Log: cosmetic tweaks + Branch: perl + ! embed.h embed.pl embedvar.h global.sym intrpvar.h makedef.pl + ! objXSUB.h perl.h perlapi.c proto.h sv.c win32/perllib.c +____________________________________________________________________________ +[ 4583] By: gsar on 1999/11/14 17:38:32 + Log: fix problem pointer casts + Branch: perl + ! Changes run.c sv.c +____________________________________________________________________________ +[ 4582] By: jhi on 1999/11/14 17:10:01 + Log: Integrate with Sarathy. + Branch: cfgperl + !> cop.h dump.c ext/Opcode/Opcode.xs gv.c op.c perl.c perly.c + !> perly.y pp_ctl.c pp_sys.c sv.c t/op/misc.t toke.c util.c + !> vms/perly_c.vms win32/perllib.c +____________________________________________________________________________ +[ 4581] By: jhi on 1999/11/14 17:08:23 + Log: The separation of 64-bitness and largefileness continues + (with a setback, see hpux.sh). + Branch: cfgperl + ! Configure MANIFEST config_h.SH hints/aix.sh hints/hpux.sh + ! hints/solaris_2.sh + Branch: metaconfig + ! U/threads/archname.U U/typedefs/lseektype.U + Branch: metaconfig/U/perl + ! fpossize.U use64bits.U uselfs.U +____________________________________________________________________________ +[ 4580] By: jhi on 1999/11/14 13:26:41 + Log: Another Unicode update. + Branch: cfgperl + + lib/unicode/Jamo.txt lib/unicode/NamesList.html + + lib/unicode/UCD300.html lib/unicode/Unicode3.html + - lib/unicode/Jamo-2.txt lib/unicode/Unicode.html + ! (edit 189 files) +____________________________________________________________________________ +[ 4579] By: gsar on 1999/11/14 10:21:49 + Log: sundry cleanups for cloned interpreters (only known failure mode + is due to regexps keeping non-constant data in their compiled + structures) + Branch: perl + ! cop.h dump.c ext/Opcode/Opcode.xs gv.c op.c perl.c pp_ctl.c + ! pp_sys.c sv.c toke.c util.c win32/perllib.c +____________________________________________________________________________ +[ 4578] By: gsar on 1999/11/14 03:37:37 + Log: fix bug in change#4515 (STOP blocks now see @ARGV like the rest) + Branch: perl + ! perly.c perly.y t/op/misc.t vms/perly_c.vms +____________________________________________________________________________ +[ 4577] By: jhi on 1999/11/13 19:50:24 + Log: Change #4576 accidentally leaked also parts of + Ilya's patch that won't apply cleanly anymore. + Branch: cfgperl + ! regexec.c t/op/re_tests +____________________________________________________________________________ +[ 4576] By: jhi on 1999/11/13 19:43:37 + Log: Integrate with Sarathy. + Branch: cfgperl + ! embed.h embed.pl embedvar.h proto.h regexec.c t/op/re_tests + !> ext/Errno/Errno_pm.PL ext/IO/lib/IO/Socket.pm t/lib/dumper.t + !> t/op/regexp.t t/pragma/overload.t +____________________________________________________________________________ +[ 4575] By: gsar on 1999/11/13 19:41:46 + Log: typos in change#4561 and change#4565 + Branch: perl + ! ext/Errno/Errno_pm.PL ext/IO/lib/IO/Socket.pm +____________________________________________________________________________ +[ 4574] By: gsar on 1999/11/13 19:31:19 + Log: revert non-kosher parts of change#4562 (sort order problems + should be ignored (on ebcdic) by fixing dumper.t/T() to sort + result and expected lines; /[:ascii:]/ not working should be + fixed, not ignored in regexp.t; result from sort should be + fixed to be ascii portable on ebcdic, not ebcdic-specific) + Branch: perl + ! t/lib/dumper.t t/op/regexp.t t/pragma/overload.t +____________________________________________________________________________ +[ 4573] By: gsar on 1999/11/13 19:13:04 + Log: integrate cfgperl changes into mainline + Branch: perl + +> lib/unicode/Eq/Latin1.pl lib/unicode/Eq/Unicode.pl + +> lib/unicode/In/BopomofoExtended.pl + +> lib/unicode/In/BraillePatterns.pl + +> lib/unicode/In/CJKRadicalsSupplement.pl + +> lib/unicode/In/CJKUnifiedIdeographsExtensionA.pl + +> lib/unicode/In/Cherokee.pl + +> lib/unicode/In/IdeographicDescriptionCharacters.pl + +> lib/unicode/In/KangxiRadicals.pl lib/unicode/In/Khmer.pl + +> lib/unicode/In/Mongolian.pl lib/unicode/In/Myanmar.pl + +> lib/unicode/In/Ogham.pl lib/unicode/In/Runic.pl + +> lib/unicode/In/Sinhala.pl lib/unicode/In/Syriac.pl + +> lib/unicode/In/Thaana.pl + +> lib/unicode/In/UnifiedCanadianAboriginalSyllabics.pl + +> lib/unicode/In/YiRadicals.pl lib/unicode/In/YiSyllables.pl + - lib/unicode/Eq/Latin1 lib/unicode/Eq/Unicode + !> (integrate 213 files) +____________________________________________________________________________ +[ 4572] By: jhi on 1999/11/13 18:44:50 + Log: From: "Craig A. Berry" + To: perl5-porters@perl.org, VMSPERL@perl.org + Subject: [PATCH 5.005_03 and 5.005_62] updates to README.vms + Date: Wed, 27 Oct 1999 11:02:54 -0500 + Message-Id: <4.2.0.58.19991027105257.00addc10@mmtnt11.metamor.com> + Branch: cfgperl + ! README.vms +____________________________________________________________________________ +[ 4571] By: jhi on 1999/11/13 18:33:39 + Log: From: jand@activestate.com (Jan Dubois) + To: perl5-porters@perl.org, Perl-Win32-Porters@activestate.com + Cc: Douglas Lankshear , + Gurusamy Sarathy + Subject: [5.005_62 PATCH] support link() on WinNT and NTFS + Date: Tue, 09 Nov 1999 00:38:33 +0100 + Message-ID: <382b5d24.10899522@smtprelay.t-online.de> + Branch: cfgperl + ! XSUB.h iperlsys.h pp_sys.c t/io/fs.t win32/config.bc + ! win32/config.gc win32/config.vc win32/config_H.bc + ! win32/config_H.gc win32/config_H.vc win32/perllib.c + ! win32/win32.c win32/win32iop.h +____________________________________________________________________________ +[ 4570] By: jhi on 1999/11/13 18:30:37 + Log: From: Ilya Zakharevich + To: perl5-porters@perl.org (Mailing list Perl5) + Subject: [PATCH 5.005_62] makedef.pl goof + Date: Mon, 8 Nov 1999 23:55:21 -0500 (EST) + Message-Id: <199911090455.XAA25627@monk.mps.ohio-state.edu> + Branch: cfgperl + ! makedef.pl +____________________________________________________________________________ +[ 4569] By: jhi on 1999/11/13 18:06:54 + Log: From: Michael G Schwern + To: perl5-porters@perl.org, pod-people@perl.org + Cc: tchrist@mox.perl.com, gnat@frii.com + Subject: [DOCPATCH 5.005_62 perlfaq9.pod] Mention HTML::FormatText + Date: Wed, 10 Nov 1999 17:21:46 -0500 + Message-ID: <19991110172146.A23527@athens.aocn.com> + Branch: cfgperl + ! pod/perlfaq9.pod +____________________________________________________________________________ +[ 4568] By: jhi on 1999/11/13 18:05:33 + Log: From: "Paul Moore" + To: + Subject: DynaLoader_pm.PL patch (backslashes in strings) + Date: Wed, 10 Nov 1999 22:52:02 -0000 + Message-ID: + Branch: cfgperl + ! ext/DynaLoader/DynaLoader_pm.PL +____________________________________________________________________________ +[ 4567] By: jhi on 1999/11/13 18:03:52 + Log: From: JD Laub + To: perl5-porters@perl.org + Subject: [ID 19991112.002] patch: Exporter.pm not reporting path + Date: Fri, 12 Nov 1999 08:58:28 -0700 (MST) + Message-Id: <199911121558.IAA08915@mocha.iasi.com> + Branch: cfgperl + ! lib/Exporter/Heavy.pm +____________________________________________________________________________ +[ 4566] By: jhi on 1999/11/13 18:01:24 + Log: From: Bernard Quatermass + To: perl5-porters@perl.org + Subject: small patch for perldoc + Date: Fri, 12 Nov 1999 23:11:43 GMT + Message-Id: + Branch: cfgperl + ! utils/perldoc.PL +____________________________________________________________________________ +[ 4565] By: jhi on 1999/11/13 17:58:54 + Log: From: Scott Gifford + To: perl5-porters@perl.org + Cc: gbarr@pobox.com + Subject: [ID 19991112.004] Bug in IO::Socket (patch included) + Date: 12 Nov 1999 18:55:30 -0500 + Message-Id: + Branch: cfgperl + ! ext/IO/lib/IO/Socket.pm +____________________________________________________________________________ +[ 4564] By: jhi on 1999/11/13 17:45:39 + Log: Applied manually: + From: "Craig A. Berry" + To: perl5-porters@perl.org, VMSPERL@perl.org + Subject: [PATCH 5.005_62] patches required to build on VMS + Date: Tue, 09 Nov 1999 18:16:14 -0600 + Message-Id: <4.2.2.19991109173839.00d12630@mmtnt11.metamor.com> + Branch: cfgperl + ! configure.com vms/descrip_mms.template vms/subconfigure.com + ! vms/vms.c vms/vmsish.h +____________________________________________________________________________ +[ 4563] By: jhi on 1999/11/13 17:18:41 + Log: Regen Unicode tables to include a warning: + Thou Shalt Not Edit Them By Hand; add missing + (Unicode 2.0 -introduced) tables to MANIFEST; + convert the equivalence tables to be valid Perl code. + Branch: cfgperl + + lib/unicode/Eq/Latin1.pl lib/unicode/Eq/Unicode.pl + + lib/unicode/In/BopomofoExtended.pl + + lib/unicode/In/BraillePatterns.pl + + lib/unicode/In/CJKRadicalsSupplement.pl + + lib/unicode/In/CJKUnifiedIdeographsExtensionA.pl + + lib/unicode/In/Cherokee.pl + + lib/unicode/In/IdeographicDescriptionCharacters.pl + + lib/unicode/In/KangxiRadicals.pl lib/unicode/In/Khmer.pl + + lib/unicode/In/Mongolian.pl lib/unicode/In/Myanmar.pl + + lib/unicode/In/Ogham.pl lib/unicode/In/Runic.pl + + lib/unicode/In/Sinhala.pl lib/unicode/In/Syriac.pl + + lib/unicode/In/Thaana.pl + + lib/unicode/In/UnifiedCanadianAboriginalSyllabics.pl + + lib/unicode/In/YiRadicals.pl lib/unicode/In/YiSyllables.pl + - lib/unicode/Eq/Latin1 lib/unicode/Eq/Unicode + ! (edit 169 files) +____________________________________________________________________________ +[ 4562] By: jhi on 1999/11/13 16:53:00 + Log: From: Peter Prymmer + To: gsar@activestate.com, perl-mvs@perl.org, perlbug@perl.com + Subject: [PATCH: 5.005_62]was Re: [ID 19991102.003] perl on os390 + Date: Wed, 10 Nov 1999 14:34:36 -0800 (PST) + Message-Id: <199911102234.OAA01018@brio.forte.com> + Branch: cfgperl + ! t/lib/dumper.t t/op/pack.t t/op/regexp.t t/pragma/locale.t + ! t/pragma/overload.t +____________________________________________________________________________ +[ 4561] By: jhi on 1999/11/13 16:29:37 + Log: $Config{myarchname} is not a good architecture identifier + because it may contain host/node identification like + CPU serial numbers. + Branch: cfgperl + ! ext/Errno/Errno_pm.PL +____________________________________________________________________________ +[ 4560] By: jhi on 1999/11/13 16:26:13 + Log: Continue largefileness separation from quadness; + move nv-preserving test out of perl.h into Configure; + use HAS_SETVBUF in IO. + Branch: cfgperl + ! Configure Porting/Glossary Porting/config.sh Porting/config_H + ! config_h.SH ext/IO/IO.xs hints/solaris_2.sh perl.h pp_sys.c + Branch: metaconfig + ! U/a_dvisory/quadtype.U + Branch: metaconfig/U/perl + + nvpresuv.U + ! d_fseeko.U d_ftello.U io64.U perlxv.U +____________________________________________________________________________ +[ 4559] By: jhi on 1999/11/13 13:46:38 + Log: Try to fix largefileness so that it "works" without a quad IV. + Branch: cfgperl + ! Configure Porting/Glossary Porting/config.sh Porting/config_H + ! config_h.SH perl.h pp_sys.c t/lib/syslfs.t t/op/lfs.t + Branch: metaconfig + ! U/a_dvisory/quadtype.U U/typedefs/lseektype.U + Branch: metaconfig/U/perl + ! io64.U +____________________________________________________________________________ +[ 4558] By: jhi on 1999/11/13 11:36:19 + Log: Undo drift from mainline. + Branch: cfgperl + ! regcomp.c util.c utils/h2xs.PL +____________________________________________________________________________ +[ 4557] By: gsar on 1999/11/13 10:54:46 + Log: typo + Branch: perl + ! util.c +____________________________________________________________________________ +[ 4556] By: gsar on 1999/11/13 10:53:41 + Log: integrate cfgperl contents (op.[ch] needed manual resolve) + Branch: perl + +> epoc/Config.pm epoc/autosplit.pl epoc/createpkg.pl + +> epoc/epoc_stubs.c + !> (integrate 48 files) +____________________________________________________________________________ +[ 4555] By: jhi on 1999/11/13 10:05:54 + Log: Integrate with Sarathy. + Branch: cfgperl + !> dump.c ext/Devel/DProf/DProf.xs gv.c mg.c op.c perl.c pp.c + !> sv.c warnings.h warnings.pl win32/Makefile win32/perllib.c +____________________________________________________________________________ +[ 4554] By: jhi on 1999/11/13 10:03:07 + Log: s/_SIGN$/_sign/g; + Branch: metaconfig + ! U/typedefs/gidsign.U U/typedefs/pidsign.U U/typedefs/uidsign.U +____________________________________________________________________________ +[ 4553] By: gsar on 1999/11/13 02:17:53 + Log: cloned interpreters now actually run and pass all but 55/10386 + subtests; various subtle bugs, new and old, observed when running + cloned interpreters have been fixed + + still to do: + | * dup psig_ptr table + | * merge PADOP GVs support with "our" SVs (existing PADOPs are too + | simple-minded and grab one pad entry each, heavily bloating + | the pad by not avoiding dups) + | * overloaded constants are not really immutable--they need to + | be PADOPs + | * allocator for constants and OPs need to be spelled differently + | (shared vs interpreter-local allocations) + | * optree refcounting is still missing locking (macros are in place) + | * curstackinfo, {mark,scope,save,ret}stack need to be cloned so + | perl_clone() can be called from within runops*() + Branch: perl + ! dump.c ext/Devel/DProf/DProf.xs gv.c mg.c op.c perl.c pp.c + ! sv.c warnings.h warnings.pl win32/Makefile win32/perllib.c +____________________________________________________________________________ +[ 4552] By: jhi on 1999/11/11 23:17:43 + Log: Turn on largefileness always if available and + continue 64-bit fixes. + Branch: cfgperl + ! Configure config_h.SH handy.h hints/aix.sh hints/dec_osf.sh + ! hints/hpux.sh hints/irix_6.sh hints/solaris_2.sh perl.h pp.c + ! sv.c t/lib/syslfs.t t/op/lfs.t utf8.c +____________________________________________________________________________ +[ 4551] By: jhi on 1999/11/11 23:16:15 + Log: Split int64type from i_inttypes, rename quadcase into quadkind. + Branch: metaconfig + ! U/a_dvisory/quadtype.U + Branch: metaconfig/U/perl + + d_int64t.U + ! i_inttypes.U io64.U +____________________________________________________________________________ +[ 4550] By: jhi on 1999/11/11 20:24:55 + Log: Fix a thinko in 4548. + Branch: cfgperl + ! pp_sys.c +____________________________________________________________________________ +[ 4549] By: jhi on 1999/11/11 19:48:21 + Log: Integrate with Sarathy. + Branch: cfgperl + !> (integrate 56 files) +____________________________________________________________________________ +[ 4548] By: jhi on 1999/11/11 19:41:56 + Log: Try to do something if st_size, st_uid, st_gid are too big for an IV; + regen Configure. + Branch: cfgperl + ! Configure Porting/Glossary Porting/config.sh Porting/config_H + ! config_h.SH pp_sys.c +____________________________________________________________________________ +[ 4547] By: jhi on 1999/11/11 19:40:38 + Log: s/_SIZE$/_size/g; add sizesize and ssizesize. + Branch: metaconfig + + U/typedefs/sizesize.U U/typedefs/ssizesize.U + ! U/typedefs/gidsize.U U/typedefs/pidsize.U U/typedefs/uidsize.U +____________________________________________________________________________ +[ 4546] By: gsar on 1999/11/11 10:32:54 + Log: avoid stash pointers in optree under USE_ITHREADS + Branch: perl + ! bytecode.pl cop.h ext/B/B.xs ext/B/B/Asmdata.pm + ! ext/B/B/Bytecode.pm ext/B/B/C.pm ext/B/B/Debug.pm + ! ext/B/B/Deparse.pm ext/ByteLoader/bytecode.h + ! ext/ByteLoader/byterun.c ext/ByteLoader/byterun.h + ! ext/Opcode/Opcode.xs gv.c op.c perl.c pp.c pp_ctl.c pp_hot.c + ! scope.h sv.c +____________________________________________________________________________ +[ 4545] By: gsar on 1999/11/11 06:04:20 + Log: another change towards a shareable optree: avoid pointer to filegv + in COP; revert parts of change#4485 and s/xcv_filegv/xcv_file/ + (CvFILE() may yet come in handy somewhere); adjust compiler doodads + to suit + Branch: perl + ! bytecode.pl cop.h cv.h dump.c ext/B/B.pm ext/B/B.xs + ! ext/B/B/Asmdata.pm ext/B/B/Bytecode.pm ext/B/B/C.pm + ! ext/B/B/CC.pm ext/B/B/Debug.pm ext/B/B/Deparse.pm + ! ext/B/B/Lint.pm ext/B/B/Xref.pm ext/ByteLoader/bytecode.h + ! ext/ByteLoader/byterun.c ext/ByteLoader/byterun.h + ! ext/Devel/Peek/Peek.pm gv.c gv.h op.c perl.c pp.c pp_ctl.c + ! pp_sys.c scope.c scope.h sv.c sv.h toke.c util.c util.h + ! win32/perllib.c +____________________________________________________________________________ +[ 4544] By: gsar on 1999/11/10 18:19:12 + Log: more cleanups for change#4539 + Branch: perl + ! gv.h op.c op.h pp_ctl.c pp_hot.c +____________________________________________________________________________ +[ 4543] By: gsar on 1999/11/10 01:52:22 + Log: remove dead branch/infinite looper in change#3612 + Branch: perl + ! op.c +____________________________________________________________________________ +[ 4542] By: gsar on 1999/11/09 20:05:47 + Log: IoDIRP may be fake when used in source filters, mark as such + Branch: perl + ! sv.c sv.h toke.c +____________________________________________________________________________ +[ 4541] By: gsar on 1999/11/09 05:47:53 + Log: small nits in changes#4538,4539 + Branch: perl + ! op.c sv.c +____________________________________________________________________________ +[ 4540] By: gsar on 1999/11/08 20:30:58 + Log: win32 symbol export tweak + Branch: perl + ! makedef.pl win32/win32.c win32/win32iop.h +____________________________________________________________________________ +[ 4539] By: gsar on 1999/11/08 18:50:40 + Log: preliminary support for GVOP indirection via pad + Branch: perl + ! doio.c dump.c embed.h embed.pl global.sym objXSUB.h op.c op.h + ! opcode.pl perlapi.c pp_hot.c pp_sys.c proto.h run.c +____________________________________________________________________________ +[ 4538] By: gsar on 1999/11/08 11:25:49 + Log: preliminary support for perl_clone() (still needs work in + the following areas: SVOPs must indirect via pad; context + stack, scope stack, and runlevels must be cloned; must + hook up the virtualized pseudo-process support provided by + "host"; ...) + Branch: perl + ! av.h embed.h embed.pl embedvar.h global.sym hv.c hv.h + ! intrpvar.h makedef.pl objXSUB.h perl.h perlapi.c proto.h sv.c + ! win32/perllib.c win32/win32.c +____________________________________________________________________________ +[ 4537] By: gsar on 1999/11/08 11:19:18 + Log: more thorough cleanup in perl_destroy() + Branch: perl + ! perl.c util.c +____________________________________________________________________________ +[ 4536] By: gsar on 1999/11/08 07:16:10 + Log: win32 internal data must be interpreter-local + Branch: perl + ! win32/win32.c win32/win32.h win32/win32sck.c +____________________________________________________________________________ +[ 4535] By: gsar on 1999/11/08 04:17:28 + Log: tweak change#4502 + Branch: perl + ! doio.c perl.c +____________________________________________________________________________ +[ 4534] By: jhi on 1999/11/07 13:17:03 + Log: Four special class subs, not three. + Branch: cfgperl + ! pod/perlmod.pod +____________________________________________________________________________ +[ 4533] By: jhi on 1999/11/07 13:13:15 + Log: Integrate with Sarathy. + Branch: cfgperl + !> mg.c t/io/print.t +____________________________________________________________________________ +[ 4532] By: jhi on 1999/11/07 12:36:10 + Log: More test program maintenance. + Branch: cfgperl + ! Configure config_h.SH + Branch: metaconfig + ! U/a_dvisory/intsize.U U/compline/alignbytes.U + ! U/compline/charsize.U U/compline/d_sigaction.U + ! U/compline/doublesize.U U/compline/floatsize.U + ! U/compline/nblock_io.U U/compline/ptrsize.U + ! U/modified/Signal.U U/typedefs/gidsize.U U/typedefs/pidsize.U + ! U/typedefs/uidsize.U + Branch: metaconfig/U/perl + ! fpossize.U +____________________________________________________________________________ +[ 4531] By: jhi on 1999/11/07 00:34:09 + Log: Tidy up the metaconfig test programs. + Branch: cfgperl + ! Configure config_h.SH + Branch: metaconfig + ! U/a_dvisory/intsize.U U/compline/alignbytes.U + ! U/compline/charsize.U U/compline/doublesize.U + ! U/compline/nblock_io.U U/compline/ptrsize.U + ! U/modified/d_longlong.U U/typedefs/gidsize.U + ! U/typedefs/lseektype.U U/typedefs/pidsize.U + ! U/typedefs/uidsize.U + Branch: metaconfig/U/perl + ! fpossize.U +____________________________________________________________________________ +[ 4530] By: jhi on 1999/11/06 23:51:34 + Log: So many printfs, so little time. + Branch: cfgperl + ! op.c perl.c regcomp.c scope.c util.c +____________________________________________________________________________ +[ 4529] By: jhi on 1999/11/06 23:27:35 + Log: Replace the explicit zeros with NOOPs. + Branch: cfgperl + ! perl.h +____________________________________________________________________________ +[ 4528] By: jhi on 1999/11/06 23:10:54 + Log: From: jand@activestate.com (Jan Dubois) + To: perl5-porters@perl.org + Cc: Mike Blazer , + Mark Borgerding + Subject: [5.005_62 PATCH] binmode and locale support for -T and -B filetest operators + Date: Sat, 06 Nov 1999 22:16:43 +0100 + Message-ID: <38279207.46448719@smtprelay.t-online.de> + Branch: cfgperl + ! op.c op.h +____________________________________________________________________________ +[ 4527] By: jhi on 1999/11/06 20:22:14 + Log: ...and fewer. + Branch: cfgperl + ! dump.c +____________________________________________________________________________ +[ 4526] By: jhi on 1999/11/06 20:19:04 + Log: ...and they are getting fewer. + Branch: cfgperl + ! dump.c op.c util.c +____________________________________________________________________________ +[ 4525] By: jhi on 1999/11/06 19:59:59 + Log: More printf miscasts flushed out. + Branch: cfgperl + ! dump.c ext/B/B.xs ext/Data/Dumper/Dumper.xs regcomp.c + ! regexec.c +____________________________________________________________________________ +[ 4524] By: jhi on 1999/11/06 15:39:05 + Log: Crushing the remaining %ld guerillas. + Branch: cfgperl + ! ext/Devel/DProf/DProf.xs +____________________________________________________________________________ +[ 4523] By: jhi on 1999/11/06 15:11:38 + Log: Update CPAN sites list. + Branch: cfgperl + ! pod/perlmodlib.pod +____________________________________________________________________________ +[ 4522] By: jhi on 1999/11/05 19:50:46 + Log: The -n32 is normally part of $cc, not $ccflags. + Branch: cfgperl + ! hints/irix_6.sh +____________________________________________________________________________ +[ 4521] By: gsar on 1999/11/05 04:35:30 + Log: allow $\ to work right when set to a string with embedded nulls + Branch: perl + ! mg.c t/io/print.t +____________________________________________________________________________ +[ 4520] By: jhi on 1999/11/04 23:30:09 + Log: Integrate with Sarathy. + Branch: cfgperl + !> embedvar.h ext/B/B/Bytecode.pm ext/B/B/Lint.pm + !> ext/B/B/Stash.pm ext/B/NOTES ext/B/O.pm ext/File/Glob/Glob.pm + !> ext/File/Glob/bsd_glob.c ext/File/Glob/bsd_glob.h intrpvar.h + !> keywords.h keywords.pl objXSUB.h op.c perl.c pod/perldelta.pod + !> pod/perldiag.pod pod/perlfunc.pod pod/perlmod.pod + !> pod/perlrun.pod pod/perlsub.pod pod/perltodo.pod toke.c +____________________________________________________________________________ +[ 4519] By: jhi on 1999/11/04 23:09:25 + Log: From: Ilya Zakharevich + To: perl5-porters@perl.org (Mailing list Perl5) + Subject: [PATCH 5.005_62] ref to non-lvalue method + Date: Wed, 3 Nov 1999 03:52:48 -0500 (EST) + Message-Id: <199911030852.DAA06563@monk.mps.ohio-state.edu> + Branch: cfgperl + ! op.c +____________________________________________________________________________ +[ 4518] By: jhi on 1999/11/04 23:07:27 + Log: From: Ilya Zakharevich + To: perl5-porters@perl.org (Mailing list Perl5) + Subject: [PATCH 5.005_62] xsubpp dependency + Date: Wed, 3 Nov 1999 02:57:23 -0500 (EST) + Message-Id: <199911030757.CAA06325@monk.mps.ohio-state.edu> + Branch: cfgperl + ! lib/ExtUtils/MM_Unix.pm +____________________________________________________________________________ +[ 4517] By: jhi on 1999/11/04 23:05:59 + Log: From: Ilya Zakharevich + To: perl5-porters@perl.org (Mailing list Perl5) + Subject: [PATCH 5.005_62] regexp.h + Date: Wed, 3 Nov 1999 02:55:21 -0500 (EST) + Message-Id: <199911030755.CAA06311@monk.mps.ohio-state.edu> + Branch: cfgperl + ! regexp.h +____________________________________________________________________________ +[ 4516] By: gsar on 1999/11/04 18:25:45 + Log: change#4485 didn't do the right thing for B::Bytecode + Branch: perl + ! ext/B/B/Bytecode.pm +____________________________________________________________________________ +[ 4515] By: gsar on 1999/11/04 17:28:29 + Log: implement STOP blocks and fix compiler to use them (minimally + tested) + Branch: perl + ! embedvar.h ext/B/B/Lint.pm ext/B/B/Stash.pm ext/B/NOTES + ! ext/B/O.pm intrpvar.h keywords.h keywords.pl objXSUB.h op.c + ! perl.c pod/perldelta.pod pod/perldiag.pod pod/perlfunc.pod + ! pod/perlmod.pod pod/perlrun.pod pod/perlsub.pod + ! pod/perltodo.pod toke.c +____________________________________________________________________________ +[ 4514] By: gsar on 1999/11/04 15:59:46 + Log: display BSD license in Glob.pm (for clause #2 conformity) + Branch: perl + ! ext/File/Glob/Glob.pm ext/File/Glob/bsd_glob.c + ! ext/File/Glob/bsd_glob.h +____________________________________________________________________________ +[ 4513] By: jhi on 1999/11/04 08:26:19 + Log: Integrate with Sarathy. + Branch: cfgperl + +> t/io/nargv.t + !> (integrate 34 files) +____________________________________________________________________________ +[ 4512] By: jhi on 1999/11/04 08:01:25 + Log: Incremental Mac integration from Matthias. + Branch: cfgperl + ! perl.c perl.h pp_ctl.c pp_hot.c run.c sv.c t/pod/testpchk.pl + ! toke.c util.c +____________________________________________________________________________ +[ 4511] By: gsar on 1999/11/04 02:53:37 + Log: remove VIRTUAL tag, PERL_OBJECT doesn't need it anymore + Branch: perl + ! dosish.h embed.pl mg.c os2/os2ish.h perl.c perl.h perly.c + ! perly_c.diff pp_ctl.c proto.h regcomp.c regexec.c sv.c toke.c + ! universal.c vms/perly_c.vms vms/vmsish.h win32/win32.h + ! xsutils.c +____________________________________________________________________________ +[ 4510] By: jhi on 1999/11/02 22:12:29 + Log: S_init_interp is a better place to diddle with PL_opargs + than perl_construct. + Branch: cfgperl + ! perl.c +____________________________________________________________________________ +[ 4509] By: jhi on 1999/11/02 21:30:02 + Log: From: "M.J.T. Guy" + To: ben@mucus.advanced.org, perl5-porters@perl.org + Subject: Re: [ID 19991102.002] unpack('N', pack('N', -1)) not idempotent + Date: Tue, 02 Nov 1999 21:36:00 +0000 + Message-Id: + Branch: cfgperl + ! pod/perlfunc.pod +____________________________________________________________________________ +[ 4508] By: jhi on 1999/11/02 20:46:27 + Log: Initial integration of the MacPerl changes form Matthias. + Branch: cfgperl + ! doio.c ext/DynaLoader/DynaLoader_pm.PL ext/Fcntl/Fcntl.pm + ! ext/Fcntl/Fcntl.xs gv.c mg.c opcode.pl perl.c perl.h pp_ctl.c + ! pp_hot.c pp_sys.c run.c sv.c toke.c util.c +____________________________________________________________________________ +[ 4507] By: jhi on 1999/11/01 23:05:07 + Log: From: Ilya Zakharevich + To: lvirden@cas.org (Larry W. Virden) + Cc: perl5-porters@perl.org, lvirden@cas.org + Subject: Re: [ID 19991026.001] perl segmentation fault report + Date: Mon, 1 Nov 1999 18:14:16 -0500 (EST) + Message-Id: <199911012314.SAA22664@monk.mps.ohio-state.edu> + Branch: cfgperl + ! regexec.c t/op/pat.t +____________________________________________________________________________ +[ 4506] By: jhi on 1999/11/01 19:56:28 + Log: From: Olaf Flebbe + To: perl5-porters@perl.org + Subject: [PATCH: 5.005_62] Patch for EPOC Support + Date: Mon, 1 Nov 1999 20:46:54 +0100 (MET) + Message-ID: + Branch: cfgperl + + epoc/Config.pm epoc/autosplit.pl epoc/createpkg.pl + + epoc/epoc_stubs.c + ! MANIFEST README.epoc epoc/epocish.h epoc/perl.mmp + ! epoc/perl.pkg +____________________________________________________________________________ +[ 4505] By: gsar on 1999/11/01 17:09:44 + Log: macros for COP.cop_filegv access + Branch: perl + ! cop.h deb.c gv.c op.c perl.c pp_ctl.c pp_sys.c scope.c toke.c + ! util.c +____________________________________________________________________________ +[ 4504] By: gsar on 1999/11/01 17:08:28 + Log: enable better Win32::DomainName() by demand loading netapi32.dll + (from Jan Dubois) + Branch: perl + ! pod/Win32.pod win32/win32.c +____________________________________________________________________________ +[ 4503] By: gsar on 1999/10/31 20:56:06 + Log: change#4502 was missing a file + Branch: perl + + t/io/nargv.t +____________________________________________________________________________ +[ 4502] By: gsar on 1999/10/31 20:46:02 + Log: make nested ARGV/$^I loops work correctly; fixes several bugs + in the way ARGV state was handled in readline(); writing a + subroutine to do inplace edits is now possible, provided *ARGV, + *ARGVOUT, $^I and $_ are localized where needed + Branch: perl + ! MANIFEST doio.c embedvar.h intrpvar.h objXSUB.h perl.c + ! pp_hot.c scope.c +____________________________________________________________________________ +[ 4501] By: jhi on 1999/10/31 12:43:54 + Log: Integrate with Sarathy. + Branch: cfgperl + !> perl.h win32/config.bc win32/config.gc win32/config.vc + !> win32/config_H.bc win32/config_H.gc win32/config_H.vc +____________________________________________________________________________ +[ 4500] By: gsar on 1999/10/31 10:01:17 + Log: updated windows config* files + Branch: perl + ! win32/config.bc win32/config.gc win32/config.vc + ! win32/config_H.bc win32/config_H.gc win32/config_H.vc +____________________________________________________________________________ +[ 4499] By: gsar on 1999/10/31 09:15:17 + Log: integrate cfgperl contents into mainline + Branch: perl + !> Configure Porting/Glossary Porting/config.sh Porting/config_H + !> config_h.SH perl.h +____________________________________________________________________________ +[ 4498] By: gsar on 1999/10/31 09:13:41 + Log: remove unused struct Outrec + Branch: perl + ! perl.h +____________________________________________________________________________ +[ 4497] By: jhi on 1999/10/30 12:41:50 + Log: Add HAS_QUAD ($Config{d_quad}); use it. + Branch: cfgperl + ! Configure Porting/Glossary Porting/config.sh Porting/config_H + ! config_h.SH perl.h + Branch: metaconfig + ! U/a_dvisory/quadtype.U U/compline/charsize.U U/typedefs/gidf.U + ! U/typedefs/uidf.U + Branch: metaconfig/U/perl + ! perlxv.U +____________________________________________________________________________ +[ 4496] By: gsar on 1999/10/30 00:28:32 + Log: integrate cfgperl contents into mainline + Branch: perl + !> Configure Policy_sh.SH Porting/Glossary Porting/config.sh + !> Porting/config_H README.hurd config_h.SH doop.c handy.h + !> hints/aix.sh hints/irix_6.sh hints/solaris_2.sh mg.c perl.c + !> perl.h pp.c pp.h regexec.c sv.c taint.c +____________________________________________________________________________ +[ 4495] By: jhi on 1999/10/29 23:36:19 + Log: Continue what #4494 started; introduce uid and gid formats. + Branch: cfgperl + ! Configure Porting/Glossary Porting/config.sh Porting/config_H + ! config_h.SH handy.h perl.h + Branch: metaconfig + + U/a_dvisory/quadtype.U U/typedefs/gidf.U U/typedefs/uidf.U + - U/typedefs/quadtype.U + Branch: metaconfig/U/perl + ! perlxv.U +____________________________________________________________________________ +[ 4494] By: jhi on 1999/10/29 22:09:01 + Log: Move the IV, UV, I8, U8, ..., and NV to metaconfig + from perl.h and handy.h. + Branch: cfgperl + ! Configure Porting/Glossary Porting/config.sh Porting/config_H + ! config_h.SH handy.h perl.h + Branch: metaconfig/U/perl + + perlxv.U perlxvf.U +____________________________________________________________________________ +[ 4493] By: jhi on 1999/10/29 22:08:06 + Log: Finetuning the output continues along the lines of #4490 and #4491. + Branch: metaconfig + ! U/modified/i_sysuio.U U/threads/d_pthreadj.U + ! U/typedefs/fpostype.U + Branch: metaconfig/U/perl + + fpossize.U + ! d_cmsghdr_s.U d_fs_data_s.U d_msghdr_s.U d_statfs3.U + ! d_statfs4.U d_statfs_f_flags.U d_statfs_s.U io64.U +____________________________________________________________________________ +[ 4492] By: jhi on 1999/10/29 21:14:53 + Log: Hurd update from Mark Kettenis. + Branch: cfgperl + ! README.hurd +____________________________________________________________________________ +[ 4491] By: jhi on 1999/10/29 20:37:02 + Log: A new try at what #4490 tried to accomplish. + Branch: metaconfig + ! U/modified/i_sysuio.U U/threads/d_pthreadj.U + Branch: metaconfig/U/perl + ! d_cmsghdr_s.U d_fs_data_s.U d_msghdr_s.U d_statfs3.U + ! d_statfs4.U d_statfs_f_flags.U d_statfs_s.U io64.U +____________________________________________________________________________ +[ 4490] By: jhi on 1999/10/29 20:19:41 + Log: metaconfig nits. + Branch: metaconfig + ! U/modified/i_sysuio.U U/threads/d_pthreadj.U + Branch: metaconfig/U/perl + + d_iovec_s.U + ! d_cmsghdr_s.U d_fs_data_s.U d_msghdr_s.U d_statfs3.U + ! d_statfs4.U d_statfs_f_flags.U d_statfs_s.U io64.U +____________________________________________________________________________ +[ 4489] By: jhi on 1999/10/29 16:08:43 + Log: Integrate with Sarathy. + Branch: cfgperl + !> (integrate 31 files) +____________________________________________________________________________ +[ 4488] By: jhi on 1999/10/29 15:30:30 + Log: Regen Configure and Glossary. + Branch: cfgperl + ! Configure Porting/Glossary Porting/config.sh Porting/config_H + ! config_h.SH +____________________________________________________________________________ +[ 4487] By: jhi on 1999/10/29 15:24:13 + Log: Remove quad logic from perl.h; regen Configure; + add -DUSE_LONG_LONG to ccflags if not already there. + Branch: cfgperl + ! Configure config_h.SH doop.c hints/aix.sh hints/irix_6.sh + ! hints/solaris_2.sh perl.h pp.c pp.h regexec.c sv.c +____________________________________________________________________________ +[ 4486] By: jhi on 1999/10/29 15:22:38 + Log: metaconfig: moved quad logic from perl.h to Configure (quadtype.U); + fixed the use*.U to define their stuff only iff not already defined + (so that ccflags can have any -DUSE_* it wants); + uselonglong.U added; various small nits fixed. + Branch: metaconfig + + U/typedefs/quadtype.U + ! U/modified/d_longdbl.U U/modified/d_longlong.U + ! U/modified/d_statblks.U U/modified/usenm.U + ! U/threads/usethreads.U + Branch: metaconfig/U/perl + + uselonglong.U + ! d_cmsghdr_s.U d_fs_data_s.U d_msghdr_s.U d_statfs3.U + ! d_statfs4.U d_statfs_f_flags.U d_statfs_s.U i_inttypes.U + ! quadfio.U use64bits.U uselfs.U uselongdbl.U usemorebits.U + ! usemultiplicity.U useperlio.U usesocks.U +____________________________________________________________________________ +[ 4485] By: gsar on 1999/10/29 06:08:50 + Log: more cleanup: avoid unused knowledge of "file GV" notion in CV and GV + Branch: perl + ! bytecode.pl cv.h dump.c ext/B/B.pm ext/B/B.xs + ! ext/B/B/Asmdata.pm ext/B/B/Bytecode.pm ext/B/B/C.pm + ! ext/B/B/Debug.pm ext/B/B/Xref.pm ext/ByteLoader/byterun.c + ! ext/ByteLoader/byterun.h ext/Devel/Peek/Peek.pm gv.c gv.h op.c + ! sv.h +____________________________________________________________________________ +[ 4484] By: gsar on 1999/10/29 03:00:21 + Log: usurp GVOP slot for new PADOP (one small step to making optree + shareable across interpreters) + Branch: perl + ! bytecode.pl doio.c dump.c ext/B/B.pm ext/B/B.xs + ! ext/B/B/Asmdata.pm ext/B/B/Bytecode.pm ext/B/B/C.pm + ! ext/B/B/Debug.pm ext/B/B/Deparse.pm ext/B/B/Lint.pm + ! ext/B/B/Terse.pm ext/B/typemap ext/ByteLoader/byterun.c + ! ext/ByteLoader/byterun.h op.c op.h opcode.h opcode.pl perl.h + ! pp_hot.c pp_sys.c regexec.c run.c +____________________________________________________________________________ +[ 4483] By: jhi on 1999/10/28 22:01:12 + Log: Regen Configure. + Branch: cfgperl + ! Configure Porting/Glossary Porting/config.sh Porting/config_H + ! config_h.SH +____________________________________________________________________________ +[ 4482] By: jhi on 1999/10/28 21:45:26 + Log: Installdirs patches from Andy. + Branch: metaconfig + ! U/installdirs/sitearch.U U/installdirs/sitebin.U + ! U/installdirs/sitehtml1dir.U U/installdirs/sitehtml3dir.U + ! U/installdirs/sitelib.U U/installdirs/siteman1dir.U + ! U/installdirs/siteman3dir.U U/installdirs/siteprefix.U + ! U/installdirs/sitescriptdir.U U/installdirs/vendorarch.U + ! U/installdirs/vendorbin.U U/installdirs/vendorhtml1dir.U + ! U/installdirs/vendorhtml3dir.U U/installdirs/vendorlib.U + ! U/installdirs/vendorman1dir.U U/installdirs/vendorman3dir.U + ! U/installdirs/vendorprefix.U U/installdirs/vendorscriptdir.U +____________________________________________________________________________ +[ 4481] By: gsar on 1999/10/28 17:33:49 + Log: remove C misfeature (global + can still be directly set) + Branch: perl + ! lib/Time/Local.pm +____________________________________________________________________________ +[ 4480] By: jhi on 1999/10/28 13:49:26 + Log: Fix printing of uids and gids; regen Configure. + Branch: cfgperl + ! Configure Porting/Glossary Porting/config.sh Porting/config_H + ! config_h.SH mg.c perl.c perl.h taint.c +____________________________________________________________________________ +[ 4479] By: jhi on 1999/10/28 11:53:57 + Log: Fix typo. + Branch: metaconfig + ! U/typedefs/gidsize.U +____________________________________________________________________________ +[ 4478] By: jhi on 1999/10/28 06:50:02 + Log: Integrate with Sarathy. + Branch: cfgperl + !> Changes iperlsys.h makedef.pl patchlevel.h perl.h + !> win32/Makefile win32/config.bc win32/config.gc win32/config.vc + !> win32/config_H.bc win32/config_H.gc win32/config_H.vc + !> win32/config_sh.PL win32/makefile.mk win32/win32.h +____________________________________________________________________________ +[ 4477] By: jhi on 1999/10/28 06:40:54 + Log: (Slightly) better comments for Policy_sh.SH from Andy. + Branch: cfgperl + ! Policy_sh.SH +____________________________________________________________________________ +[ 4476] By: gsar on 1999/10/27 23:54:36 + Log: regen config* stuff for windows + Branch: perl + ! Changes patchlevel.h win32/Makefile win32/config.bc + ! win32/config.gc win32/config.vc win32/config_H.bc + ! win32/config_H.gc win32/config_H.vc win32/config_sh.PL + ! win32/makefile.mk +____________________________________________________________________________ +[ 4475] By: gsar on 1999/10/27 21:32:30 + Log: integrate cfgperl contents into mainline; merge conflicts + Branch: perl + !> (integrate 46 files) +____________________________________________________________________________ +[ 4474] By: gsar on 1999/10/27 21:15:07 + Log: patch up egcs-1.1.2-mingw32 build (builds a working miniperl, but not + perl; stdout/stderr redirects seem broken as well) + Branch: perl + ! iperlsys.h makedef.pl perl.h win32/makefile.mk win32/win32.h +____________________________________________________________________________ +[ 4473] By: jhi on 1999/10/27 21:11:11 + Log: Do not block if no message queues available. + Branch: cfgperl + ! t/lib/ipc_sysv.t +____________________________________________________________________________ +[ 4472] By: jhi on 1999/10/27 18:27:40 + Log: Remove unused "squatter" symbols; regen Configure. + Branch: cfgperl + ! Configure Makefile.SH Porting/Glossary Porting/config.sh + ! Porting/config_H config_h.SH epoc/config.h iperlsys.h perl.h + ! win32/config_H.bc win32/config_H.gc win32/config_H.vc +____________________________________________________________________________ +[ 4471] By: jhi on 1999/10/27 18:26:55 + Log: metaconfig; split socket; fix output. + Branch: metaconfig + ! U/modified/d_socket.U U/modified/d_statblks.U + Branch: metaconfig/U/perl + + d_cmsghdr_s.U d_msghdr_s.U d_recvmsg.U d_sendmsg.U + ! i_sysstatfs.U i_sysvfs.U +____________________________________________________________________________ +[ 4470] By: jhi on 1999/10/27 17:19:06 + Log: Regen Configure. + Branch: cfgperl + ! Configure Porting/Glossary Porting/config.sh Porting/config_H + ! config_h.SH perl.c perl.h +____________________________________________________________________________ +[ 4469] By: jhi on 1999/10/27 17:18:41 + Log: metaconfig; split statfs. + Branch: metaconfig/U/perl + + d_fs_data_s.U d_statfs_f_flags.U d_statfs_s.U + ! d_statfs.U +____________________________________________________________________________ +[ 4468] By: jhi on 1999/10/27 14:06:44 + Log: Integrate with Sarathy; manual resolve on regcomp.c conflicts + (Ilya's changes won). + Branch: cfgperl + +> os2/OS2/REXX/DLL/Changes os2/OS2/REXX/DLL/DLL.pm + +> os2/OS2/REXX/DLL/DLL.xs os2/OS2/REXX/DLL/MANIFEST + +> os2/OS2/REXX/DLL/Makefile.PL os2/OS2/REXX/t/rx_emxrv.t + !> (integrate 65 files) +____________________________________________________________________________ +[ 4467] By: jhi on 1999/10/27 13:38:41 + Log: Regen Configure. + Branch: cfgperl + ! Configure Porting/Glossary Porting/config.sh Porting/config_H + ! config_h.SH +____________________________________________________________________________ +[ 4466] By: jhi on 1999/10/27 13:18:06 + Log: metaconfig fixes from Andy. + Branch: metaconfig + + U/modified/libnlist.U U/modified/usrinc.U + ! U/Glossary.patch U/mkglossary U/modified/libpth.U +____________________________________________________________________________ +[ 4465] By: jhi on 1999/10/27 13:06:27 + Log: Nosuid checking for statfs() people. + Branch: cfgperl + ! Configure Porting/Glossary Porting/config.sh Porting/config_H + ! config_h.SH perl.c perl.h pod/perldiag.pod +____________________________________________________________________________ +[ 4464] By: jhi on 1999/10/27 13:04:20 + Log: metaconfig maintenance; fix Hasfield, statfs; + add Hasstruct, statfs3, statfs4, ustat, sysvfs; + split fstatfs away from statfs. + Branch: metaconfig + + U/protos/Hasstruct.U + ! U/protos/Hasfield.U + Branch: metaconfig/U/perl + + d_fstatfs.U d_statfs3.U d_statfs4.U d_ustat.U i_sysvfs.U + + i_ustat.U + ! d_statfs.U +____________________________________________________________________________ +[ 4463] By: jhi on 1999/10/27 07:55:53 + Log: We need cc to be able to test for cc -v. + Branch: cfgperl + ! hints/dec_osf.sh +____________________________________________________________________________ +[ 4462] By: gsar on 1999/10/27 01:31:41 + Log: more GCC v2.95 induced adjustments + Branch: perl + ! globals.c mg.c opcode.h opcode.pl perl.h sv.c + ! win32/makefile.mk win32/win32.c x2p/walk.c +____________________________________________________________________________ +[ 4461] By: gsar on 1999/10/26 21:42:59 + Log: warnings and const violations identified by compiling in C++ mode + with GCC v2.95 + Branch: perl + ! doio.c embed.pl mg.c op.c perl.c perlapi.c proto.h regcomp.c + ! sv.c taint.c toke.c win32/win32.c +____________________________________________________________________________ +[ 4459] By: jhi on 1999/10/26 10:15:58 + Log: Regen Configure. + Branch: cfgperl + ! Configure Porting/Glossary Porting/config.sh Porting/config_H + ! config_h.SH +____________________________________________________________________________ +[ 4458] By: jhi on 1999/10/26 09:48:37 + Log: Minor rewordings. + Branch: metaconfig/U/perl + ! d_getmnt.U d_getmntent.U d_statfs.U d_statvfs.U +____________________________________________________________________________ +[ 4456] By: jhi on 1999/10/26 09:11:49 + Log: Fix d_statfsflags; add d_getmnt. + Branch: metaconfig/U/perl + + d_getmnt.U + ! d_statfs.U +____________________________________________________________________________ +[ 4455] By: jhi on 1999/10/26 08:12:27 + Log: Massive multitypo in #4446. + Branch: cfgperl + ! hints/dec_osf.sh +____________________________________________________________________________ +[ 4454] By: jhi on 1999/10/25 08:28:45 + Log: From: Laszlo Molnar + To: Perl 5 Porters + Subject: [PATCH 5.005_62] dos-djgpp update + Date: Mon, 25 Oct 1999 10:11:30 +0200 + Message-ID: <19991025101130.K459@crater.eth.ericsson.se> + Branch: cfgperl + ! djgpp/config.over djgpp/configure.bat djgpp/djgppsed.sh + ! pod/perldelta.pod t/lib/io_unix.t +____________________________________________________________________________ +[ 4453] By: jhi on 1999/10/25 08:25:50 + Log: From: Ilya Zakharevich + To: perl5-porters@perl.org (Mailing list Perl5) + Subject: [PATCH 5.005_62] Remove the last regnode<==>char* + Date: Mon, 25 Oct 1999 03:06:21 -0400 (EDT) + Message-Id: <199910250706.DAA16825@monk.mps.ohio-state.edu> + Branch: cfgperl + ! embed.h embed.pl proto.h regcomp.c regcomp.h regexec.c +____________________________________________________________________________ +[ 4452] By: jhi on 1999/10/25 08:16:55 + Log: From: Ilya Zakharevich + To: perl5-porters@perl.org (Mailing list Perl5) + Subject: [PATCH 5.005_62] Missing REx engine patch + Date: Sun, 24 Oct 1999 23:47:45 -0400 (EDT) + Message-Id: <199910250347.XAA16094@monk.mps.ohio-state.edu> + Branch: cfgperl + ! pod/perldiag.pod regcomp.c regexec.c +____________________________________________________________________________ +[ 4451] By: jhi on 1999/10/25 08:13:06 + Log: From: Ilya Zakharevich + To: perl5-porters@perl.org (Mailing list Perl5) + Subject: [PATCH 5.005_62] charnames and UTEST + Date: Sun, 24 Oct 1999 23:39:49 -0400 (EDT) + Message-Id: <199910250339.XAA16058@monk.mps.ohio-state.edu> + Branch: cfgperl + ! t/lib/charnames.t +____________________________________________________________________________ +[ 4450] By: gsar on 1999/10/25 07:38:15 + Log: win32 tweak + Branch: perl + ! win32/perllib.c +____________________________________________________________________________ +[ 4449] By: gsar on 1999/10/24 23:20:10 + Log: remove inconsistent tainting behavior of sprintf("%e",...) + (all bets are off is "C" locale is compromised) + Branch: perl + ! pod/perlfunc.pod pod/perllocale.pod sv.c +____________________________________________________________________________ +[ 4448] By: gsar on 1999/10/24 22:20:42 + Log: remove unused interpreter globals + Branch: perl + ! deb.c dump.c embed.h embed.pl embedvar.h ext/POSIX/POSIX.xs + ! global.sym gv.c gv.h intrpvar.h objXSUB.h perl.c perlapi.c + ! proto.h toke.c +____________________________________________________________________________ +[ 4447] By: jhi on 1999/10/24 21:49:52 + Log: Another hints tweak. + Branch: cfgperl + ! hints/aix.sh +____________________________________________________________________________ +[ 4446] By: jhi on 1999/10/24 21:48:02 + Log: Hints tweak. + Branch: cfgperl + ! hints/dec_osf.sh +____________________________________________________________________________ +[ 4445] By: nick on 1999/10/24 21:03:28 + Log: Integrate own changes to mainline. + Branch: utfperl + !> installperl pp.c +____________________________________________________________________________ +[ 4444] By: nick on 1999/10/24 20:54:06 + Log: Avoid creating GV with NULL name when vivifying nameless scalars. + (Fix/workround for [ID19991024.001]) + Branch: perl + ! pp.c +____________________________________________________________________________ +[ 4443] By: nick on 1999/10/24 15:09:51 + Log: Follow that camel ... another sync. + Branch: utfperl + +> os2/OS2/REXX/DLL/Changes os2/OS2/REXX/DLL/DLL.pm + +> os2/OS2/REXX/DLL/DLL.xs os2/OS2/REXX/DLL/MANIFEST + +> os2/OS2/REXX/DLL/Makefile.PL os2/OS2/REXX/t/rx_emxrv.t + !> (integrate 36 files) +____________________________________________________________________________ +[ 4442] By: gsar on 1999/10/24 14:40:01 + Log: typo in installperl (from Paul Moore ) + Branch: perl + ! installperl +____________________________________________________________________________ +[ 4441] By: gsar on 1999/10/24 14:33:11 + Log: test in change#4428 needs strict interpretation of C modulus + Branch: perl + ! t/op/int.t +____________________________________________________________________________ +[ 4440] By: gsar on 1999/10/24 13:47:17 + Log: don't allow SIGCHLD to be ignored at startup, or wait*() and + $? break + Branch: perl + ! perl.c pod/perldelta.pod pod/perldiag.pod +____________________________________________________________________________ +[ 4439] By: jhi on 1999/10/24 13:19:17 + Log: test for #2835 (yeah, better later than never) + Branch: cfgperl + ! t/op/array.t +____________________________________________________________________________ +[ 4438] By: gsar on 1999/10/24 12:59:12 + Log: typo, doc tweak + Branch: perl + ! lib/attributes.pm pod/perlop.pod +____________________________________________________________________________ +[ 4437] By: gsar on 1999/10/24 11:59:55 + Log: allow get() and reftype() functions to be imported (from + Spider Boardman) + Branch: perl + ! lib/attributes.pm +____________________________________________________________________________ +[ 4436] By: gsar on 1999/10/24 11:52:53 + Log: suppress scalar leak messages for known leaks (from + Robin Barker ) + Branch: perl + ! Changes t/op/lex_assign.t t/pragma/warn/op +____________________________________________________________________________ +[ 4435] By: gsar on 1999/10/24 11:39:42 + Log: VMS tweak (suggested by Craig A. Berry ) + Branch: perl + ! ext/B/defsubs_h.PL +____________________________________________________________________________ +[ 4434] By: gsar on 1999/10/24 11:36:08 + Log: relax range checking if they ask for it (from John L. Allen + ) + Branch: perl + ! lib/Time/Local.pm +____________________________________________________________________________ +[ 4433] By: gsar on 1999/10/24 11:25:51 + Log: README nits pointed out by Chris Nandor + Branch: perl + ! README lib/File/Path.pm +____________________________________________________________________________ +[ 4432] By: gsar on 1999/10/24 11:11:02 + Log: From: Ilya Zakharevich + Date: Sun, 24 Oct 1999 03:24:28 -0400 (EDT) + Message-Id: <199910240724.DAA12230@monk.mps.ohio-state.edu> + Subject: Re: [PATCH 5.005_62] OS/2 improvements + Branch: perl + + os2/OS2/REXX/DLL/Changes os2/OS2/REXX/DLL/DLL.pm + + os2/OS2/REXX/DLL/DLL.xs os2/OS2/REXX/DLL/MANIFEST + + os2/OS2/REXX/DLL/Makefile.PL os2/OS2/REXX/t/rx_emxrv.t + ! MANIFEST hints/os2.sh mg.c miniperlmain.c os2/Changes + ! os2/OS2/REXX/Changes os2/OS2/REXX/Makefile.PL + ! os2/OS2/REXX/REXX.pm os2/OS2/REXX/REXX.xs + ! os2/OS2/REXX/t/rx_dllld.t os2/OS2/REXX/t/rx_objcall.t + ! os2/OS2/REXX/t/rx_tievar.t os2/OS2/REXX/t/rx_tieydb.t + ! os2/OS2/REXX/t/rx_vrexx.t os2/dl_os2.c os2/os2.c os2/os2ish.h + ! perl.c perl.h t/io/fs.t t/op/magic.t +____________________________________________________________________________ +[ 4431] By: gsar on 1999/10/24 10:50:14 + Log: install all README.foo with pod content as podfoo.pod + Branch: perl + ! Makefile.SH installman +____________________________________________________________________________ +[ 4430] By: gsar on 1999/10/24 09:28:24 + Log: @INC needs ../lib + Branch: perl + ! t/op/int.t +____________________________________________________________________________ +[ 4429] By: jhi on 1999/10/23 21:47:49 + Log: More printf-fixes (see also #4426). + Branch: cfgperl + ! deb.c dump.c ext/Data/Dumper/Dumper.xs + ! ext/Devel/DProf/DProf.xs malloc.c mg.c op.c perl.c pp.c + ! pp_ctl.c regcomp.c regexec.c run.c scope.c sv.c util.c +____________________________________________________________________________ +[ 4428] By: gsar on 1999/10/23 20:28:56 + Log: fix accidental C modulo semantics on integer-valued operations + (e.g. caused C to return 3 rather than -7) + Branch: perl + ! op.c t/op/int.t +____________________________________________________________________________ +[ 4427] By: jhi on 1999/10/23 16:10:10 + Log: Integrate with Sarathy. + Branch: cfgperl + !> sv.c win32/win32.c +____________________________________________________________________________ +[ 4426] By: jhi on 1999/10/23 16:04:02 + Log: Fix the printfing nits pointed out by using gcc -Wall and + Configure -Duse64bits -Dccflags=-DDEBUGGING in Solaris, + plus few other warnings in Dumper.xs. + Branch: cfgperl + ! ext/Data/Dumper/Dumper.xs ext/Devel/DProf/DProf.xs + ! ext/Devel/Peek/Peek.xs regcomp.c regexec.c sv.c util.c +____________________________________________________________________________ +[ 4425] By: jhi on 1999/10/23 15:16:41 + Log: Configure regen to pick up the new installation directories + from Policy_sh.SH. The explanations of "public add-ons" and + "vendor-supplied" could do with more work. + Branch: cfgperl + ! Configure config_h.SH +____________________________________________________________________________ +[ 4424] By: nick on 1999/10/23 00:46:22 + Log: Resolve mainline before possible hacking operertunity this weekend + Branch: utfperl + +> pod/perlfilter.pod + !> (integrate 32 files) +____________________________________________________________________________ +[ 4423] By: jhi on 1999/10/22 22:53:17 + Log: Update Policy_sh.SH to handle the newer installation directives. + From: Andy Dougherty + To: Perl Porters + Subject: [PATCH 5.005_62] Policy_sh.SH update + Date: Fri, 22 Oct 1999 16:47:34 -0400 (EDT) + Message-ID: + Branch: cfgperl + ! Policy_sh.SH +____________________________________________________________________________ +[ 4422] By: jhi on 1999/10/22 22:44:44 + Log: so back to 'so', from Stephanie Beals + Branch: cfgperl + ! hints/aix.sh +____________________________________________________________________________ +[ 4421] By: gsar on 1999/10/22 21:16:44 + Log: sv_vcatpvfn() bug: fell through to assuming intsize of 'q' for + C<"%ld", long_val> + Branch: perl + ! sv.c +____________________________________________________________________________ +[ 4420] By: gsar on 1999/10/22 16:36:46 + Log: win32_utime() on directories should use localtime() rather + than gmtime() (from Jan Dubois) + Branch: perl + ! win32/win32.c +____________________________________________________________________________ +[ 4419] By: jhi on 1999/10/21 10:31:41 + Log: Integrate with Sarathy. + Branch: cfgperl + !> Makefile.SH lib/CPAN/FirstTime.pm op.c opcode.h opcode.pl + !> t/lib/glob-basic.t t/op/sort.t +____________________________________________________________________________ +[ 4418] By: gsar on 1999/10/20 23:49:47 + Log: add test for change#4417 + Branch: perl + ! t/op/sort.t +____________________________________________________________________________ +[ 4417] By: gsar on 1999/10/20 23:45:03 + Log: avoid coredump on C + Branch: perl + ! op.c +____________________________________________________________________________ +[ 4416] By: gsar on 1999/10/20 01:00:50 + Log: fix prototype mismatch (from Hans Mulder ) + Branch: perl + ! lib/CPAN/FirstTime.pm +____________________________________________________________________________ +[ 4415] By: gsar on 1999/10/20 00:52:34 + Log: disable optimizing troublesome ops in change#3612 + (from Ilya Zakharevich) + Branch: perl + ! Makefile.SH opcode.h opcode.pl +____________________________________________________________________________ +[ 4414] By: gsar on 1999/10/20 00:37:46 + Log: skip unreadable directory test when running as root + Branch: perl + ! t/lib/glob-basic.t +____________________________________________________________________________ +[ 4413] By: jhi on 1999/10/19 09:26:52 + Log: Avoid GNU ar if HP cc is being used. + Branch: cfgperl + ! hints/hpux.sh +____________________________________________________________________________ +[ 4412] By: jhi on 1999/10/19 07:24:29 + Log: Integrate with Sarathy. + Branch: cfgperl + !> perlvars.h +____________________________________________________________________________ +[ 4411] By: jhi on 1999/10/19 07:22:34 + Log: Long double support: sqrtl et al are not available everywhere, + e.g. not in Solaris, even when long doubles are. + Branch: cfgperl + ! Configure Porting/Glossary Porting/config.sh Porting/config_H + ! config_h.SH perl.h +____________________________________________________________________________ +[ 4410] By: jhi on 1999/10/19 07:21:42 + Log: Add sqrtl probe, add echo dependencies. + Branch: metaconfig + ! U/threads/d_pthreadj.U + Branch: metaconfig/U/perl + + d_sqrtl.U + ! i_inttypes.U io64.U +____________________________________________________________________________ +[ 4409] By: gsar on 1999/10/19 02:18:54 + Log: perl_mutex n/a if !USE_THREADS + Branch: perl + ! perlvars.h +____________________________________________________________________________ +[ 4408] By: jhi on 1999/10/18 20:13:02 + Log: Forgotten s/warning/warnings/. + Branch: cfgperl + ! Makefile.SH +____________________________________________________________________________ +[ 4407] By: jhi on 1999/10/18 20:02:12 + Log: Integrate with Sarathy. + Branch: cfgperl + +> pod/perlfilter.pod + !> (integrate 30 files) +____________________________________________________________________________ +[ 4406] By: gsar on 1999/10/18 16:32:10 + Log: added intro to source filters from Paul Marquess + Branch: perl + + pod/perlfilter.pod + ! MANIFEST pod/perldelta.pod +____________________________________________________________________________ +[ 4405] By: gsar on 1999/10/18 05:53:06 + Log: missing manpages + Branch: perl + ! installman +____________________________________________________________________________ +[ 4404] By: gsar on 1999/10/18 05:09:22 + Log: pod updates from Tom Christiansen + Branch: perl + ! lib/Pod/Man.pm pod/perldelta.pod pod/perlmodlib.pod +____________________________________________________________________________ +[ 4403] By: gsar on 1999/10/17 23:43:59 + Log: PL_malloc_mutex needs to be global, not per-interpreter + (malloc.c has static data) + Branch: perl + ! embedvar.h intrpvar.h objXSUB.h perl.c perlvars.h +____________________________________________________________________________ +[ 4402] By: gsar on 1999/10/17 22:30:30 + Log: support PERL_IMPLICIT_SYS with MULTIPLICITY/USE_THREADS on + windows + Branch: perl + ! XSUB.h ext/POSIX/POSIX.xs intrpvar.h makedef.pl malloc.c + ! perl.c perl.h perlio.c win32/perllib.c win32/win32.c + ! win32/win32.h +____________________________________________________________________________ +[ 4401] By: gsar on 1999/10/17 20:33:42 + Log: serious bug introduced by G_VOID changes in 5.003_96: scalar + eval"" did not pop stack correctly; C<$a = eval "(1,2)x1"> + is one symptom of the problem + Branch: perl + ! pp_ctl.c t/op/eval.t +____________________________________________________________________________ +[ 4400] By: gsar on 1999/10/17 18:36:46 + Log: remove FileHandle from list of PodParser dependencies (the + difference is 20 files vs 6 files loaded!) + Branch: perl + ! lib/Pod/Parser.pm lib/Pod/Select.pm pod/perldelta.pod + ! t/pod/testcmp.pl +____________________________________________________________________________ +[ 4399] By: nick on 1999/10/17 14:51:35 + Log: Pre-trip resolve + Branch: utfperl + !> installperl lib/Text/Tabs.pm perl.c pp_hot.c +____________________________________________________________________________ +[ 4398] By: gsar on 1999/10/17 09:19:24 + Log: make installperl ignore RCS files (from Michael G Schwern + ) + Branch: perl + ! installperl lib/Text/Tabs.pm +____________________________________________________________________________ +[ 4397] By: gsar on 1999/10/16 18:30:14 + Log: another bug in change#3386 (CATCH_SET wasn't reverted correctly) + Branch: perl + ! perl.c +____________________________________________________________________________ +[ 4396] By: jhi on 1999/10/16 17:44:39 + Log: Missing comma. + Branch: cfgperl + ! lib/diagnostics.pm +____________________________________________________________________________ +[ 4395] By: gsar on 1999/10/16 17:18:36 + Log: assumption about @_ always being non-REAL doesn't hold when + debugger is running; DB::sub() can call arbitrary stuff + that modifies @_ at will + Branch: perl + ! pp_hot.c +____________________________________________________________________________ +[ 4394] By: nick on 1999/10/16 09:35:20 + Log: Resolve utfperl branch against mainline as of _62 + Branch: utfperl + +> eg/cgi/dna_small_gif.uu eg/cgi/wilogo_gif.uu + +> ext/DB_File/hints/sco.pl ext/DynaLoader/hints/aix.pl + +> ext/File/Glob/Changes ext/File/Glob/Glob.pm + +> ext/File/Glob/Glob.xs ext/File/Glob/Makefile.PL + +> ext/File/Glob/TODO ext/File/Glob/bsd_glob.c + +> ext/File/Glob/bsd_glob.h ext/NDBM_File/hints/sco.pl + +> pod/perlhack.pod t/lib/glob-basic.t t/lib/glob-global.t + +> t/lib/glob-taint.t win32/genmk95.pl + - eg/cgi/dna.small.gif.uu eg/cgi/wilogo.gif.uu + !> (integrate 144 files) +____________________________________________________________________________ +[ 4393] By: gsar on 1999/10/16 04:07:02 + Log: OS/2 support bits (from Ilya Zakharevich) + Branch: perl + ! hints/os2.sh makedef.pl os2/Makefile.SHs t/lib/glob-basic.t +____________________________________________________________________________ +[ 4392] By: jhi on 1999/10/15 10:28:09 + Log: Integrate with Sarathy. + Branch: cfgperl + !> Changes MANIFEST Makefile.SH Porting/makerel lib/Pod/Man.pm + !> lib/Pod/Parser.pm op.c pod/perldelta.pod pod/perlopentut.pod + !> win32/Makefile win32/makefile.mk + +---------------- +Version 5.005_62 +---------------- + +____________________________________________________________________________ +[ 4391] By: gsar on 1999/10/15 10:12:42 + Log: here be 5.005_62 + Branch: perl + ! Changes MANIFEST Porting/makerel +____________________________________________________________________________ +[ 4390] By: gsar on 1999/10/15 09:45:51 + Log: lvalue subs patch (change#4081) breaks C<\(Foo->Bar())>; + avoid tickling it in Pod::Man for now; other nits in + Pod::* + Branch: perl + ! lib/Pod/Man.pm lib/Pod/Parser.pm pod/perldelta.pod + ! pod/perlopentut.pod +____________________________________________________________________________ +[ 4389] By: gsar on 1999/10/15 08:55:01 + Log: disable internal globbing for miniperl (or build breaks out + in a rash of failed dependencies) + Branch: perl + ! Makefile.SH op.c win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 4388] By: jhi on 1999/10/15 08:07:49 + Log: Integrate with Sarathy. + Branch: cfgperl + !> Changes ext/POSIX/POSIX.xs lib/Benchmark.pm pod/perldelta.pod + !> pod/perlfaq2.pod win32/include/dirent.h win32/win32.c +____________________________________________________________________________ +[ 4387] By: gsar on 1999/10/15 07:46:24 + Log: integrate cfgperl contents into mainline + Branch: perl + ! Changes + !> pod/perldelta.pod pod/perldiag.pod regcomp.c + !> t/pragma/warn/regcomp +____________________________________________________________________________ +[ 4386] By: gsar on 1999/10/15 05:45:36 + Log: various little goofs in change#4385 + Branch: perl + ! win32/include/dirent.h win32/win32.c +____________________________________________________________________________ +[ 4385] By: gsar on 1999/10/15 04:49:09 + Log: win32_*dir() cleanup; win32_readdir() iterates as necessary + rather than win32_opendir() reading all files up front (untested) + Branch: perl + ! win32/include/dirent.h win32/win32.c +____________________________________________________________________________ +[ 4384] By: gsar on 1999/10/15 01:34:09 + Log: Benchmark notes (from Barrie Slaymaker ) + Branch: perl + ! lib/Benchmark.pm pod/perldelta.pod +____________________________________________________________________________ +[ 4383] By: gsar on 1999/10/15 01:22:32 + Log: include info about Perl Mongers in perlfaq2 (from David H. Adler + ) + Branch: perl + ! pod/perlfaq2.pod +____________________________________________________________________________ +[ 4382] By: gsar on 1999/10/15 01:14:22 + Log: From: jand@ActiveState.com (Jan Dubois) + Date: Fri, 15 Oct 1999 01:14:23 +0200 + Message-ID: <380f61ae.18202914@smtprelay.t-online.de> + Subject: [PATCH 5.005_61] Prevent "Out of memory" error in POSIX's strftime() + Branch: perl + ! ext/POSIX/POSIX.xs +____________________________________________________________________________ +[ 4381] By: jhi on 1999/10/14 22:11:36 + Log: Integrate with Sarathy. + Branch: cfgperl + !> XSUB.h cop.h embed.h embed.pl ext/File/Glob/bsd_glob.c + !> lib/Time/Local.pm perl.c perlapi.c pod/perlop.pod pp_ctl.c + !> proto.h scope.c scope.h t/op/runlevel.t util.c win32/Makefile + !> win32/makefile.mk +____________________________________________________________________________ +[ 4380] By: jhi on 1999/10/14 22:08:22 + Log: Warn inside character classes about unknown backslash escapes + (that are not caught earlier because of being completely unknown, + such as \m), such as \z (because they make do sense inside regexen, + but not inside character classes). + Branch: cfgperl + ! pod/perldelta.pod pod/perldiag.pod regcomp.c + ! t/pragma/warn/regcomp +____________________________________________________________________________ +[ 4379] By: gsar on 1999/10/14 18:26:56 + Log: clarify significance of parens for "x" (from M.J.T. Guy + ) + Branch: perl + ! pod/perlop.pod +____________________________________________________________________________ +[ 4378] By: gsar on 1999/10/14 18:25:20 + Log: make timelocal work better when time is close to the epoch + east of GMT (from Keiki SATOH ) + Branch: perl + ! lib/Time/Local.pm +____________________________________________________________________________ +[ 4377] By: gsar on 1999/10/14 18:15:11 + Log: integrate cfgperl contents into mainline + Branch: perl + +> ext/DB_File/hints/sco.pl + !> MANIFEST hints/aix.sh hints/linux.sh hints/svr5.sh + !> pod/perldelta.pod pod/perldiag.pod pod/perlop.pod + !> pod/perlre.pod regcomp.c t/op/re_tests t/pragma/warn/regcomp +____________________________________________________________________________ +[ 4376] By: gsar on 1999/10/14 17:47:35 + Log: fix POPSTACK panics that ensued from bad interaction between + runlevels and stack of stacks (change#3988 done right); + basically, we pop the runlevel if the stacklevel is not the + same one we started the runlevel with + Branch: perl + ! cop.h perl.c pp_ctl.c t/op/runlevel.t util.c +____________________________________________________________________________ +[ 4375] By: gsar on 1999/10/14 15:54:48 + Log: avoid warnings + Branch: perl + ! ext/File/Glob/bsd_glob.c +____________________________________________________________________________ +[ 4374] By: jhi on 1999/10/14 10:08:44 + Log: Warn about false ranges like \d-\w (see the change #4355). + The invalid ranges (b-a) warning message also enhanced. + Branch: cfgperl + ! pod/perldelta.pod pod/perldiag.pod regcomp.c t/op/re_tests + ! t/pragma/warn/regcomp +____________________________________________________________________________ +[ 4373] By: gsar on 1999/10/14 03:49:54 + Log: File::Glob fixes for Windows + Branch: perl + ! XSUB.h ext/File/Glob/bsd_glob.c win32/Makefile + ! win32/makefile.mk +____________________________________________________________________________ +[ 4372] By: gsar on 1999/10/14 02:21:31 + Log: avoid inefficiency in change#3386 (every longjmp() was followed + by an avoidable call to setjmp()) + Branch: perl + ! embed.h embed.pl perl.c perlapi.c pod/perldelta.pod pp_ctl.c + ! proto.h scope.c scope.h +____________________________________________________________________________ +[ 4371] By: jhi on 1999/10/13 21:17:17 + Log: Integrate with Sarathy. + Branch: cfgperl + !> op.c pod/perldelta.pod +____________________________________________________________________________ +[ 4370] By: gsar on 1999/10/13 18:08:45 + Log: misc tweaks + Branch: perl + ! op.c pod/perldelta.pod +____________________________________________________________________________ +[ 4369] By: jhi on 1999/10/13 16:18:58 + Log: Integrate with Sarathy. + Branch: cfgperl + !> pod/perldelta.pod pod/perldiag.pod pod/perlfunc.pod +____________________________________________________________________________ +[ 4368] By: gsar on 1999/10/13 16:14:16 + Log: pod nits from various perl porters + Branch: perl + ! pod/perldelta.pod pod/perldiag.pod pod/perlfunc.pod +____________________________________________________________________________ +[ 4367] By: jhi on 1999/10/13 12:10:30 + Log: From: Vlad Harchev + To: perl5-porters@perl.org + Subject: [ID 19991013.002] fix for 'perlop.pod' shipped with perl5.00503 + Date: Wed, 13 Oct 1999 15:48:59 +0500 (SAMST) + Message-Id: + Branch: cfgperl + ! pod/perlop.pod +____________________________________________________________________________ +[ 4366] By: gsar on 1999/10/13 08:11:11 + Log: typos and language goofs pointed out by Hugo van der Sanden + + Branch: perl + ! pod/perldelta.pod pod/perldiag.pod +____________________________________________________________________________ +[ 4365] By: jhi on 1999/10/13 07:27:44 + Log: Integrate with Sarathy. + Branch: cfgperl + +> ext/File/Glob/Changes ext/File/Glob/Glob.pm + +> ext/File/Glob/Glob.xs ext/File/Glob/Makefile.PL + +> ext/File/Glob/TODO ext/File/Glob/bsd_glob.c + +> ext/File/Glob/bsd_glob.h ext/NDBM_File/hints/sco.pl + +> t/lib/glob-basic.t t/lib/glob-global.t t/lib/glob-taint.t + !> Changes MANIFEST README.win32 ext/ODBM_File/hints/sco.pl + !> lib/perl5db.pl op.c pod/perldelta.pod pod/perlfaq8.pod + !> pod/perlfunc.pod pod/perlop.pod pod/perlport.pod t/op/glob.t + !> t/op/readdir.t t/op/taint.t t/pragma/overload.t util.c +____________________________________________________________________________ +[ 4364] By: gsar on 1999/10/13 07:06:04 + Log: debugger tweak (from M.J.T. Guy ) + Branch: perl + ! lib/perl5db.pl +____________________________________________________________________________ +[ 4363] By: jhi on 1999/10/13 07:03:43 + Log: From: Mike Hopkirk (hops) + To: perl5-porters@perl.org + Subject: [ID 19991012.002] Latest UnixWare7 (svr5.sh) hints file + Date: Tue, 12 Oct 1999 19:48:11 -0700 (PDT) + Message-Id: <199910130248.TAA14636@scoot.pdev.sco.com> + Branch: cfgperl + ! hints/svr5.sh +____________________________________________________________________________ +[ 4362] By: jhi on 1999/10/13 06:57:16 + Log: Add DB_File hint for SCO ODT. + From: hops@sco.com + To: perl5-porters@perl.org + Subject: [ID 19991012.004] Build patch for perl5.005_03 on ODT3 ( 3.2v4.2) + Date: Tue, 12 Oct 1999 20:16:04 PDT + Message-Id: <199910122016.aa18415@charmstr.pdev.sco.com> + Branch: cfgperl + + ext/DB_File/hints/sco.pl + ! MANIFEST +____________________________________________________________________________ +[ 4361] By: gsar on 1999/10/13 06:56:08 + Log: PL_numeric_radix used without being defined (from Ilya + Zakharevich) + Branch: perl + ! util.c +____________________________________________________________________________ +[ 4360] By: gsar on 1999/10/13 06:43:03 + Log: use libdbm.nfs.a if available (libdbm.a is missing dbmclose()) + From: hops@sco.com + Date: Tue, 12 Oct 1999 20:16:04 PDT + Message-Id: <199910122016.aa18415@charmstr.pdev.sco.com> + Subject: [ID 19991012.004] Build patch for perl5.005_03 on ODT3 ( 3.2v4.2) + Branch: perl + + ext/NDBM_File/hints/sco.pl + ! MANIFEST ext/ODBM_File/hints/sco.pl +____________________________________________________________________________ +[ 4359] By: gsar on 1999/10/13 06:34:53 + Log: various pod tweaks (from M.J.T. Guy ) + Branch: perl + ! README.win32 pod/perlfaq8.pod pod/perlfunc.pod pod/perlop.pod + ! pod/perlport.pod +____________________________________________________________________________ +[ 4358] By: gsar on 1999/10/12 19:10:27 + Log: perldelta updates + Branch: perl + ! pod/perldelta.pod +____________________________________________________________________________ +[ 4357] By: gsar on 1999/10/12 17:11:18 + Log: update perldelta for change#4356 + Branch: perl + ! Changes pod/perldelta.pod +____________________________________________________________________________ +[ 4356] By: gsar on 1999/10/12 16:53:31 + Log: add File::BSDGlob as File::Glob and load it at compile-time + if perl was built with -DPERL_INTERNAL_GLOB + + TODO: we currently get a compile-time failure if File/Glob.pm + can't be found; such failure needs to be made to emit a warning + and use the csh implementation instead + Branch: perl + + ext/File/Glob/Changes ext/File/Glob/Glob.pm + + ext/File/Glob/Glob.xs ext/File/Glob/Makefile.PL + + ext/File/Glob/TODO ext/File/Glob/bsd_glob.c + + ext/File/Glob/bsd_glob.h t/lib/glob-basic.t + + t/lib/glob-global.t t/lib/glob-taint.t + ! MANIFEST op.c t/op/glob.t t/op/readdir.t t/op/taint.t + ! t/pragma/overload.t +____________________________________________________________________________ +[ 4355] By: jhi on 1999/10/12 15:30:05 + Log: Revert the parts of #3926 that outlawed character ranges + that have character classes such as \w as either endpoint. + This change re-establishes the old behavior which meant that + such ranges weren't really ranges, the "-" was literal. + Moreover, this change also fixes the old behavior to be + more consistent: [\w-.] and [\s-\w] worked, but [.-\w] didn't. + Now they all do work as described above. The #3926 outlawed + all of those. + Branch: cfgperl + ! pod/perldiag.pod pod/perlre.pod regcomp.c t/op/re_tests +____________________________________________________________________________ +[ 4354] By: jhi on 1999/10/12 09:58:59 + Log: Integrate with Sarathy. + Branch: cfgperl + !> (integrate 33 files) +____________________________________________________________________________ +[ 4353] By: gsar on 1999/10/12 05:53:40 + Log: apply parts of LynxOS patches from Alan Johnson + + Branch: perl + ! Changes hints/lynxos.sh pod/perldelta.pod t/lib/safe2.t + ! t/op/groups.t +____________________________________________________________________________ +[ 4352] By: gsar on 1999/10/12 05:24:39 + Log: allow any unpack specifier to take a count via '/' + (from Ilya Zakharevich) + Branch: perl + ! pp.c t/op/pack.t +____________________________________________________________________________ +[ 4351] By: gsar on 1999/10/12 05:02:35 + Log: avoid warnings + Branch: perl + ! malloc.c +____________________________________________________________________________ +[ 4350] By: gsar on 1999/10/12 04:50:52 + Log: various cleanups + Branch: perl + ! ext/Devel/DProf/DProf.xs op.c perl.c perly.c perly.y + ! perly_c.diff pp_hot.c toke.c vms/perly_c.vms win32/config.bc + ! win32/config.gc win32/config.vc win32/config_H.bc + ! win32/config_H.gc win32/config_H.vc win32/config_sh.PL +____________________________________________________________________________ +[ 4349] By: gsar on 1999/10/12 00:23:11 + Log: update Changes, patchlevel etc. + Branch: perl + ! Changes Porting/findvars patchlevel.h win32/Makefile + ! win32/config_H.bc win32/config_H.gc win32/config_H.vc + ! win32/makefile.mk +____________________________________________________________________________ +[ 4348] By: gsar on 1999/10/11 23:11:57 + Log: add vec() example from Chaim Frenkel + Branch: perl + ! pod/perlfunc.pod +____________________________________________________________________________ +[ 4347] By: jhi on 1999/10/11 21:25:03 + Log: Sparc Linux -Duseshrplib fix. + + From: Brian Jepson + To: Nick Ing-Simmons + cc: perl5-porters@perl.org + Subject: Re: [ID 19990813.002] Can't build Perl 5.005_60 on SPARC/Linux with -Duseshrplib + Date: Fri, 20 Aug 1999 11:25:17 -0500 (EST) + Message-ID: + Branch: cfgperl + ! hints/linux.sh +____________________________________________________________________________ +[ 4346] By: gsar on 1999/10/11 20:28:32 + Log: more pack/unpack documentation (from Ilya Zakharevich); changed + the behavior of 'Z*' and 'Z3' to always pack a trailing + null byte; changed documentation to suit; added test + Branch: perl + ! pod/perlfunc.pod pp.c t/op/pack.t +____________________________________________________________________________ +[ 4345] By: gsar on 1999/10/11 19:15:46 + Log: writing to perllocal.pod fails if it was never created; + tweak pseudo-hash example (both suggested by Michael G Schwern + ) + Branch: perl + ! lib/ExtUtils/MM_Unix.pm pod/perlref.pod +____________________________________________________________________________ +[ 4344] By: gsar on 1999/10/11 17:57:31 + Log: slightly edited variant of suggested patch + From: Ilya Zakharevich + Date: Thu, 9 Sep 1999 18:35:37 -0400 + Message-ID: <19990909183537.A28682@monk.mps.ohio-state.edu> + Subject: [PATCH 5.005_58] How RExen match? + Branch: perl + ! pod/perlre.pod +____________________________________________________________________________ +[ 4343] By: gsar on 1999/10/11 16:55:48 + Log: change#4327 was inefficient + Branch: perl + ! lib/lib.pm +____________________________________________________________________________ +[ 4342] By: jhi on 1999/10/11 07:01:46 + Log: Integrate with Sarathy. + Branch: cfgperl + +> pod/perlhack.pod + !> (integrate 28 files) +____________________________________________________________________________ +[ 4341] By: jhi on 1999/10/11 06:37:47 + Log: The 2.5th cut at the AIX C++ extension problems. + Branch: cfgperl + ! hints/aix.sh +____________________________________________________________________________ +[ 4340] By: gsar on 1999/10/10 23:48:07 + Log: add perlhack.pod from Nathan Torkington + Branch: perl + + pod/perlhack.pod + ! MANIFEST pod/Makefile pod/perl.pod pod/roffitall +____________________________________________________________________________ +[ 4339] By: gsar on 1999/10/10 20:42:40 + Log: revert SAVEDESTRUCTOR() to accepting void(*)(void*) for source + compatibility; introduce SAVEDESTRUCTOR_X() that accepts + void(*)(pTHX_ void*) + Branch: perl + ! embed.h embed.pl ext/Devel/DProf/DProf.xs global.sym mg.c + ! objXSUB.h perl.h perlapi.c perly.c perly.y perly_c.diff + ! pod/perlguts.pod pod/perltoc.pod pp.c pp_hot.c proto.h + ! regcomp.h regexec.c scope.c scope.h toke.c vms/perly_c.vms +____________________________________________________________________________ +[ 4338] By: gsar on 1999/10/10 20:38:59 + Log: add missing new diagnostics to perldelta + Branch: perl + ! pod/perldelta.pod +____________________________________________________________________________ +[ 4337] By: gsar on 1999/10/10 17:40:13 + Log: update perldelta for change#3406 + Branch: perl + ! embed.pl pod/perldata.pod pod/perldelta.pod +____________________________________________________________________________ +[ 4336] By: gsar on 1999/10/10 16:33:14 + Log: integrate cfgperl contents into mainline + Branch: perl + +> ext/DynaLoader/hints/aix.pl + !> MANIFEST ext/DynaLoader/dl_aix.xs hints/aix.sh hints/irix_6.sh + !> makedef.pl perl.h pod/perldelta.pod +____________________________________________________________________________ +[ 4335] By: jhi on 1999/10/10 11:09:48 + Log: Update perldelta. + Branch: cfgperl + ! pod/perldelta.pod +____________________________________________________________________________ +[ 4334] By: jhi on 1999/10/10 10:31:46 + Log: Integrate with Sarathy. + Branch: cfgperl + +> win32/genmk95.pl + !> Changes MANIFEST README.win32 cop.h ext/Thread/Thread.pm + !> ext/Thread/Thread.xs ext/Thread/Thread/Queue.pm + !> ext/Thread/Thread/Semaphore.pm ext/Thread/Thread/Specific.pm + !> ext/Thread/sync.t ext/Thread/sync2.t installperl + !> lib/Exporter.pm lib/ExtUtils/MM_Unix.pm + !> lib/ExtUtils/MM_Win32.pm lib/diagnostics.pm lib/lib.pm perl.c + !> pod/perldelta.pod pod/perlfunc.pod pp_ctl.c pp_hot.c pp_sys.c + !> utils/perldoc.PL win32/makefile.mk +____________________________________________________________________________ +[ 4333] By: gsar on 1999/10/10 06:33:15 + Log: install pods to 'pods' rather than 'pod' on cygwin (modified + a patch suggested by cwilson@cc865179-c.chmbl1.ga.home.com) + Branch: perl + ! installperl lib/diagnostics.pm utils/perldoc.PL +____________________________________________________________________________ +[ 4332] By: gsar on 1999/10/10 05:15:26 + Log: add $VERSION + Branch: perl + ! lib/Exporter.pm +____________________________________________________________________________ +[ 4331] By: gsar on 1999/10/10 05:10:22 + Log: describe what can go in an export list (from Anno Siegel + ) + Branch: perl + ! lib/Exporter.pm +____________________________________________________________________________ +[ 4330] By: gsar on 1999/10/10 04:50:43 + Log: more basic support for building modules under Windows 95/98 + (applied relevant parts from a patch suggested by + Jochen Wiedmann ) + Branch: perl + ! lib/ExtUtils/MM_Unix.pm +____________________________________________________________________________ +[ 4329] By: gsar on 1999/10/10 04:28:38 + Log: rudimentary support for building under Windows 95/98 (from + Benjamin Stuhl ) + Branch: perl + + win32/genmk95.pl + ! MANIFEST README.win32 lib/ExtUtils/MM_Win32.pm + ! win32/makefile.mk +____________________________________________________________________________ +[ 4328] By: gsar on 1999/10/10 03:37:21 + Log: fix two leaks in Thread.xs (from Eugene Alterman + ); convert places with + 'use attrs' to new attributes syntax + Branch: perl + ! ext/Thread/Thread.pm ext/Thread/Thread.xs + ! ext/Thread/Thread/Queue.pm ext/Thread/Thread/Semaphore.pm + ! ext/Thread/Thread/Specific.pm ext/Thread/sync.t + ! ext/Thread/sync2.t +____________________________________________________________________________ +[ 4327] By: gsar on 1999/10/10 02:23:52 + Log: avoid duplicates in @INC, they cause leaks in mod_perl etc + (suggested by Tod Irwin ) + Branch: perl + ! lib/lib.pm +____________________________________________________________________________ +[ 4326] By: gsar on 1999/10/10 00:51:48 + Log: better documentation for recv() (from Anton Berezin + ) + Branch: perl + ! pod/perlfunc.pod +____________________________________________________________________________ +[ 4325] By: gsar on 1999/10/09 22:46:23 + Log: perldelta updates (see TODO markers) + Branch: perl + ! Changes pod/perldelta.pod pp_sys.c +____________________________________________________________________________ +[ 4324] By: gsar on 1999/10/09 19:43:10 + Log: fix Exporter::export_to_level() documentation + Branch: perl + ! lib/Exporter.pm +____________________________________________________________________________ +[ 4323] By: gsar on 1999/10/09 18:48:31 + Log: don't run END blocks when running under -c switch (older, + rarely useful behavior may still be obtained by putting + BEGIN { $^C = 0; exit; } at the end of the script) + Branch: perl + ! perl.c +____________________________________________________________________________ +[ 4322] By: jhi on 1999/10/09 05:31:26 + Log: While awaiting a good test program to detect the broken gcc. + From: Thomas Conté + To: + Cc: + Subject: Re: [ID 19990825.007] test t/lib/ipc_sysv.t failing under irix 6.4 + Date: Wed, 6 Oct 1999 19:56:29 +0200 + Message-ID: <000a01bf1024$1d938f20$252ad0d4@eng.iway.fr> + Branch: cfgperl + ! hints/irix_6.sh perl.h +____________________________________________________________________________ +[ 4321] By: gsar on 1999/10/09 00:41:02 + Log: POPSUB() gave up the refcount to the CV before LEAVE had a chance to + clear entries in the CV's pad, leading to coredumps when CV had no + other references to it; this is a slightly edited version of the + patch suggested by Russel O'Connor + Branch: perl + ! cop.h pp_ctl.c pp_hot.c +____________________________________________________________________________ +[ 4320] By: gsar on 1999/10/08 22:50:51 + Log: revert POP{SUB,LOOP}{1,2} logic to the simpler pre-5.003_24 + situation (assumptions about cx invalidation are not valid + anymore) + Branch: perl + ! cop.h pp_ctl.c pp_hot.c +____________________________________________________________________________ +[ 4319] By: jhi on 1999/10/08 14:33:31 + Log: Integrate with Sarathy. + Branch: cfgperl + !> cop.h ext/Thread/Thread.xs op.c opcode.h perl.c perl.h perly.c + !> perly.y pod/perldiag.pod pod/perlfunc.pod pp_ctl.c pp_sys.c + !> t/comp/bproto.t thrdvar.h toke.c util.c +____________________________________________________________________________ +[ 4318] By: jhi on 1999/10/08 13:51:34 + Log: The second cut at AIX C++ extension troubles. + Branch: cfgperl + ! ext/DynaLoader/dl_aix.xs ext/DynaLoader/hints/aix.pl + ! hints/aix.sh +____________________________________________________________________________ +[ 4317] By: jhi on 1999/10/08 10:44:13 + Log: The first cut at fixing Perl extensions written in C++ in AIX, + statics don't get initialized right. This patch at least + doesn't seem to break the build in my AIX, but unfortunately + I don't have the IBM C++ to do further testing. + + Problem reported by Stephanie Beals in + From: bealzy@us.ibm.com + To: perl5-porters@perl.org + Subject: [ID 19991007.005] DynaLoader/dl_aix.xs problem using load and unload on AIX + Date: Thu, 7 Oct 1999 15:05:54 -0400 + Message-Id: <85256803.0068E70D.00@D51MTA03.pok.ibm.com> + Branch: cfgperl + + ext/DynaLoader/hints/aix.pl + ! MANIFEST ext/DynaLoader/dl_aix.xs hints/aix.sh +____________________________________________________________________________ +[ 4316] By: gsar on 1999/10/08 10:26:15 + Log: remove kludgey duplicate background error avoidance (caused + "leaks"; %@ wasn't even user-visible under -Dusethreads); + only repeats of most recent error are now avoided + Branch: perl + ! ext/Thread/Thread.xs perl.c perl.h pp_ctl.c thrdvar.h util.c +____________________________________________________________________________ +[ 4315] By: jhi on 1999/10/08 09:48:59 + Log: Fix omission. + Branch: cfgperl + ! makedef.pl +____________________________________________________________________________ +[ 4314] By: gsar on 1999/10/08 07:17:01 + Log: extend change#2299 to C (fixes scoping problems in + C) + Branch: perl + ! op.c +____________________________________________________________________________ +[ 4313] By: gsar on 1999/10/08 04:52:19 + Log: small tweak for change#4309 + Branch: perl + ! op.c +____________________________________________________________________________ +[ 4312] By: gsar on 1999/10/08 02:31:13 + Log: add suggested patch =~ s/NOTOP/OP_NOT/ with tests + From: Larry Wall + Date: Wed, 6 Oct 1999 09:55:57 -0700 (PDT) + Message-Id: <199910061655.JAA11333@kiev.wall.org> + Subject: Re: [ID 19991001.004] apparent parsing error with not(arg) + Branch: perl + ! opcode.h t/comp/bproto.t toke.c +____________________________________________________________________________ +[ 4311] By: gsar on 1999/10/08 00:58:19 + Log: typo + Branch: perl + ! pp_sys.c +____________________________________________________________________________ +[ 4310] By: gsar on 1999/10/07 23:51:38 + Log: fix setpgrp vs getpgrp and POSIX vs BSD confusion (spotted by + Brian Mitchell ) + Branch: perl + ! pod/perldiag.pod pod/perlfunc.pod pp_sys.c +____________________________________________________________________________ +[ 4309] By: gsar on 1999/10/07 22:57:52 + Log: change#3728 was flawed (loop contexts saw the wrong statement + info, causing loop control constructs to not find the label); + disable OP_SETSTATE entirely and add a fix that is specifically + targetted at disabling the OP_LINESEQ optimization in else BLOCK, + which was what the original patch was supposed to fix + + TODO: remove the remainder of the setstate logic if it can't + be used anywhere else (it isn't used anywhere now) + Branch: perl + ! cop.h op.c perly.c perly.y +____________________________________________________________________________ +[ 4308] By: jhi on 1999/10/07 19:21:27 + Log: Integrate with Sarathy. + Branch: cfgperl + !> lib/Pod/Man.pm lib/Pod/Text.pm pod/pod2man.PL +____________________________________________________________________________ +[ 4307] By: gsar on 1999/10/07 15:12:24 + Log: update to podlators-0.08 from Russ Allbery + Branch: perl + ! lib/Pod/Man.pm lib/Pod/Text.pm pod/pod2man.PL +____________________________________________________________________________ +[ 4306] By: jhi on 1999/10/06 17:20:34 + Log: Integrate with Sarathy. + Branch: cfgperl + !> (integrate 45 files) +____________________________________________________________________________ +[ 4305] By: gsar on 1999/10/06 16:55:45 + Log: some versions of mingw32 have __int64, define iff it isn't + Branch: perl + ! win32/win32.h +____________________________________________________________________________ +[ 4304] By: gsar on 1999/10/06 03:45:44 + Log: fix typos in change#4288 + Branch: perl + ! Changes dump.c sv.c +____________________________________________________________________________ +[ 4303] By: gsar on 1999/10/06 03:22:46 + Log: integrate cfgperl contents into mainline + Branch: perl + +> eg/cgi/dna_small_gif.uu eg/cgi/wilogo_gif.uu + - eg/cgi/dna.small.gif.uu eg/cgi/wilogo.gif.uu + !> (integrate 31 files) +____________________________________________________________________________ +[ 4302] By: gsar on 1999/10/06 02:36:53 + Log: make die/warn and other diagnostics go to wherever STDERR happens + to point at; change places that meant Perl_debug_log rather than + PerlIO_stderr() + Branch: perl + ! cop.h doio.c embedvar.h ext/Devel/Peek/Peek.xs + ! ext/DynaLoader/dl_aix.xs ext/DynaLoader/dl_beos.xs + ! ext/DynaLoader/dl_cygwin.xs ext/DynaLoader/dl_dld.xs + ! ext/DynaLoader/dl_dlopen.xs ext/DynaLoader/dl_hpux.xs + ! ext/DynaLoader/dl_mpeix.xs ext/DynaLoader/dl_next.xs + ! ext/DynaLoader/dl_rhapsody.xs ext/DynaLoader/dl_vmesa.xs + ! ext/DynaLoader/dl_vms.xs ext/DynaLoader/dlutils.c + ! ext/Thread/Thread.xs ext/Thread/typemap intrpvar.h malloc.c + ! mg.c objXSUB.h op.c perl.c perl.h perlio.c pp.c pp_ctl.c + ! pp_hot.c regexec.c scope.c scope.h sv.c thread.h toke.c util.c + ! win32/dl_win32.xs win32/win32.c win32/win32thread.c +____________________________________________________________________________ +[ 4301] By: jhi on 1999/10/05 23:03:46 + Log: From: Ilya Zakharevich + To: François Désarménien + Cc: "perl5-porters@perl.org" + Subject: Re: Strange RE engine breakage in 5_61 + Date: Mon, 4 Oct 1999 19:58:03 -0400 + Message-ID: <19991004195803.A21760@monk.mps.ohio-state.edu> + + (had to apply pat.t part manually because there + already were more tests than there was in _61) + Branch: cfgperl + ! regcomp.c regexec.c t/op/pat.t t/op/re_tests +____________________________________________________________________________ +[ 4300] By: jhi on 1999/10/04 17:03:18 + Log: From: Andy Dougherty + To: Jarkko Hietaniemi + cc: Perl Porters , jhi@cc.hut.fi + Subject: Re: [ID 19991001.005] [_61] [PATCH] tarball fine on win32, zip isn't + Date: Mon, 4 Oct 1999 13:05:08 -0400 (EDT) + Message-ID: + Branch: cfgperl + + eg/cgi/dna_small_gif.uu eg/cgi/wilogo_gif.uu + - eg/cgi/dna.small.gif.uu eg/cgi/wilogo.gif.uu + ! MANIFEST ext/B/defsubs_h.PL +____________________________________________________________________________ +[ 4299] By: jhi on 1999/10/04 07:15:16 + Log: From: Michael G Schwern + To: perl5-porters@perl.org + Subject: Re: [PATCH av.c, op.c, perldiag.pod] "array field" -> "pseudo-hash field" + Date: Sun, 3 Oct 1999 17:34:17 -0400 + Message-ID: <19991003173417.A4351@blackrider> + Branch: cfgperl + ! t/lib/fields.t t/pragma/constant.t +____________________________________________________________________________ +[ 4298] By: gsar on 1999/10/04 04:57:53 + Log: some compatibility macros were busted + Branch: perl + ! embed.h embed.pl toke.c +____________________________________________________________________________ +[ 4297] By: jhi on 1999/10/03 17:50:59 + Log: A better version of #4296. + + From: Michael G Schwern + To: perl5-porters@perl.org + Subject: [PATCH av.c, op.c, perldiag.pod] "array field" -> "pseudo-hash field" + Date: Sun, 3 Oct 1999 13:54:23 -0400 + Message-ID: <19991003135423.A3050@blackrider> + Branch: cfgperl + ! av.c op.c pod/perldiag.pod +____________________________________________________________________________ +[ 4296] By: jhi on 1999/10/03 17:21:01 + Log: (Replaced by #4297.) + + From: Michael G Schwern + To: perl5-porters@perl.org + Subject: [PATCH av.c, perldiag.pod] Added field name to "No such array field" + Date: Sun, 3 Oct 1999 13:16:47 -0400 + Message-ID: <19991003131647.A2816@blackrider> + + plus changed the error message to say "No such pseudo-hash field" + as discussed in the above mail message. + Branch: cfgperl + ! av.c pod/perldiag.pod +____________________________________________________________________________ +[ 4295] By: gsar on 1999/10/03 16:09:36 + Log: avoid doing irrelevant things on 'make perl' + Branch: perl + ! Makefile.SH +____________________________________________________________________________ +[ 4294] By: jhi on 1999/10/03 14:16:24 + Log: Fix a typo in #4293 spotted by Graham Barr. + Branch: cfgperl + ! pod/perlref.pod +____________________________________________________________________________ +[ 4293] By: jhi on 1999/10/03 11:31:22 + Log: From: Michael G Schwern + To: perl5-porters@perl.org + Subject: Re: Should keys in pseudo-hashes -always- exist? [DOC PATCH] + Date: Sun, 3 Oct 1999 02:34:01 -0400 + Message-ID: <19991003023401.A1520@blackrider> + Branch: cfgperl + ! pod/perlfunc.pod pod/perlref.pod +____________________________________________________________________________ +[ 4292] By: jhi on 1999/10/03 09:23:16 + Log: From: Barrie Slaymaker + To: perl5-porters@perl.org + Subject: [PATCH 5.005_61] Benchmark.pm bugfix, tweaks + Date: Sun, 3 Oct 1999 00:09:51 -0400 + Message-Id: <199910030409.AAA18228@jester.slaysys.com> + Branch: cfgperl + ! lib/Benchmark.pm +____________________________________________________________________________ +[ 4291] By: jhi on 1999/10/02 23:43:53 + Log: Be understanding about large file systems. + Branch: cfgperl + ! t/lib/syslfs.t t/op/lfs.t +____________________________________________________________________________ +[ 4290] By: jhi on 1999/10/02 23:39:16 + Log: Configure fixfest continues. + Branch: cfgperl + ! Configure config_h.SH + Branch: metaconfig + ! U/modified/d_longdbl.U U/modified/d_longlong.U + ! U/threads/d_pthreadj.U U/typedefs/gidsign.U + ! U/typedefs/gidsize.U U/typedefs/pidsign.U U/typedefs/pidsize.U + ! U/typedefs/uidsign.U U/typedefs/uidsize.U + Branch: metaconfig/U/perl + ! i_inttypes.U io64.U +____________________________________________________________________________ +[ 4289] By: jhi on 1999/10/02 23:12:54 + Log: Regen Porting stuff. + Branch: cfgperl + ! Porting/Glossary Porting/config.sh Porting/config_H +____________________________________________________________________________ +[ 4288] By: jhi on 1999/10/02 23:05:50 + Log: Untangle the IV_IS_QUAD jungle by introduding + macros to be used when doing formatted printing: + IVdf, UVuf, UVxf, UVof. Also introduce Uid_t_SIGN. + Branch: cfgperl + ! Configure Porting/Glossary Porting/config.sh Porting/config_H + ! config_h.SH doio.c dump.c op.c perl.h pp_hot.c pp_sys.c + ! regcomp.c sv.c taint.c toke.c util.c +____________________________________________________________________________ +[ 4287] By: jhi on 1999/10/02 22:54:18 + Log: metaconfig maintenance. + Branch: metaconfig + ! U/ebcdic/ebcdic.U U/typedefs/gidsign.U U/typedefs/gidsize.U + ! U/typedefs/pidsign.U U/typedefs/pidsize.U U/typedefs/uidsign.U + ! U/typedefs/uidsize.U +____________________________________________________________________________ +[ 4286] By: nick on 1999/10/02 11:11:44 + Log: Incremental merge of mainline + Branch: utfperl + +> README.Y2K hints/svr5.sh lib/Pod/Man.pm + +> lib/unicode/Unicode.html t/op/args.t t/pod/multiline_items.t + +> t/pod/multiline_items.xr t/pod/pod2usage.t t/pod/pod2usage.xr + +> t/pod/podselect.t t/pod/podselect.xr + - lib/Pod/PlainText.pm + !> (integrate 148 files) +____________________________________________________________________________ +[ 4285] By: jhi on 1999/10/02 10:16:15 + Log: Battle namespace pollution. + Branch: cfgperl + ! lib/Benchmark.pm +____________________________________________________________________________ +[ 4284] By: jhi on 1999/10/02 10:11:20 + Log: Regen Configure, all of xs_apiversion didn't take. + Branch: cfgperl + ! Configure Porting/Glossary Porting/config.sh Porting/config_H + ! config_h.SH patchlevel.h +____________________________________________________________________________ +[ 4283] By: jhi on 1999/10/02 09:48:17 + Log: Integrate with Sarathy. + Branch: cfgperl + +> lib/Pod/Man.pm t/pod/multiline_items.t + +> t/pod/multiline_items.xr t/pod/pod2usage.t t/pod/pod2usage.xr + +> t/pod/podselect.t t/pod/podselect.xr + - lib/Pod/PlainText.pm + !> (integrate 50 files) +____________________________________________________________________________ +[ 4282] By: gsar on 1999/10/02 06:39:14 + Log: update pod2man, pod2text and related Pod:: modules with the + ones in podlators-0.07 from Russ Allbery + Branch: perl + + lib/Pod/Man.pm + ! lib/Pod/Text.pm lib/Pod/Text/Color.pm lib/Pod/Text/Termcap.pm + ! pod/pod2man.PL pod/pod2text.PL +____________________________________________________________________________ +[ 4281] By: gsar on 1999/10/02 06:14:44 + Log: fix PodParser testsuite; Pod::Text subsumes Pod::PlainText + Branch: perl + - lib/Pod/PlainText.pm + ! MANIFEST lib/Pod/Text.pm lib/Pod/Usage.pm pod/pod2usage.PL + ! pod/podchecker.PL pod/podselect.PL t/pod/emptycmd.t + ! t/pod/for.t t/pod/headings.t t/pod/include.t t/pod/included.t + ! t/pod/lref.t t/pod/multiline_items.t t/pod/nested_items.t + ! t/pod/nested_seqs.t t/pod/oneline_cmds.t t/pod/pod2usage.t + ! t/pod/poderrs.t t/pod/poderrs.xr t/pod/podselect.t + ! t/pod/special_seqs.t t/pod/testp2pt.pl t/pod/testpchk.pl +____________________________________________________________________________ +[ 4280] By: gsar on 1999/10/02 04:39:38 + Log: upgrade to PodParser-1.085 from Brad Appleton + Branch: perl + + t/pod/multiline_items.t t/pod/multiline_items.xr + + t/pod/pod2usage.t t/pod/pod2usage.xr t/pod/podselect.t + + t/pod/podselect.xr + ! MANIFEST lib/Pod/Checker.pm lib/Pod/InputObjects.pm + ! lib/Pod/Parser.pm lib/Pod/PlainText.pm lib/Pod/Select.pm + ! lib/Pod/Usage.pm t/pod/for.xr t/pod/headings.xr + ! t/pod/include.xr t/pod/included.xr t/pod/lref.xr + ! t/pod/nested_items.xr t/pod/nested_seqs.xr + ! t/pod/oneline_cmds.xr t/pod/poderrs.xr t/pod/special_seqs.xr + ! t/pod/testp2pt.pl +____________________________________________________________________________ +[ 4279] By: gsar on 1999/10/02 03:36:41 + Log: make exists() work better on pseudo-hashes (reworked a patch suggested + by Michael G Schwern ) + Branch: perl + ! av.c t/op/avhv.t +____________________________________________________________________________ +[ 4278] By: gsar on 1999/10/02 02:36:55 + Log: deprecate C + Branch: perl + ! ext/attrs/attrs.pm ext/attrs/attrs.xs t/lib/attrs.t + ! t/lib/thread.t t/pragma/sub_lval.t +____________________________________________________________________________ +[ 4277] By: gsar on 1999/10/02 01:43:25 + Log: add notes about effect of loop control statements inside + LABEL BLOCK continue BLOCK + Branch: perl + ! pod/perlfunc.pod +____________________________________________________________________________ +[ 4276] By: gsar on 1999/10/02 01:23:02 + Log: indent nested =items properly (suggested by Bill Fenner + ) + Branch: perl + ! pod/pod2man.PL +____________________________________________________________________________ +[ 4275] By: gsar on 1999/10/02 01:09:16 + Log: updated ptags generator from Ilya Zakharevich + Branch: perl + ! emacs/ptags +____________________________________________________________________________ +[ 4274] By: gsar on 1999/10/01 23:08:52 + Log: update Changes + Branch: perl + ! Changes +____________________________________________________________________________ +[ 4273] By: gsar on 1999/10/01 22:58:55 + Log: typo, whitespace adjustments + Branch: perl + ! utils/h2xs.PL +____________________________________________________________________________ +[ 4272] By: gsar on 1999/10/01 22:46:06 + Log: remove dup hunks + Branch: perl + ! configure.com vms/vms.c +____________________________________________________________________________ +[ 4271] By: gsar on 1999/10/01 22:33:02 + Log: integrate cfgperl contents into mainline; resolve h2xs.PL conflict + by declaring new globals "our" (XXX this means h2xs generated code + won't run on earlier versions; a switch to generate compatible + source is needed) + Branch: perl + !> (integrate 35 files) +____________________________________________________________________________ +[ 4270] By: jhi on 1999/10/01 12:05:56 + Log: Integrate with Sarathy. + Branch: cfgperl + !> ext/B/B/C.pm lib/ExtUtils/typemap lib/ExtUtils/xsubpp + !> pod/perldiag.pod util.c +____________________________________________________________________________ +[ 4269] By: jhi on 1999/10/01 10:26:19 + Log: From: Piotr Klaban + To: perl5-porters@perl.org + Subject: [ID 19991001.001] perlguts man page error + Date: Fri, 1 Oct 1999 10:23:49 +0200 (MET DST) + Message-Id: <199910010823.KAA05796@oryl.man.torun.pl> + Branch: cfgperl + ! pod/perlguts.pod +____________________________________________________________________________ +[ 4268] By: jhi on 1999/10/01 07:32:33 + Log: There *is* a month called October. + Branch: cfgperl + ! t/op/time.t +____________________________________________________________________________ +[ 4267] By: jhi on 1999/10/01 06:58:10 + Log: Temp file cleanliness. + Branch: cfgperl + ! t/lib/filecopy.t +____________________________________________________________________________ +[ 4266] By: jhi on 1999/10/01 06:46:56 + Log: From: Barrie Slaymaker + To: perl5-porters@perl.org + Subject: [PATCH 5.005_61] Benchmark.pm: Export countit(), cmpthese() by default + Date: Thu, 30 Sep 1999 22:16:26 -0400 + Message-Id: <199910010216.WAA08309@jester.slaysys.com> + Branch: cfgperl + ! lib/Benchmark.pm +____________________________________________________________________________ +[ 4265] By: jhi on 1999/09/30 20:25:35 + Log: From: Barrie Slaymaker + To: perl5-porters@perl.org + Subject: [PATCH 5.005_61] Benchmark tweaks, fixes, cmpthese() + Date: Thu, 30 Sep 1999 15:44:00 -0400 + Message-Id: <199909301944.PAA07166@jester.slaysys.com> + (Replaces #4175.) + Branch: cfgperl + ! lib/Benchmark.pm +____________________________________________________________________________ +[ 4264] By: gsar on 1999/09/30 17:59:26 + Log: re-add missing "Out of memory!" entry + Branch: perl + ! pod/perldiag.pod +____________________________________________________________________________ +[ 4263] By: jhi on 1999/09/30 17:05:43 + Log: Regenerate Configure. + Branch: cfgperl + ! Configure Porting/Glossary Porting/config.sh Porting/config_H + ! config_h.SH +____________________________________________________________________________ +[ 4261] By: jhi on 1999/09/30 16:15:05 + Log: From: Andy Dougherty + To: Perl Porters + Subject: [PATCH 5.005_61] rand() advisory for perldelta.pod + Date: Thu, 30 Sep 1999 12:24:00 -0400 (EDT) + Message-ID: + Branch: cfgperl + ! pod/perldelta.pod +____________________________________________________________________________ +[ 4260] By: jhi on 1999/09/30 15:48:56 + Log: From: Andy Dougherty + To: Jarkko Hietaniemi , Gurusamy Sarathy + Subject: Re: Possible skeletal structure for searching multiple versions + Date: Thu, 30 Sep 1999 11:52:00 -0400 (EDT) + Message-ID: + Branch: metaconfig + ! U/mkglossary + Branch: metaconfig/U/perl + + xs_apiversion.U + ! patchlevel.U +____________________________________________________________________________ +[ 4259] By: jhi on 1999/09/30 15:07:16 + Log: Further ?idsize.U fixing. + Branch: metaconfig + ! U/typedefs/gidsize.U U/typedefs/pidsize.U U/typedefs/uidsize.U +____________________________________________________________________________ +[ 4258] By: jhi on 1999/09/30 15:00:14 + Log: Fix the ?idsi{gn,ze} units, from Andy Dougherty. + Branch: metaconfig + ! U/typedefs/gidsign.U U/typedefs/gidsize.U U/typedefs/pidsign.U + ! U/typedefs/pidsize.U U/typedefs/uidsign.U U/typedefs/uidsize.U +____________________________________________________________________________ +[ 4257] By: jhi on 1999/09/30 09:48:33 + Log: From: "Kurt D. Starsinic" + To: Gurusamy Sarathy + Cc: tchrist@perl.com, Larry Wall , + The Perl Porters Mailing List + Subject: [PATCH] (Was: deprecating SIGDIE) + Date: Wed, 29 Sep 1999 15:16:50 -0400 + Message-ID: <19990929151650.E26675@O2.chapin.edu> + Branch: cfgperl + ! Porting/findvars embedvar.h intrpvar.h mg.c objXSUB.h perl.c +____________________________________________________________________________ +[ 4256] By: jhi on 1999/09/30 09:45:22 + Log: From: Ilya Zakharevich + To: Gurusamy Sarathy + Cc: Barrie Slaymaker , perl5-porters@perl.org + Subject: Re: _58, _61 Argument "" is not numeric in sprintf + Date: Wed, 29 Sep 1999 18:58:23 -0400 + Message-ID: <19990929185823.A22099@monk.mps.ohio-state.edu> + Branch: cfgperl + ! Makefile.SH opcode.pl +____________________________________________________________________________ +[ 4255] By: gsar on 1999/09/30 09:03:48 + Log: remove prehistoric XFree() gunk + Branch: perl + ! lib/ExtUtils/typemap lib/ExtUtils/xsubpp +____________________________________________________________________________ +[ 4254] By: gsar on 1999/09/30 08:40:14 + Log: From: Vishal Bhatia + Date: Wed, 29 Sep 1999 23:27:28 +0900 (JST) + Message-ID: + Subject: [patch _61] Minor corrections in C.pm + Branch: perl + ! ext/B/B/C.pm +____________________________________________________________________________ +[ 4253] By: gsar on 1999/09/30 08:36:27 + Log: off-by-one in fbm_compile() (spotted by John Bley + ); whitespace adjustments + Branch: perl + ! util.c +____________________________________________________________________________ +[ 4251] By: jhi on 1999/09/30 08:09:13 + Log: From: Ilya Zakharevich + To: perl5-porters@perl.org (Mailing list Perl5) + Subject: [PATCH 5.00561+] Followup h2xs patch + Date: Thu, 30 Sep 1999 04:15:52 -0400 (EDT) + Message-Id: <199909300815.EAA25425@monk.mps.ohio-state.edu> + Branch: cfgperl + ! utils/h2xs.PL +____________________________________________________________________________ +[ 4250] By: jhi on 1999/09/29 19:11:32 + Log: Integrate with Sarathy. + Branch: cfgperl + !> djgpp/configure.bat embed.h embed.pl lib/Exporter/Heavy.pm + !> lib/ExtUtils/MM_Unix.pm lib/Time/Local.pm proto.h + !> t/pragma/locale/latin1 win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 4249] By: bailey on 1999/09/29 02:21:31 + Log: resync with mainline + Branch: vmsperl + +> (branch 32 files) + - ext/B/defsubs.h.PL lib/unicode/arabshp.txt + - lib/unicode/blocks.txt lib/unicode/index2.txt + - lib/unicode/jamo2.txt lib/unicode/names2.txt + - lib/unicode/props2.txt lib/unicode/readme.txt + - t/lib/bigfloatpm.t + !> (integrate 240 files) +____________________________________________________________________________ +[ 4248] By: jhi on 1999/09/28 18:14:39 + Log: From: Andy Dougherty + To: Perl Porters + Subject: [PATCH 5.005_xx] Re: [Config 5.005_03] -DDEBUGGING + Date: Tue, 28 Sep 1999 12:20:50 -0400 (EDT) + Message-ID: + + From: Andy Dougherty + To: Perl Porters + Subject: [ANOTHER PATCH 5.005_61] Re: [Config 5.005_03] -DDEBUGGING + Date: Tue, 28 Sep 1999 13:39:49 -0400 (EDT) + Message-ID: + Branch: cfgperl + ! hints/README.hints hints/amigaos.sh hints/cygwin.sh + ! hints/dynixptx.sh hints/epix.sh hints/esix4.sh hints/mint.sh + ! hints/mpeix.sh hints/next_3.sh hints/next_3_0.sh + ! hints/next_4.sh +____________________________________________________________________________ +[ 4247] By: gsar on 1999/09/28 17:36:59 + Log: revert change#4115 (breaks libwww's base/date.t); could be + reworked to enable it conditional on $Time::Local::nocroak + or some such + Branch: perl + ! lib/Time/Local.pm +____________________________________________________________________________ +[ 4246] By: gsar on 1999/09/28 17:33:14 + Log: tweak for win32 build + Branch: perl + ! win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 4245] By: gsar on 1999/09/28 17:31:34 + Log: change#4236 fallout + Branch: perl + ! lib/ExtUtils/MM_Unix.pm +____________________________________________________________________________ +[ 4244] By: gsar on 1999/09/28 17:29:31 + Log: remove doubled new_xpv + Branch: perl + ! embed.h embed.pl proto.h +____________________________________________________________________________ +[ 4243] By: jhi on 1999/09/27 19:13:20 + Log: Artistic fine-tuning. + Branch: cfgperl + ! ext/B/defsubs_h.PL +____________________________________________________________________________ +[ 4242] By: gsar on 1999/09/27 17:05:22 + Log: avoid implicit split to @_ in change#4181; binary -> text file + types in p4 + Branch: perl + ! djgpp/configure.bat lib/Exporter/Heavy.pm + ! t/pragma/locale/latin1 +____________________________________________________________________________ +[ 4241] By: jhi on 1999/09/27 07:48:19 + Log: Integrate with Sarathy. + Branch: cfgperl + !> INSTALL embed.h embed.pl malloc.c pod/perldiag.pod pp.c + !> pp_ctl.c pp_hot.c pp_sys.c win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 4240] By: jhi on 1999/09/27 07:47:11 + Log: Finalize change #4232. + From: Ilya Zakharevich + To: Jarkko Hietaniemi + Cc: gsar@activestate.com, Mailing list Perl5 + Subject: Re: xsubpp change breaks B, DB_File, POSIX builds + Date: Sun, 26 Sep 1999 16:52:31 -0400 + Message-ID: <19990926165230.A26933@monk.mps.ohio-state.edu> + Branch: cfgperl + ! lib/ExtUtils/xsubpp +____________________________________________________________________________ +[ 4239] By: gsar on 1999/09/27 02:48:42 + Log: add notes in INSTALL about Configure -Accflags=-DFOO + Branch: perl + ! INSTALL +____________________________________________________________________________ +[ 4238] By: gsar on 1999/09/27 02:03:48 + Log: PERL_POLLUTE isn't required for bincompat, so don't enable + it automatically + Branch: perl + ! embed.h embed.pl +____________________________________________________________________________ +[ 4237] By: gsar on 1999/09/27 01:52:47 + Log: From: Ilya Zakharevich + Date: Fri, 24 Sep 1999 23:25:36 -0400 + Message-ID: <19990924232536.A16257@monk.mps.ohio-state.edu> + Subject: [PATCH 5.005_61] Malloc fixes and docs + Branch: perl + ! malloc.c pod/perldiag.pod +____________________________________________________________________________ +[ 4236] By: gsar on 1999/09/27 01:31:32 + Log: avoid .exe in $Config{cc} (spotted by Vadim Konovalov + ) + Branch: perl + ! win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 4235] By: gsar on 1999/09/26 17:02:03 + Log: fix buggy popping of subroutine contexts in the lvalue + subroutines implementation (change#4081); correct the + plethora of cases where DIE() was more appropriate than + croak() + Branch: perl + ! pp.c pp_ctl.c pp_hot.c pp_sys.c +____________________________________________________________________________ +[ 4234] By: jhi on 1999/09/26 12:06:28 + Log: Fix #endif. + Branch: cfgperl + ! XSUB.h +____________________________________________________________________________ +[ 4233] By: jhi on 1999/09/26 11:59:18 + Log: Integrate with Sarathy. h2xs.PL had to be manually resolved, + I kept my (Ilya's) version. + Branch: cfgperl + !> gv.c gv.h intrpvar.h keywords.h keywords.pl lib/Shell.pm op.c + !> pod/perldiag.pod pod/perlembed.pod pod/perlfaq3.pod + !> pod/perlfaq7.pod pod/perlfunc.pod pod/perlmod.pod + !> pod/perlmodlib.pod pod/perlsub.pod pod/perltoot.pod + !> pod/perlxstut.pod sv.h t/pragma/strict-vars toke.c + !> utils/h2xs.PL win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 4232] By: jhi on 1999/09/26 09:53:43 + Log: From: Ilya Zakharevich + To: Mailing list Perl5 + Subject: [PATCH 5.005_61] teach xsubpp function pointers + Date: Sun, 26 Sep 1999 01:36:09 -0400 + Message-ID: <19990926013609.A21148@monk.mps.ohio-state.edu> + + From: Ilya Zakharevich + To: Mailing list Perl5 + Subject: [PATCH 5.005_61] Make h2xs -x almost bullet-proof + Date: Sun, 26 Sep 1999 03:00:50 -0400 + Message-ID: <19990926030050.A21498@monk.mps.ohio-state.edu> + Branch: cfgperl + ! lib/ExtUtils/xsubpp utils/h2xs.PL +____________________________________________________________________________ +[ 4231] By: jhi on 1999/09/26 09:48:49 + Log: From: "Konovalov, Vadim" + To: perl5-porters@perl.org + Subject: misprint in perlguts + Date: Sun, 26 Sep 1999 12:48:36 +0400 + Message-ID: <402099F49BEED211999700805FC7359F20D7A5@ru0028exch01.spb.lucent.com> + Branch: cfgperl + ! pod/perlguts.pod +____________________________________________________________________________ +[ 4230] By: gsar on 1999/09/26 00:50:08 + Log: add $installarchlib/CORE to default linker search path on windows + Branch: perl + ! win32/Makefile win32/makefile.mk +____________________________________________________________________________ +[ 4229] By: gsar on 1999/09/25 20:05:03 + Log: support C on Windows (reworked a patch suggested + by Jenda Krynicky ) + Branch: perl + ! lib/Shell.pm +____________________________________________________________________________ +[ 4228] By: gsar on 1999/09/25 07:03:34 + Log: integrate cfgperl contents into mainline + Branch: perl + +> hints/svr5.sh + !> Configure MANIFEST Makefile.SH config_h.SH hints/sco.sh + !> lib/unicode/Eq/Latin1 lib/unicode/Eq/Unicode + !> lib/unicode/mktables.PL pod/perldelta.pod pod/perlfaq9.pod + !> regcomp.c regexec.c t/lib/syslfs.t t/op/lfs.t +____________________________________________________________________________ +[ 4227] By: gsar on 1999/09/25 06:44:47 + Log: From: Larry Wall + Date: Fri, 24 Sep 1999 21:59:37 PDT + Message-Id: <199909250459.VAA27506@kiev.wall.org> + Subject: Re: [PATCH 5.005_61] "our" declarations + Branch: perl + ! gv.c gv.h intrpvar.h keywords.h keywords.pl op.c + ! pod/perldiag.pod pod/perlembed.pod pod/perlfaq3.pod + ! pod/perlfaq7.pod pod/perlfunc.pod pod/perlmod.pod + ! pod/perlmodlib.pod pod/perlsub.pod pod/perltoot.pod + ! pod/perlxstut.pod sv.h t/pragma/strict-vars toke.c + ! utils/h2xs.PL +____________________________________________________________________________ +[ 4226] By: jhi on 1999/09/24 23:10:52 + Log: Integrate with Sarathy. + Branch: cfgperl + !> XSUB.h ext/POSIX/POSIX.pod ext/POSIX/POSIX.xs + !> ext/POSIX/hints/linux.pl pod/perldiag.pod pod/perlfunc.pod + !> pp.c t/lib/posix.t t/op/pack.t toke.c utils/perlcc.PL +____________________________________________________________________________ +[ 4225] By: gsar on 1999/09/24 18:19:54 + Log: avoid infinite recursive exec()s of perl.exe when shebang + contains "Perl" rather than "perl" on DOSISH platforms + Branch: perl + ! toke.c +____________________________________________________________________________ +[ 4224] By: gsar on 1999/09/24 16:09:23 + Log: support cygwin and other platforms that link to import libraries + rather than directly with shared libraries (from a suggestion + by Lucian Cionca ) + Branch: perl + ! utils/perlcc.PL +____________________________________________________________________________ +[ 4223] By: gsar on 1999/09/24 05:05:06 + Log: normalize time for strftime() (without the isdst effects of + mktime()) using a custom mini_mktime() + From: spider-perl@Orb.Nashua.NH.US + Date: Thu, 23 Sep 1999 17:54:53 -0400 + Message-Id: <199909232154.RAA25151@leggy.zk3.dec.com> + Subject: Re: [ID 19990913.003] Possible bug using POSIX::strftime Digital UNIX Perl 5.005_03 + Branch: perl + ! ext/POSIX/POSIX.pod ext/POSIX/POSIX.xs + ! ext/POSIX/hints/linux.pl t/lib/posix.t +____________________________________________________________________________ +[ 4222] By: gsar on 1999/09/23 06:44:42 + Log: change "#" to a comment starter in pack templates; "/" now + used for specifying counted types + From: Ilya Zakharevich + Date: Wed, 22 Sep 1999 19:41:30 -0400 + Message-ID: <19990922194130.A864@monk.mps.ohio-state.edu> + Subject: [PATCH 5.005_61] Enable comments in pack()/unpack() templates + Branch: perl + ! pod/perldiag.pod pod/perlfunc.pod pp.c t/op/pack.t +____________________________________________________________________________ +[ 4221] By: gsar on 1999/09/23 06:26:54 + Log: From: Vishal Bhatia + Date: Thu, 23 Sep 1999 12:45:19 +0900 (JST) + Message-ID: + Subject: [patch _61] perlcc changes + Branch: perl + ! utils/perlcc.PL +____________________________________________________________________________ +[ 4220] By: gsar on 1999/09/23 01:12:24 + Log: add include guard + Branch: perl + ! XSUB.h +____________________________________________________________________________ +[ 4219] By: jhi on 1999/09/22 20:38:15 + Log: Cleanup cleanup. + Branch: cfgperl + ! Makefile.SH t/lib/syslfs.t t/op/lfs.t +____________________________________________________________________________ +[ 4218] By: jhi on 1999/09/22 19:26:58 + Log: Tweak the equivalence tables once again. + Branch: cfgperl + ! lib/unicode/Eq/Latin1 lib/unicode/Eq/Unicode + ! lib/unicode/mktables.PL +____________________________________________________________________________ +[ 4215] By: jhi on 1999/09/22 06:47:03 + Log: From: Ilya Zakharevich + To: Mailing list Perl5 + Subject: [PATCH 5.005_61] regfree could segfault with -Mre=debug + Date: Tue, 21 Sep 1999 19:50:00 -0400 + Message-ID: <19990921195000.A23938@monk.mps.ohio-state.edu> + + From: Ilya Zakharevich + To: Mailing list Perl5 + Subject: [PATCH 5.005_61] More verbose -Mre=debug + Date: Tue, 21 Sep 1999 22:29:55 -0400 + Message-ID: <19990921222955.A25094@monk.mps.ohio-state.edu> + Branch: cfgperl + ! regcomp.c regexec.c +____________________________________________________________________________ +[ 4214] By: jhi on 1999/09/21 21:08:43 + Log: From: 0000-Admin (0000) + Reply-To: gerberb@zenez.com + To: perl5-porters@perl.org + Subject: [ID 19990921.004] Changes for SCO OpenServer and UnixWare 7 + Date: Tue, 21 Sep 1999 11:07:46 -0600 (MDT) + Message-Id: <199909211707.LAA23611@devsys0.zenez.com> + + (Snipped away the last lines of svr5.sh a la change #3725) + Branch: cfgperl + + hints/svr5.sh + ! Configure MANIFEST config_h.SH hints/sco.sh + Branch: metaconfig + ! U/modified/Cppsym.U U/modified/Oldconfig.U +____________________________________________________________________________ +[ 4213] By: jhi on 1999/09/21 20:48:01 + Log: From: Kragen Sitaker + To: perl5-porters@perl.org + Subject: [ID 19990921.013] accidental list context in perlfaq9 + Date: Tue, 21 Sep 1999 16:27:53 -0400 (EDT) + Reply-To: kragen@pobox.com + Message-Id: <199909212027.QAA03450@kirk.dnaco.net> + Branch: cfgperl + ! pod/perlfaq9.pod +____________________________________________________________________________ +[ 4212] By: jhi on 1999/09/20 19:55:42 + Log: Integrate with Sarathy. + Branch: cfgperl + +> README.Y2K + !> Changes MANIFEST +____________________________________________________________________________ +[ 4211] By: jhi on 1999/09/20 19:44:44 + Log: Rename -Duselfs to -Duselargefiles. We don't need no stnkngbbrvtns. + Branch: cfgperl + ! Configure config_h.SH pod/perldelta.pod + Branch: metaconfig/U/perl + ! use64bits.U uselfs.U uselongdbl.U +____________________________________________________________________________ +[ 4210] By: jhi on 1999/09/20 19:38:26 + Log: Configure -A change: -Afoo=bar is equal to -Aappend:foo=" bar". + Branch: cfgperl + ! Configure config_h.SH + Branch: metaconfig + ! U/modified/Options.U +____________________________________________________________________________ +[ 4209] By: gsar on 1999/09/20 19:35:39 + Log: integrate cfgperl changes into mainline + Branch: perl + +> lib/unicode/Unicode.html + ! Changes + !> Configure Porting/Glossary Porting/config.sh Porting/config_H + !> config_h.SH doio.c perl.h pod/perldelta.pod pod/perlfunc.pod +____________________________________________________________________________ [ 4208] By: gsar on 1999/09/20 18:28:44 Log: add README.Y2K (from Dominic Dunlop ) Branch: perl @@ -796,11 +5205,6 @@ ____________________________________________________________________________ + t/lib/gol-basic.t t/lib/gol-compat.t t/lib/gol-linkage.t ! Changes MANIFEST lib/Getopt/Long.pm ____________________________________________________________________________ -[ 4117] By: jhi on 1999/09/09 18:24:30 - Log: Remove ill-designed %B introduced by change #4111. - Branch: cfgperl - ! sv.c t/op/sprintf.t -____________________________________________________________________________ [ 4116] By: jhi on 1999/09/09 15:56:52 Log: perldeltify change #4115. Branch: cfgperl @@ -846,11 +5250,6 @@ ____________________________________________________________________________ Branch: cfgperl ! regexec.c t/op/pat.t ____________________________________________________________________________ -[ 4111] By: jhi on 1999/09/09 07:50:07 - Log: %#b in particular and %B in general were kaputt. - Branch: cfgperl - ! sv.c t/op/sprintf.t -____________________________________________________________________________ [ 4110] By: jhi on 1999/09/09 07:29:17 Log: Tidy up 64-bit situation in perldelta. Branch: cfgperl @@ -1261,22 +5660,11 @@ ____________________________________________________________________________ Branch: cfgperl ! toke.c ____________________________________________________________________________ -[ 4058] By: jhi on 1999/08/31 08:57:35 - Log: For some odd reason #4056 didn't undo #3922 completely. - Branch: cfgperl - ! pp.c -____________________________________________________________________________ [ 4057] By: gsar on 1999/08/30 22:08:19 Log: avoid hiding child process window Branch: perl ! win32/win32.c ____________________________________________________________________________ -[ 4056] By: jhi on 1999/08/30 21:36:24 - Log: Retract #3922 (Rule #1 was invoked). - (See also #4058). - Branch: cfgperl - ! pod/perldiag.pod pp.c regexp.h -____________________________________________________________________________ [ 4055] By: jhi on 1999/08/30 21:20:50 Log: Document the undefinedness of overshifting. Branch: cfgperl @@ -1854,11 +6242,6 @@ ____________________________________________________________________________ Branch: metaconfig/U/perl ! d_dlsymun.U io64.U uselongdbl.U ____________________________________________________________________________ -[ 3981] By: jhi on 1999/08/13 15:11:51 - Log: Retract change #3977 (do_open9() adds O_LARGEFILE automagically). - Branch: cfgperl - ! t/lib/syslfs.t -____________________________________________________________________________ [ 3980] By: jhi on 1999/08/13 15:09:11 Log: Introduce HAS_LLSEEK. Branch: cfgperl @@ -1879,11 +6262,6 @@ ____________________________________________________________________________ Branch: cfgperl ! t/op/64bit.t ____________________________________________________________________________ -[ 3977] By: jhi on 1999/08/13 09:56:25 - Log: Use O_LARGEFILE if available. - Branch: cfgperl - ! t/lib/syslfs.t -____________________________________________________________________________ [ 3976] By: jhi on 1999/08/12 21:49:16 Log: IRIX64 needs more -mabi=64 with gcc. Branch: cfgperl @@ -2258,18 +6636,6 @@ ____________________________________________________________________________ Branch: cfgperl ! pp.c ____________________________________________________________________________ -[ 3924] By: jhi on 1999/08/05 09:23:00 - Log: Warning fix to change #3922. - From: paul.marquess@bt.com - To: ilya@math.ohio-state.edu, gsar@activestate.com - Cc: tchrist@jhereg.perl.com, chaimf@pobox.com, ed@chronos.net, - perl5-porters@perl.org - Subject: RE: [PATCH 5.00557] split /^/ - Date: Thu, 5 Aug 1999 09:01:15 +0100 - Message-ID: <5104D4DBC598D211B5FE0000F8FE7EB202D49B23@mbtlipnt02.btlabs.bt.co.uk> - Branch: cfgperl - ! pp.c -____________________________________________________________________________ [ 3923] By: jhi on 1999/08/05 09:16:57 Log: From: paul.marquess@bt.com To: jhi@iki.fi, paul.marquess@bt.com @@ -2280,19 +6646,6 @@ ____________________________________________________________________________ Branch: cfgperl ! t/lib/anydbm.t ____________________________________________________________________________ -[ 3922] By: jhi on 1999/08/05 08:09:59 - Log: Deprecate /^/ implictly meaning /^/m. - - From: Ilya Zakharevich - To: Gurusamy Sarathy - Cc: Tom Christiansen , chaimf@pobox.com, - ed@chronos.net, perl5-porters@perl.org - Subject: [PATCH 5.00557] split /^/ - Date: Wed, 4 Aug 1999 16:46:57 -0400 - Message-ID: <19990804164657.A3776@monk.mps.ohio-state.edu> - Branch: cfgperl - ! pod/perldiag.pod pp.c regexp.h -____________________________________________________________________________ [ 3921] By: jhi on 1999/08/05 08:05:13 Log: From: paul.marquess@bt.com To: perl5-porters@perl.org @@ -2376,26 +6729,6 @@ ____________________________________________________________________________ Branch: cfgperl ! t/op/filetest.t ____________________________________________________________________________ -[ 3913] By: jhi on 1999/08/03 21:07:57 - Log: Retract #3912, much too many compilation warnings - under Digital UNIX. - Branch: cfgperl - ! doio.c iperlsys.h perl.h perlio.c perlsdio.h perlsfio.h - ! pp_sys.c sv.c -____________________________________________________________________________ -[ 3912] By: jhi on 1999/08/03 20:13:59 - Log: (Retracted). See #3913. - - From: Sven Verdoolaege - To: perl5-porters@perl.org - Subject: [ID 19990803.003] Not OK: perl 5.00560 on i586-linux-thread - 2.1.125 [PATCH] - Date: Tue, 3 Aug 1999 13:14:07 +0200 - Message-Id: <19990803131407.A30911@pool.kotnet.org> - Branch: cfgperl - ! doio.c iperlsys.h perl.h perlio.c perlsdio.h perlsfio.h - ! pp_sys.c sv.c -____________________________________________________________________________ [ 3911] By: jhi on 1999/08/03 19:52:38 Log: The "-Dusethreads -Duseperlio" combination failed. @@ -6999,13 +11332,6 @@ ____________________________________________________________________________ Branch: perl ! win32/win32.c ____________________________________________________________________________ -[ 3315] By: nick on 1999/05/06 21:44:38 - Log: open(FH,undef) # creates new_tmpfile opened read/write - Add t/io/open.t with test for above. - Branch: perl - + t/io/open.t - ! pp_sys.c -____________________________________________________________________________ [ 3314] By: gsar on 1999/05/06 08:01:23 Log: compiler fixes from Vishal Bhatia Date: Tue, 30 Mar 1999 23:40:34 PST diff --git a/Configure b/Configure index caea67e..ba58770 100755 --- a/Configure +++ b/Configure @@ -20,7 +20,7 @@ # $Id: Head.U,v 3.0.1.9 1997/02/28 15:02:09 ram Exp $ # -# Generated on Wed Sep 22 00:13:58 EET DST 1999 [metaconfig 3.0 PL70] +# Generated on Tue Jan 18 21:42:31 EET 2000 [metaconfig 3.0 PL70] # (with additional metaconfig patches by perlbug@perl.com) cat >/tmp/c1$$ < tmparch 2>&1 ; then - tarch=`$sed -e 's/ *$//' -e 's/ /_/g' \ - -e 's/$/'"-$osname/" tmparch` - else - tarch="$osname" - fi - $rm -f tmparch -else - tarch="$osname" -fi -case "$myarchname" in -''|"$tarch") ;; -*) - echo "(Your architecture name used to be $myarchname.)" - archname='' - ;; -esac -myarchname="$tarch" -case "$archname" in -'') dflt="$tarch";; -*) dflt="$archname";; -esac -rp='What is your architecture name' -. ./myread -archname="$ans" -case "$usethreads" in -$define) - echo "Threads selected." >&4 - case "$archname" in - *-thread*) echo "...and architecture name already has -thread." >&4 - ;; - *) archname="$archname-thread" - echo "...setting architecture name to $archname." >&4 - ;; - esac - ;; -esac -case "$usemultiplicity" in -$define) - echo "Multiplicity selected." >&4 - case "$archname" in - *-multi*) echo "...and architecture name already has -multi." >&4 - ;; - *) archname="$archname-multi" - echo "...setting architecture name to $archname." >&4 - ;; - esac - ;; -esac -case "$use64bits" in -$define) - echo "Explicit 64-bitness selected." >&4 - case "$archname64" in - '') - ;; - *) - case "$archname" in - *-$archname64*) echo "...and architecture name already has $archname64." >&4 - ;; - *) archname="$archname-$archname64" - echo "...setting architecture name to $archname." >&4 - ;; - esac - ;; - esac -esac - : decide how portable to be. Allow command line overrides. case "$d_portable" in "$undef") ;; @@ -3454,1116 +3397,1555 @@ rm -f getfile.ok test "X$gfpthkeep" != Xy && gfpth="" EOSC -: determine root of directory hierarchy where package will be installed. -case "$prefix" in -'') - dflt=`./loc . /usr/local /usr/local /local /opt /usr` - ;; -*) - dflt="$prefix" - ;; -esac -$cat <usr.c <<'EOCP' +#ifdef SYSTYPE_BSD43 +/bsd43 +#endif +EOCP + if $cc -E usr.c > usr.out && $contains / usr.out >/dev/null 2>&1; then + dflt='/bsd43/usr/include' + incpath='/bsd43' + mips_type='BSD 4.3' + else + mips_type='System V' + fi + $rm -f usr.c usr.out + echo "and you're compiling with the $mips_type compiler and libraries." + xxx_prompt=y + echo "exit 0" >mips +else + echo "Doesn't look like a MIPS system." + xxx_prompt=n + echo "exit 1" >mips +fi +chmod +x mips +$eunicefix mips +case "$usrinc" in '') ;; -*) - case "$ans" in - "$prefix") ;; - *) oldprefix="$prefix";; - esac +*) dflt="$usrinc";; +esac +case "$xxx_prompt" in +y) fn=d/ + echo " " + rp='Where are the include files you want to use?' + . ./getfile + usrinc="$ans" + ;; +*) usrinc="$dflt" ;; esac -prefix="$ans" -prefixexp="$ansexp" -: is AFS running? +: see how we invoke the C preprocessor echo " " -case "$afs" in -$define|true) afs=true ;; -$undef|false) afs=false ;; -*) if test -d /afs; then - afs=true +echo "Now, how can we feed standard input to your C preprocessor..." >&4 +cat <<'EOT' >testcpp.c +#define ABC abc +#define XYZ xyz +ABC.XYZ +EOT +cd .. +if test ! -f cppstdin; then + if test "X$osname" = "Xaix" -a "X$gccversion" = X; then + # AIX cc -E doesn't show the absolute headerfile + # locations but we'll cheat by using the -M flag. + echo 'cat >.$$.c; rm -f .$$.u; '"$cc"' ${1+"$@"} -M -c .$$.c 2>/dev/null; test -s .$$.u && awk '"'"'$2 ~ /\.h$/ { print "# 0 \""$2"\"" }'"'"' .$$.u; rm -f .$$.o .$$.u; '"$cc"' -E ${1+"$@"} .$$.c; rm .$$.c' > cppstdin else - afs=false + echo 'cat >.$$.c; '"$cc"' -E ${1+"$@"} .$$.c; rm .$$.c' >cppstdin fi - ;; -esac -if $afs; then - echo "AFS may be running... I'll be extra cautious then..." >&4 else - echo "AFS does not seem to be running..." >&4 + echo "Keeping your $hint cppstdin wrapper." fi +chmod 755 cppstdin +wrapper=`pwd`/cppstdin +ok='false' +cd UU -: determine installation prefix for where package is to be installed. -if $afs; then -$cat <testcpp.out 2>&1 && \ + $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 +then + echo "You used to use $cppstdin $cppminus so we'll use that again." + case "$cpprun" in + '') echo "But let's see if we can live without a wrapper..." ;; + *) + if $cpprun $cpplast testcpp.out 2>&1 && \ + $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 + then + echo "(And we'll use $cpprun $cpplast to preprocess directly.)" + ok='true' + else + echo "(However, $cpprun $cpplast does not work, let's see...)" + fi + ;; esac else -$cat <&4 -if $test -r $rsrc/patchlevel.h;then - patchlevel=`awk '/define[ ]+PERL_VERSION/ {print $3}' $rsrc/patchlevel.h` - subversion=`awk '/define[ ]+PERL_SUBVERSION/ {print $3}' $rsrc/patchlevel.h` -else - patchlevel=0 - subversion=0 + echo "Good old $cppstdin $cppminus does not seem to be of any help..." + ;; + esac fi -$echo $n "(You have $package" $c -case "$package" in -"*$baserev") ;; -*) $echo $n " $baserev" $c ;; -esac -$echo $n " patchlevel $patchlevel" $c -test 0 -eq "$subversion" || $echo $n " subversion $subversion" $c -echo ".)" -if test 0 -eq "$subversion"; then - version=`LC_ALL=C; export LC_ALL; \ - echo $baserev $patchlevel | \ - $awk '{ printf "%.3f\n", $1 + $2/1000.0 }'` -else - version=`LC_ALL=C; export LC_ALL; \ - echo $baserev $patchlevel $subversion | \ - $awk '{ printf "%.5f\n", $1 + $2/1000.0 + $3/100000.0 }'` -fi -: Figure out perl API version. Perhaps this should be in patchlevel.h -if test "$subversion" -lt 50; then - apiversion=`LC_ALL=C; export LC_ALL; \ - LANGUAGE=C; export LANGUAGE; \ - echo $baserev $patchlevel | \ - $awk '{ printf "%.3f\n", $1 + $2/1000.0 }'` +if $ok; then + : nothing +elif echo 'Maybe "'"$cc"' -E" will work...'; \ + $cc -E testcpp.out 2>&1; \ + $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then + echo "Yup, it does." + x_cpp="$cc -E" + x_minus=''; +elif echo 'Nope...maybe "'"$cc"' -E -" will work...'; \ + $cc -E - testcpp.out 2>&1; \ + $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then + echo "Yup, it does." + x_cpp="$cc -E" + x_minus='-'; +elif echo 'Nope...maybe "'"$cc"' -P" will work...'; \ + $cc -P testcpp.out 2>&1; \ + $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then + echo "Yipee, that works!" + x_cpp="$cc -P" + x_minus=''; +elif echo 'Nope...maybe "'"$cc"' -P -" will work...'; \ + $cc -P - testcpp.out 2>&1; \ + $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then + echo "At long last!" + x_cpp="$cc -P" + x_minus='-'; +elif echo 'No such luck, maybe "'$cpp'" will work...'; \ + $cpp testcpp.out 2>&1; \ + $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then + echo "It works!" + x_cpp="$cpp" + x_minus=''; +elif echo 'Nixed again...maybe "'$cpp' -" will work...'; \ + $cpp - testcpp.out 2>&1; \ + $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then + echo "Hooray, it works! I was beginning to wonder." + x_cpp="$cpp" + x_minus='-'; +elif echo 'Uh-uh. Time to get fancy. Trying a wrapper...'; \ + $wrapper testcpp.out 2>&1; \ + $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then + x_cpp="$wrapper" + x_minus='' + echo "Eureka!" else - apiversion="$version" + dflt='' + rp="No dice. I can't find a C preprocessor. Name one:" + . ./myread + x_cpp="$ans" + x_minus='' + $x_cpp testcpp.out 2>&1 + if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then + echo "OK, that will do." >&4 + else +echo "Sorry, I can't get that to work. Go find one and rerun Configure." >&4 + exit 1 + fi fi -: determine installation style -: For now, try to deduce it from prefix unless it is already set. -: Reproduce behavior of 5.005 and earlier, maybe drop that in 5.7. -case "$installstyle" in -'') case "$prefix" in - *perl*) dflt='lib';; - *) dflt='lib/perl5' ;; +case "$ok" in +false) + cppstdin="$x_cpp" + cppminus="$x_minus" + cpprun="$x_cpp" + cpplast="$x_minus" + set X $x_cpp + shift + case "$1" in + "$cpp") + echo "Perhaps can we force $cc -E using a wrapper..." + if $wrapper testcpp.out 2>&1; \ + $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 + then + echo "Yup, we can." + cppstdin="$wrapper" + cppminus=''; + else + echo "Nope, we'll have to live without it..." + fi + ;; + esac + case "$cpprun" in + "$wrapper") + cpprun='' + cpplast='' + ;; esac ;; -*) dflt='lib/perl5' ;; esac -: Probably not worth prompting for this since we prompt for all -: the directories individually, and the prompt would be too long and -: confusing anyway. -installstyle=$dflt -: determine where private library files go -: Usual default is /usr/local/lib/perl5/$version. -: Also allow things like /opt/perl/lib/$version, since -: /opt/perl/lib/perl5... would be redundant. -: The default "style" setting is made in installstyle.U -case "$installstyle" in -*lib/perl5*) set dflt privlib lib/$package/$version ;; -*) set dflt privlib lib/$version ;; +case "$cppstdin" in +"$wrapper"|'cppstdin') ;; +*) $rm -f $wrapper;; esac -eval $prefixit -$cat <reflect - chmod +x,u+s reflect - ./reflect >flect 2>&1 - if $contains "/dev/fd" flect >/dev/null; then - echo "Congratulations, your kernel has secure setuid scripts!" >&4 - val="$define" - else - $cat <&4 - dflt=n;; - "$undef") - echo "Well, the $hint value is *not* secure." >&4 - dflt=n;; - *) echo "Well, the $hint value *is* secure." >&4 - dflt=y;; - esac - ;; - *) - $rm -f reflect flect - echo "#!$ls" >reflect - chmod +x,u+s reflect - echo >flect - chmod a+w flect - echo '"su" will (probably) prompt you for '"$ans's password." - su $ans -c './reflect >flect' - if $contains "/dev/fd" flect >/dev/null; then - echo "Okay, it looks like setuid scripts are secure." >&4 - dflt=y - else - echo "I don't think setuid scripts are secure." >&4 - dflt=n - fi - ;; +: Looking for optional libraries +echo " " +echo "Checking for optional libraries..." >&4 +case "$libs" in +' '|'') dflt='';; +*) dflt="$libs";; +esac +case "$libswanted" in +'') libswanted='c_s';; +esac +case "$usesocks" in +$define) + libswanted="$libswanted socks5 socks5_sh" + ;; +esac +for thislib in $libswanted; do + + if xxx=`./loc lib$thislib.$so.[0-9]'*' X $libpth`; + $test -f "$xxx" -a "X$ignore_versioned_solibs" = "X"; then + echo "Found -l$thislib (shared)." + case " $dflt " in + *"-l$thislib "*);; + *) dflt="$dflt -l$thislib";; esac - rp='Does your kernel have *secure* setuid scripts?' - . ./myread - case "$ans" in - [yY]*) val="$define";; - *) val="$undef";; + elif xxx=`./loc lib$thislib.$so X $libpth` ; $test -f "$xxx"; then + echo "Found -l$thislib (shared)." + case " $dflt " in + *"-l$thislib "*);; + *) dflt="$dflt -l$thislib";; + esac + elif xxx=`./loc lib$thislib$_a 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 + 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 + 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 + echo "Found -l$thislib." + case " $dflt " in + *"-l$thislib "*);; + *) dflt="$dflt -l$thislib";; + esac + else + echo "No -l$thislib." fi -else - echo "I don't think setuid scripts are secure (no /dev/fd directory)." >&4 - echo "(That's for file descriptors, not floppy disks.)" - val="$undef" -fi -set d_suidsafe -eval $setvar +done +set X $dflt +shift +dflt="$*" +case "$libs" in +'') dflt="$dflt";; +*) dflt="$libs";; +esac +case "$dflt" in +' '|'') dflt='none';; +esac -$rm -f reflect flect +$cat <& 4 - ;; -*) - $cat </dev/null 2>&1 + then + dflt="$dflt -posix" + fi + ;; + esac + case "$gccversion" in + 1*) ;; + 2.[0-8]*) ;; + ?*) echo " " + echo "Checking if your compiler accepts -fno-strict-aliasing" 2>&1 + echo 'int main(void) { return 0; }' > gcctest.c + if $cc -O2 -fno-strict-aliasing -o gcctest gcctest.c; then + echo "Yes, it does." 2>&1 + case "$ccflags" in + *strict-aliasing*) + echo "Leaving current flags $ccflags alone." 2>&1 + ;; + *) dflt="$dflt -fno-strict-aliasing" ;; + esac + else + echo "Nope, it doesn't, but that's ok." 2>&1 + fi + ;; esac ;; esac -set d_dosuid -eval $setvar -: What should the include directory be ? -echo " " -$echo $n "Hmm... $c" -dflt='/usr/include' -incpath='' -mips_type='' -if $test -f /bin/mips && /bin/mips; then - echo "Looks like a MIPS system..." - $cat >usr.c <<'EOCP' -#ifdef SYSTYPE_BSD43 -/bsd43 -#endif -EOCP - if $cc -E usr.c > usr.out && $contains / usr.out >/dev/null 2>&1; then - dflt='/bsd43/usr/include' - incpath='/bsd43' - mips_type='BSD 4.3' - else - mips_type='System V' +case "$mips_type" in +*BSD*|'') inclwanted="$locincpth $usrinc";; +*) inclwanted="$locincpth $inclwanted $usrinc/bsd";; +esac +for thisincl in $inclwanted; do + if $test -d $thisincl; then + if $test x$thisincl != x$usrinc; then + case "$dflt" in + *$thisincl*);; + *) dflt="$dflt -I$thisincl";; + esac + fi fi - $rm -f usr.c usr.out - echo "and you're compiling with the $mips_type compiler and libraries." - xxx_prompt=y - echo "exit 0" >mips +done + +inctest='if $contains $2 $usrinc/$1 >/dev/null 2>&1; then + xxx=true; +elif $contains $2 $usrinc/sys/$1 >/dev/null 2>&1; then + xxx=true; else - echo "Doesn't look like a MIPS system." - xxx_prompt=n - echo "exit 1" >mips -fi -chmod +x mips -$eunicefix mips -case "$usrinc" in -'') ;; -*) dflt="$usrinc";; -esac -case "$xxx_prompt" in -y) fn=d/ - echo " " - rp='Where are the include files you want to use?' - . ./getfile - usrinc="$ans" - ;; -*) usrinc="$dflt" + xxx=false; +fi; +if $xxx; then + case "$dflt" in + *$2*);; + *) dflt="$dflt -D$2";; + esac; +fi' + +set signal.h LANGUAGE_C; eval $inctest + +case "$usesocks" in +$define) + ccflags="$ccflags -DSOCKS" ;; esac -: see how we invoke the C preprocessor -echo " " -echo "Now, how can we feed standard input to your C preprocessor..." >&4 -cat <<'EOT' >testcpp.c -#define ABC abc -#define XYZ xyz -ABC.XYZ -EOT -cd .. -if test ! -f cppstdin; then - if test "X$osname" = "Xaix" -a "X$gccversion" = X; then - # AIX cc -E doesn't show the absolute headerfile - # locations but we'll cheat by using the -M flag. - echo 'cat >.$$.c; rm -f .$$.u; '"$cc"' ${1+"$@"} -M -c .$$.c 2>/dev/null; test -s .$$.u && awk '"'"'$2 ~ /\.h$/ { print "# 0 \""$2"\"" }'"'"' .$$.u; rm -f .$$.o .$$.u; '"$cc"' -E ${1+"$@"} .$$.c; rm .$$.c' > cppstdin - else - echo 'cat >.$$.c; '"$cc"' -E ${1+"$@"} .$$.c; rm .$$.c' >cppstdin - fi -else - echo "Keeping your $hint cppstdin wrapper." -fi -chmod 755 cppstdin -wrapper=`pwd`/cppstdin -ok='false' -cd UU +case "$hint" in +default|recommended) dflt="$ccflags $dflt" ;; +*) dflt="$ccflags";; +esac -if $test "X$cppstdin" != "X" && \ - $cppstdin $cppminus testcpp.out 2>&1 && \ - $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 -then - echo "You used to use $cppstdin $cppminus so we'll use that again." - case "$cpprun" in - '') echo "But let's see if we can live without a wrapper..." ;; - *) - if $cpprun $cpplast testcpp.out 2>&1 && \ - $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 +case "$dflt" in +''|' ') dflt=none;; +esac +$cat <&4 + set X $cppflags + shift + cppflags='' + $cat >cpp.c <<'EOM' +#define BLURFL foo + +BLURFL xx LFRULB +EOM + previous='' + for flag in $* + do + case "$flag" in + -*) ftry="$flag";; + *) ftry="$previous $flag";; + esac + if $cppstdin -DLFRULB=bar $cppflags $ftry $cppminus cpp1.out 2>/dev/null && \ + $cpprun -DLFRULB=bar $cppflags $ftry $cpplast cpp2.out 2>/dev/null && \ + $contains 'foo.*xx.*bar' cpp1.out >/dev/null 2>&1 && \ + $contains 'foo.*xx.*bar' cpp2.out >/dev/null 2>&1 then - echo "(And we'll use $cpprun $cpplast to preprocess directly.)" - ok='true' + cppflags="$cppflags $ftry" + previous='' else - echo "(However, $cpprun $cpplast does not work, let's see...)" + previous="$flag" fi - ;; + done + set X $cppflags + shift + cppflags=${1+"$@"} + case "$cppflags" in + *-*) echo "They appear to be: $cppflags";; esac -else - case "$cppstdin" in - '') ;; - *) - echo "Good old $cppstdin $cppminus does not seem to be of any help..." + $rm -f cpp.c cpp?.out + ;; +esac + +: flags used in final linking phase +case "$ldflags" in +'') if ./venix; then + dflt='-i -z' + else + dflt='' + fi + case "$ccflags" in + *-posix*) dflt="$dflt -posix" ;; + esac + ;; +*) dflt="$ldflags";; +esac + +: Try to guess additional flags to pick up local libraries. +for thislibdir in $libpth; do + case " $loclibpth " in + *" $thislibdir "*) + case "$dflt " in + *"-L$thislibdir "*) ;; + *) dflt="$dflt -L$thislibdir" ;; + esac ;; esac -fi +done -if $ok; then - : nothing -elif echo 'Maybe "'"$cc"' -E" will work...'; \ - $cc -E testcpp.out 2>&1; \ - $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then - echo "Yup, it does." - x_cpp="$cc -E" - x_minus=''; -elif echo 'Nope...maybe "'"$cc"' -E -" will work...'; \ - $cc -E - testcpp.out 2>&1; \ - $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then - echo "Yup, it does." - x_cpp="$cc -E" - x_minus='-'; -elif echo 'Nope...maybe "'"$cc"' -P" will work...'; \ - $cc -P testcpp.out 2>&1; \ - $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then - echo "Yipee, that works!" - x_cpp="$cc -P" - x_minus=''; -elif echo 'Nope...maybe "'"$cc"' -P -" will work...'; \ - $cc -P - testcpp.out 2>&1; \ - $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then - echo "At long last!" - x_cpp="$cc -P" - x_minus='-'; -elif echo 'No such luck, maybe "'$cpp'" will work...'; \ - $cpp testcpp.out 2>&1; \ - $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then - echo "It works!" - x_cpp="$cpp" - x_minus=''; -elif echo 'Nixed again...maybe "'$cpp' -" will work...'; \ - $cpp - testcpp.out 2>&1; \ - $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then - echo "Hooray, it works! I was beginning to wonder." - x_cpp="$cpp" - x_minus='-'; -elif echo 'Uh-uh. Time to get fancy. Trying a wrapper...'; \ - $wrapper testcpp.out 2>&1; \ - $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then - x_cpp="$wrapper" - x_minus='' - echo "Eureka!" -else - dflt='' - rp="No dice. I can't find a C preprocessor. Name one:" - . ./myread - x_cpp="$ans" - x_minus='' - $x_cpp testcpp.out 2>&1 - if $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 ; then - echo "OK, that will do." >&4 +case "$dflt" in +'') dflt='none' ;; +esac + +$cat <&4 +$cat > try.c <<'EOF' +#include +int main() { printf("Ok\n"); exit(0); } +EOF +set X $cc $optimize $ccflags -o try $ldflags try.c $libs +shift +$cat >try.msg <<'EOM' +I've tried to compile and run the following simple program: + +EOM +$cat try.c >> try.msg + +$cat >> try.msg <>try.msg 2>&1; then + if sh -c './try' >>try.msg 2>&1; then + xxx=`./try` + case "$xxx" in + "Ok") dflt=n ;; + *) echo 'The program compiled OK, but produced no output.' >> try.msg + case " $libs " in + *" -lsfio "*) + cat >> try.msg <<'EOQS' +If $libs contains -lsfio, and sfio is mis-configured, then it +sometimes (apparently) runs and exits with a 0 status, but with no +output! It may have to do with sfio's use of _exit vs. exit. + +EOQS + rp="You have a big problem. Shall I abort Configure" + dflt=y + ;; + esac + ;; + esac else -echo "Sorry, I can't get that to work. Go find one and rerun Configure." >&4 - exit 1 + echo "The program compiled OK, but exited with status $?." >>try.msg + rp="You have a problem. Shall I abort Configure" + dflt=y fi +else + echo "I can't compile the test program." >>try.msg + rp="You have a BIG problem. Shall I abort Configure" + dflt=y fi - -case "$ok" in -false) - cppstdin="$x_cpp" - cppminus="$x_minus" - cpprun="$x_cpp" - cpplast="$x_minus" - set X $x_cpp - shift - case "$1" in - "$cpp") - echo "Perhaps can we force $cc -E using a wrapper..." - if $wrapper testcpp.out 2>&1; \ - $contains 'abc.*xyz' testcpp.out >/dev/null 2>&1 - then - echo "Yup, we can." - cppstdin="$wrapper" - cppminus=''; - else - echo "Nope, we'll have to live without it..." - fi +case "$dflt" in +y) + $cat try.msg >&4 + case "$knowitall" in + '') + echo "(The supplied flags or libraries might be incorrect.)" ;; + *) dflt=n;; esac - case "$cpprun" in - "$wrapper") - cpprun='' - cpplast='' + echo " " + . ./myread + case "$ans" in + n*|N*) ;; + *) echo "Ok. Stopping Configure." >&4 + exit 1 ;; esac ;; +n) echo "OK, that should do.";; esac +$rm -f try try.* core -case "$cppstdin" in -"$wrapper"|'cppstdin') ;; -*) $rm -f $wrapper;; -esac -$rm -f testcpp.c testcpp.out - -: Set private lib path -case "$plibpth" in -'') if ./mips; then - plibpth="$incpath/usr/lib /usr/local/lib /usr/ccs/lib" - fi;; -esac -case "$libpth" in -' ') dlist='';; -'') dlist="$loclibpth $plibpth $glibpth";; -*) dlist="$libpth";; -esac +: define an is-a-typedef? function +typedef='type=$1; var=$2; def=$3; shift; shift; shift; inclist=$@; +case "$inclist" in +"") inclist="sys/types.h";; +esac; +eval "varval=\$$var"; +case "$varval" in +"") + $rm -f temp.c; + for inc in $inclist; do + echo "#include <$inc>" >>temp.c; + done; + echo "#ifdef $type" >> temp.c; + echo "printf(\"We have $type\");" >> temp.c; + echo "#endif" >> temp.c; + $cppstdin $cppflags $cppminus < temp.c >temp.E 2>/dev/null; + if $contains $type temp.E >/dev/null 2>&1; then + eval "$var=\$type"; + else + eval "$var=\$def"; + fi; + $rm -f temp.?;; +*) eval "$var=\$varval";; +esac' -: Now check and see which directories actually exist, avoiding duplicates -libpth='' -for xxx in $dlist -do - if $test -d $xxx; then - case " $libpth " in - *" $xxx "*) ;; - *) libpth="$libpth $xxx";; - esac - fi -done -$cat <<'EOM' +: define an is-a-typedef? function that prompts if the type is not available. +typedef_ask='type=$1; var=$2; def=$3; shift; shift; shift; inclist=$@; +case "$inclist" in +"") inclist="sys/types.h";; +esac; +eval "varval=\$$var"; +case "$varval" in +"") + $rm -f temp.c; + for inc in $inclist; do + echo "#include <$inc>" >>temp.c; + done; + echo "#ifdef $type" >> temp.c; + echo "printf(\"We have $type\");" >> temp.c; + echo "#endif" >> temp.c; + $cppstdin $cppflags $cppminus < temp.c >temp.E 2>/dev/null; + echo " " ; + echo "$rp" | $sed -e "s/What is/Looking for/" -e "s/?/./"; + if $contains $type temp.E >/dev/null 2>&1; then + echo "$type found." >&4; + eval "$var=\$type"; + else + echo "$type NOT found." >&4; + dflt="$def"; + . ./myread ; + eval "$var=\$ans"; + fi; + $rm -f temp.?;; +*) eval "$var=\$varval";; +esac' -Some systems have incompatible or broken versions of libraries. Among -the directories listed in the question below, please remove any you -know not to be holding relevant libraries, and add any that are needed. -Say "none" for none. +: define a shorthand compile call +compile=' +mc_file=$1; +shift; +$cc $optimize $ccflags $ldflags -o ${mc_file} $* ${mc_file}.c $libs > /dev/null 2>&1;' +: define a shorthand compile call for compilations that should be ok. +compile_ok=' +mc_file=$1; +shift; +$cc $optimize $ccflags $ldflags -o ${mc_file} $* ${mc_file}.c $libs;' +: check for lengths of integral types +echo " " +case "$intsize" in +'') + echo "Checking to see how big your integers are..." >&4 + $cat >intsize.c <<'EOCP' +#include +int main() +{ + printf("intsize=%d;\n", (int)sizeof(int)); + printf("longsize=%d;\n", (int)sizeof(long)); + printf("shortsize=%d;\n", (int)sizeof(short)); + exit(0); +} +EOCP + set intsize + if eval $compile_ok && ./intsize > /dev/null; then + eval `./intsize` + echo "Your integers are $intsize bytes long." + echo "Your long integers are $longsize bytes long." + echo "Your short integers are $shortsize bytes long." + else + $cat >&4 <&4 +$cat >try.c < +#include +int main() +{ + printf("%d\n", (int)sizeof($lseektype)); + return(0); +} +EOCP +set try +if eval $compile_ok; then + lseeksize=`./try` + $echo " $lseeksize bytes." >&4 +else + dflt=$longsize + echo " " + echo "(I can't seem to compile the test program. Guessing...)" + rp="What is the size of your file offsets (in bytes)?" + . ./myread + lseeksize="$ans" +fi +$rm -f try.c try + +: see what type file positions are declared as in the library +rp="What is the type for file position used by fsetpos()?" +set fpos_t fpostype long stdio.h sys/types.h +eval $typedef_ask + +echo " " +case "$fpostype" in +*_t) zzz="$fpostype" ;; +*) zzz="fpos_t" ;; esac +$echo $n "Checking the size of $zzz...$c" >&4 +cat > try.c < +#include +int main() { + printf("%d\n", (int)sizeof($fpostype)); + exit(0); +} +EOCP +set try +if eval $compile_ok; then + yyy=`./try` + case "$yyy" in + '') fpossize=4 + echo " " + echo "(I can't execute the test program--guessing $fpossize.)" >&4 + ;; + *) fpossize=$yyy + echo " $fpossize bytes." + ;; + esac +else + dflt="$longsize" + echo " " + echo "(I can't compile the test program. Guessing...)" >&4 + rp="What is the size of your file positions (in bytes)?" + . ./myread + fpossize="$ans" +fi -: compute shared library extension -case "$so" in -'') - if xxx=`./loc libc.sl X $libpth`; $test -f "$xxx"; then - dflt='sl' - else - dflt='so' - fi - ;; -*) dflt="$so";; -esac -$cat <&4 + $cat >try.c < +#include +int main() +{ + printf("%d\n", (int)sizeof($lseektype)); + return(0); +} +EOCP + set try + if eval $compile_ok; then + lseeksize=`./try` + $echo " $lseeksize bytes." >&4 + else + dflt="$lseeksize" + echo " " + echo "(I can't seem to compile the test program. Guessing...)" + rp="What is the size of your file offsets (in bytes)?" + . ./myread + lseeksize="$ans" + fi + case "$fpostype" in + *_t) zzz="$fpostype" ;; + *) zzz="fpos_t" ;; + esac + $echo $n "Rechecking the size of $zzz...$c" >&4 + $cat > try.c < +#include +int main() { + printf("%d\n", (int)sizeof($fpostype)); + exit(0); +} +EOCP + set try + if eval $compile_ok; then + yyy=`./try` + dflt="$lseeksize" + case "$yyy" in + '') echo " " + echo "(I can't execute the test program--guessing $fpossize.)" >&4 + ;; + *) fpossize=$yyy + echo " $fpossize bytes." + ;; + esac + else + dflt="$fpossize" + echo " " + echo "(I can't compile the test program. Guessing...)" >&4 + rp="What is the size of your file positions (in bytes)?" + . ./myread + fpossize="$ans" + fi + $rm -f try.c try + fi ;; esac -case "$_o" in -'') case "$obj_ext" in - '') _o='.o';; - *) _o="$obj_ext";; - esac + + +case "$usemorebits" in +"$define"|true|[yY]*) + use64bits="$define" + uselongdouble="$define" + usemorebits="$define" ;; -esac -case "$p_" in -'') case "$path_sep" in - '') p_=':';; - *) p_="$path_sep";; - esac +*) usemorebits="$undef" ;; esac -exe_ext=$_exe -lib_ext=$_a -obj_ext=$_o -path_sep=$p_ -: Which makefile gets called first. This is used by make depend. -case "$firstmakefile" in -'') firstmakefile='makefile';; -esac -cat <&4 -case "$libs" in -' '|'') dflt='';; -*) dflt="$libs";; -esac -case "$libswanted" in -'') libswanted='c_s';; -esac -case "$usesocks" in -$define) - libswanted="$libswanted socks5 socks5_sh" - ;; +case "$archname64" in +'') archname64='' ;; # not a typo esac -for thislib in $libswanted; do - - if xxx=`./loc lib$thislib.$so.[0-9]'*' X $libpth`; - $test -f "$xxx" -a "X$ignore_versioned_solibs" = "X"; then - echo "Found -l$thislib (shared)." - case " $dflt " in - *"-l$thislib "*);; - *) dflt="$dflt -l$thislib";; - esac - elif xxx=`./loc lib$thislib.$so X $libpth` ; $test -f "$xxx"; then - echo "Found -l$thislib (shared)." - case " $dflt " in - *"-l$thislib "*);; - *) dflt="$dflt -l$thislib";; - esac - elif xxx=`./loc lib$thislib$_a 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 - 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 - 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 - echo "Found -l$thislib." - case " $dflt " in - *"-l$thislib "*);; - *) dflt="$dflt -l$thislib";; - esac + +case "$use64bits" in +"$define"|true|[yY]*) +: Look for a hint-file generated 'call-back-unit'. If the +: user has specified that a 64-bit perl is to be built, +: we may need to set or change some other defaults. + if $test -f use64bits.cbu; then + echo "Your platform has some specific hints for 64-bit builds, using them..." + . ./use64bits.cbu else - echo "No -l$thislib." + $cat < tmparch 2>&1 ; then + tarch=`$sed -e 's/ *$//' -e 's/ /_/g' \ + -e 's/$/'"-$osname/" tmparch` + else + tarch="$osname" + fi + $rm -f tmparch +else + tarch="$osname" +fi +case "$myarchname" in +''|"$tarch") ;; +*) + echo "(Your architecture name used to be $myarchname.)" + archname='' + ;; esac -$cat <&4 + case "$archname" in + *-thread*) echo "...and architecture name already has -thread." >&4 + ;; + *) archname="$archname-thread" + echo "...setting architecture name to $archname." >&4 + ;; + esac + ;; esac - -dflt='' -: We will not override a previous value, but we might want to -: augment a hint file -case "$hint" in -default|recommended) - case "$gccversion" in - 1*) dflt='-fpcc-struct-return' ;; - esac - case "$optimize" in - *-g*) dflt="$dflt -DDEBUGGING";; - esac - case "$gccversion" in - 2*) if test -d /etc/conf/kconfig.d && - $contains _POSIX_VERSION $usrinc/sys/unistd.h >/dev/null 2>&1 - then - dflt="$dflt -posix" - fi +case "$usemultiplicity" in +$define) + echo "Multiplicity selected." >&4 + case "$archname" in + *-multi*) echo "...and architecture name already has -multi." >&4 + ;; + *) archname="$archname-multi" + echo "...setting architecture name to $archname." >&4 + ;; + esac + ;; +esac +case "$use64bits" in +$define) + case "$archname64" in + '') ;; - esac - case "$gccversion" in - 1*) ;; - 2.[0-8]*) ;; - ?*) echo " " - echo "Checking if your compiler accepts -fno-strict-aliasing" 2>&1 - echo 'int main(void) { return 0; }' > gcctest.c - if $cc -O2 -fno-strict-aliasing -o gcctest gcctest.c; then - echo "Yes, it does." 2>&1 - case "$ccflags" in - *strict-aliasing*) - echo "Leaving current flags $ccflags alone." 2>&1 - ;; - *) dflt="$dflt -fno-strict-aliasing" ;; - esac - else - echo "Nope, it doesn't, but that's ok." 2>&1 - fi + *) + case "$archname" in + *-$archname64*) echo "...and architecture name already has $archname64." >&4 + ;; + *) archname="$archname-$archname64" + echo "...setting architecture name to $archname." >&4 + ;; + esac ;; esac - ;; esac -case "$mips_type" in -*BSD*|'') inclwanted="$locincpth $usrinc";; -*) inclwanted="$locincpth $inclwanted $usrinc/bsd";; +: determine root of directory hierarchy where package will be installed. +case "$prefix" in +'') + dflt=`./loc . /usr/local /usr/local /local /opt /usr` + ;; +*) + dflt="$prefix" + ;; esac -for thisincl in $inclwanted; do - if $test -d $thisincl; then - if $test x$thisincl != x$usrinc; then - case "$dflt" in - *$thisincl*);; - *) dflt="$dflt -I$thisincl";; - esac - fi - fi -done - -inctest='if $contains $2 $usrinc/$1 >/dev/null 2>&1; then - xxx=true; -elif $contains $2 $usrinc/sys/$1 >/dev/null 2>&1; then - xxx=true; -else - xxx=false; -fi; -if $xxx; then - case "$dflt" in - *$2*);; - *) dflt="$dflt -D$2";; - esac; -fi' +$cat <&4 +else + echo "AFS does not seem to be running..." >&4 +fi -case "$dflt" in -''|' ') dflt=none;; -esac -$cat <&4 +if $test -r $rsrc/patchlevel.h;then + patchlevel=`awk '/define[ ]+PERL_VERSION/ {print $3}' $rsrc/patchlevel.h` + subversion=`awk '/define[ ]+PERL_SUBVERSION/ {print $3}' $rsrc/patchlevel.h` + api_revision=`awk '/define[ ]+PERL_API_REVISION/ {print $3}' $rsrc/patchlevel.h` + api_version=`awk '/define[ ]+PERL_API_VERSION/ {print $3}' $rsrc/patchlevel.h` + api_subversion=`awk '/define[ ]+PERL_API_SUBVERSION/ {print $3}' $rsrc/patchlevel.h` +else + patchlevel=0 + subversion=0 + api_revision=0 + api_version=0 + api_subversion=0 +fi +$echo $n "(You have $package" $c +case "$package" in +"*$baserev") ;; +*) $echo $n " $baserev" $c ;; esac -case "$cppflags" in -'');; +$echo $n " patchlevel $patchlevel" $c +test 0 -eq "$subversion" || $echo $n " subversion $subversion" $c +echo ".)" +case "$osname" in +dos|vms) + : XXX Should be a Configure test for double-dots in filenames. + version=`echo $baserev $patchlevel $subversion | \ + $awk '{ printf "%d_%d_%d\n", $1, $2, $3 }'` + api_versionstring=`echo $api_revision $api_version $api_subversion | \ + $awk '{ printf "%d_%d_%d\n", $1, $2, $3 }'` + ;; *) - echo " " - echo "Let me guess what the preprocessor flags are..." >&4 - set X $cppflags - shift - cppflags='' - $cat >cpp.c <<'EOM' -#define BLURFL foo - -BLURFL xx LFRULB -EOM - previous='' - for flag in $* - do - case "$flag" in - -*) ftry="$flag";; - *) ftry="$previous $flag";; - esac - if $cppstdin -DLFRULB=bar $cppflags $ftry $cppminus cpp1.out 2>/dev/null && \ - $cpprun -DLFRULB=bar $cppflags $ftry $cpplast cpp2.out 2>/dev/null && \ - $contains 'foo.*xx.*bar' cpp1.out >/dev/null 2>&1 && \ - $contains 'foo.*xx.*bar' cpp2.out >/dev/null 2>&1 - then - cppflags="$cppflags $ftry" - previous='' - else - previous="$flag" - fi - done - set X $cppflags - shift - cppflags=${1+"$@"} - case "$cppflags" in - *-*) echo "They appear to be: $cppflags";; - esac - $rm -f cpp.c cpp?.out + version=`echo $baserev $patchlevel $subversion | \ + $awk '{ printf "%d.%d.%d\n", $1, $2, $3 }'` + api_versionstring=`echo $api_revision $api_version $api_subversion | \ + $awk '{ printf "%d.%d.%d\n", $1, $2, $3 }'` ;; esac +: Special case the 5.005_xx maintenance series, which used 5.005 +: without any subversion label as a subdirectory in $sitelib +if test "${api_revision}${api_version}${api_subversion}" = "550"; then + api_versionstring='5.005' +fi -: flags used in final linking phase -case "$ldflags" in -'') if ./venix; then - dflt='-i -z' - else - dflt='' - fi - case "$ccflags" in - *-posix*) dflt="$dflt -posix" ;; +: determine installation style +: For now, try to deduce it from prefix unless it is already set. +: Reproduce behavior of 5.005 and earlier, maybe drop that in 5.7. +case "$installstyle" in +'') case "$prefix" in + *perl*) dflt='lib';; + *) dflt='lib/perl5' ;; esac ;; -*) dflt="$ldflags";; +*) dflt='lib/perl5' ;; esac +: Probably not worth prompting for this since we prompt for all +: the directories individually, and the prompt would be too long and +: confusing anyway. +installstyle=$dflt -: Try to guess additional flags to pick up local libraries. -for thislibdir in $libpth; do - case " $loclibpth " in - *" $thislibdir "*) - case "$dflt " in - *"-L$thislibdir "*) ;; - *) dflt="$dflt -L$thislibdir" ;; - esac - ;; - esac -done - -case "$dflt" in -'') dflt='none' ;; +: determine where private library files go +: Usual default is /usr/local/lib/perl5/$version. +: Also allow things like /opt/perl/lib/$version, since +: /opt/perl/lib/perl5... would be redundant. +: The default "style" setting is made in installstyle.U +case "$installstyle" in +*lib/perl5*) set dflt privlib lib/$package/$version ;; +*) set dflt privlib lib/$version ;; esac +eval $prefixit +$cat <&4 -$cat > try.c <<'EOF' -#include -int main() { printf("Ok\n"); exit(0); } -EOF -set X $cc $optimize $ccflags -o try $ldflags try.c $libs -shift -$cat >try.msg <<'EOM' -I've tried to compile and run the following simple program: +$spackage contains architecture-dependent library files. If you are +sharing libraries in a heterogeneous environment, you might store +these files in a separate location. Otherwise, you can just include +them with the rest of the public library files. EOM -$cat try.c >> try.msg +fn=d+~ +rp='Where do you want to put the public architecture-dependent libraries?' +. ./getfile +archlib="$ans" +archlibexp="$ansexp" +if $test X"$archlib" = X"$privlib"; then + d_archlib="$undef" +else + d_archlib="$define" +fi +: Change installation prefix, if necessary. +if $test X"$prefix" != X"$installprefix"; then + installarchlib=`echo $archlibexp | sed "s#^$prefix#$installprefix#"` +else + installarchlib="$archlibexp" +fi -$cat >> try.msg <>try.msg 2>&1; then - if sh -c './try' >>try.msg 2>&1; then - xxx=`./try` - case "$xxx" in - "Ok") dflt=n ;; - *) echo 'The program compiled OK, but produced no output.' >> try.msg - case " $libs " in - *" -lsfio "*) - cat >> try.msg <<'EOQS' -If $libs contains -lsfio, and sfio is mis-configured, then it -sometimes (apparently) runs and exits with a 0 status, but with no -output! It may have to do with sfio's use of _exit vs. exit. -EOQS - rp="You have a big problem. Shall I abort Configure" - dflt=y - ;; +val="$undef" +if $test -d /dev/fd; then + echo "#!$ls" >reflect + chmod +x,u+s reflect + ./reflect >flect 2>&1 + if $contains "/dev/fd" flect >/dev/null; then + echo "Congratulations, your kernel has secure setuid scripts!" >&4 + val="$define" + else + $cat <&4 + dflt=n;; + "$undef") + echo "Well, the $hint value is *not* secure." >&4 + dflt=n;; + *) echo "Well, the $hint value *is* secure." >&4 + dflt=y;; esac ;; + *) + $rm -f reflect flect + echo "#!$ls" >reflect + chmod +x,u+s reflect + echo >flect + chmod a+w flect + echo '"su" will (probably) prompt you for '"$ans's password." + su $ans -c './reflect >flect' + if $contains "/dev/fd" flect >/dev/null; then + echo "Okay, it looks like setuid scripts are secure." >&4 + dflt=y + else + echo "I don't think setuid scripts are secure." >&4 + dflt=n + fi + ;; + esac + rp='Does your kernel have *secure* setuid scripts?' + . ./myread + case "$ans" in + [yY]*) val="$define";; + *) val="$undef";; esac - else - echo "The program compiled OK, but exited with status $?." >>try.msg - rp="You have a problem. Shall I abort Configure" - dflt=y fi else - echo "I can't compile the test program." >>try.msg - rp="You have a BIG problem. Shall I abort Configure" - dflt=y + echo "I don't think setuid scripts are secure (no /dev/fd directory)." >&4 + echo "(That's for file descriptors, not floppy disks.)" + val="$undef" fi -case "$dflt" in -y) - $cat try.msg >&4 - case "$knowitall" in - '') - echo "(The supplied flags or libraries might be incorrect.)" - ;; - *) dflt=n;; +set d_suidsafe +eval $setvar + +$rm -f reflect flect + +: now see if they want to do setuid emulation +echo " " +val="$undef" +case "$d_suidsafe" in +"$define") + val="$undef" + echo "No need to emulate SUID scripts since they are secure here." >& 4 + ;; +*) + $cat <&4 - exit 1 - ;; + [yY]*) val="$define";; + *) val="$undef";; esac ;; -n) echo "OK, that should do.";; esac -$rm -f try try.* core +set d_dosuid +eval $setvar : determine filename position in cpp output echo " " @@ -4807,11 +5189,11 @@ case "$vendorprefix" in ;; *) d_vendorlib="$define" : determine where vendor-supplied modules go. - : Usual default is /usr/local/lib/perl5/vendor_perl + : Usual default is /usr/local/lib/perl5/vendor_perl/$version prog=`echo $package | $sed 's/-*[0-9.]*$//'` case "$installstyle" in - *lib/perl5*) dflt=$vendorprefix/lib/$package/vendor_$prog ;; - *) dflt=$vendorprefix/lib/vendor_$prog ;; + *lib/perl5*) dflt=$vendorprefix/lib/$package/vendor_$prog/$version ;; + *) dflt=$vendorprefix/lib/vendor_$prog/$version ;; esac fn=d~+ rp='Pathname for the vendor-supplied library files?' @@ -4888,6 +5270,152 @@ else installbin="$binexp" fi +$cat < getverlist <> getverlist <<'EOPL' +# Can't have leading @ because metaconfig interprets it as a command! +;@inc_version_list=(); +$stem=dirname($sitelib); +# Redo to do opendir/readdir? +if (-d $stem) { + chdir($stem); + ;@candidates = glob("5.*"); +} +else { + ;@candidates = (); +} + +# XXX ToDo: These comparisons must be reworked when two-digit +# subversions come along, so that 5.7.10 compares as greater than +# 5.7.3! By that time, hope that 5.6.x is sufficiently +# widespread that we can use the built-in version vectors rather +# than reinventing them here. For 5.6.0, however, we must +# assume this script will likely be run by 5.005_0x. --AD 1/2000. +foreach $d (@candidates) { + if ($d lt $version) { + if ($d ge $api_versionstring) { + unshift(@inc_version_list, "$d/$archname", $d); + } + elsif ($d ge "5.005") { + unshift(@inc_version_list, $d); + } + } + else { + # Skip newer version. I.e. don't look in + # 5.7.0 if we're installing 5.6.1. + } +} + +if (@inc_version_list) { + print '"'; + print join('", "', @inc_version_list); + print '"'; +} +else { + # Blank space to preserve value for next Configure run. + print " "; +} +EOPL +chmod +x getverlist +case "$inc_version_list" in +'') if test -x $perl; then + dflt=`$perl getverlist` + else + dflt='' + fi + ;; +*) dflt="$inc_version_list" ;; +esac +$cat <<'EOM' + +In order to ease the process of upgrading, this version of perl +can be configured to use modules built and installed with earlier +versions of perl that were installed under $prefix. Specify here +the list of earlier versions that this version of perl should check. +If Configure detected no earlier versions of perl installed under +$prefix, then the list will be empty. + +The default should almost always be sensible, so if you're not sure, +just accept the default. +EOM + +rp='list of earlier versions to include in @INC?' +. ./myread +inc_version_list="$ans" +$rm -f getverlist + : determine whether to install perl also as /usr/bin/perl echo " " @@ -4913,17 +5441,6 @@ fi set installusrbinperl eval $setvar -: define a shorthand compile call -compile=' -mc_file=$1; -shift; -$cc $optimize $ccflags $ldflags -o ${mc_file} $* ${mc_file}.c $libs > /dev/null 2>&1;' -: define a shorthand compile call for compilations that should be ok. -compile_ok=' -mc_file=$1; -shift; -$cc $optimize $ccflags $ldflags -o ${mc_file} $* ${mc_file}.c $libs;' - echo " " echo "Checking for GNU C Library..." >&4 cat >gnulibc.c < hosts && \ $test -s hosts } || { + test "X$hostcat" != "X" && $hostcat | $sed -n -e "s/[ ]*#.*//; s/\$/ / /[ ]$myhostname[ . ]/p" > hosts } @@ -6437,85 +6958,20 @@ if $test "X$ansexp" != "X$scriptdirexp"; then installscript='' fi scriptdir="$ans" -scriptdirexp="$ansexp" -: Change installation prefix, if necessary. -if $test X"$prefix" != X"$installprefix"; then - installscript=`echo $scriptdirexp | sed "s#^$prefix#$installprefix#"` -else - installscript="$scriptdirexp" -fi - -$cat <. Versions 5.003_02 and later of perl allow alternate IO -mechanisms via a "PerlIO" abstraction, but the stdio mechanism is still -the default. This abstraction layer can use AT&T's sfio (if you already -have sfio installed) or regular stdio. Using PerlIO with sfio may cause -problems with some extension modules. Using PerlIO with stdio is safe, -but it is slower than plain stdio and therefore is not the default. - -If this doesn't make any sense to you, just accept the default 'n'. -EOM -case "$useperlio" in -$define|true|[yY]*) dflt='y';; -*) dflt='n';; -esac -rp='Use the experimental PerlIO abstraction layer?' -. ./myread -case "$ans" in -y|Y) - val="$define" - ;; -*) - echo "Ok, doing things the stdio way" - val="$undef" - ;; -esac -set useperlio -eval $setvar - -: Check how to convert floats to strings. -if test "X$d_Gconvert" = X; then - echo " " - echo "Checking for an efficient way to convert floats to strings." - $cat >try.c <<'EOP' -#ifdef TRY_gconvert -#define Gconvert(x,n,t,b) gconvert((x),(n),(t),(b)) -char *myname = "gconvert"; -#endif -#ifdef TRY_gcvt -#define Gconvert(x,n,t,b) gcvt((x),(n),(b)) -char *myname = "gcvt"; -#endif -#ifdef TRY_sprintf -#define Gconvert(x,n,t,b) sprintf((b),"%.*g",(n),(x)) -char *myname = "sprintf"; -#endif - -#include - -int -checkit(expect, got) -char *expect; -char *got; -{ - if (strcmp(expect, got)) { - printf("%s oddity: Expected %s, got %s\n", - myname, expect, got); - exit(1); - } -} - -int main() -{ - char buf[64]; - buf[63] = '\0'; - - /* This must be 1st test on (which?) platform */ - /* Alan Burlison */ - Gconvert(0.1, 8, 0, buf); - checkit("0.1", buf); - - Gconvert(1.0, 8, 0, buf); - checkit("1", buf); - - Gconvert(0.0, 8, 0, buf); - checkit("0", buf); - - Gconvert(-1.0, 8, 0, buf); - checkit("-1", buf); - - /* Some Linux gcvt's give 1.e+5 here. */ - Gconvert(100000.0, 8, 0, buf); - checkit("100000", buf); - - /* Some Linux gcvt's give -1.e+5 here. */ - Gconvert(-100000.0, 8, 0, buf); - checkit("-100000", buf); - - exit(0); -} -EOP - case "$d_Gconvert" in - gconvert*) xxx_list='gconvert gcvt sprintf' ;; - gcvt*) xxx_list='gcvt gconvert sprintf' ;; - sprintf*) xxx_list='sprintf gconvert gcvt' ;; - *) xxx_list='gconvert gcvt sprintf' ;; - esac - - for xxx_convert in $xxx_list; do - echo "Trying $xxx_convert" - $rm -f try try$_o - set try -DTRY_$xxx_convert - if eval $compile; then - echo "$xxx_convert" found. >&4 - if ./try; then - echo "I'll use $xxx_convert to convert floats into a string." >&4 - break; - else - echo "...But $xxx_convert didn't work as I expected." - fi - else - echo "$xxx_convert NOT found." >&4 - fi - done - - case "$xxx_convert" in - gconvert) d_Gconvert='gconvert((x),(n),(t),(b))' ;; - gcvt) d_Gconvert='gcvt((x),(n),(b))' ;; - *) d_Gconvert='sprintf((b),"%.*g",(n),(x))' ;; - esac -fi - -: see if inttypes.h is available -: we want a real compile instead of Inhdr because some systems -: have an inttypes.h which includes non-existent headers -echo " " -$cat >try.c < -int main() { - static int32_t foo32 = 0x12345678; -} -EOCP -set try -if eval $compile; then - echo " found." >&4 - val="$define" -else - echo " NOT found." >&4 - val="$undef" -fi -$rm -f try.c try -set i_inttypes -eval $setvar - -: check for int64_t -case "$use64bits" in -"$define" ) - echo " " - echo $n "Checking to see if your system supports int64_t...$c" >&4 - $cat >try.c < -#$i_inttypes I_INTTYPES -#ifdef I_INTTYPES -#include -#endif -int64_t foo() { int64_t x; x = 7; return x; } -EOCP - if $cc $optimize $ccflags -c try.c >/dev/null 2>&1; then - val="$define" - echo " Yup, it does." >&4 - else - val="$undef" - echo " Nope, it doesn't." >&4 - fi - $rm -f try.* - ;; -*) val="$undef" - ;; -esac -set d_int64t -eval $setvar - - -: check for lengths of integral types -echo " " -case "$intsize" in -'') - echo "Checking to see how big your integers are..." >&4 - $cat >intsize.c <<'EOCP' -#include -int main() -{ - printf("intsize=%d;\n", sizeof(int)); - printf("longsize=%d;\n", sizeof(long)); - printf("shortsize=%d;\n", sizeof(short)); - exit(0); -} -EOCP - set intsize - if eval $compile_ok && ./intsize > /dev/null; then - eval `./intsize` - echo "Your integers are $intsize bytes long." - echo "Your long integers are $longsize bytes long." - echo "Your short integers are $shortsize bytes long." - else - $cat >&4 <&4 -echo 'long long foo() { long long x; x = 7; return x; }' > try.c -if $cc $optimize $ccflags -c try.c >/dev/null 2>&1; then - val="$define" - echo " Yup, it does." >&4 -else - val="$undef" - echo " Nope, it doesn't." >&4 -fi -$rm try.* -set d_longlong -eval $setvar -: check for length of long long -case "${d_longlong}${longlongsize}" in -$define) - echo " " - $echo $n "Checking to see how big your long longs are...$c" >&4 - $cat >try.c <<'EOCP' -#include -int main() -{ - printf("%d\n", sizeof(long long)); -} -EOCP - set try - if eval $compile_ok; then - longlongsize=`./try` - $echo " $longlongsize bytes." >&4 +case "$uselongdouble" in +$define) +: Look for a hint-file generated 'call-back-unit'. If the +: user has specified that long doubles should be used, +: we may need to set or change some other defaults. + if $test -f uselongdouble.cbu; then + echo "Your platform has some specific hints for long doubles, using them..." + . ./uselongdouble.cbu else - dflt='8' - echo " " - echo "(I can't seem to compile the test program. Guessing...)" - rp="What is the size of a long long (in bytes)?" - . ./myread - longlongsize="$ans" + $cat <&4 +cat <try.c <<'EOCP' -#include -#include -int main() { - int q = 12345678901; - printf("%ld\n", q); -} -EOCP - set try - if eval $compile; then - yyy=`./try$exe_ext` - case "$yyy" in - 12345678901) - sPRId64='"d"'; sPRIi64='"i"'; sPRIu64='"u"'; - sPRIo64='"o"'; sPRIx64='"x"'; sPRIX64='"X"'; - echo "We will use %d." - ;; - esac - fi -fi +Perl can be built to take advantage of long longs which +(if available) may give more range for integer numbers. -if $test X"$sPRId64" = X -a X"$longsize" = X8; then - quad=long - $cat >try.c <<'EOCP' -#include -#include -int main() { - long q = 12345678901; - printf("%ld\n", q); -} -EOCP - set try - if eval $compile; then - yyy=`./try$exe_ext` - case "$yyy" in - 12345678901) - sPRId64='"ld"'; sPRIi64='"li"'; sPRIu64='"lu"'; - sPRIo64='"lo"'; sPRIx64='"lx"'; sPRIX64='"lX"'; - echo "We will use %ld." - ;; - esac - fi -fi +If this doesn't make any sense to you, just accept the default 'n'. +EOM -if $test X"$sPRId64" = X -a X"$i_inttypes.h" = X"$define" -a X"$d_int64t" = X"$define"; then - quad=int64_t - $cat >try.c <<'EOCP' -#include -#include -#include -int main() { - int64_t q = 12345678901; - printf("%" PRId64 "\n", q); -} -EOCP - set try - if eval $compile; then - yyy=`./try$exe_ext` - case "$yyy" in - 12345678901) - sPRId64=PRId64; sPRIi64=PRIi64; sPRIu64=PRIu64; - sPRIo64=PRIo64; sPRIx64=PRIx64; sPRIX64=PRIX64; - echo "We will use the C9X style." - ;; - esac - fi -fi +case "$ccflags" in +*-DUSE_LONG_LONG*) uselonglong="$define" ;; +esac -if $test X"$sPRId64" = X -a X"$d_longlong" = X"$define" -a X"$longlongsize" = X8; then - quad="long long" - $cat >try.c <<'EOCP' -#include -#include -int main() { - long long q = 12345678901LL; /* AIX cc requires the LL prefix. */ - printf("%lld\n", q); -} -EOCP - set try - if eval $compile; then - yyy=`./try$exe_ext` - case "$yyy" in - 12345678901) - sPRId64='"lld"'; sPRIi64='"lli"'; sPRIu64='"llu"'; - sPRIo64='"llo"'; sPRIx64='"llx"'; sPRIX64='"llX"'; - echo "We will use the %lld style." - ;; - esac - fi -fi +case "$uselonglong" in +$define|true|[yY]*) dflt='y';; +*) dflt='n';; +esac +rp='Try to use long longs if available?' +. ./myread +case "$ans" in +y|Y) val="$define" ;; +*) val="$undef" ;; +esac +set uselonglong +eval $setvar -if $test X"$sPRId64" = X -a X"$quad" != X; then - $cat >try.c < -#include -int main() { - $quad q = 12345678901; - printf("%Ld\n", q); -} -EOCP - set try - if eval $compile; then - yyy=`./try$exe_ext` - case "$yyy" in - 12345678901) - sPRId64='"Ld"'; sPRIi64='"Li"'; sPRIu64='"Lu"'; - sPRIo64='"Lo"'; sPRIx64='"Lx"'; sPRIX64='"LX"'; - echo "We will use %lld." - ;; - esac - fi -fi +case "$uselonglong" in +true|[yY]*) uselonglong="$define" ;; +esac -if $test X"$sPRId64" = X -a X"$quad" != X; then - $cat >try.c < -#include -int main() { - $quad q = 12345678901; - printf("%qd\n", q); -} -EOCP - set try - if eval $compile; then - yyy=`./try$exe_ext` - case "$yyy" in - 12345678901) - sPRId64='"qd"'; sPRIi64='"qi"'; sPRIu64='"qu"'; - sPRIo64='"qo"'; sPRIx64='"qx"'; sPRIX64='"qX"'; - echo "We will use %qd." - ;; - esac +case "$uselonglong" in +$define) +: Look for a hint-file generated 'call-back-unit'. If the +: user has specified that long longs should be used, +: we may need to set or change some other defaults. + if $test -f uselonglong.cbu; then + echo "Your platform has some specific hints for long longs, using them..." + . ./uselonglong.cbu + else + $cat <&4 -fi +cat <. Versions 5.003_02 and later of perl allow alternate IO +mechanisms via a "PerlIO" abstraction, but the stdio mechanism is still +the default. This abstraction layer can use AT&T's sfio (if you already +have sfio installed) or regular stdio. Using PerlIO with sfio may cause +problems with some extension modules. Using PerlIO with stdio is safe, +but it is slower than plain stdio and therefore is not the default. -fi # intsize -o longsize -o d_int64t -o d_longlong +If this doesn't make any sense to you, just accept the default 'n'. +EOM +case "$useperlio" in +$define|true|[yY]*) dflt='y';; +*) dflt='n';; +esac +rp='Use the experimental PerlIO abstraction layer?' +. ./myread +case "$ans" in +y|Y) + val="$define" + ;; +*) + echo "Ok, doing things the stdio way" + val="$undef" + ;; +esac +set useperlio +eval $setvar -case "$sPRId64" in -'') d_PRId64="$undef"; d_PRIi64="$undef"; d_PRIu64="$undef"; - d_PRIo64="$undef"; d_PRIx64="$undef"; d_PRIX64="$undef"; +case "$vendorprefix" in +'') d_vendorbin="$undef" + vendorbin='' + vendorbinexp='' ;; -*) d_PRId64="$define"; d_PRIi64="$define"; d_PRIu64="$define"; - d_PRIo64="$define"; d_PRIx64="$define"; d_PRIX64="$define"; +*) d_vendorbin="$define" + : determine where vendor-supplied executables go. + dflt=$vendorprefix/bin + fn=d~+ + rp='Pathname for the vendor-supplied executables directory?' + . ./getfile + vendorbin="$ans" + vendorbinexp="$ansexp" + : Change installation prefix, if necessary. + if $test X"$prefix" != X"$installprefix"; then + installvendorbin=`echo $vendorbinexp | $sed "s#^$prefix#$installprefix#"` + else + installvendorbin="$vendorbinexp" + fi ;; esac @@ -7012,7 +7164,8 @@ case "$doublesize" in #include int main() { - printf("%d\n", sizeof(double)); + printf("%d\n", (int)sizeof(double)); + exit(0); } EOCP set try @@ -7032,14 +7185,15 @@ $rm -f try.c try : check for long doubles echo " " -echo $n "Checking to see if your system supports long double...$c" >&4 -echo 'long double foo() { long double x; x = 7.0; return x; }' > try.c -if $cc $optimize $ccflags -c try.c >/dev/null 2>&1; then +$echo $n "Checking to see if your system supports long double..." $c >&4 +echo 'int main() { long double x = 7.0; }' > try.c +set try +if eval $compile; then val="$define" - echo " Yup, it does." >&4 + echo " Yes, it does." >&4 else val="$undef" - echo " Nope, it doesn't." >&4 + echo " No, it doesn't." >&4 fi $rm try.* set d_longdbl @@ -7049,32 +7203,144 @@ eval $setvar case "${d_longdbl}${longdblsize}" in $define) echo " " - $echo $n "Checking to see how big your long doubles are...$c" >&4 + $echo $n "Checking to see how big your long doubles are..." $c >&4 $cat >try.c <<'EOCP' #include -int main() +int main() +{ + printf("%d\n", sizeof(long double)); +} +EOCP + set try + set try + if eval $compile; then + longdblsize=`./try$exe_ext` + $echo " $longdblsize bytes." >&4 + else + dflt='8' + echo " " + echo "(I can't seem to compile the test program. Guessing...)" >&4 + rp="What is the size of a long double (in bytes)?" + . ./myread + longdblsize="$ans" + fi + if $test "X$doublesize" = "X$longdblsize"; then + echo "(That isn't any different from an ordinary double.)" + fi + ;; +esac +$rm -f try.* try + +: Check how to convert floats to strings. +if test "X$d_Gconvert" = X; then + echo " " + echo "Checking for an efficient way to convert floats to strings." + $cat >try.c < + +#ifdef I_STDLIB +#include +#endif + +int +checkit(expect, got) +char *expect; +char *got; { - printf("%d\n", sizeof(long double)); + if (strcmp(expect, got)) { + printf("%s oddity: Expected %s, got %s\n", + myname, expect, got); + exit(1); + } } -EOCP - set try - if eval $compile; then - longdblsize=`./try` - $echo " $longdblsize bytes." >&4 - else - dflt='8' - echo " " - echo "(I can't seem to compile the test program. Guessing...)" >&4 - rp="What is the size of a long double (in bytes)?" - . ./myread - longdblsize="$ans" - fi - if $test "X$doublesize" = "X$longdblsize"; then - echo "(That isn't any different from an ordinary double.)" - fi - ;; -esac -$rm -f try.c try + +int main() +{ + char buf[64]; + buf[63] = '\0'; + + /* This must be 1st test on (which?) platform */ + /* Alan Burlison */ + Gconvert((DOUBLETYPE)0.1, 8, 0, buf); + checkit("0.1", buf); + + Gconvert((DOUBLETYPE)1.0, 8, 0, buf); + checkit("1", buf); + + Gconvert((DOUBLETYPE)0.0, 8, 0, buf); + checkit("0", buf); + + Gconvert((DOUBLETYPE)-1.0, 8, 0, buf); + checkit("-1", buf); + + /* Some Linux gcvt's give 1.e+5 here. */ + Gconvert((DOUBLETYPE)100000.0, 8, 0, buf); + checkit("100000", buf); + + /* Some Linux gcvt's give -1.e+5 here. */ + Gconvert((DOUBLETYPE)-100000.0, 8, 0, buf); + checkit("-100000", buf); + + exit(0); +} +EOP + case "$d_Gconvert" in + gconvert*) xxx_list='gconvert gcvt sprintf' ;; + gcvt*) xxx_list='gcvt gconvert sprintf' ;; + sprintf*) xxx_list='sprintf gconvert gcvt' ;; + *) xxx_list='gconvert gcvt sprintf' ;; + esac + + case "$d_longdbl$uselongdouble" in + definedefine) xxx_list="`echo $xxx_list|sed 's/gcvt/qgcvt gcvt/'`" ;; + esac + + for xxx_convert in $xxx_list; do + echo "Trying $xxx_convert..." + $rm -f try try$_o + set try -DTRY_$xxx_convert + if eval $compile; then + echo "$xxx_convert() found." >&4 + if ./try; then + echo "I'll use $xxx_convert to convert floats into a string." >&4 + break; + else + echo "...But $xxx_convert didn't work as I expected." + fi + else + echo "$xxx_convert NOT found." >&4 + fi + done + + case "$xxx_convert" in + gconvert) d_Gconvert='gconvert((x),(n),(t),(b))' ;; + gcvt) d_Gconvert='gcvt((x),(n),(b))' ;; + qgcvt) d_Gconvert='qgcvt((x),(n),(b))' ;; + *) d_Gconvert='sprintf((b),"%.*g",(n),(x))' ;; + esac +fi echo " " @@ -7577,232 +7843,91 @@ int main() if (result) exit(result); signal(SIGFPE, blech_in_list); - sprintf(str, "123."); - sscanf(str, "%lf", &f); /* f = 123.; */ - along = dummy_long((unsigned long)f); - aint = dummy_int((unsigned int)f); - ashort = dummy_short((unsigned short)f); - if (along != (unsigned long)123) - result |= 4; - if (aint != (unsigned int)123) - result |= 4; - if (ashort != (unsigned short)123) - result |= 4; - exit(result); - -} -EOCP -set try -if eval $compile_ok; then - ./try - castflags=$? -else - echo "(I can't seem to compile the test program--assuming it can't)" - castflags=7 -fi -case "$castflags" in -0) val="$define" - echo "Yup, it can." - ;; -*) val="$undef" - echo "Nope, it can't." - ;; -esac -set d_castneg -eval $setvar -$rm -f try.* - -: see if vprintf exists -echo " " -if set vprintf val -f d_vprintf; eval $csym; $val; then - echo 'vprintf() found.' >&4 - val="$define" - $cat >vprintf.c <<'EOF' -#include - -int main() { xxx("foo"); } - -xxx(va_alist) -va_dcl -{ - va_list args; - char buf[10]; - - va_start(args); - exit((unsigned long)vsprintf(buf,"%s",args) > 10L); -} -EOF - set vprintf - if eval $compile && ./vprintf; then - echo "Your vsprintf() returns (int)." >&4 - val2="$undef" - else - echo "Your vsprintf() returns (char*)." >&4 - val2="$define" - fi -else - echo 'vprintf() NOT found.' >&4 - val="$undef" - val2="$undef" -fi -set d_vprintf -eval $setvar -val=$val2 -set d_charvspr -eval $setvar - -: see if chown exists -set chown d_chown -eval $inlibc - -: see if chroot exists -set chroot d_chroot -eval $inlibc - -: see if chsize exists -set chsize d_chsize -eval $inlibc - -hasfield='varname=$1; struct=$2; field=$3; shift; shift; shift; -while $test $# -ge 2; do - case "$1" in - $define) echo "#include <$2>";; - esac ; - shift 2; -done > try.c; -echo "int main () { struct $struct foo; foo.$field = 0; }" >> try.c; -if $cc $optimize $ccflags -c try.c >/dev/null 2>&1; then - val="$define"; -else - val="$undef"; -fi; -set $varname; -eval $setvar; -$rm -f try.c try.o' - -: see if this is a sys/uio.h system -set sys/uio.h i_sysuio -eval $inhdr - -echo "Checking to see if your system supports struct iovec..." >&4 -set d_iovec_s iovec iov_base $i_sysuio sys/uio.h -eval $hasfield -case "$d_iovec_s" in -"$define") echo "Yup, it does." >&4 - ;; -*) echo "Nope, it doesn't." >&4 - ;; -esac - -socketlib='' -sockethdr='' -: see whether socket exists -echo " " -$echo $n "Hmm... $c" >&4 -if set socket val -f d_socket; eval $csym; $val; then - echo "Looks like you have Berkeley networking support." >&4 - d_socket="$define" - if set setsockopt val -f; eval $csym; $val; then - d_oldsock="$undef" - else - echo "...but it uses the old BSD 4.1c interface, rather than 4.2." >&4 - d_oldsock="$define" - fi -else - if $contains socklib libc.list >/dev/null 2>&1; then - echo "Looks like you have Berkeley networking support." >&4 - d_socket="$define" - : 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 "X$d_socket" = "X$define"; then - echo "...but you seem to believe that you have sockets." >&4 - else - for net in net socket - do - if test -f /usr/lib/lib$net$_a; then - ( ($nm $nm_opt /usr/lib/lib$net$_a | eval $nm_extract) || \ - $ar t /usr/lib/lib$net$_a) 2>/dev/null >> libc.list - if $contains socket libc.list >/dev/null 2>&1; then - d_socket="$define" - socketlib="-l$net" - case "$net" in - net) - echo "...but the Wollongong group seems to have hacked it in." >&4 - sockethdr="-I/usr/netinclude" - ;; - esac - echo "Found Berkeley sockets interface in lib$net." >& 4 - if $contains setsockopt libc.list >/dev/null 2>&1; then - d_oldsock="$undef" - else - echo "...using the old BSD 4.1c interface, rather than 4.2." >&4 - d_oldsock="$define" - fi - break - fi - fi - done - if test "X$d_socket" != "X$define"; then - echo "or anywhere else I see." >&4 - d_socket="$undef" - d_oldsock="$undef" - fi - fi - fi + sprintf(str, "123."); + sscanf(str, "%lf", &f); /* f = 123.; */ + along = dummy_long((unsigned long)f); + aint = dummy_int((unsigned int)f); + ashort = dummy_short((unsigned short)f); + if (along != (unsigned long)123) + result |= 4; + if (aint != (unsigned int)123) + result |= 4; + if (ashort != (unsigned short)123) + result |= 4; + exit(result); + +} +EOCP +set try +if eval $compile_ok; then + ./try + castflags=$? +else + echo "(I can't seem to compile the test program--assuming it can't)" + castflags=7 fi +case "$castflags" in +0) val="$define" + echo "Yup, it can." + ;; +*) val="$undef" + echo "Nope, it can't." + ;; +esac +set d_castneg +eval $setvar +$rm -f try.* -: see if socketpair exists -set socketpair d_sockpair -eval $inlibc +: see if vprintf exists +echo " " +if set vprintf val -f d_vprintf; eval $csym; $val; then + echo 'vprintf() found.' >&4 + val="$define" + $cat >vprintf.c <<'EOF' +#include +int main() { xxx("foo"); } -echo " " -echo "Checking the availability of certain socket constants..." >& 4 -for ENUM in MSG_CTRUNC MSG_DONTROUTE MSG_OOB MSG_PEEK MSG_PROXY SCM_RIGHTS; do - enum=`$echo $ENUM|./tr '[A-Z]' '[a-z]'` - $cat >try.c < -#include -int main() { - int i = $ENUM; +xxx(va_alist) +va_dcl +{ + va_list args; + char buf[10]; + + va_start(args); + exit((unsigned long)vsprintf(buf,"%s",args) > 10L); } EOF - val="$undef" - set try; if eval $compile; then - val="$define" + set vprintf + if eval $compile && ./vprintf; then + echo "Your vsprintf() returns (int)." >&4 + val2="$undef" + else + echo "Your vsprintf() returns (char*)." >&4 + val2="$define" fi - set d_${enum}; eval $setvar - $rm -f try.c try -done +else + echo 'vprintf() NOT found.' >&4 + val="$undef" + val2="$undef" +fi +set d_vprintf +eval $setvar +val=$val2 +set d_charvspr +eval $setvar -set sendmsg d_sendmsg +: see if chown exists +set chown d_chown eval $inlibc -set recvmsg d_recvmsg +: see if chroot exists +set chroot d_chroot eval $inlibc -echo " " -$echo $n "Checking to see if your system supports struct msghdr...$c" >&4 -set d_msghdr_s msghdr msg_name define sys/types.h $d_socket sys/socket.h $i_sysuio sys/uio.h -eval $hasfield -case "$d_msghdr_s" in -"$define") echo "Yup, it does." >&4 - ;; -*) echo "Nope, it doesn't." >&4 - ;; -esac - -$echo $n "Checking to see if your system supports struct cmsghdr...$c" >&4 -set d_cmsghdr_s cmsghdr cmsg_len define sys/types.h $d_socket sys/socket.h $i_sysuio sys/uio.h -eval $hasfield -case "$d_cmsghdr_s" in -"$define") echo "Yup, it does." >&4 - ;; -*) echo "Nope, it doesn't." >&4 - ;; -esac +: see if chsize exists +set chsize d_chsize +eval $inlibc : check for const keyword echo " " @@ -8208,6 +8333,28 @@ set d_open3 eval $setvar $rm -f open3* +: see which of string.h or strings.h is needed +echo " " +strings=`./findhdr string.h` +if $test "$strings" && $test -r "$strings"; then + echo "Using instead of ." >&4 + val="$define" +else + val="$undef" + strings=`./findhdr strings.h` + if $test "$strings" && $test -r "$strings"; then + echo "Using instead of ." >&4 + else + echo "No string header found -- You'll surely have problems." >&4 + fi +fi +set i_string +eval $setvar +case "$i_string" in +"$undef") strings=`./findhdr strings.h`;; +*) strings=`./findhdr string.h`;; +esac + : check for non-blocking I/O stuff case "$h_sysfile" in true) echo "#include " > head.c;; @@ -8224,6 +8371,7 @@ case "$o_nonblock" in '') $cat head.c > try.c $cat >>try.c <<'EOCP' +#include int main() { #ifdef O_NONBLOCK printf("O_NONBLOCK\n"); @@ -8264,10 +8412,20 @@ case "$eagain" in #include #include #include +#include #define MY_O_NONBLOCK $o_nonblock #ifndef errno /* XXX need better Configure test */ extern int errno; #endif +#$i_unistd I_UNISTD +#ifdef I_UNISTD +#include +#endif +#ifdef $i_string +#include +#else +#include +#endif $signal_t blech(x) int x; { exit(3); } EOCP $cat >> try.c <<'EOCP' @@ -8397,6 +8555,107 @@ eval $inlibc set fcntl d_fcntl eval $inlibc +hasfield='varname=$1; struct=$2; field=$3; shift; shift; shift; +while $test $# -ge 2; do + case "$1" in + $define) echo "#include <$2>";; + esac ; + shift 2; +done > try.c; +echo "int main () { struct $struct foo; char* bar; bar = (char*)foo.$field; }" >> try.c; +set try; +if eval $compile; then + val="$define"; +else + val="$undef"; +fi; +set $varname; +eval $setvar; +$rm -f try.c try.o' + +socketlib='' +sockethdr='' +: see whether socket exists +echo " " +$echo $n "Hmm... $c" >&4 +if set socket val -f d_socket; eval $csym; $val; then + echo "Looks like you have Berkeley networking support." >&4 + d_socket="$define" + if set setsockopt val -f; eval $csym; $val; then + d_oldsock="$undef" + else + echo "...but it uses the old BSD 4.1c interface, rather than 4.2." >&4 + d_oldsock="$define" + fi +else + if $contains socklib libc.list >/dev/null 2>&1; then + echo "Looks like you have Berkeley networking support." >&4 + d_socket="$define" + : 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 "X$d_socket" = "X$define"; then + echo "...but you seem to believe that you have sockets." >&4 + else + for net in net socket + do + if test -f /usr/lib/lib$net$_a; then + ( ($nm $nm_opt /usr/lib/lib$net$_a | eval $nm_extract) || \ + $ar t /usr/lib/lib$net$_a) 2>/dev/null >> libc.list + if $contains socket libc.list >/dev/null 2>&1; then + d_socket="$define" + socketlib="-l$net" + case "$net" in + net) + echo "...but the Wollongong group seems to have hacked it in." >&4 + sockethdr="-I/usr/netinclude" + ;; + esac + echo "Found Berkeley sockets interface in lib$net." >& 4 + if $contains setsockopt libc.list >/dev/null 2>&1; then + d_oldsock="$undef" + else + echo "...using the old BSD 4.1c interface, rather than 4.2." >&4 + d_oldsock="$define" + fi + break + fi + fi + done + if test "X$d_socket" != "X$define"; then + echo "or anywhere else I see." >&4 + d_socket="$undef" + d_oldsock="$undef" + fi + fi + fi +fi + +: see if socketpair exists +set socketpair d_sockpair +eval $inlibc + + +echo " " +echo "Checking the availability of certain socket constants..." >& 4 +for ENUM in MSG_CTRUNC MSG_DONTROUTE MSG_OOB MSG_PEEK MSG_PROXY SCM_RIGHTS; do + enum=`$echo $ENUM|./tr '[A-Z]' '[a-z]'` + $cat >try.c < +#include +int main() { + int i = $ENUM; +} +EOF + val="$undef" + set try; if eval $compile; then + val="$define" + fi + set d_${enum}; eval $setvar + $rm -f try.c try +done + : see if sys/select.h has to be included set sys/select.h i_sysselct eval $inhdr @@ -8580,54 +8839,68 @@ set fpathconf d_fpathconf eval $inlibc -: see if llseek exists -set llseek d_llseek -eval $inlibc - : check for off64_t echo " " -echo $n "Checking to see if your system supports off64_t...$c" >&4 +echo "Checking to see if your system supports off64_t..." >&4 $cat >try.c < #include -off64_t foo() { off64_t x; x = 7; return x; }' +int main() { off64_t x = 7; }' EOCP -if $cc $optimize $ccflags -c try.c >/dev/null 2>&1; then +set try +if eval $compile; then val="$define" - echo " Yup, it does." >&4 + echo "Yes, it does." else val="$undef" - echo " Nope, it doesn't." >&4 + echo "No, it doesn't." + case "$lseeksize" in + 8) echo "(Your off_t is 64 bits, so you could use that.)" ;; + esac fi -$rm -f try.* +$rm -f try.* try set d_off64_t eval $setvar : check for fpos64_t echo " " -echo $n "Checking to see if your system supports fpos64_t...$c" >&4 +echo "Checking to see if your system supports fpos64_t..." >&4 $cat >try.c < -fpos64_t foo() { fpos64_t x; x = 7; return x; }' +int main() { fpos64_t x x = 7; }' EOCP -if $cc $optimize $ccflags -c try.c >/dev/null 2>&1; then +set try +if eval $compile; then val="$define" - echo " Yup, it does." >&4 + echo "Yes, it does." else val="$undef" - echo " Nope, it doesn't." >&4 + echo "No, it doesn't." + case "$fpossize" in + 8) echo "(Your fpos_t is 64 bits, so you could use that.)" ;; + esac fi -$rm -f try.* +$rm -f try.* try set d_fpos64_t eval $setvar -: see if fseeko exists -set fseeko d_fseeko -eval $inlibc - -: see if fsetpos exists -set fsetpos d_fsetpos -eval $inlibc +hasstruct='varname=$1; struct=$2; shift; shift; +while $test $# -ge 2; do + case "$1" in + $define) echo "#include <$2>";; + esac ; + shift 2; +done > try.c; +echo "int main () { struct $struct foo; }" >> try.c; +set try; +if eval $compile; then + val="$define"; +else + val="$undef"; +fi; +set $varname; +eval $setvar; +$rm -f try.c try.o' : see if this is a sys/param system set sys/param.h i_sysparam @@ -8637,19 +8910,36 @@ eval $inhdr set sys/mount.h i_sysmount eval $inhdr +: see if sys/types.h has to be included +set sys/types.h i_systypes +eval $inhdr + + +echo " " +echo "Checking to see if your system supports struct fs_data..." >&4 +set d_fs_data_s fs_data $i_systypes sys/types.h $i_sysparam sys/param.h $i_sysmount sys/mount.h +eval $hasstruct +case "$d_fs_data_s" in +"$define") echo "Yes, it does." ;; +*) echo "No, it doesn't." ;; +esac + +: see if fseeko exists +set fseeko d_fseeko +eval $inlibc +case "$longsize" in +8) echo "(Your long is 64 bits, so in a pinch you could use fseek.)" ;; +esac -: see if statfs exists -set statfs d_statfs +: see if fsetpos exists +set fsetpos d_fsetpos eval $inlibc + : see if fstatfs exists set fstatfs d_fstatfs eval $inlibc -: see if statfs knows about mount flags -set d_statfsflags statfs f_flags $i_sysparam sys/param.h $i_sysmount sys/mount.h -eval $hasfield - : see if statvfs exists set statvfs d_statvfs @@ -8663,6 +8953,9 @@ eval $inlibc : see if ftello exists set ftello d_ftello eval $inlibc +case "$longsize" in +8) echo "(Your long is 64 bits, so in a pinch you could use ftell.)" ;; +esac : see if getgrent exists set getgrent d_getgrent @@ -8778,6 +9071,10 @@ eval $hasproto set getlogin d_getlogin eval $inlibc +: see if getmnt exists +set getmnt d_getmnt +eval $inlibc + : see if getmntent exists set getmntent d_getmntent eval $inlibc @@ -8957,28 +9254,6 @@ esac set d_htonl eval $setvar -: see which of string.h or strings.h is needed -echo " " -strings=`./findhdr string.h` -if $test "$strings" && $test -r "$strings"; then - echo "Using instead of ." >&4 - val="$define" -else - val="$undef" - strings=`./findhdr strings.h` - if $test "$strings" && $test -r "$strings"; then - echo "Using instead of ." >&4 - else - echo "No string header found -- You'll surely have problems." >&4 - fi -fi -set i_string -eval $setvar -case "$i_string" in -"$undef") strings=`./findhdr strings.h`;; -*) strings=`./findhdr string.h`;; -esac - : index or strchr echo " " if set index val -f; eval $csym; $val; then @@ -9116,14 +9391,58 @@ eval $inlibc set lockf d_lockf eval $inlibc +: check for long long +echo " " +$echo $n "Checking to see if your system supports long long..." $c >&4 +echo 'int main() { long long x = 7; return 0; }' > try.c +set try +if eval $compile; then + val="$define" + echo " Yes, it does." >&4 +else + val="$undef" + echo " No, it doesn't." >&4 +fi +$rm try.* +set d_longlong +eval $setvar + +: check for length of long long +case "${d_longlong}${longlongsize}" in +$define) + echo " " + $echo $n "Checking to see how big your long longs are..." $c >&4 + $cat >try.c <<'EOCP' +#include +int main() +{ + printf("%d\n", (int)sizeof(long long)); + return(0); +} +EOCP + set try + if eval $compile_ok; then + longlongsize=`./try$exe_ext` + $echo " $longlongsize bytes." >&4 + else + dflt='8' + echo " " + echo "(I can't seem to compile the test program. Guessing...)" + rp="What is the size of a long long (in bytes)?" + . ./myread + longlongsize="$ans" + fi + if $test "X$longsize" = "X$longlongsize"; then + echo "(That isn't any different from an ordinary long.)" + fi + ;; +esac +$rm -f try.* try + : see if lstat exists set lstat d_lstat eval $inlibc -: see if madvise exists -set madvise d_madvise -eval $inlibc - : see if mblen exists set mblen d_mblen eval $inlibc @@ -9168,37 +9487,6 @@ eval $inlibc set mktime d_mktime eval $inlibc -: see if this is a sys/mman.h system -set sys/mman.h i_sysmman -eval $inhdr - -: see if mmap exists -set mmap d_mmap -eval $inlibc -: see what shmat returns -: default to something harmless -mmaptype='void *' -case "$i_sysmman$d_mmap" in -"$define$define") - $cat >mmap.c <<'END' -#include -void *mmap(); -END - if $cc $ccflags -c mmap.c >/dev/null 2>&1; then - mmaptype='void *' - else - mmaptype='caddr_t' - fi - echo "and it returns ($mmaptype)." >&4 - ;; -esac - - - -: see if mprotect exists -set mprotect d_mprotect -eval $inlibc - : see if msgctl exists set msgctl d_msgctl eval $inlibc @@ -9251,14 +9539,6 @@ fi set d_msg eval $setvar -: see if msync exists -set msync d_msync -eval $inlibc - -: see if munmap exists -set munmap d_munmap -eval $inlibc - : see if nice exists set nice d_nice eval $inlibc @@ -9498,6 +9778,119 @@ $define) ;; esac +: see if inttypes.h is available +: we want a real compile instead of Inhdr because some systems +: have an inttypes.h which includes non-existent headers +echo " " +$cat >try.c < +int main() { + static int32_t foo32 = 0x12345678; +} +EOCP +set try +if eval $compile; then + echo " found." >&4 + val="$define" +else + echo " NOT found." >&4 + val="$undef" +fi +$rm -f try.c try +set i_inttypes +eval $setvar + +: check for int64_t +echo " " +$echo $n "Checking to see if your system supports int64_t...$c" >&4 +$cat >try.c < +#$i_inttypes I_INTTYPES +#ifdef I_INTTYPES +#include +#endif +int main() { int64_t x = 7; } +EOCP +set try +if eval $compile; then + val="$define" + echo " Yes, it does." >&4 +else + val="$undef" + echo " No, it doesn't." >&4 +fi +$rm -f try try.* +set d_int64t +eval $setvar + + +echo " " +echo "Checking which 64-bit integer type we could use..." >&4 + +case "$intsize" in +8) val=int + set quadtype + eval $setvar + val='"unsigned int"' + set uquadtype + eval $setvar + quadkind=1 + ;; +*) case "$longsize" in + 8) val=long + set quadtype + eval $setvar + val='"unsigned long"' + set uquadtype + eval $setvar + quadkind=2 + ;; + *) case "$uselonglong:$d_longlong:$longlongsize" in + define:define:8) + val='"long long"' + set quadtype + eval $setvar + val='"unsigned long long"' + set uquadtype + eval $setvar + quadkind=3 + ;; + *) case "$d_int64t" in + define) + val=int64_t + set quadtype + eval $setvar + val=uint64_t + set uquadtype + eval $setvar + quadkind=4 + ;; + esac + ;; + esac + ;; + esac + ;; +esac + +case "$quadtype" in +'') case "$uselonglong:$d_longlong:$longlongsize" in + undef:define:8) + echo "(You would have 'long long', but you are not using it.)" >&4 ;; + *) echo "Alas, no 64-bit integer types in sight." >&4 ;; + esac + d_quad="$undef" + ;; +*) if test X"$use64bits" = Xdefine -o X"$longsize" = X8; then + verb="will" + else + verb="could" + fi + echo "We $verb use '$quadtype' for 64-bit integers." >&4 + d_quad="$define" + ;; +esac + : see if readdir and friends exist set readdir d_readdir eval $inlibc @@ -9512,10 +9905,6 @@ eval $inlibc set readlink d_readlink eval $inlibc -: see if readv exists -set readv d_readv -eval $inlibc - : see if rename exists set rename d_rename eval $inlibc @@ -10224,6 +10613,8 @@ int main() struct sigaction act, oact; act.sa_flags = 0; oact.sa_handler = 0; + /* so that act and oact are used */ + exit(act.sa_flags == 0 && oact.sa_handler == 0); } EOP set try @@ -10285,15 +10676,61 @@ set d_sigsetjmp eval $setvar $rm -f try.c try +: see if sqrtl exists +set sqrtl d_sqrtl +eval $inlibc + : see if sys/stat.h is available set sys/stat.h i_sysstat eval $inhdr + : see if stat knows about block sizes echo " " +echo "Checking to see if your struct stat has st_blocks field..." >&4 set d_statblks stat st_blocks $i_sysstat sys/stat.h eval $hasfield + +: see if this is a sys/vfs.h system +set sys/vfs.h i_sysvfs +eval $inhdr + + +: see if this is a sys/statfs.h system +set sys/statfs.h i_sysstatfs +eval $inhdr + + +echo " " +echo "Checking to see if your system supports struct statfs..." >&4 +set d_statfs_s statfs $i_systypes sys/types.h $i_sysparam sys/param.h $i_sysmount sys/mount.h $i_sysvfs sys/vfs.h $i_sysstatfs sys/statfs.h +eval $hasstruct +case "$d_statfs_s" in +"$define") echo "Yes, it does." ;; +*) echo "No, it doesn't." ;; +esac + + + +: see if struct statfs knows about f_flags +case "$d_statfs_s" in +define) + echo " " + echo "Checking to see if your struct statfs has f_flags field..." >&4 + set d_statfs_f_flags statfs f_flags $i_systypes sys/types.h $i_sysparam sys/param.h $i_sysmount sys/mount.h $i_sysvfs sys/vfs.h $i_sysstatfs sys/statfs.h + eval $hasfield + ;; +*) val="$undef" + set d_statfs_f_flags + eval $setvar + ;; +esac +case "$d_statfs_f_flags" in +"$define") echo "Yes, it does." ;; +*) echo "No, it doesn't." ;; +esac + : see if _ptr and _cnt from stdio act std echo " " if $contains '_IO_fpos_t' `./findhdr stdio.h` `./findhdr libio.h` >/dev/null 2>&1 ; then @@ -10531,6 +10968,14 @@ eval $inlibc set strtol d_strtol eval $inlibc +: see if strtold exists +set strtold d_strtold +eval $inlibc + +: see if strtoll exists +set strtoll d_strtoll +eval $inlibc + : see if strtoul exists set strtoul d_strtoul eval $inlibc @@ -10539,6 +10984,10 @@ eval $inlibc set strtoull d_strtoull eval $inlibc +: see if strtouq exists +set strtouq d_strtouq +eval $inlibc + : see if strxfrm exists set strxfrm d_strxfrm eval $inlibc @@ -10567,70 +11016,10 @@ eval $inlibc set tcsetpgrp d_tcsetpgrp eval $inlibc -: see if sys/types.h has to be included -set sys/types.h i_systypes -eval $inhdr - : see if prototype for telldir is available -echo " " -set d_telldirproto telldir $i_systypes sys/types.h $i_dirent dirent.h -eval $hasproto - -: define an is-a-typedef? function -typedef='type=$1; var=$2; def=$3; shift; shift; shift; inclist=$@; -case "$inclist" in -"") inclist="sys/types.h";; -esac; -eval "varval=\$$var"; -case "$varval" in -"") - $rm -f temp.c; - for inc in $inclist; do - echo "#include <$inc>" >>temp.c; - done; - echo "#ifdef $type" >> temp.c; - echo "printf(\"We have $type\");" >> temp.c; - echo "#endif" >> temp.c; - $cppstdin $cppflags $cppminus < temp.c >temp.E 2>/dev/null; - if $contains $type temp.E >/dev/null 2>&1; then - eval "$var=\$type"; - else - eval "$var=\$def"; - fi; - $rm -f temp.?;; -*) eval "$var=\$varval";; -esac' - -: define an is-a-typedef? function that prompts if the type is not available. -typedef_ask='type=$1; var=$2; def=$3; shift; shift; shift; inclist=$@; -case "$inclist" in -"") inclist="sys/types.h";; -esac; -eval "varval=\$$var"; -case "$varval" in -"") - $rm -f temp.c; - for inc in $inclist; do - echo "#include <$inc>" >>temp.c; - done; - echo "#ifdef $type" >> temp.c; - echo "printf(\"We have $type\");" >> temp.c; - echo "#endif" >> temp.c; - $cppstdin $cppflags $cppminus < temp.c >temp.E 2>/dev/null; - echo " " ; - echo "$rp" | $sed -e "s/What is/Looking for/" -e "s/?/./"; - if $contains $type temp.E >/dev/null 2>&1; then - echo "$type found." >&4; - eval "$var=\$type"; - else - echo "$type NOT found." >&4; - dflt="$def"; - . ./myread ; - eval "$var=\$ans"; - fi; - $rm -f temp.?;; -*) eval "$var=\$varval";; -esac' +echo " " +set d_telldirproto telldir $i_systypes sys/types.h $i_dirent dirent.h +eval $hasproto : see if this is a sys/times.h system set sys/times.h i_systimes @@ -10674,6 +11063,10 @@ eval $setvar set umask d_umask eval $inlibc +: see if ustat exists +set ustat d_ustat +eval $inlibc + : backward compatibility for d_hvfork if test X$d_hvfork != X; then d_vfork="$d_hvfork" @@ -10833,10 +11226,6 @@ eval $inlibc set wctomb d_wctomb eval $inlibc -: see if writev exists -set writev d_writev -eval $inlibc - : preserve RCS keywords in files with variable substitution, grrr Date='$Date' Id='$Id' @@ -10872,13 +11261,15 @@ EOM case "$alignbytes" in '') echo "Checking alignment constraints..." >&4 $cat >try.c <<'EOCP' +#include struct foobar { char foo; double bar; } try_algn; int main() { - printf("%d\n", (char *)&try_algn.bar - (char *)&try_algn.foo); + printf("%d\n", (int)((char *)&try_algn.bar - (char *)&try_algn.foo)); + return(0); } EOCP set try @@ -11066,7 +11457,7 @@ int main() } EOCP set try - if eval $compile && ./try; then + if eval $compile_ok && ./try; then echo 'Looks OK.' >&4 else echo "I can't use Berkeley DB with your . I'll disable Berkeley DB." >&4 @@ -11144,518 +11535,1025 @@ define) #include #include -#ifndef DB_VERSION_MAJOR -size_t prefix_cb (key1, key2) -const DBT *key1; -const DBT *key2; -{ -} -BTREEINFO info; +#ifndef DB_VERSION_MAJOR +size_t prefix_cb (key1, key2) +const DBT *key1; +const DBT *key2; +{ +} +BTREEINFO info; +int main() +{ + info.prefix = prefix_cb; +} +#endif +EOCP + if $cc $ccflags -c try.c >try.out 2>&1 ; then + if $contains warning try.out >>/dev/null 2>&1 ; then + db_prefixtype='int' + else + db_prefixtype='size_t' + fi + else + db_prefixtype='size_t' + : XXX Maybe we should just give up here. + $cat try.out >&4 + echo "Help: I can't seem to compile the db test program." >&4 + echo "Something's wrong, but I'll assume you use $db_prefixtype." >&4 + fi + $rm -f try.* + echo "Your version of Berkeley DB uses $db_prefixtype for prefix." + ;; +*) db_prefixtype='size_t' + ;; +esac + +: check for void type +echo " " +echo "Checking to see how well your C compiler groks the void type..." >&4 +case "$voidflags" in +'') + $cat >try.c <<'EOCP' +#if TRY & 1 +void sub() { +#else +sub() { +#endif + extern void moo(); /* function returning void */ + void (*goo)(); /* ptr to func returning void */ +#if TRY & 8 + void *hue; /* generic ptr */ +#endif +#if TRY & 2 + void (*foo[10])(); +#endif + +#if TRY & 4 + if(goo == moo) { + exit(0); + } +#endif + exit(0); +} +int main() { sub(); } +EOCP + if $cc $ccflags -c -DTRY=$defvoidused try.c >.out 2>&1 ; then + voidflags=$defvoidused + echo "Good. It appears to support void to the level $package wants.">&4 + if $contains warning .out >/dev/null 2>&1; then + echo "However, you might get some warnings that look like this:" + $cat .out + fi + else +echo "Hmm, your compiler has some difficulty with void. Checking further..." >&4 + if $cc $ccflags -c -DTRY=1 try.c >/dev/null 2>&1; then + echo "It supports 1..." + if $cc $ccflags -c -DTRY=3 try.c >/dev/null 2>&1; then + echo "It also supports 2..." + if $cc $ccflags -c -DTRY=7 try.c >/dev/null 2>&1; then + voidflags=7 + echo "And it supports 4 but not 8 definitely." + else + echo "It doesn't support 4..." + if $cc $ccflags -c -DTRY=11 try.c >/dev/null 2>&1; then + voidflags=11 + echo "But it supports 8." + else + voidflags=3 + echo "Neither does it support 8." + fi + fi + else + echo "It does not support 2..." + if $cc $ccflags -c -DTRY=13 try.c >/dev/null 2>&1; then + voidflags=13 + echo "But it supports 4 and 8." + else + if $cc $ccflags -c -DTRY=5 try.c >/dev/null 2>&1; then + voidflags=5 + echo "And it supports 4 but has not heard about 8." + else + echo "However it supports 8 but not 4." + fi + fi + fi + else + echo "There is no support at all for void." + voidflags=0 + fi + fi +esac +case "$voidflags" in +"$defvoidused") ;; +*) $cat >&4 <<'EOM' + Support flag bits are: + 1: basic void declarations. + 2: arrays of pointers to functions returning void. + 4: operations between pointers to and addresses of void functions. + 8: generic void pointers. +EOM + dflt="$voidflags"; + rp="Your void support flags add up to what?" + . ./myread + voidflags="$ans" + ;; +esac +$rm -f try.* .out + + +: How can we generate normalized random numbers ? +echo " " +echo "Looking for a random number function..." >&4 +case "$randfunc" in +'') + if set drand48 val -f; eval $csym; $val; then + dflt="drand48" + echo "Good, found drand48()." >&4 + elif set random val -f; eval $csym; $val; then + dflt="random" + echo "OK, found random()." >&4 + else + dflt="rand" + echo "Yick, looks like I have to use rand()." >&4 + fi + echo " " + ;; +*) + dflt="$randfunc" + ;; +esac +cont=true + +case "$ccflags" in +*-Dmy_rand=*|*-Dmy_srand=*) + echo "Removing obsolete -Dmy_rand, -Dmy_srand, and -Drandbits from ccflags." >&4 + ccflags="`echo $ccflags | sed -e 's/-Dmy_rand=random/ /'`" + ccflags="`echo $ccflags | sed -e 's/-Dmy_srand=srandom/ /'`" + ccflags="`echo $ccflags | sed -e 's/-Drandbits=[0-9][0-9]*/ /'`" + ;; +esac + +while $test "$cont"; do + rp="Use which function to generate random numbers?" + . ./myread + if $test "$ans" = "$dflt"; then + : null + else + randbits='' + fi + randfunc="$ans" + if set $ans val -f; eval $csym; $val; then + cont='' + else + dflt=y + rp="I cannot find function $ans. Use that name anyway?" + . ./myread + dflt=rand + case "$ans" in + [yY]*) cont='';; + esac + fi + case "$cont" in + '') + case "$randfunc" in + drand48) + drand01="drand48()" + seedfunc="srand48" + randbits=48 + randseedtype=long + ;; + rand|random) + case "$randbits" in + '') +echo "Checking to see how many bits your $randfunc() function produces..." >&4 + $cat >try.c < +#ifdef I_UNISTD +# include +#endif +#ifdef I_STDLIB +# include +#endif +int main() +{ + register int i; + register unsigned long tmp; + register unsigned long max = 0L; + + for (i = 1000; i; i--) { + tmp = (unsigned long) $randfunc(); + if (tmp > max) max = tmp; + } + for (i = 0; max; i++) + max /= 2; + printf("%d\n",i); +} +EOCP + set try + if eval $compile_ok; then + dflt=`try` + else + dflt='?' + echo "(I can't seem to compile the test program...)" + fi + ;; + *) + dflt="$randbits" + ;; + esac + rp="How many bits does your $randfunc() function produce?" + . ./myread + randbits="$ans" + $rm -f try.c try + drand01="($randfunc() / (double) ((unsigned long)1 << $randbits))" + seedfunc="s$randfunc" + randseedtype=unsigned + ;; + *) + dflt="31" + rp="How many bits does your $randfunc() function produce?" + . ./myread + randbits="$ans" + seedfunc="s$randfunc" + drand01="($randfunc() / (double) ((unsigned long)1 << $randbits))" + if set $seedfunc val -f; eval $csym; $val; then + echo "(Using $seedfunc() to seed random generator)" + else + echo "(Warning: no $seedfunc() to seed random generator)" + seedfunc=rand + fi + randseedtype=unsigned + ;; + esac + ;; + esac +done + +echo " " +echo "Determining whether or not we are on an EBCDIC system..." >&4 +$cat >tebcdic.c <<'EOM' int main() { - info.prefix = prefix_cb; + if ('M'==0xd4) return 0; + return 1; } -#endif -EOCP - if $cc $ccflags -c try.c >try.out 2>&1 ; then - if $contains warning try.out >>/dev/null 2>&1 ; then - db_prefixtype='int' - else - db_prefixtype='size_t' - fi +EOM + +val=$undef +set tebcdic +if eval $compile_ok; then + if ./tebcdic; then + echo "You have EBCDIC." >&4 + val="$define" else - db_prefixtype='size_t' - : XXX Maybe we should just give up here. - $cat try.out >&4 - echo "Help: I can't seem to compile the db test program." >&4 - echo "Something's wrong, but I'll assume you use $db_prefixtype." >&4 + echo "Nope, no EBCDIC, probably ASCII or some ISO Latin." >&4 fi - $rm -f try.* - echo "Your version of Berkeley DB uses $db_prefixtype for prefix." - ;; -*) db_prefixtype='size_t' - ;; -esac +else + echo "I'm unable to compile the test program." >&4 + echo "I'll assume ASCII or some ISO Latin." >&4 +fi +$rm -f tebcdic.c tebcdic +set ebcdic +eval $setvar -: check for void type echo " " -echo "Checking to see how well your C compiler groks the void type..." >&4 -case "$voidflags" in -'') - $cat >try.c <<'EOCP' -#if TRY & 1 -void sub() { -#else -sub() { +$cat >&4 < try.c ;; +esac +$cat >>try.c < +#$i_unistd I_UNISTD +#ifdef I_UNISTD +# include #endif - extern void moo(); /* function returning void */ - void (*goo)(); /* ptr to func returning void */ -#if TRY & 8 - void *hue; /* generic ptr */ +#$d_sysconf HAS_SYSCONF +#$d_stdio_stream_array HAS_STDIO_STREAM_ARRAY +#ifdef HAS_STDIO_STREAM_ARRAY +# define STDIO_STREAM_ARRAY $stdio_stream_array #endif -#if TRY & 2 - void (*foo[10])(); +int main() { + FILE* p = fopen("try.out", "w"); +#ifdef TRY_FPUTC + fputc('x', p); +#else +# ifdef TRY_FPRINTF + fprintf(p, "x"); +# endif #endif - -#if TRY & 4 - if(goo == moo) { - exit(0); - } +#ifdef TRY_FFLUSH_NULL + fflush(NULL); #endif - exit(0); +#ifdef TRY_FFLUSH_ALL + { + long open_max = -1; +# ifdef PERL_FFLUSH_ALL_FOPEN_MAX + open_max = PERL_FFLUSH_ALL_FOPEN_MAX; +# else +# if defined(HAS_SYSCONF) && defined(_SC_OPEN_MAX) + open_max = sysconf(_SC_OPEN_MAX); +# else +# ifdef FOPEN_MAX + open_max = FOPEN_MAX; +# else +# ifdef OPEN_MAX + open_max = OPEN_MAX; +# else +# ifdef _NFILE + open_max = _NFILE; +# endif +# endif +# endif +# endif +# endif +# ifdef HAS_STDIO_STREAM_ARRAY + if (open_max > 0) { + long i; + for (i = 0; i < open_max; i++) + if (STDIO_STREAM_ARRAY[i]._file >= 0 && + STDIO_STREAM_ARRAY[i]._file < open_max && + STDIO_STREAM_ARRAY[i]._flag) + fflush(&STDIO_STREAM_ARRAY[i]); + } + } +# endif +#endif + _exit(42); } -int main() { sub(); } EOCP - if $cc $ccflags -c -DTRY=$defvoidused try.c >.out 2>&1 ; then - voidflags=$defvoidused - echo "Good. It appears to support void to the level $package wants.">&4 - if $contains warning .out >/dev/null 2>&1; then - echo "However, you might get some warnings that look like this:" - $cat .out +: first we have to find out how _not_ to flush +if $test "X$fflushNULL" = X -o "X$fflushall" = X; then + output='' + set try -DTRY_FPUTC + if eval $compile; then + $rm -f try.out + ./try$exe_ext 2>/dev/null + if $test ! -s try.out -a "X$?" = X42; then + output=-DTRY_FPUTC + fi + fi + case "$output" in + '') + set try -DTRY_FPRINTF + $rm -f try.out + if eval $compile; then + $rm -f try.out + ./try$exe_ext 2>/dev/null + if $test ! -s try.out -a "X$?" = X42; then + output=-DTRY_FPRINTF + fi + fi + ;; + esac +fi +: check for fflush NULL behaviour +case "$fflushNULL" in +'') set try -DTRY_FFLUSH_NULL $output + if eval $compile; then + $rm -f try.out + ./try$exe_ext 2>/dev/null + code="$?" + if $test -s try.out -a "X$code" = X42; then + fflushNULL="`$cat try.out`" + else + if $test "X$code" != X42; then + $cat >&4 <&4 - if $cc $ccflags -c -DTRY=1 try.c >/dev/null 2>&1; then - echo "It supports 1..." - if $cc $ccflags -c -DTRY=3 try.c >/dev/null 2>&1; then - echo "It also supports 2..." - if $cc $ccflags -c -DTRY=7 try.c >/dev/null 2>&1; then - voidflags=7 - echo "And it supports 4 but not 8 definitely." - else - echo "It doesn't support 4..." - if $cc $ccflags -c -DTRY=11 try.c >/dev/null 2>&1; then - voidflags=11 - echo "But it supports 8." - else - voidflags=3 - echo "Neither does it support 8." - fi - fi - else - echo "It does not support 2..." - if $cc $ccflags -c -DTRY=13 try.c >/dev/null 2>&1; then - voidflags=13 - echo "But it supports 4 and 8." - else - if $cc $ccflags -c -DTRY=5 try.c >/dev/null 2>&1; then - voidflags=5 - echo "And it supports 4 but has not heard about 8." - else - echo "However it supports 8 but not 4." - fi - fi + fi + $rm -f core try.core core.try.* + case "$fflushNULL" in + x) $cat >&4 <&4 <&4 <&4 </dev/null + if $test -s try.out -a "X$?" = X42; then + fflushall="`$cat try.out`" fi - else - echo "There is no support at all for void." - voidflags=0 fi - fi + $rm -f core try.core core.try.* + case "$fflushall" in + x) $cat >&4 <&4 <&4 <&4 <<'EOM' - Support flag bits are: - 1: basic void declarations. - 2: arrays of pointers to functions returning void. - 4: operations between pointers to and addresses of void functions. - 8: generic void pointers. +case "$fflushNULL$fflushall" in +undefundef) + $cat <&4 -case "$randfunc" in -'') - if set drand48 val -f; eval $csym; $val; then - dflt="drand48" - echo "Good, found drand48()." >&4 - elif set random val -f; eval $csym; $val; then - dflt="random" - echo "OK, found random()." >&4 - else - dflt="rand" - echo "Yick, looks like I have to use rand()." >&4 - fi - echo " " - ;; -*) - dflt="$randfunc" +echo "Looking for the type for group ids returned by getgid()." +set gid_t gidtype xxx stdio.h sys/types.h +eval $typedef +case "$gidtype" in +xxx) + xxx=`./findhdr sys/user.h` + set `grep 'groups\[NGROUPS\];' "$xxx" 2>/dev/null` unsigned short + case $1 in + unsigned) dflt="$1 $2" ;; + *) dflt="$1" ;; + esac ;; +*) dflt="$gidtype";; esac -cont=true - -case "$ccflags" in -*-Dmy_rand=*|*-Dmy_srand=*) - echo "Removing obsolete -Dmy_rand, -Dmy_srand, and -Drandbits from ccflags." >&4 - ccflags="`echo $ccflags | sed -e 's/-Dmy_rand=random/ /'`" - ccflags="`echo $ccflags | sed -e 's/-Dmy_srand=srandom/ /'`" - ccflags="`echo $ccflags | sed -e 's/-Drandbits=[0-9][0-9]*/ /'`" +case "$gidtype" in +gid_t) echo "gid_t found." ;; +*) rp="What is the type for group ids returned by getgid()?" + . ./myread + gidtype="$ans" ;; esac -while $test "$cont"; do - rp="Use which function to generate random numbers?" - . ./myread - if $test "$ans" = "$dflt"; then - : null - else - randbits='' - fi - randfunc="$ans" - if set $ans val -f; eval $csym; $val; then - cont='' - else - dflt=y - rp="I cannot find function $ans. Use that name anyway?" - . ./myread - dflt=rand - case "$ans" in - [yY]*) cont='';; - esac - fi - case "$cont" in - '') - case "$randfunc" in - drand48) - drand01="drand48()" - seedfunc="srand48" - randbits=48 - randseedtype=long - ;; - rand|random) - case "$randbits" in - '') -echo "Checking to see how many bits your $randfunc() function produces..." >&4 - $cat >try.c <&4 +cat > try.c < #include -#ifdef I_UNISTD -# include -#endif -#ifdef I_STDLIB -# include -#endif -int main() -{ - register int i; - register unsigned long tmp; - register unsigned long max = 0L; +int main() { + printf("%d\n", (int)sizeof($gidtype)); + exit(0); +} +EOCP +set try +if eval $compile_ok; then + yyy=`./try` + case "$yyy" in + '') gidsize=4 + echo "(I can't execute the test program--guessing $gidsize.)" >&4 + ;; + *) gidsize=$yyy + echo "Your $zzz size is $gidsize bytes." + ;; + esac +else + gidsize=4 + echo "(I can't compile the test program--guessing $gidsize.)" >&4 +fi - for (i = 1000; i; i--) { - tmp = (unsigned long) $randfunc(); - if (tmp > max) max = tmp; - } - for (i = 0; max; i++) - max /= 2; - printf("%d\n",i); + +echo " " +case "$gidtype" in +*_t) zzz="$gidtype" ;; +*) zzz="gid" ;; +esac +echo "Checking the sign of $zzz..." >&4 +cat > try.c < +#include +int main() { + $gidtype foo = -1; + if (foo < 0) + printf("-1\n"); + else + printf("1\n"); } EOCP - set try - if eval $compile_ok; then - dflt=`try` - else - dflt='?' - echo "(I can't seem to compile the test program...)" - fi - ;; - *) - dflt="$randbits" - ;; - esac - rp="How many bits does your $randfunc() function produce?" - . ./myread - randbits="$ans" - $rm -f try.c try - drand01="($randfunc() / (double) ((unsigned long)1 << $randbits))" - seedfunc="s$randfunc" - randseedtype=unsigned - ;; - *) - dflt="31" - rp="How many bits does your $randfunc() function produce?" - . ./myread - randbits="$ans" - seedfunc="s$randfunc" - drand01="($randfunc() / (double) ((unsigned long)1 << $randbits))" - if set $seedfunc val -f; eval $csym; $val; then - echo "(Using $seedfunc() to seed random generator)" - else - echo "(Warning: no $seedfunc() to seed random generator)" - seedfunc=rand - fi - randseedtype=unsigned - ;; +set try +if eval $compile; then + yyy=`./try` + case "$yyy" in + '') gidsign=1 + echo "(I can't execute the test program--guessing unsigned.)" >&4 + ;; + *) gidsign=$yyy + case "$gidsign" in + 1) echo "Your $zzz is unsigned." ;; + -1) echo "Your $zzz is signed." ;; esac ;; esac -done +else + gidsign=1 + echo "(I can't compile the test program--guessing unsigned.)" >&4 +fi + +: check for length of character echo " " -echo "Determining whether or not we are on an EBCDIC system..." >&4 -$cat >tebcdic.c <<'EOM' +case "$charsize" in +'') + echo "Checking to see how big your characters are (hey, you never know)..." >&4 + $cat >try.c <<'EOCP' +#include int main() { - if ('M'==0xd4) return 0; - return 1; + printf("%d\n", (int)sizeof(char)); + exit(0); } -EOM - -val=$undef -set tebcdic -if eval $compile_ok; then - if ./tebcdic; then - echo "You have EBCDIC." >&4 - val="$define" +EOCP + set try + if eval $compile_ok; then + dflt=`./try` else - echo "Nope, no EBCDIC. Assuming ASCII or some ISO Latin, or UTF." >&4 + dflt='1' + echo "(I can't seem to compile the test program. Guessing...)" fi -else - echo "I'm unable to compile the test program." >&4 - echo "I'll assume ASCII or some ISO Latin." >&4 -fi -$rm -f tebcdic.c tebcdic -set ebcdic -eval $setvar + ;; +*) + dflt="$charsize" + ;; +esac +rp="What is the size of a character (in bytes)?" +. ./myread +charsize="$ans" +$rm -f try.c try + echo " " -$cat >&4 < try.c ;; +$echo "Choosing the C types to be used for Perl's internal types..." >&4 + +case "$use64bits:$d_quad:$quadtype" in +define:define:?*) + ivtype="$quadtype" + uvtype="$uquadtype" + ivsize=8 + uvsize=8 + ;; +*) ivtype="long" + uvtype="unsigned long" + ivsize=$longsize + uvsize=$longsize + ;; esac -$cat >>try.c < -#$i_unistd I_UNISTD -#ifdef I_UNISTD -# include -#endif -#$d_sysconf HAS_SYSCONF -#$d_stdio_stream_array HAS_STDIO_STREAM_ARRAY -#ifdef HAS_STDIO_STREAM_ARRAY -# define STDIO_STREAM_ARRAY $stdio_stream_array + +case "$uselongdouble:$d_longdbl" in +define:define) + nvtype="long double" + nvsize=$longdblsize + ;; +*) nvtype=double + nvsize=$doublesize + ;; +esac + +echo "(IV will be "$ivtype", $ivsize bytes)" +echo "(UV will be "$uvtype", $uvsize bytes)" +echo "(NV will be "$nvtype", $nvsize bytes)" + +$cat >try.c < #endif +#include int main() { - FILE* p = fopen("try.out", "w"); -#ifdef TRY_FPUTC - fputc('x', p); -#else -# ifdef TRY_FPRINTF - fprintf(p, "x"); -# endif +#ifdef INT8 + int8_t i = INT8_MAX; + uint8_t u = UINT8_MAX; + printf("int8_t\n"); #endif -#ifdef TRY_FFLUSH_NULL - fflush(NULL); +#ifdef INT16 + int16_t i = INT16_MAX; + uint16_t i = UINT16_MAX; + printf("int16_t\n"); #endif -#ifdef TRY_FFLUSH_ALL - { - long open_max = -1; -# ifdef PERL_FFLUSH_ALL_FOPEN_MAX - open_max = PERL_FFLUSH_ALL_FOPEN_MAX; -# else -# if defined(HAS_SYSCONF) && defined(_SC_OPEN_MAX) - open_max = sysconf(_SC_OPEN_MAX); -# else -# ifdef FOPEN_MAX - open_max = FOPEN_MAX; -# else -# ifdef OPEN_MAX - open_max = OPEN_MAX; -# else -# ifdef _NFILE - open_max = _NFILE; -# endif -# endif -# endif -# endif -# endif -# ifdef HAS_STDIO_STREAM_ARRAY - if (open_max > 0) { - long i; - for (i = 0; i < open_max; i++) - if (STDIO_STREAM_ARRAY[i]._file >= 0 && - STDIO_STREAM_ARRAY[i]._file < open_max && - STDIO_STREAM_ARRAY[i]._flag) - fflush(&STDIO_STREAM_ARRAY[i]); - } - } -# endif +#ifdef INT32 + int32_t i = INT32_MAX; + uint32_t u = UINT32_MAX; + printf("int32_t\n"); #endif - _exit(42); } EOCP -: first we have to find out how _not_ to flush -if $test "X$fflushNULL" = X -o "X$fflushall" = X; then - output='' - set try -DTRY_FPUTC - if eval $compile; then - $rm -f try.out - ./try$exe_ext 2>/dev/null - if $test ! -s try.out -a "X$?" = X42; then - output=-DTRY_FPUTC - fi - fi - case "$output" in - '') - set try -DTRY_FPRINTF - $rm -f try.out - if eval $compile; then - $rm -f try.out - ./try$exe_ext 2>/dev/null - if $test ! -s try.out -a "X$?" = X42; then - output=-DTRY_FPRINTF - fi - fi + +case "$i8type" in +'') case "$charsize" in + 1) i8type=char + u8type="unsigned char" + i8size=$charsize + u8size=$charsize + ;; + esac ;; - esac -fi -: check for fflush NULL behaviour -case "$fflushNULL" in -'') set try -DTRY_FFLUSH_NULL $output +esac +case "$i8type" in +'') set try -DINT8 if eval $compile; then - $rm -f try.out - ./try$exe_ext 2>/dev/null - code="$?" - if $test -s try.out -a "X$code" = X42; then - fflushNULL="`$cat try.out`" - else - if $test "X$code" != X42; then - $cat >&4 <&4 <&4 <&4 <&4 </dev/null - if $test -s try.out -a "X$?" = X42; then - fflushall="`$cat try.out`" - fi - fi - $rm -f core try.core core.try.* - case "$fflushall" in - x) $cat >&4 <&4 + +if $test X"$sPRId64" = X -a X"$quadtype" = Xint; then + $cat >try.c <<'EOCP' +#include +#include +int main() { + int q = 12345678901; + printf("%ld\n", q); +} +EOCP + set try + if eval $compile; then + yyy=`./try$exe_ext` + case "$yyy" in + 12345678901) + sPRId64='"d"'; sPRIi64='"i"'; sPRIu64='"u"'; + sPRIo64='"o"'; sPRIx64='"x"'; sPRIX64='"X"'; + echo "We will use %d." + ;; + esac + fi +fi + +if $test X"$sPRId64" = X -a X"$quadtype" = Xlong; then + $cat >try.c <<'EOCP' +#include +#include +int main() { + long q = 12345678901; + printf("%ld\n", q); +} +EOCP + set try + if eval $compile; then + yyy=`./try$exe_ext` + case "$yyy" in + 12345678901) + sPRId64='"ld"'; sPRIi64='"li"'; sPRIu64='"lu"'; + sPRIo64='"lo"'; sPRIx64='"lx"'; sPRIX64='"lX"'; + echo "We will use %ld." + ;; + esac + fi +fi + +if $test X"$sPRId64" = X -a X"$i_inttypes.h" = X"$define" -a X"$quadtype" = Xint64_t; then + $cat >try.c <<'EOCP' +#include +#include +#include +int main() { + int64_t q = 12345678901; + printf("%" PRId64 "\n", q); +} +EOCP + set try + if eval $compile; then + yyy=`./try$exe_ext` + case "$yyy" in + 12345678901) + sPRId64=PRId64; sPRIi64=PRIi64; sPRIu64=PRIu64; + sPRIo64=PRIo64; sPRIx64=PRIx64; sPRIX64=PRIX64; + echo "We will use the C9X style." ;; - '') $cat >&4 <try.c <<'EOCP' +#include +#include +int main() { + long long q = 12345678901LL; /* AIX cc requires the LL prefix. */ + printf("%lld\n", q); +} +EOCP + set try + if eval $compile; then + yyy=`./try$exe_ext` + case "$yyy" in + 12345678901) + sPRId64='"lld"'; sPRIi64='"lli"'; sPRIu64='"llu"'; + sPRIo64='"llo"'; sPRIx64='"llx"'; sPRIX64='"llX"'; + echo "We will use the %lld style." ;; - *) $cat >&4 <try.c < +#include +int main() { + $quadtype q = 12345678901; + printf("%Ld\n", q); +} +EOCP + set try + if eval $compile; then + yyy=`./try$exe_ext` + case "$yyy" in + 12345678901) + sPRId64='"Ld"'; sPRIi64='"Li"'; sPRIu64='"Lu"'; + sPRIo64='"Lo"'; sPRIx64='"Lx"'; sPRIX64='"LX"'; + echo "We will use %Ld." ;; esac - ;; - "$define"|true|[yY]*) - fflushall="$define" - ;; - *) - fflushall="$undef" - ;; - esac - ;; -*) fflushall="$undef" + fi +fi + +if $test X"$sPRId64" = X -a X"$quadtype" != X; then + $cat >try.c < +#include +int main() { + $quadtype q = 12345678901; + printf("%qd\n", q); +} +EOCP + set try + if eval $compile; then + yyy=`./try$exe_ext` + case "$yyy" in + 12345678901) + sPRId64='"qd"'; sPRIi64='"qi"'; sPRIu64='"qu"'; + sPRIo64='"qo"'; sPRIx64='"qx"'; sPRIX64='"qX"'; + echo "We will use %qd." + ;; + esac + fi +fi + +if $test X"$sPRId64" = X; then + echo "Cannot figure out how to print 64-bit integers." >&4 +fi + +$rm -f try try.* + +fi + +case "$sPRId64" in +'') d_PRId64="$undef"; d_PRIi64="$undef"; d_PRIu64="$undef"; + d_PRIo64="$undef"; d_PRIx64="$undef"; d_PRIX64="$undef"; ;; -esac -case "$fflushNULL$fflushall" in -undefundef) - $cat <&4 + +if $test X"$ivsize" = X8; then + ivdformat="$sPRId64" + uvuformat="$sPRIu64" + uvoformat="$sPRIo64" + uvxformat="$sPRIx64" +else + if $test X"$ivsize" = X"$longsize"; then + ivdformat='"ld"' + uvuformat='"lu"' + uvoformat='"lo"' + uvxformat='"lx"' + else + if $test X"$ivsize" = X"$intsize"; then + ivdformat='"d"' + uvuformat='"u"' + uvoformat='"o"' + uvxformat='"x"' + else + : far out + if $test X"$ivsize" = X"$shortsize"; then + ivdformat='"hd"' + uvuformat='"hu"' + uvoformat='"ho"' + uvxformat='"hx"' + fi + fi + fi +fi + +case "$ivdformat" in +'') echo "$0: Fatal: failed to find format strings, cannot continue." >& 4 + exit 1 + ;; esac -: Store the full pathname to the sed program for use in the C program -full_sed=$sed -: see what type gids are declared as in the kernel echo " " -echo "Looking for the type for group ids returned by getgid()." -set gid_t gidtype xxx stdio.h sys/types.h -eval $typedef -case "$gidtype" in -xxx) - xxx=`./findhdr sys/user.h` - set `grep 'groups\[NGROUPS\];' "$xxx" 2>/dev/null` unsigned short - case $1 in - unsigned) dflt="$1 $2" ;; - *) dflt="$1" ;; - esac +$echo "Checking the format string to be used for gids..." >&4 + +case "$gidsign" in +-1) if $test X"$gidsize" = X"$ivsize"; then + gidformat="$ivdformat" + else + if $test X"$gidsize" = X"$longsize"; then + gidformat='"ld"' + else + if $test X"$gidsize" = X"$intsize"; then + gidformat='"d"' + else + if $test X"$gidsize" = X"$shortsize"; then + gidformat='"hd"' + fi + fi + fi + fi ;; -*) dflt="$gidtype";; -esac -case "$gidtype" in -gid_t) echo "gid_t found." ;; -*) rp="What is the type for group ids returned by getgid()?" - . ./myread - gidtype="$ans" +*) if $test X"$gidsize" = X"$uvsize"; then + gidformat="$uvuformat" + else + if $test X"$gidsize" = X"$longsize"; then + gidformat='"lu"' + else + if $test X"$gidsize" = X"$intsize"; then + gidformat='"u"' + else + if $test X"$gidsize" = X"$shortsize"; then + gidformat='"hu"' + fi + fi + fi + fi ;; esac @@ -11688,35 +12586,6 @@ EOM *) groupstype="$gidtype";; esac -: see what type lseek is declared as in the kernel -rp="What is the type used for lseek's offset on this system?" -set off_t lseektype long stdio.h sys/types.h -eval $typedef_ask - -echo " " -$echo $n "Checking to see how big your file offsets are...$c" >&4 -$cat >try.c < -#include -int main() -{ - printf("%d\n", sizeof($lseektype)); -} -EOCP -set try -if eval $compile_ok; then - lseeksize=`./try` - $echo " $lseeksize bytes." >&4 -else - dflt='4' - echo " " - echo "(I can't seem to compile the test program. Guessing...)" - rp="What is the size of your file offsets (in bytes)?" - . ./myread - lseeksize="$ans" -fi -$rm -f try.c try - echo " " echo "Checking if your $make program sets \$(MAKE)..." >&4 case "$make_set_make" in @@ -11959,8 +12828,8 @@ case "$ptrsize" in #include int main() { - printf("%d\n", sizeof(VOID_PTR)); - exit(0); + printf("%d\n", (int)sizeof(VOID_PTR)); + exit(0); } EOCP set try @@ -12173,10 +13042,16 @@ esac : Remove SIGSTKSIZE used by Linux. : Remove SIGSTKSZ used by Posix. : Remove SIGTYP void lines used by OS2. -xxx=`echo '#include ' | +: Some cpps, like os390, dont give the file name anywhere +if [ "X$fieldn" = X ]; then + : Just make some guesses. We check them later. + xxx='/usr/include/signal.h /usr/include/sys/signal.h' +else + xxx=`echo '#include ' | $cppstdin $cppminus $cppflags 2>/dev/null | $grep '^[ ]*#.*include' | $awk "{print \\$$fieldn}" | $sed 's!"!!g' | $sort | $uniq` +fi : Check this list of files to be sure we have parsed the cpp output ok. : This will also avoid potentially non-existent files, such : as ../foo/bar.h @@ -12196,10 +13071,12 @@ $1 == "#" && $2 ~ /^define$/ && $3 ~ /^SIG[A-Z0-9]*$/ && $3 !~ /SIGARRAYSIZE/ && print substr($3, 4, 20) }' $xxxfiles` : Append some common names just in case the awk scan failed. -xxx="$xxx ABRT ALRM BUS CHLD CLD CONT DIL EMT FPE HUP ILL INT IO IOT KILL" -xxx="$xxx LOST PHONE PIPE POLL PROF PWR QUIT SEGV STKFLT STOP SYS TERM TRAP" -xxx="$xxx TSTP TTIN TTOU URG USR1 USR2 USR3 USR4 VTALRM" -xxx="$xxx WINCH WIND WINDOW XCPU XFSZ" +xxx="$xxx ABRT ALRM BUS CANCEL CHLD CLD CONT DIL EMT FPE" +xxx="$xxx FREEZE HUP ILL INT IO IOT KILL LOST LWP PHONE" +xxx="$xxx PIPE POLL PROF PWR QUIT RTMAX RTMIN SEGV STKFLT STOP" +xxx="$xxx SYS TERM THAW TRAP TSTP TTIN TTOU URG USR1 USR2" +xxx="$xxx USR3 USR4 VTALRM WAITING WINCH WIND WINDOW XCPU XFSZ" + : generate a few handy files for later $cat > signal.c <<'EOCP' #include @@ -12272,7 +13149,7 @@ echo $xxx | $tr ' ' $trnl | $sort | $uniq | $awk ' } END { printf "#endif /* JUST_NSIG */\n"; - printf "}\n"; + printf "exit(0);\n}\n"; } ' >>signal.c $cat >signal.awk <<'EOP' @@ -12514,6 +13391,112 @@ uid_t) echo "uid_t found." ;; ;; esac +echo " " +case "$uidtype" in +*_t) zzz="$uidtype" ;; +*) zzz="uid" ;; +esac +echo "Checking the size of $zzz..." >&4 +cat > try.c < +#include +int main() { + printf("%d\n", (int)sizeof($uidtype)); + exit(0); +} +EOCP +set try +if eval $compile_ok; then + yyy=`./try` + case "$yyy" in + '') uidsize=4 + echo "(I can't execute the test program--guessing $uidsize.)" >&4 + ;; + *) uidsize=$yyy + echo "Your $zzz size is $uidsize bytes." + ;; + esac +else + uidsize=4 + echo "(I can't compile the test program--guessing $uidsize.)" >&4 +fi + +echo " " +case "$uidtype" in +*_t) zzz="$uidtype" ;; +*) zzz="uid" ;; +esac +echo "Checking the sign of $zzz..." >&4 +cat > try.c < +#include +int main() { + $uidtype foo = -1; + if (foo < 0) + printf("-1\n"); + else + printf("1\n"); +} +EOCP +set try +if eval $compile; then + yyy=`./try` + case "$yyy" in + '') uidsign=1 + echo "(I can't execute the test program--guessing unsigned.)" >&4 + ;; + *) uidsign=$yyy + case "$uidsign" in + 1) echo "Your $zzz is unsigned." ;; + -1) echo "Your $zzz is signed." ;; + esac + ;; + esac +else + uidsign=1 + echo "(I can't compile the test program--guessing unsigned.)" >&4 +fi + + + +echo " " +$echo "Checking the format string to be used for uids..." >&4 + +case "$uidsign" in +-1) if $test X"$uidsize" = X"$ivsize"; then + uidformat="$ivdformat" + else + if $test X"$uidsize" = X"$longsize"; then + uidformat='"ld"' + else + if $test X"$uidsize" = X"$intsize"; then + uidformat='"d"' + else + if $test X"$uidsize" = X"$shortsize"; then + uidformat='"hd"' + fi + fi + fi + fi + ;; +*) if $test X"$uidsize" = X"$uvsize"; then + uidformat="$uvuformat" + else + if $test X"$uidsize" = X"$longsize"; then + uidformat='"lu"' + else + if $test X"$uidsize" = X"$intsize"; then + uidformat='"u"' + else + if $test X"$uidsize" = X"$shortsize"; then + uidformat='"hu"' + fi + fi + fi + fi + ;; +esac + : see if dbm.h is available : see if dbmclose exists set dbmclose d_dbmclose @@ -13005,6 +13988,10 @@ eval $inhdr set sys/statvfs.h i_sysstatvfs eval $inhdr +: see if this is a sys/uio.h system +set sys/uio.h i_sysuio +eval $inhdr + : see if this is a sys/un.h system set sys/un.h i_sysun eval $inhdr @@ -13013,6 +14000,10 @@ eval $inhdr set sys/wait.h i_syswait eval $inhdr +: see if this is a ustat.h system +set ustat.h i_ustat +eval $inhdr + : see if this is an utime system set utime.h i_utime eval $inhdr @@ -13369,7 +14360,10 @@ afs='$afs' alignbytes='$alignbytes' ansi2knr='$ansi2knr' aphostname='$aphostname' -apiversion='$apiversion' +api_revision='$api_revision' +api_subversion='$api_subversion' +api_version='$api_version' +api_versionstring='$api_versionstring' ar='$ar' archlib='$archlib' archlibexp='$archlibexp' @@ -13396,6 +14390,7 @@ ccsymbols='$ccsymbols' cf_by='$cf_by' cf_email='$cf_email' cf_time='$cf_time' +charsize='$charsize' chgrp='$chgrp' chmod='$chmod' chown='$chown' @@ -13451,7 +14446,6 @@ d_chown='$d_chown' d_chroot='$d_chroot' d_chsize='$d_chsize' d_closedir='$d_closedir' -d_cmsghdr_s='$d_cmsghdr_s' d_const='$d_const' d_crypt='$d_crypt' d_csh='$d_csh' @@ -13487,6 +14481,7 @@ d_flock='$d_flock' d_fork='$d_fork' d_fpathconf='$d_fpathconf' d_fpos64_t='$d_fpos64_t' +d_fs_data_s='$d_fs_data_s' d_fseeko='$d_fseeko' d_fsetpos='$d_fsetpos' d_fstatfs='$d_fstatfs' @@ -13501,6 +14496,7 @@ d_gethent='$d_gethent' d_gethname='$d_gethname' d_gethostprotos='$d_gethostprotos' d_getlogin='$d_getlogin' +d_getmnt='$d_getmnt' d_getmntent='$d_getmntent' d_getnbyaddr='$d_getnbyaddr' d_getnbyname='$d_getnbyname' @@ -13530,19 +14526,16 @@ d_htonl='$d_htonl' d_index='$d_index' d_inetaton='$d_inetaton' d_int64t='$d_int64t' -d_iovec_s='$d_iovec_s' d_isascii='$d_isascii' d_killpg='$d_killpg' d_lchown='$d_lchown' d_ldbl_dig='$d_ldbl_dig' d_link='$d_link' -d_llseek='$d_llseek' d_locconv='$d_locconv' d_lockf='$d_lockf' d_longdbl='$d_longdbl' d_longlong='$d_longlong' d_lstat='$d_lstat' -d_madvise='$d_madvise' d_mblen='$d_mblen' d_mbstowcs='$d_mbstowcs' d_mbtowc='$d_mbtowc' @@ -13554,8 +14547,6 @@ d_memset='$d_memset' d_mkdir='$d_mkdir' d_mkfifo='$d_mkfifo' d_mktime='$d_mktime' -d_mmap='$d_mmap' -d_mprotect='$d_mprotect' d_msg='$d_msg' d_msg_ctrunc='$d_msg_ctrunc' d_msg_dontroute='$d_msg_dontroute' @@ -13564,11 +14555,8 @@ d_msg_peek='$d_msg_peek' d_msg_proxy='$d_msg_proxy' d_msgctl='$d_msgctl' d_msgget='$d_msgget' -d_msghdr_s='$d_msghdr_s' d_msgrcv='$d_msgrcv' d_msgsnd='$d_msgsnd' -d_msync='$d_msync' -d_munmap='$d_munmap' d_mymalloc='$d_mymalloc' d_nice='$d_nice' d_off64_t='$d_off64_t' @@ -13591,10 +14579,9 @@ d_pwexpire='$d_pwexpire' d_pwgecos='$d_pwgecos' d_pwpasswd='$d_pwpasswd' d_pwquota='$d_pwquota' +d_quad='$d_quad' d_readdir='$d_readdir' d_readlink='$d_readlink' -d_readv='$d_readv' -d_recvmsg='$d_recvmsg' d_rename='$d_rename' d_rewinddir='$d_rewinddir' d_rmdir='$d_rmdir' @@ -13611,7 +14598,6 @@ d_semctl_semid_ds='$d_semctl_semid_ds' d_semctl_semun='$d_semctl_semun' d_semget='$d_semget' d_semop='$d_semop' -d_sendmsg='$d_sendmsg' d_setegid='$d_setegid' d_seteuid='$d_seteuid' d_setgrent='$d_setgrent' @@ -13647,9 +14633,10 @@ d_sigaction='$d_sigaction' d_sigsetjmp='$d_sigsetjmp' d_socket='$d_socket' d_sockpair='$d_sockpair' +d_sqrtl='$d_sqrtl' d_statblks='$d_statblks' -d_statfs='$d_statfs' -d_statfsflags='$d_statfsflags' +d_statfs_f_flags='$d_statfs_f_flags' +d_statfs_s='$d_statfs_s' d_statvfs='$d_statvfs' d_stdio_cnt_lval='$d_stdio_cnt_lval' d_stdio_ptr_lval='$d_stdio_ptr_lval' @@ -13663,8 +14650,11 @@ d_strerrm='$d_strerrm' d_strerror='$d_strerror' d_strtod='$d_strtod' d_strtol='$d_strtol' +d_strtold='$d_strtold' +d_strtoll='$d_strtoll' d_strtoul='$d_strtoul' d_strtoull='$d_strtoull' +d_strtouq='$d_strtouq' d_strxfrm='$d_strxfrm' d_suidsafe='$d_suidsafe' d_symlink='$d_symlink' @@ -13684,6 +14674,8 @@ d_tzname='$d_tzname' d_umask='$d_umask' d_uname='$d_uname' d_union_semun='$d_union_semun' +d_ustat='$d_ustat' +d_vendorbin='$d_vendorbin' d_vendorlib='$d_vendorlib' d_vfork='$d_vfork' d_void_closedir='$d_void_closedir' @@ -13695,7 +14687,6 @@ d_wait4='$d_wait4' d_waitpid='$d_waitpid' d_wcstombs='$d_wcstombs' d_wctomb='$d_wctomb' -d_writev='$d_writev' d_xenix='$d_xenix' date='$date' db_hashtype='$db_hashtype' @@ -13721,12 +14712,16 @@ fflushall='$fflushall' find='$find' firstmakefile='$firstmakefile' flex='$flex' +fpossize='$fpossize' fpostype='$fpostype' freetype='$freetype' full_ar='$full_ar' full_csh='$full_csh' full_sed='$full_sed' gccversion='$gccversion' +gidformat='$gidformat' +gidsign='$gidsign' +gidsize='$gidsize' gidtype='$gidtype' glibpth='$glibpth' grep='$grep' @@ -13738,6 +14733,14 @@ h_sysfile='$h_sysfile' hint='$hint' hostcat='$hostcat' huge='$huge' +i16size='$i16size' +i16type='$i16type' +i32size='$i32size' +i32type='$i32type' +i64size='$i64size' +i64type='$i64type' +i8size='$i8size' +i8type='$i8type' i_arpainet='$i_arpainet' i_bsdioctl='$i_bsdioctl' i_db='$i_db' @@ -13780,7 +14783,6 @@ i_sysfile='$i_sysfile' i_sysfilio='$i_sysfilio' i_sysin='$i_sysin' i_sysioctl='$i_sysioctl' -i_sysmman='$i_sysmman' i_sysmount='$i_sysmount' i_sysndir='$i_sysndir' i_sysparam='$i_sysparam' @@ -13789,6 +14791,7 @@ i_syssecrt='$i_syssecrt' i_sysselct='$i_sysselct' i_syssockio='$i_syssockio' i_sysstat='$i_sysstat' +i_sysstatfs='$i_sysstatfs' i_sysstatvfs='$i_sysstatvfs' i_systime='$i_systime' i_systimek='$i_systimek' @@ -13796,17 +14799,20 @@ i_systimes='$i_systimes' i_systypes='$i_systypes' i_sysuio='$i_sysuio' i_sysun='$i_sysun' +i_sysvfs='$i_sysvfs' i_syswait='$i_syswait' i_termio='$i_termio' i_termios='$i_termios' i_time='$i_time' i_unistd='$i_unistd' +i_ustat='$i_ustat' i_utime='$i_utime' i_values='$i_values' i_varargs='$i_varargs' i_varhdr='$i_varhdr' i_vfork='$i_vfork' ignore_versioned_solibs='$ignore_versioned_solibs' +inc_version_list='$inc_version_list' incpath='$incpath' inews='$inews' installarchlib='$installarchlib' @@ -13818,11 +14824,16 @@ installprefixexp='$installprefixexp' installprivlib='$installprivlib' installscript='$installscript' installsitearch='$installsitearch' +installsitebin='$installsitebin' installsitelib='$installsitelib' installstyle='$installstyle' installusrbinperl='$installusrbinperl' +installvendorbin='$installvendorbin' installvendorlib='$installvendorlib' intsize='$intsize' +ivdformat='$ivdformat' +ivsize='$ivsize' +ivtype='$ivtype' known_extensions='$known_extensions' ksh='$ksh' large='$large' @@ -13866,10 +14877,8 @@ man3dir='$man3dir' man3direxp='$man3direxp' man3ext='$man3ext' medium='$medium' -mips='$mips' mips_type='$mips_type' mkdir='$mkdir' -mmaptype='$mmaptype' models='$models' modetype='$modetype' more='$more' @@ -13889,6 +14898,8 @@ nm_opt='$nm_opt' nm_so_opt='$nm_so_opt' nonxs_ext='$nonxs_ext' nroff='$nroff' +nvsize='$nvsize' +nvtype='$nvtype' o_nonblock='$o_nonblock' obj_ext='$obj_ext' old_pthread_create_joinable='$old_pthread_create_joinable' @@ -13916,6 +14927,8 @@ privlib='$privlib' privlibexp='$privlibexp' prototype='$prototype' ptrsize='$ptrsize' +quadkind='$quadkind' +quadtype='$quadtype' randbits='$randbits' randfunc='$randfunc' randseedtype='$randseedtype' @@ -13959,6 +14972,8 @@ sig_num_init='$sig_num_init' signal_t='$signal_t' sitearch='$sitearch' sitearchexp='$sitearchexp' +sitebin='$sitebin' +sitebinexp='$sitebinexp' sitelib='$sitelib' sitelibexp='$sitelibexp' siteprefix='$siteprefix' @@ -14001,13 +15016,28 @@ touch='$touch' tr='$tr' trnl='$trnl' troff='$troff' +u16size='$u16size' +u16type='$u16type' +u32size='$u32size' +u32type='$u32type' +u64size='$u64size' +u64type='$u64type' +u8size='$u8size' +u8type='$u8type' +uidformat='$uidformat' +uidsign='$uidsign' +uidsize='$uidsize' uidtype='$uidtype' uname='$uname' uniq='$uniq' +uquadtype='$uquadtype' +use5005threads='$use5005threads' use64bits='$use64bits' usedl='$usedl' +useithreads='$useithreads' uselargefiles='$uselargefiles' uselongdouble='$uselongdouble' +uselonglong='$uselonglong' usemorebits='$usemorebits' usemultiplicity='$usemultiplicity' usemymalloc='$usemymalloc' @@ -14023,6 +15053,13 @@ usevendorprefix='$usevendorprefix' usevfork='$usevfork' usrinc='$usrinc' uuname='$uuname' +uvoformat='$uvoformat' +uvsize='$uvsize' +uvtype='$uvtype' +uvuformat='$uvuformat' +uvxformat='$uvxformat' +vendorbin='$vendorbin' +vendorbinexp='$vendorbinexp' vendorlib='$vendorlib' vendorlibexp='$vendorlibexp' vendorprefix='$vendorprefix' diff --git a/EXTERN.h b/EXTERN.h index 9d31124..c813f81 100644 --- a/EXTERN.h +++ b/EXTERN.h @@ -27,7 +27,7 @@ # define EXTCONST globalref # define dEXTCONST globaldef {"$GLOBAL_RO_VARS"} readonly #else -# if defined(WIN32) && !defined(PERL_STATIC_SYMS) && !defined(__GNUC__) && !defined(PERL_OBJECT) +# if defined(WIN32) && !defined(PERL_STATIC_SYMS) && !defined(PERL_OBJECT) # ifdef PERLDLL # define EXT extern __declspec(dllexport) # define dEXT diff --git a/INSTALL b/INSTALL index 8014a41..7ac14ca 100644 --- a/INSTALL +++ b/INSTALL @@ -4,6 +4,10 @@ Install - Build and Installation guide for perl5. =head1 SYNOPSIS +First, make sure you are installing an up-to-date version of Perl. If +you didn't get your Perl source from CPAN, check the latest version at +. + The basic steps to build and install perl5 on a Unix system are: rm -f config.sh Policy.sh @@ -28,8 +32,6 @@ on the platform. If that's not okay with you, use make test make install -Full configuration instructions can be found in the INSTALL file. - For information on non-Unix systems, see the section on L<"Porting information"> below. @@ -333,7 +335,7 @@ The directories set up by Configure fall into three broad categories. By default, Configure will use the following directories for 5.6. $version is the full perl version number, including subversion, e.g. -5.6 or 5.6.1, and $archname is a string like sun4-sunos, +5.6.0 or 5.6.1, and $archname is a string like sun4-sunos, determined by Configure. The full definitions of all Configure variables are in the file Porting/Glossary. @@ -358,23 +360,22 @@ the common style is shown here. After perl is installed, you may later wish to add modules (e.g. from CPAN) or scripts. Configure will set up the following directories to -be used for installing those add-on modules and scripts. $apiversion -is the perl version number (without subversion), e.g. 5.6. +be used for installing those add-on modules and scripts. $version +is the perl version number, e.g. 5.6.0. Configure variable Default value $siteprefix $prefix $sitebin $siteprefix/bin $sitescriptdir $siteprefix/bin - $sitelib $siteprefix/lib/perl5/site_perl/ - $sitearch $siteprefix/lib/perl5/site_perl/$apiversion/$archname + $sitelib $siteprefix/lib/perl5/site_perl/$version + $sitearch $siteprefix/lib/perl5/site_perl/$version/$archname $siteman1dir $siteprefix/man/man1 $siteman3dir $siteprefix/man/man3 $sitehtml1dir (none) $sitehtml3dir (none) By default, ExtUtils::MakeMaker will install architecture-independent -modules into $sitelib/$apiversion and architecture-dependent modules -into $sitearch. +modules into $sitelib and architecture-dependent modules into $sitearch. =item Directories for vendor-supplied add-on files @@ -387,8 +388,8 @@ for you to use to distribute add-on modules. (The next ones are set only if vendorprefix is set.) $vendorbin $vendorprefix/bin $vendorscriptdir $vendorprefix/bin - $vendorlib $vendorprefix/lib/perl5/vendor_perl/ - $vendorarch $vendorprefix/lib/perl5/vendor_perl/$apiversion/$archname + $vendorlib $vendorprefix/lib/perl5/vendor_perl/$version + $vendorarch $vendorprefix/lib/perl5/vendor_perl/$version/$archname $vendorman1dir $vendorprefix/man/man1 $vendorman3dir $vendorprefix/man/man3 $vendorhtml1dir (none) @@ -412,24 +413,28 @@ This would have the effect of setting the following: $sitebin /usr/local/bin $sitescriptdir /usr/local/bin - $sitelib /usr/local/lib/perl5/site_perl/ - $sitearch /usr/local/lib/perl5/site_perl/$apiversion/$archname + $sitelib /usr/local/lib/perl5/site_perl/$version + $sitearch /usr/local/lib/perl5/site_perl/$version/$archname $siteman1dir /usr/local/man/man1 $siteman3dir /usr/local/man/man3 $vendorbin /usr/bin $vendorscriptdir /usr/bin - $vendorlib /usr/lib/perl5/vendor_perl/ - $vendorarch /usr/lib/perl5/vendor_perl/$apiversion/$archname + $vendorlib /usr/lib/perl5/vendor_perl/$version + $vendorarch /usr/lib/perl5/vendor_perl/$version/$archname $vendorman1dir /usr/man/man1 $vendorman3dir /usr/man/man3 Note how in this example, the vendor-supplied directories are in the /usr hierarchy, while the directories reserved for the end-user are in -the /usr/local hierarchy. Note too how the vendor-supplied -directories track $apiversion, rather than $version, to ease upgrading -between maintenance subversions. See L<"Coexistence with earlier -versions of perl5"> below for more details. +the /usr/local hierarchy. + +The entire installed library hierarchy is installed in locations with +version numbers, keeping the installations of different versions distinct. +However, later installations of Perl can still be configured to search the +installed libraries corresponding to compatible earlier versions. +See L<"Coexistence with earlier versions of perl5"> below for more details +on how Perl can be made to search older version directories. Of course you may use these directories however you see fit. For example, you may wish to use $siteprefix for site-specific files that @@ -457,7 +462,7 @@ without resetting MANPATH. You can continue to use the old default from the command line with - sh Configure -Dman3dir=/usr/local/lib/perl5/5.6/man/man3 + sh Configure -Dman3dir=/usr/local/lib/perl5/5.6.0/man/man3 Some users also prefer to use a .3pm suffix. You can do that with @@ -495,13 +500,13 @@ library directory structure is slightly simplified. Instead of suggesting $prefix/lib/perl5/, Configure will suggest $prefix/lib. Thus, for example, if you Configure with --Dprefix=/opt/perl, then the default library directories for 5.6 are +-Dprefix=/opt/perl, then the default library directories for 5.6.0 are Configure variable Default value - $privlib /opt/perl/lib/5.6 - $archlib /opt/perl/lib/5.6/$archname - $sitelib /opt/perl/lib/site_perl/5.6 - $sitearch /opt/perl/lib/site_perl/5.6/$archname + $privlib /opt/perl/lib/5.6.0 + $archlib /opt/perl/lib/5.6.0/$archname + $sitelib /opt/perl/lib/site_perl/5.6.0 + $sitearch /opt/perl/lib/site_perl/5.6.0/$archname =head2 Changing the installation directory @@ -602,6 +607,20 @@ line so that the hint files can make appropriate adjustments. The default is to compile without thread support. +As of v5.5.64, perl has two different internal threads implementations. +The 5.005 version (5005threads) and an interpreter-based implementation +(ithreads) with one interpreter per thread. By default, Configure selects +ithreads if -Dusethreads is specified. However, you can select the old +5005threads behavior instead by either + + sh Configure -Dusethreads -Duse5005threads + +or by + sh Configure -Dusethreads -Uuseithreads + +Eventually (by perl v5.6.0) this internal confusion ought to disappear, +and these options may disappear as well. + =head2 Selecting File IO mechanisms Previous versions of perl used the standard IO mechanisms as defined in @@ -719,7 +738,7 @@ You can elect to build a shared libperl by To build a shared libperl, the environment variable controlling shared library search (LD_LIBRARY_PATH in most systems, DYLD_LIBRARY_PATH for NeXTSTEP/OPENSTEP/Rhapsody, LIBRARY_PATH for BeOS, SHLIB_PATH for -HP-UX, LIBPATH for AIX, PATH for cygwin) must be set up to include +HP-UX, LIBPATH for AIX, PATH for Cygwin) must be set up to include the Perl build directory because that's where the shared libperl will be created. Configure arranges makefile to have the correct shared library search settings. @@ -1674,13 +1693,14 @@ searched by 5.005_03 are /usr/local/lib/perl5/site_perl/5.005/$archname /usr/local/lib/perl5/site_perl/5.005 -Now, suppose you install version 5.6. The directories searched by -version 5.6 will be +Beginning with 5.6.0 the version number in the site libraries are +fully versioned. Now, suppose you install version 5.6.0. The directories +searched by version 5.6.0 will be - /usr/local/lib/perl5/5.6/$archname - /usr/local/lib/perl5/5.6 - /usr/local/lib/perl5/site_perl/5.6/$archname - /usr/local/lib/perl5/site_perl/5.6 + /usr/local/lib/perl5/5.6.0/$archname + /usr/local/lib/perl5/5.6.0 + /usr/local/lib/perl5/site_perl/5.6.0/$archname + /usr/local/lib/perl5/site_perl/5.6.0 /usr/local/lib/perl5/site_perl/5.005/$archname /usr/local/lib/perl5/site_perl/5.005 @@ -1688,56 +1708,55 @@ version 5.6 will be Notice the last two entries -- Perl understands the default structure of the $sitelib directories and will look back in older, compatible directories. This way, modules installed under 5.005_03 will continue -to be usable by 5.005_03 but will also accessible to 5.6. Further, +to be usable by 5.005_03 but will also accessible to 5.6.0. Further, suppose that you upgrade a module to one which requires features -present only in 5.6. That new module will get installed into -/usr/local/lib/perl5/site_perl/5.6 and will be available to 5.6, +present only in 5.6.0. That new module will get installed into +/usr/local/lib/perl5/site_perl/5.6.0 and will be available to 5.6.0, but will not interfere with the 5.005_03 version. -Also, by default, 5.6 will look in +Also, by default, 5.6.0 will look in /usr/local/lib/perl5/site_perl/ for 5.004-era pure perl modules. -Lastly, suppose you now install version 5.6.1. The directories -searched by 5.6.1 will be +Lastly, suppose you now install version 5.6.1, which we'll assume is +binary compatible with 5.6.0 and 5.005. The directories searched +by 5.6.1 (if you don't change the Configure defaults) will be: /usr/local/lib/perl5/5.6.1/$archname /usr/local/lib/perl5/5.6.1 - /usr/local/lib/perl5/site_perl/5.6/$archname - /usr/local/lib/perl5/site_perl/5.6 + /usr/local/lib/perl5/site_perl/5.6.1/$archname + /usr/local/lib/perl5/site_perl/5.6.1 + + /usr/local/lib/perl5/site_perl/5.6.0/$archname + /usr/local/lib/perl5/site_perl/5.6.0 /usr/local/lib/perl5/site_perl/5.005/$archname /usr/local/lib/perl5/site_perl/5.005 /usr/local/lib/perl5/site_perl/ -When you install an add-on extension, it gets installed into $sitelib (or -$sitearch if it is architecture-specific). This directory deliberately -does NOT include the sub-version number (01) so that both 5.6 and -5.6.1 can use the extension. - -However, if you do run into problems, and you want to continue to use the -old version of perl along with your extension, move those extension files -to the appropriate version directory, such as $privlib (or $archlib). -(The extension's .packlist file lists the files installed with that -extension. For the Tk extension, for example, the list of files installed -is in $sitearch/auto/Tk/.packlist.) Then use your newer version of perl -to rebuild and re-install the extension into $sitelib. This way, Perl -5.6 will find your files in the 5.6 directory, and newer versions -of perl will find your newer extension in the $sitelib directory. -(This is also why perl searches the site-specific libraries last.) - -Alternatively, if you are willing to reinstall all your modules -every time you upgrade perl, then you can include the subversion -number in $sitearch and $sitelib when you run Configure. +Assuming the users in your site are still actively using perl 5.6.0 and +5.005 after you installed 5.6.1, you can continue to install add-on +extensions using any of perl 5.6.1, 5.6.0, or 5.005. The installations +of these different versions remain distinct, but remember that the newer +versions of perl are automatically set up to search the site libraries of +the older ones. This means that installing a new extension with 5.005 +will make it visible to all three versions. Later, if you install the +same extension using, say, perl 5.6.1, it will override the 5.005-installed +version, but only for perl 5.6.1. + +This way, you can choose to share compatible extensions, but also upgrade +to a newer version of an extension that may be incompatible with earlier +versions, without breaking the earlier versions' installations. =head2 Maintaining completely separate versions Many users prefer to keep all versions of perl in completely separate directories. This guarantees that an update to one version -won't interfere with another version. One convenient way to do this -is by using a separate prefix for each version, such as +won't interfere with another version. (The defaults guarantee this for +libraries after 5.6.0, but not for executables. TODO?) One convenient +way to do this is by using a separate prefix for each version, such as sh Configure -Dprefix=/opt/perl5.004 @@ -1754,13 +1773,13 @@ seriously consider using a separate directory, since development subversions may not have all the compatibility wrinkles ironed out yet. -=head2 Upgrading from 5.005 to 5.6 +=head2 Upgrading from 5.005 to 5.6.0 Extensions built and installed with versions of perl prior to 5.005_50 will need to be recompiled to be used with 5.005_50 and later. You will, however, be able to continue using 5.005 even after you install 5.6. The 5.005 binary will still be able to find the modules built under -5.005; the 5.6 binary will look in the new $sitearch and $sitelib +5.005; the 5.6.0 binary will look in the new $sitearch and $sitelib directories, and will not find them. See also your installed copy of the perllocal.pod file for a (possibly incomplete) list of locally installed modules. Note that you want perllocal.pod not perllocale.pod diff --git a/INTERN.h b/INTERN.h index 118e47c..ee2959c 100644 --- a/INTERN.h +++ b/INTERN.h @@ -27,11 +27,17 @@ # define EXTCONST globaldef {"$GLOBAL_RO_VARS"} readonly # define dEXTCONST globaldef {"$GLOBAL_RO_VARS"} readonly #else -# ifdef __cplusplus -# define EXT -# define dEXT -# define EXTCONST extern const -# define dEXTCONST const +#if defined(WIN32) && defined(__MINGW32__) +# define EXT __declspec(dllexport) +# define dEXT +# define EXTCONST __declspec(dllexport) const +# define dEXTCONST const +#else +#ifdef __cplusplus +# define EXT +# define dEXT +# define EXTCONST extern const +# define dEXTCONST const #else # define EXT # define dEXT @@ -39,6 +45,7 @@ # define dEXTCONST const #endif #endif +#endif #undef INIT #define INIT(x) = x diff --git a/MAINTAIN b/MAINTAIN index 4507ca9..be9eaff 100644 --- a/MAINTAIN +++ b/MAINTAIN @@ -154,7 +154,6 @@ ext/DynaLoader/DynaLoader_pm.PL ext/DynaLoader/Makefile.PL ext/DynaLoader/README ext/DynaLoader/dl_aix.xs aix -ext/DynaLoader/dl_cygwin.xs cygwin ext/DynaLoader/dl_dld.xs rsanders ext/DynaLoader/dl_dlopen.xs timb ext/DynaLoader/dl_hpux.xs hpux diff --git a/MANIFEST b/MANIFEST index 74ed56c..f6e96a7 100644 --- a/MANIFEST +++ b/MANIFEST @@ -91,7 +91,7 @@ eg/cgi/cookie.cgi CGI example eg/cgi/crash.cgi CGI example eg/cgi/customize.cgi CGI example eg/cgi/diff_upload.cgi CGI example -eg/cgi/dna.small.gif.uu Small image for CGI examples +eg/cgi/dna_small_gif.uu Small image for CGI examples eg/cgi/file_upload.cgi CGI example eg/cgi/frameset.cgi CGI example eg/cgi/index.html Index page for CGI examples @@ -104,7 +104,7 @@ eg/cgi/nph-multipart.cgi CGI example eg/cgi/popup.cgi CGI example eg/cgi/save_state.cgi CGI example eg/cgi/tryit.cgi CGI example -eg/cgi/wilogo.gif.uu Small image for CGI examples +eg/cgi/wilogo_gif.uu Small image for CGI examples eg/changes A program to list recently changed files eg/client A sample client eg/down A program to do things to subdirectories @@ -153,11 +153,13 @@ emacs/ptags Creates smart TAGS file embed.h Maps symbols to safer names embed.pl Produces {embed,embedvar,objXSUB,proto}.h, global.sym embedvar.h C namespace management -epoc/config.h EPOC port +epoc/config.sh EPOC port config.sh template +epoc/createpkg.pl EPOC port generate PKG file epoc/epoc.c EPOC port +epoc/epoc_stubs.c EPOC port +epoc/epocish.c EPOC port epoc/epocish.h EPOC port -epoc/perl.mmp EPOC port -epoc/perl.pkg EPOC port +epoc/link.pl EPOC port link a exe ext/B/B.pm Compiler backend support functions and methods ext/B/B.xs Compiler backend external subroutines ext/B/B/Asmdata.pm Compiler backend data for assembler @@ -207,6 +209,7 @@ ext/DB_File/DB_File_BS Berkeley DB extension mkbootstrap fodder ext/DB_File/Makefile.PL Berkeley DB extension makefile writer ext/DB_File/dbinfo Berkeley DB database version checker ext/DB_File/hints/dynixptx.pl Hint for DB_File for named architecture +ext/DB_File/hints/sco.pl Hint for DB_File for named architecture ext/DB_File/typemap Berkeley DB extension interface types ext/DB_File/version.c Berkeley DB extension interface version check ext/Data/Dumper/Changes Data pretty printer, changelog @@ -226,9 +229,9 @@ ext/Devel/Peek/Peek.xs Data debugging tool, externals ext/DynaLoader/DynaLoader_pm.PL Dynamic Loader perl module ext/DynaLoader/Makefile.PL Dynamic Loader makefile writer ext/DynaLoader/README Dynamic Loader notes and intro +ext/DynaLoader/XSLoader_pm.PL Simple XS Loader perl module ext/DynaLoader/dl_aix.xs AIX implementation ext/DynaLoader/dl_beos.xs BeOS implementation -ext/DynaLoader/dl_cygwin.xs Cygwin implementation ext/DynaLoader/dl_dld.xs GNU dld style implementation ext/DynaLoader/dl_dlopen.xs BSD/SunOS4&5 dlopen() style implementation ext/DynaLoader/dl_hpux.xs HP-UX implementation @@ -239,13 +242,22 @@ ext/DynaLoader/dl_rhapsody.xs Rhapsody implementation ext/DynaLoader/dl_vmesa.xs VM/ESA implementation ext/DynaLoader/dl_vms.xs VMS implementation ext/DynaLoader/dlutils.c Dynamic loader utilities for dl_*.xs files +ext/DynaLoader/hints/aix.pl Hint for DynaLoader for named architecture ext/DynaLoader/hints/linux.pl Hint for DynaLoader for named architecture +ext/DynaLoader/hints/openbsd.pl Hint for DynaLoader for named architecture ext/Errno/ChangeLog Errno perl module change log ext/Errno/Errno_pm.PL Errno perl module create script ext/Errno/Makefile.PL Errno extension makefile writer ext/Fcntl/Fcntl.pm Fcntl extension Perl module ext/Fcntl/Fcntl.xs Fcntl extension external subroutines ext/Fcntl/Makefile.PL Fcntl extension makefile writer +ext/File/Glob/Changes File::Glob extension changelog +ext/File/Glob/Glob.pm File::Glob extension module +ext/File/Glob/Glob.xs File::Glob extension external subroutines +ext/File/Glob/Makefile.PL File::Glob extension makefile writer +ext/File/Glob/TODO File::Glob extension todo list +ext/File/Glob/bsd_glob.c File::Glob extension run time code +ext/File/Glob/bsd_glob.h File::Glob extension header file ext/GDBM_File/GDBM_File.pm GDBM extension Perl module ext/GDBM_File/GDBM_File.xs GDBM extension external subroutines ext/GDBM_File/Makefile.PL GDBM extension makefile writer @@ -276,20 +288,24 @@ ext/IPC/SysV/README IPC::SysV extension Perl module ext/IPC/SysV/Semaphore.pm IPC::SysV extension Perl module ext/IPC/SysV/SysV.pm IPC::SysV extension Perl module ext/IPC/SysV/SysV.xs IPC::SysV extension Perl module +ext/IPC/SysV/hints/cygwin.pl Hint for IPC::SysV for named architecture ext/IPC/SysV/hints/next_3.pl Hint for IPC::SysV for named architecture ext/IPC/SysV/t/msg.t IPC::SysV extension Perl module ext/IPC/SysV/t/sem.t IPC::SysV extension Perl module ext/NDBM_File/Makefile.PL NDBM extension makefile writer ext/NDBM_File/NDBM_File.pm NDBM extension Perl module ext/NDBM_File/NDBM_File.xs NDBM extension external subroutines +ext/NDBM_File/hints/cygwin.pl Hint for NDBM_File for named architecture ext/NDBM_File/hints/dec_osf.pl Hint for NDBM_File for named architecture ext/NDBM_File/hints/dynixptx.pl Hint for NDBM_File for named architecture ext/NDBM_File/hints/solaris.pl Hint for NDBM_File for named architecture +ext/NDBM_File/hints/sco.pl Hint for NDBM_File for named architecture ext/NDBM_File/hints/svr4.pl Hint for NDBM_File for named architecture ext/NDBM_File/typemap NDBM extension interface types ext/ODBM_File/Makefile.PL ODBM extension makefile writer ext/ODBM_File/ODBM_File.pm ODBM extension Perl module ext/ODBM_File/ODBM_File.xs ODBM extension external subroutines +ext/ODBM_File/hints/cygwin.pl Hint for ODBM_File for named architecture ext/ODBM_File/hints/dec_osf.pl Hint for ODBM_File for named architecture ext/ODBM_File/hints/hpux.pl Hint for ODBM_File for named architecture ext/ODBM_File/hints/sco.pl Hint for ODBM_File for named architecture @@ -494,7 +510,7 @@ iperlsys.h Perl's interface to the system jpl/JNI/Changes Java Native Interface changes jpl/JNI/Closer.java Java Native Interface example jpl/JNI/JNI.pm Java Native Interface module -jpl/JNI/JNI.pm Java Native Interface module +jpl/JNI/JNI.xs Java Native Interface module jpl/JNI/JNIConfig Java Native Interface config jpl/JNI/JNIConfig.Win32 Java Native Interface config jpl/JNI/JNIConfig.kaffe Java Native Interface config @@ -613,10 +629,10 @@ lib/Pod/Checker.pm Pod-Parser - check POD documents for syntax errors lib/Pod/Functions.pm used by pod/splitpod lib/Pod/Html.pm Convert POD data to HTML lib/Pod/InputObjects.pm Pod-Parser - define objects for input streams +lib/Pod/Man.pm Convert POD data to *roff lib/Pod/Parser.pm Pod-Parser - define base class for parsing POD -lib/Pod/PlainText.pm Pod-Parser - convert POD data to formatted ASCII text lib/Pod/Select.pm Pod-Parser - select portions of POD docs -lib/Pod/Text.pm Convert POD data to formatted ASCII text +lib/Pod/Text.pm Pod-Parser - convert POD data to formatted ASCII text lib/Pod/Text/Color.pm Convert POD data to color ASCII text lib/Pod/Text/Termcap.pm Convert POD data to ASCII text with format escapes lib/Pod/Usage.pm Pod-Parser - print usage messages @@ -659,6 +675,8 @@ lib/bigfloat.pl An arbitrary precision floating point package lib/bigint.pl An arbitrary precision integer arithmetic package lib/bigrat.pl An arbitrary precision rational arithmetic package lib/blib.pm For "use blib" +lib/byte.pm Pragma to enable byte operations +lib/byte_heavy.pl Support routines for byte pragma lib/cacheout.pl Manages output filehandles when you need too many lib/caller.pm Inherit pragmatic attributes from caller's context lib/charnames.pm Character names @@ -704,13 +722,17 @@ lib/termcap.pl Perl library supporting termcap usage lib/timelocal.pl Perl library supporting inverse of localtime, gmtime lib/unicode/ArabLink.pl Unicode character database lib/unicode/ArabLnkGrp.pl Unicode character database +lib/unicode/ArabShap.txt Unicode character database lib/unicode/Bidirectional.pl Unicode character database lib/unicode/Block.pl Unicode character database +lib/unicode/Blocks.txt Unicode character database lib/unicode/Category.pl Unicode character database lib/unicode/CombiningClass.pl Unicode character database +lib/unicode/CompExcl.txt Unicode character database lib/unicode/Decomposition.pl Unicode character database -lib/unicode/Eq/Latin1 Unicode character database -lib/unicode/Eq/Unicode Unicode character database +lib/unicode/EAWidth.txt Unicode character database +lib/unicode/Eq/Latin1.pl Unicode character database +lib/unicode/Eq/Unicode.pl Unicode character database lib/unicode/In/AlphabeticPresentationForms.pl Unicode character database lib/unicode/In/Arabic.pl Unicode character database lib/unicode/In/ArabicPresentationForms-A.pl Unicode character database @@ -721,12 +743,17 @@ lib/unicode/In/BasicLatin.pl Unicode character database lib/unicode/In/Bengali.pl Unicode character database lib/unicode/In/BlockElements.pl Unicode character database lib/unicode/In/Bopomofo.pl Unicode character database +lib/unicode/In/BopomofoExtended.pl Unicode character database lib/unicode/In/BoxDrawing.pl Unicode character database +lib/unicode/In/BraillePatterns.pl Unicode character database lib/unicode/In/CJKCompatibility.pl Unicode character database lib/unicode/In/CJKCompatibilityForms.pl Unicode character database lib/unicode/In/CJKCompatibilityIdeographs.pl Unicode character database +lib/unicode/In/CJKRadicalsSupplement.pl Unicode character database lib/unicode/In/CJKSymbolsandPunctuation.pl Unicode character database lib/unicode/In/CJKUnifiedIdeographs.pl Unicode character database +lib/unicode/In/CJKUnifiedIdeographsExtensionA.pl Unicode character database +lib/unicode/In/Cherokee.pl Unicode character database lib/unicode/In/CombiningDiacriticalMarks.pl Unicode character database lib/unicode/In/CombiningHalfMarks.pl Unicode character database lib/unicode/In/CombiningMarksforSymbols.pl Unicode character database @@ -754,9 +781,12 @@ lib/unicode/In/HighPrivateUseSurrogates.pl Unicode character database lib/unicode/In/HighSurrogates.pl Unicode character database lib/unicode/In/Hiragana.pl Unicode character database lib/unicode/In/IPAExtensions.pl Unicode character database +lib/unicode/In/IdeographicDescriptionCharacters.pl Unicode character database lib/unicode/In/Kanbun.pl Unicode character database +lib/unicode/In/KangxiRadicals.pl Unicode character database lib/unicode/In/Kannada.pl Unicode character database lib/unicode/In/Katakana.pl Unicode character database +lib/unicode/In/Khmer.pl Unicode character database lib/unicode/In/Lao.pl Unicode character database lib/unicode/In/Latin-1Supplement.pl Unicode character database lib/unicode/In/LatinExtended-A.pl Unicode character database @@ -768,18 +798,29 @@ lib/unicode/In/Malayalam.pl Unicode character database lib/unicode/In/MathematicalOperators.pl Unicode character database lib/unicode/In/MiscellaneousSymbols.pl Unicode character database lib/unicode/In/MiscellaneousTechnical.pl Unicode character database +lib/unicode/In/Mongolian.pl Unicode character database +lib/unicode/In/Myanmar.pl Unicode character database lib/unicode/In/NumberForms.pl Unicode character database +lib/unicode/In/Ogham.pl Unicode character database lib/unicode/In/OpticalCharacterRecognition.pl Unicode character database lib/unicode/In/Oriya.pl Unicode character database lib/unicode/In/PrivateUse.pl Unicode character database +lib/unicode/In/Runic.pl Unicode character database +lib/unicode/In/Sinhala.pl Unicode character database lib/unicode/In/SmallFormVariants.pl Unicode character database lib/unicode/In/SpacingModifierLetters.pl Unicode character database lib/unicode/In/Specials.pl Unicode character database lib/unicode/In/SuperscriptsandSubscripts.pl Unicode character database +lib/unicode/In/Syriac.pl Unicode character database lib/unicode/In/Tamil.pl Unicode character database lib/unicode/In/Telugu.pl Unicode character database +lib/unicode/In/Thaana.pl Unicode character database lib/unicode/In/Thai.pl Unicode character database lib/unicode/In/Tibetan.pl Unicode character database +lib/unicode/In/UnifiedCanadianAboriginalSyllabics.pl Unicode character database +lib/unicode/In/YiRadicals.pl Unicode character database +lib/unicode/In/YiSyllables.pl Unicode character database +lib/unicode/Index.txt Unicode character database lib/unicode/Is/ASCII.pl Unicode character database lib/unicode/Is/Alnum.pl Unicode character database lib/unicode/Is/Alpha.pl Unicode character database @@ -848,7 +889,6 @@ lib/unicode/Is/SylA.pl Unicode character database lib/unicode/Is/SylC.pl Unicode character database lib/unicode/Is/SylE.pl Unicode character database lib/unicode/Is/SylI.pl Unicode character database -lib/unicode/Is/Syllable.pl Unicode character database lib/unicode/Is/SylO.pl Unicode character database lib/unicode/Is/SylU.pl Unicode character database lib/unicode/Is/SylV.pl Unicode character database @@ -857,6 +897,7 @@ lib/unicode/Is/SylWC.pl Unicode character database lib/unicode/Is/SylWE.pl Unicode character database lib/unicode/Is/SylWI.pl Unicode character database lib/unicode/Is/SylWV.pl Unicode character database +lib/unicode/Is/Syllable.pl Unicode character database lib/unicode/Is/Upper.pl Unicode character database lib/unicode/Is/Word.pl Unicode character database lib/unicode/Is/XDigit.pl Unicode character database @@ -864,30 +905,27 @@ lib/unicode/Is/Z.pl Unicode character database lib/unicode/Is/Zl.pl Unicode character database lib/unicode/Is/Zp.pl Unicode character database lib/unicode/Is/Zs.pl Unicode character database +lib/unicode/Jamo.txt Unicode character database lib/unicode/JamoShort.pl Unicode character database +lib/unicode/LineBrk.txt Unicode character database lib/unicode/Makefile Unicode character database lib/unicode/Name.pl Unicode character database +lib/unicode/Names.txt Unicode character database +lib/unicode/NamesList.html Unicode character database lib/unicode/Number.pl Unicode character database +lib/unicode/Props.txt Unicode character database lib/unicode/README.Ethiopic Unicode character database +lib/unicode/ReadMe.txt Unicode character database info +lib/unicode/SpecCase.txt Unicode character database lib/unicode/To/Digit.pl Unicode character database lib/unicode/To/Lower.pl Unicode character database lib/unicode/To/Title.pl Unicode character database lib/unicode/To/Upper.pl Unicode character database -lib/unicode/UnicodeData-Latest.txt Unicode character database -lib/unicode/ArabShap.txt Unicode character database -lib/unicode/Blocks.txt Unicode character database -lib/unicode/CompExcl.txt Unicode character database -lib/unicode/EAWidth.txt Unicode character database -lib/unicode/Index.txt Unicode character database -lib/unicode/Jamo-2.txt Unicode character database -lib/unicode/LineBrk.txt Unicode character database +lib/unicode/UCD300.html Unicode character database +lib/unicode/Unicode.300 Unicode character database +lib/unicode/Unicode3.html Unicode character database lib/unicode/mktables.PL Unicode character database generator -lib/unicode/Names.txt Unicode character database -lib/unicode/Props.txt Unicode character database -lib/unicode/ReadMe.txt Unicode character database info -lib/unicode/SpecCase.txt Unicode character database lib/unicode/syllables.txt Unicode character database -lib/unicode/Unicode.html Unicode character database lib/utf8.pm Pragma to control Unicode support lib/utf8_heavy.pl Support routines for utf8 pragma lib/validate.pl Perl library supporting wholesale file mode validation @@ -944,11 +982,17 @@ os2/OS2/Process/Process.pm system() constants in a module os2/OS2/Process/Process.xs system() constants in a module os2/OS2/REXX/Changes DLL access module os2/OS2/REXX/MANIFEST DLL access module +os2/OS2/REXX/DLL/Changes DLL access module +os2/OS2/REXX/DLL/DLL.pm DLL access module +os2/OS2/REXX/DLL/DLL.xs DLL access module +os2/OS2/REXX/DLL/MANIFEST DLL access module +os2/OS2/REXX/DLL/Makefile.PL DLL access module os2/OS2/REXX/Makefile.PL DLL access module os2/OS2/REXX/REXX.pm DLL access module os2/OS2/REXX/REXX.xs DLL access module os2/OS2/REXX/t/rx_cmprt.t DLL access module os2/OS2/REXX/t/rx_dllld.t DLL access module +os2/OS2/REXX/t/rx_emxrv.t DLL access module os2/OS2/REXX/t/rx_objcall.t DLL access module os2/OS2/REXX/t/rx_sql.test DLL access module os2/OS2/REXX/t/rx_tiesql.test DLL access module @@ -956,7 +1000,6 @@ os2/OS2/REXX/t/rx_tievar.t DLL access module os2/OS2/REXX/t/rx_tieydb.t DLL access module os2/OS2/REXX/t/rx_varset.t DLL access module os2/OS2/REXX/t/rx_vrexx.t DLL access module -os2/POSIX.mkfifo OS2-specific patch os2/diff.configure Patches to Configure os2/dl_os2.c Addon for dl_open os2/dlfcn.h Addon for dl_open @@ -1026,9 +1069,12 @@ pod/perlfaq6.pod Frequently Asked Questions, Part 6 pod/perlfaq7.pod Frequently Asked Questions, Part 7 pod/perlfaq8.pod Frequently Asked Questions, Part 8 pod/perlfaq9.pod Frequently Asked Questions, Part 9 +pod/perlfilter.pod Source filters info +pod/perlfork.pod Info about fork() pod/perlform.pod Format info pod/perlfunc.pod Function info pod/perlguts.pod Internals info +pod/perlhack.pod Perl hackers guide pod/perlhist.pod Perl history info pod/perlipc.pod IPC info pod/perllexwarn.pod Lexical Warnings info @@ -1128,6 +1174,7 @@ t/io/dup.t See if >& works right t/io/fs.t See if directory manipulations work t/io/inplace.t See if inplace editing works t/io/iprefix.t See if inplace editing works with prefixes +t/io/nargv.t See if nested ARGV stuff works t/io/open.t See if open works t/io/openpid.t See if open works for subprocesses t/io/pipe.t See if secure pipes work @@ -1186,6 +1233,10 @@ t/lib/filespec.t See if File::Spec works t/lib/findbin.t See if FindBin works t/lib/gdbm.t See if GDBM_File works t/lib/getopt.t See if Getopt::Std and Getopt::Long work +t/lib/glob-basic.t See if File::Glob works +t/lib/glob-case.t See if File::Glob works +t/lib/glob-global.t See if File::Glob works +t/lib/glob-taint.t See if File::Glob works t/lib/gol-basic.t See if Getopt::Long works t/lib/gol-compat.t See if Getopt::Long works t/lib/gol-linkage.t See if Getopt::Long works @@ -1344,14 +1395,20 @@ t/pod/included.t Test =include directive t/pod/included.xr Expected results for included.t t/pod/lref.t Test L<...> sequences t/pod/lref.xr Expected results for lref.t +t/pod/multiline_items.t Test multiline =items +t/pod/multiline_items.xr Test multiline =items t/pod/nested_items.t Test nested =items t/pod/nested_items.xr Expected results for nested_items.t t/pod/nested_seqs.t Test nested interior sequences t/pod/nested_seqs.xr Expected results for nested_seqs.t t/pod/oneline_cmds.t Test single paragraph ==cmds t/pod/oneline_cmds.xr Expected results for oneline_cmds.t +t/pod/pod2usage.t Test Pod::Usage +t/pod/pod2usage.xr Expected results for pod2usage.t t/pod/poderrs.t Test POD errors t/pod/poderrs.xr Expected results for emptycmd.t +t/pod/podselect.t Test Pod::Select +t/pod/podselect.xr Expected results for podselect.t t/pod/special_seqs.t Test "special" interior sequences t/pod/special_seqs.xr Expected results for emptycmd.t t/pod/testcmp.pl Module to compare output against expected results @@ -1486,16 +1543,20 @@ win32/config_h.PL Perl code to convert Win32 config.sh to config.h win32/config_sh.PL Perl code to update Win32 config.sh from Makefile win32/des_fcrypt.patch Win32 port win32/dl_win32.xs Win32 port +win32/genmk95.pl Perl code to generate command.com-usable makefile.95 win32/include/arpa/inet.h Win32 port win32/include/dirent.h Win32 port win32/include/netdb.h Win32 port win32/include/sys/socket.h Win32 port -win32/makefile.mk Win32 makefile for DMAKE (BC++, VC++ builds) +win32/makefile.mk Win32 makefile for DMAKE (BC++, VC++ builds) win32/perlglob.c Win32 port +win32/perlhost.h Perl "host" implementation win32/perllib.c Win32 port win32/pod.mak Win32 port win32/runperl.c Win32 port win32/splittree.pl Win32 port +win32/vdir.h Perl "host" virtual directory manager +win32/vmem.h Perl "host" memory manager win32/win32.c Win32 port win32/win32.h Win32 port win32/win32iop.h Win32 port diff --git a/Makefile.SH b/Makefile.SH index 09f7f9c..347ee7e 100644 --- a/Makefile.SH +++ b/Makefile.SH @@ -194,6 +194,10 @@ SHELL = $sh # how to tr(anslate) newlines TRNL = '$trnl' +# not used by Makefile but by installperl; +# mentioned here so that metaconfig picks it up +INSTALL_USR_BIN_PERL = $installusrbinperl + !GROK!THIS! ## In the following dollars and backticks do not need the extra backslash. @@ -257,7 +261,7 @@ lintflags = -hbvxac .c$(OBJ_EXT): $(CCCMD) $(PLDLFLAGS) $*.c -all: $(FIRSTMAKEFILE) miniperl $(private) $(plextract) $(public) $(dynamic_ext) $(nonxs_ext) +all: $(FIRSTMAKEFILE) miniperl extra.pods $(private) $(public) $(dynamic_ext) $(nonxs_ext) @echo " "; @echo " Everything is up to date. 'make test' to run test suite." @@ -270,7 +274,7 @@ compile: all translators: miniperl lib/Config.pm FORCE @echo " "; echo " Making x2p stuff"; cd x2p; $(LDLIBPTH) $(MAKE) all -utilities: miniperl lib/Config.pm FORCE +utilities: miniperl lib/Config.pm $(plextract) FORCE @echo " "; echo " Making utilities"; cd utils; $(LDLIBPTH) $(MAKE) all @@ -282,6 +286,9 @@ utilities: miniperl lib/Config.pm FORCE FORCE: @sh -c true +opmini$(OBJ_EXT): op.c + $(CCCMD) $(PLDLFLAGS) -DPERL_EXTERNAL_GLOB -o opmini$(OBJ_EXT) op.c + miniperlmain$(OBJ_EXT): miniperlmain.c $(CCCMD) $(PLDLFLAGS) $*.c @@ -332,8 +339,9 @@ $(LIBPERL_NONSHR): perl$(OBJ_EXT) $(obj) $(RMS) $(LIBPERL_NONSHR) $(AR) rcu $(LIBPERL_NONSHR) perl$(OBJ_EXT) $(obj) -$(MINIPERL_NONSHR): $(LIBPERL_NONSHR) miniperlmain$(OBJ_EXT) - $(CC) $(LDFLAGS) -o $(MINIPERL_NONSHR) miniperlmain$(OBJ_EXT) $(LIBPERL_NONSHR) $(LIBS) +$(MINIPERL_NONSHR): $(LIBPERL_NONSHR) miniperlmain$(OBJ_EXT) opmini$(OBJ_EXT) + $(CC) $(LDFLAGS) -o $(MINIPERL_NONSHR) miniperlmain$(OBJ_EXT) \ + opmini$(OBJ_EXT) $(LIBPERL_NONSHR) $(LIBS) MINIPERLEXP = $(MINIPERL_NONSHR) @@ -415,9 +423,28 @@ $(LIBPERL): $& perl$(OBJ_EXT) $(obj) $(LIBPERLEXPORT) # build problems but that's not obvious to the novice. # The Module used here must not depend on Config or any extensions. -miniperl: $& miniperlmain$(OBJ_EXT) $(LIBPERL) - $(LDLIBPTH) $(CC) $(LARGE) $(CLDFLAGS) -o miniperl miniperlmain$(OBJ_EXT) $(LLIBPERL) $(libs) - $(LDLIBPTH) ./miniperl -w -Ilib -MExporter -e 0 || $(MAKE) minitest +!NO!SUBS! + + case "${osname}${osvers}" in + next4*) + $spitshell >>Makefile <<'!NO!SUBS!' +miniperl: $& miniperlmain$(OBJ_EXT) $(LIBPERL) opmini$(OBJ_EXT) + $(CC) -o miniperl `echo $(obj) | sed 's/ op$(OBJ_EXT) / /'` \ + miniperlmain$(OBJ_EXT) opmini$(OBJ_EXT) perl$(OBJ_EXT) $(libs) + $(LDLIBPTH) ./miniperl -w -Ilib -MExporter -e '' || $(MAKE) minitest +!NO!SUBS! + ;; + *) + $spitshell >>Makefile <<'!NO!SUBS!' +miniperl: $& miniperlmain$(OBJ_EXT) $(LIBPERL) opmini$(OBJ_EXT) + $(LDLIBPTH) $(CC) $(LARGE) $(CLDFLAGS) -o miniperl \ + miniperlmain$(OBJ_EXT) opmini$(OBJ_EXT) $(LLIBPERL) $(libs) + $(LDLIBPTH) ./miniperl -w -Ilib -MExporter -e '' || $(MAKE) minitest +!NO!SUBS! + ;; + esac + + $spitshell >>Makefile <<'!NO!SUBS!' perl: $& perlmain$(OBJ_EXT) $(LIBPERL) $(DYNALOADER) $(static_ext) ext.libs $(PERLEXPORT) $(SHRPENV) $(LDLIBPTH) $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o perl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs) @@ -454,7 +481,7 @@ sperl$(OBJ_EXT): perl.c perly.h patchlevel.h $(h) # We have to call our ./makedir because Ultrix 4.3 make can't handle the line # test -d lib/auto || mkdir lib/auto # -preplibrary: miniperl lib/Config.pm $(plextract) +preplibrary: miniperl lib/Config.pm @sh ./makedir lib/auto @echo " AutoSplitting perl library" $(LDLIBPTH) ./miniperl -Ilib -e 'use AutoSplit; \ @@ -463,7 +490,7 @@ preplibrary: miniperl lib/Config.pm $(plextract) # Take care to avoid modifying lib/Config.pm without reason # (If trying to create a new port and having problems with the configpm script, # try 'make minitest' and/or commenting out the tests at the end of configpm.) -lib/Config.pm: config.sh miniperl configpm +lib/Config.pm: config.sh miniperl configpm lib/re.pm $(LDLIBPTH) ./miniperl configpm configpm.tmp sh mv-if-diff configpm.tmp $@ @@ -475,9 +502,18 @@ lib/re.pm: ext/re/re.pm rm -f $@ cat ext/re/re.pm > $@ -$(plextract): miniperl lib/Config.pm lib/re.pm +$(plextract): miniperl lib/Config.pm $(LDLIBPTH) ./miniperl -Ilib $@.PL - + +extra.pods: miniperl + -@test -f extra.pods && rm -f `cat extra.pods` + -@rm -f extra.pods + -@for x in `grep -l '^=[a-z]' README.*` ; do \ + nx=`echo $$x | sed -e "s/README\.//"`; \ + $(LNS) ../$$x "pod/perl"$$nx".pod" ; \ + echo "pod/perl"$$nx".pod" >> extra.pods ; \ + done + install: all install.perl install.man install.perl: all installperl @@ -539,6 +575,8 @@ SYM = global.sym globvar.sym perlio.sym pp.sym SYMH = perlvars.h intrpvar.h thrdvar.h +CHMOD_W = chmod +w + # The following files are generated automatically # keywords.h: keywords.pl # opcode.h: opcode.pl @@ -557,6 +595,7 @@ SYMH = perlvars.h intrpvar.h thrdvar.h # To force them to run, type # make regen_headers regen_headers: FORCE + $(CHMOD_W) proto.h warnings.h lib/warnings.pm perl keywords.pl perl opcode.pl perl embed.pl @@ -599,7 +638,8 @@ distclean: clobber # Do not 'make _mopup' directly. _mopup: rm -f *$(OBJ_EXT) *$(LIB_EXT) all perlmain.c - rm -f perl.exp ext.libs + -@test -f extra.pods && rm -f `cat extra.pods` + -rm -f perl.exp ext.libs extra.pods -rm -f perl.export perl.dll perl.libexp perl.map perl.def -rm -f perl.loadmap miniperl.loadmap perl.prelmap miniperl.prelmap rm -f perl suidperl miniperl $(LIBPERL) diff --git a/Policy_sh.SH b/Policy_sh.SH index 3008843..cb8536c 100644 --- a/Policy_sh.SH +++ b/Policy_sh.SH @@ -29,12 +29,25 @@ case "\$perladmin" in '') perladmin='$perladmin' ;; esac -# Installation prefix. Allow a Configure -D override. You +# Installation prefixes. Allow a Configure -D override. You # may wish to reinstall perl under a different prefix, perhaps # in order to test a different configuration. +# For an explanation of the installation directories, see the +# INSTALL file section on "Installation Directories". case "\$prefix" in '') prefix='$prefix' ;; esac +case "\$siteprefix" in +'') siteprefix='$siteprefix' ;; +esac +case "\$vendorprefix" in +'') vendorprefix='$vendorprefix' ;; +esac + +# Where installperl puts things. +case "\$installprefix" in +'') installprefix='$installprefix' ;; +esac # Installation directives. Note that each one comes in three flavors. # For example, we have privlib, privlibexp, and installprivlib. @@ -44,7 +57,22 @@ esac # out automatically by Configure, so you don't have to include it here. # installprivlib is for systems (such as those running AFS) that # need to distinguish between the place where things -# get installed and where they finally will reside. +# get installed and where they finally will reside. As of 5.005_6x, +# this too is handled automatically by Configure based on +# $installprefix, so it isn't included here either. +# +# Note also that there are three broad hierarchies of installation +# directories, as discussed in the INSTALL file under +# "Installation Directories": +# +# =item Directories for the perl distribution +# +# =item Directories for site-specific add-on files +# +# =item Directories for vendor-supplied add-on files +# +# See Porting/Glossary for the definitions of these names, and see the +# INSTALL file for further explanation and some examples. # # In each case, if your previous value was the default, leave it commented # out. That way, if you override prefix, all of these will be @@ -56,13 +84,17 @@ esac !GROK!THIS! -for var in bin scriptdir privlib archlib \ - man1dir man3dir sitelib sitearch \ - installbin installscript installprivlib installarchlib \ - installman1dir installman3dir installsitelib installsitearch \ - man1ext man3ext; do +for var in \ + bin scriptdir privlib archlib man1dir man3dir html1dir html3dir \ + sitebin sitescriptdir sitelib sitearch \ + siteman1dir siteman3dir sitehtml1dir sitehtml3dir \ + vendorbin vendorscript vendorlib vendorarch \ + vendorman1 vendorman3 vendorhtml1 vendorhtml3 +do case "$var" in + + # Directories for the core perl components bin) dflt=$prefix/bin ;; # The scriptdir test is more complex, but this is probably usually ok. scriptdir) @@ -78,47 +110,77 @@ for var in bin scriptdir privlib archlib \ *) dflt=$prefix/lib/$package/$version ;; esac ;; - archlib) - case "$prefix" in - *perl*) dflt=$prefix/lib/$version/$archname ;; - *) dflt=$prefix/lib/$package/$version/$archname ;; - esac + archlib) dflt="$privlib/$archname" ;; + + man1dir) dflt="$prefix/man/man1" ;; + man3dir) dflt="$prefix/man/man3" ;; + # Can we assume all sed's have greedy matching? + man1ext) dflt=`echo $man1dir | sed -e 's!.*man!!' -e 's!^\.!!'` ;; + man3ext) dflt=`echo $man3dir | sed -e 's!.*man!!' -e 's!^\.!!'` ;; + + # We don't know what to do with these yet. + html1dir) dflt='' ;; + htm31dir) dflt='' ;; + + # Directories for site-specific add-on files + sitebin) dflt=$siteprefix/bin ;; + # The scriptdir test is more complex, but this is probably usually ok. + sitescriptdir) + if $test -d $siteprefix/script; then + dflt=$siteprefix/script + else + dflt=$sitebin + fi ;; sitelib) - case "$prefix" in - *perl*) dflt=$prefix/lib/site_perl/$apiversion ;; - *) dflt=$prefix/lib/$package/site_perl/$apiversion ;; - esac - ;; - sitearch) - case "$prefix" in - *perl*) dflt=$prefix/lib/site_perl/$apiversion/$archname ;; - *) dflt=$prefix/lib/$package/site_perl/$apiversion/$archname ;; - esac - ;; - man1dir) dflt="$prefix/man/man1" ;; - man3dir) - case "$prefix" in - *perl*) dflt=`echo $man1dir | - sed -e 's/man1/man3/g' -e 's/man\.1/man\.3/g'` ;; - *) dflt=$privlib/man/man3 ;; + case "$siteprefix" in + *perl*) dflt=$prefix/lib/site_perl ;; + *) dflt=$prefix/lib/$package/site_perl ;; esac ;; + sitearch) dflt="$sitelib/$apiversion/$archname" ;; - # Can we assume all sed's have greedy matching? - man1ext) dflt=`echo $man1dir | sed -e 's!.*man!!' -e 's!^\.!!'` ;; - man3ext) dflt=`echo $man3dir | sed -e 's!.*man!!' -e 's!^\.!!'` ;; + siteman1dir) dflt="$siteprefix/man/man1" ;; + siteman3dir) dflt="$siteprefix/man/man3" ;; + # We don't know what to do with these yet. + sitehtml1dir) dflt='' ;; + sitehtm31dir) dflt='' ;; + + # Directories for vendor-supplied add-on files + # These are all usually empty. + vendor*) + if test X"$vendorprefix" = X""; then + dflt='' + else + case "$var" in + vendorbin) dflt=$vendorprefix/bin ;; - # It might be possible to fool these next tests. Please let - # me know if they don't work right for you. - installbin) dflt=`echo $binexp | sed 's#^/afs/#/afs/.#'`;; - installscript) dflt=`echo $scriptdirexp | sed 's#^/afs/#/afs/.#'`;; - installprivlib) dflt=`echo $privlibexp | sed 's#^/afs/#/afs/.#'`;; - installarchlib) dflt=`echo $archlibexp | sed 's#^/afs/#/afs/.#'`;; - installsitelib) dflt=`echo $sitelibexp | sed 's#^/afs/#/afs/.#'`;; - installsitearch) dflt=`echo $sitearchexp | sed 's#^/afs/#/afs/.#'`;; - installman1dir) dflt=`echo $man1direxp | sed 's#^/afs/#/afs/.#'`;; - installman3dir) dflt=`echo $man3direxp | sed 's#^/afs/#/afs/.#'`;; + # The scriptdir test is more complex, + # but this is probably usually ok. + vendorscriptdir) + if $test -d $vendorprefix/script; then + dflt=$vendorprefix/script + else + dflt=$vendorbin + fi + ;; + vendorlib) + case "$vendorprefix" in + *perl*) dflt=$prefix/lib/vendor_perl ;; + *) dflt=$prefix/lib/$package/vendor_perl ;; + esac + ;; + vendorarch) dflt="$vendorlib/$apiversion/$archname" ;; + + vendorman1dir) dflt="$vendorprefix/man/man1" ;; + vendorman3dir) dflt="$vendorprefix/man/man3" ;; + # We don't know what to do with these yet. + vendorhtml1dir) dflt='' ;; + vendorhtm31dir) dflt='' ;; + + esac # End of vendorprefix != '' + fi + ;; esac eval val="\$$var" @@ -148,6 +210,5 @@ $spitshell <>Policy.sh # The original design for this Policy.sh file came from Wayne Davison, # maintainer of trn. # This version for Perl5.004_61 originally written by -# Andy Dougherty . +# Andy Dougherty . # This file may be distributed under the same terms as Perl itself. - diff --git a/Porting/Glossary b/Porting/Glossary index fe4b9c4..bde26b7 100644 --- a/Porting/Glossary +++ b/Porting/Glossary @@ -37,17 +37,52 @@ aphostname (d_gethname.U): host name. The command is fully qualified by its absolute path, to make it safe when used by a process with super-user privileges. -apiversion (patchlevel.U): - This is a number which identifies the lowest version of perl - to have an API (for XS extensions) compatible with the present - version. For example, for 5.005_01, the apiversion should be - 5.005, since 5.005_01 should be binary compatible with 5.005. - This should probably be incremented manually somehow, perhaps - from patchlevel.h. For now, we'll guess maintenance subversions - will retain binary compatibility. +api_revision (patchlevel.U): + The three variables, api_revision, api_version, and + api_subversion, specify the version of the oldest perl binary + compatible with the present perl. In a full version string + such as '5.6.1', api_revision is the '5'. + Prior to 5.5.640, the format was a floating point number, + like 5.00563. + perl.c:incpush() and lib/lib.pm will automatically search in + $sitelib/.. for older directories back to the limit specified + by these api_ variables. This is only useful if you have a + perl library directory tree structured like the default one. + See INSTALL for how this works. The versioned site_perl + directory was introduced in 5.005, so that is the lowest + possible value. The version list appropriate for the current + system is determined in inc_version_list.U. + XXX To do: Since compatibility can depend on compile time + options (such as bincompat, longlong, etc.) it should + (perhaps) be set by Configure, but currently it isn't. + Currently, we read a hard-wired value from patchlevel.h. + Perhaps what we ought to do is take the hard-wired value from + patchlevel.h but then modify it if the current Configure + options warrant. patchlevel.h then would use an #ifdef guard. + +api_subversion (patchlevel.U): + The three variables, api_revision, api_version, and + api_subversion, specify the version of the oldest perl binary + compatible with the present perl. In a full version string + such as '5.6.1', api_subversion is the '1'. See api_revision for + full details. + +api_version (patchlevel.U): + The three variables, api_revision, api_version, and + api_subversion, specify the version of the oldest perl binary + compatible with the present perl. In a full version string + such as '5.6.1', api_version is the '6'. See api_revision for + full details. As a special case, 5.5.0 is rendered in the + old-style as 5.005. (In the 5.005_0x maintenance series, + this was the only versioned directory in $sitelib.) + +api_versionstring (patchlevel.U): + This variable combines api_revision, api_version, and + api_subversion in a format such as 5.6.1 (or 5_6_1) suitable + for use as a directory name. This is filesystem dependent. ar (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the ar program. After Configure runs, the value is reset to a plain "ar" and is not useful. @@ -77,7 +112,7 @@ archobjs (Unix.U): include os2/os2.obj. awk (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the awk program. After Configure runs, the value is reset to a plain "awk" and is not useful. @@ -107,7 +142,7 @@ bison (Loc.U): The value is a plain '' and is not useful. byacc (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the byacc program. After Configure runs, the value is reset to a plain "byacc" and is not useful. @@ -131,7 +166,7 @@ castflags (d_castneg.U): 4 = couldn't cast in argument expression list cat (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the cat program. After Configure runs, the value is reset to a plain "cat" and is not useful. @@ -174,6 +209,10 @@ cf_time (cf_who.U): Holds the output of the "date" command when the configuration file was produced. This is used to tag both config.sh and config_h.SH. +charsize (charsize.U): + This variable contains the value of the CHARSIZE symbol, which + indicates to the C program how many bytes there are in a character. + chgrp (Loc.U): This variable is defined but not used by Configure. The value is a plain '' and is not useful. @@ -192,7 +231,7 @@ clocktype (d_times.U): included). comm (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the comm program. After Configure runs, the value is reset to a plain "comm" and is not useful. @@ -200,6 +239,10 @@ compress (Loc.U): This variable is defined but not used by Configure. The value is a plain '' and is not useful. +CONFIGDOTSH (Oldsyms.U): + This is set to 'true' in config.sh so that a shell script + sourcing config.sh can tell if it has been sourced already. + contains (contains.U): This variable holds the command to do a grep with a proper return status. On most sane systems it is simply "grep". On insane systems @@ -207,7 +250,7 @@ contains (contains.U): is primarily for the use of other Configure units. cp (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the cp program. After Configure runs, the value is reset to a plain "cp" and is not useful. @@ -216,7 +259,7 @@ cpio (Loc.U): The value is a plain '' and is not useful. cpp (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the cpp program. After Configure runs, the value is reset to a plain "cpp" and is not useful. @@ -225,7 +268,7 @@ cpp_stuff (cpp_stuff.U): used by the C preprocessor. cppccsymbols (Cppsym.U): - The variable contains the symbols defined by the C compiler when + The variable contains the symbols defined by the C compiler when it calls cpp. The symbols defined by the cc alone or cpp alone are not in this list, see ccsymbols and cppsymbols. The list is a space-separated list of symbol=value tokens. @@ -275,7 +318,7 @@ cryptlib (d_crypt.U): up to the Makefile to use this. csh (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the csh program. After Configure runs, the value is reset to a plain "csh" and is not useful. @@ -370,10 +413,6 @@ d_closedir (d_closedir.U): This variable conditionally defines HAS_CLOSEDIR if closedir() is available. -d_cmsghdr_s (d_socket.U): - This variable conditionally defines the HAS_STRUCT_CMSGHDR symbol, - which indicates that the the struct cmsghdr is supported. - d_const (d_const.U): This variable conditionally defines the HASCONST symbol, which indicates to the C program that this C compiler knows about the @@ -532,6 +571,10 @@ d_fpathconf (d_pathconf.U): d_fpos64_t (io64.U): This symbol will be defined if the C compiler supports fpos64_t. +d_fs_data_s (d_fs_data_s.U): + This variable conditionally defines the HAS_STRUCT_FS_DATA symbol, + which indicates that the struct fs_data is supported. + d_fseeko (d_fseeko.U): This variable conditionally defines the HAS_FSEEKO symbol, which indicates to the C program that the fseeko() routine is available. @@ -540,7 +583,7 @@ d_fsetpos (d_fsetpos.U): This variable conditionally defines HAS_FSETPOS if fsetpos() is available to set the file position indicator. -d_fstatfs (d_statfs.U): +d_fstatfs (d_fstatfs.U): This variable conditionally defines the HAS_FSTATFS symbol, which indicates to the C program that the fstatfs() routine is available. @@ -606,10 +649,15 @@ d_getlogin (d_getlogin.U): indicates to the C program that the getlogin() routine is available to get the login name. +d_getmnt (d_getmnt.U): + This variable conditionally defines the HAS_GETMNT symbol, which + indicates to the C program that the getmnt() routine is available + to retrieve one or more mount info blocks by filename. + d_getmntent (d_getmntent.U): This variable conditionally defines the HAS_GETMNTENT symbol, which indicates to the C program that the getmntent() routine is available - to iterate through mounted files. + to iterate through mounted files to get their mount info. d_getnbyaddr (d_getnbyad.U): This variable conditionally defines the HAS_GETNETBYADDR symbol, which @@ -741,13 +789,9 @@ d_inetaton (d_inetaton.U): indicates to the C program that the inet_aton() function is available to parse IP address "dotted-quad" strings. -d_int64t (i_inttypes.U): +d_int64t (d_int64t.U): This symbol will be defined if the C compiler supports int64_t. -d_iovec_s (i_sysuio.U): - This variable conditionally defines the HAS_STRUCT_IOVEC symbol, - which indicates that the struct iovec is supported. - d_isascii (d_isascii.U): This variable conditionally defines the HAS_ISASCII constant, which indicates to the C program that isascii() is available. @@ -771,10 +815,6 @@ d_link (d_link.U): This variable conditionally defines HAS_LINK if link() is available to create hard links. -d_llseek (io64.U): - This variable conditionally defines the HAS_LLSEEK symbol, which - indicates to the C program that the llseek() routine is available. - d_locconv (d_locconv.U): This variable conditionally defines HAS_LOCALECONV if localeconv() is available for numeric and monetary formatting conventions. @@ -795,10 +835,6 @@ d_lstat (d_lstat.U): This variable conditionally defines HAS_LSTAT if lstat() is available to do file stats on symbolic links. -d_madvise (d_madvise.U): - This variable conditionally defines HAS_MADVISE if madvise() is - available to map a file into memory. - d_mblen (d_mblen.U): This variable conditionally defines the HAS_MBLEN symbol, which indicates to the C program that the mblen() routine is available @@ -852,14 +888,6 @@ d_mktime (d_mktime.U): This variable conditionally defines the HAS_MKTIME symbol, which indicates to the C program that the mktime() routine is available. -d_mmap (d_mmap.U): - This variable conditionally defines HAS_MMAP if mmap() is - available to map a file into memory. - -d_mprotect (d_mprotect.U): - This variable conditionally defines HAS_MPROTECT if mprotect() is - available to modify the access protection of a memory mapped file. - d_msg (d_msg.U): This variable conditionally defines the HAS_MSG symbol, which indicates that the entire msg*(2) library is present. @@ -897,10 +925,6 @@ d_msgget (d_msgget.U): This variable conditionally defines the HAS_MSGGET symbol, which indicates to the C program that the msgget() routine is available. -d_msghdr_s (d_socket.U): - This variable conditionally defines the HAS_STRUCT_MSGHDR symbol, - which indicates that the struct msghdr is supported. - d_msgrcv (d_msgrcv.U): This variable conditionally defines the HAS_MSGRCV symbol, which indicates to the C program that the msgrcv() routine is available. @@ -909,14 +933,6 @@ d_msgsnd (d_msgsnd.U): This variable conditionally defines the HAS_MSGSND symbol, which indicates to the C program that the msgsnd() routine is available. -d_msync (d_msync.U): - This variable conditionally defines HAS_MSYNC if msync() is - available to synchronize a mapped file. - -d_munmap (d_munmap.U): - This variable conditionally defines HAS_MUNMAP if munmap() is - available to unmap a region mapped by mmap(). - d_mymalloc (mallocsrc.U): This variable conditionally defines MYMALLOC in case other parts of the source want to take special action if MYMALLOC is used. @@ -1065,6 +1081,10 @@ d_pwquota (i_pwd.U): This variable conditionally defines PWQUOTA, which indicates that struct passwd contains pw_quota. +d_quad (quadtype.U): + This variable, if defined, tells that there's a 64-bit integer type, + quadtype. + d_readdir (d_readdir.U): This variable conditionally defines HAS_READDIR if readdir() is available to read directory entries. @@ -1074,14 +1094,6 @@ d_readlink (d_readlink.U): indicates to the C program that the readlink() routine is available to read the value of a symbolic link. -d_readv (d_readv.U): - This variable conditionally defines the HAS_READV symbol, which - indicates to the C program that the readv() routine is available. - -d_recvmsg (d_socket.U): - This variable conditionally defines the HAS_RECVMSG symbol, - which indicates that the recvmsg is supported. - d_rename (d_rename.U): This variable conditionally defines the HAS_RENAME symbol, which indicates to the C program that the rename() routine is available @@ -1151,10 +1163,6 @@ d_semop (d_semop.U): This variable conditionally defines the HAS_SEMOP symbol, which indicates to the C program that the semop() routine is available. -d_sendmsg (d_socket.U): - This variable conditionally defines the HAS_SENDMSG symbol, - which indicates that the sendmsg is supported. - d_setegid (d_setegid.U): This variable conditionally defines the HAS_SETEGID symbol, which indicates to the C program that the setegid() routine is available @@ -1312,21 +1320,25 @@ d_sockpair (d_socket.U): This variable conditionally defines the HAS_SOCKETPAIR symbol, which indicates that the BSD socketpair() is supported. +d_sqrtl (d_sqrtl.U): + This variable conditionally defines the HAS_SQRTL symbol, which + indicates to the C program that the sqrtl() routine is available. + d_statblks (d_statblks.U): This variable conditionally defines USE_STAT_BLOCKS if this system has a stat structure declaring st_blksize and st_blocks. -d_statfs (d_statfs.U): - This variable conditionally defines the HAS_STATFS symbol, which - indicates to the C program that the statfs() routine is available. - -d_statfsflags (d_statfs.U): - This variable conditionally defines the HAS_STRUCT_STATFS_FLAGS +d_statfs_f_flags (d_statfs_f_flags.U): + This variable conditionally defines the HAS_STRUCT_STATFS_F_FLAGS symbol, which indicates to struct statfs from has f_flags member. This kind of struct statfs is coming from sys/mount.h (BSD), not from sys/statfs.h (SYSV). +d_statfs_s (d_statfs_s.U): + This variable conditionally defines the HAS_STRUCT_STATFS symbol, + which indicates that the struct statfs is supported. + d_statvfs (d_statvfs.U): This variable conditionally defines the HAS_STATVFS symbol, which indicates to the C program that the statvfs() routine is available. @@ -1386,15 +1398,27 @@ d_strtol (d_strtol.U): indicates to the C program that the strtol() routine is available to provide better numeric string conversion than atoi() and friends. +d_strtold (d_strtold.U): + This variable conditionally defines the HAS_STRTOLD symbol, which + indicates to the C program that the strtold() routine is available. + +d_strtoll (d_strtoll.U): + This variable conditionally defines the HAS_STRTOLL symbol, which + indicates to the C program that the strtoll() routine is available. + d_strtoul (d_strtoul.U): This variable conditionally defines the HAS_STRTOUL symbol, which indicates to the C program that the strtoul() routine is available to provide conversion of strings to unsigned long. -d_strtoull (strtoull.U): +d_strtoull (d_strtoull.U): This variable conditionally defines the HAS_STRTOULL symbol, which indicates to the C program that the strtoull() routine is available. +d_strtouq (d_strtouq.U): + This variable conditionally defines the HAS_STRTOUQ symbol, which + indicates to the C program that the strtouq() routine is available. + d_strxfrm (d_strxfrm.U): This variable conditionally defines HAS_STRXFRM if strxfrm() is available to transform strings. @@ -1481,6 +1505,13 @@ d_union_semun (d_union_semun.U): This variable conditionally defines HAS_UNION_SEMUN if the union semun is defined by including . +d_ustat (d_ustat.U): + This variable conditionally defines HAS_USTAT if ustat() is + available to query file system statistics by dev_t. + +d_vendorbin (vendorbin.U): + This variable conditionally defines PERL_VENDORBIN. + d_vendorlib (vendorlib.U): This variable conditionally defines PERL_VENDORLIB. @@ -1531,16 +1562,12 @@ d_wctomb (d_wctomb.U): indicates to the C program that the wctomb() routine is available to convert a wide character to a multibyte. -d_writev (d_writev.U): - This variable conditionally defines the HAS_WRITEV symbol, which - indicates to the C program that the writev() routine is available. - d_xenix (Guess.U): This variable conditionally defines the symbol XENIX, which alerts the C program that it runs under Xenix. date (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the date program. After Configure runs, the value is reset to a plain "date" and is not useful. @@ -1597,12 +1624,12 @@ ebcdic (ebcdic.U): See trnl.U echo (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the echo program. After Configure runs, the value is reset to a plain "echo" and is not useful. egrep (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the egrep program. After Configure runs, the value is reset to a plain "egrep" and is not useful. @@ -1619,7 +1646,7 @@ exe_ext (Unix.U): This is an old synonym for _exe. expr (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the expr program. After Configure runs, the value is reset to a plain "expr" and is not useful. @@ -1654,8 +1681,11 @@ flex (Loc.U): This variable is defined but not used by Configure. The value is a plain '' and is not useful. +fpossize (fpossize.U): + This variable contains the size of a fpostype in bytes. + fpostype (fpostype.U): - This variable defines Fpos_t to be something like fpost_t, long, + This variable defines Fpos_t to be something like fpos_t, long, uint, or whatever type is used to declare file positions in libc. freetype (mallocsrc.U): @@ -1686,6 +1716,16 @@ gccversion (cc.U): indicate whether the compiler is version 1 or 2. This is used in setting some of the default cflags. It is set to '' if not gcc. +gidformat (gidf.U): + This variable contains the format string used for printing a Gid_t. + +gidsign (gidsign.U): + This variable contains the signedness of a gidtype. + 1 for unsigned, -1 for signed. + +gidsize (gidsize.U): + This variable contains the size of a gidtype in bytes. + gidtype (gidtype.U): This variable defines Gid_t to be something like gid_t, int, ushort, or whatever type is used to declare the return type @@ -1697,7 +1737,7 @@ glibpth (libpth.U): this platform, libpth is the cleaned-up version. grep (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the grep program. After Configure runs, the value is reset to a plain "grep" and is not useful. @@ -1705,6 +1745,8 @@ groupcat (nis.U): This variable contains a command that produces the text of the /etc/group file. This is normally "cat /etc/group", but can be "ypcat group" when NIS is used. + On some systems, such as os390, there may be no equivalent + command, in which case this variable is unset. groupstype (groupstype.U): This variable defines Groups_t to be something like gid_t, int, @@ -1713,7 +1755,7 @@ groupstype (groupstype.U): gidtype (gid_t), but sometimes it isn't. gzip (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the gzip program. After Configure runs, the value is reset to a plain "gzip" and is not useful. @@ -1733,6 +1775,8 @@ hostcat (nis.U): This variable contains a command that produces the text of the /etc/hosts file. This is normally "cat /etc/hosts", but can be "ypcat hosts" when NIS is used. + On some systems, such as os390, there may be no equivalent + command, in which case this variable is unset. huge (models.U): This variable contains a flag which will tell the C compiler and loader @@ -1740,6 +1784,30 @@ huge (models.U): huge model is not supported, contains the flag to produce large model programs. It is up to the Makefile to use this. +i16size (perlxv.U): + This variable is the size of an I16 in bytes. + +i16type (perlxv.U): + This variable contains the C type used for Perl's I16. + +i32size (perlxv.U): + This variable is the size of an I32 in bytes. + +i32type (perlxv.U): + This variable contains the C type used for Perl's I32. + +i64size (perlxv.U): + This variable is the size of an I64 in bytes. + +i64type (perlxv.U): + This variable contains the C type used for Perl's I64. + +i8size (perlxv.U): + This variable is the size of an I8 in bytes. + +i8type (perlxv.U): + This variable contains the C type used for Perl's I8. + i_arpainet (i_arpainet.U): This variable conditionally defines the I_ARPA_INET symbol, and indicates whether a C program should include . @@ -1926,10 +1994,6 @@ i_sysioctl (i_sysioctl.U): indicates to the C program that exists and should be included. -i_sysmman (i_sysmman.U): - This variable conditionally defines the I_SYS_MMAN symbol, and - indicates whether a C program should include . - i_sysmount (i_sysmount.U): This variable conditionally defines the I_SYSMOUNT symbol, and indicates whether a C program should include . @@ -1964,6 +2028,10 @@ i_sysstat (i_sysstat.U): This variable conditionally defines the I_SYS_STAT symbol, and indicates whether a C program should include . +i_sysstatfs (i_sysstatfs.U): + This variable conditionally defines the I_SYSSTATFS symbol, + and indicates whether a C program should include . + i_sysstatvfs (i_sysstatvfs.U): This variable conditionally defines the I_SYSSTATVFS symbol, and indicates whether a C program should include . @@ -1994,6 +2062,10 @@ i_sysun (i_sysun.U): to the C program that it should include to get UNIX domain socket definitions. +i_sysvfs (i_sysvfs.U): + This variable conditionally defines the I_SYSVFS symbol, + and indicates whether a C program should include . + i_syswait (i_syswait.U): This variable conditionally defines I_SYS_WAIT, which indicates to the C program that it should include . @@ -2016,6 +2088,10 @@ i_unistd (i_unistd.U): This variable conditionally defines the I_UNISTD symbol, and indicates whether a C program should include . +i_ustat (i_ustat.U): + This variable conditionally defines the I_USTAT symbol, and indicates + whether a C program should include . + i_utime (i_utime.U): This variable conditionally defines the I_UTIME symbol, and indicates whether a C program should include . @@ -2042,6 +2118,15 @@ ignore_versioned_solibs (libs.U): libraries (libfoo.so.x.y) are to be ignored (because they cannot be linked against). +inc_version_list (inc_version_list.U): + This variable specifies the list of subdirectories in over + which perl.c:incpush() and lib/lib.pm will automatically + search when adding directories to @INC. This is only useful + if you have a perl library directory tree structured like the + default one. See INSTALL for how this works. The versioned + site_perl directory was introduced in 5.005, so that is the + lowest possible value. + incpath (usrinc.U): This variable must preceed the normal include path to get hte right one, as in "$incpath/usr/include" or "$incpath/usr/lib". @@ -2100,6 +2185,11 @@ installsitearch (sitearch.U): those systems using AFS. For extra portability, only this variable should be used in makefiles. +installsitebin (sitebin.U): + This variable is usually the same as sitebinexp, unless you are on + a system running AFS, in which case they may differ slightly. You + should always use this variable within your makefiles for portability. + installsitelib (sitelib.U): This variable is really the same as sitelibexp but may differ on those systems using AFS. For extra portability, only this variable @@ -2128,6 +2218,11 @@ installusrbinperl (instubperl.U): /usr/bin/perl in addition to $installbin/perl +installvendorbin (vendorbin.U): + This variable is really the same as vendorbinexp but may differ on + those systems using AFS. For extra portability, only this variable + should be used in makefiles. + installvendorlib (vendorlib.U): This variable is really the same as vendorlibexp but may differ on those systems using AFS. For extra portability, only this variable @@ -2137,6 +2232,16 @@ intsize (intsize.U): This variable contains the value of the INTSIZE symbol, which indicates to the C program how many bytes there are in an int. +ivdformat (perlxvf.U): + This variable contains the format string used for printing + a Perl IV as a signed decimal integer. + +ivsize (perlxv.U): + This variable is the size of an IV in bytes. + +ivtype (perlxv.U): + This variable contains the C type used for Perl's IV. + known_extensions (Extensions.U): This variable holds a list of all XS extensions included in the package. @@ -2172,7 +2277,7 @@ ldlibpthname (libperl.U): string, the hints file must set this to 'none'. less (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the less program. After Configure runs, the value is reset to a plain "less" and is not useful. @@ -2216,7 +2321,7 @@ lkflags (ccflags.U): the user. It is up to the Makefile to use this. ln (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the ln program. After Configure runs, the value is reset to a plain "ln" and is not useful. @@ -2260,7 +2365,7 @@ lpr (Loc.U): The value is a plain '' and is not useful. ls (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the ls program. After Configure runs, the value is reset to a plain "ls" and is not useful. @@ -2283,7 +2388,7 @@ mailx (Loc.U): The value is a plain '' and is not useful. make (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the make program. After Configure runs, the value is reset to a plain "make" and is not useful. @@ -2344,7 +2449,7 @@ man3ext (man3dir.U): See man3dir. Mcc (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the Mcc program. After Configure runs, the value is reset to a plain "Mcc" and is not useful. @@ -2359,15 +2464,10 @@ mips_type (usrinc.U): Possible values are "BSD 4.3" and "System V". mkdir (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the mkdir program. After Configure runs, the value is reset to a plain "mkdir" and is not useful. -mmaptype (d_mmap.U): - This symbol contains the type of pointer returned by mmap() - (and simultaneously the type of the first argument). - It can be 'void *' or 'caddr_t'. - models (models.U): This variable contains the list of memory models supported by this system. Possible component values are none, split, unsplit, small, @@ -2379,7 +2479,7 @@ modetype (modetype.U): modes for system calls. more (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the more program. After Configure runs, the value is reset to a plain "more" and is not useful. @@ -2441,7 +2541,7 @@ netdb_net_type (netdbtype.U): This is only useful if you have getnetbyaddr(), naturally. nm (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the nm program. After Configure runs, the value is reset to a plain "nm" and is not useful. @@ -2461,10 +2561,16 @@ nonxs_ext (Extensions.U): in the package. All of them will be built. nroff (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the nroff program. After Configure runs, the value is reset to a plain "nroff" and is not useful. +nvsize (perlxv.U): + This variable is the size of an NV in bytes. + +nvtype (perlxv.U): + This variable contains the C type used for Perl's NV. + o_nonblock (nblock_io.U): This variable bears the symbol value to be used during open() or fcntl() to turn on non-blocking I/O for a file descriptor. If you wish to switch @@ -2517,18 +2623,37 @@ passcat (nis.U): This variable contains a command that produces the text of the /etc/passwd file. This is normally "cat /etc/passwd", but can be "ypcat passwd" when NIS is used. + On some systems, such as os390, there may be no equivalent + command, in which case this variable is unset. patchlevel (patchlevel.U): The patchlevel level of this package. The value of patchlevel comes from the patchlevel.h file. + In a version number such as 5.6.1, this is the "6". + In patchlevel.h, this is referred to as the "PERL_VERSION". path_sep (Unix.U): This is an old synonym for p_ in Head.U, the character used to separate elements in the command shell search PATH. perl (Loc.U): - This variable is defined but not used by Configure. - The value is a plain '' and is not useful. + This variable is used internally by Configure to determine the + full pathname (if any) of the perl program. After Configure runs, + the value is reset to a plain "perl" and is not useful. + +PERL_REVISION (Oldsyms.U): + In a Perl version number such as 5.6.2, this is the 5. + This value is manually set in patchlevel.h + +PERL_SUBVERSION (Oldsyms.U): + In a Perl version number such as 5.6.2, this is the 2. + Values greater than 50 represent potentially unstable + development subversions. + This value is manually set in patchlevel.h + +PERL_VERSION (Oldsyms.U): + In a Perl version number such as 5.6.2, this is the 6. + This value is manually set in patchlevel.h perladmin (perladmin.U): Electronic mail address of the perl5 administrator. @@ -2539,7 +2664,7 @@ perlpath (perlpath.U): shell scripts and in the "eval 'exec'" idiom. pg (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the pg program. After Configure runs, the value is reset to a plain "pg" and is not useful. @@ -2595,6 +2720,14 @@ ptrsize (ptrsize.U): This variable contains the value of the PTRSIZE symbol, which indicates to the C program how many bytes there are in a pointer. +quadkind (quadtype.U): + This variable, if defined, encodes the type of a quad: + 1 = int, 2 = long, 3 = long long, 4 = int64_t. + +quadtype (quadtype.U): + This variable defines Quad_t to be something like long, int, + long long, int64_t, or whatever type is used for 64-bit integers. + randbits (randfunc.U): Indicates how many bits are produced by the function used to generate normalized random numbers. @@ -2620,7 +2753,7 @@ rd_nodata (nblock_io.U): no data and an EOF.. Sigh! rm (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the rm program. After Configure runs, the value is reset to a plain "rm" and is not useful. @@ -2649,7 +2782,7 @@ scriptdirexp (scriptdir.U): at configuration time, for programs not wanting to bother with it. sed (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the sed program. After Configure runs, the value is reset to a plain "sed" and is not useful. @@ -2757,16 +2890,41 @@ sitearch (sitearch.U): which is the name of the private library for this package. It may have a ~ on the front. It is up to the makefile to eventually create this directory while performing installation (with ~ substitution). + The standard distribution will put nothing in this directory. + After perl has been installed, users may install their own local + architecture-dependent modules in this directory with + MakeMaker Makefile.PL + or equivalent. See INSTALL for details. sitearchexp (sitearch.U): This variable is the ~name expanded version of sitearch, so that you may use it directly in Makefiles or shell scripts. +sitebin (sitebin.U): + This variable holds the name of the directory in which the user wants + to put add-on publicly executable files for the package in question. It + is most often a local directory such as /usr/local/bin. Programs using + this variable must be prepared to deal with ~name substitution. + The standard distribution will put nothing in this directory. + After perl has been installed, users may install their own local + executables in this directory with + MakeMaker Makefile.PL + or equivalent. See INSTALL for details. + +sitebinexp (sitebin.U): + This is the same as the sitebin variable, but is filename expanded at + configuration time, for use in your makefiles. + sitelib (sitelib.U): This variable contains the eventual value of the SITELIB symbol, which is the name of the private library for this package. It may have a ~ on the front. It is up to the makefile to eventually create this directory while performing installation (with ~ substitution). + The standard distribution will put nothing in this directory. + After perl has been installed, users may install their own local + architecture-independent modules in this directory with + MakeMaker Makefile.PL + or equivalent. See INSTALL for details. sitelibexp (sitelib.U): This variable is the ~name expanded version of sitelib, so that you @@ -2775,6 +2933,7 @@ sitelibexp (sitelib.U): siteprefix (siteprefix.U): This variable holds the full absolute path of the directory below which the user will install add-on packages. + See INSTALL for usage and examples. siteprefixexp (siteprefix.U): This variable holds the full absolute path of the directory below @@ -2809,7 +2968,7 @@ socketlib (d_socket.U): This variable has the names of any libraries needed for socket support. sort (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the sort program. After Configure runs, the value is reset to a plain "sort" and is not useful. @@ -2951,6 +3110,7 @@ submit (Loc.U): subversion (patchlevel.U): The subversion level of this package. The value of subversion comes from the patchlevel.h file. + In a version number such as 5.6.1, this is the "1". This is unique to perl. sysman (sysman.U): @@ -2976,7 +3136,7 @@ tee (Loc.U): The value is a plain '' and is not useful. test (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the test program. After Configure runs, the value is reset to a plain "test" and is not useful. @@ -2989,12 +3149,12 @@ timetype (d_time.U): included). Anyway, the type Time_t should be used. touch (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the touch program. After Configure runs, the value is reset to a plain "touch" and is not useful. tr (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the tr program. After Configure runs, the value is reset to a plain "tr" and is not useful. @@ -3008,30 +3168,79 @@ troff (Loc.U): This variable is defined but not used by Configure. The value is a plain '' and is not useful. +u16size (perlxv.U): + This variable is the size of an U16 in bytes. + +u16type (perlxv.U): + This variable contains the C type used for Perl's U16. + +u32size (perlxv.U): + This variable is the size of an U32 in bytes. + +u32type (perlxv.U): + This variable contains the C type used for Perl's U32. + +u64size (perlxv.U): + This variable is the size of an U64 in bytes. + +u64type (perlxv.U): + This variable contains the C type used for Perl's U64. + +u8size (perlxv.U): + This variable is the size of an U8 in bytes. + +u8type (perlxv.U): + This variable contains the C type used for Perl's U8. + +uidformat (uidf.U): + This variable contains the format string used for printing a Uid_t. + +uidsign (uidsign.U): + This variable contains the signedness of a uidtype. + 1 for unsigned, -1 for signed. + +uidsize (uidsize.U): + This variable contains the size of a uidtype in bytes. + uidtype (uidtype.U): This variable defines Uid_t to be something like uid_t, int, ushort, or whatever type is used to declare user ids in the kernel. uname (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the uname program. After Configure runs, the value is reset to a plain "uname" and is not useful. uniq (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the uniq program. After Configure runs, the value is reset to a plain "uniq" and is not useful. +uquadtype (quadtype.U): + This variable defines Uquad_t to be something like unsigned long, + unsigned int, unsigned long long, uint64_t, or whatever type is + used for 64-bit integers. + +use5005threads (usethreads.U): + This variable conditionally defines the USE_5005THREADS symbol, + and indicates that Perl should be built to use the 5.005-based + threading implementation. + use64bits (use64bits.U): This variable conditionally defines the USE_64_BITS symbol, - and indicates that explicit 64-bit interfaces should be used + and indicates that 64-bit integer types should be used when available. usedl (dlsrc.U): - This variable indicates if the the system supports dynamic + This variable indicates if the system supports dynamic loading of some sort. See also dlsrc and dlobj. -uselfs (uselfs.U): +useithreads (usethreads.U): + This variable conditionally defines the USE_ITHREADS symbol, + and indicates that Perl should be built to use the interpreter-based + threading implementation. + +uselargefiles (uselfs.U): This variable conditionally defines the USE_LARGE_FILES symbol, and indicates that large file interfaces should be used when available. The use64bits symbol will also be turned on if necessary. @@ -3040,6 +3249,10 @@ uselongdouble (uselongdbl.U): This variable conditionally defines the USE_LONG_DOUBLE symbol, and indicates that long doubles should be used when available. +uselonglong (uselonglong.U): + This variable conditionally defines the USE_LONG_LONG symbol, + and indicates that long longs should be used when available. + usemorebits (usemorebits.U): This variable conditionally defines the USE_MORE_BITS symbol, and indicates that explicit 64-bit interfaces and long doubles @@ -3115,13 +3328,45 @@ uuname (Loc.U): This variable is defined but not used by Configure. The value is a plain '' and is not useful. +uvoformat (perlxvf.U): + This variable contains the format string used for printing + a Perl UV as an unsigned octal integer. + +uvsize (perlxv.U): + This variable is the size of a UV in bytes. + +uvtype (perlxv.U): + This variable contains the C type used for Perl's UV. + +uvuformat (perlxvf.U): + This variable contains the format string used for printing + a Perl UV as an unsigned decimal integer. + +uvxformat (perlxvf.U): + This variable contains the format string used for printing + a Perl UV as an unsigned hexadecimal integer. + +vendorbin (vendorbin.U): + This variable contains the eventual value of the VENDORBIN symbol. + It may have a ~ on the front. + The standard distribution will put nothing in this directory. + Vendors who distribute perl may wish to place additional + binaries in this directory with + MakeMaker Makefile.PL INSTALLDIRS=vendor + or equivalent. See INSTALL for details. + +vendorbinexp (vendorbin.U): + This variable is the ~name expanded version of vendorbin, so that you + may use it directly in Makefiles or shell scripts. + vendorlib (vendorlib.U): This variable contains the eventual value of the VENDORLIB symbol, - which is the name of the private library for this package. It may - have a ~ on the front. It is up to the makefile to eventually create - this directory while performing installation (with ~ substitution). - Vendors who distribute perl binaries may place their own - extensions and modules in this directory. + which is the name of the private library for this package. + The standard distribution will put nothing in this directory. + Vendors who distribute perl may wish to place their own + modules in this directory with + MakeMaker Makefile.PL INSTALLDIRS=vendor + or equivalent. See INSTALL for details. vendorlibexp (vendorlib.U): This variable is the ~name expanded version of vendorlib, so that you @@ -3130,17 +3375,18 @@ vendorlibexp (vendorlib.U): vendorprefix (vendorprefix.U): This variable holds the full absolute path of the directory below which the vendor will install add-on packages. + See INSTALL for usage and examples. vendorprefixexp (vendorprefix.U): This variable holds the full absolute path of the directory below which the vendor will install add-on packages. Derived from vendorprefix. version (patchlevel.U): - The full version number of this package. This combines - baserev, patchlevel, and subversion to get the full - version number, including any possible subversions. Care - is taken to use the C locale in order to get something - like 5.004 instead of 5,004. This is unique to perl. + The full version number of this package, such as 5.6.1 (or 5_6_1). + This combines baserev, patchlevel, and subversion to get the + full version number, including any possible subversions. + This is suitable for use as a directory name, and hence is + filesystem dependent. vi (Loc.U): This variable is defined but not used by Configure. @@ -3161,7 +3407,7 @@ zcat (Loc.U): The value is a plain '' and is not useful. zip (Loc.U): - This variable is be used internally by Configure to determine the + This variable is used internally by Configure to determine the full pathname (if any) of the zip program. After Configure runs, the value is reset to a plain "zip" and is not useful. diff --git a/Porting/config.sh b/Porting/config.sh index 5dea400..eebf57f 100644 --- a/Porting/config.sh +++ b/Porting/config.sh @@ -8,7 +8,7 @@ # Package name : perl5 # Source directory : . -# Configuration time: Mon Sep 20 12:44:36 EET DST 1999 +# Configuration time: Sun Jan 16 21:10:53 EET 2000 # Configured by : jhi # Target system : osf1 alpha.hut.fi v4.0 878 alpha @@ -30,12 +30,15 @@ afs='false' alignbytes='8' ansi2knr='' aphostname='' -apiversion='5.00561' +api_revision='5' +api_subversion='640' +api_version='5' +api_versionstring='5.5.640' ar='ar' -archlib='/opt/perl/lib/5.00561/alpha-dec_osf-thread' -archlibexp='/opt/perl/lib/5.00561/alpha-dec_osf-thread' +archlib='/opt/perl/lib/5.5.640/alpha-dec_osf-thread-multi' +archlibexp='/opt/perl/lib/5.5.640/alpha-dec_osf-thread-multi' archname64='' -archname='alpha-dec_osf-thread' +archname='alpha-dec_osf-thread-multi' archobjs='' awk='awk' baserev='5.0' @@ -51,12 +54,13 @@ castflags='0' cat='cat' cc='cc' cccdlflags=' ' -ccdlflags=' -Wl,-rpath,/opt/perl/lib/5.00561/alpha-dec_osf-thread/CORE' +ccdlflags=' -Wl,-rpath,/opt/perl/lib/5.5.640/alpha-dec_osf-thread-multi/CORE' ccflags='-pthread -std -DLANGUAGE_C' ccsymbols='__LANGUAGE_C__=1 _LONGLONG=1 LANGUAGE_C=1 SYSTYPE_BSD=1' cf_by='jhi' cf_email='yourname@yourhost.yourplace.com' -cf_time='Mon Sep 20 12:44:36 EET DST 1999' +cf_time='Sun Jan 16 21:10:53 EET 2000' +charsize='1' chgrp='' chmod='' chown='' @@ -112,7 +116,6 @@ d_chown='define' d_chroot='define' d_chsize='undef' d_closedir='define' -d_cmsghdr_s='define' d_const='define' d_crypt='define' d_csh='define' @@ -148,6 +151,7 @@ d_flock='define' d_fork='define' d_fpathconf='define' d_fpos64_t='undef' +d_fs_data_s='undef' d_fseeko='undef' d_fsetpos='define' d_fstatfs='define' @@ -162,6 +166,7 @@ d_gethent='define' d_gethname='define' d_gethostprotos='define' d_getlogin='define' +d_getmnt='undef' d_getmntent='undef' d_getnbyaddr='define' d_getnbyname='define' @@ -191,19 +196,16 @@ d_htonl='define' d_index='undef' d_inetaton='define' d_int64t='undef' -d_iovec_s='define' d_isascii='define' d_killpg='define' d_lchown='define' d_ldbl_dig='define' d_link='define' -d_llseek='undef' d_locconv='define' d_lockf='define' d_longdbl='define' d_longlong='define' d_lstat='define' -d_madvise='define' d_mblen='define' d_mbstowcs='define' d_mbtowc='define' @@ -215,8 +217,6 @@ d_memset='define' d_mkdir='define' d_mkfifo='define' d_mktime='define' -d_mmap='define' -d_mprotect='define' d_msg='define' d_msg_ctrunc='define' d_msg_dontroute='define' @@ -225,11 +225,8 @@ d_msg_peek='define' d_msg_proxy='undef' d_msgctl='define' d_msgget='define' -d_msghdr_s='define' d_msgrcv='define' d_msgsnd='define' -d_msync='define' -d_munmap='define' d_mymalloc='undef' d_nice='define' d_off64_t='undef' @@ -252,10 +249,9 @@ d_pwexpire='undef' d_pwgecos='define' d_pwpasswd='define' d_pwquota='define' +d_quad='define' d_readdir='define' d_readlink='define' -d_readv='define' -d_recvmsg='define' d_rename='define' d_rewinddir='define' d_rmdir='define' @@ -272,7 +268,6 @@ d_semctl_semid_ds='define' d_semctl_semun='define' d_semget='define' d_semop='define' -d_sendmsg='define' d_setegid='define' d_seteuid='define' d_setgrent='define' @@ -308,9 +303,10 @@ d_sigaction='define' d_sigsetjmp='define' d_socket='define' d_sockpair='define' +d_sqrtl='define' d_statblks='define' -d_statfs='define' -d_statfsflags='define' +d_statfs_f_flags='define' +d_statfs_s='define' d_statvfs='define' d_stdio_cnt_lval='define' d_stdio_ptr_lval='define' @@ -324,8 +320,11 @@ d_strerrm='strerror(e)' d_strerror='define' d_strtod='define' d_strtol='define' +d_strtold='undef' +d_strtoll='undef' d_strtoul='define' d_strtoull='undef' +d_strtouq='undef' d_strxfrm='define' d_suidsafe='undef' d_symlink='define' @@ -345,6 +344,8 @@ d_tzname='define' d_umask='define' d_uname='define' d_union_semun='undef' +d_ustat='define' +d_vendorbin='undef' d_vendorlib='undef' d_vfork='undef' d_void_closedir='undef' @@ -356,7 +357,6 @@ d_wait4='define' d_waitpid='define' d_wcstombs='define' d_wctomb='define' -d_writev='define' d_xenix='undef' date='date' db_hashtype='u_int32_t' @@ -367,7 +367,7 @@ dlext='so' dlsrc='dl_dlopen.xs' doublesize='8' drand01='drand48()' -dynamic_ext='B ByteLoader DB_File Data/Dumper Devel/DProf Devel/Peek Fcntl IO IPC/SysV NDBM_File ODBM_File Opcode POSIX SDBM_File Socket Thread attrs re' +dynamic_ext='B ByteLoader DB_File Data/Dumper Devel/DProf Devel/Peek Fcntl File/Glob IO IPC/SysV NDBM_File ODBM_File Opcode POSIX SDBM_File Socket Thread attrs re' eagain='EAGAIN' ebcdic='undef' echo='echo' @@ -376,18 +376,22 @@ emacs='' eunicefix=':' exe_ext='' expr='expr' -extensions='B ByteLoader DB_File Data/Dumper Devel/DProf Devel/Peek Fcntl IO IPC/SysV NDBM_File ODBM_File Opcode POSIX SDBM_File Socket Thread attrs re Errno' +extensions='B ByteLoader DB_File Data/Dumper Devel/DProf Devel/Peek Fcntl File/Glob IO IPC/SysV NDBM_File ODBM_File Opcode POSIX SDBM_File Socket Thread attrs re Errno' fflushNULL='define' fflushall='undef' find='' firstmakefile='makefile' flex='' +fpossize='8' fpostype='fpos_t' freetype='void' full_ar='/usr/bin/ar' full_csh='/usr/bin/csh' full_sed='/usr/bin/sed' gccversion='' +gidformat='"u"' +gidsign='1' +gidsize='4' gidtype='gid_t' glibpth='/usr/shlib /usr/ccs/lib /usr/lib/cmplrs/cc /usr/lib /usr/local/lib /var/shlib' grep='grep' @@ -399,6 +403,14 @@ h_sysfile='true' hint='recommended' hostcat='cat /etc/hosts' huge='' +i16size='2' +i16type='short' +i32size='4' +i32type='int' +i64size='8' +i64type='long' +i8size='1' +i8type='char' i_arpainet='define' i_bsdioctl='' i_db='define' @@ -441,7 +453,6 @@ i_sysfile='define' i_sysfilio='undef' i_sysin='undef' i_sysioctl='define' -i_sysmman='define' i_sysmount='define' i_sysndir='undef' i_sysparam='define' @@ -450,6 +461,7 @@ i_syssecrt='define' i_sysselct='define' i_syssockio='' i_sysstat='define' +i_sysstatfs='undef' i_sysstatvfs='define' i_systime='define' i_systimek='undef' @@ -457,34 +469,42 @@ i_systimes='define' i_systypes='define' i_sysuio='define' i_sysun='define' +i_sysvfs='undef' i_syswait='define' i_termio='undef' i_termios='define' i_time='undef' i_unistd='define' +i_ustat='define' i_utime='define' i_values='define' i_varargs='undef' i_varhdr='stdarg.h' i_vfork='undef' ignore_versioned_solibs='' +inc_version_list=' ' incpath='' inews='' -installarchlib='/opt/perl/lib/5.00561/alpha-dec_osf-thread' +installarchlib='/opt/perl/lib/5.5.640/alpha-dec_osf-thread-multi' installbin='/opt/perl/bin' installman1dir='/opt/perl/man/man1' installman3dir='/opt/perl/man/man3' installprefix='/opt/perl' installprefixexp='/opt/perl' -installprivlib='/opt/perl/lib/5.00561' +installprivlib='/opt/perl/lib/5.5.640' installscript='/opt/perl/bin' -installsitearch='/opt/perl/lib/site_perl/5.00561/alpha-dec_osf-thread' -installsitelib='/opt/perl/lib/site_perl' +installsitearch='/opt/perl/lib/site_perl/5.5.640/alpha-dec_osf-thread-multi' +installsitebin='/opt/perl/bin' +installsitelib='/opt/perl/lib/site_perl/5.5.640' installstyle='lib' installusrbinperl='define' +installvendorbin='' installvendorlib='' intsize='4' -known_extensions='B ByteLoader DB_File Data/Dumper Devel/DProf Devel/Peek Fcntl GDBM_File IO IPC/SysV NDBM_File ODBM_File Opcode POSIX SDBM_File Socket Thread attrs re' +ivdformat='"ld"' +ivsize='8' +ivtype='long' +known_extensions='B ByteLoader DB_File Data/Dumper Devel/DProf Devel/Peek Fcntl File/Glob GDBM_File IO IPC/SysV NDBM_File ODBM_File Opcode POSIX SDBM_File Socket Thread attrs re' ksh='' large='' ld='ld' @@ -527,10 +547,8 @@ man3dir='/opt/perl/man/man3' man3direxp='/opt/perl/man/man3' man3ext='3' medium='' -mips='' mips_type='' mkdir='mkdir' -mmaptype='void *' models='none' modetype='mode_t' more='more' @@ -550,6 +568,8 @@ nm_opt='-p' nm_so_opt='' nonxs_ext='Errno' nroff='nroff' +nvsize='8' +nvtype='double' o_nonblock='O_NONBLOCK' obj_ext='.o' old_pthread_create_joinable='' @@ -562,7 +582,7 @@ pager='/c/bin/less' passcat='cat /etc/passwd' patchlevel='5' path_sep=':' -perl='' +perl='perl' perladmin='yourname@yourhost.yourplace.com' perlpath='/opt/perl/bin/perl' pg='pg' @@ -573,10 +593,12 @@ pmake='' pr='' prefix='/opt/perl' prefixexp='/opt/perl' -privlib='/opt/perl/lib/5.00561' -privlibexp='/opt/perl/lib/5.00561' +privlib='/opt/perl/lib/5.5.640' +privlibexp='/opt/perl/lib/5.5.640' prototype='define' ptrsize='8' +quadkind='2' +quadtype='long' randbits='48' randfunc='drand48' randseedtype='long' @@ -618,10 +640,12 @@ sig_name_init='"ZERO", "HUP", "INT", "QUIT", "ILL", "TRAP", "ABRT", "EMT", "FPE" sig_num='0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 6 6 16 20 23 23 23 29 48 ' sig_num_init='0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 6, 6, 16, 20, 23, 23, 23, 29, 48, 0' signal_t='void' -sitearch='/opt/perl/lib/site_perl/5.00561/alpha-dec_osf-thread' -sitearchexp='/opt/perl/lib/site_perl/5.00561/alpha-dec_osf-thread' -sitelib='/opt/perl/lib/site_perl' -sitelibexp='/opt/perl/lib/site_perl' +sitearch='/opt/perl/lib/site_perl/5.5.640/alpha-dec_osf-thread-multi' +sitearchexp='/opt/perl/lib/site_perl/5.5.640/alpha-dec_osf-thread-multi' +sitebin='/opt/perl/bin' +sitebinexp='/opt/perl/bin' +sitelib='/opt/perl/lib/site_perl/5.5.640' +sitelibexp='/opt/perl/lib/site_perl/5.5.640' siteprefix='/opt/perl' siteprefixexp='/opt/perl' sizetype='size_t' @@ -649,7 +673,7 @@ stdio_ptr='((fp)->_ptr)' stdio_stream_array='_iob' strings='/usr/include/string.h' submit='' -subversion='61' +subversion='640' sysman='/usr/man/man1' tail='' tar='' @@ -662,15 +686,30 @@ touch='touch' tr='tr' trnl='\n' troff='' +u16size='2' +u16type='unsigned short' +u32size='4' +u32type='unsigned int' +u64size='8' +u64type='unsigned long' +u8size='1' +u8type='unsigned char' +uidformat='"u"' +uidsign='1' +uidsize='4' uidtype='uid_t' uname='uname' uniq='uniq' +uquadtype='unsigned long' +use5005threads='undef' use64bits='define' usedl='define' -uselfs='define' +useithreads='define' +uselargefiles='define' uselongdouble='undef' +uselonglong='undef' usemorebits='undef' -usemultiplicity='undef' +usemultiplicity='define' usemymalloc='n' usenm='true' useopcode='true' @@ -684,11 +723,18 @@ usevendorprefix='undef' usevfork='false' usrinc='/usr/include' uuname='' +uvoformat='"lo"' +uvsize='8' +uvtype='unsigned long' +uvuformat='"lu"' +uvxformat='"lx"' +vendorbin='' +vendorbinexp='' vendorlib='' vendorlibexp='' vendorprefix='' vendorprefixexp='' -version='5.00561' +version='5.5.640' vi='' voidflags='15' xlibpth='/usr/lib/386 /lib/386' @@ -711,7 +757,10 @@ config_arg10='-Dmyhostname=yourhost' config_arg11='-dE' PERL_REVISION=5 PERL_VERSION=5 -PERL_SUBVERSION=61 +PERL_SUBVERSION=640 +PERL_API_REVISION=5 +PERL_API_VERSION=5 +PERL_API_SUBVERSION=640 CONFIGDOTSH=true # Variables propagated from previous config.sh file. pp_sys_cflags='ccflags="$ccflags -DNO_EFF_ONLY_OK"' diff --git a/Porting/config_H b/Porting/config_H index b6468df..94007e9 100644 --- a/Porting/config_H +++ b/Porting/config_H @@ -17,7 +17,7 @@ /* * Package name : perl5 * Source directory : . - * Configuration time: Mon Sep 20 12:44:36 EET DST 1999 + * Configuration time: Sun Jan 16 21:10:53 EET 2000 * Configured by : jhi * Target system : osf1 alpha.hut.fi v4.0 878 alpha */ @@ -362,18 +362,6 @@ */ #define HAS_MKTIME /**/ -/* HAS_MSYNC: - * This symbol, if defined, indicates that the msync system call is - * available to synchronize a mapped file. - */ -#define HAS_MSYNC /**/ - -/* HAS_MUNMAP: - * This symbol, if defined, indicates that the munmap system call is - * available to unmap a region, usually mapped by mmap(). - */ -#define HAS_MUNMAP /**/ - /* HAS_NICE: * This symbol, if defined, indicates that the nice routine is * available. @@ -996,30 +984,6 @@ */ #define STDCHAR unsigned char /**/ -/* HAS_ACCESSX: - * This symbol, if defined, indicates that the accessx routine is - * available to do extended access checks. - */ -/*#define HAS_ACCESSX / **/ - -/* HAS_EACCESS: - * This symbol, if defined, indicates that the eaccess routine is - * available to do extended access checks. - */ -/*#define HAS_EACCESS / **/ - -/* I_SYS_ACCESS: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -#define I_SYS_ACCESS /**/ - -/* I_SYS_SECURITY: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -#define I_SYS_SECURITY /**/ - /* CROSSCOMPILE: * This symbol, if defined, signifies that we our * build process is a cross-compilation. @@ -1051,6 +1015,53 @@ */ /*#define MULTIARCH / **/ +/* HAS_QUAD: + * This symbol, if defined, tells that there's a 64-bit integer type, + * Quad_t, and its unsigned counterpar, Uquad_t. QUADKIND will be one + * of QUAD_IS_INT, QUAD_IS_LONG, QUAD_IS_LONG_LONG, or QUAD_IS_INT64_T. + */ +#define HAS_QUAD /**/ +#ifdef HAS_QUAD +# define Quad_t long /**/ +# define Uquad_t unsigned long /**/ +# define QUADKIND 2 /**/ +# define QUAD_IS_INT 1 +# define QUAD_IS_LONG 2 +# define QUAD_IS_LONG_LONG 3 +# define QUAD_IS_INT64_T 4 +#endif + +/* HAS_ACCESSX: + * This symbol, if defined, indicates that the accessx routine is + * available to do extended access checks. + */ +/*#define HAS_ACCESSX / **/ + +/* HAS_EACCESS: + * This symbol, if defined, indicates that the eaccess routine is + * available to do extended access checks. + */ +/*#define HAS_EACCESS / **/ + +/* I_SYS_ACCESS: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +#define I_SYS_ACCESS /**/ + +/* I_SYS_SECURITY: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +#define I_SYS_SECURITY /**/ + +/* OSNAME: + * This symbol contains the name of the operating system, as determined + * by Configure. You shouldn't rely on it too much; the specific + * feature tests from Configure are generally more reliable. + */ +#define OSNAME "dec_osf" /**/ + /* MEM_ALIGNBYTES: * This symbol contains the number of bytes required to align a * double. Usual values are 2, 4 and 8. The default is eight, @@ -1062,6 +1073,61 @@ #define MEM_ALIGNBYTES 8 #endif +/* ARCHLIB: + * This variable, if defined, holds the name of the directory in + * which the user wants to put architecture-dependent public + * library files for perl5. It is most often a local directory + * such as /usr/local/lib. Programs using this variable must be + * prepared to deal with filename expansion. If ARCHLIB is the + * same as PRIVLIB, it is not defined, since presumably the + * program already searches PRIVLIB. + */ +/* ARCHLIB_EXP: + * This symbol contains the ~name expanded version of ARCHLIB, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. + */ +#define ARCHLIB "/opt/perl/lib/5.5.640/alpha-dec_osf-thread-multi" /**/ +#define ARCHLIB_EXP "/opt/perl/lib/5.5.640/alpha-dec_osf-thread-multi" /**/ + +/* ARCHNAME: + * This symbol holds a string representing the architecture name. + * It may be used to construct an architecture-dependant pathname + * where library files may be held under a private library, for + * instance. + */ +#define ARCHNAME "alpha-dec_osf-thread-multi" /**/ + +/* HAS_ATOLF: + * This symbol, if defined, indicates that the atolf routine is + * available to convert strings into long doubles. + */ +/*#define HAS_ATOLF / **/ + +/* HAS_ATOLL: + * This symbol, if defined, indicates that the atoll routine is + * available to convert strings into long longs. + */ +/*#define HAS_ATOLL / **/ + +/* BIN: + * This symbol holds the path of the bin directory where the package will + * be installed. Program must be prepared to deal with ~name substitution. + */ +/* BIN_EXP: + * This symbol is the filename expanded version of the BIN symbol, for + * programs that do not want to deal with that at run-time. + */ +#define BIN "/opt/perl/bin" /**/ +#define BIN_EXP "/opt/perl/bin" /**/ + +/* PERL_BINCOMPAT_5005: + * This symbol, if defined, indicates that Perl 5.006 should be + * binary-compatible with Perl 5.005. This is impossible for builds + * that use features like threads and multiplicity it is always + * for those versions. + */ +/*#define PERL_BINCOMPAT_5005 / **/ + /* BYTEORDER: * This symbol holds the hexadecimal constant defined in byteorder, * i.e. 0x1234 or 0x4321, etc... @@ -1105,6 +1171,58 @@ #define BYTEORDER 0x12345678 /* large digits for MSB */ #endif /* NeXT */ +/* CAT2: + * This macro catenates 2 tokens together. + */ +/* STRINGIFY: + * This macro surrounds its token with double quotes. + */ +#if 42 == 1 +#define CAT2(a,b)a/**/b +#define STRINGIFY(a)"a" + /* If you can get stringification with catify, tell me how! */ +#endif +#if 42 == 42 +#define CAT2(a,b)a ## b +#define StGiFy(a)# a +#define STRINGIFY(a)StGiFy(a) +#endif +#if 42 != 1 && 42 != 42 +#include "Bletch: How does this C preprocessor catenate tokens?" +#endif + +/* CPPSTDIN: + * This symbol contains the first part of the string which will invoke + * the C preprocessor on the standard input and produce to standard + * output. Typical value of "cc -E" or "/lib/cpp", but it can also + * call a wrapper. See CPPRUN. + */ +/* CPPMINUS: + * This symbol contains the second part of the string which will invoke + * the C preprocessor on the standard input and produce to standard + * output. This symbol will have the value "-" if CPPSTDIN needs a minus + * to specify standard input, otherwise the value is "". + */ +/* CPPRUN: + * This symbol contains the string which will invoke a C preprocessor on + * the standard input and produce to standard output. It needs to end + * with CPPLAST, after all other preprocessor flags have been specified. + * The main difference with CPPSTDIN is that this program will never be a + * pointer to a shell wrapper, i.e. it will be empty if no preprocessor is + * available directly to the user. Note that it may well be different from + * the preprocessor used to compile the C program. + */ +#define CPPSTDIN "cppstdin" +#define CPPMINUS "" +#define CPPRUN "/usr/bin/cpp" + +/* HAS_ACCESS: + * This manifest constant lets the C program know that the access() + * system call is available to check for accessibility using real UID/GID. + * (always present on UNIX.) + */ +#define HAS_ACCESS /**/ + /* CASTI32: * This symbol is defined if the C compiler can cast negative * or large floating point numbers to 32-bit ints. @@ -1132,12 +1250,104 @@ */ /*#define VOID_CLOSEDIR / **/ +/* HAS_CSH: + * This symbol, if defined, indicates that the C-shell exists. + */ +/* CSH: + * This symbol, if defined, contains the full pathname of csh. + */ +#define HAS_CSH /**/ +#ifdef HAS_CSH +#define CSH "/usr/bin/csh" /**/ +#endif + +/* DLSYM_NEEDS_UNDERSCORE: + * This symbol, if defined, indicates that we need to prepend an + * underscore to the symbol name before calling dlsym(). This only + * makes sense if you *have* dlsym, which we will presume is the + * case if you're using dl_dlopen.xs. + */ +/*#define DLSYM_NEEDS_UNDERSCORE / **/ + +/* HAS_DRAND48_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the drand48() function. Otherwise, it is up + * to the program to supply one. A good guess is + * extern double drand48 _((void)); + */ +#define HAS_DRAND48_PROTO /**/ + +/* HAS_ENDGRENT: + * This symbol, if defined, indicates that the getgrent routine is + * available for finalizing sequential access of the group database. + */ +#define HAS_ENDGRENT /**/ + +/* HAS_ENDHOSTENT: + * This symbol, if defined, indicates that the endhostent() routine is + * available to close whatever was being used for host queries. + */ +#define HAS_ENDHOSTENT /**/ + +/* HAS_ENDNETENT: + * This symbol, if defined, indicates that the endnetent() routine is + * available to close whatever was being used for network queries. + */ +#define HAS_ENDNETENT /**/ + +/* HAS_ENDPROTOENT: + * This symbol, if defined, indicates that the endprotoent() routine is + * available to close whatever was being used for protocol queries. + */ +#define HAS_ENDPROTOENT /**/ + +/* HAS_ENDPWENT: + * This symbol, if defined, indicates that the getgrent routine is + * available for finalizing sequential access of the passwd database. + */ +#define HAS_ENDPWENT /**/ + +/* HAS_ENDSERVENT: + * This symbol, if defined, indicates that the endservent() routine is + * available to close whatever was being used for service queries. + */ +#define HAS_ENDSERVENT /**/ + +/* HAS_ENDSPENT: + * This symbol, if defined, indicates that the endspent system call is + * available to finalize the scan of SysV shadow password entries. + */ +/*#define HAS_ENDSPENT / **/ + /* HAS_FD_SET: * This symbol, when defined, indicates presence of the fd_set typedef * in */ #define HAS_FD_SET /**/ +/* HAS_STRUCT_FS_DATA: + * This symbol, if defined, indicates that the struct fs_data + * to do statfs() is supported. + */ +/*#define HAS_STRUCT_FS_DATA / **/ + +/* HAS_FSEEKO: + * This symbol, if defined, indicates that the fseeko routine is + * available to fseek beyond 32 bits (useful for ILP32 hosts). + */ +/*#define HAS_FSEEKO / **/ + +/* HAS_FSTATFS: + * This symbol, if defined, indicates that the fstatfs routine is + * available to stat filesystems by file descriptors. + */ +#define HAS_FSTATFS /**/ +/* HAS_FTELLO: + * This symbol, if defined, indicates that the ftello routine is + * available to ftell beyond 32 bits (useful for ILP32 hosts). + */ +/*#define HAS_FTELLO / **/ + /* Gconvert: * This preprocessor macro is defined to convert a floating point * number to a string without a trailing decimal point. This @@ -1155,456 +1365,6 @@ */ #define Gconvert(x,n,t,b) gcvt((x),(n),(b)) -/* HAS_GNULIBC: - * This symbol, if defined, indicates to the C program that - * the GNU C library is being used. - */ -/*#define HAS_GNULIBC / **/ -/* HAS_ISASCII: - * This manifest constant lets the C program know that isascii - * is available. - */ -#define HAS_ISASCII /**/ - -/* HAS_LCHOWN: - * This symbol, if defined, indicates that the lchown routine is - * available to operate on a symbolic link (instead of following the - * link). - */ -#define HAS_LCHOWN /**/ - -/* HAS_OPEN3: - * This manifest constant lets the C program know that the three - * argument form of open(2) is available. - */ -#define HAS_OPEN3 /**/ - -/* HAS_SAFE_BCOPY: - * This symbol, if defined, indicates that the bcopy routine is available - * to copy potentially overlapping memory blocks. Otherwise you should - * probably use memmove() or memcpy(). If neither is defined, roll your - * own version. - */ -#define HAS_SAFE_BCOPY /**/ - -/* HAS_SAFE_MEMCPY: - * This symbol, if defined, indicates that the memcpy routine is available - * to copy potentially overlapping memory blocks. Otherwise you should - * probably use memmove() or memcpy(). If neither is defined, roll your - * own version. - */ -/*#define HAS_SAFE_MEMCPY / **/ - -/* HAS_SANE_MEMCMP: - * This symbol, if defined, indicates that the memcmp routine is available - * and can be used to compare relative magnitudes of chars with their high - * bits set. If it is not defined, roll your own version. - */ -#define HAS_SANE_MEMCMP /**/ - -/* HAS_SIGACTION: - * This symbol, if defined, indicates that Vr4's sigaction() routine - * is available. - */ -#define HAS_SIGACTION /**/ - -/* HAS_SIGSETJMP: - * This variable indicates to the C program that the sigsetjmp() - * routine is available to save the calling process's registers - * and stack environment for later use by siglongjmp(), and - * to optionally save the process's signal mask. See - * Sigjmp_buf, Sigsetjmp, and Siglongjmp. - */ -/* Sigjmp_buf: - * This is the buffer type to be used with Sigsetjmp and Siglongjmp. - */ -/* Sigsetjmp: - * This macro is used in the same way as sigsetjmp(), but will invoke - * traditional setjmp() if sigsetjmp isn't available. - * See HAS_SIGSETJMP. - */ -/* Siglongjmp: - * This macro is used in the same way as siglongjmp(), but will invoke - * traditional longjmp() if siglongjmp isn't available. - * See HAS_SIGSETJMP. - */ -#define HAS_SIGSETJMP /**/ -#ifdef HAS_SIGSETJMP -#define Sigjmp_buf sigjmp_buf -#define Sigsetjmp(buf,save_mask) sigsetjmp((buf),(save_mask)) -#define Siglongjmp(buf,retval) siglongjmp((buf),(retval)) -#else -#define Sigjmp_buf jmp_buf -#define Sigsetjmp(buf,save_mask) setjmp((buf)) -#define Siglongjmp(buf,retval) longjmp((buf),(retval)) -#endif - -/* USE_STDIO_PTR: - * This symbol is defined if the _ptr and _cnt fields (or similar) - * of the stdio FILE structure can be used to access the stdio buffer - * for a file handle. If this is defined, then the FILE_ptr(fp) - * and FILE_cnt(fp) macros will also be defined and should be used - * to access these fields. - */ -/* FILE_ptr: - * This macro is used to access the _ptr field (or equivalent) of the - * FILE structure pointed to by its argument. This macro will always be - * defined if USE_STDIO_PTR is defined. - */ -/* STDIO_PTR_LVALUE: - * This symbol is defined if the FILE_ptr macro can be used as an - * lvalue. - */ -/* FILE_cnt: - * This macro is used to access the _cnt field (or equivalent) of the - * FILE structure pointed to by its argument. This macro will always be - * defined if USE_STDIO_PTR is defined. - */ -/* STDIO_CNT_LVALUE: - * This symbol is defined if the FILE_cnt macro can be used as an - * lvalue. - */ -#define USE_STDIO_PTR /**/ -#ifdef USE_STDIO_PTR -#define FILE_ptr(fp) ((fp)->_ptr) -#define STDIO_PTR_LVALUE /**/ -#define FILE_cnt(fp) ((fp)->_cnt) -#define STDIO_CNT_LVALUE /**/ -#endif - -/* USE_STDIO_BASE: - * This symbol is defined if the _base field (or similar) of the - * stdio FILE structure can be used to access the stdio buffer for - * a file handle. If this is defined, then the FILE_base(fp) macro - * will also be defined and should be used to access this field. - * Also, the FILE_bufsiz(fp) macro will be defined and should be used - * to determine the number of bytes in the buffer. USE_STDIO_BASE - * will never be defined unless USE_STDIO_PTR is. - */ -/* FILE_base: - * This macro is used to access the _base field (or equivalent) of the - * FILE structure pointed to by its argument. This macro will always be - * defined if USE_STDIO_BASE is defined. - */ -/* FILE_bufsiz: - * This macro is used to determine the number of bytes in the I/O - * buffer pointed to by _base field (or equivalent) of the FILE - * structure pointed to its argument. This macro will always be defined - * if USE_STDIO_BASE is defined. - */ -#define USE_STDIO_BASE /**/ -#ifdef USE_STDIO_BASE -#define FILE_base(fp) ((fp)->_base) -#define FILE_bufsiz(fp) ((fp)->_cnt + (fp)->_ptr - (fp)->_base) -#endif - -/* HAS_VPRINTF: - * This symbol, if defined, indicates that the vprintf routine is available - * to printf with a pointer to an argument list. If unavailable, you - * may need to write your own, probably in terms of _doprnt(). - */ -/* USE_CHAR_VSPRINTF: - * This symbol is defined if this system has vsprintf() returning type - * (char*). The trend seems to be to declare it as "int vsprintf()". It - * is up to the package author to declare vsprintf correctly based on the - * symbol. - */ -#define HAS_VPRINTF /**/ -/*#define USE_CHAR_VSPRINTF / **/ - -/* DOUBLESIZE: - * This symbol contains the size of a double, so that the C preprocessor - * can make decisions based on it. - */ -#define DOUBLESIZE 8 /**/ - -/* I_TIME: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -/* I_SYS_TIME: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -/* I_SYS_TIME_KERNEL: - * This symbol, if defined, indicates to the C program that it should - * include with KERNEL defined. - */ -/*#define I_TIME / **/ -#define I_SYS_TIME /**/ -/*#define I_SYS_TIME_KERNEL / **/ - -/* VAL_O_NONBLOCK: - * This symbol is to be used during open() or fcntl(F_SETFL) to turn on - * non-blocking I/O for the file descriptor. Note that there is no way - * back, i.e. you cannot turn it blocking again this way. If you wish to - * alternatively switch between blocking and non-blocking, use the - * ioctl(FIOSNBIO) call instead, but that is not supported by all devices. - */ -/* VAL_EAGAIN: - * This symbol holds the errno error code set by read() when no data was - * present on the non-blocking file descriptor. - */ -/* RD_NODATA: - * This symbol holds the return code from read() when no data is present - * on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is - * not defined, then you can't distinguish between no data and EOF by - * issuing a read(). You'll have to find another way to tell for sure! - */ -/* EOF_NONBLOCK: - * This symbol, if defined, indicates to the C program that a read() on - * a non-blocking file descriptor will return 0 on EOF, and not the value - * held in RD_NODATA (-1 usually, in that case!). - */ -#define VAL_O_NONBLOCK O_NONBLOCK -#define VAL_EAGAIN EAGAIN -#define RD_NODATA -1 -#define EOF_NONBLOCK - -/* PTRSIZE: - * This symbol contains the size of a pointer, so that the C preprocessor - * can make decisions based on it. It will be sizeof(void *) if - * the compiler supports (void *); otherwise it will be - * sizeof(char *). - */ -#define PTRSIZE 8 /**/ - -/* Drand01: - * This macro is to be used to generate uniformly distributed - * random numbers over the range [0., 1.[. You may have to supply - * an 'extern double drand48();' in your program since SunOS 4.1.3 - * doesn't provide you with anything relevant in it's headers. - * See HAS_DRAND48_PROTO. - */ -/* Rand_seed_t: - * This symbol defines the type of the argument of the - * random seed function. - */ -/* seedDrand01: - * This symbol defines the macro to be used in seeding the - * random number generator (see Drand01). - */ -/* RANDBITS: - * This symbol indicates how many bits are produced by the - * function used to generate normalized random numbers. - * Values include 15, 16, 31, and 48. - */ -#define Drand01() drand48() /**/ -#define Rand_seed_t long /**/ -#define seedDrand01(x) srand48((Rand_seed_t)x) /**/ -#define RANDBITS 48 /**/ - -/* SSize_t: - * This symbol holds the type used by functions that return - * a count of bytes or an error condition. It must be a signed type. - * It is usually ssize_t, but may be long or int, etc. - * It may be necessary to include or - * to get any typedef'ed information. - * We will pick a type such that sizeof(SSize_t) == sizeof(Size_t). - */ -#define SSize_t ssize_t /* signed count of bytes */ - -/* EBCDIC: - * This symbol, if defined, indicates that this system uses - * EBCDIC encoding. - */ -/*#define EBCDIC / **/ - -/* ARCHLIB: - * This variable, if defined, holds the name of the directory in - * which the user wants to put architecture-dependent public - * library files for perl5. It is most often a local directory - * such as /usr/local/lib. Programs using this variable must be - * prepared to deal with filename expansion. If ARCHLIB is the - * same as PRIVLIB, it is not defined, since presumably the - * program already searches PRIVLIB. - */ -/* ARCHLIB_EXP: - * This symbol contains the ~name expanded version of ARCHLIB, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -#define ARCHLIB "/opt/perl/lib/5.00561/alpha-dec_osf-thread" /**/ -#define ARCHLIB_EXP "/opt/perl/lib/5.00561/alpha-dec_osf-thread" /**/ - -/* BIN: - * This symbol holds the path of the bin directory where the package will - * be installed. Program must be prepared to deal with ~name substitution. - */ -/* BIN_EXP: - * This symbol is the filename expanded version of the BIN symbol, for - * programs that do not want to deal with that at run-time. - */ -#define BIN "/opt/perl/bin" /**/ -#define BIN_EXP "/opt/perl/bin" /**/ - -/* INSTALL_USR_BIN_PERL: - * This symbol, if defined, indicates that Perl is to be installed - * also as /usr/bin/perl. - */ -#define INSTALL_USR_BIN_PERL /**/ - -/* PRIVLIB: - * This symbol contains the name of the private library for this package. - * The library is private in the sense that it needn't be in anyone's - * execution path, but it should be accessible by the world. The program - * should be prepared to do ~ expansion. - */ -/* PRIVLIB_EXP: - * This symbol contains the ~name expanded version of PRIVLIB, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -#define PRIVLIB "/opt/perl/lib/5.00561" /**/ -#define PRIVLIB_EXP "/opt/perl/lib/5.00561" /**/ - -/* SITEARCH: - * This symbol contains the name of the private library for this package. - * The library is private in the sense that it needn't be in anyone's - * execution path, but it should be accessible by the world. The program - * should be prepared to do ~ expansion. - * The standard distribution will put nothing in this directory. - * Individual sites may place their own extensions and modules in - * this directory. - */ -/* SITEARCH_EXP: - * This symbol contains the ~name expanded version of SITEARCH, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -#define SITEARCH "/opt/perl/lib/site_perl/5.00561/alpha-dec_osf-thread" /**/ -#define SITEARCH_EXP "/opt/perl/lib/site_perl/5.00561/alpha-dec_osf-thread" /**/ - -/* SITELIB: - * This symbol contains the name of the private library for this package. - * The library is private in the sense that it needn't be in anyone's - * execution path, but it should be accessible by the world. The program - * should be prepared to do ~ expansion. - * The standard distribution will put nothing in this directory. - * Individual sites may place their own extensions and modules in - * this directory. - */ -/* SITELIB_EXP: - * This symbol contains the ~name expanded version of SITELIB, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -#define SITELIB "/opt/perl/lib/site_perl" /**/ -#define SITELIB_EXP "/opt/perl/lib/site_perl" /**/ - -/* PERL_VENDORLIB_EXP: - * This symbol contains the ~name expanded version of VENDORLIB, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -/*#define PERL_VENDORLIB_EXP "" / **/ - -/* OSNAME: - * This symbol contains the name of the operating system, as determined - * by Configure. You shouldn't rely on it too much; the specific - * feature tests from Configure are generally more reliable. - */ -#define OSNAME "dec_osf" /**/ - -/* CAT2: - * This macro catenates 2 tokens together. - */ -/* STRINGIFY: - * This macro surrounds its token with double quotes. - */ -#if 42 == 1 -#define CAT2(a,b)a/**/b -#define STRINGIFY(a)"a" - /* If you can get stringification with catify, tell me how! */ -#endif -#if 42 == 42 -#define CAT2(a,b)a ## b -#define StGiFy(a)# a -#define STRINGIFY(a)StGiFy(a) -#endif -#if 42 != 1 && 42 != 42 -#include "Bletch: How does this C preprocessor catenate tokens?" -#endif - -/* CPPSTDIN: - * This symbol contains the first part of the string which will invoke - * the C preprocessor on the standard input and produce to standard - * output. Typical value of "cc -E" or "/lib/cpp", but it can also - * call a wrapper. See CPPRUN. - */ -/* CPPMINUS: - * This symbol contains the second part of the string which will invoke - * the C preprocessor on the standard input and produce to standard - * output. This symbol will have the value "-" if CPPSTDIN needs a minus - * to specify standard input, otherwise the value is "". - */ -/* CPPRUN: - * This symbol contains the string which will invoke a C preprocessor on - * the standard input and produce to standard output. It needs to end - * with CPPLAST, after all other preprocessor flags have been specified. - * The main difference with CPPSTDIN is that this program will never be a - * pointer to a shell wrapper, i.e. it will be empty if no preprocessor is - * available directly to the user. Note that it may well be different from - * the preprocessor used to compile the C program. - */ -/* CPPLAST: - * This symbol is intended to be used along with CPPRUN in the same manner - * symbol CPPMINUS is used with CPPSTDIN. It contains either "-" or "". - */ -#define CPPSTDIN "cppstdin" -#define CPPMINUS "" -#define CPPRUN "/usr/bin/cpp" -#define CPPLAST "" - -/* HAS_ACCESS: - * This manifest constant lets the C program know that the access() - * system call is available to check for accessibility using real UID/GID. - * (always present on UNIX.) - */ -#define HAS_ACCESS /**/ - -/* HAS_CSH: - * This symbol, if defined, indicates that the C-shell exists. - */ -/* CSH: - * This symbol, if defined, contains the full pathname of csh. - */ -#define HAS_CSH /**/ -#ifdef HAS_CSH -#define CSH "/usr/bin/csh" /**/ -#endif - -/* HAS_ENDGRENT: - * This symbol, if defined, indicates that the getgrent routine is - * available for finalizing sequential access of the group database. - */ -#define HAS_ENDGRENT /**/ - -/* HAS_ENDHOSTENT: - * This symbol, if defined, indicates that the endhostent() routine is - * available to close whatever was being used for host queries. - */ -#define HAS_ENDHOSTENT /**/ - -/* HAS_ENDNETENT: - * This symbol, if defined, indicates that the endnetent() routine is - * available to close whatever was being used for network queries. - */ -#define HAS_ENDNETENT /**/ - -/* HAS_ENDPROTOENT: - * This symbol, if defined, indicates that the endprotoent() routine is - * available to close whatever was being used for protocol queries. - */ -#define HAS_ENDPROTOENT /**/ - -/* HAS_ENDPWENT: - * This symbol, if defined, indicates that the getgrent routine is - * available for finalizing sequential access of the passwd database. - */ -#define HAS_ENDPWENT /**/ - -/* HAS_ENDSERVENT: - * This symbol, if defined, indicates that the endservent() routine is - * available to close whatever was being used for service queries. - */ -#define HAS_ENDSERVENT /**/ - /* HAS_GETGRENT: * This symbol, if defined, indicates that the getgrent routine is * available for sequential access of the group database. @@ -1646,11 +1406,6 @@ * so that it is safe even if used by a process with super-user * privileges. */ -/* HAS_PHOSTNAME: - * This symbol, if defined, indicates that the C program may use the - * contents of PHOSTNAME as a command to feed to the popen() routine - * to derive the host name. - */ #define HAS_GETHOSTNAME /**/ #define HAS_UNAME /**/ #undef HAS_PHOSTNAME @@ -1658,6 +1413,26 @@ #define PHOSTNAME "" /* How to get the host name */ #endif +/* HAS_GETHOST_PROTOS: + * This symbol, if defined, indicates that includes + * prototypes for gethostent(), gethostbyname(), and + * gethostbyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +#define HAS_GETHOST_PROTOS /**/ + +/* HAS_GETMNT: + * This symbol, if defined, indicates that the getmnt routine is + * available to get filesystem mount info by filename. + */ +/*#define HAS_GETMNT / **/ + +/* HAS_GETMNTENT: + * This symbol, if defined, indicates that the getmntent routine is + * available to iterate through mounted file systems to get their info. + */ +/*#define HAS_GETMNTENT / **/ + /* HAS_GETNETBYADDR: * This symbol, if defined, indicates that the getnetbyaddr() routine is * available to look up networks by their IP addresses. @@ -1676,6 +1451,14 @@ */ #define HAS_GETNETENT /**/ +/* HAS_GETNET_PROTOS: + * This symbol, if defined, indicates that includes + * prototypes for getnetent(), getnetbyname(), and + * getnetbyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +#define HAS_GETNET_PROTOS /**/ + /* HAS_GETPROTOENT: * This symbol, if defined, indicates that the getprotoent() routine is * available to look up protocols in some data base or another. @@ -1693,6 +1476,14 @@ #define HAS_GETPROTOBYNAME /**/ #define HAS_GETPROTOBYNUMBER /**/ +/* HAS_GETPROTO_PROTOS: + * This symbol, if defined, indicates that includes + * prototypes for getprotoent(), getprotobyname(), and + * getprotobyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +#define HAS_GETPROTO_PROTOS /**/ + /* HAS_GETPWENT: * This symbol, if defined, indicates that the getpwent routine is * available for sequential access of the passwd database. @@ -1706,6 +1497,26 @@ */ #define HAS_GETSERVENT /**/ +/* HAS_GETSERV_PROTOS: + * This symbol, if defined, indicates that includes + * prototypes for getservent(), getservbyname(), and + * getservbyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +#define HAS_GETSERV_PROTOS /**/ + +/* HAS_GETSPENT: + * This symbol, if defined, indicates that the getspent system call is + * available to retrieve SysV shadow password entries sequentially. + */ +/*#define HAS_GETSPENT / **/ + +/* HAS_GETSPNAM: + * This symbol, if defined, indicates that the getspnam system call is + * available to retrieve SysV shadow password entries by name. + */ +/*#define HAS_GETSPNAM / **/ + /* HAS_GETSERVBYNAME: * This symbol, if defined, indicates that the getservbyname() * routine is available to look up services by their name. @@ -1717,6 +1528,17 @@ #define HAS_GETSERVBYNAME /**/ #define HAS_GETSERVBYPORT /**/ +/* HAS_GNULIBC: + * This symbol, if defined, indicates to the C program that + * the GNU C library is being used. + */ +/*#define HAS_GNULIBC / **/ +/* HAS_HASMNTOPT: + * This symbol, if defined, indicates that the hasmntopt routine is + * available to query the mount options of file systems. + */ +/*#define HAS_HASMNTOPT / **/ + /* HAS_HTONL: * This symbol, if defined, indicates that the htonl() routine (and * friends htons() ntohl() ntohs()) are available to do network @@ -1742,6 +1564,27 @@ #define HAS_NTOHL /**/ #define HAS_NTOHS /**/ +/* HAS_ISASCII: + * This manifest constant lets the C program know that isascii + * is available. + */ +#define HAS_ISASCII /**/ + +/* HAS_LCHOWN: + * This symbol, if defined, indicates that the lchown routine is + * available to operate on a symbolic link (instead of following the + * link). + */ +#define HAS_LCHOWN /**/ + +/* HAS_LDBL_DIG: + * This symbol, if defined, indicates that this system's + * or defines the symbol LDBL_DIG, which is the number + * of significant digits in a long double precision number. Unlike + * for DBL_DIG, there's no good guess for LDBL_DIG if it is undefined. + */ +#define HAS_LDBL_DIG /* */ + /* HAS_LONG_DOUBLE: * This symbol will be defined if the C compiler supports long * doubles. @@ -1773,25 +1616,71 @@ * This symbol, if defined, indicates that the memchr routine is available * to locate characters within a C string. */ -#define HAS_MEMCHR /**/ +#define HAS_MEMCHR /**/ + +/* HAS_MSG: + * This symbol, if defined, indicates that the entire msg*(2) library is + * supported (IPC mechanism based on message queues). + */ +#define HAS_MSG /**/ + +/* HAS_OPEN3: + * This manifest constant lets the C program know that the three + * argument form of open(2) is available. + */ +#define HAS_OPEN3 /**/ + +/* OLD_PTHREAD_CREATE_JOINABLE: + * This symbol, if defined, indicates how to create pthread + * in joinable (aka undetached) state. NOTE: not defined + * if pthread.h already has defined PTHREAD_CREATE_JOINABLE + * (the new version of the constant). + * If defined, known values are PTHREAD_CREATE_UNDETACHED + * and __UNDETACHED. + */ +/*#define OLD_PTHREAD_CREATE_JOINABLE / **/ + +/* HAS_PTHREAD_YIELD: + * This symbol, if defined, indicates that the pthread_yield + * routine is available to yield the execution of the current + * thread. sched_yield is preferable to pthread_yield. + */ +/* SCHED_YIELD: + * This symbol defines the way to yield the execution of + * the current thread. Known ways are sched_yield, + * pthread_yield, and pthread_yield with NULL. + */ +/* HAS_SCHED_YIELD: + * This symbol, if defined, indicates that the sched_yield + * routine is available to yield the execution of the current + * thread. sched_yield is preferable to pthread_yield. + */ +/*#define HAS_PTHREAD_YIELD / **/ +#define SCHED_YIELD sched_yield() /**/ +#define HAS_SCHED_YIELD /**/ -/* HAS_MMAP: - * This symbol, if defined, indicates that the mmap system call is - * available to map a file into memory. +/* HAS_SAFE_BCOPY: + * This symbol, if defined, indicates that the bcopy routine is available + * to copy potentially overlapping memory blocks. Otherwise you should + * probably use memmove() or memcpy(). If neither is defined, roll your + * own version. */ -/* Mmap_t: - * This symbol holds the return type of the mmap() system call - * (and simultaneously the type of the first argument). - * Usually set to 'void *' or 'cadd_t'. +#define HAS_SAFE_BCOPY /**/ + +/* HAS_SAFE_MEMCPY: + * This symbol, if defined, indicates that the memcpy routine is available + * to copy potentially overlapping memory blocks. Otherwise you should + * probably use memmove() or memcpy(). If neither is defined, roll your + * own version. */ -#define HAS_MMAP /**/ -#define Mmap_t void * /**/ +/*#define HAS_SAFE_MEMCPY / **/ -/* HAS_MSG: - * This symbol, if defined, indicates that the entire msg*(2) library is - * supported (IPC mechanism based on message queues). +/* HAS_SANE_MEMCMP: + * This symbol, if defined, indicates that the memcmp routine is available + * and can be used to compare relative magnitudes of chars with their high + * bits set. If it is not defined, roll your own version. */ -#define HAS_MSG /**/ +#define HAS_SANE_MEMCMP /**/ /* HAS_SEM: * This symbol, if defined, indicates that the entire sem*(2) library is @@ -1842,6 +1731,12 @@ */ #define HAS_SETSERVENT /**/ +/* HAS_SETSPENT: + * This symbol, if defined, indicates that the setspent system call is + * available to initialize the scan of SysV shadow password entries. + */ +/*#define HAS_SETSPENT / **/ + /* HAS_SETVBUF: * This symbol, if defined, indicates that the setvbuf routine is * available to change buffering on an open stdio stream. @@ -1849,12 +1744,55 @@ */ #define HAS_SETVBUF /**/ +/* USE_SFIO: + * This symbol, if defined, indicates that sfio should + * be used. + */ +/*#define USE_SFIO / **/ + /* HAS_SHM: * This symbol, if defined, indicates that the entire shm*(2) library is * supported. */ #define HAS_SHM /**/ +/* HAS_SIGACTION: + * This symbol, if defined, indicates that Vr4's sigaction() routine + * is available. + */ +#define HAS_SIGACTION /**/ + +/* HAS_SIGSETJMP: + * This variable indicates to the C program that the sigsetjmp() + * routine is available to save the calling process's registers + * and stack environment for later use by siglongjmp(), and + * to optionally save the process's signal mask. See + * Sigjmp_buf, Sigsetjmp, and Siglongjmp. + */ +/* Sigjmp_buf: + * This is the buffer type to be used with Sigsetjmp and Siglongjmp. + */ +/* Sigsetjmp: + * This macro is used in the same way as sigsetjmp(), but will invoke + * traditional setjmp() if sigsetjmp isn't available. + * See HAS_SIGSETJMP. + */ +/* Siglongjmp: + * This macro is used in the same way as siglongjmp(), but will invoke + * traditional longjmp() if siglongjmp isn't available. + * See HAS_SIGSETJMP. + */ +#define HAS_SIGSETJMP /**/ +#ifdef HAS_SIGSETJMP +#define Sigjmp_buf sigjmp_buf +#define Sigsetjmp(buf,save_mask) sigsetjmp((buf),(save_mask)) +#define Siglongjmp(buf,retval) siglongjmp((buf),(retval)) +#else +#define Sigjmp_buf jmp_buf +#define Sigsetjmp(buf,save_mask) setjmp((buf)) +#define Siglongjmp(buf,retval) longjmp((buf),(retval)) +#endif + /* HAS_SOCKET: * This symbol, if defined, indicates that the BSD socket interface is * supported. @@ -1893,26 +1831,6 @@ * Checking just with #ifdef might not be enough because this symbol * has been known to be an enum. */ -/* HAS_SENDMSG: - * This symbol, if defined, indicates that the sendmsg is supported - * to send messages between sockets. You will also need struct - * iovec from , HAS_STRUCT_IOVEC and I_SYSUIO. - */ -/* HAS_RECVMSG: - * This symbol, if defined, indicates that the recvmsg is supported - * to send messages between sockets. You will also need struct - * iovec from , HAS_STRUCT_IOVEC and I_SYSUIO. - */ -/* HAS_STRUCT_MSGHDR: - * This symbol, if defined, indicates that the struct msghdr - * (BSD 4.3 or 4.4) is supported. You will also need struct - * iovec from , HAS_STRUCT_IOVEC and I_SYSUIO. - */ -/* HAS_STRUCT_CMSGHDR: - * This symbol, if defined, indicates that the struct cmsghdr - * (BSD 4.4) is supported. You will also need struct - * iovec from , HAS_STRUCT_IOVEC and I_SYSUIO. - */ #define HAS_SOCKET /**/ #define HAS_SOCKETPAIR /**/ #define HAS_MSG_CTRUNC /**/ @@ -1921,16 +1839,102 @@ #define HAS_MSG_PEEK /**/ /*#define HAS_MSG_PROXY / **/ #define HAS_SCM_RIGHTS /**/ -#define HAS_SENDMSG /**/ -#define HAS_RECVMSG /**/ -#define HAS_STRUCT_MSGHDR /**/ -#define HAS_STRUCT_CMSGHDR /**/ + +/* HAS_SQRTL: + * This symbol, if defined, indicates that the sqrtl routine is + * available to do long double square roots. + */ +#define HAS_SQRTL /**/ /* USE_STAT_BLOCKS: * This symbol is defined if this system has a stat structure declaring * st_blksize and st_blocks. */ +#ifndef USE_STAT_BLOCKS #define USE_STAT_BLOCKS /**/ +#endif + +/* HAS_STRUCT_STATFS_F_FLAGS: + * This symbol, if defined, indicates that the struct statfs + * does have the f_flags member containing the mount flags of + * the filesystem containing the file. + * This kind of struct statfs is coming from (BSD 4.3), + * not from (SYSV). Older BSDs (like Ultrix) do not + * have statfs() and struct statfs, they have ustat() and getmnt() + * with struct ustat and struct fs_data. + */ +#define HAS_STRUCT_STATFS_F_FLAGS /**/ + +/* HAS_STRUCT_STATFS: + * This symbol, if defined, indicates that the struct statfs + * to do statfs() is supported. + */ +#define HAS_STRUCT_STATFS /**/ + +/* HAS_FSTATVFS: + * This symbol, if defined, indicates that the fstatvfs routine is + * available to stat filesystems by file descriptors. + */ +#define HAS_FSTATVFS /**/ + +/* USE_STDIO_PTR: + * This symbol is defined if the _ptr and _cnt fields (or similar) + * of the stdio FILE structure can be used to access the stdio buffer + * for a file handle. If this is defined, then the FILE_ptr(fp) + * and FILE_cnt(fp) macros will also be defined and should be used + * to access these fields. + */ +/* FILE_ptr: + * This macro is used to access the _ptr field (or equivalent) of the + * FILE structure pointed to by its argument. This macro will always be + * defined if USE_STDIO_PTR is defined. + */ +/* STDIO_PTR_LVALUE: + * This symbol is defined if the FILE_ptr macro can be used as an + * lvalue. + */ +/* FILE_cnt: + * This macro is used to access the _cnt field (or equivalent) of the + * FILE structure pointed to by its argument. This macro will always be + * defined if USE_STDIO_PTR is defined. + */ +/* STDIO_CNT_LVALUE: + * This symbol is defined if the FILE_cnt macro can be used as an + * lvalue. + */ +#define USE_STDIO_PTR /**/ +#ifdef USE_STDIO_PTR +#define FILE_ptr(fp) ((fp)->_ptr) +#define STDIO_PTR_LVALUE /**/ +#define FILE_cnt(fp) ((fp)->_cnt) +#define STDIO_CNT_LVALUE /**/ +#endif + +/* USE_STDIO_BASE: + * This symbol is defined if the _base field (or similar) of the + * stdio FILE structure can be used to access the stdio buffer for + * a file handle. If this is defined, then the FILE_base(fp) macro + * will also be defined and should be used to access this field. + * Also, the FILE_bufsiz(fp) macro will be defined and should be used + * to determine the number of bytes in the buffer. USE_STDIO_BASE + * will never be defined unless USE_STDIO_PTR is. + */ +/* FILE_base: + * This macro is used to access the _base field (or equivalent) of the + * FILE structure pointed to by its argument. This macro will always be + * defined if USE_STDIO_BASE is defined. + */ +/* FILE_bufsiz: + * This macro is used to determine the number of bytes in the I/O + * buffer pointed to by _base field (or equivalent) of the FILE + * structure pointed to its argument. This macro will always be defined + * if USE_STDIO_BASE is defined. + */ +#define USE_STDIO_BASE /**/ +#ifdef USE_STDIO_BASE +#define FILE_base(fp) ((fp)->_base) +#define FILE_bufsiz(fp) ((fp)->_cnt + (fp)->_ptr - (fp)->_base) +#endif /* HAS_STRERROR: * This symbol, if defined, indicates that the strerror routine is @@ -1951,6 +1955,52 @@ #define HAS_SYS_ERRLIST /**/ #define Strerror(e) strerror(e) +/* HAS_STRTOLD: + * This symbol, if defined, indicates that the strtold routine is + * available to convert strings to long doubles. + */ +/*#define HAS_STRTOLD / **/ + +/* HAS_STRTOLL: + * This symbol, if defined, indicates that the strtoll routine is + * available to convert strings to long longs. + */ +/*#define HAS_STRTOLL / **/ + +/* HAS_STRTOULL: + * This symbol, if defined, indicates that the strtoull routine is + * available to convert strings to unsigned long longs. + */ +/*#define HAS_STRTOULL / **/ + +/* HAS_STRTOUQ: + * This symbol, if defined, indicates that the strtouq routine is + * available to convert strings to unsigned long longs (quads). + */ +/*#define HAS_STRTOUQ / **/ + +/* HAS_TELLDIR_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the telldir() function. Otherwise, it is up + * to the program to supply one. A good guess is + * extern long telldir _((DIR*)); + */ +#define HAS_TELLDIR_PROTO /**/ + +/* Time_t: + * This symbol holds the type returned by time(). It can be long, + * or time_t on BSD sites (in which case should be + * included). + */ +#define Time_t time_t /* Time type */ + +/* HAS_TIMES: + * This symbol, if defined, indicates that the times() routine exists. + * Note that this became obsolete on some systems (SUNOS), which now + * use getrusage(). It may be necessary to include . + */ +#define HAS_TIMES /**/ + /* HAS_UNION_SEMUN: * This symbol, if defined, indicates that the union semun is * defined by including . If not, the user code @@ -1973,6 +2023,12 @@ #define USE_SEMCTL_SEMUN /**/ #define USE_SEMCTL_SEMID_DS /**/ +/* HAS_USTAT: + * This symbol, if defined, indicates that the ustat system call is + * available to query file system statistics by dev_t. + */ +#define HAS_USTAT /**/ + /* HAS_VFORK: * This symbol, if defined, indicates that vfork() exists. */ @@ -1986,6 +2042,78 @@ */ #define Signal_t void /* Signal handler's return type */ +/* HAS_VPRINTF: + * This symbol, if defined, indicates that the vprintf routine is available + * to printf with a pointer to an argument list. If unavailable, you + * may need to write your own, probably in terms of _doprnt(). + */ +/* USE_CHAR_VSPRINTF: + * This symbol is defined if this system has vsprintf() returning type + * (char*). The trend seems to be to declare it as "int vsprintf()". It + * is up to the package author to declare vsprintf correctly based on the + * symbol. + */ +#define HAS_VPRINTF /**/ +/*#define USE_CHAR_VSPRINTF / **/ + +/* USE_DYNAMIC_LOADING: + * This symbol, if defined, indicates that dynamic loading of + * some sort is available. + */ +#define USE_DYNAMIC_LOADING /**/ + +/* DOUBLESIZE: + * This symbol contains the size of a double, so that the C preprocessor + * can make decisions based on it. + */ +#define DOUBLESIZE 8 /**/ + +/* EBCDIC: + * This symbol, if defined, indicates that this system uses + * EBCDIC encoding. + */ +/*#define EBCDIC / **/ + +/* FFLUSH_NULL: + * This symbol, if defined, tells that fflush(NULL) does flush + * all pending stdio output. + */ +/* FFLUSH_ALL: + * This symbol, if defined, tells that to flush + * all pending stdio output one must loop through all + * the stdio file handles stored in an array and fflush them. + * Note that if fflushNULL is defined, fflushall will not + * even be probed for and will be left undefined. + */ +#define FFLUSH_NULL /**/ +/*#define FFLUSH_ALL / **/ + +/* Fpos_t: + * This symbol holds the type used to declare file positions in libc. + * It can be fpos_t, long, uint, etc... It may be necessary to include + * to get any typedef'ed information. + */ +#define Fpos_t fpos_t /* File position type */ + +/* Gid_t_f: + * This symbol defines the format string used for printing a Gid_t. + */ +#define Gid_t_f "u" /**/ + +/* Gid_t_size: + * This symbol holds the size of a Gid_t in bytes. + */ +#define Gid_t_size 4 /* GID size */ + +/* Gid_t: + * This symbol holds the return type of getgid() and the type of + * argument to setrgid() and related functions. Typically, + * it is the type of group ids in the kernel. It can be int, ushort, + * uid_t, etc... It may be necessary to include to get + * any typedef'ed information. + */ +#define Gid_t gid_t /* Type for getgid(), etc... */ + /* Groups_t: * This symbol holds the type used for the second argument to * getgroups() and setgropus(). Usually, this is the same as @@ -1999,6 +2127,19 @@ #define Groups_t gid_t /* Type for 2nd arg to [sg]etgroups() */ #endif +/* DB_Prefix_t: + * This symbol contains the type of the prefix structure element + * in the header file. In older versions of DB, it was + * int, while in newer ones it is u_int32_t. + */ +/* DB_Hash_t: + * This symbol contains the type of the prefix structure element + * in the header file. In older versions of DB, it was + * int, while in newer ones it is size_t. + */ +#define DB_Hash_t u_int32_t /**/ +#define DB_Prefix_t size_t /**/ + /* I_GRP: * This symbol, if defined, indicates to the C program that it should * include . @@ -2010,12 +2151,48 @@ #define I_GRP /**/ #define GRPASSWD /**/ +/* I_INTTYPES: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +/*#define I_INTTYPES / **/ + +/* I_MACH_CTHREADS: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +/*#define I_MACH_CTHREADS / **/ + +/* I_MNTENT: + * This symbol, if defined, indicates that exists and + * should be included. + */ +/*#define I_MNTENT / **/ + /* I_NETDB: * This symbol, if defined, indicates that exists and * should be included. */ #define I_NETDB /**/ +/* I_NETINET_TCP: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +#define I_NETINET_TCP /**/ + +/* I_POLL: + * This symbol, if defined, indicates that exists and + * should be included. + */ +#define I_POLL /**/ + +/* I_PTHREAD: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +#define I_PTHREAD /**/ + /* I_PWD: * This symbol, if defined, indicates to the C program that it should * include . @@ -2062,16 +2239,112 @@ #define PWGECOS /**/ #define PWPASSWD /**/ +/* I_SHADOW: + * This symbol, if defined, indicates that exists and + * should be included. + */ +/*#define I_SHADOW / **/ + +/* I_SOCKS: + * This symbol, if defined, indicates that exists and + * should be included. + */ +/*#define I_SOCKS / **/ + +/* I_SYS_MOUNT: + * This symbol, if defined, indicates that exists and + * should be included. + */ +#define I_SYS_MOUNT /**/ + +/* I_SYS_STATFS: + * This symbol, if defined, indicates that exists. + */ +/*#define I_SYS_STATFS / **/ + +/* I_SYS_STATVFS: + * This symbol, if defined, indicates that exists and + * should be included. + */ +#define I_SYS_STATVFS /**/ + /* I_SYSUIO: * This symbol, if defined, indicates that exists and * should be included. */ -/* HAS_STRUCT_IOVEC: - * This symbol, if defined, indicates that the struct iovec - * to do scatter writes/gather reads is supported. - */ #define I_SYSUIO /**/ -#define HAS_STRUCT_IOVEC /**/ + +/* I_SYS_VFS: + * This symbol, if defined, indicates that exists and + * should be included. + */ +/*#define I_SYS_VFS / **/ + +/* I_TIME: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +/* I_SYS_TIME: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +/* I_SYS_TIME_KERNEL: + * This symbol, if defined, indicates to the C program that it should + * include with KERNEL defined. + */ +/*#define I_TIME / **/ +#define I_SYS_TIME /**/ +/*#define I_SYS_TIME_KERNEL / **/ + +/* I_USTAT: + * This symbol, if defined, indicates that exists and + * should be included. + */ +#define I_USTAT /**/ + +/* PERL_INC_VERSION_LIST: + * This variable specifies the list of subdirectories in over + * which perl.c:incpush() and lib/lib.pm will automatically + * search when adding directories to @INC, in a format suitable + * for a C initialization string. See the inc_version_list entry + * in Porting/Glossary for more details. + */ +#define PERL_INC_VERSION_LIST /**/ + +/* HAS_OFF64_T: + * This symbol will be defined if the C compiler supports off64_t. + */ +/* HAS_FPOS64_T: + * This symbol will be defined if the C compiler supports fpos64_t. + */ +/*#define HAS_OFF64_T / **/ +/*#define HAS_FPOS64_T / **/ + +/* PERL_PRIfldbl: + * This symbol, if defined, contains the string used by stdio to + * format long doubles (format 'f') for output. + */ +/* PERL_PRIgldbl: + * This symbol, if defined, contains the string used by stdio to + * format long doubles (format 'g') for output. + */ +#define PERL_PRIfldbl "f" /**/ +#define PERL_PRIgldbl "g" /**/ + +/* Off_t: + * This symbol holds the type used to declare offsets in the kernel. + * It can be int, long, off_t, etc... It may be necessary to include + * to get any typedef'ed information. + */ +/* LSEEKSIZE: + * This symbol holds the number of bytes used by the Off_t. + */ +/* Off_t_size: + * This symbol holds the number of bytes used by the Off_t. + */ +#define Off_t off_t /* type */ +#define LSEEKSIZE 8 /* size */ +#define Off_t_size 8 /* size */ /* Free_t: * This variable contains the return type of free(). It is usually @@ -2088,347 +2361,326 @@ */ /*#define MYMALLOC / **/ -/* SIG_NAME: - * This symbol contains a list of signal names in order of - * signal number. This is intended - * to be used as a static array initialization, like this: - * char *sig_name[] = { SIG_NAME }; - * The signals in the list are separated with commas, and each signal - * is surrounded by double quotes. There is no leading SIG in the signal - * name, i.e. SIGQUIT is known as "QUIT". - * Gaps in the signal numbers (up to NSIG) are filled in with NUMnn, - * etc., where nn is the actual signal number (e.g. NUM37). - * The signal number for sig_name[i] is stored in sig_num[i]. - * The last element is 0 to terminate the list with a NULL. This - * corresponds to the 0 at the end of the sig_num list. - */ -/* SIG_NUM: - * This symbol contains a list of signal numbers, in the same order as the - * SIG_NAME list. It is suitable for static array initialization, as in: - * int sig_num[] = { SIG_NUM }; - * The signals in the list are separated with commas, and the indices - * within that list and the SIG_NAME list match, so it's easy to compute - * the signal name from a number or vice versa at the price of a small - * dynamic linear lookup. - * Duplicates are allowed, but are moved to the end of the list. - * The signal number corresponding to sig_name[i] is sig_number[i]. - * if (i < NSIG) then sig_number[i] == i. - * The last element is 0, corresponding to the 0 at the end of - * the sig_name list. +/* Mode_t: + * This symbol holds the type used to declare file modes + * for systems calls. It is usually mode_t, but may be + * int or unsigned short. It may be necessary to include + * to get any typedef'ed information. */ -#define SIG_NAME "ZERO", "HUP", "INT", "QUIT", "ILL", "TRAP", "ABRT", "EMT", "FPE", "KILL", "BUS", "SEGV", "SYS", "PIPE", "ALRM", "TERM", "IOINT", "STOP", "TSTP", "CONT", "CHLD", "TTIN", "TTOU", "AIO", "XCPU", "XFSZ", "VTALRM", "PROF", "WINCH", "INFO", "USR1", "USR2", "RESV", "RTMIN", "NUM34", "NUM35", "NUM36", "NUM37", "NUM38", "NUM39", "NUM40", "NUM41", "NUM42", "NUM43", "NUM44", "NUM45", "NUM46", "NUM47", "MAX", "IOT", "LOST", "URG", "CLD", "IO", "POLL", "PTY", "PWR", "RTMAX", 0 /**/ -#define SIG_NUM 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 6, 6, 16, 20, 23, 23, 23, 29, 48, 0 /**/ +#define Mode_t mode_t /* file mode parameter for system calls */ -/* VOIDFLAGS: - * This symbol indicates how much support of the void type is given by this - * compiler. What various bits mean: - * - * 1 = supports declaration of void - * 2 = supports arrays of pointers to functions returning void - * 4 = supports comparisons between pointers to void functions and - * addresses of void functions - * 8 = suports declaration of generic void pointers - * - * The package designer should define VOIDUSED to indicate the requirements - * of the package. This can be done either by #defining VOIDUSED before - * including config.h, or by defining defvoidused in Myinit.U. If the - * latter approach is taken, only those flags will be tested. If the - * level of void support necessary is not present, defines void to int. +/* VAL_O_NONBLOCK: + * This symbol is to be used during open() or fcntl(F_SETFL) to turn on + * non-blocking I/O for the file descriptor. Note that there is no way + * back, i.e. you cannot turn it blocking again this way. If you wish to + * alternatively switch between blocking and non-blocking, use the + * ioctl(FIOSNBIO) call instead, but that is not supported by all devices. */ -#ifndef VOIDUSED -#define VOIDUSED 15 -#endif -#define VOIDFLAGS 15 -#if (VOIDFLAGS & VOIDUSED) != VOIDUSED -#define void int /* is void to be avoided? */ -#define M_VOID /* Xenix strikes again */ -#endif - -/* HAS_ATOLF: - * This symbol, if defined, indicates that the atolf routine is - * available to convert strings into long doubles. +/* VAL_EAGAIN: + * This symbol holds the errno error code set by read() when no data was + * present on the non-blocking file descriptor. */ -/*#define HAS_ATOLF / **/ - -/* HAS_ATOLL: - * This symbol, if defined, indicates that the atoll routine is - * available to convert strings into long longs. +/* RD_NODATA: + * This symbol holds the return code from read() when no data is present + * on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is + * not defined, then you can't distinguish between no data and EOF by + * issuing a read(). You'll have to find another way to tell for sure! */ -/*#define HAS_ATOLL / **/ - -/* PERL_BINCOMPAT_5005: - * This symbol, if defined, indicates that Perl 5.006 should be - * binary-compatible with Perl 5.005. This is impossible for builds - * that use features like threads and multiplicity it is always - * for those versions. +/* EOF_NONBLOCK: + * This symbol, if defined, indicates to the C program that a read() on + * a non-blocking file descriptor will return 0 on EOF, and not the value + * held in RD_NODATA (-1 usually, in that case!). */ -/*#define PERL_BINCOMPAT_5005 / **/ +#define VAL_O_NONBLOCK O_NONBLOCK +#define VAL_EAGAIN EAGAIN +#define RD_NODATA -1 +#define EOF_NONBLOCK -/* DLSYM_NEEDS_UNDERSCORE: - * This symbol, if defined, indicates that we need to prepend an - * underscore to the symbol name before calling dlsym(). This only - * makes sense if you *have* dlsym, which we will presume is the - * case if you're using dl_dlopen.xs. +/* Netdb_host_t: + * This symbol holds the type used for the 1st argument + * to gethostbyaddr(). */ -/*#define DLSYM_NEEDS_UNDERSCORE / **/ - -/* HAS_ENDSPENT: - * This symbol, if defined, indicates that the endspent system call is - * available to finalize the scan of SysV shadow password entries. +/* Netdb_hlen_t: + * This symbol holds the type used for the 2nd argument + * to gethostbyaddr(). */ -/*#define HAS_ENDSPENT / **/ - -/* HAS_FSEEKO: - * This symbol, if defined, indicates that the fseeko routine is - * available to fseek beyond 32 bits (useful for ILP32 hosts). +/* Netdb_name_t: + * This symbol holds the type used for the argument to + * gethostbyname(). + */ +/* Netdb_net_t: + * This symbol holds the type used for the 1st argument to + * getnetbyaddr(). */ -/*#define HAS_FSEEKO / **/ +#define Netdb_host_t const char * /**/ +#define Netdb_hlen_t int /**/ +#define Netdb_name_t const char * /**/ +#define Netdb_net_t int /**/ -/* HAS_FTELLO: - * This symbol, if defined, indicates that the ftello routine is - * available to ftell beyond 32 bits (useful for ILP32 hosts). +/* IVTYPE: + * This symbol defines the C type used for Perl's IV. */ -/*#define HAS_FTELLO / **/ - -/* HAS_GETMNTENT: - * This symbol, if defined, indicates that the getmntent routine is - * available to iterate through mounted file systems. +/* UVTYPE: + * This symbol defines the C type used for Perl's UV. */ -/*#define HAS_GETMNTENT / **/ - -/* HAS_GETSPENT: - * This symbol, if defined, indicates that the getspent system call is - * available to retrieve SysV shadow password entries sequentially. +/* I8TYPE: + * This symbol defines the C type used for Perl's I8. */ -/*#define HAS_GETSPENT / **/ - -/* HAS_GETSPNAM: - * This symbol, if defined, indicates that the getspnam system call is - * available to retrieve SysV shadow password entries by name. +/* U8TYPE: + * This symbol defines the C type used for Perl's U8. */ -/*#define HAS_GETSPNAM / **/ - -/* HAS_HASMNTOPT: - * This symbol, if defined, indicates that the hasmntopt routine is - * available to query the mount options of file systems. +/* I16TYPE: + * This symbol defines the C type used for Perl's I16. */ -/*#define HAS_HASMNTOPT / **/ - -/* HAS_LDBL_DIG: - * This symbol, if defined, indicates that this system's - * or defines the symbol LDBL_DIG, which is the number - * of significant digits in a long double precision number. Unlike - * for DBL_DIG, there's no good guess for LDBL_DIG if it is undefined. +/* U16TYPE: + * This symbol defines the C type used for Perl's U16. */ -#define HAS_LDBL_DIG /* */ - -/* HAS_MADVISE: - * This symbol, if defined, indicates that the madvise system call is - * available to map a file into memory. +/* I32TYPE: + * This symbol defines the C type used for Perl's I32. */ -#define HAS_MADVISE /**/ - -/* HAS_MPROTECT: - * This symbol, if defined, indicates that the mprotect system call is - * available to modify the access protection of a memory mapped file. +/* U32TYPE: + * This symbol defines the C type used for Perl's U32. */ -#define HAS_MPROTECT /**/ - -/* HAS_READV: - * This symbol, if defined, indicates that the readv routine is - * available to do gather reads. You will also need - * and there I_SYSUIO. +/* I64TYPE: + * This symbol defines the C type used for Perl's I64. */ -#define HAS_READV /**/ - -/* HAS_SETSPENT: - * This symbol, if defined, indicates that the setspent system call is - * available to initialize the scan of SysV shadow password entries. +/* U64TYPE: + * This symbol defines the C type used for Perl's U64. */ -/*#define HAS_SETSPENT / **/ - -/* USE_SFIO: - * This symbol, if defined, indicates that sfio should - * be used. +/* NVTYPE: + * This symbol defines the C type used for Perl's NV. */ -/*#define USE_SFIO / **/ - -/* HAS_FSTATFS: - * This symbol, if defined, indicates that the fstatfs routine is - * available to stat filesystems of file descriptors. +/* IVSIZE: + * This symbol contains the sizeof(IV). */ -/* HAS_STRUCT_STATFS_FLAGS: - * This symbol, if defined, indicates that the struct statfs - * does have the f_flags member containing the mount flags of - * the filesystem holding the file. - * This kind of struct statfs is coming from sys/mount.h (BSD), - * not from sys/statfs.h (SYSV). +/* UVSIZE: + * This symbol contains the sizeof(UV). */ -#define HAS_FSTATFS /**/ -#define HAS_STRUCT_STATFS_FLAGS /**/ - -/* HAS_FSTATVFS: - * This symbol, if defined, indicates that the fstatvfs routine is - * available to stat filesystems of file descriptors. +/* I8SIZE: + * This symbol contains the sizeof(I8). */ -#define HAS_FSTATVFS /**/ - -/* HAS_TELLDIR_PROTO: - * This symbol, if defined, indicates that the system provides - * a prototype for the telldir() function. Otherwise, it is up - * to the program to supply one. A good guess is - * extern long telldir _((DIR*)); +/* U8SIZE: + * This symbol contains the sizeof(U8). */ -#define HAS_TELLDIR_PROTO /**/ - -/* HAS_WRITEV: - * This symbol, if defined, indicates that the writev routine is - * available to do scatter writes. +/* I16SIZE: + * This symbol contains the sizeof(I16). */ -#define HAS_WRITEV /**/ - -/* USE_DYNAMIC_LOADING: - * This symbol, if defined, indicates that dynamic loading of - * some sort is available. +/* U16SIZE: + * This symbol contains the sizeof(U16). */ -#define USE_DYNAMIC_LOADING /**/ - -/* FFLUSH_NULL: - * This symbol, if defined, tells that fflush(NULL) does flush - * all pending stdio output. +/* I32SIZE: + * This symbol contains the sizeof(I32). */ -/* FFLUSH_ALL: - * This symbol, if defined, tells that to flush - * all pending stdio output one must loop through all - * the stdio file handles stored in an array and fflush them. - * Note that if fflushNULL is defined, fflushall will not - * even be probed for and will be left undefined. +/* U32SIZE: + * This symbol contains the sizeof(U32). */ -#define FFLUSH_NULL /**/ -/*#define FFLUSH_ALL / **/ - -/* DB_Prefix_t: - * This symbol contains the type of the prefix structure element - * in the header file. In older versions of DB, it was - * int, while in newer ones it is u_int32_t. +/* I64SIZE: + * This symbol contains the sizeof(I64). */ -/* DB_Hash_t: - * This symbol contains the type of the prefix structure element - * in the header file. In older versions of DB, it was - * int, while in newer ones it is size_t. +/* U64SIZE: + * This symbol contains the sizeof(U64). */ -#define DB_Hash_t u_int32_t /**/ -#define DB_Prefix_t size_t /**/ +#define IVTYPE long /**/ +#define UVTYPE unsigned long /**/ +#define I8TYPE char /**/ +#define U8TYPE unsigned char /**/ +#define I16TYPE short /**/ +#define U16TYPE unsigned short /**/ +#define I32TYPE int /**/ +#define U32TYPE unsigned int /**/ +#ifdef HAS_QUAD +#define I64TYPE long /**/ +#define U64TYPE unsigned long /**/ +#endif +#define NVTYPE double /**/ +#define IVSIZE 8 /**/ +#define UVSIZE 8 /**/ +#define I8SIZE 1 /**/ +#define U8SIZE 1 /**/ +#define I16SIZE 2 /**/ +#define U16SIZE 2 /**/ +#define I32SIZE 4 /**/ +#define U32SIZE 4 /**/ +#ifdef HAS_QUAD +#define I64SIZE 8 /**/ +#define U64SIZE 8 /**/ +#endif -/* I_INTTYPES: - * This symbol, if defined, indicates to the C program that it should - * include . +/* IVdf: + * This symbol defines the format string used for printing a Perl IV + * as a signed decimal integer. */ -/* HAS_INT64_T: - * This symbol will defined if the C compiler supports int64_t. - * Usually the needs to be included, but sometimes - * is enough. +/* UVuf: + * This symbol defines the format string used for printing a Perl UV + * as an unsigned decimal integer. */ -/*#define I_INTTYPES / **/ -/*#define HAS_INT64_T / **/ - -/* I_MNTENT: - * This symbol, if defined, indicates that exists and - * should be included. +/* UVof: + * This symbol defines the format string used for printing a Perl UV + * as an unsigned octal integer. */ -/*#define I_MNTENT / **/ - -/* I_NETINET_TCP: - * This symbol, if defined, indicates to the C program that it should - * include . +/* UVxf: + * This symbol defines the format string used for printing a Perl UV + * as an unsigned hexadecimal integer. */ -#define I_NETINET_TCP /**/ +#define IVdf "ld" /**/ +#define UVuf "lu" /**/ +#define UVof "lo" /**/ +#define UVxf "lx" /**/ -/* I_POLL: - * This symbol, if defined, indicates that exists and - * should be included. +/* Pid_t: + * This symbol holds the type used to declare process ids in the kernel. + * It can be int, uint, pid_t, etc... It may be necessary to include + * to get any typedef'ed information. */ -#define I_POLL /**/ +#define Pid_t pid_t /* PID type */ -/* I_SHADOW: - * This symbol, if defined, indicates that exists and - * should be included. +/* PRIVLIB: + * This symbol contains the name of the private library for this package. + * The library is private in the sense that it needn't be in anyone's + * execution path, but it should be accessible by the world. The program + * should be prepared to do ~ expansion. */ -/*#define I_SHADOW / **/ +/* PRIVLIB_EXP: + * This symbol contains the ~name expanded version of PRIVLIB, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. + */ +#define PRIVLIB "/opt/perl/lib/5.5.640" /**/ +#define PRIVLIB_EXP "/opt/perl/lib/5.5.640" /**/ -/* I_SOCKS: - * This symbol, if defined, indicates that exists and - * should be included. +/* PTRSIZE: + * This symbol contains the size of a pointer, so that the C preprocessor + * can make decisions based on it. It will be sizeof(void *) if + * the compiler supports (void *); otherwise it will be + * sizeof(char *). */ -/*#define I_SOCKS / **/ +#define PTRSIZE 8 /**/ -/* I_SYS_MMAN: - * This symbol, if defined, indicates that exists and - * should be included. +/* Drand01: + * This macro is to be used to generate uniformly distributed + * random numbers over the range [0., 1.[. You may have to supply + * an 'extern double drand48();' in your program since SunOS 4.1.3 + * doesn't provide you with anything relevant in it's headers. + * See HAS_DRAND48_PROTO. + */ +/* Rand_seed_t: + * This symbol defines the type of the argument of the + * random seed function. + */ +/* seedDrand01: + * This symbol defines the macro to be used in seeding the + * random number generator (see Drand01). + */ +/* RANDBITS: + * This symbol indicates how many bits are produced by the + * function used to generate normalized random numbers. + * Values include 15, 16, 31, and 48. */ -#define I_SYS_MMAN /**/ +#define Drand01() drand48() /**/ +#define Rand_seed_t long /**/ +#define seedDrand01(x) srand48((Rand_seed_t)x) /**/ +#define RANDBITS 48 /**/ -/* I_SYS_MOUNT: - * This symbol, if defined, indicates that exists and - * should be included. +/* SELECT_MIN_BITS: + * This symbol holds the minimum number of bits operated by select. + * That is, if you do select(n, ...), how many bits at least will be + * cleared in the masks if some activity is detected. Usually this + * is either n or 32*ceil(n/32), especially many little-endians do + * the latter. This is only useful if you have select(), naturally. */ -#define I_SYS_MOUNT /**/ +#define SELECT_MIN_BITS 32 /**/ -/* I_SYS_STATVFS: - * This symbol, if defined, indicates that exists and - * should be included. +/* Select_fd_set_t: + * This symbol holds the type used for the 2nd, 3rd, and 4th + * arguments to select. Usually, this is 'fd_set *', if HAS_FD_SET + * is defined, and 'int *' otherwise. This is only useful if you + * have select(), of course. */ -#define I_SYS_STATVFS /**/ +#define Select_fd_set_t fd_set * /**/ -/* HAS_OFF64_T: - * This symbol will be defined if the C compiler supports off64_t. +/* SIG_NAME: + * This symbol contains a list of signal names in order of + * signal number. This is intended + * to be used as a static array initialization, like this: + * char *sig_name[] = { SIG_NAME }; + * The signals in the list are separated with commas, and each signal + * is surrounded by double quotes. There is no leading SIG in the signal + * name, i.e. SIGQUIT is known as "QUIT". + * Gaps in the signal numbers (up to NSIG) are filled in with NUMnn, + * etc., where nn is the actual signal number (e.g. NUM37). + * The signal number for sig_name[i] is stored in sig_num[i]. + * The last element is 0 to terminate the list with a NULL. This + * corresponds to the 0 at the end of the sig_num list. */ -/* HAS_FPOS64_T: - * This symbol will be defined if the C compiler supports fpos64_t. +/* SIG_NUM: + * This symbol contains a list of signal numbers, in the same order as the + * SIG_NAME list. It is suitable for static array initialization, as in: + * int sig_num[] = { SIG_NUM }; + * The signals in the list are separated with commas, and the indices + * within that list and the SIG_NAME list match, so it's easy to compute + * the signal name from a number or vice versa at the price of a small + * dynamic linear lookup. + * Duplicates are allowed, but are moved to the end of the list. + * The signal number corresponding to sig_name[i] is sig_number[i]. + * if (i < NSIG) then sig_number[i] == i. + * The last element is 0, corresponding to the 0 at the end of + * the sig_name list. */ -/*#define HAS_OFF64_T / **/ -/*#define HAS_FPOS64_T / **/ +#define SIG_NAME "ZERO", "HUP", "INT", "QUIT", "ILL", "TRAP", "ABRT", "EMT", "FPE", "KILL", "BUS", "SEGV", "SYS", "PIPE", "ALRM", "TERM", "IOINT", "STOP", "TSTP", "CONT", "CHLD", "TTIN", "TTOU", "AIO", "XCPU", "XFSZ", "VTALRM", "PROF", "WINCH", "INFO", "USR1", "USR2", "RESV", "RTMIN", "NUM34", "NUM35", "NUM36", "NUM37", "NUM38", "NUM39", "NUM40", "NUM41", "NUM42", "NUM43", "NUM44", "NUM45", "NUM46", "NUM47", "MAX", "IOT", "LOST", "URG", "CLD", "IO", "POLL", "PTY", "PWR", "RTMAX", 0 /**/ +#define SIG_NUM 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 6, 6, 16, 20, 23, 23, 23, 29, 48, 0 /**/ -/* PERL_PRIfldbl: - * This symbol, if defined, contains the string used by stdio to - * format long doubles (format 'f') for output. +/* SITEARCH: + * This symbol contains the name of the private library for this package. + * The library is private in the sense that it needn't be in anyone's + * execution path, but it should be accessible by the world. The program + * should be prepared to do ~ expansion. + * The standard distribution will put nothing in this directory. + * After perl has been installed, users may install their own local + * architecture-dependent modules in this directory with + * MakeMaker Makefile.PL + * or equivalent. See INSTALL for details. */ -/* PERL_PRIgldbl: - * This symbol, if defined, contains the string used by stdio to - * format long doubles (format 'g') for output. +/* SITEARCH_EXP: + * This symbol contains the ~name expanded version of SITEARCH, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define PERL_PRIfldbl "f" /**/ -#define PERL_PRIgldbl "g" /**/ +#define SITEARCH "/opt/perl/lib/site_perl/5.5.640/alpha-dec_osf-thread-multi" /**/ +#define SITEARCH_EXP "/opt/perl/lib/site_perl/5.5.640/alpha-dec_osf-thread-multi" /**/ -/* PERL_PRId64: - * This symbol, if defined, contains the string used by stdio to - * format 64-bit decimal numbers (format 'd') for output. - */ -/* PERL_PRIu64: - * This symbol, if defined, contains the string used by stdio to - * format 64-bit unsigned decimal numbers (format 'u') for output. +/* SITELIB: + * This symbol contains the name of the private library for this package. + * The library is private in the sense that it needn't be in anyone's + * execution path, but it should be accessible by the world. The program + * should be prepared to do ~ expansion. + * The standard distribution will put nothing in this directory. + * After perl has been installed, users may install their own local + * architecture-independent modules in this directory with + * MakeMaker Makefile.PL + * or equivalent. See INSTALL for details. */ -/* PERL_PRIo64: - * This symbol, if defined, contains the string used by stdio to - * format 64-bit octal numbers (format 'o') for output. +/* SITELIB_EXP: + * This symbol contains the ~name expanded version of SITELIB, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. */ -/* PERL_PRIx64: - * This symbol, if defined, contains the string used by stdio to - * format 64-bit hexadecimal numbers (format 'x') for output. +#define SITELIB "/opt/perl/lib/site_perl/5.5.640" /**/ +#define SITELIB_EXP "/opt/perl/lib/site_perl/5.5.640" /**/ + +/* Size_t: + * This symbol holds the type used to declare length parameters + * for string functions. It is usually size_t, but may be + * unsigned long, int, etc. It may be necessary to include + * to get any typedef'ed information. */ -#define PERL_PRId64 "ld" /**/ -#define PERL_PRIu64 "lu" /**/ -#define PERL_PRIo64 "lo" /**/ -#define PERL_PRIx64 "lx" /**/ +#define Size_t size_t /* length paramater for string functions */ -/* SELECT_MIN_BITS: - * This symbol holds the minimum number of bits operated by select. - * That is, if you do select(n, ...), how many bits at least will be - * cleared in the masks if some activity is detected. Usually this - * is either n or 32*ceil(n/32), especially many little-endians do - * the latter. This is only useful if you have select(), naturally. +/* SSize_t: + * This symbol holds the type used by functions that return + * a count of bytes or an error condition. It must be a signed type. + * It is usually ssize_t, but may be long or int, etc. + * It may be necessary to include or + * to get any typedef'ed information. + * We will pick a type such that sizeof(SSize_t) == sizeof(Size_t). */ -#define SELECT_MIN_BITS 32 /**/ +#define SSize_t ssize_t /* signed count of bytes */ /* STARTPERL: * This variable contains the string to put in front of a perl @@ -2448,249 +2700,134 @@ #define HAS_STDIO_STREAM_ARRAY /**/ #define STDIO_STREAM_ARRAY _iob -/* HAS_STRTOULL: - * This symbol, if defined, indicates that the strtoull routine is - * available to convert strings into unsigned long longs. +/* Uid_t_f: + * This symbol defines the format string used for printing a Uid_t. */ -/*#define HAS_STRTOULL / **/ +#define Uid_t_f "u" /**/ + +/* Uid_t_size: + * This symbol holds the size of a Uid_t in bytes. + */ +#define Uid_t_size 4 /* UID size */ + +/* Uid_t: + * This symbol holds the type used to declare user ids in the kernel. + * It can be int, ushort, uid_t, etc... It may be necessary to include + * to get any typedef'ed information. + */ +#define Uid_t uid_t /* UID type */ /* USE_64_BITS: - * This symbol, if defined, indicates that 64-bit interfaces should - * be used when available. If not defined, the native default interfaces + * This symbol, if defined, indicates that 64-bit integers should + * be used when available. If not defined, the native integers * will be used (be they 32 or 64 bits). */ +#ifndef USE_64_BITS #define USE_64_BITS /**/ +#endif /* USE_LARGE_FILES: * This symbol, if defined, indicates that large file support * should be used when available. The USE_64_BITS symbol will * also be turned on if necessary. */ +#ifndef USE_LARGE_FILES #define USE_LARGE_FILES /**/ +#endif /* USE_LONG_DOUBLE: * This symbol, if defined, indicates that long doubles should * be used when available. */ +#ifndef USE_LONG_DOUBLE /*#define USE_LONG_DOUBLE / **/ +#endif + +/* USE_LONG_LONG: + * This symbol, if defined, indicates that long longs should + * be used when available. + */ +#ifndef USE_LONG_LONG +/*#define USE_LONG_LONG / **/ +#endif + +#ifndef USE_MORE_BITS +/*#define USE_MORE_BITS / **/ +#endif /* MULTIPLICITY: * This symbol, if defined, indicates that Perl should * be built to use multiplicity. */ -/*#define MULTIPLICITY / **/ +#ifndef MULTIPLICTY +#define MULTIPLICITY /**/ +#endif /* USE_PERLIO: * This symbol, if defined, indicates that the PerlIO abstraction should * be used throughout. If not defined, stdio should be * used in a fully backward compatible manner. */ +#ifndef USE_PERLIO /*#define USE_PERLIO / **/ +#endif /* USE_SOCKS: * This symbol, if defined, indicates that Perl should * be built to use socks. */ +#ifndef USE_SOCKS /*#define USE_SOCKS / **/ +#endif -/* HAS_DRAND48_PROTO: - * This symbol, if defined, indicates that the system provides - * a prototype for the drand48() function. Otherwise, it is up - * to the program to supply one. A good guess is - * extern double drand48 _((void)); - */ -#define HAS_DRAND48_PROTO /**/ - -/* HAS_GETHOST_PROTOS: - * This symbol, if defined, indicates that includes - * prototypes for gethostent(), gethostbyname(), and - * gethostbyaddr(). Otherwise, it is up to the program to guess - * them. See netdbtype.U for probing for various Netdb_xxx_t types. - */ -#define HAS_GETHOST_PROTOS /**/ - -/* HAS_GETNET_PROTOS: - * This symbol, if defined, indicates that includes - * prototypes for getnetent(), getnetbyname(), and - * getnetbyaddr(). Otherwise, it is up to the program to guess - * them. See netdbtype.U for probing for various Netdb_xxx_t types. - */ -#define HAS_GETNET_PROTOS /**/ - -/* HAS_GETPROTO_PROTOS: - * This symbol, if defined, indicates that includes - * prototypes for getprotoent(), getprotobyname(), and - * getprotobyaddr(). Otherwise, it is up to the program to guess - * them. See netdbtype.U for probing for various Netdb_xxx_t types. - */ -#define HAS_GETPROTO_PROTOS /**/ - -/* HAS_GETSERV_PROTOS: - * This symbol, if defined, indicates that includes - * prototypes for getservent(), getservbyname(), and - * getservbyaddr(). Otherwise, it is up to the program to guess - * them. See netdbtype.U for probing for various Netdb_xxx_t types. - */ -#define HAS_GETSERV_PROTOS /**/ - -/* Netdb_host_t: - * This symbol holds the type used for the 1st argument - * to gethostbyaddr(). - */ -/* Netdb_hlen_t: - * This symbol holds the type used for the 2nd argument - * to gethostbyaddr(). - */ -/* Netdb_name_t: - * This symbol holds the type used for the argument to - * gethostbyname(). - */ -/* Netdb_net_t: - * This symbol holds the type used for the 1st argument to - * getnetbyaddr(). - */ -#define Netdb_host_t const char * /**/ -#define Netdb_hlen_t int /**/ -#define Netdb_name_t const char * /**/ -#define Netdb_net_t int /**/ - -/* Select_fd_set_t: - * This symbol holds the type used for the 2nd, 3rd, and 4th - * arguments to select. Usually, this is 'fd_set *', if HAS_FD_SET - * is defined, and 'int *' otherwise. This is only useful if you - * have select(), of course. - */ -#define Select_fd_set_t fd_set * /**/ - -/* ARCHNAME: - * This symbol holds a string representing the architecture name. - * It may be used to construct an architecture-dependant pathname - * where library files may be held under a private library, for - * instance. - */ -#define ARCHNAME "alpha-dec_osf-thread" /**/ - -/* OLD_PTHREAD_CREATE_JOINABLE: - * This symbol, if defined, indicates how to create pthread - * in joinable (aka undetached) state. NOTE: not defined - * if pthread.h already has defined PTHREAD_CREATE_JOINABLE - * (the new version of the constant). - * If defined, known values are PTHREAD_CREATE_UNDETACHED - * and __UNDETACHED. - */ -/*#define OLD_PTHREAD_CREATE_JOINABLE / **/ - -/* HAS_PTHREAD_YIELD: - * This symbol, if defined, indicates that the pthread_yield - * routine is available to yield the execution of the current - * thread. sched_yield is preferable to pthread_yield. - */ -/* SCHED_YIELD: - * This symbol defines the way to yield the execution of - * the current thread. Known ways are sched_yield, - * pthread_yield, and pthread_yield with NULL. - */ -/* HAS_SCHED_YIELD: - * This symbol, if defined, indicates that the sched_yield - * routine is available to yield the execution of the current - * thread. sched_yield is preferable to pthread_yield. - */ -/*#define HAS_PTHREAD_YIELD / **/ -#define SCHED_YIELD sched_yield() /**/ -#define HAS_SCHED_YIELD /**/ - -/* I_MACH_CTHREADS: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -/*#define I_MACH_CTHREADS / **/ - -/* I_PTHREAD: - * This symbol, if defined, indicates to the C program that it should - * include . +/* USE_ITHREADS: + * This symbol, if defined, indicates that Perl should be built to + * use the interpreter-based threading implementation. */ -#define I_PTHREAD /**/ - -/* USE_THREADS: - * This symbol, if defined, indicates that Perl should - * be built to use threads. +/* USE_5005THREADS: + * This symbol, if defined, indicates that Perl should be built to + * use the 5.005-based threading implementation. */ /* OLD_PTHREADS_API: * This symbol, if defined, indicates that Perl should * be built to use the old draft POSIX threads API. */ -#define USE_THREADS /**/ +/*#define USE_5005THREADS / **/ +#define USE_ITHREADS /**/ +#if defined(USE_5005THREADS) && !defined(USE_ITHREADS) +#define USE_THREADS /* until src is revised*/ +#endif /*#define OLD_PTHREADS_API / **/ -/* Time_t: - * This symbol holds the type returned by time(). It can be long, - * or time_t on BSD sites (in which case should be - * included). - */ -#define Time_t time_t /* Time type */ - -/* HAS_TIMES: - * This symbol, if defined, indicates that the times() routine exists. - * Note that this became obsolete on some systems (SUNOS), which now - * use getrusage(). It may be necessary to include . - */ -#define HAS_TIMES /**/ - -/* Fpos_t: - * This symbol holds the type used to declare file positions in libc. - * It can be fpos_t, long, uint, etc... It may be necessary to include - * to get any typedef'ed information. - */ -#define Fpos_t fpos_t /* File position type */ - -/* Gid_t: - * This symbol holds the return type of getgid() and the type of - * argument to setrgid() and related functions. Typically, - * it is the type of group ids in the kernel. It can be int, ushort, - * uid_t, etc... It may be necessary to include to get - * any typedef'ed information. - */ -#define Gid_t gid_t /* Type for getgid(), etc... */ - -/* Off_t: - * This symbol holds the type used to declare offsets in the kernel. - * It can be int, long, off_t, etc... It may be necessary to include - * to get any typedef'ed information. - */ -/* LSEEKSIZE: - * This symbol holds the number of bytes used by the Off_t. - */ -#define Off_t off_t /* type */ -#define LSEEKSIZE 8 /* size */ - -/* Mode_t: - * This symbol holds the type used to declare file modes - * for systems calls. It is usually mode_t, but may be - * int or unsigned short. It may be necessary to include - * to get any typedef'ed information. - */ -#define Mode_t mode_t /* file mode parameter for system calls */ - -/* Pid_t: - * This symbol holds the type used to declare process ids in the kernel. - * It can be int, uint, pid_t, etc... It may be necessary to include - * to get any typedef'ed information. - */ -#define Pid_t pid_t /* PID type */ - -/* Size_t: - * This symbol holds the type used to declare length parameters - * for string functions. It is usually size_t, but may be - * unsigned long, int, etc. It may be necessary to include - * to get any typedef'ed information. +/* PERL_VENDORLIB_EXP: + * This symbol contains the ~name expanded version of VENDORLIB, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define Size_t size_t /* length paramater for string functions */ +/*#define PERL_VENDORLIB_EXP "" / **/ -/* Uid_t: - * This symbol holds the type used to declare user ids in the kernel. - * It can be int, ushort, uid_t, etc... It may be necessary to include - * to get any typedef'ed information. +/* VOIDFLAGS: + * This symbol indicates how much support of the void type is given by this + * compiler. What various bits mean: + * + * 1 = supports declaration of void + * 2 = supports arrays of pointers to functions returning void + * 4 = supports comparisons between pointers to void functions and + * addresses of void functions + * 8 = suports declaration of generic void pointers + * + * The package designer should define VOIDUSED to indicate the requirements + * of the package. This can be done either by #defining VOIDUSED before + * including config.h, or by defining defvoidused in Myinit.U. If the + * latter approach is taken, only those flags will be tested. If the + * level of void support necessary is not present, defines void to int. */ -#define Uid_t uid_t /* UID type */ +#ifndef VOIDUSED +#define VOIDUSED 15 +#endif +#define VOIDFLAGS 15 +#if (VOIDFLAGS & VOIDUSED) != VOIDUSED +#define void int /* is void to be avoided? */ +#define M_VOID /* Xenix strikes again */ +#endif #endif diff --git a/Porting/findvars b/Porting/findvars index 2e81244..3cdb854 100755 --- a/Porting/findvars +++ b/Porting/findvars @@ -11,15 +11,17 @@ chop $pat if $pat =~ /\|$/; # grep while (<>) { - if (/^(.*?)\b($pat)\b(.*)$/o) { - my $head = "$1#$2#"; - $_ = $3; - while (/^(.*?)\b($pat)\b(.*)$/o) { - $head .= "$1#$2#"; - $_ = $3; - } - print "$ARGV\:$.\:$head$_\n"; - } + print "$ARGV\:$.\:$_" if s/\b($pat)\b/#$1#/og; +# this variant might useful if the transformation is more complicated +# if (/^(.*?)\b($pat)\b(.*)$/o) { +# my $head = "$1#$2#"; +# $_ = $3; +# while (/^(.*?)\b($pat)\b(.*)$/o) { +# $head .= "$1#$2#"; +# $_ = $3; +# } +# print "$ARGV\:$.\:$head$_\n"; +# } } continue { close ARGV if eof; @@ -238,7 +240,6 @@ osname pad_reset_pending padix padix_floor -parsehook patchlevel patleave pending_ident diff --git a/Porting/genlog b/Porting/genlog index b8bd1d6..efb7ef8 100755 --- a/Porting/genlog +++ b/Porting/genlog @@ -12,7 +12,7 @@ # # Outputs the changelist to stdout. # -# Gurusamy Sarathy +# Gurusamy Sarathy # use Text::Wrap; diff --git a/Porting/makerel b/Porting/makerel index 8db209a..f51b4a5 100644 --- a/Porting/makerel +++ b/Porting/makerel @@ -114,13 +114,13 @@ my @writables = qw( ext/ByteLoader/byterun.h global.sym keywords.h - lib/warning.pm + lib/warnings.pm objXSUB.h opcode.h pp.sym pp_proto.h regnodes.h - warning.h + warnings.h win32/config_H.bc win32/config_H.gc win32/config_H.vc diff --git a/Porting/p4d2p b/Porting/p4d2p index 67780a9..f645ef8 100755 --- a/Porting/p4d2p +++ b/Porting/p4d2p @@ -4,7 +4,7 @@ # reads a perforce style diff on stdin and outputs appropriate headers # so the diff can be applied with the patch program # -# Gurusamy Sarathy +# Gurusamy Sarathy # BEGIN { diff --git a/Porting/p4desc b/Porting/p4desc index 7bac3eb..b6b412d 100755 --- a/Porting/p4desc +++ b/Porting/p4desc @@ -3,7 +3,7 @@ # # Munge "p4 describe ..." output to include new files. # -# Gurusamy Sarathy +# Gurusamy Sarathy # use vars qw($thisfile $change $file $fnum $h $v $p4port @addfiles); diff --git a/Porting/patchls b/Porting/patchls index 2e4a0ac..4329f4c 100644 --- a/Porting/patchls +++ b/Porting/patchls @@ -17,7 +17,7 @@ use Text::Tabs qw(expand unexpand); use strict; use vars qw($VERSION); -$VERSION = 2.10; +$VERSION = 2.11; sub usage { die qq{ @@ -35,6 +35,7 @@ die qq{ (F has \$ appended unless it contains a /). -e Expect patched files to Exist (relative to current directory) Will print warnings for files which don't. Also affects -4 option. + - Read patch from STDIN other options for special uses: -I just gather and display summary Information about the patches. -4 write to stdout the PerForce commands to prepare for patching. @@ -159,7 +160,9 @@ foreach my $argv (@ARGV) { warn "Ignored directory $in\n"; next; } - unless (open F, "<$in") { + if ($in eq "-") { + *F = \*STDIN; + } elsif (not open F, "<$in") { warn "Unable to open $in: $!\n"; next; } diff --git a/Porting/pumpkin.pod b/Porting/pumpkin.pod index 8736a70..8e83d74 100644 --- a/Porting/pumpkin.pod +++ b/Porting/pumpkin.pod @@ -95,7 +95,7 @@ directories. =head2 Maintenance and Development Subversions -Starting with version 5.004, subversions _01 through _49 is reserved +Starting with version 5.004, subversions _01 through _49 are reserved for bug-fix maintenance releases, and subversions _50 through _99 for unstable development versions. @@ -236,7 +236,7 @@ emulations, function stubs, build utility wrappers) you may create a separate subdirectory (djgpp, win32) and put the files in there. Remember to update C when you add files. -If your system support dynamic loading but none of the existing +If your system supports dynamic loading but none of the existing methods at F work for you, you must write a new one. Study the existing ones to see what kind of interface you must supply. @@ -1123,33 +1123,6 @@ may find metaconfig's units clumsy to work with. =back -=head2 @INC search order - -By default, the list of perl library directories in @INC is the -following: - - $archlib - $privlib - $sitearch - $sitelib - -Specifically, on my Solaris/x86 system, I run -B and I have the following -directories: - - /opt/perl/lib/i86pc-solaris/5.00307 - /opt/perl/lib - /opt/perl/lib/site_perl/i86pc-solaris - /opt/perl/lib/site_perl - -That is, perl's directories come first, followed by the site-specific -directories. - -The site libraries come second to support the usage of extensions -across perl versions. Read the relevant section in F for -more information. If we ever make $sitearch version-specific, this -topic could be revisited. - =head2 Why isn't there a directory to override Perl's library? Mainly because no one's gotten around to making one. Note that @@ -1273,18 +1246,6 @@ what I came up with off the top of my head. =over 4 -=item installprefix - -I think we ought to support - - Configure -Dinstallprefix=/blah/blah - -Currently, we support B<-Dprefix=/blah/blah>, but the changing the install -location has to be handled by something like the F trick -described in F. AFS users also are treated specially. -We should probably duplicate the metaconfig prefix stuff for an -install prefix. - =item Configure -Dsrc=/blah/blah We should be able to emulate B. Tom Tromey @@ -1293,34 +1254,6 @@ the dist-users mailing list along these lines. They have been folded back into the main distribution, but various parts of the perl Configure/build/install process still assume src='.'. -=item Directory for vendor-supplied modules? - -If a vendor supplies perl, but wants to leave $siteperl and $sitearch -for the local user to use, where should the vendor put vendor-supplied -modules (such as Tk.so)? If the vendor puts them in the default $archlib, -then they need to be updated each time the perl version is updated. -Perhaps we need a set of libries $vendorlib and $vendorarch that -track $apiversion (like the $sitexxx directories do) rather than just -$version (like the main perl directory). - -An alternative (and perhaps even better) plan might be for the vendor -to select non-default $privlib and $archlib directories, perhaps using -$apiversion instead of $version (or even just /usr/lib/perl5 with no -version stuff at all), and put modules into those directories (with perl -Makefile.PL INSTALLDIRS=perl). This would be fine unless the vendor -wanted to support different versions of perl installed at the same time. -(How many vendors *really* want to do that?) - -=item Separate directories for Perl-supplied and add-on man pages - -Man pages supplied with the perl distribution proper ought to go in -an appropriate man directory. Perhaps man pages supplied with add-on -modules ought to (at least optionally) go into a $siteman[1-9] directory. -For example, suppose that $privlib is /usr/lib/perl5 and $man1dir -is /usr/man/man1. Also, suppose $sitelib is /usr/local/lib/perl5. -In this situation, it might make sense for man pages to go into -/usr/local/lib/man/man1. - =item Hint file fixes Various hint files work around Configure problems. We ought to fix @@ -1331,47 +1264,6 @@ Configure so that most of them aren't needed. Some of the hint file information (particularly dynamic loading stuff) ought to be fed back into the main metaconfig distribution. -=item Catch GNU Libc "Stub" functions - -Some functions (such as lchown()) are present in libc, but are -unimplmented. That is, they always fail and set errno=ENOSYS. - -Thomas Bushnell provided the following sample code and the explanation -that follows: - - /* System header to define __stub macros and hopefully few prototypes, - which can conflict with char FOO(); below. */ - #include - /* Override any gcc2 internal prototype to avoid an error. */ - /* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ - char FOO(); - - int main() { - - /* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ - #if defined (__stub_FOO) || defined (__stub___FOO) - choke me - #else - FOO(); - #endif - - ; return 0; } - -The choice of is essentially arbitrary. The GNU libc -macros are found in . You can include that file instead -of (which itself includes ) if you test for -its existence first. is assumed to exist on every system, -which is why it's used here. Any GNU libc header file will include -the stubs macros. If either __stub_NAME or __stub___NAME is defined, -then the function doesn't actually exist. Tests using work -on every system around. - -The declaration of FOO is there to override builtin prototypes for -ANSI C functions. - =back =head2 Probably good ideas waiting for round tuits @@ -1453,4 +1345,4 @@ All opinions expressed herein are those of the authorZ<>(s). =head1 LAST MODIFIED -$Id: pumpkin.pod,v 1.22 1998/07/22 16:33:55 doughera Released $ +$Id: pumpkin.pod,v 1.23 2000/01/13 19:45:13 doughera Released $ diff --git a/README b/README index 63ae2e3..7b294f2 100644 --- a/README +++ b/README @@ -50,9 +50,9 @@ -------------------------------------------------------------------------- Perl is a language that combines some of the features of C, sed, awk -and shell. See the manual page for more hype. There are also two Nutshell -Handbooks published by O'Reilly & Assoc. See pod/perlbook.pod -for more information. +and shell. See the manual page for more hype. There are also many Perl +books available, covering a wide variety of topics, from various publishers. +See pod/perlbook.pod for more information. Please read all the directions below before you proceed any further, and then follow them carefully. @@ -62,29 +62,10 @@ in MANIFEST. Installation -1) Detailed instructions are in the file INSTALL which you should read. -In brief, the following should work on most systems: - - rm -f config.sh Policy.sh - sh Configure -de - make - make test - make install - -For most systems, it should be safe to accept all the Configure defaults. -It is recommended that you accept the defaults the first time you build -or if you have any problems building. - -The above commands will install Perl to /usr/local or /opt, depending -on the platform. If that's not okay with you, use - - rm -f config.sh Policy.sh - sh Configure - make - make test - make install - -Full configuration instructions can be found in the INSTALL file. +1) Detailed instructions are in the file "INSTALL", which you should +read if you are either installing on a system resembling Unix +or porting perl to another platform. For non-Unix platforms, see the +corresponding README. 2) Read the manual entries before running perl. @@ -94,18 +75,16 @@ If you have a problem, there's someone else out there who either has had or will have the same problem. It's usually helpful if you send the output of the "myconfig" script in the main perl directory. -If you've succeeded in compiling perl, the perlbug script in the utils/ +If you've succeeded in compiling perl, the perlbug script in the "utils" subdirectory can be used to help mail in a bug report. If possible, send in patches such that the patch program will apply them. Context diffs are the best, then normal diffs. Don't send ed scripts-- I've probably changed my copy since the version you have. -Watch for perl patches in comp.lang.perl.announce. Patches will generally -be in a form usable by the patch program. If you are just now bringing -up perl and aren't sure how many patches there are, write to me and I'll -send any you don't have. Your current patch level is shown in -patchlevel.h. +The latest versions of perl are always available on the various CPAN +(Comprehensive Perl Archive Network) sites around the world. +See . Just a personal note: I want you to know that I create nice things like this diff --git a/README.epoc b/README.epoc index d078d84..2ff36fd 100644 --- a/README.epoc +++ b/README.epoc @@ -1,42 +1,49 @@ -================================================= +===================================================================== Perl 5 README file for the EPOC operating system. -================================================== +===================================================================== Olaf Flebbe -http://www.fortunecity.de/wolkenkratzer/trumpet/84/perl5.html -Aug 25, 1999 +http://www.linuxstart.com/~oflebbe/perl/perl5.html +2000-01-08 +===================================================================== Introduction ------------- +===================================================================== -This is a port of Perl version 5.005_60 to EPOC. +EPOC is a OS for palmtops and mobile phones. For more informations look at: +http://www.symbian.com/ -There are many features left out, because of restrictions of the POSIX -support in the SDK. +This is a port of Perl version 5.005_63 to EPOC. It runs on the Perl +Series 5, Series 5mx. I have no reports about the Psion Revo, the +Ericcson (??) and the Psion NetBook. I only have acess to an Series 5. +Features are left out, because of restrictions of the POSIX support. +===================================================================== Installation/Usage ------------------- +===================================================================== -You will need ~4MB free space in order to run perl. +You will need ~4MB free space in order to install and run perl. -Install perl.sis on the EPOC machine (most likely a PSION Series -5). If you do not know how to do that, you are on your own. You may -have to use a CF Card in order to work with perl. The perl debugger -uses more then 1.5 MB additional RAM. The heap is limited to 2 MB. +Install perl.sis on the EPOC machine (most likely a PSION Series 5, +5mx). If you do not know how to do that, you are on your own. -Perl itself and its standard library are using 1.7MB disk space. I -left out UTF support and modules which will not work with this -version. (For details look into epoc/createpkg.pl). +Perl itself and its standard library are using 2.5 MB disk space. I +left out unicode support modules and modules which will not work with +this version. (For details look into epoc/createpkg.pl). If you like +to use them, you are free to copy them from a current perl release. -Copy eshell.exe to the same location as perl. Start eshell.exe with a -double click. +Copy eshell.exe from the same page you got perl to your EPOC device. +Start eshell.exe with a double tap. Now you can enter: perl -de 0 in order to run the perl debugger. If -you are leaving perl, you have to switch back manually to eshell.exe -(With Ctrl-System or the button in the upper right corner of the -System screen.) When perl is running, you will see a task with the -name STDOUT in the task list. +you are leaving perl, you get into the system screen. You have to +switch back manually to eshell.exe When perl is running, you will see +a task with the name STDOUT in the task list. + +====================================================================== +IO Redirection +====================================================================== You can redirect the output with the UNIX bourne shell syntax (this is built into perl rather then eshell) For instance the following command @@ -45,88 +52,113 @@ stdout_file, the errors to stderr_file and input from stdin_file. perl test.pl >stdout_file stderr_file -Alternativly you can use 2>&1 in order to add the standard error output to -stdout. +Alternativly you can use 2>&1 in order to add the standard error +output to stdout. + +====================================================================== +PATH Names +====================================================================== Pathnames to executables in eshell.exe have to be written with -backslashes, file arguments to perl with slashes. The default drive of -perl is the same as the drive perl.exe is located on, the default path -is the path perl.exe is / (???). +backslashes '\', file arguments to perl with slashes '/'. The default +drive of perl is the same as the drive perl.exe is located on, the +default path seems to be '/'. i.e. command lines look a little bit funny: D:\perl.exe C:/test.pl >C:/output.txt -In order to use Getopt::Long you have to autosplit this module by hand: run +You can automatically search for file on all EPOC drives with a ? as +the driver letter. For instance ?:\a.txt seraches for C:\a.txt, +D:\b.txt (and Z:\a.txt). -\perl.exe \autosplit.pl in order to create the necessary files. +====================================================================== +Editors +====================================================================== You may have a problem to create perl scripts. A cumbersome workaround is to use the OPL Editor and exporting to text. -Problems --------- +The OPL+ Editor is quite good. (Shareware: http://www.twiddlebit.com) +There is a port of vim around: + http://www.starship.freeserve.co.uk/index.html + +====================================================================== +Restrictions +====================================================================== -The following known problems exist: +The following things are left out of this perl port: -1) no support for system, backquoting, pipes etc. One cannot exec a - different process. ++ backquoting, pipes etc. -2) no signals, kill, alarm. Do not try to use them. This may be - impossible to implement on EPOC. ++ system() does not inherit ressources like: file descriptors, + environment etc. -3) select is missing. ++ signal, kill, alarm. Do not try to use them. This may be + impossible to implement on EPOC. -4) binmode does not exist. (No CR LF to LF translation for text files) ++ select is missing. -5) Only a stub Config.pm ++ binmode does not exist. (No CR LF to LF translation for text files) -6) EPOC does not handle the notion of current drive and current - directory very well (i.e. not at all, but it tries hard to emulate - one) ++ EPOC does not handle the notion of current drive and current + directory very well (i.e. not at all, but it tries hard to emulate + one) See PATH. -7) sockets may hardly of any use. ++ sockets seems to work now! -8) You need the shell eshell.exe in order to run perl.exe and supply - it with arguments. ++ You need the shell eshell.exe in order to run perl.exe and supply + it with arguments. ++ Heap is limited to 4MB. +=================================================================== Compiling Perl 5 on the EPOC cross compiling envionment. --------------------------------------------------------- +=================================================================== -0. You will need the C++ SDK from - http://developer.epocworld.com/. Install it on a separate - drive. +Sorry, this is far too short. -1. Get the Perl sources from your nearest CPAN site. - Unpack the sources of perl5.005_60 in the epoc development drive. - -2. Copy all files in the directory perl5.005_60/epoc to perl5.005_60. + You will need the C++ SDK from http://developer.epocworld.com/. -3. Check the perl.mmp file: It should have the correct locations for - project und subproject (see step 1) + You will need to set up the cross SDK from + http://www.linuxstart.com/~oflebbe -4. Change to the EPOC development drive and run - makmake perl marm - nmake -f perl.marm - makesis perl.pkg perl5.005.sis + You may have to adjust config.sh (cc, cppflags) for your epoc + install location. -5. Beam the perl5.005.sis to the Psion5, install and enjoy! + You may have to adjust config.sh for your cross SDK location -You can use epoc\createpkg.pl to generate a new perl.pkg file. + Get the Perl sources from your nearest CPAN site. + Unpack the sources. -Wish List ---------- + Build a native miniperl... + cp epoc/* . + for i in *.SH ; do + sh $i + done + make perl + cp miniperl.native miniperl + make perl + perl linkit perlmain.o lib/auto/DynaLoader/DynaLoader.a \ + lib/auto/Data/Dumper.a \ + lib/auto/File/Glob/Glob.a lib/auto/IO/IO.a \ + lib/auto/Socket/Socket.a perl.a `cat ext.libs` + perl createpkg.pl + wine "G:/bin/makesis perl.pkg perl.sis" -- Implement an OPX to get rid of eshell.exe. -- Implement system(), in order to run the tests. +==================================================================== +TODO +==================================================================== -- Implement getprotcolbyname() and relatives. +- Get the HTTPD::* working (Hey, It worked the first time for me!) +- Threads ? +- Acess to the GUI? +==================================================================== Support Status --------------- +==================================================================== I'm offering this port "as is". You can ask me questions, but I can't guarantee I'll be able to answer them; I don't know much about Perl diff --git a/README.hurd b/README.hurd index 40e1ba9..6db3ef3 100644 --- a/README.hurd +++ b/README.hurd @@ -1,5 +1,5 @@ Notes on Perl on the Hurd -Last Updated: Sat, 6 Mar 1999 16:07:59 +0100 +Last Updated: Fri, 29 Oct 1999 22:50:30 +0200 Written by: Mark Kettenis If you want to use Perl on the Hurd, I recommend using the Debian @@ -9,32 +9,32 @@ binary distribution will most certainly have additional problems. * Known Problems -The Perl testsuite may still report some errors on the Hurd. The -`lib/anydbm.t' and `op/stat.t' tests will most certainly fail. The -first fails because Berkeley DB 2 does not allow empty keys and the -test tries to use them anyway. This is not really a Hurd bug. The -same test fails on Linux with version 2.1 of the GNU C Library. The -second failure is caused by a bug in the Hurd's filesystem servers, -that we have not been able to fix yet. I don't think it is crucial. +The Perl test suite may still report some errors on the Hurd. The +`lib/anydbm' and `pragma/warnings' tests will almost certainly fail. +Both failures are not really specific to the Hurd, as indicated by the +test suite output. The socket tests may fail if the network is not configured. You have to make `/hurd/pfinet' the translator for `/servers/socket/2', giving it the right arguments. Try `/hurd/pfinet --help' for more information. -Here are the statistics for Perl 5.005_03 on my system: +Here are the statistics for Perl 5.005_62 on my system: Failed Test Status Wstat Total Fail Failed List of failed ------------------------------------------------------------------------------- lib/anydbm.t 12 1 8.33% 12 -op/stat.t 58 1 1.72% 4 -5 tests skipped, plus 14 subtests skipped. -Failed 2/189 test scripts, 98.94% okay. 2/6669 subtests failed, 99.97% okay. +pragma/warnings 333 1 0.30% 215 +8 tests and 24 subtests skipped. +Failed 2/229 test scripts, 99.13% okay. 2/10850 subtests failed, 99.98% okay. There are quite a few systems out there that do worse! However, since I am running a very recent Hurd snapshot, in which a lot of -bugs that were exposed by the Perl testsuite have been fixed, you may -encounter more failures. Likely candidates are: `lib/io_pipe.t', -`lib/io_sock.t', `lib/io_udp.t' and `lib/time.t'. +bugs that were exposed by the Perl test suite have been fixed, you may +encounter more failures. Likely candidates are: `op/stat', `lib/io_pipe', +`lib/io_sock', `lib/io_udp' and `lib/time'. +In any way, if you're seeing failures beyond those mentioned in this +document, please consider upgrading to the latest Hurd before reporting +the failure as a bug. diff --git a/README.os2 b/README.os2 index 409c774..cd07ca1 100644 --- a/README.os2 +++ b/README.os2 @@ -809,10 +809,8 @@ Change to the directory of extraction. =head2 Application of the patches -You need to apply the patches in F<./os2/diff.*> and -F<./os2/POSIX.mkfifo> like this: +You need to apply the patches in F<./os2/diff.*> like this: - gnupatch -p0 < os2\POSIX.mkfifo gnupatch -p0 < os2\diff.configure You may also need to apply the patches supplied with the binary @@ -939,6 +937,8 @@ The reasons for most important skipped tests are: =item F +=over 4 + =item 18 Checks C and C of C - unfortunately, HPFS diff --git a/README.vms b/README.vms index e2c0e08..d9ea97e 100644 --- a/README.vms +++ b/README.vms @@ -1,11 +1,12 @@ -Last Revised 01-March-1999 by Dan Sugalski +Last revised 27-October-1999 by Craig Berry +Revised 01-March-1999 by Dan Sugalski Originally by Charles Bailey * Important safety tip The build and install procedures have changed significantly from the 5.004 releases! Make sure you read the "Building Perl" and "Installing Perl" -sections before you build or install. +sections of this document before you build or install. Also note that, as of 5.005, an ANSI C compliant compiler is required to build Perl. Vax C is *not* ANSI compliant, as it died a natural death some @@ -83,7 +84,7 @@ Building perl has two steps, configuration and compilation. To configure perl (a necessary first step), issue the command -@CONFIGURE + @CONFIGURE from the top of an unpacked perl directory. You'll be asked a series of questions, and the answers to them (along with the capabilities of your C @@ -95,7 +96,22 @@ you're using a version older than 5.2, check the Dec C Issues section. The configuration script will print out, at the very end, the MMS or MMK command you need to compile perl. Issue it (exactly as printed) to start -the build. +the build. If you have any symbols or logical names in your environment +that may interfere with the build or regression testing of perl then +configure.com will try to warn you about them. If a logical name is causing +you trouble but is in an LNM table that you do not have write access to +then try defining your own to a harmless equivalence string in a table +such that it is resolved before the other (e.g. if TMP is defined in the +SYSTEM table then try DEFINE TMP "NL:" or somesuch) otherwise simply deasign +the dangerous logical names. The potentially troublesome logicals and +symbols are: + + TMP "LOGICAL" + LIB "LOGICAL" + T "LOGICAL" + FOO "LOGICAL" + EXT "LOGICAL" + TEST "SYMBOL" Once you issue your MMS command, sit back and wait. Perl should build and link without a problem. If it doesn't, check the Gotchas to watch out for @@ -104,7 +120,7 @@ Instructions are in the Mailing Lists section. As a handy shortcut, the command: -@CONFIGURE "-des" + @CONFIGURE "-des" (note the quotation marks and case) will choose reasonable defaults. (It takes Dec C over Gnu C, Dec C sockets over SOCKETSHR sockets, and either @@ -143,14 +159,14 @@ confident you are, make a bug report to the VMSPerl mailing list. If one or more tests fail, you can get more info on the failure by issuing this command sequence: -$ @[.VMS]TEST .typ "-v" [.subdir]test.T +$ @[.VMS]TEST .typ "" "-v" [.subdir]test.T where ".typ" is the file type of the Perl images you just built (if you didn't do anything special, use .EXE), and "[.subdir]test.T" is the test that failed. For example, with a normal Perl build, if the test indicated that [.op]time failed, then you'd do this: -$ @[.VMS]TEST .EXE "-v" [.OP]TIME.T +$ @[.VMS]TEST .EXE "" "-v" [.OP]TIME.T When you send in a bug report for failed tests, please include the output from this command, which is run from the main source directory: @@ -244,18 +260,18 @@ into DCLTABLES, replace it with just perl. Execute the following command file to define PERL as a DCL command. You'll need CMKRNL priv to install the new dcltables.exe. -$ create perl.cld -! -! modify to reflect location of your perl.exe -! -define verb perl - image perl_root:[000000]perl.exe - cliflags (foreign) -$! -$ set command perl /table=sys$common:[syslib]dcltables.exe - - /output=sys$common:[syslib]dcltables.exe -$ install replace sys$common:[syslib]dcltables.exe -$ exit + $ create perl.cld + ! + ! modify to reflect location of your perl.exe + ! + define verb perl + image perl_root:[000000]perl.exe + cliflags (foreign) + $! + $ set command perl /table=sys$common:[syslib]dcltables.exe - + /output=sys$common:[syslib]dcltables.exe + $ install replace sys$common:[syslib]dcltables.exe + $ exit * Changing compile-time things @@ -277,7 +293,7 @@ change these, as they can cause some fairly subtle problems. On systems that are using perl quite a bit, and particularly those with minimal RAM, you can boost the performance of perl by INSTALLing it as -a known image. PERLSHR.EXE is typically larger than 1500 blocks +a known image. PERLSHR.EXE is typically larger than 2000 blocks and that is a reasonably large amount of IO to load each time perl is invoked. @@ -358,7 +374,7 @@ before you rebuild. * Dec C issues Note to DECC users: Some early versions (pre-5.2, some pre-4. If you're Dec -C 5.x or higher, with current patches if anym you're fine) of the DECCRTL +C 5.x or higher, with current patches if any, you're fine) of the DECCRTL contained a few bugs which affect Perl performance: - Newlines are lost on I/O through pipes, causing lines to run together. This shows up as RMS RTB errors when reading from a pipe. You can @@ -380,16 +396,16 @@ specific issues (including both Perl questions and installation problems) there is the VMSPERL mailing list. It's usually a low-volume (10-12 messages a week) mailing list. -The subscription address is VMSPERL-REQUEST@NEWMAN.UPENN.EDU. Send a mail -message with just the words SUBSCRIBE VMSPERL in the body of the message. - -The VMSPERL mailing list address is VMSPERL@NEWMAN.UPENN.EDU. Any mail -sent there gets echoed to all subscribers of the list. - +The subscription address is MAJORDOMO@PERL.ORG. Send a mail message with just +the words SUBSCRIBE VMSPERL in the body of the message. + +The VMSPERL mailing list address is VMSPERL@PERL.ORG. Any mail sent there +gets echoed to all subscribers of the list. There is a searchable archive of +the list at . + To unsubscribe from VMSPERL send the message UNSUBSCRIBE VMSPERL to -VMSPERL-REQUEST@NEWMAN.UPENN.EDU. Be sure to do so from the subscribed -account that you are cancelling. - +MAJORDOMO@PERL.ORG. Be sure to do so from the subscribed account that +you are cancelling. * Acknowledgements @@ -409,10 +425,10 @@ missed someone. That said, special thanks are due to the following: for the getredirection() code Rich Salz for readdir() and related routines - Peter Prymmer or + Peter Prymmer for extensive testing, as well as development work on configuration and documentation for VMS Perl, - Dan Sugalski + Dan Sugalski for extensive contributions to recent version support, development of VMS-specific extensions, and dissemination of information about VMS Perl, diff --git a/README.win32 b/README.win32 index 3d37330..1623acf 100644 --- a/README.win32 +++ b/README.win32 @@ -9,12 +9,12 @@ perlwin32 - Perl under Win32 =head1 SYNOPSIS These are instructions for building Perl under Windows NT (versions -3.51 or 4.0). Currently, this port is reported to build -under Windows95 using the 4DOS shell--the default shell that infests -Windows95 will not work (see below). Note this caveat is only about -B perl. Once built, you should be able to B it on -either Win32 platform (modulo the problems arising from the inferior -command shell). +3.51 or 4.0). Currently, this port is reported to build under +Windows95 using the 4DOS shell--the default shell that infests +Windows95 may not work fully (but see below). Note that this caveat +is only about B perl. Once built, you should be able to +B it on either Win32 platform (modulo the problems arising from +the inferior command shell). =head1 DESCRIPTION @@ -47,11 +47,11 @@ following compilers: Borland C++ version 5.02 or later Microsoft Visual C++ version 4.2 or later - Mingw32 with EGCS versions 1.0.2, 1.1 - Mingw32 with GCC version 2.8.1 + Mingw32 with GCC version 2.95.2 or better -The last two of these are high quality freeware compilers. Support -for them is still experimental. +The last of these is a high quality freeware compiler. Support +for it is still experimental. (Older versions of GCC are known +not to work.) This port currently supports MakeMaker (the set of modules that is used to build extensions to perl). Therefore, you should be @@ -67,13 +67,16 @@ See L below for general hints about this. Use the default "cmd" shell that comes with NT. Some versions of the popular 4DOS/NT shell have incompatibilities that may cause you trouble. If the build fails under that shell, try building again with the cmd -shell. The Makefile also has known incompatibilites with the "command.com" -shell that comes with Windows95, so building under Windows95 should -be considered "unsupported". However, there have been reports of successful -build attempts using 4DOS/NT version 6.01 under Windows95, using dmake, but -your mileage may vary. +shell. The nmake Makefile also has known incompatibilites with the +"command.com" shell that comes with Windows95. -The surest way to build it is on WindowsNT, using the cmd shell. +However, there have been reports of successful build attempts using +4DOS/NT version 6.01 under Windows95, using dmake, but your mileage +may vary. There is also some basic support for building using dmake +under command.com. Nevertheless, if building under command.com +doesn't work, try 4DOS/NT. + +The surest way to build it is on Windows NT, using the cmd shell. Make sure the path to the build directory does not contain spaces. The build usually works in this circumstance, but some tests will fail. @@ -87,14 +90,19 @@ work for MakeMaker builds.) A port of dmake for win32 platforms is available from: - http://www-personal.umich.edu/~gsar/dmake-4.1-win32.zip + ftp://ftp.linux.activestate.com/pub/staff/gsar/dmake-4.1-win32.zip + +(This is a fixed version of original dmake sources obtained from +http://www.wticorp.com/dmake/. As of version 4.1PL1, the original +sources did not build as shipped, and had various other problems. +A patch is included in the above fixed version.) Fetch and install dmake somewhere on your path (follow the instructions in the README.NOW file). =item Microsoft Visual C++ -The NMAKE that comes with Visual C++ will suffice for building. +The nmake that comes with Visual C++ will suffice for building. You will need to run the VCVARS32.BAT file usually found somewhere like C:\MSDEV4.2\BIN. This will set your build environment. @@ -105,24 +113,17 @@ and edit win32/config.vc to change "make=nmake" into "make=dmake". The latter step is only essential if you want to use dmake as your default make for building extensions using MakeMaker. -=item Mingw32 with EGCS or GCC +=item Mingw32 with GCC -ECGS binaries can be downloaded from: +GCC-2.95.2 binaries can be downloaded from: ftp://ftp.xraylith.wisc.edu/pub/khan/gnu-win32/mingw32/ -GCC-2.8.1 binaries are available from: - - http://agnes.dida.physik.uni-essen.de/~janjaap/mingw32/ +The GCC-2.95.2 bundle comes with Mingw32 libraries and headers. -You only need either one of those, not both. Both bundles come with -Mingw32 libraries and headers. While both of them work to build perl, -the EGCS binaries are currently favored by the maintainers, since they -come with more up-to-date Mingw32 libraries. - -Make sure you install the binaries as indicated in the web sites -above. You will need to set up a few environment variables (usually -run from a batch file). +Make sure you install the binaries as indicated in the README for +the GCC bundle. You may need to set up a few environment variables +(usually run from a batch file). You also need dmake. See L above on how to get it. @@ -136,7 +137,7 @@ You also need dmake. See L above on how to get it. Make sure you are in the "win32" subdirectory under the perl toplevel. This directory contains a "Makefile" that will work with -versions of NMAKE that come with Visual C++, and a dmake "makefile.mk" +versions of nmake that come with Visual C++, and a dmake "makefile.mk" that will work for all supported compilers. The defaults in the dmake makefile are setup to build using the Borland compiler. @@ -157,7 +158,7 @@ is typically requested through: perl Makefile.PL CAPI=TRUE PERL_OBJECT requires VC++ 5.0 (Service Pack 3 recommended) or later. It -is not yet supported under GCC or EGCS. WARNING: Binaries built with +is not yet supported under GCC. WARNING: Binaries built with PERL_OBJECT enabled are B compatible with binaries built without. Perl installs PERL_OBJECT binaries under a distinct architecture name, so they B coexist, though. @@ -249,10 +250,6 @@ default path. You will need to copy the DLLs reported by the messages from where Borland chose to install it, into the Windows system directory (usually somewhere like C:\WINNT\SYSTEM32), and rerun the test. -The Visual C runtime apparently has a bug that causes posix.t to fail -test#2. This usually happens only if you extracted the files in text -mode. Enable the USE_PERLCRT option in the Makefile to fix this bug. - Please report any other failures as described under L. =head2 Installation @@ -697,8 +694,9 @@ C is implemented, but doesn't have the semantics of C, i.e. it doesn't send a signal to the identified process like it does on Unix platforms. Instead it immediately calls C. Thus the signal argument is -used to set the exit-status of the terminated process. This behavior -may change in future. +used to set the exit-status of the terminated process. In particular, +C will kill the process identified by C<$pid> (unlike +on Unix). This behavior may change in future. =item * @@ -725,7 +723,7 @@ by C. Gary Ng E71564.1743@CompuServe.COME -Gurusamy Sarathy Egsar@umich.eduE +Gurusamy Sarathy Egsar@activestate.comE Nick Ing-Simmons Enick@ni-s.u-net.comE @@ -741,10 +739,8 @@ L This port was originally contributed by Gary Ng around 5.003_24, and borrowed from the Hip Communications port that was available -at the time. - -Nick Ing-Simmons and Gurusamy Sarathy have made numerous and -sundry hacks since then. +at the time. Various people have made numerous and sundry hacks +since then. Borland support was added in 5.004_01 (Gurusamy Sarathy). @@ -752,7 +748,10 @@ GCC/mingw32 support was added in 5.005 (Nick Ing-Simmons). Support for PERL_OBJECT was added in 5.005 (ActiveState Tool Corp). -Last updated: 18 January 1999 +Support for fork() emulation was added in 5.6 (ActiveState Tool Corp). -=cut +Win9x support was added in 5.6 (Benjamin Stuhl). +Last updated: 28 December 1999 + +=cut diff --git a/XSUB.h b/XSUB.h index a414b85..53ff98d 100644 --- a/XSUB.h +++ b/XSUB.h @@ -17,6 +17,9 @@ #define dXSTARG SV * targ = ((PL_op->op_private & OPpENTERSUB_HASTARG) \ ? PAD_SV(PL_op->op_targ) : sv_newmortal()) +/* Should be used before final PUSHi etc. if not in PPCODE section. */ +#define XSprePUSH (sp = PL_stack_base + ax - 1) + #define XSANY CvXSUBANY(cv) #define dXSI32 I32 ix = XSANY.any_i32 @@ -128,7 +131,7 @@ # define aTHX_ aTHX, #endif -#if defined(PERL_CAPI) +#if (defined(PERL_CAPI) || defined(PERL_IMPLICIT_SYS)) && !defined(PERL_CORE) # ifndef NO_XSLOCKS # undef closedir # undef opendir @@ -196,6 +199,7 @@ # define fstat PerlLIO_fstat # define ioctl PerlLIO_ioctl # define isatty PerlLIO_isatty +# define link PerlLIO_link # define lseek PerlLIO_lseek # define lstat PerlLIO_lstat # define mktemp PerlLIO_mktemp @@ -203,7 +207,7 @@ # define read PerlLIO_read # define rename PerlLIO_rename # define setmode PerlLIO_setmode -# define stat PerlLIO_stat +# define stat(buf,sb) PerlLIO_stat(buf,sb) # define tmpnam PerlLIO_tmpnam # define umask PerlLIO_umask # define unlink PerlLIO_unlink @@ -237,6 +241,7 @@ # define setjmp PerlProc_setjmp # define longjmp PerlProc_longjmp # define signal PerlProc_signal +# define getpid PerlProc_getpid # define htonl PerlSock_htonl # define htons PerlSock_htons # define ntohl PerlSock_ntohl @@ -283,4 +288,4 @@ # endif /* NO_XSLOCKS */ #endif /* PERL_CAPI */ -#endif _INC_PERL_XSUB_H /* include guard */ +#endif /* _INC_PERL_XSUB_H */ /* include guard */ diff --git a/av.c b/av.c index 509b897..af8296a 100644 --- a/av.c +++ b/av.c @@ -591,6 +591,86 @@ Perl_av_fill(pTHX_ register AV *av, I32 fill) (void)av_store(av,fill,&PL_sv_undef); } +SV * +Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags) +{ + SV *sv; + + if (!av) + return Nullsv; + if (SvREADONLY(av)) + Perl_croak(aTHX_ PL_no_modify); + if (key < 0) { + key += AvFILL(av) + 1; + if (key < 0) + return Nullsv; + } + if (SvRMAGICAL(av)) { + SV **svp; + if ((mg_find((SV*)av,'P') || mg_find((SV*)av,'D')) + && (svp = av_fetch(av, key, TRUE))) + { + sv = *svp; + mg_clear(sv); + if (mg_find(sv, 'p')) { + sv_unmagic(sv, 'p'); /* No longer an element */ + return sv; + } + return Nullsv; /* element cannot be deleted */ + } + } + if (key > AvFILLp(av)) + return Nullsv; + else { + sv = AvARRAY(av)[key]; + if (key == AvFILLp(av)) { + do { + AvFILLp(av)--; + } while (--key >= 0 && AvARRAY(av)[key] == &PL_sv_undef); + } + else + AvARRAY(av)[key] = &PL_sv_undef; + if (SvSMAGICAL(av)) + mg_set((SV*)av); + } + if (flags & G_DISCARD) { + SvREFCNT_dec(sv); + sv = Nullsv; + } + return sv; +} + +/* + * This relies on the fact that uninitialized array elements + * are set to &PL_sv_undef. + */ + +bool +Perl_av_exists(pTHX_ AV *av, I32 key) +{ + if (!av) + return FALSE; + if (key < 0) { + key += AvFILL(av) + 1; + if (key < 0) + return FALSE; + } + if (SvRMAGICAL(av)) { + if (mg_find((SV*)av,'P') || mg_find((SV*)av,'D')) { + SV *sv = sv_newmortal(); + mg_copy((SV*)av, sv, 0, key); + magic_existspack(sv, mg_find(sv, 'p')); + return SvTRUE(sv); + } + } + if (key <= AvFILLp(av) && AvARRAY(av)[key] != &PL_sv_undef + && AvARRAY(av)[key]) + { + return TRUE; + } + else + return FALSE; +} /* AVHV: Support for treating arrays as if they were hashes. The * first element of the array should be a hash reference that maps @@ -630,18 +710,41 @@ Perl_avhv_fetch_ent(pTHX_ AV *av, SV *keysv, I32 lval, U32 hash) SV **indsvp; HV *keys = avhv_keys(av); HE *he; - + STRLEN n_a; + he = hv_fetch_ent(keys, keysv, FALSE, hash); if (!he) - Perl_croak(aTHX_ "No such array field"); + Perl_croak(aTHX_ "No such pseudo-hash field \"%s\"", SvPV(keysv,n_a)); return av_fetch(av, avhv_index_sv(HeVAL(he)), lval); } +SV * +Perl_avhv_delete_ent(pTHX_ AV *av, SV *keysv, I32 flags, U32 hash) +{ + HV *keys = avhv_keys(av); + HE *he; + + he = hv_fetch_ent(keys, keysv, FALSE, hash); + if (!he || !SvOK(HeVAL(he))) + return Nullsv; + + return av_delete(av, avhv_index_sv(HeVAL(he)), flags); +} + +/* Check for the existence of an element named by a given key. + * + */ bool Perl_avhv_exists_ent(pTHX_ AV *av, SV *keysv, U32 hash) { HV *keys = avhv_keys(av); - return hv_exists_ent(keys, keysv, hash); + HE *he; + + he = hv_fetch_ent(keys, keysv, FALSE, hash); + if (!he || !SvOK(HeVAL(he))) + return FALSE; + + return av_exists(av, avhv_index_sv(HeVAL(he))); } HE * diff --git a/av.h b/av.h index f537d9e..14e8765 100644 --- a/av.h +++ b/av.h @@ -10,7 +10,7 @@ struct xpvav { char* xav_array; /* pointer to first array element */ SSize_t xav_fill; /* Index of last element present */ - SSize_t xav_max; /* Number of elements for which array has space */ + SSize_t xav_max; /* max index for which array has space */ IV xof_off; /* ptr is incremented by offset */ NV xnv_nv; /* numeric value, if any */ MAGIC* xmg_magic; /* magic for scalar array */ diff --git a/bytecode.pl b/bytecode.pl index 7d9b223..00df48b 100644 --- a/bytecode.pl +++ b/bytecode.pl @@ -9,7 +9,7 @@ my %alias_to = ( U8 => [qw(char)], ); -my @optype= qw(OP UNOP BINOP LOGOP LISTOP PMOP SVOP GVOP PVOP LOOP COP); +my @optype= qw(OP UNOP BINOP LOGOP LISTOP PMOP SVOP PADOP PVOP LOOP COP); # Nullsv *must* come first in the following so that the condition # ($$sv == 0) can continue to be used to test (sv == Nullsv). @@ -339,7 +339,7 @@ xcv_stash *(SV**)&CvSTASH(bytecode_sv) svindex xcv_start CvSTART(bytecode_sv) opindex xcv_root CvROOT(bytecode_sv) opindex xcv_gv *(SV**)&CvGV(bytecode_sv) svindex -xcv_filegv *(SV**)&CvFILEGV(bytecode_sv) svindex +xcv_file CvFILE(bytecode_sv) pvcontents xcv_depth CvDEPTH(bytecode_sv) long xcv_padlist *(SV**)&CvPADLIST(bytecode_sv) svindex xcv_outside *(SV**)&CvOUTSIDE(bytecode_sv) svindex @@ -366,7 +366,7 @@ gp_refcnt_add GvREFCNT(bytecode_sv) I32 x gp_av *(SV**)&GvAV(bytecode_sv) svindex gp_hv *(SV**)&GvHV(bytecode_sv) svindex gp_cv *(SV**)&GvCV(bytecode_sv) svindex -gp_filegv *(SV**)&GvFILEGV(bytecode_sv) svindex +gp_file GvFILE(bytecode_sv) pvcontents gp_io *(SV**)&GvIOp(bytecode_sv) svindex gp_form *(SV**)&GvFORM(bytecode_sv) svindex gp_cvgen GvCVGEN(bytecode_sv) U32 @@ -393,18 +393,18 @@ pregcomp PL_op pvcontents x op_pmflags cPMOP->op_pmflags U16 op_pmpermflags cPMOP->op_pmpermflags U16 op_sv cSVOP->op_sv svindex -op_gv *(SV**)&cGVOP->op_gv svindex +op_padix cPADOP->op_padix PADOFFSET op_pv cPVOP->op_pv pvcontents op_pv_tr cPVOP->op_pv op_tr_array op_redoop cLOOP->op_redoop opindex op_nextop cLOOP->op_nextop opindex op_lastop cLOOP->op_lastop opindex cop_label cCOP->cop_label pvcontents -cop_stash *(SV**)&cCOP->cop_stash svindex -cop_filegv *(SV**)&cCOP->cop_filegv svindex +cop_stashpv cCOP pvcontents x +cop_file cCOP pvcontents x cop_seq cCOP->cop_seq U32 cop_arybase cCOP->cop_arybase I32 -cop_line cCOP->cop_line line_t +cop_line cCOP line_t x cop_warnings cCOP->cop_warnings svindex main_start PL_main_start opindex main_root PL_main_root opindex diff --git a/config_h.SH b/config_h.SH index 5aa68c2..712b38e 100644 --- a/config_h.SH +++ b/config_h.SH @@ -376,18 +376,6 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_mktime HAS_MKTIME /**/ -/* HAS_MSYNC: - * This symbol, if defined, indicates that the msync system call is - * available to synchronize a mapped file. - */ -#$d_msync HAS_MSYNC /**/ - -/* HAS_MUNMAP: - * This symbol, if defined, indicates that the munmap system call is - * available to unmap a region, usually mapped by mmap(). - */ -#$d_munmap HAS_MUNMAP /**/ - /* HAS_NICE: * This symbol, if defined, indicates that the nice routine is * available. @@ -1010,30 +998,6 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #define STDCHAR $stdchar /**/ -/* HAS_ACCESSX: - * This symbol, if defined, indicates that the accessx routine is - * available to do extended access checks. - */ -#$d_accessx HAS_ACCESSX /**/ - -/* HAS_EACCESS: - * This symbol, if defined, indicates that the eaccess routine is - * available to do extended access checks. - */ -#$d_eaccess HAS_EACCESS /**/ - -/* I_SYS_ACCESS: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -#$i_sysaccess I_SYS_ACCESS /**/ - -/* I_SYS_SECURITY: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -#$i_syssecrt I_SYS_SECURITY /**/ - /* CROSSCOMPILE: * This symbol, if defined, signifies that we our * build process is a cross-compilation. @@ -1065,6 +1029,53 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$multiarch MULTIARCH /**/ +/* HAS_QUAD: + * This symbol, if defined, tells that there's a 64-bit integer type, + * Quad_t, and its unsigned counterpar, Uquad_t. QUADKIND will be one + * of QUAD_IS_INT, QUAD_IS_LONG, QUAD_IS_LONG_LONG, or QUAD_IS_INT64_T. + */ +#$d_quad HAS_QUAD /**/ +#ifdef HAS_QUAD +# define Quad_t $quadtype /**/ +# define Uquad_t $uquadtype /**/ +# define QUADKIND $quadkind /**/ +# define QUAD_IS_INT 1 +# define QUAD_IS_LONG 2 +# define QUAD_IS_LONG_LONG 3 +# define QUAD_IS_INT64_T 4 +#endif + +/* HAS_ACCESSX: + * This symbol, if defined, indicates that the accessx routine is + * available to do extended access checks. + */ +#$d_accessx HAS_ACCESSX /**/ + +/* HAS_EACCESS: + * This symbol, if defined, indicates that the eaccess routine is + * available to do extended access checks. + */ +#$d_eaccess HAS_EACCESS /**/ + +/* I_SYS_ACCESS: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +#$i_sysaccess I_SYS_ACCESS /**/ + +/* I_SYS_SECURITY: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +#$i_syssecrt I_SYS_SECURITY /**/ + +/* OSNAME: + * This symbol contains the name of the operating system, as determined + * by Configure. You shouldn't rely on it too much; the specific + * feature tests from Configure are generally more reliable. + */ +#define OSNAME "$osname" /**/ + /* MEM_ALIGNBYTES: * This symbol contains the number of bytes required to align a * double. Usual values are 2, 4 and 8. The default is eight, @@ -1076,6 +1087,61 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #define MEM_ALIGNBYTES $alignbytes #endif +/* ARCHLIB: + * This variable, if defined, holds the name of the directory in + * which the user wants to put architecture-dependent public + * library files for $package. It is most often a local directory + * such as /usr/local/lib. Programs using this variable must be + * prepared to deal with filename expansion. If ARCHLIB is the + * same as PRIVLIB, it is not defined, since presumably the + * program already searches PRIVLIB. + */ +/* ARCHLIB_EXP: + * This symbol contains the ~name expanded version of ARCHLIB, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. + */ +#$d_archlib ARCHLIB "$archlib" /**/ +#$d_archlib ARCHLIB_EXP "$archlibexp" /**/ + +/* ARCHNAME: + * This symbol holds a string representing the architecture name. + * It may be used to construct an architecture-dependant pathname + * where library files may be held under a private library, for + * instance. + */ +#define ARCHNAME "$archname" /**/ + +/* HAS_ATOLF: + * This symbol, if defined, indicates that the atolf routine is + * available to convert strings into long doubles. + */ +#$d_atolf HAS_ATOLF /**/ + +/* HAS_ATOLL: + * This symbol, if defined, indicates that the atoll routine is + * available to convert strings into long longs. + */ +#$d_atoll HAS_ATOLL /**/ + +/* BIN: + * This symbol holds the path of the bin directory where the package will + * be installed. Program must be prepared to deal with ~name substitution. + */ +/* BIN_EXP: + * This symbol is the filename expanded version of the BIN symbol, for + * programs that do not want to deal with that at run-time. + */ +#define BIN "$bin" /**/ +#define BIN_EXP "$binexp" /**/ + +/* PERL_BINCOMPAT_5005: + * This symbol, if defined, indicates that Perl 5.006 should be + * binary-compatible with Perl 5.005. This is impossible for builds + * that use features like threads and multiplicity it is always $undef + * for those versions. + */ +#$d_bincompat5005 PERL_BINCOMPAT_5005 /**/ + /* BYTEORDER: * This symbol holds the hexadecimal constant defined in byteorder, * i.e. 0x1234 or 0x4321, etc... @@ -1119,6 +1185,58 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #define BYTEORDER 0x$byteorder /* large digits for MSB */ #endif /* NeXT */ +/* CAT2: + * This macro catenates 2 tokens together. + */ +/* STRINGIFY: + * This macro surrounds its token with double quotes. + */ +#if $cpp_stuff == 1 +#define CAT2(a,b)a/**/b +#define STRINGIFY(a)"a" + /* If you can get stringification with catify, tell me how! */ +#endif +#if $cpp_stuff == 42 +#define CAT2(a,b)a ## b +#define StGiFy(a)# a +#define STRINGIFY(a)StGiFy(a) +#endif +#if $cpp_stuff != 1 && $cpp_stuff != 42 +#include "Bletch: How does this C preprocessor catenate tokens?" +#endif + +/* CPPSTDIN: + * This symbol contains the first part of the string which will invoke + * the C preprocessor on the standard input and produce to standard + * output. Typical value of "cc -E" or "/lib/cpp", but it can also + * call a wrapper. See CPPRUN. + */ +/* CPPMINUS: + * This symbol contains the second part of the string which will invoke + * the C preprocessor on the standard input and produce to standard + * output. This symbol will have the value "-" if CPPSTDIN needs a minus + * to specify standard input, otherwise the value is "". + */ +/* CPPRUN: + * This symbol contains the string which will invoke a C preprocessor on + * the standard input and produce to standard output. It needs to end + * with CPPLAST, after all other preprocessor flags have been specified. + * The main difference with CPPSTDIN is that this program will never be a + * pointer to a shell wrapper, i.e. it will be empty if no preprocessor is + * available directly to the user. Note that it may well be different from + * the preprocessor used to compile the C program. + */ +#define CPPSTDIN "$cppstdin" +#define CPPMINUS "$cppminus" +#define CPPRUN "$cpprun" + +/* HAS_ACCESS: + * This manifest constant lets the C program know that the access() + * system call is available to check for accessibility using real UID/GID. + * (always present on UNIX.) + */ +#$d_access HAS_ACCESS /**/ + /* CASTI32: * This symbol is defined if the C compiler can cast negative * or large floating point numbers to 32-bit ints. @@ -1146,12 +1264,104 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_void_closedir VOID_CLOSEDIR /**/ +/* HAS_CSH: + * This symbol, if defined, indicates that the C-shell exists. + */ +/* CSH: + * This symbol, if defined, contains the full pathname of csh. + */ +#$d_csh HAS_CSH /**/ +#ifdef HAS_CSH +#define CSH "$full_csh" /**/ +#endif + +/* DLSYM_NEEDS_UNDERSCORE: + * This symbol, if defined, indicates that we need to prepend an + * underscore to the symbol name before calling dlsym(). This only + * makes sense if you *have* dlsym, which we will presume is the + * case if you're using dl_dlopen.xs. + */ +#$d_dlsymun DLSYM_NEEDS_UNDERSCORE /**/ + +/* HAS_DRAND48_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the drand48() function. Otherwise, it is up + * to the program to supply one. A good guess is + * extern double drand48 _((void)); + */ +#$d_drand48proto HAS_DRAND48_PROTO /**/ + +/* HAS_ENDGRENT: + * This symbol, if defined, indicates that the getgrent routine is + * available for finalizing sequential access of the group database. + */ +#$d_endgrent HAS_ENDGRENT /**/ + +/* HAS_ENDHOSTENT: + * This symbol, if defined, indicates that the endhostent() routine is + * available to close whatever was being used for host queries. + */ +#$d_endhent HAS_ENDHOSTENT /**/ + +/* HAS_ENDNETENT: + * This symbol, if defined, indicates that the endnetent() routine is + * available to close whatever was being used for network queries. + */ +#$d_endnent HAS_ENDNETENT /**/ + +/* HAS_ENDPROTOENT: + * This symbol, if defined, indicates that the endprotoent() routine is + * available to close whatever was being used for protocol queries. + */ +#$d_endpent HAS_ENDPROTOENT /**/ + +/* HAS_ENDPWENT: + * This symbol, if defined, indicates that the getgrent routine is + * available for finalizing sequential access of the passwd database. + */ +#$d_endpwent HAS_ENDPWENT /**/ + +/* HAS_ENDSERVENT: + * This symbol, if defined, indicates that the endservent() routine is + * available to close whatever was being used for service queries. + */ +#$d_endsent HAS_ENDSERVENT /**/ + +/* HAS_ENDSPENT: + * This symbol, if defined, indicates that the endspent system call is + * available to finalize the scan of SysV shadow password entries. + */ +#$d_endspent HAS_ENDSPENT /**/ + /* HAS_FD_SET: * This symbol, when defined, indicates presence of the fd_set typedef * in */ #$d_fd_set HAS_FD_SET /**/ +/* HAS_STRUCT_FS_DATA: + * This symbol, if defined, indicates that the struct fs_data + * to do statfs() is supported. + */ +#$d_fs_data_s HAS_STRUCT_FS_DATA /**/ + +/* HAS_FSEEKO: + * This symbol, if defined, indicates that the fseeko routine is + * available to fseek beyond 32 bits (useful for ILP32 hosts). + */ +#$d_fseeko HAS_FSEEKO /**/ + +/* HAS_FSTATFS: + * This symbol, if defined, indicates that the fstatfs routine is + * available to stat filesystems by file descriptors. + */ +#$d_fstatfs HAS_FSTATFS /**/ +/* HAS_FTELLO: + * This symbol, if defined, indicates that the ftello routine is + * available to ftell beyond 32 bits (useful for ILP32 hosts). + */ +#$d_ftello HAS_FTELLO /**/ + /* Gconvert: * This preprocessor macro is defined to convert a floating point * number to a string without a trailing decimal point. This @@ -1169,456 +1379,6 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #define Gconvert(x,n,t,b) $d_Gconvert -/* HAS_GNULIBC: - * This symbol, if defined, indicates to the C program that - * the GNU C library is being used. - */ -#$d_gnulibc HAS_GNULIBC /**/ -/* HAS_ISASCII: - * This manifest constant lets the C program know that isascii - * is available. - */ -#$d_isascii HAS_ISASCII /**/ - -/* HAS_LCHOWN: - * This symbol, if defined, indicates that the lchown routine is - * available to operate on a symbolic link (instead of following the - * link). - */ -#$d_lchown HAS_LCHOWN /**/ - -/* HAS_OPEN3: - * This manifest constant lets the C program know that the three - * argument form of open(2) is available. - */ -#$d_open3 HAS_OPEN3 /**/ - -/* HAS_SAFE_BCOPY: - * This symbol, if defined, indicates that the bcopy routine is available - * to copy potentially overlapping memory blocks. Otherwise you should - * probably use memmove() or memcpy(). If neither is defined, roll your - * own version. - */ -#$d_safebcpy HAS_SAFE_BCOPY /**/ - -/* HAS_SAFE_MEMCPY: - * This symbol, if defined, indicates that the memcpy routine is available - * to copy potentially overlapping memory blocks. Otherwise you should - * probably use memmove() or memcpy(). If neither is defined, roll your - * own version. - */ -#$d_safemcpy HAS_SAFE_MEMCPY /**/ - -/* HAS_SANE_MEMCMP: - * This symbol, if defined, indicates that the memcmp routine is available - * and can be used to compare relative magnitudes of chars with their high - * bits set. If it is not defined, roll your own version. - */ -#$d_sanemcmp HAS_SANE_MEMCMP /**/ - -/* HAS_SIGACTION: - * This symbol, if defined, indicates that Vr4's sigaction() routine - * is available. - */ -#$d_sigaction HAS_SIGACTION /**/ - -/* HAS_SIGSETJMP: - * This variable indicates to the C program that the sigsetjmp() - * routine is available to save the calling process's registers - * and stack environment for later use by siglongjmp(), and - * to optionally save the process's signal mask. See - * Sigjmp_buf, Sigsetjmp, and Siglongjmp. - */ -/* Sigjmp_buf: - * This is the buffer type to be used with Sigsetjmp and Siglongjmp. - */ -/* Sigsetjmp: - * This macro is used in the same way as sigsetjmp(), but will invoke - * traditional setjmp() if sigsetjmp isn't available. - * See HAS_SIGSETJMP. - */ -/* Siglongjmp: - * This macro is used in the same way as siglongjmp(), but will invoke - * traditional longjmp() if siglongjmp isn't available. - * See HAS_SIGSETJMP. - */ -#$d_sigsetjmp HAS_SIGSETJMP /**/ -#ifdef HAS_SIGSETJMP -#define Sigjmp_buf sigjmp_buf -#define Sigsetjmp(buf,save_mask) sigsetjmp((buf),(save_mask)) -#define Siglongjmp(buf,retval) siglongjmp((buf),(retval)) -#else -#define Sigjmp_buf jmp_buf -#define Sigsetjmp(buf,save_mask) setjmp((buf)) -#define Siglongjmp(buf,retval) longjmp((buf),(retval)) -#endif - -/* USE_STDIO_PTR: - * This symbol is defined if the _ptr and _cnt fields (or similar) - * of the stdio FILE structure can be used to access the stdio buffer - * for a file handle. If this is defined, then the FILE_ptr(fp) - * and FILE_cnt(fp) macros will also be defined and should be used - * to access these fields. - */ -/* FILE_ptr: - * This macro is used to access the _ptr field (or equivalent) of the - * FILE structure pointed to by its argument. This macro will always be - * defined if USE_STDIO_PTR is defined. - */ -/* STDIO_PTR_LVALUE: - * This symbol is defined if the FILE_ptr macro can be used as an - * lvalue. - */ -/* FILE_cnt: - * This macro is used to access the _cnt field (or equivalent) of the - * FILE structure pointed to by its argument. This macro will always be - * defined if USE_STDIO_PTR is defined. - */ -/* STDIO_CNT_LVALUE: - * This symbol is defined if the FILE_cnt macro can be used as an - * lvalue. - */ -#$d_stdstdio USE_STDIO_PTR /**/ -#ifdef USE_STDIO_PTR -#define FILE_ptr(fp) $stdio_ptr -#$d_stdio_ptr_lval STDIO_PTR_LVALUE /**/ -#define FILE_cnt(fp) $stdio_cnt -#$d_stdio_cnt_lval STDIO_CNT_LVALUE /**/ -#endif - -/* USE_STDIO_BASE: - * This symbol is defined if the _base field (or similar) of the - * stdio FILE structure can be used to access the stdio buffer for - * a file handle. If this is defined, then the FILE_base(fp) macro - * will also be defined and should be used to access this field. - * Also, the FILE_bufsiz(fp) macro will be defined and should be used - * to determine the number of bytes in the buffer. USE_STDIO_BASE - * will never be defined unless USE_STDIO_PTR is. - */ -/* FILE_base: - * This macro is used to access the _base field (or equivalent) of the - * FILE structure pointed to by its argument. This macro will always be - * defined if USE_STDIO_BASE is defined. - */ -/* FILE_bufsiz: - * This macro is used to determine the number of bytes in the I/O - * buffer pointed to by _base field (or equivalent) of the FILE - * structure pointed to its argument. This macro will always be defined - * if USE_STDIO_BASE is defined. - */ -#$d_stdiobase USE_STDIO_BASE /**/ -#ifdef USE_STDIO_BASE -#define FILE_base(fp) $stdio_base -#define FILE_bufsiz(fp) $stdio_bufsiz -#endif - -/* HAS_VPRINTF: - * This symbol, if defined, indicates that the vprintf routine is available - * to printf with a pointer to an argument list. If unavailable, you - * may need to write your own, probably in terms of _doprnt(). - */ -/* USE_CHAR_VSPRINTF: - * This symbol is defined if this system has vsprintf() returning type - * (char*). The trend seems to be to declare it as "int vsprintf()". It - * is up to the package author to declare vsprintf correctly based on the - * symbol. - */ -#$d_vprintf HAS_VPRINTF /**/ -#$d_charvspr USE_CHAR_VSPRINTF /**/ - -/* DOUBLESIZE: - * This symbol contains the size of a double, so that the C preprocessor - * can make decisions based on it. - */ -#define DOUBLESIZE $doublesize /**/ - -/* I_TIME: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -/* I_SYS_TIME: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -/* I_SYS_TIME_KERNEL: - * This symbol, if defined, indicates to the C program that it should - * include with KERNEL defined. - */ -#$i_time I_TIME /**/ -#$i_systime I_SYS_TIME /**/ -#$i_systimek I_SYS_TIME_KERNEL /**/ - -/* VAL_O_NONBLOCK: - * This symbol is to be used during open() or fcntl(F_SETFL) to turn on - * non-blocking I/O for the file descriptor. Note that there is no way - * back, i.e. you cannot turn it blocking again this way. If you wish to - * alternatively switch between blocking and non-blocking, use the - * ioctl(FIOSNBIO) call instead, but that is not supported by all devices. - */ -/* VAL_EAGAIN: - * This symbol holds the errno error code set by read() when no data was - * present on the non-blocking file descriptor. - */ -/* RD_NODATA: - * This symbol holds the return code from read() when no data is present - * on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is - * not defined, then you can't distinguish between no data and EOF by - * issuing a read(). You'll have to find another way to tell for sure! - */ -/* EOF_NONBLOCK: - * This symbol, if defined, indicates to the C program that a read() on - * a non-blocking file descriptor will return 0 on EOF, and not the value - * held in RD_NODATA (-1 usually, in that case!). - */ -#define VAL_O_NONBLOCK $o_nonblock -#define VAL_EAGAIN $eagain -#define RD_NODATA $rd_nodata -#$d_eofnblk EOF_NONBLOCK - -/* PTRSIZE: - * This symbol contains the size of a pointer, so that the C preprocessor - * can make decisions based on it. It will be sizeof(void *) if - * the compiler supports (void *); otherwise it will be - * sizeof(char *). - */ -#define PTRSIZE $ptrsize /**/ - -/* Drand01: - * This macro is to be used to generate uniformly distributed - * random numbers over the range [0., 1.[. You may have to supply - * an 'extern double drand48();' in your program since SunOS 4.1.3 - * doesn't provide you with anything relevant in it's headers. - * See HAS_DRAND48_PROTO. - */ -/* Rand_seed_t: - * This symbol defines the type of the argument of the - * random seed function. - */ -/* seedDrand01: - * This symbol defines the macro to be used in seeding the - * random number generator (see Drand01). - */ -/* RANDBITS: - * This symbol indicates how many bits are produced by the - * function used to generate normalized random numbers. - * Values include 15, 16, 31, and 48. - */ -#define Drand01() $drand01 /**/ -#define Rand_seed_t $randseedtype /**/ -#define seedDrand01(x) $seedfunc((Rand_seed_t)x) /**/ -#define RANDBITS $randbits /**/ - -/* SSize_t: - * This symbol holds the type used by functions that return - * a count of bytes or an error condition. It must be a signed type. - * It is usually ssize_t, but may be long or int, etc. - * It may be necessary to include or - * to get any typedef'ed information. - * We will pick a type such that sizeof(SSize_t) == sizeof(Size_t). - */ -#define SSize_t $ssizetype /* signed count of bytes */ - -/* EBCDIC: - * This symbol, if defined, indicates that this system uses - * EBCDIC encoding. - */ -#$ebcdic EBCDIC /**/ - -/* ARCHLIB: - * This variable, if defined, holds the name of the directory in - * which the user wants to put architecture-dependent public - * library files for $package. It is most often a local directory - * such as /usr/local/lib. Programs using this variable must be - * prepared to deal with filename expansion. If ARCHLIB is the - * same as PRIVLIB, it is not defined, since presumably the - * program already searches PRIVLIB. - */ -/* ARCHLIB_EXP: - * This symbol contains the ~name expanded version of ARCHLIB, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -#$d_archlib ARCHLIB "$archlib" /**/ -#$d_archlib ARCHLIB_EXP "$archlibexp" /**/ - -/* BIN: - * This symbol holds the path of the bin directory where the package will - * be installed. Program must be prepared to deal with ~name substitution. - */ -/* BIN_EXP: - * This symbol is the filename expanded version of the BIN symbol, for - * programs that do not want to deal with that at run-time. - */ -#define BIN "$bin" /**/ -#define BIN_EXP "$binexp" /**/ - -/* INSTALL_USR_BIN_PERL: - * This symbol, if defined, indicates that Perl is to be installed - * also as /usr/bin/perl. - */ -#$installusrbinperl INSTALL_USR_BIN_PERL /**/ - -/* PRIVLIB: - * This symbol contains the name of the private library for this package. - * The library is private in the sense that it needn't be in anyone's - * execution path, but it should be accessible by the world. The program - * should be prepared to do ~ expansion. - */ -/* PRIVLIB_EXP: - * This symbol contains the ~name expanded version of PRIVLIB, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -#define PRIVLIB "$privlib" /**/ -#define PRIVLIB_EXP "$privlibexp" /**/ - -/* SITEARCH: - * This symbol contains the name of the private library for this package. - * The library is private in the sense that it needn't be in anyone's - * execution path, but it should be accessible by the world. The program - * should be prepared to do ~ expansion. - * The standard distribution will put nothing in this directory. - * Individual sites may place their own extensions and modules in - * this directory. - */ -/* SITEARCH_EXP: - * This symbol contains the ~name expanded version of SITEARCH, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -#define SITEARCH "$sitearch" /**/ -#define SITEARCH_EXP "$sitearchexp" /**/ - -/* SITELIB: - * This symbol contains the name of the private library for this package. - * The library is private in the sense that it needn't be in anyone's - * execution path, but it should be accessible by the world. The program - * should be prepared to do ~ expansion. - * The standard distribution will put nothing in this directory. - * Individual sites may place their own extensions and modules in - * this directory. - */ -/* SITELIB_EXP: - * This symbol contains the ~name expanded version of SITELIB, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -#define SITELIB "$sitelib" /**/ -#define SITELIB_EXP "$sitelibexp" /**/ - -/* PERL_VENDORLIB_EXP: - * This symbol contains the ~name expanded version of VENDORLIB, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -#$d_vendorlib PERL_VENDORLIB_EXP "$vendorlibexp" /**/ - -/* OSNAME: - * This symbol contains the name of the operating system, as determined - * by Configure. You shouldn't rely on it too much; the specific - * feature tests from Configure are generally more reliable. - */ -#define OSNAME "$osname" /**/ - -/* CAT2: - * This macro catenates 2 tokens together. - */ -/* STRINGIFY: - * This macro surrounds its token with double quotes. - */ -#if $cpp_stuff == 1 -#define CAT2(a,b)a/**/b -#define STRINGIFY(a)"a" - /* If you can get stringification with catify, tell me how! */ -#endif -#if $cpp_stuff == 42 -#define CAT2(a,b)a ## b -#define StGiFy(a)# a -#define STRINGIFY(a)StGiFy(a) -#endif -#if $cpp_stuff != 1 && $cpp_stuff != 42 -#include "Bletch: How does this C preprocessor catenate tokens?" -#endif - -/* CPPSTDIN: - * This symbol contains the first part of the string which will invoke - * the C preprocessor on the standard input and produce to standard - * output. Typical value of "cc -E" or "/lib/cpp", but it can also - * call a wrapper. See CPPRUN. - */ -/* CPPMINUS: - * This symbol contains the second part of the string which will invoke - * the C preprocessor on the standard input and produce to standard - * output. This symbol will have the value "-" if CPPSTDIN needs a minus - * to specify standard input, otherwise the value is "". - */ -/* CPPRUN: - * This symbol contains the string which will invoke a C preprocessor on - * the standard input and produce to standard output. It needs to end - * with CPPLAST, after all other preprocessor flags have been specified. - * The main difference with CPPSTDIN is that this program will never be a - * pointer to a shell wrapper, i.e. it will be empty if no preprocessor is - * available directly to the user. Note that it may well be different from - * the preprocessor used to compile the C program. - */ -/* CPPLAST: - * This symbol is intended to be used along with CPPRUN in the same manner - * symbol CPPMINUS is used with CPPSTDIN. It contains either "-" or "". - */ -#define CPPSTDIN "$cppstdin" -#define CPPMINUS "$cppminus" -#define CPPRUN "$cpprun" -#define CPPLAST "$cpplast" - -/* HAS_ACCESS: - * This manifest constant lets the C program know that the access() - * system call is available to check for accessibility using real UID/GID. - * (always present on UNIX.) - */ -#$d_access HAS_ACCESS /**/ - -/* HAS_CSH: - * This symbol, if defined, indicates that the C-shell exists. - */ -/* CSH: - * This symbol, if defined, contains the full pathname of csh. - */ -#$d_csh HAS_CSH /**/ -#ifdef HAS_CSH -#define CSH "$full_csh" /**/ -#endif - -/* HAS_ENDGRENT: - * This symbol, if defined, indicates that the getgrent routine is - * available for finalizing sequential access of the group database. - */ -#$d_endgrent HAS_ENDGRENT /**/ - -/* HAS_ENDHOSTENT: - * This symbol, if defined, indicates that the endhostent() routine is - * available to close whatever was being used for host queries. - */ -#$d_endhent HAS_ENDHOSTENT /**/ - -/* HAS_ENDNETENT: - * This symbol, if defined, indicates that the endnetent() routine is - * available to close whatever was being used for network queries. - */ -#$d_endnent HAS_ENDNETENT /**/ - -/* HAS_ENDPROTOENT: - * This symbol, if defined, indicates that the endprotoent() routine is - * available to close whatever was being used for protocol queries. - */ -#$d_endpent HAS_ENDPROTOENT /**/ - -/* HAS_ENDPWENT: - * This symbol, if defined, indicates that the getgrent routine is - * available for finalizing sequential access of the passwd database. - */ -#$d_endpwent HAS_ENDPWENT /**/ - -/* HAS_ENDSERVENT: - * This symbol, if defined, indicates that the endservent() routine is - * available to close whatever was being used for service queries. - */ -#$d_endsent HAS_ENDSERVENT /**/ - /* HAS_GETGRENT: * This symbol, if defined, indicates that the getgrent routine is * available for sequential access of the group database. @@ -1660,11 +1420,6 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- * so that it is safe even if used by a process with super-user * privileges. */ -/* HAS_PHOSTNAME: - * This symbol, if defined, indicates that the C program may use the - * contents of PHOSTNAME as a command to feed to the popen() routine - * to derive the host name. - */ #$d_gethname HAS_GETHOSTNAME /**/ #$d_uname HAS_UNAME /**/ #$d_phostname HAS_PHOSTNAME @@ -1672,6 +1427,26 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #define PHOSTNAME "$aphostname" /* How to get the host name */ #endif +/* HAS_GETHOST_PROTOS: + * This symbol, if defined, indicates that includes + * prototypes for gethostent(), gethostbyname(), and + * gethostbyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +#$d_gethostprotos HAS_GETHOST_PROTOS /**/ + +/* HAS_GETMNT: + * This symbol, if defined, indicates that the getmnt routine is + * available to get filesystem mount info by filename. + */ +#$d_getmnt HAS_GETMNT /**/ + +/* HAS_GETMNTENT: + * This symbol, if defined, indicates that the getmntent routine is + * available to iterate through mounted file systems to get their info. + */ +#$d_getmntent HAS_GETMNTENT /**/ + /* HAS_GETNETBYADDR: * This symbol, if defined, indicates that the getnetbyaddr() routine is * available to look up networks by their IP addresses. @@ -1690,6 +1465,14 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_getnent HAS_GETNETENT /**/ +/* HAS_GETNET_PROTOS: + * This symbol, if defined, indicates that includes + * prototypes for getnetent(), getnetbyname(), and + * getnetbyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +#$d_getnetprotos HAS_GETNET_PROTOS /**/ + /* HAS_GETPROTOENT: * This symbol, if defined, indicates that the getprotoent() routine is * available to look up protocols in some data base or another. @@ -1707,6 +1490,14 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #$d_getpbyname HAS_GETPROTOBYNAME /**/ #$d_getpbynumber HAS_GETPROTOBYNUMBER /**/ +/* HAS_GETPROTO_PROTOS: + * This symbol, if defined, indicates that includes + * prototypes for getprotoent(), getprotobyname(), and + * getprotobyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +#$d_getprotoprotos HAS_GETPROTO_PROTOS /**/ + /* HAS_GETPWENT: * This symbol, if defined, indicates that the getpwent routine is * available for sequential access of the passwd database. @@ -1720,6 +1511,26 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_getsent HAS_GETSERVENT /**/ +/* HAS_GETSERV_PROTOS: + * This symbol, if defined, indicates that includes + * prototypes for getservent(), getservbyname(), and + * getservbyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +#$d_getservprotos HAS_GETSERV_PROTOS /**/ + +/* HAS_GETSPENT: + * This symbol, if defined, indicates that the getspent system call is + * available to retrieve SysV shadow password entries sequentially. + */ +#$d_getspent HAS_GETSPENT /**/ + +/* HAS_GETSPNAM: + * This symbol, if defined, indicates that the getspnam system call is + * available to retrieve SysV shadow password entries by name. + */ +#$d_getspnam HAS_GETSPNAM /**/ + /* HAS_GETSERVBYNAME: * This symbol, if defined, indicates that the getservbyname() * routine is available to look up services by their name. @@ -1731,6 +1542,17 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #$d_getsbyname HAS_GETSERVBYNAME /**/ #$d_getsbyport HAS_GETSERVBYPORT /**/ +/* HAS_GNULIBC: + * This symbol, if defined, indicates to the C program that + * the GNU C library is being used. + */ +#$d_gnulibc HAS_GNULIBC /**/ +/* HAS_HASMNTOPT: + * This symbol, if defined, indicates that the hasmntopt routine is + * available to query the mount options of file systems. + */ +#$d_hasmntopt HAS_HASMNTOPT /**/ + /* HAS_HTONL: * This symbol, if defined, indicates that the htonl() routine (and * friends htons() ntohl() ntohs()) are available to do network @@ -1756,6 +1578,27 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #$d_htonl HAS_NTOHL /**/ #$d_htonl HAS_NTOHS /**/ +/* HAS_ISASCII: + * This manifest constant lets the C program know that isascii + * is available. + */ +#$d_isascii HAS_ISASCII /**/ + +/* HAS_LCHOWN: + * This symbol, if defined, indicates that the lchown routine is + * available to operate on a symbolic link (instead of following the + * link). + */ +#$d_lchown HAS_LCHOWN /**/ + +/* HAS_LDBL_DIG: + * This symbol, if defined, indicates that this system's + * or defines the symbol LDBL_DIG, which is the number + * of significant digits in a long double precision number. Unlike + * for DBL_DIG, there's no good guess for LDBL_DIG if it is undefined. + */ +#$d_ldbl_dig HAS_LDBL_DIG /* */ + /* HAS_LONG_DOUBLE: * This symbol will be defined if the C compiler supports long * doubles. @@ -1789,23 +1632,69 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_memchr HAS_MEMCHR /**/ -/* HAS_MMAP: - * This symbol, if defined, indicates that the mmap system call is - * available to map a file into memory. +/* HAS_MSG: + * This symbol, if defined, indicates that the entire msg*(2) library is + * supported (IPC mechanism based on message queues). + */ +#$d_msg HAS_MSG /**/ + +/* HAS_OPEN3: + * This manifest constant lets the C program know that the three + * argument form of open(2) is available. + */ +#$d_open3 HAS_OPEN3 /**/ + +/* OLD_PTHREAD_CREATE_JOINABLE: + * This symbol, if defined, indicates how to create pthread + * in joinable (aka undetached) state. NOTE: not defined + * if pthread.h already has defined PTHREAD_CREATE_JOINABLE + * (the new version of the constant). + * If defined, known values are PTHREAD_CREATE_UNDETACHED + * and __UNDETACHED. + */ +#$d_old_pthread_create_joinable OLD_PTHREAD_CREATE_JOINABLE $old_pthread_create_joinable /**/ + +/* HAS_PTHREAD_YIELD: + * This symbol, if defined, indicates that the pthread_yield + * routine is available to yield the execution of the current + * thread. sched_yield is preferable to pthread_yield. + */ +/* SCHED_YIELD: + * This symbol defines the way to yield the execution of + * the current thread. Known ways are sched_yield, + * pthread_yield, and pthread_yield with NULL. + */ +/* HAS_SCHED_YIELD: + * This symbol, if defined, indicates that the sched_yield + * routine is available to yield the execution of the current + * thread. sched_yield is preferable to pthread_yield. + */ +#$d_pthread_yield HAS_PTHREAD_YIELD /**/ +#define SCHED_YIELD $sched_yield /**/ +#$d_sched_yield HAS_SCHED_YIELD /**/ + +/* HAS_SAFE_BCOPY: + * This symbol, if defined, indicates that the bcopy routine is available + * to copy potentially overlapping memory blocks. Otherwise you should + * probably use memmove() or memcpy(). If neither is defined, roll your + * own version. */ -/* Mmap_t: - * This symbol holds the return type of the mmap() system call - * (and simultaneously the type of the first argument). - * Usually set to 'void *' or 'cadd_t'. +#$d_safebcpy HAS_SAFE_BCOPY /**/ + +/* HAS_SAFE_MEMCPY: + * This symbol, if defined, indicates that the memcpy routine is available + * to copy potentially overlapping memory blocks. Otherwise you should + * probably use memmove() or memcpy(). If neither is defined, roll your + * own version. */ -#$d_mmap HAS_MMAP /**/ -#define Mmap_t $mmaptype /**/ +#$d_safemcpy HAS_SAFE_MEMCPY /**/ -/* HAS_MSG: - * This symbol, if defined, indicates that the entire msg*(2) library is - * supported (IPC mechanism based on message queues). +/* HAS_SANE_MEMCMP: + * This symbol, if defined, indicates that the memcmp routine is available + * and can be used to compare relative magnitudes of chars with their high + * bits set. If it is not defined, roll your own version. */ -#$d_msg HAS_MSG /**/ +#$d_sanemcmp HAS_SANE_MEMCMP /**/ /* HAS_SEM: * This symbol, if defined, indicates that the entire sem*(2) library is @@ -1856,6 +1745,12 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_setsent HAS_SETSERVENT /**/ +/* HAS_SETSPENT: + * This symbol, if defined, indicates that the setspent system call is + * available to initialize the scan of SysV shadow password entries. + */ +#$d_setspent HAS_SETSPENT /**/ + /* HAS_SETVBUF: * This symbol, if defined, indicates that the setvbuf routine is * available to change buffering on an open stdio stream. @@ -1863,12 +1758,55 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_setvbuf HAS_SETVBUF /**/ +/* USE_SFIO: + * This symbol, if defined, indicates that sfio should + * be used. + */ +#$d_sfio USE_SFIO /**/ + /* HAS_SHM: * This symbol, if defined, indicates that the entire shm*(2) library is * supported. */ #$d_shm HAS_SHM /**/ +/* HAS_SIGACTION: + * This symbol, if defined, indicates that Vr4's sigaction() routine + * is available. + */ +#$d_sigaction HAS_SIGACTION /**/ + +/* HAS_SIGSETJMP: + * This variable indicates to the C program that the sigsetjmp() + * routine is available to save the calling process's registers + * and stack environment for later use by siglongjmp(), and + * to optionally save the process's signal mask. See + * Sigjmp_buf, Sigsetjmp, and Siglongjmp. + */ +/* Sigjmp_buf: + * This is the buffer type to be used with Sigsetjmp and Siglongjmp. + */ +/* Sigsetjmp: + * This macro is used in the same way as sigsetjmp(), but will invoke + * traditional setjmp() if sigsetjmp isn't available. + * See HAS_SIGSETJMP. + */ +/* Siglongjmp: + * This macro is used in the same way as siglongjmp(), but will invoke + * traditional longjmp() if siglongjmp isn't available. + * See HAS_SIGSETJMP. + */ +#$d_sigsetjmp HAS_SIGSETJMP /**/ +#ifdef HAS_SIGSETJMP +#define Sigjmp_buf sigjmp_buf +#define Sigsetjmp(buf,save_mask) sigsetjmp((buf),(save_mask)) +#define Siglongjmp(buf,retval) siglongjmp((buf),(retval)) +#else +#define Sigjmp_buf jmp_buf +#define Sigsetjmp(buf,save_mask) setjmp((buf)) +#define Siglongjmp(buf,retval) longjmp((buf),(retval)) +#endif + /* HAS_SOCKET: * This symbol, if defined, indicates that the BSD socket interface is * supported. @@ -1907,26 +1845,6 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- * Checking just with #ifdef might not be enough because this symbol * has been known to be an enum. */ -/* HAS_SENDMSG: - * This symbol, if defined, indicates that the sendmsg is supported - * to send messages between sockets. You will also need struct - * iovec from , HAS_STRUCT_IOVEC and I_SYSUIO. - */ -/* HAS_RECVMSG: - * This symbol, if defined, indicates that the recvmsg is supported - * to send messages between sockets. You will also need struct - * iovec from , HAS_STRUCT_IOVEC and I_SYSUIO. - */ -/* HAS_STRUCT_MSGHDR: - * This symbol, if defined, indicates that the struct msghdr - * (BSD 4.3 or 4.4) is supported. You will also need struct - * iovec from , HAS_STRUCT_IOVEC and I_SYSUIO. - */ -/* HAS_STRUCT_CMSGHDR: - * This symbol, if defined, indicates that the struct cmsghdr - * (BSD 4.4) is supported. You will also need struct - * iovec from , HAS_STRUCT_IOVEC and I_SYSUIO. - */ #$d_socket HAS_SOCKET /**/ #$d_sockpair HAS_SOCKETPAIR /**/ #$d_msg_ctrunc HAS_MSG_CTRUNC /**/ @@ -1935,16 +1853,102 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #$d_msg_peek HAS_MSG_PEEK /**/ #$d_msg_proxy HAS_MSG_PROXY /**/ #$d_scm_rights HAS_SCM_RIGHTS /**/ -#$d_sendmsg HAS_SENDMSG /**/ -#$d_recvmsg HAS_RECVMSG /**/ -#$d_msghdr_s HAS_STRUCT_MSGHDR /**/ -#$d_cmsghdr_s HAS_STRUCT_CMSGHDR /**/ + +/* HAS_SQRTL: + * This symbol, if defined, indicates that the sqrtl routine is + * available to do long double square roots. + */ +#$d_sqrtl HAS_SQRTL /**/ /* USE_STAT_BLOCKS: * This symbol is defined if this system has a stat structure declaring * st_blksize and st_blocks. */ +#ifndef USE_STAT_BLOCKS #$d_statblks USE_STAT_BLOCKS /**/ +#endif + +/* HAS_STRUCT_STATFS_F_FLAGS: + * This symbol, if defined, indicates that the struct statfs + * does have the f_flags member containing the mount flags of + * the filesystem containing the file. + * This kind of struct statfs is coming from (BSD 4.3), + * not from (SYSV). Older BSDs (like Ultrix) do not + * have statfs() and struct statfs, they have ustat() and getmnt() + * with struct ustat and struct fs_data. + */ +#$d_statfs_f_flags HAS_STRUCT_STATFS_F_FLAGS /**/ + +/* HAS_STRUCT_STATFS: + * This symbol, if defined, indicates that the struct statfs + * to do statfs() is supported. + */ +#$d_statfs_s HAS_STRUCT_STATFS /**/ + +/* HAS_FSTATVFS: + * This symbol, if defined, indicates that the fstatvfs routine is + * available to stat filesystems by file descriptors. + */ +#$d_fstatvfs HAS_FSTATVFS /**/ + +/* USE_STDIO_PTR: + * This symbol is defined if the _ptr and _cnt fields (or similar) + * of the stdio FILE structure can be used to access the stdio buffer + * for a file handle. If this is defined, then the FILE_ptr(fp) + * and FILE_cnt(fp) macros will also be defined and should be used + * to access these fields. + */ +/* FILE_ptr: + * This macro is used to access the _ptr field (or equivalent) of the + * FILE structure pointed to by its argument. This macro will always be + * defined if USE_STDIO_PTR is defined. + */ +/* STDIO_PTR_LVALUE: + * This symbol is defined if the FILE_ptr macro can be used as an + * lvalue. + */ +/* FILE_cnt: + * This macro is used to access the _cnt field (or equivalent) of the + * FILE structure pointed to by its argument. This macro will always be + * defined if USE_STDIO_PTR is defined. + */ +/* STDIO_CNT_LVALUE: + * This symbol is defined if the FILE_cnt macro can be used as an + * lvalue. + */ +#$d_stdstdio USE_STDIO_PTR /**/ +#ifdef USE_STDIO_PTR +#define FILE_ptr(fp) $stdio_ptr +#$d_stdio_ptr_lval STDIO_PTR_LVALUE /**/ +#define FILE_cnt(fp) $stdio_cnt +#$d_stdio_cnt_lval STDIO_CNT_LVALUE /**/ +#endif + +/* USE_STDIO_BASE: + * This symbol is defined if the _base field (or similar) of the + * stdio FILE structure can be used to access the stdio buffer for + * a file handle. If this is defined, then the FILE_base(fp) macro + * will also be defined and should be used to access this field. + * Also, the FILE_bufsiz(fp) macro will be defined and should be used + * to determine the number of bytes in the buffer. USE_STDIO_BASE + * will never be defined unless USE_STDIO_PTR is. + */ +/* FILE_base: + * This macro is used to access the _base field (or equivalent) of the + * FILE structure pointed to by its argument. This macro will always be + * defined if USE_STDIO_BASE is defined. + */ +/* FILE_bufsiz: + * This macro is used to determine the number of bytes in the I/O + * buffer pointed to by _base field (or equivalent) of the FILE + * structure pointed to its argument. This macro will always be defined + * if USE_STDIO_BASE is defined. + */ +#$d_stdiobase USE_STDIO_BASE /**/ +#ifdef USE_STDIO_BASE +#define FILE_base(fp) $stdio_base +#define FILE_bufsiz(fp) $stdio_bufsiz +#endif /* HAS_STRERROR: * This symbol, if defined, indicates that the strerror routine is @@ -1965,6 +1969,52 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #$d_syserrlst HAS_SYS_ERRLIST /**/ #define Strerror(e) $d_strerrm +/* HAS_STRTOLD: + * This symbol, if defined, indicates that the strtold routine is + * available to convert strings to long doubles. + */ +#$d_strtold HAS_STRTOLD /**/ + +/* HAS_STRTOLL: + * This symbol, if defined, indicates that the strtoll routine is + * available to convert strings to long longs. + */ +#$d_strtoll HAS_STRTOLL /**/ + +/* HAS_STRTOULL: + * This symbol, if defined, indicates that the strtoull routine is + * available to convert strings to unsigned long longs. + */ +#$d_strtoull HAS_STRTOULL /**/ + +/* HAS_STRTOUQ: + * This symbol, if defined, indicates that the strtouq routine is + * available to convert strings to unsigned long longs (quads). + */ +#$d_strtouq HAS_STRTOUQ /**/ + +/* HAS_TELLDIR_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the telldir() function. Otherwise, it is up + * to the program to supply one. A good guess is + * extern long telldir _((DIR*)); + */ +#$d_telldirproto HAS_TELLDIR_PROTO /**/ + +/* Time_t: + * This symbol holds the type returned by time(). It can be long, + * or time_t on BSD sites (in which case should be + * included). + */ +#define Time_t $timetype /* Time type */ + +/* HAS_TIMES: + * This symbol, if defined, indicates that the times() routine exists. + * Note that this became obsolete on some systems (SUNOS), which now + * use getrusage(). It may be necessary to include . + */ +#$d_times HAS_TIMES /**/ + /* HAS_UNION_SEMUN: * This symbol, if defined, indicates that the union semun is * defined by including . If not, the user code @@ -1987,6 +2037,12 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #$d_semctl_semun USE_SEMCTL_SEMUN /**/ #$d_semctl_semid_ds USE_SEMCTL_SEMID_DS /**/ +/* HAS_USTAT: + * This symbol, if defined, indicates that the ustat system call is + * available to query file system statistics by dev_t. + */ +#$d_ustat HAS_USTAT /**/ + /* HAS_VFORK: * This symbol, if defined, indicates that vfork() exists. */ @@ -2000,6 +2056,78 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #define Signal_t $signal_t /* Signal handler's return type */ +/* HAS_VPRINTF: + * This symbol, if defined, indicates that the vprintf routine is available + * to printf with a pointer to an argument list. If unavailable, you + * may need to write your own, probably in terms of _doprnt(). + */ +/* USE_CHAR_VSPRINTF: + * This symbol is defined if this system has vsprintf() returning type + * (char*). The trend seems to be to declare it as "int vsprintf()". It + * is up to the package author to declare vsprintf correctly based on the + * symbol. + */ +#$d_vprintf HAS_VPRINTF /**/ +#$d_charvspr USE_CHAR_VSPRINTF /**/ + +/* USE_DYNAMIC_LOADING: + * This symbol, if defined, indicates that dynamic loading of + * some sort is available. + */ +#$usedl USE_DYNAMIC_LOADING /**/ + +/* DOUBLESIZE: + * This symbol contains the size of a double, so that the C preprocessor + * can make decisions based on it. + */ +#define DOUBLESIZE $doublesize /**/ + +/* EBCDIC: + * This symbol, if defined, indicates that this system uses + * EBCDIC encoding. + */ +#$ebcdic EBCDIC /**/ + +/* FFLUSH_NULL: + * This symbol, if defined, tells that fflush(NULL) does flush + * all pending stdio output. + */ +/* FFLUSH_ALL: + * This symbol, if defined, tells that to flush + * all pending stdio output one must loop through all + * the stdio file handles stored in an array and fflush them. + * Note that if fflushNULL is defined, fflushall will not + * even be probed for and will be left undefined. + */ +#$fflushNULL FFLUSH_NULL /**/ +#$fflushall FFLUSH_ALL /**/ + +/* Fpos_t: + * This symbol holds the type used to declare file positions in libc. + * It can be fpos_t, long, uint, etc... It may be necessary to include + * to get any typedef'ed information. + */ +#define Fpos_t $fpostype /* File position type */ + +/* Gid_t_f: + * This symbol defines the format string used for printing a Gid_t. + */ +#define Gid_t_f $gidformat /**/ + +/* Gid_t_size: + * This symbol holds the size of a Gid_t in bytes. + */ +#define Gid_t_size $gidsize /* GID size */ + +/* Gid_t: + * This symbol holds the return type of getgid() and the type of + * argument to setrgid() and related functions. Typically, + * it is the type of group ids in the kernel. It can be int, ushort, + * uid_t, etc... It may be necessary to include to get + * any typedef'ed information. + */ +#define Gid_t $gidtype /* Type for getgid(), etc... */ + /* Groups_t: * This symbol holds the type used for the second argument to * getgroups() and setgropus(). Usually, this is the same as @@ -2009,9 +2137,22 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- * typedef'ed information. This is only required if you have * getgroups() or setgropus().. */ -#if defined(HAS_GETGROUPS) || defined(HAS_SETGROUPS) -#define Groups_t $groupstype /* Type for 2nd arg to [sg]etgroups() */ -#endif +#if defined(HAS_GETGROUPS) || defined(HAS_SETGROUPS) +#define Groups_t $groupstype /* Type for 2nd arg to [sg]etgroups() */ +#endif + +/* DB_Prefix_t: + * This symbol contains the type of the prefix structure element + * in the header file. In older versions of DB, it was + * int, while in newer ones it is u_int32_t. + */ +/* DB_Hash_t: + * This symbol contains the type of the prefix structure element + * in the header file. In older versions of DB, it was + * int, while in newer ones it is size_t. + */ +#define DB_Hash_t $db_hashtype /**/ +#define DB_Prefix_t $db_prefixtype /**/ /* I_GRP: * This symbol, if defined, indicates to the C program that it should @@ -2024,12 +2165,48 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #$i_grp I_GRP /**/ #$d_grpasswd GRPASSWD /**/ +/* I_INTTYPES: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +#$i_inttypes I_INTTYPES /**/ + +/* I_MACH_CTHREADS: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +#$i_machcthr I_MACH_CTHREADS /**/ + +/* I_MNTENT: + * This symbol, if defined, indicates that exists and + * should be included. + */ +#$i_mntent I_MNTENT /**/ + /* I_NETDB: * This symbol, if defined, indicates that exists and * should be included. */ #$i_netdb I_NETDB /**/ +/* I_NETINET_TCP: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +#$i_netinettcp I_NETINET_TCP /**/ + +/* I_POLL: + * This symbol, if defined, indicates that exists and + * should be included. + */ +#$i_poll I_POLL /**/ + +/* I_PTHREAD: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +#$i_pthread I_PTHREAD /**/ + /* I_PWD: * This symbol, if defined, indicates to the C program that it should * include . @@ -2076,16 +2253,112 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #$d_pwgecos PWGECOS /**/ #$d_pwpasswd PWPASSWD /**/ +/* I_SHADOW: + * This symbol, if defined, indicates that exists and + * should be included. + */ +#$i_shadow I_SHADOW /**/ + +/* I_SOCKS: + * This symbol, if defined, indicates that exists and + * should be included. + */ +#$i_socks I_SOCKS /**/ + +/* I_SYS_MOUNT: + * This symbol, if defined, indicates that exists and + * should be included. + */ +#$i_sysmount I_SYS_MOUNT /**/ + +/* I_SYS_STATFS: + * This symbol, if defined, indicates that exists. + */ +#$i_sysstatfs I_SYS_STATFS /**/ + +/* I_SYS_STATVFS: + * This symbol, if defined, indicates that exists and + * should be included. + */ +#$i_sysstatvfs I_SYS_STATVFS /**/ + /* I_SYSUIO: * This symbol, if defined, indicates that exists and * should be included. */ -/* HAS_STRUCT_IOVEC: - * This symbol, if defined, indicates that the struct iovec - * to do scatter writes/gather reads is supported. - */ #$i_sysuio I_SYSUIO /**/ -#$d_iovec_s HAS_STRUCT_IOVEC /**/ + +/* I_SYS_VFS: + * This symbol, if defined, indicates that exists and + * should be included. + */ +#$i_sysvfs I_SYS_VFS /**/ + +/* I_TIME: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +/* I_SYS_TIME: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +/* I_SYS_TIME_KERNEL: + * This symbol, if defined, indicates to the C program that it should + * include with KERNEL defined. + */ +#$i_time I_TIME /**/ +#$i_systime I_SYS_TIME /**/ +#$i_systimek I_SYS_TIME_KERNEL /**/ + +/* I_USTAT: + * This symbol, if defined, indicates that exists and + * should be included. + */ +#$i_ustat I_USTAT /**/ + +/* PERL_INC_VERSION_LIST: + * This variable specifies the list of subdirectories in over + * which perl.c:incpush() and lib/lib.pm will automatically + * search when adding directories to @INC, in a format suitable + * for a C initialization string. See the inc_version_list entry + * in Porting/Glossary for more details. + */ +#define PERL_INC_VERSION_LIST $inc_version_list /**/ + +/* HAS_OFF64_T: + * This symbol will be defined if the C compiler supports off64_t. + */ +/* HAS_FPOS64_T: + * This symbol will be defined if the C compiler supports fpos64_t. + */ +#$d_off64_t HAS_OFF64_T /**/ +#$d_fpos64_t HAS_FPOS64_T /**/ + +/* PERL_PRIfldbl: + * This symbol, if defined, contains the string used by stdio to + * format long doubles (format 'f') for output. + */ +/* PERL_PRIgldbl: + * This symbol, if defined, contains the string used by stdio to + * format long doubles (format 'g') for output. + */ +#$d_PRIfldbl PERL_PRIfldbl $sPRIfldbl /**/ +#$d_PRIgldbl PERL_PRIgldbl $sPRIgldbl /**/ + +/* Off_t: + * This symbol holds the type used to declare offsets in the kernel. + * It can be int, long, off_t, etc... It may be necessary to include + * to get any typedef'ed information. + */ +/* LSEEKSIZE: + * This symbol holds the number of bytes used by the Off_t. + */ +/* Off_t_size: + * This symbol holds the number of bytes used by the Off_t. + */ +#define Off_t $lseektype /* type */ +#define LSEEKSIZE $lseeksize /* size */ +#define Off_t_size $lseeksize /* size */ /* Free_t: * This variable contains the return type of free(). It is usually @@ -2102,347 +2375,326 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- */ #$d_mymalloc MYMALLOC /**/ -/* SIG_NAME: - * This symbol contains a list of signal names in order of - * signal number. This is intended - * to be used as a static array initialization, like this: - * char *sig_name[] = { SIG_NAME }; - * The signals in the list are separated with commas, and each signal - * is surrounded by double quotes. There is no leading SIG in the signal - * name, i.e. SIGQUIT is known as "QUIT". - * Gaps in the signal numbers (up to NSIG) are filled in with NUMnn, - * etc., where nn is the actual signal number (e.g. NUM37). - * The signal number for sig_name[i] is stored in sig_num[i]. - * The last element is 0 to terminate the list with a NULL. This - * corresponds to the 0 at the end of the sig_num list. - */ -/* SIG_NUM: - * This symbol contains a list of signal numbers, in the same order as the - * SIG_NAME list. It is suitable for static array initialization, as in: - * int sig_num[] = { SIG_NUM }; - * The signals in the list are separated with commas, and the indices - * within that list and the SIG_NAME list match, so it's easy to compute - * the signal name from a number or vice versa at the price of a small - * dynamic linear lookup. - * Duplicates are allowed, but are moved to the end of the list. - * The signal number corresponding to sig_name[i] is sig_number[i]. - * if (i < NSIG) then sig_number[i] == i. - * The last element is 0, corresponding to the 0 at the end of - * the sig_name list. +/* Mode_t: + * This symbol holds the type used to declare file modes + * for systems calls. It is usually mode_t, but may be + * int or unsigned short. It may be necessary to include + * to get any typedef'ed information. */ -#define SIG_NAME $sig_name_init /**/ -#define SIG_NUM $sig_num_init /**/ +#define Mode_t $modetype /* file mode parameter for system calls */ -/* VOIDFLAGS: - * This symbol indicates how much support of the void type is given by this - * compiler. What various bits mean: - * - * 1 = supports declaration of void - * 2 = supports arrays of pointers to functions returning void - * 4 = supports comparisons between pointers to void functions and - * addresses of void functions - * 8 = suports declaration of generic void pointers - * - * The package designer should define VOIDUSED to indicate the requirements - * of the package. This can be done either by #defining VOIDUSED before - * including config.h, or by defining defvoidused in Myinit.U. If the - * latter approach is taken, only those flags will be tested. If the - * level of void support necessary is not present, defines void to int. +/* VAL_O_NONBLOCK: + * This symbol is to be used during open() or fcntl(F_SETFL) to turn on + * non-blocking I/O for the file descriptor. Note that there is no way + * back, i.e. you cannot turn it blocking again this way. If you wish to + * alternatively switch between blocking and non-blocking, use the + * ioctl(FIOSNBIO) call instead, but that is not supported by all devices. */ -#ifndef VOIDUSED -#define VOIDUSED $defvoidused -#endif -#define VOIDFLAGS $voidflags -#if (VOIDFLAGS & VOIDUSED) != VOIDUSED -#define void int /* is void to be avoided? */ -#define M_VOID /* Xenix strikes again */ -#endif - -/* HAS_ATOLF: - * This symbol, if defined, indicates that the atolf routine is - * available to convert strings into long doubles. +/* VAL_EAGAIN: + * This symbol holds the errno error code set by read() when no data was + * present on the non-blocking file descriptor. */ -#$d_atolf HAS_ATOLF /**/ - -/* HAS_ATOLL: - * This symbol, if defined, indicates that the atoll routine is - * available to convert strings into long longs. +/* RD_NODATA: + * This symbol holds the return code from read() when no data is present + * on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is + * not defined, then you can't distinguish between no data and EOF by + * issuing a read(). You'll have to find another way to tell for sure! */ -#$d_atoll HAS_ATOLL /**/ - -/* PERL_BINCOMPAT_5005: - * This symbol, if defined, indicates that Perl 5.006 should be - * binary-compatible with Perl 5.005. This is impossible for builds - * that use features like threads and multiplicity it is always $undef - * for those versions. +/* EOF_NONBLOCK: + * This symbol, if defined, indicates to the C program that a read() on + * a non-blocking file descriptor will return 0 on EOF, and not the value + * held in RD_NODATA (-1 usually, in that case!). */ -#$d_bincompat5005 PERL_BINCOMPAT_5005 /**/ +#define VAL_O_NONBLOCK $o_nonblock +#define VAL_EAGAIN $eagain +#define RD_NODATA $rd_nodata +#$d_eofnblk EOF_NONBLOCK -/* DLSYM_NEEDS_UNDERSCORE: - * This symbol, if defined, indicates that we need to prepend an - * underscore to the symbol name before calling dlsym(). This only - * makes sense if you *have* dlsym, which we will presume is the - * case if you're using dl_dlopen.xs. +/* Netdb_host_t: + * This symbol holds the type used for the 1st argument + * to gethostbyaddr(). */ -#$d_dlsymun DLSYM_NEEDS_UNDERSCORE /**/ - -/* HAS_ENDSPENT: - * This symbol, if defined, indicates that the endspent system call is - * available to finalize the scan of SysV shadow password entries. +/* Netdb_hlen_t: + * This symbol holds the type used for the 2nd argument + * to gethostbyaddr(). */ -#$d_endspent HAS_ENDSPENT /**/ - -/* HAS_FSEEKO: - * This symbol, if defined, indicates that the fseeko routine is - * available to fseek beyond 32 bits (useful for ILP32 hosts). +/* Netdb_name_t: + * This symbol holds the type used for the argument to + * gethostbyname(). */ -#$d_fseeko HAS_FSEEKO /**/ +/* Netdb_net_t: + * This symbol holds the type used for the 1st argument to + * getnetbyaddr(). + */ +#define Netdb_host_t $netdb_host_type /**/ +#define Netdb_hlen_t $netdb_hlen_type /**/ +#define Netdb_name_t $netdb_name_type /**/ +#define Netdb_net_t $netdb_net_type /**/ -/* HAS_FTELLO: - * This symbol, if defined, indicates that the ftello routine is - * available to ftell beyond 32 bits (useful for ILP32 hosts). +/* IVTYPE: + * This symbol defines the C type used for Perl's IV. */ -#$d_ftello HAS_FTELLO /**/ - -/* HAS_GETMNTENT: - * This symbol, if defined, indicates that the getmntent routine is - * available to iterate through mounted file systems. +/* UVTYPE: + * This symbol defines the C type used for Perl's UV. */ -#$d_getmntent HAS_GETMNTENT /**/ - -/* HAS_GETSPENT: - * This symbol, if defined, indicates that the getspent system call is - * available to retrieve SysV shadow password entries sequentially. +/* I8TYPE: + * This symbol defines the C type used for Perl's I8. */ -#$d_getspent HAS_GETSPENT /**/ - -/* HAS_GETSPNAM: - * This symbol, if defined, indicates that the getspnam system call is - * available to retrieve SysV shadow password entries by name. +/* U8TYPE: + * This symbol defines the C type used for Perl's U8. */ -#$d_getspnam HAS_GETSPNAM /**/ - -/* HAS_HASMNTOPT: - * This symbol, if defined, indicates that the hasmntopt routine is - * available to query the mount options of file systems. +/* I16TYPE: + * This symbol defines the C type used for Perl's I16. */ -#$d_hasmntopt HAS_HASMNTOPT /**/ - -/* HAS_LDBL_DIG: - * This symbol, if defined, indicates that this system's - * or defines the symbol LDBL_DIG, which is the number - * of significant digits in a long double precision number. Unlike - * for DBL_DIG, there's no good guess for LDBL_DIG if it is undefined. +/* U16TYPE: + * This symbol defines the C type used for Perl's U16. */ -#$d_ldbl_dig HAS_LDBL_DIG /* */ - -/* HAS_MADVISE: - * This symbol, if defined, indicates that the madvise system call is - * available to map a file into memory. +/* I32TYPE: + * This symbol defines the C type used for Perl's I32. */ -#$d_madvise HAS_MADVISE /**/ - -/* HAS_MPROTECT: - * This symbol, if defined, indicates that the mprotect system call is - * available to modify the access protection of a memory mapped file. +/* U32TYPE: + * This symbol defines the C type used for Perl's U32. */ -#$d_mprotect HAS_MPROTECT /**/ - -/* HAS_READV: - * This symbol, if defined, indicates that the readv routine is - * available to do gather reads. You will also need - * and there I_SYSUIO. +/* I64TYPE: + * This symbol defines the C type used for Perl's I64. */ -#$d_readv HAS_READV /**/ - -/* HAS_SETSPENT: - * This symbol, if defined, indicates that the setspent system call is - * available to initialize the scan of SysV shadow password entries. +/* U64TYPE: + * This symbol defines the C type used for Perl's U64. */ -#$d_setspent HAS_SETSPENT /**/ - -/* USE_SFIO: - * This symbol, if defined, indicates that sfio should - * be used. +/* NVTYPE: + * This symbol defines the C type used for Perl's NV. */ -#$d_sfio USE_SFIO /**/ - -/* HAS_FSTATFS: - * This symbol, if defined, indicates that the fstatfs routine is - * available to stat filesystems of file descriptors. +/* IVSIZE: + * This symbol contains the sizeof(IV). */ -/* HAS_STRUCT_STATFS_FLAGS: - * This symbol, if defined, indicates that the struct statfs - * does have the f_flags member containing the mount flags of - * the filesystem holding the file. - * This kind of struct statfs is coming from sys/mount.h (BSD), - * not from sys/statfs.h (SYSV). +/* UVSIZE: + * This symbol contains the sizeof(UV). */ -#$d_fstatfs HAS_FSTATFS /**/ -#$d_statfsflags HAS_STRUCT_STATFS_FLAGS /**/ - -/* HAS_FSTATVFS: - * This symbol, if defined, indicates that the fstatvfs routine is - * available to stat filesystems of file descriptors. +/* I8SIZE: + * This symbol contains the sizeof(I8). */ -#$d_fstatvfs HAS_FSTATVFS /**/ - -/* HAS_TELLDIR_PROTO: - * This symbol, if defined, indicates that the system provides - * a prototype for the telldir() function. Otherwise, it is up - * to the program to supply one. A good guess is - * extern long telldir _((DIR*)); +/* U8SIZE: + * This symbol contains the sizeof(U8). */ -#$d_telldirproto HAS_TELLDIR_PROTO /**/ - -/* HAS_WRITEV: - * This symbol, if defined, indicates that the writev routine is - * available to do scatter writes. +/* I16SIZE: + * This symbol contains the sizeof(I16). */ -#$d_writev HAS_WRITEV /**/ - -/* USE_DYNAMIC_LOADING: - * This symbol, if defined, indicates that dynamic loading of - * some sort is available. +/* U16SIZE: + * This symbol contains the sizeof(U16). */ -#$usedl USE_DYNAMIC_LOADING /**/ - -/* FFLUSH_NULL: - * This symbol, if defined, tells that fflush(NULL) does flush - * all pending stdio output. +/* I32SIZE: + * This symbol contains the sizeof(I32). */ -/* FFLUSH_ALL: - * This symbol, if defined, tells that to flush - * all pending stdio output one must loop through all - * the stdio file handles stored in an array and fflush them. - * Note that if fflushNULL is defined, fflushall will not - * even be probed for and will be left undefined. +/* U32SIZE: + * This symbol contains the sizeof(U32). */ -#$fflushNULL FFLUSH_NULL /**/ -#$fflushall FFLUSH_ALL /**/ - -/* DB_Prefix_t: - * This symbol contains the type of the prefix structure element - * in the header file. In older versions of DB, it was - * int, while in newer ones it is u_int32_t. +/* I64SIZE: + * This symbol contains the sizeof(I64). */ -/* DB_Hash_t: - * This symbol contains the type of the prefix structure element - * in the header file. In older versions of DB, it was - * int, while in newer ones it is size_t. +/* U64SIZE: + * This symbol contains the sizeof(U64). */ -#define DB_Hash_t $db_hashtype /**/ -#define DB_Prefix_t $db_prefixtype /**/ +#define IVTYPE $ivtype /**/ +#define UVTYPE $uvtype /**/ +#define I8TYPE $i8type /**/ +#define U8TYPE $u8type /**/ +#define I16TYPE $i16type /**/ +#define U16TYPE $u16type /**/ +#define I32TYPE $i32type /**/ +#define U32TYPE $u32type /**/ +#ifdef HAS_QUAD +#define I64TYPE $i64type /**/ +#define U64TYPE $u64type /**/ +#endif +#define NVTYPE $nvtype /**/ +#define IVSIZE $ivsize /**/ +#define UVSIZE $uvsize /**/ +#define I8SIZE $i8size /**/ +#define U8SIZE $u8size /**/ +#define I16SIZE $i16size /**/ +#define U16SIZE $u16size /**/ +#define I32SIZE $i32size /**/ +#define U32SIZE $u32size /**/ +#ifdef HAS_QUAD +#define I64SIZE $i64size /**/ +#define U64SIZE $u64size /**/ +#endif -/* I_INTTYPES: - * This symbol, if defined, indicates to the C program that it should - * include . +/* IVdf: + * This symbol defines the format string used for printing a Perl IV + * as a signed decimal integer. */ -/* HAS_INT64_T: - * This symbol will defined if the C compiler supports int64_t. - * Usually the needs to be included, but sometimes - * is enough. +/* UVuf: + * This symbol defines the format string used for printing a Perl UV + * as an unsigned decimal integer. */ -#$i_inttypes I_INTTYPES /**/ -#$d_int64t HAS_INT64_T /**/ - -/* I_MNTENT: - * This symbol, if defined, indicates that exists and - * should be included. +/* UVof: + * This symbol defines the format string used for printing a Perl UV + * as an unsigned octal integer. */ -#$i_mntent I_MNTENT /**/ - -/* I_NETINET_TCP: - * This symbol, if defined, indicates to the C program that it should - * include . +/* UVxf: + * This symbol defines the format string used for printing a Perl UV + * as an unsigned hexadecimal integer. */ -#$i_netinettcp I_NETINET_TCP /**/ +#define IVdf $ivdformat /**/ +#define UVuf $uvuformat /**/ +#define UVof $uvoformat /**/ +#define UVxf $uvxformat /**/ -/* I_POLL: - * This symbol, if defined, indicates that exists and - * should be included. +/* Pid_t: + * This symbol holds the type used to declare process ids in the kernel. + * It can be int, uint, pid_t, etc... It may be necessary to include + * to get any typedef'ed information. */ -#$i_poll I_POLL /**/ +#define Pid_t $pidtype /* PID type */ -/* I_SHADOW: - * This symbol, if defined, indicates that exists and - * should be included. +/* PRIVLIB: + * This symbol contains the name of the private library for this package. + * The library is private in the sense that it needn't be in anyone's + * execution path, but it should be accessible by the world. The program + * should be prepared to do ~ expansion. */ -#$i_shadow I_SHADOW /**/ +/* PRIVLIB_EXP: + * This symbol contains the ~name expanded version of PRIVLIB, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. + */ +#define PRIVLIB "$privlib" /**/ +#define PRIVLIB_EXP "$privlibexp" /**/ -/* I_SOCKS: - * This symbol, if defined, indicates that exists and - * should be included. +/* PTRSIZE: + * This symbol contains the size of a pointer, so that the C preprocessor + * can make decisions based on it. It will be sizeof(void *) if + * the compiler supports (void *); otherwise it will be + * sizeof(char *). */ -#$i_socks I_SOCKS /**/ +#define PTRSIZE $ptrsize /**/ -/* I_SYS_MMAN: - * This symbol, if defined, indicates that exists and - * should be included. +/* Drand01: + * This macro is to be used to generate uniformly distributed + * random numbers over the range [0., 1.[. You may have to supply + * an 'extern double drand48();' in your program since SunOS 4.1.3 + * doesn't provide you with anything relevant in it's headers. + * See HAS_DRAND48_PROTO. + */ +/* Rand_seed_t: + * This symbol defines the type of the argument of the + * random seed function. + */ +/* seedDrand01: + * This symbol defines the macro to be used in seeding the + * random number generator (see Drand01). + */ +/* RANDBITS: + * This symbol indicates how many bits are produced by the + * function used to generate normalized random numbers. + * Values include 15, 16, 31, and 48. */ -#$i_sysmman I_SYS_MMAN /**/ +#define Drand01() $drand01 /**/ +#define Rand_seed_t $randseedtype /**/ +#define seedDrand01(x) $seedfunc((Rand_seed_t)x) /**/ +#define RANDBITS $randbits /**/ -/* I_SYS_MOUNT: - * This symbol, if defined, indicates that exists and - * should be included. +/* SELECT_MIN_BITS: + * This symbol holds the minimum number of bits operated by select. + * That is, if you do select(n, ...), how many bits at least will be + * cleared in the masks if some activity is detected. Usually this + * is either n or 32*ceil(n/32), especially many little-endians do + * the latter. This is only useful if you have select(), naturally. */ -#$i_sysmount I_SYS_MOUNT /**/ +#define SELECT_MIN_BITS $selectminbits /**/ -/* I_SYS_STATVFS: - * This symbol, if defined, indicates that exists and - * should be included. +/* Select_fd_set_t: + * This symbol holds the type used for the 2nd, 3rd, and 4th + * arguments to select. Usually, this is 'fd_set *', if HAS_FD_SET + * is defined, and 'int *' otherwise. This is only useful if you + * have select(), of course. */ -#$i_sysstatvfs I_SYS_STATVFS /**/ +#define Select_fd_set_t $selecttype /**/ -/* HAS_OFF64_T: - * This symbol will be defined if the C compiler supports off64_t. +/* SIG_NAME: + * This symbol contains a list of signal names in order of + * signal number. This is intended + * to be used as a static array initialization, like this: + * char *sig_name[] = { SIG_NAME }; + * The signals in the list are separated with commas, and each signal + * is surrounded by double quotes. There is no leading SIG in the signal + * name, i.e. SIGQUIT is known as "QUIT". + * Gaps in the signal numbers (up to NSIG) are filled in with NUMnn, + * etc., where nn is the actual signal number (e.g. NUM37). + * The signal number for sig_name[i] is stored in sig_num[i]. + * The last element is 0 to terminate the list with a NULL. This + * corresponds to the 0 at the end of the sig_num list. */ -/* HAS_FPOS64_T: - * This symbol will be defined if the C compiler supports fpos64_t. +/* SIG_NUM: + * This symbol contains a list of signal numbers, in the same order as the + * SIG_NAME list. It is suitable for static array initialization, as in: + * int sig_num[] = { SIG_NUM }; + * The signals in the list are separated with commas, and the indices + * within that list and the SIG_NAME list match, so it's easy to compute + * the signal name from a number or vice versa at the price of a small + * dynamic linear lookup. + * Duplicates are allowed, but are moved to the end of the list. + * The signal number corresponding to sig_name[i] is sig_number[i]. + * if (i < NSIG) then sig_number[i] == i. + * The last element is 0, corresponding to the 0 at the end of + * the sig_name list. */ -#$d_off64_t HAS_OFF64_T /**/ -#$d_fpos64_t HAS_FPOS64_T /**/ +#define SIG_NAME $sig_name_init /**/ +#define SIG_NUM $sig_num_init /**/ -/* PERL_PRIfldbl: - * This symbol, if defined, contains the string used by stdio to - * format long doubles (format 'f') for output. +/* SITEARCH: + * This symbol contains the name of the private library for this package. + * The library is private in the sense that it needn't be in anyone's + * execution path, but it should be accessible by the world. The program + * should be prepared to do ~ expansion. + * The standard distribution will put nothing in this directory. + * After perl has been installed, users may install their own local + * architecture-dependent modules in this directory with + * MakeMaker Makefile.PL + * or equivalent. See INSTALL for details. */ -/* PERL_PRIgldbl: - * This symbol, if defined, contains the string used by stdio to - * format long doubles (format 'g') for output. +/* SITEARCH_EXP: + * This symbol contains the ~name expanded version of SITEARCH, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. */ -#$d_PRIfldbl PERL_PRIfldbl $sPRIfldbl /**/ -#$d_PRIgldbl PERL_PRIgldbl $sPRIgldbl /**/ +#define SITEARCH "$sitearch" /**/ +#define SITEARCH_EXP "$sitearchexp" /**/ -/* PERL_PRId64: - * This symbol, if defined, contains the string used by stdio to - * format 64-bit decimal numbers (format 'd') for output. - */ -/* PERL_PRIu64: - * This symbol, if defined, contains the string used by stdio to - * format 64-bit unsigned decimal numbers (format 'u') for output. +/* SITELIB: + * This symbol contains the name of the private library for this package. + * The library is private in the sense that it needn't be in anyone's + * execution path, but it should be accessible by the world. The program + * should be prepared to do ~ expansion. + * The standard distribution will put nothing in this directory. + * After perl has been installed, users may install their own local + * architecture-independent modules in this directory with + * MakeMaker Makefile.PL + * or equivalent. See INSTALL for details. */ -/* PERL_PRIo64: - * This symbol, if defined, contains the string used by stdio to - * format 64-bit octal numbers (format 'o') for output. +/* SITELIB_EXP: + * This symbol contains the ~name expanded version of SITELIB, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. */ -/* PERL_PRIx64: - * This symbol, if defined, contains the string used by stdio to - * format 64-bit hexadecimal numbers (format 'x') for output. +#define SITELIB "$sitelib" /**/ +#define SITELIB_EXP "$sitelibexp" /**/ + +/* Size_t: + * This symbol holds the type used to declare length parameters + * for string functions. It is usually size_t, but may be + * unsigned long, int, etc. It may be necessary to include + * to get any typedef'ed information. */ -#$d_PRId64 PERL_PRId64 $sPRId64 /**/ -#$d_PRIu64 PERL_PRIu64 $sPRIu64 /**/ -#$d_PRIo64 PERL_PRIo64 $sPRIo64 /**/ -#$d_PRIx64 PERL_PRIx64 $sPRIx64 /**/ +#define Size_t $sizetype /* length paramater for string functions */ -/* SELECT_MIN_BITS: - * This symbol holds the minimum number of bits operated by select. - * That is, if you do select(n, ...), how many bits at least will be - * cleared in the masks if some activity is detected. Usually this - * is either n or 32*ceil(n/32), especially many little-endians do - * the latter. This is only useful if you have select(), naturally. +/* SSize_t: + * This symbol holds the type used by functions that return + * a count of bytes or an error condition. It must be a signed type. + * It is usually ssize_t, but may be long or int, etc. + * It may be necessary to include or + * to get any typedef'ed information. + * We will pick a type such that sizeof(SSize_t) == sizeof(Size_t). */ -#define SELECT_MIN_BITS $selectminbits /**/ +#define SSize_t $ssizetype /* signed count of bytes */ /* STARTPERL: * This variable contains the string to put in front of a perl @@ -2462,250 +2714,135 @@ sed <config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un- #$d_stdio_stream_array HAS_STDIO_STREAM_ARRAY /**/ #define STDIO_STREAM_ARRAY $stdio_stream_array -/* HAS_STRTOULL: - * This symbol, if defined, indicates that the strtoull routine is - * available to convert strings into unsigned long longs. +/* Uid_t_f: + * This symbol defines the format string used for printing a Uid_t. */ -#$d_strtoull HAS_STRTOULL /**/ +#define Uid_t_f $uidformat /**/ + +/* Uid_t_size: + * This symbol holds the size of a Uid_t in bytes. + */ +#define Uid_t_size $uidsize /* UID size */ + +/* Uid_t: + * This symbol holds the type used to declare user ids in the kernel. + * It can be int, ushort, uid_t, etc... It may be necessary to include + * to get any typedef'ed information. + */ +#define Uid_t $uidtype /* UID type */ /* USE_64_BITS: - * This symbol, if defined, indicates that 64-bit interfaces should - * be used when available. If not defined, the native default interfaces + * This symbol, if defined, indicates that 64-bit integers should + * be used when available. If not defined, the native integers * will be used (be they 32 or 64 bits). */ +#ifndef USE_64_BITS #$use64bits USE_64_BITS /**/ +#endif /* USE_LARGE_FILES: * This symbol, if defined, indicates that large file support * should be used when available. The USE_64_BITS symbol will * also be turned on if necessary. */ +#ifndef USE_LARGE_FILES #$uselargefiles USE_LARGE_FILES /**/ +#endif /* USE_LONG_DOUBLE: * This symbol, if defined, indicates that long doubles should * be used when available. */ +#ifndef USE_LONG_DOUBLE #$uselongdouble USE_LONG_DOUBLE /**/ +#endif + +/* USE_LONG_LONG: + * This symbol, if defined, indicates that long longs should + * be used when available. + */ +#ifndef USE_LONG_LONG +#$uselonglong USE_LONG_LONG /**/ +#endif + +#ifndef USE_MORE_BITS +#$usemorebits USE_MORE_BITS /**/ +#endif /* MULTIPLICITY: * This symbol, if defined, indicates that Perl should * be built to use multiplicity. */ +#ifndef MULTIPLICTY #$usemultiplicity MULTIPLICITY /**/ +#endif /* USE_PERLIO: * This symbol, if defined, indicates that the PerlIO abstraction should * be used throughout. If not defined, stdio should be * used in a fully backward compatible manner. */ +#ifndef USE_PERLIO #$useperlio USE_PERLIO /**/ +#endif /* USE_SOCKS: * This symbol, if defined, indicates that Perl should * be built to use socks. */ +#ifndef USE_SOCKS #$usesocks USE_SOCKS /**/ +#endif -/* HAS_DRAND48_PROTO: - * This symbol, if defined, indicates that the system provides - * a prototype for the drand48() function. Otherwise, it is up - * to the program to supply one. A good guess is - * extern double drand48 _((void)); - */ -#$d_drand48proto HAS_DRAND48_PROTO /**/ - -/* HAS_GETHOST_PROTOS: - * This symbol, if defined, indicates that includes - * prototypes for gethostent(), gethostbyname(), and - * gethostbyaddr(). Otherwise, it is up to the program to guess - * them. See netdbtype.U for probing for various Netdb_xxx_t types. - */ -#$d_gethostprotos HAS_GETHOST_PROTOS /**/ - -/* HAS_GETNET_PROTOS: - * This symbol, if defined, indicates that includes - * prototypes for getnetent(), getnetbyname(), and - * getnetbyaddr(). Otherwise, it is up to the program to guess - * them. See netdbtype.U for probing for various Netdb_xxx_t types. - */ -#$d_getnetprotos HAS_GETNET_PROTOS /**/ - -/* HAS_GETPROTO_PROTOS: - * This symbol, if defined, indicates that includes - * prototypes for getprotoent(), getprotobyname(), and - * getprotobyaddr(). Otherwise, it is up to the program to guess - * them. See netdbtype.U for probing for various Netdb_xxx_t types. - */ -#$d_getprotoprotos HAS_GETPROTO_PROTOS /**/ - -/* HAS_GETSERV_PROTOS: - * This symbol, if defined, indicates that includes - * prototypes for getservent(), getservbyname(), and - * getservbyaddr(). Otherwise, it is up to the program to guess - * them. See netdbtype.U for probing for various Netdb_xxx_t types. - */ -#$d_getservprotos HAS_GETSERV_PROTOS /**/ - -/* Netdb_host_t: - * This symbol holds the type used for the 1st argument - * to gethostbyaddr(). - */ -/* Netdb_hlen_t: - * This symbol holds the type used for the 2nd argument - * to gethostbyaddr(). - */ -/* Netdb_name_t: - * This symbol holds the type used for the argument to - * gethostbyname(). - */ -/* Netdb_net_t: - * This symbol holds the type used for the 1st argument to - * getnetbyaddr(). - */ -#define Netdb_host_t $netdb_host_type /**/ -#define Netdb_hlen_t $netdb_hlen_type /**/ -#define Netdb_name_t $netdb_name_type /**/ -#define Netdb_net_t $netdb_net_type /**/ - -/* Select_fd_set_t: - * This symbol holds the type used for the 2nd, 3rd, and 4th - * arguments to select. Usually, this is 'fd_set *', if HAS_FD_SET - * is defined, and 'int *' otherwise. This is only useful if you - * have select(), of course. - */ -#define Select_fd_set_t $selecttype /**/ - -/* ARCHNAME: - * This symbol holds a string representing the architecture name. - * It may be used to construct an architecture-dependant pathname - * where library files may be held under a private library, for - * instance. - */ -#define ARCHNAME "$archname" /**/ - -/* OLD_PTHREAD_CREATE_JOINABLE: - * This symbol, if defined, indicates how to create pthread - * in joinable (aka undetached) state. NOTE: not defined - * if pthread.h already has defined PTHREAD_CREATE_JOINABLE - * (the new version of the constant). - * If defined, known values are PTHREAD_CREATE_UNDETACHED - * and __UNDETACHED. - */ -#$d_old_pthread_create_joinable OLD_PTHREAD_CREATE_JOINABLE $old_pthread_create_joinable /**/ - -/* HAS_PTHREAD_YIELD: - * This symbol, if defined, indicates that the pthread_yield - * routine is available to yield the execution of the current - * thread. sched_yield is preferable to pthread_yield. - */ -/* SCHED_YIELD: - * This symbol defines the way to yield the execution of - * the current thread. Known ways are sched_yield, - * pthread_yield, and pthread_yield with NULL. - */ -/* HAS_SCHED_YIELD: - * This symbol, if defined, indicates that the sched_yield - * routine is available to yield the execution of the current - * thread. sched_yield is preferable to pthread_yield. - */ -#$d_pthread_yield HAS_PTHREAD_YIELD /**/ -#define SCHED_YIELD $sched_yield /**/ -#$d_sched_yield HAS_SCHED_YIELD /**/ - -/* I_MACH_CTHREADS: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -#$i_machcthr I_MACH_CTHREADS /**/ - -/* I_PTHREAD: - * This symbol, if defined, indicates to the C program that it should - * include . +/* USE_ITHREADS: + * This symbol, if defined, indicates that Perl should be built to + * use the interpreter-based threading implementation. */ -#$i_pthread I_PTHREAD /**/ - -/* USE_THREADS: - * This symbol, if defined, indicates that Perl should - * be built to use threads. +/* USE_5005THREADS: + * This symbol, if defined, indicates that Perl should be built to + * use the 5.005-based threading implementation. */ /* OLD_PTHREADS_API: * This symbol, if defined, indicates that Perl should * be built to use the old draft POSIX threads API. */ -#$usethreads USE_THREADS /**/ +#$use5005threads USE_5005THREADS /**/ +#$useithreads USE_ITHREADS /**/ +#if defined(USE_5005THREADS) && !defined(USE_ITHREADS) +#define USE_THREADS /* until src is revised*/ +#endif #$d_oldpthreads OLD_PTHREADS_API /**/ -/* Time_t: - * This symbol holds the type returned by time(). It can be long, - * or time_t on BSD sites (in which case should be - * included). - */ -#define Time_t $timetype /* Time type */ - -/* HAS_TIMES: - * This symbol, if defined, indicates that the times() routine exists. - * Note that this became obsolete on some systems (SUNOS), which now - * use getrusage(). It may be necessary to include . - */ -#$d_times HAS_TIMES /**/ - -/* Fpos_t: - * This symbol holds the type used to declare file positions in libc. - * It can be fpos_t, long, uint, etc... It may be necessary to include - * to get any typedef'ed information. - */ -#define Fpos_t $fpostype /* File position type */ - -/* Gid_t: - * This symbol holds the return type of getgid() and the type of - * argument to setrgid() and related functions. Typically, - * it is the type of group ids in the kernel. It can be int, ushort, - * uid_t, etc... It may be necessary to include to get - * any typedef'ed information. - */ -#define Gid_t $gidtype /* Type for getgid(), etc... */ - -/* Off_t: - * This symbol holds the type used to declare offsets in the kernel. - * It can be int, long, off_t, etc... It may be necessary to include - * to get any typedef'ed information. - */ -/* LSEEKSIZE: - * This symbol holds the number of bytes used by the Off_t. - */ -#define Off_t $lseektype /* type */ -#define LSEEKSIZE $lseeksize /* size */ - -/* Mode_t: - * This symbol holds the type used to declare file modes - * for systems calls. It is usually mode_t, but may be - * int or unsigned short. It may be necessary to include - * to get any typedef'ed information. - */ -#define Mode_t $modetype /* file mode parameter for system calls */ - -/* Pid_t: - * This symbol holds the type used to declare process ids in the kernel. - * It can be int, uint, pid_t, etc... It may be necessary to include - * to get any typedef'ed information. - */ -#define Pid_t $pidtype /* PID type */ - -/* Size_t: - * This symbol holds the type used to declare length parameters - * for string functions. It is usually size_t, but may be - * unsigned long, int, etc. It may be necessary to include - * to get any typedef'ed information. +/* PERL_VENDORLIB_EXP: + * This symbol contains the ~name expanded version of VENDORLIB, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define Size_t $sizetype /* length paramater for string functions */ +#$d_vendorlib PERL_VENDORLIB_EXP "$vendorlibexp" /**/ -/* Uid_t: - * This symbol holds the type used to declare user ids in the kernel. - * It can be int, ushort, uid_t, etc... It may be necessary to include - * to get any typedef'ed information. +/* VOIDFLAGS: + * This symbol indicates how much support of the void type is given by this + * compiler. What various bits mean: + * + * 1 = supports declaration of void + * 2 = supports arrays of pointers to functions returning void + * 4 = supports comparisons between pointers to void functions and + * addresses of void functions + * 8 = suports declaration of generic void pointers + * + * The package designer should define VOIDUSED to indicate the requirements + * of the package. This can be done either by #defining VOIDUSED before + * including config.h, or by defining defvoidused in Myinit.U. If the + * latter approach is taken, only those flags will be tested. If the + * level of void support necessary is not present, defines void to int. */ -#define Uid_t $uidtype /* UID type */ +#ifndef VOIDUSED +#define VOIDUSED $defvoidused +#endif +#define VOIDFLAGS $voidflags +#if (VOIDFLAGS & VOIDUSED) != VOIDUSED +#define void int /* is void to be avoided? */ +#define M_VOID /* Xenix strikes again */ +#endif #endif !GROK!THIS! diff --git a/configure.com b/configure.com index a9ed05be..a77bec8 100644 --- a/configure.com +++ b/configure.com @@ -14,7 +14,7 @@ $! $ @Configure "-des" $! $! That's it. If you get into a bind trying to build perl on VMS then $! definitely read through the README.VMS file. -$! Beyond that send email to VMSPerl@cor.newman.upenn.edu +$! Beyond that send email to vmsperl@perl.org $! $! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ $! @@ -24,8 +24,8 @@ $! Thank you!!!! $! $! Adapted and converted from Larry Wall & Andy Dougherty's $! "Configure generated by metaconfig 3.0 PL60." by Peter Prymmer -$! (a Bourne sh[ell] script for configuring the installation of perl on VMS) -$! in the perl5.002|3 epoch (spring/summer 1996) +$! (a Bourne sh[ell] script for configuring the installation of perl +$! on non-VMS systems) in the perl5.002|3 epoch (spring/summer 1996) $! with much valuable help from Charles Bailey & $! the whole VMSPerl crew. $! Extended and messed about with by Dan Sugalski @@ -41,7 +41,7 @@ $ ans = "" $ macros = "" $ use_vmsdebug_perl = "N" $ use_debugging_perl = "Y" -$ use_64bit = "N" +$ use_64bit = "n" $ C_Compiler_Replace = "CC=" $ Thread_Live_Dangerously = "MT=" $ use_two_pot_malloc = "N" @@ -481,6 +481,19 @@ $ IF (((f$length(file_2_find)+1) .eq. f$length(basename)) .and. - $ file_2_find = dirname + basename $! $ found = F$SEARCH(file_2_find) +$ IF (found .EQS. "" .AND. dots .GT. 2) +$ THEN +$! 17-DEC-1999 Improved to turn "[.foo.bar]baz.c_buz" into +$! "[.foo.bar]baz_c.buz" to cover unzipped archives and put +$! "[.foo.bar]baz.c_buz,baz_c.buz" into missing list if neither is found. +$ basename[f$locate(".",basename),1] := _ +$ dot_ele = F$ELEMENT(dots - 1,"_",basename) +$ basename = - + f$extract(0,f$length(basename)-(f$length(dot_ele)+1),basename) - + + "." + dot_ele +$ found = F$SEARCH(dirname + basename) +$ file_2_find = file_2_find + "," + basename +$ ENDIF $ IF (found .EQS. "") $ THEN $ WRITE MISSING file_2_find @@ -702,7 +715,7 @@ $ TYPE SYS$INPUT: %Config-E-VMS, ERROR: Err, you do not appear to be running VMS! - This package is intended to Configure the building of Perl for VMS. + This procedure is intended to Configure the building of Perl for VMS. $ READ SYS$COMMAND/PROMPT="Continue anyway? [n] " ans $ IF ans @@ -826,7 +839,7 @@ $! $TZSet: $ echo "" $ echo "Please tell me in hh:mm form what time offset from GMT/UTC in England" -$ echo "you are. As an example Eastern (US) Standard Time is -5:00 offset, but" +$ echo "you are. As an example Eastern (US) Standard Time is -5:00 offset, but" $ echo "Eastern Daylight Time (summer) is -4:00 offset." $ dflt = "0:00" $ rp = "Enter the Time Zone offset: [''dflt'] " @@ -870,8 +883,10 @@ $! $ IF (F$GETSYI("HW_MODEL") .LT. 1024) $ THEN $ archname = "VMS_VAX" +$ otherarch = "an Alpha" $ ELSE $ archname = "VMS_AXP" +$ otherarch = "a VAX" $ ENDIF $ rp = "What is your architecture name? [''archname'] " $ GOSUB myread @@ -883,24 +898,22 @@ $ THEN $ echo4 "I'll go with ''archname' anyway..." $ ENDIF $ ENDIF -$ IF (archname.EQS."VMS_AXP") +$ dflt = "n" +$ rp = "Will you be sharing your PERL_ROOT with ''otherarch'? [''dflt'] " +$ GOSUB myread +$ if ans.NES."" $ THEN -$ dflt = "n" -$ rp = "Are you sharing your PERL_ROOT with a VAX? [''dflt'] " -$ GOSUB myread -$ if ans.NES."" -$ THEN -$ ans = F$EDIT(ans,"COLLAPSE, UPCASE") -$ ENDIF -$ IF (ans.NES."Y") +$ ans = F$EXTRACT(0,1,F$EDIT(ans,"COLLAPSE, UPCASE")) +$ ENDIF +$ IF (ans.NES."Y") +$ THEN +$ sharedperl = "N" +$ ELSE +$ sharedperl = "Y" +$ IF (archname.EQS."VMS_AXP") $ THEN -$ sharedperl = "N" -$ ELSE -$ sharedperl = "Y" $ macros = macros + """AXE=1""," $ ENDIF -$ ELSE -$ sharedperl = "N" $ ENDIF $! $!: is AFS running? !sfn @@ -971,7 +984,7 @@ $! $ ENDIF !%Config-I-VMS, skip "where install" questions $! $!: set the base revision -$ baserev="5.0" +$ baserev="5" $!: get the patchlevel $ echo "" $ echo4 "Getting the current patchlevel..." !>&4 @@ -1019,7 +1032,7 @@ $ ENDIF $ ELSE subversion = "" $ ENDIF $! -$ version = F$EXTRACT(0,1,baserev) + "_" + patchlevel + subversion +$ version = baserev + "_" + patchlevel + "_" + subversion $! $ IF (.NOT.vms_skip_install) $ THEN @@ -1597,7 +1610,7 @@ no easy means to double check it. The default value provided below is most probably close to the reality but may not be valid from outside your organization... $ ENDIF -$ dflt = "''cf_by@''myhostname'"+"''mydomain'" +$ dflt = "''cf_by'@''myhostname'"+"''mydomain'" $ rp = "What is your e-mail address? [''dflt'] " $ GOSUB myread $ IF ans .nes. "" @@ -1685,16 +1698,16 @@ $ endif $! $! $! Ask if they want to build with VMS_DEBUG perl +$ echo "" $ echo "Perl can be built to run under the VMS debugger." $ echo "You should only select this option if you are debugging" $ echo "perl itself. This can be a useful feature if you are " $ echo "embedding perl in a program." -$ echo "" -$ dflt = "N" +$ dflt = "n" $ rp = "Build a VMS-DEBUG version of Perl? [''dflt'] " $ GOSUB myread -$ if ans.eqs."" then ans = dflt -$ if (f$extract(0, 1, "''ans'").eqs."Y").or.(f$extract(0, 1, "''ans'").eqs."y") +$ IF ans.eqs."" then ans = dflt +$ IF F$EXTRACT(0, 1, F$EDIT(ans,"COLLAPSE,UPCASE")) .eqs. "Y" $ THEN $ use_vmsdebug_perl = "Y" $ macros = macros + """__DEBUG__=1""," @@ -1703,18 +1716,18 @@ $ use_vmsdebug_perl = "N" $ ENDIF $! $! Ask if they want to build with MULTIPLICITY +$ echo "" $ echo "The perl interpreter engine can be built in a way that makes it -$ echo "possible for a program that embeds perl into it (and yep, you can +$ echo "possible for a program that embeds perl into it (and yes, you can $ echo "do that--it's pretty keen) to have multiple perl interpreters active $ echo "at once. There is some performance overhead, however, so you $ echo "probably don't want to choose this unless you're going to be doing $ echo "funky perl embedding." -$ echo "" $ dflt = "n" $ rp = "Build with MULTIPLICITY? [''dflt'] " $ GOSUB myread -$ if ans.eqs."" then ans = dflt -$ if (f$extract(0, 1, "''ans'").eqs."Y").or.(f$extract(0, 1, "''ans'").eqs."y") +$ if ans.eqs."" then ans = dflt +$ IF F$EXTRACT(0, 1, F$EDIT(ans,"COLLAPSE,UPCASE")) .eqs. "Y" $ THEN $ use_multiplicity="Y" $ ELSE @@ -1724,37 +1737,16 @@ $! $! Ask if they want to build with 64-bit support $ if (Archname.eqs."VMS_AXP").and.("''f$extract(1,3, f$getsyi(""version""))'".ges."7.1") $ THEN -$ echo "This version of perl has experimental support for building wtih -$ echo "64 bit integers and 128 bit floating point variables. This gives -$ echo "a much larger range for perl's mathematical operations. (Note that -$ echo "does *not* enable 64-bit fileops at the moment, as Dec C doesn't -$ echo "do that yet)" $ echo "" -$ dflt = use_64bit -$ rp = "Build with 64 bits? [''dflt'] " -$ GOSUB myread -$ if ans.eqs."" then ans = dflt -$ if (f$extract(0, 1, "''ans'").eqs."Y").or.(f$extract(0, 1, "''ans'").eqs."y") -$ THEN -$ use_64bit="Y" -$ ELSE -$ use_64bit="N" -$ ENDIF -$ ENDIF -$! -$! Ask if they want to build with 64-bit support -$ if (Archname.eqs."VMS_AXP").and.("''f$extract(1,3, f$getsyi(""version""))'".ges."7.1") -$ THEN -$ echo "This version of perl has experimental support for building wtih +$ echo "This version of perl has experimental support for building with $ echo "64 bit integers and 128 bit floating point variables. This gives $ echo "a much larger range for perl's mathematical operations. (Note that $ echo "does *not* enable 64-bit fileops at the moment, as Dec C doesn't $ echo "do that yet)" -$ echo "" $ dflt = use_64bit $ rp = "Build with 64 bits? [''dflt'] " $ GOSUB myread -$ if ans.eqs."" then ans = dflt +$ if ans.eqs."" then ans = dflt $ if (f$extract(0, 1, "''ans'").eqs."Y").or.(f$extract(0, 1, "''ans'").eqs."y") $ THEN $ use_64bit="Y" @@ -1762,13 +1754,14 @@ $ ELSE $ use_64bit="N" $ ENDIF $ ENDIF +$! $! Ask about threads, if appropriate $ if (Using_Dec_C.eqs."Yes") $ THEN +$ echo "" $ echo "This version of Perl can be built with threads. While really nifty, $ echo "they are a beta feature, and there is a speed penalty for perl $ echo "programs if you build with threads *even if you don't use them* -$ echo "" $ dflt = "n" $ rp = "Build with threads? [''dflt'] " $ GOSUB myread @@ -1788,7 +1781,6 @@ $ echo "all the threads in a program, even on a single-processor $ echo "machine. Unfortunately this feature isn't safe on an $ echo "unpatched 7.1 system. (Several OS patches were required when $ echo "this procedure was written) -$ echo "" $ dflt = "n" $ rp = "Enable multiple kernel threads and upcalls? [''dflt'] " $ gosub myread @@ -1816,7 +1808,6 @@ $ echo "This restriction does not apply to the %ENV hash or to implicit" $ echo "logical name translation during parsing of file specifications;" $ echo "these always use the normal sequence of access modes for logical" $ echo "name translation." -$ echo "" $ dflt = "n" $ rp = "Use secure logical name translation? [''dflt'] " $ GOSUB myread @@ -1832,12 +1823,11 @@ $ echo "default file types, however, you can configure Perl to try default" $ echo "file types of nothing, .pl, and .com, in that order (e.g. typing" $ echo """$ perl foo"" would cause Perl to look for foo., then foo.pl, and" $ echo "finally foo.com)." -$ echo "" $ dflt = "n" $ rp = "Always use default file types? [''dflt'] " $ GOSUB myread $ if ans.eqs."" then ans="''dflt'" -$ d_alwdeftype = f$extract(0, 1, f$edit(ans,"TRIM,COMPRESS,UPCASE")) +$ d_alwdeftype = f$extract(0, 1, f$edit(ans,"COLLAPSE,UPCASE")) $! $! Ask if they want to use perl's memory allocator $ echo "" @@ -1845,12 +1835,11 @@ $ echo "Perl has a built-in memory allocator that's tuned for perl's $ echo "normal memory usage. It's oftentimes better than the standard $ echo "system memory allocator. It also has the advantage of providing $ echo "memory allocation statistics, if you choose to enable them. -$ echo "" $ dflt = "n" $ rp = "Build with perl's memory allocator? [''dflt'] " $ GOSUB myread $ if ans.eqs."" then ans="''dflt'" -$ mymalloc = f$extract(0, 1, f$edit(ans,"TRIM,COMPRESS,UPCASE")) +$ mymalloc = f$extract(0, 1, f$edit(ans,"COLLAPSE,UPCASE")) $ if mymalloc.eqs."Y" $ THEN $ if use_debugging_perl.eqs."Y" @@ -1859,12 +1848,11 @@ $ echo "" $ echo "Perl can keep statistics on memory usage if you choose to use $ echo "them. This is useful for debugging, but does have some $ echo "performance overhead. -$ echo "" $ dflt = "n" $ rp = "Do you want the debugging memory allocator? [''dflt'] " $ gosub myread $ if ans.eqs."" then ans="''dflt'" -$ use_debugmalloc = f$extract(0, 1, f$edit(ans, "TRIM,COMPRESS,UPCASE")) +$ use_debugmalloc = f$extract(0, 1, f$edit(ans, "COLLAPSE,UPCASE")) $ ENDIF $ ! Check which memory allocator we want $ echo "" @@ -1875,7 +1863,6 @@ $ echo "larger allocations), and PACK_MALLOC (which is optimized to save $ echo "memory for smaller allocations). They're all good, but if your $ echo "usage tends towards larger chunks use TWO_POT, otherwise use $ echo "PACK_MALLOC." -$ echo "" $ dflt = "DEFAULT" $ rp = "Memory allocator (DEFAULT, TWO_POT, PACK_MALLOC) [''dflt'] " $ GOSUB myread @@ -1892,8 +1879,8 @@ $ echo "you might, for example, want to build GDBM_File instead of $ echo "SDBM_File if you have the GDBM library built on your machine $ echo " $ echo "Which modules do you want to build into perl?" -$! dflt = "Fcntl Errno IO Opcode Byteloader Devel::Peek Devel::DProf Data::Dumper attrs re VMS::Stdio VMS::DCLsym B SDBM_File" -$ dflt = "Fcntl Errno IO Opcode Devel::Peek Devel::DProf Data::Dumper attrs re VMS::Stdio VMS::DCLsym B SDBM_File" +$! dflt = "Fcntl Errno File::Glob IO Opcode Byteloader Devel::Peek Devel::DProf Data::Dumper attrs re VMS::Stdio VMS::DCLsym B SDBM_File" +$ dflt = "Fcntl Errno File::Glob IO Opcode Devel::Peek Devel::DProf Data::Dumper attrs re VMS::Stdio VMS::DCLsym B SDBM_File" $ if Using_Dec_C.eqs."Yes" $ THEN $ dflt = dflt + " POSIX" @@ -2048,10 +2035,17 @@ $ SET DEFAULT [-.vms] $ @subconfigure $ SET DEFAULT 'dflt $! -$! Warn of dangerous logical names +$! Warn of dangerous symbols or logical names $! -$Bad_logical: SUBROUTINE -$ IF f$trnlnm(p1) .nes. "" +$Bad_environment: SUBROUTINE +$ Bad_env = "" +$ IF p2 .eqs. "SYMBOL" +$ THEN +$ IF f$type('p1) .nes. "" THEN Bad_env := SYMBOL +$ ELSE +$ IF f$trnlnm(p1) .nes. "" THEN Bad_env := LOGICAL +$ ENDIF +$ IF Bad_env .eqs. "SYMBOL" .or. Bad_env .eqs. "LOGICAL" $ THEN $ IF f$search("config.msg") .nes. "" $ THEN @@ -2059,19 +2053,38 @@ $ OPEN/APPEND CONFIG config.msg $ ELSE $ OPEN/WRITE CONFIG config.msg $ ENDIF -$ WRITE CONFIG "Logical name ''p1' found in environment as " + f$trnlnm(p1) -$ WRITE CONFIG " deassign before building ''package'" +$ IF Bad_env .eqs. "SYMBOL" +$ THEN +$ WRITE CONFIG "" +$ WRITE CONFIG "Symbol name ''p1' found in environment as " + &p1 +$ WRITE CONFIG " delete before building ''package' via:" +$ WRITE CONFIG " $ DELETE/SYMBOL/GLOBAL ''p1'" +$ IF f$locate("""",&p1) .ge. f$length(&p1) +$ THEN +$ WRITE CONFIG " after building, testing, and installing ''package' +$ WRITE CONFIG " restore the symbol with:" +$ WRITE CONFIG " $ ''p1' == """ + &p1 + """" +$ ENDIF +$ ENDIF +$ IF Bad_env .eqs. "LOGICAL" +$ THEN +$ WRITE CONFIG "" +$ WRITE CONFIG "Logical name ''p1' found in environment as " + f$trnlnm(p1) +$ WRITE CONFIG " deassign before building ''package'" +$ ENDIF $ CLOSE CONFIG +$ Bad_env = "" $ ENDIF $ EXIT -$ ENDSUBROUTINE ! Bad_logical +$ ENDSUBROUTINE ! Bad_environment $ echo "" -$ echo4 "%Config-I-VMS, Checking for dangerous pre extant logical names." -$ CALL Bad_logical "TMP" -$ CALL Bad_logical "LIB" -$ CALL Bad_logical "T" -$ CALL Bad_logical "FOO" -$ CALL Bad_logical "EXT" +$ echo4 "%Config-I-VMS, Checking for dangerous pre extant global symbols and logical names." +$ CALL Bad_environment "TMP" +$ CALL Bad_environment "LIB" +$ CALL Bad_environment "T" +$ CALL Bad_environment "FOO" +$ CALL Bad_environment "EXT" +$ CALL Bad_environment "TEST" "SYMBOL" $ IF f$search("config.msg") .eqs. "" THEN echo "OK." $! $! %Config-I-VMS, write perl_setup.com here diff --git a/cop.h b/cop.h index e8221b6..ede2fce 100644 --- a/cop.h +++ b/cop.h @@ -10,8 +10,13 @@ struct cop { BASEOP char * cop_label; /* label for this construct */ +#ifdef USE_ITHREADS + char * cop_stashpv; /* package line was compiled in */ + char * cop_file; /* file name the following line # is from */ +#else HV * cop_stash; /* package line was compiled in */ GV * cop_filegv; /* file the following line # is from */ +#endif U32 cop_seq; /* parse sequence number */ I32 cop_arybase; /* array base this line was compiled with */ line_t cop_line; /* line # of this command */ @@ -20,6 +25,44 @@ struct cop { #define Nullcop Null(COP*) +#ifdef USE_ITHREADS +# define CopFILE(c) ((c)->cop_file) +# define CopFILEGV(c) (CopFILE(c) \ + ? gv_fetchfile(CopFILE(c)) : Nullgv) +# define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv)) /* XXX */ +# define CopFILESV(c) (CopFILE(c) \ + ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv) +# define CopFILEAV(c) (CopFILE(c) \ + ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav) +# define CopSTASHPV(c) ((c)->cop_stashpv) +# define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = savepv(pv)) /* XXX */ +# define CopSTASH(c) (CopSTASHPV(c) \ + ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv) +# define CopSTASH_set(c,hv) CopSTASHPV_set(c, HvNAME(hv)) +# define CopSTASH_eq(c,hv) (hv \ + && (CopSTASHPV(c) == HvNAME(hv) \ + || (CopSTASHPV(c) && HvNAME(hv) \ + && strEQ(CopSTASHPV(c), HvNAME(hv))))) +#else +# define CopFILEGV(c) ((c)->cop_filegv) +# define CopFILEGV_set(c,gv) ((c)->cop_filegv = gv) +# define CopFILE_set(c,pv) ((c)->cop_filegv = gv_fetchfile(pv)) +# define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv) +# define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav) +# define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch) +# define CopSTASH(c) ((c)->cop_stash) +# define CopSTASH_set(c,hv) ((c)->cop_stash = hv) +# define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch) +# define CopSTASHPV_set(c,pv) CopSTASH_set(c, gv_stashpv(pv,GV_ADD)) +# define CopSTASH_eq(c,hv) (CopSTASH(c) == hv) +#endif /* USE_ITHREADS */ + +#define CopSTASH_ne(c,hv) (!CopSTASH_eq(c,hv)) +#define CopLINE(c) ((c)->cop_line) +#define CopLINE_inc(c) (++CopLINE(c)) +#define CopLINE_dec(c) (--CopLINE(c)) +#define CopLINE_set(c,l) (CopLINE(c) = (l)) + /* * Here we have some enormously heavy (or at least ponderous) wizardry. */ @@ -52,41 +95,51 @@ struct block_sub { cx->blk_sub.dfoutgv = PL_defoutgv; \ (void)SvREFCNT_inc(cx->blk_sub.dfoutgv) -#define POPSUB(cx) \ - { struct block_sub cxsub; \ - POPSUB1(cx); \ - POPSUB2(); } - -#define POPSUB1(cx) \ - cxsub = cx->blk_sub; /* because DESTROY may clobber *cx */ - #ifdef USE_THREADS -#define POPSAVEARRAY() NOOP +# define POP_SAVEARRAY() NOOP #else -#define POPSAVEARRAY() \ +# define POP_SAVEARRAY() \ STMT_START { \ SvREFCNT_dec(GvAV(PL_defgv)); \ - GvAV(PL_defgv) = cxsub.savearray; \ + GvAV(PL_defgv) = cx->blk_sub.savearray; \ } STMT_END #endif /* USE_THREADS */ -#define POPSUB2() \ - if (cxsub.hasargs) { \ - POPSAVEARRAY(); \ +#ifdef USE_ITHREADS + /* junk in @_ spells trouble when cloning CVs, so don't leave any */ +# define CLEAR_ARGARRAY() av_clear(cx->blk_sub.argarray) +#else +# define CLEAR_ARGARRAY() NOOP +#endif /* USE_ITHREADS */ + + +#define POPSUB(cx,sv) \ + STMT_START { \ + if (cx->blk_sub.hasargs) { \ + POP_SAVEARRAY(); \ /* abandon @_ if it got reified */ \ - if (AvREAL(cxsub.argarray)) { \ - SSize_t fill = AvFILLp(cxsub.argarray); \ - SvREFCNT_dec(cxsub.argarray); \ - cxsub.argarray = newAV(); \ - av_extend(cxsub.argarray, fill); \ - AvFLAGS(cxsub.argarray) = AVf_REIFY; \ - PL_curpad[0] = (SV*)cxsub.argarray; \ + if (AvREAL(cx->blk_sub.argarray)) { \ + SSize_t fill = AvFILLp(cx->blk_sub.argarray); \ + SvREFCNT_dec(cx->blk_sub.argarray); \ + cx->blk_sub.argarray = newAV(); \ + av_extend(cx->blk_sub.argarray, fill); \ + AvFLAGS(cx->blk_sub.argarray) = AVf_REIFY; \ + PL_curpad[0] = (SV*)cx->blk_sub.argarray; \ + } \ + else { \ + CLEAR_ARGARRAY(); \ } \ } \ - if (cxsub.cv) { \ - if (!(CvDEPTH(cxsub.cv) = cxsub.olddepth)) \ - SvREFCNT_dec(cxsub.cv); \ - } + sv = (SV*)cx->blk_sub.cv; \ + if (sv && (CvDEPTH((CV*)sv) = cx->blk_sub.olddepth)) \ + sv = Nullsv; \ + } STMT_END + +#define LEAVESUB(sv) \ + STMT_START { \ + if (sv) \ + SvREFCNT_dec(sv); \ + } STMT_END #define POPFORMAT(cx) \ setdefout(cx->blk_sub.dfoutgv); \ @@ -103,15 +156,16 @@ struct block_eval { #define PUSHEVAL(cx,n,fgv) \ cx->blk_eval.old_in_eval = PL_in_eval; \ - cx->blk_eval.old_op_type = PL_op->op_type; \ - cx->blk_eval.old_name = n; \ - cx->blk_eval.old_eval_root = PL_eval_root; \ + cx->blk_eval.old_op_type = PL_op->op_type; \ + cx->blk_eval.old_name = (n ? savepv(n) : Nullch); \ + cx->blk_eval.old_eval_root = PL_eval_root; \ cx->blk_eval.cur_text = PL_linestr; #define POPEVAL(cx) \ PL_in_eval = cx->blk_eval.old_in_eval; \ optype = cx->blk_eval.old_op_type; \ - PL_eval_root = cx->blk_eval.old_eval_root; + PL_eval_root = cx->blk_eval.old_eval_root; \ + Safefree(cx->blk_eval.old_name); /* loop context */ struct block_loop { @@ -120,7 +174,11 @@ struct block_loop { OP * redo_op; OP * next_op; OP * last_op; +#ifdef USE_ITHREADS + void * iterdata; +#else SV ** itervar; +#endif SV * itersave; SV * iterlval; AV * iterary; @@ -128,35 +186,43 @@ struct block_loop { IV itermax; }; -#define PUSHLOOP(cx, ivar, s) \ - cx->blk_loop.label = PL_curcop->cop_label; \ - cx->blk_loop.resetsp = s - PL_stack_base; \ +#ifdef USE_ITHREADS +# define CxITERVAR(c) \ + ((c)->blk_loop.iterdata \ + ? (CxPADLOOP(cx) \ + ? &PL_curpad[(PADOFFSET)(c)->blk_loop.iterdata] \ + : &GvSV((GV*)(c)->blk_loop.iterdata)) \ + : (SV**)NULL) +# define CX_ITERDATA_SET(cx,idata) \ + if (cx->blk_loop.iterdata = (idata)) \ + cx->blk_loop.itersave = SvREFCNT_inc(*CxITERVAR(cx)); +#else +# define CxITERVAR(c) ((c)->blk_loop.itervar) +# define CX_ITERDATA_SET(cx,ivar) \ + if (cx->blk_loop.itervar = (SV**)(ivar)) \ + cx->blk_loop.itersave = SvREFCNT_inc(*CxITERVAR(cx)); +#endif + +#define PUSHLOOP(cx, dat, s) \ + cx->blk_loop.label = PL_curcop->cop_label; \ + cx->blk_loop.resetsp = s - PL_stack_base; \ cx->blk_loop.redo_op = cLOOP->op_redoop; \ cx->blk_loop.next_op = cLOOP->op_nextop; \ cx->blk_loop.last_op = cLOOP->op_lastop; \ - if (cx->blk_loop.itervar = (ivar)) \ - cx->blk_loop.itersave = SvREFCNT_inc(*cx->blk_loop.itervar);\ cx->blk_loop.iterlval = Nullsv; \ cx->blk_loop.iterary = Nullav; \ - cx->blk_loop.iterix = -1; + cx->blk_loop.iterix = -1; \ + CX_ITERDATA_SET(cx,dat); #define POPLOOP(cx) \ - { struct block_loop cxloop; \ - POPLOOP1(cx); \ - POPLOOP2(); } - -#define POPLOOP1(cx) \ - cxloop = cx->blk_loop; /* because DESTROY may clobber *cx */ \ - newsp = PL_stack_base + cxloop.resetsp; - -#define POPLOOP2() \ - SvREFCNT_dec(cxloop.iterlval); \ - if (cxloop.itervar) { \ - sv_2mortal(*cxloop.itervar); \ - *cxloop.itervar = cxloop.itersave; \ + SvREFCNT_dec(cx->blk_loop.iterlval); \ + if (CxITERVAR(cx)) { \ + SV **s_v_p = CxITERVAR(cx); \ + sv_2mortal(*s_v_p); \ + *s_v_p = cx->blk_loop.itersave; \ } \ - if (cxloop.iterary && cxloop.iterary != PL_curstack) \ - SvREFCNT_dec(cxloop.iterary); + if (cx->blk_loop.iterary && cx->blk_loop.iterary != PL_curstack)\ + SvREFCNT_dec(cx->blk_loop.iterary); /* context common to subroutines, evals and loops */ struct block { @@ -195,7 +261,7 @@ struct block { cx->blk_oldretsp = PL_retstack_ix, \ cx->blk_oldpm = PL_curpm, \ cx->blk_gimme = gimme; \ - DEBUG_l( PerlIO_printf(PerlIO_stderr(), "Entering block %ld, type %s\n", \ + DEBUG_l( PerlIO_printf(Perl_debug_log, "Entering block %ld, type %s\n", \ (long)cxstack_ix, PL_block_type[CxTYPE(cx)]); ) /* Exit a block (RETURN and LAST). */ @@ -207,7 +273,7 @@ struct block { PL_retstack_ix = cx->blk_oldretsp, \ pm = cx->blk_oldpm, \ gimme = cx->blk_gimme; \ - DEBUG_l( PerlIO_printf(PerlIO_stderr(), "Leaving block %ld, type %s\n", \ + DEBUG_l( PerlIO_printf(Perl_debug_log, "Leaving block %ld, type %s\n", \ (long)cxstack_ix+1,PL_block_type[CxTYPE(cx)]); ) /* Continue a block elsewhere (NEXT and REDO). */ @@ -286,12 +352,23 @@ struct context { #define CXt_LOOP 3 #define CXt_SUBST 4 #define CXt_BLOCK 5 +#define CXt_FORMAT 6 /* private flags for CXt_EVAL */ #define CXp_REAL 0x00000100 /* truly eval'', not a lookalike */ +#ifdef USE_ITHREADS +/* private flags for CXt_LOOP */ +# define CXp_PADVAR 0x00000100 /* itervar lives on pad, iterdata + has pad offset; if not set, + iterdata holds GV* */ +# define CxPADLOOP(c) (((c)->cx_type & (CXt_LOOP|CXp_PADVAR)) \ + == (CXt_LOOP|CXp_PADVAR)) +#endif + #define CxTYPE(c) ((c)->cx_type & CXTYPEMASK) -#define CxREALEVAL(c) (((c)->cx_type & (CXt_EVAL|CXp_REAL)) == (CXt_EVAL|CXp_REAL)) +#define CxREALEVAL(c) (((c)->cx_type & (CXt_EVAL|CXp_REAL)) \ + == (CXt_EVAL|CXp_REAL)) #define CXINC (cxstack_ix < cxstack_max ? ++cxstack_ix : (cxstack_ix = cxinc())) @@ -306,7 +383,6 @@ struct context { #define G_NOARGS 8 /* Don't construct a @_ array. */ #define G_KEEPERR 16 /* Append errors to $@, don't overwrite it */ #define G_NODEBUG 32 /* Disable debugging at toplevel. */ -#define G_NOCATCH 64 /* Don't do CATCH_SET() */ /* flag bits for PL_in_eval */ #define EVAL_NULL 0 /* not in an eval */ @@ -338,7 +414,7 @@ struct stackinfo { I32 si_type; /* type of runlevel */ struct stackinfo * si_prev; struct stackinfo * si_next; - I32 * si_markbase; /* where markstack begins for us. + I32 si_markoff; /* offset where markstack begins for us. * currently used only with DEBUGGING, * but not #ifdef-ed for bincompat */ }; @@ -350,9 +426,10 @@ typedef struct stackinfo PERL_SI; #define cxstack_max (PL_curstackinfo->si_cxmax) #ifdef DEBUGGING -# define SET_MARKBASE PL_curstackinfo->si_markbase = PL_markstack_ptr +# define SET_MARK_OFFSET \ + PL_curstackinfo->si_markoff = PL_markstack_ptr - PL_markstack #else -# define SET_MARKBASE NOOP +# define SET_MARK_OFFSET NOOP #endif #define PUSHSTACKi(type) \ @@ -368,7 +445,7 @@ typedef struct stackinfo PERL_SI; AvFILLp(next->si_stack) = 0; \ SWITCHSTACK(PL_curstack,next->si_stack); \ PL_curstackinfo = next; \ - SET_MARKBASE; \ + SET_MARK_OFFSET; \ } STMT_END #define PUSHSTACK PUSHSTACKi(PERLSI_UNKNOWN) @@ -380,7 +457,7 @@ typedef struct stackinfo PERL_SI; djSP; \ PERL_SI *prev = PL_curstackinfo->si_prev; \ if (!prev) { \ - PerlIO_printf(PerlIO_stderr(), "panic: POPSTACK\n"); \ + PerlIO_printf(Perl_error_log, "panic: POPSTACK\n"); \ my_exit(1); \ } \ SWITCHSTACK(PL_curstack,prev->si_stack); \ diff --git a/cv.h b/cv.h index 67d4a8e..06cbb89 100644 --- a/cv.h +++ b/cv.h @@ -7,7 +7,8 @@ * */ -/* This structure much match the beginning of XPVFM */ +/* This structure much match XPVCV in B/C.pm and the beginning of XPVFM + * in sv.h */ struct xpvcv { char * xpv_pv; /* pointer to malloced string */ @@ -24,8 +25,8 @@ struct xpvcv { void (*xcv_xsub) (pTHXo_ CV*); ANY xcv_xsubany; GV * xcv_gv; - GV * xcv_filegv; - long xcv_depth; /* >= 2 indicates recursive call */ + char * xcv_file; + long xcv_depth; /* >= 2 indicates recursive call */ AV * xcv_padlist; CV * xcv_outside; #ifdef USE_THREADS @@ -43,7 +44,8 @@ struct xpvcv { #define CvXSUB(sv) ((XPVCV*)SvANY(sv))->xcv_xsub #define CvXSUBANY(sv) ((XPVCV*)SvANY(sv))->xcv_xsubany #define CvGV(sv) ((XPVCV*)SvANY(sv))->xcv_gv -#define CvFILEGV(sv) ((XPVCV*)SvANY(sv))->xcv_filegv +#define CvFILE(sv) ((XPVCV*)SvANY(sv))->xcv_file +#define CvFILEGV(sv) (gv_fetchfile(CvFILE(sv)) #define CvDEPTH(sv) ((XPVCV*)SvANY(sv))->xcv_depth #define CvPADLIST(sv) ((XPVCV*)SvANY(sv))->xcv_padlist #define CvOUTSIDE(sv) ((XPVCV*)SvANY(sv))->xcv_outside diff --git a/cygwin/Makefile.SHs b/cygwin/Makefile.SHs index 4a37907..d466bde 100644 --- a/cygwin/Makefile.SHs +++ b/cygwin/Makefile.SHs @@ -124,9 +124,9 @@ $(LIBPERL)$(LIB_EXT): $& perl$(OBJ_EXT) $(cwobj) ld2 # build problems but that's not obvious to the novice. # The Module used here must not depend on Config or any extensions. -miniperl: $& miniperlmain$(OBJ_EXT) $(LIBPERL)s$(LIB_EXT) - $(LDLIBPTH) $(CC) $(LARGE) $(CLDFLAGS) -o miniperl miniperlmain$(OBJ_EXT) $(LLIBPERL)s $(libs) - $(LDLIBPTH) ./miniperl -w -Ilib -MExporter -e 0 || $(MAKE) minitest +miniperl: $& miniperlmain$(OBJ_EXT) $(LIBPERL)s$(LIB_EXT) opmini$(OBJ_EXT) + $(LDLIBPTH) $(CC) $(LARGE) $(CLDFLAGS) -o miniperl miniperlmain$(OBJ_EXT) opmini$(OBJ_EXT) $(LLIBPERL)s $(libs) + $(LDLIBPTH) ./miniperl -w -Ilib -MExporter -e '' || $(MAKE) minitest !NO!SUBS! ;; @@ -146,9 +146,9 @@ $(LIBPERL)$(LIB_EXT): $& perl$(OBJ_EXT) $(cwobj) # build problems but that's not obvious to the novice. # The Module used here must not depend on Config or any extensions. -miniperl: $& miniperlmain$(OBJ_EXT) $(LIBPERL)$(LIB_EXT) - $(LDLIBPTH) $(CC) $(LARGE) $(CLDFLAGS) -o miniperl miniperlmain$(OBJ_EXT) $(LLIBPERL) $(libs) - $(LDLIBPTH) ./miniperl -w -Ilib -MExporter -e 0 || $(MAKE) minitest +miniperl: $& miniperlmain$(OBJ_EXT) $(LIBPERL)$(LIB_EXT) opmini$(OBJ_EXT) + $(LDLIBPTH) $(CC) $(LARGE) $(CLDFLAGS) -o miniperl miniperlmain$(OBJ_EXT) opmini$(OBJ_EXT) $(LLIBPERL) $(libs) + $(LDLIBPTH) ./miniperl -w -Ilib -MExporter -e '' || $(MAKE) minitest !NO!SUBS! ;; @@ -159,6 +159,9 @@ esac # $spitshell >>Makefile <<'!NO!SUBS!' +opmini$(OBJ_EXT) : op.c + $(CCCMD) $(PLDLFLAGS) -DPERL_EXTERNAL_GLOB -o opmini$(OBJ_EXT) op.c + perl: $& perlmain$(OBJ_EXT) $(LIBPERL)$(LIB_EXT) $(DYNALOADER) $(static_ext) ext.libs $(SHRPENV) $(LDLIBPTH) $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o perl perlmain$(OBJ_EXT) $(DYNALOADER) $(static_ext) $(LLIBPERL) `cat ext.libs` $(libs) diff --git a/deb.c b/deb.c index b6456e6..36b8ca3 100644 --- a/deb.c +++ b/deb.c @@ -47,46 +47,36 @@ Perl_vdeb(pTHX_ const char *pat, va_list *args) #ifdef DEBUGGING dTHR; register I32 i; - GV* gv = PL_curcop->cop_filegv; + char* file = CopFILE(PL_curcop); #ifdef USE_THREADS - PerlIO_printf(Perl_debug_log, "0x%lx (%s:%ld)\t", - (unsigned long) thr, - SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "", - (long)PL_curcop->cop_line); + PerlIO_printf(Perl_debug_log, "0x%"UVxf" (%s:%ld)\t", + PTR2UV(thr), + (file ? file : ""), + (long)CopLINE(PL_curcop)); #else - PerlIO_printf(Perl_debug_log, "(%s:%ld)\t", - SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "", - (long)PL_curcop->cop_line); + PerlIO_printf(Perl_debug_log, "(%s:%ld)\t", (file ? file : ""), + (long)CopLINE(PL_curcop)); #endif /* USE_THREADS */ - for (i=0; isi_markbase; + I32 *markscan = PL_markstack + PL_curstackinfo->si_markoff; if (i < 0) i = 0; @@ -108,8 +98,9 @@ Perl_debstack(pTHX) break; #ifdef USE_THREADS - PerlIO_printf(Perl_debug_log, i ? "0x%lx => ... " : "0x%lx => ", - (unsigned long) thr); + PerlIO_printf(Perl_debug_log, + i ? "0x%"UVxf" => ... " : "0x%lx => ", + PTR2UV(thr)); #else PerlIO_printf(Perl_debug_log, i ? " => ... " : " => "); #endif /* USE_THREADS */ diff --git a/djgpp/config.over b/djgpp/config.over index c624386..f47e7fc 100644 --- a/djgpp/config.over +++ b/djgpp/config.over @@ -28,7 +28,11 @@ repair() -e 's/thread/Thread/'\ -e 's/byteload/ByteLoader/'\ -e 's=devel/peek=Devel/Peek='\ - -e 's=devel/dprof=Devel/DProf=' + -e 's=devel/dprof=Devel/DProf='\ + -e 's=file/=='\ + -e 's=File/=='\ + -e 's=glob=='\ + -e 's=Glob==' } static_ext=$(repair "$static_ext") extensions=$(repair "$extensions") diff --git a/djgpp/configure.bat b/djgpp/configure.bat index 6073f44..e7d41d7 100644 --- a/djgpp/configure.bat +++ b/djgpp/configure.bat @@ -29,7 +29,6 @@ goto end sh -c 'if test ! -d /tmp; then mkdir /tmp; fi' cp djgpp.c config.over .. cd .. -mv ext/B/defsu* ext/B/defsubsh.PL echo Running sed... sh djgpp/djgppsed.sh diff --git a/djgpp/djgppsed.sh b/djgpp/djgppsed.sh index a25e894..b62acfd 100644 --- a/djgpp/djgppsed.sh +++ b/djgpp/djgppsed.sh @@ -24,8 +24,6 @@ SDBHASH='s=dbhash\.tmp=dbhash_tmp=g' SSTAT='s=\.\(stat\.\)=_\1=g' STMP2='s=tmp2=tm2=g' SPACKLIST='s=\.\(packlist\)=_\1=g' -SDEFSUB='s=defsubs\.h=defsubsh=g' -SPLPLI='s=PL/;=PL/i;=g' sed -e $SCONFIG -e $SGREPTMP -e $SECHOTMP -e $SDDC -e $SOUT -e 's=\.\( \./\$file\)$=sh\1=g' Configure |tr -d '\r' >s; mv -f s Configure sed -e $SEXISTS -e $SLIST -e $SCONFIG Makefile.SH |tr -d '\r' >s; mv -f s Makefile.SH @@ -49,6 +47,3 @@ sed -e $SPACKLIST lib/ExtUtils/Installed.pm >s; mv -f s lib/ExtUtils/Installed.p sed -e $SPACKLIST lib/ExtUtils/Packlist.pm >s; mv -f s lib/ExtUtils/Packlist.pm sed -e $SPACKLIST lib/ExtUtils/inst >s; mv -f s lib/ExtUtils/inst sed -e $SABC t/io/iprefix.t >s; mv -f s t/io/iprefix.t -sed -e $SDEFSUB ext/B/Makefile.PL >s; mv -f s ext/B/Makefile.PL -sed -e $SDEFSUB ext/B/B.xs >s; mv -f s ext/B/B.xs -sed -e $SDEFSUB -e $SPLPLI ext/B/defsubsh.PL >s; mv -f s ext/B/defsubsh.PL diff --git a/doio.c b/doio.c index 2baecec..d2385f0 100644 --- a/doio.c +++ b/doio.c @@ -134,7 +134,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, else result = PerlIO_close(IoIFP(io)); if (result == EOF && fd > PL_maxsysfd) - PerlIO_printf(PerlIO_stderr(), + PerlIO_printf(Perl_error_log, "Warning: unable to close filehandle %s properly.\n", GvENAME(gv)); IoOFP(io) = IoIFP(io) = Nullfp; @@ -183,28 +183,29 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, } } else { - char *myname; - char *type = name; - char *otype = name; + char *type; + char *oname = name; STRLEN tlen; - STRLEN otlen = len; + STRLEN olen = len; char mode[3]; /* stdio file mode ("r\0" or "r+\0") */ int dodup; + type = savepvn(name, len); + tlen = len; + SAVEFREEPV(type); if (num_svs) { - type = name; - name = SvPV(svs, tlen) ; - len = (I32)tlen; + STRLEN l; + name = SvPV(svs, l) ; + len = (I32)l; + name = savepvn(name, len); + SAVEFREEPV(name); } - - tlen = otlen; - myname = savepvn(name, len); - SAVEFREEPV(myname); - name = myname; - if (!num_svs) + else { while (tlen && isSPACE(type[tlen-1])) type[--tlen] = '\0'; - + name = type; + len = tlen; + } mode[0] = mode[1] = mode[2] = '\0'; IoTYPE(io) = *type; if (*type == '+' && tlen > 1 && type[tlen-1] != '|') { /* scary */ @@ -216,12 +217,14 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, if (*type == '|') { if (num_svs && (tlen != 2 || type[1] != '-')) { unknown_desr: - Perl_croak(aTHX_ "Unknown open() mode '%.*s'", otlen, otype); + Perl_croak(aTHX_ "Unknown open() mode '%.*s'", olen, oname); } /*SUPPRESS 530*/ - for (type++; isSPACE(*type); type++) ; - if (!num_svs) + for (type++, tlen--; isSPACE(*type); type++, tlen--) ; + if (!num_svs) { name = type; + len = tlen; + } if (*name == '\0') { /* command is missing 19990114 */ dTHR; if (ckWARN(WARN_PIPE)) @@ -232,11 +235,11 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, if (strNE(name,"-") || num_svs) TAINT_ENV(); TAINT_PROPER("piped open"); - if (name[strlen(name)-1] == '|') { + if (name[len-1] == '|') { dTHR; - name[strlen(name)-1] = '\0' ; + name[--len] = '\0' ; if (ckWARN(WARN_PIPE)) - Perl_warner(aTHX_ WARN_PIPE, "Can't do bidirectional pipe"); + Perl_warner(aTHX_ WARN_PIPE, "Can't open bidirectional pipe"); } fp = PerlProc_popen(name,"w"); writing = 1; @@ -308,7 +311,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, if (!(fp = PerlIO_fdopen(fd,mode))) { if (dodup) PerlLIO_close(fd); - } + } } } else { @@ -452,6 +455,7 @@ Perl_do_open9(pTHX_ GV *gv, register char *name, I32 len, int as_raw, } #endif IoIFP(io) = fp; + IoFLAGS(io) &= ~IOf_NOLINE; if (writing) { dTHR; if (IoTYPE(io) == 's' @@ -484,9 +488,18 @@ Perl_nextargv(pTHX_ register GV *gv) #endif Uid_t fileuid; Gid_t filegid; + IO *io = GvIOp(gv); if (!PL_argvoutgv) PL_argvoutgv = gv_fetchpv("ARGVOUT",TRUE,SVt_PVIO); + if (io && (IoFLAGS(io) & IOf_ARGV) && (IoFLAGS(io) & IOf_START)) { + IoFLAGS(io) &= ~IOf_START; + if (PL_inplace) { + if (!PL_argvout_stack) + PL_argvout_stack = newAV(); + av_push(PL_argvout_stack, SvREFCNT_inc(PL_defoutgv)); + } + } if (PL_filemode & (S_ISUID|S_ISGID)) { PerlIO_flush(IoIFP(GvIOn(PL_argvoutgv))); /* chmod must follow last write */ #ifdef HAS_FCHMOD @@ -610,11 +623,12 @@ Perl_nextargv(pTHX_ register GV *gv) SETERRNO(0,0); /* in case sprintf set errno */ #ifdef VMS if (!do_open(PL_argvoutgv,SvPVX(sv),SvCUR(sv),PL_inplace!=0, - O_WRONLY|O_CREAT|O_TRUNC,0,Nullfp)) { + O_WRONLY|O_CREAT|O_TRUNC,0,Nullfp)) #else if (!do_open(PL_argvoutgv,SvPVX(sv),SvCUR(sv),PL_inplace!=0, - O_WRONLY|O_CREAT|OPEN_EXCL,0666,Nullfp)) { + O_WRONLY|O_CREAT|OPEN_EXCL,0666,Nullfp)) #endif + { if (ckWARN_d(WARN_INPLACE)) Perl_warner(aTHX_ WARN_INPLACE, "Can't do inplace edit on %s: %s", PL_oldname, Strerror(errno) ); @@ -650,15 +664,25 @@ Perl_nextargv(pTHX_ register GV *gv) if (!S_ISREG(PL_statbuf.st_mode)) Perl_warner(aTHX_ WARN_INPLACE, "Can't do inplace edit: %s is not a regular file", - PL_oldname ); + PL_oldname); else - Perl_warner(aTHX_ WARN_INPLACE, "Can't open %s: %s\n", + Perl_warner(aTHX_ WARN_INPLACE, "Can't open %s: %s", PL_oldname, Strerror(errno)); } } } + if (io && (IoFLAGS(io) & IOf_ARGV)) + IoFLAGS(io) |= IOf_START; if (PL_inplace) { (void)do_close(PL_argvoutgv,FALSE); + if (io && (IoFLAGS(io) & IOf_ARGV) + && PL_argvout_stack && AvFILLp(PL_argvout_stack) >= 0) + { + GV *oldout = (GV*)av_pop(PL_argvout_stack); + setdefout(oldout); + SvREFCNT_dec(oldout); + return Nullfp; + } setdefout(gv_fetchpv("STDOUT",TRUE,SVt_PVIO)); } return Nullfp; @@ -1006,24 +1030,17 @@ Perl_do_print(pTHX_ register SV *sv, PerlIO *fp) { dTHR; if (ckWARN(WARN_UNINITIALIZED)) - Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit); + report_uninit(); } return TRUE; case SVt_IV: if (SvIOK(sv)) { if (SvGMAGICAL(sv)) mg_get(sv); -#ifdef IV_IS_QUAD - if (SvIsUV(sv)) - PerlIO_printf(fp, "%" PERL_PRIu64, (UV)SvUVX(sv)); - else - PerlIO_printf(fp, "%" PERL_PRId64, (IV)SvIVX(sv)); -#else if (SvIsUV(sv)) - PerlIO_printf(fp, "%lu", (unsigned long)SvUVX(sv)); + PerlIO_printf(fp, "%"UVuf, (UV)SvUVX(sv)); else - PerlIO_printf(fp, "%ld", (long)SvIVX(sv)); -#endif + PerlIO_printf(fp, "%"IVdf, (IV)SvIVX(sv)); return !PerlIO_error(fp); } /* FALL THROUGH */ @@ -1051,7 +1068,7 @@ Perl_my_stat(pTHX) if (PL_op->op_flags & OPf_REF) { EXTEND(SP,1); - tmpgv = cGVOP->op_gv; + tmpgv = cGVOP_gv; do_fstat: io = GvIO(tmpgv); if (io && IoIFP(io)) { @@ -1104,7 +1121,7 @@ Perl_my_lstat(pTHX) STRLEN n_a; if (PL_op->op_flags & OPf_REF) { EXTEND(SP,1); - if (cGVOP->op_gv == PL_defgv) { + if (cGVOP_gv == PL_defgv) { if (PL_laststype != OP_LSTAT) Perl_croak(aTHX_ "The stat preceding -l _ wasn't an lstat"); return PL_laststatval; @@ -1133,6 +1150,9 @@ bool Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp, int fd, int do_report) { +#ifdef MACOS_TRADITIONAL + Perl_croak(aTHX_ "exec? I'm not *that* kind of operating system"); +#else register char **a; char *tmps; STRLEN n_a; @@ -1165,6 +1185,7 @@ Perl_do_aexec5(pTHX_ SV *really, register SV **mark, register SV **sp, } } do_execfree(); +#endif return FALSE; } @@ -1181,7 +1202,7 @@ Perl_do_execfree(pTHX) } } -#if !defined(OS2) && !defined(WIN32) && !defined(DJGPP) && !defined(EPOC) +#if !defined(OS2) && !defined(WIN32) && !defined(DJGPP) && !defined(EPOC) && !defined(MACOS_TRADITIONAL) bool Perl_do_exec(pTHX_ char *cmd) @@ -1562,6 +1583,10 @@ Perl_cando(pTHX_ Mode_t mode, Uid_t effective, register Stat_t *statbufp) bool Perl_ingroup(pTHX_ Gid_t testgid, Uid_t effective) { +#ifdef MACOS_TRADITIONAL + /* This is simply not correct for AppleShare, but fix it yerself. */ + return TRUE; +#else if (testgid == (effective ? PL_egid : PL_gid)) return TRUE; #ifdef HAS_GETGROUPS @@ -1579,6 +1604,7 @@ Perl_ingroup(pTHX_ Gid_t testgid, Uid_t effective) } #endif return FALSE; +#endif } #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) diff --git a/doop.c b/doop.c index 1b7d02d..990898d 100644 --- a/doop.c +++ b/doop.c @@ -719,7 +719,7 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size) if (offset >= srclen) retnum = 0; else - retnum = (UV) s[offset] << 8; + retnum = (UV) s[offset] << 8; } else if (size == 32) { if (offset >= srclen) @@ -737,7 +737,7 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size) ((UV) s[offset + 1] << 16) + ( s[offset + 2] << 8); } -#ifdef HAS_QUAD +#ifdef UV_IS_QUAD else if (size == 64) { dTHR; if (ckWARN(WARN_PORTABLE)) @@ -786,7 +786,7 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size) ((UV) s[offset + 3] << 32) + ((UV) s[offset + 4] << 24) + ((UV) s[offset + 5] << 16) + - ( s[offset + 6] << 8); + ( s[offset + 6] << 8); } #endif } @@ -799,7 +799,7 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size) retnum = s[offset]; else if (size == 16) retnum = - ((UV) s[offset] << 8) + + ((UV) s[offset] << 8) + s[offset + 1]; else if (size == 32) retnum = @@ -807,7 +807,7 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size) ((UV) s[offset + 1] << 16) + ( s[offset + 2] << 8) + s[offset + 3]; -#ifdef HAS_QUAD +#ifdef UV_IS_QUAD else if (size == 64) { dTHR; if (ckWARN(WARN_PORTABLE)) @@ -820,7 +820,7 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size) ((UV) s[offset + 3] << 32) + ((UV) s[offset + 4] << 24) + ((UV) s[offset + 5] << 16) + - ( s[offset + 6] << 8) + + ( s[offset + 6] << 8) + s[offset + 7]; } #endif @@ -880,7 +880,7 @@ Perl_do_vecset(pTHX_ SV *sv) s[offset+2] = (lval >> 8) & 0xff; s[offset+3] = lval & 0xff; } -#ifdef HAS_QUAD +#ifdef UV_IS_QUAD else if (size == 64) { dTHR; if (ckWARN(WARN_PORTABLE)) diff --git a/dosish.h b/dosish.h index 7e72d67..7b2a1bd 100644 --- a/dosish.h +++ b/dosish.h @@ -19,6 +19,7 @@ # ifdef USE_THREADS # define OLD_PTHREADS_API # endif +# define PERL_FS_VER_FMT "%d_%d_%d" #else /* DJGPP */ # ifdef WIN32 # define PERL_SYS_INIT(c,v) Perl_win32_init(c,v) @@ -31,7 +32,6 @@ #define PERL_SYS_TERM() MALLOC_TERM #define dXSUB_SYS -#define TMPPATH "plXXXXXX" /* * 5.003_07 and earlier keyed on #ifdef MSDOS for determining if we were diff --git a/dump.c b/dump.c index 7f1dba4..ee64af5 100644 --- a/dump.c +++ b/dump.c @@ -30,7 +30,7 @@ void Perl_dump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args) { dTHR; - PerlIO_printf(file, "%*s", level*PL_dumpindent, ""); + PerlIO_printf(file, "%*s", (int)(level*PL_dumpindent), ""); PerlIO_vprintf(file, pat, *args); } @@ -283,18 +283,11 @@ Perl_sv_peek(pTHX_ SV *sv) Perl_sv_catpvf(aTHX_ t, "(%g)",SvNVX(sv)); RESTORE_NUMERIC_LOCAL(); } - else if (SvIOKp(sv)) { /* XXXX: IV, UV? */ -#ifdef IV_IS_QUAD + else if (SvIOKp(sv)) { if (SvIsUV(sv)) - Perl_sv_catpvf(aTHX_ t, "(%" PERL_PRIu64 ")",(UV)SvUVX(sv)); + Perl_sv_catpvf(aTHX_ t, "(%"UVuf")", (UV)SvUVX(sv)); else - Perl_sv_catpvf(aTHX_ t, "(%" PERL_PRId64 ")",(IV)SvIVX(sv)); -#else - if (SvIsUV(sv)) - Perl_sv_catpvf(aTHX_ t, "(%lu)",(unsigned long)SvUVX(sv)); - else - Perl_sv_catpvf(aTHX_ t, "(%ld)",(long)SvIVX(sv)); -#endif + Perl_sv_catpvf(aTHX_ t, "(%"IVdf")", (IV)SvIVX(sv)); } else sv_catpv(t, "()"); @@ -384,7 +377,9 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o) PerlIO_printf(file, "%-4d", o->op_seq); else PerlIO_printf(file, " "); - PerlIO_printf(file, "%*sTYPE = %s ===> ", PL_dumpindent*level-4, "", PL_op_name[o->op_type]); + PerlIO_printf(file, + "%*sTYPE = %s ===> ", + (int)(PL_dumpindent*level-4), "", PL_op_name[o->op_type]); if (o->op_next) { if (o->op_seq) PerlIO_printf(file, "%d\n", o->op_next->op_seq); @@ -400,11 +395,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o) Perl_dump_indent(aTHX_ level, file, "TARG = %d\n", o->op_targ); } #ifdef DUMPADDR -#ifdef IV_IS_QUAD - Perl_dump_indent(aTHX_ level, file, "ADDR = 0x%" PERL_PRIx64 " => 0x%" PERL_PRIx64 "\n", (IV)o, (IV)o->op_next); -#else - Perl_dump_indent(aTHX_ level, file, "ADDR = 0x%lx => 0x%lx\n", (long)o, (long)o->op_next); -#endif + Perl_dump_indent(aTHX_ level, file, "ADDR = 0x%"UVxf" => 0x%"UVxf"\n", (UV)o, (UV)o->op_next); #endif if (o->op_flags) { SV *tmpsv = newSVpvn("", 0); @@ -494,6 +485,8 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o) else { if (o->op_private & HINT_STRICT_REFS) sv_catpv(tmpsv, ",STRICT_REFS"); + if (o->op_private & OPpOUR_INTRO) + sv_catpv(tmpsv, ",OUR_INTRO"); } } else if (o->op_type == OP_CONST) { @@ -521,30 +514,41 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o) } switch (o->op_type) { + case OP_AELEMFAST: case OP_GVSV: case OP_GV: - if (cGVOPo->op_gv) { +#ifdef USE_ITHREADS + Perl_dump_indent(aTHX_ level, file, "PADIX = %d\n", cPADOPo->op_padix); +#else + if (cSVOPo->op_sv) { SV *tmpsv = NEWSV(0,0); ENTER; SAVEFREESV(tmpsv); - gv_fullname3(tmpsv, cGVOPo->op_gv, Nullch); + gv_fullname3(tmpsv, (GV*)cSVOPo->op_sv, Nullch); Perl_dump_indent(aTHX_ level, file, "GV = %s\n", SvPV(tmpsv, n_a)); LEAVE; } else Perl_dump_indent(aTHX_ level, file, "GV = NULL\n"); +#endif break; case OP_CONST: + Perl_dump_indent(aTHX_ level, file, "SV = %s\n", SvPEEK(cSVOPo_sv)); + break; case OP_METHOD_NAMED: Perl_dump_indent(aTHX_ level, file, "SV = %s\n", SvPEEK(cSVOPo->op_sv)); break; case OP_SETSTATE: case OP_NEXTSTATE: case OP_DBSTATE: - if (cCOPo->cop_line) - Perl_dump_indent(aTHX_ level, file, "LINE = %d\n",cCOPo->cop_line); + if (CopLINE(cCOPo)) + Perl_dump_indent(aTHX_ level, file, "LINE = %d\n",CopLINE(cCOPo)); + if (CopSTASHPV(cCOPo)) + Perl_dump_indent(aTHX_ level, file, "PACKAGE = \"%s\"\n", + CopSTASHPV(cCOPo)); if (cCOPo->cop_label) - Perl_dump_indent(aTHX_ level, file, "LABEL = \"%s\"\n",cCOPo->cop_label); + Perl_dump_indent(aTHX_ level, file, "LABEL = \"%s\"\n", + cCOPo->cop_label); break; case OP_ENTERLOOP: Perl_dump_indent(aTHX_ level, file, "REDO ===> "); @@ -581,6 +585,15 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o) case OP_SUBST: do_pmop_dump(level, file, cPMOPo); break; + case OP_LEAVE: + case OP_LEAVEEVAL: + case OP_LEAVESUB: + case OP_LEAVESUBLV: + case OP_LEAVEWRITE: + case OP_SCOPE: + if (o->op_private & OPpREFCOUNTED) + Perl_dump_indent(aTHX_ level, file, "REFCNT = %"UVuf"\n", (UV)o->op_targ); + break; default: break; } @@ -623,7 +636,8 @@ void Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, MAGIC *mg, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim) { for (; mg; mg = mg->mg_moremagic) { - Perl_dump_indent(aTHX_ level, file, " MAGIC = 0x%lx\n", (long)mg); + Perl_dump_indent(aTHX_ level, file, + " MAGIC = 0x%"UVxf"\n", PTR2UV(mg)); if (mg->mg_virtual) { MGVTBL *v = mg->mg_virtual; char *s = 0; @@ -657,7 +671,7 @@ Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, MAGIC *mg, I32 nest, I32 maxne if (s) Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = &PL_vtbl_%s\n", s); else - Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = 0x%lx\n", (long)v); + Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = 0x%"UVxf"\n", PTR2UV(v)); } else Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = 0\n"); @@ -682,14 +696,14 @@ Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, MAGIC *mg, I32 nest, I32 maxne Perl_dump_indent(aTHX_ level, file, " MINMATCH\n"); } if (mg->mg_obj) { - Perl_dump_indent(aTHX_ level, file, " MG_OBJ = 0x%lx\n", (long)mg->mg_obj); + Perl_dump_indent(aTHX_ level, file, " MG_OBJ = 0x%"UVxf"\n", PTR2UV(mg->mg_obj)); if (mg->mg_flags & MGf_REFCOUNTED) do_sv_dump(level+2, file, mg->mg_obj, nest+1, maxnest, dumpops, pvlim); /* MG is already +1 */ } if (mg->mg_len) Perl_dump_indent(aTHX_ level, file, " MG_LEN = %d\n", mg->mg_len); if (mg->mg_ptr) { - Perl_dump_indent(aTHX_ level, file, " MG_PTR = 0x%lx", (long)mg->mg_ptr); + Perl_dump_indent(aTHX_ level, file, " MG_PTR = 0x%"UVxf, PTR2UV(mg->mg_ptr)); if (mg->mg_len >= 0) { SV *sv = newSVpvn("", 0); PerlIO_printf(file, " %s", pv_display(sv, mg->mg_ptr, mg->mg_len, 0, pvlim)); @@ -716,7 +730,7 @@ Perl_magic_dump(pTHX_ MAGIC *mg) void Perl_do_hv_dump(pTHX_ I32 level, PerlIO *file, char *name, HV *sv) { - Perl_dump_indent(aTHX_ level, file, "%s = 0x%lx", name, (long)sv); + Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv)); if (sv && HvNAME(sv)) PerlIO_printf(file, "\t\"%s\"\n", HvNAME(sv)); else @@ -726,7 +740,7 @@ Perl_do_hv_dump(pTHX_ I32 level, PerlIO *file, char *name, HV *sv) void Perl_do_gv_dump(pTHX_ I32 level, PerlIO *file, char *name, GV *sv) { - Perl_dump_indent(aTHX_ level, file, "%s = 0x%lx", name, (long)sv); + Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv)); if (sv && GvNAME(sv)) PerlIO_printf(file, "\t\"%s\"\n", GvNAME(sv)); else @@ -736,7 +750,7 @@ Perl_do_gv_dump(pTHX_ I32 level, PerlIO *file, char *name, GV *sv) void Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO *file, char *name, GV *sv) { - Perl_dump_indent(aTHX_ level, file, "%s = 0x%lx", name, (long)sv); + Perl_dump_indent(aTHX_ level, file, "%s = 0x%"UVxf, name, PTR2UV(sv)); if (sv && GvNAME(sv)) { PerlIO_printf(file, "\t\""); if (GvSTASH(sv) && HvNAME(GvSTASH(sv))) @@ -765,19 +779,11 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo flags = SvFLAGS(sv); type = SvTYPE(sv); -#ifdef IV_IS_QUAD Perl_sv_setpvf(aTHX_ d, - "(0x%" PERL_PRIx64") at 0x%" PERL_PRIx64 "\n%*s REFCNT = %" PERL_PRId64 "\n%*s FLAGS = (", + "(0x%"UVxf") at 0x%"UVxf"\n%*s REFCNT = %"IVdf"\n%*s FLAGS = (", PTR2UV(SvANY(sv)), PTR2UV(sv), PL_dumpindent*level, "", (IV)SvREFCNT(sv), PL_dumpindent*level, ""); -#else - Perl_sv_setpvf(aTHX_ d, - "(0x%lx) at 0x%lx\n%*s REFCNT = %ld\n%*s FLAGS = (", - (unsigned long)SvANY(sv), (unsigned long)sv, - PL_dumpindent*level, "", (long)SvREFCNT(sv), - PL_dumpindent*level, ""); -#endif if (flags & SVs_PADBUSY) sv_catpv(d, "PADBUSY,"); if (flags & SVs_PADTMP) sv_catpv(d, "PADTMP,"); @@ -903,27 +909,21 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo PerlIO_printf(file, "PVIO%s\n", s); break; default: - PerlIO_printf(file, "UNKNOWN(0x%x) %s\n", type, s); + PerlIO_printf(file, "UNKNOWN(0x%"UVxf") %s\n", (UV)type, s); return; } if (type >= SVt_PVIV || type == SVt_IV) { -#ifdef IV_IS_QUAD - if (SvIsUV(sv)) - Perl_dump_indent(aTHX_ level, file, " UV = %" PERL_PRIu64, (UV)SvUVX(sv)); - else - Perl_dump_indent(aTHX_ level, file, " IV = %" PERL_PRId64, (IV)SvIVX(sv)); -#else if (SvIsUV(sv)) - Perl_dump_indent(aTHX_ level, file, " UV = %lu", (unsigned long)SvUVX(sv)); + Perl_dump_indent(aTHX_ level, file, " UV = %"UVuf, (UV)SvUVX(sv)); else - Perl_dump_indent(aTHX_ level, file, " IV = %ld", (long)SvIVX(sv)); -#endif + Perl_dump_indent(aTHX_ level, file, " IV = %"IVdf, (IV)SvIVX(sv)); if (SvOOK(sv)) PerlIO_printf(file, " (OFFSET)"); PerlIO_putc(file, '\n'); } if (type >= SVt_PVNV || type == SVt_NV) { RESTORE_NUMERIC_STANDARD(); + /* %Vg doesn't work? --jhi */ #ifdef USE_LONG_DOUBLE Perl_dump_indent(aTHX_ level, file, " NV = %.*" PERL_PRIgldbl "\n", LDBL_DIG, SvNVX(sv)); #else @@ -932,11 +932,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo RESTORE_NUMERIC_LOCAL(); } if (SvROK(sv)) { -#ifdef IV_IS_QUAD - Perl_dump_indent(aTHX_ level, file, " RV = 0x%" PERL_PRIx64 "\n", PTR2IV(SvRV(sv))); -#else - Perl_dump_indent(aTHX_ level, file, " RV = 0x%lx\n", (long)SvRV(sv)); -#endif + Perl_dump_indent(aTHX_ level, file, " RV = 0x%"UVxf"\n", PTR2UV(SvRV(sv))); if (nest < maxnest) do_sv_dump(level+1, file, SvRV(sv), nest+1, maxnest, dumpops, pvlim); return; @@ -945,21 +941,12 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo return; if (type <= SVt_PVLV) { if (SvPVX(sv)) { -#ifdef IV_IS_QUAD - Perl_dump_indent(aTHX_ level, file," PV = 0x%" PERL_PRIx64 " ", PTR2IV(SvPVX(sv))); -#else - Perl_dump_indent(aTHX_ level, file," PV = 0x%lx ", (long)SvPVX(sv)); -#endif + Perl_dump_indent(aTHX_ level, file," PV = 0x%"UVxf" ", PTR2UV(SvPVX(sv))); if (SvOOK(sv)) PerlIO_printf(file, "( %s . ) ", pv_display(d, SvPVX(sv)-SvIVX(sv), SvIVX(sv), 0, pvlim)); PerlIO_printf(file, "%s\n", pv_display(d, SvPVX(sv), SvCUR(sv), SvLEN(sv), pvlim)); -#ifdef IV_IS_QUAD - Perl_dump_indent(aTHX_ level, file, " CUR = %" PERL_PRId64 "\n", (IV)SvCUR(sv)); - Perl_dump_indent(aTHX_ level, file, " LEN = %" PERL_PRId64 "\n", (IV)SvLEN(sv)); -#else - Perl_dump_indent(aTHX_ level, file, " CUR = %ld\n", (long)SvCUR(sv)); - Perl_dump_indent(aTHX_ level, file, " LEN = %ld\n", (long)SvLEN(sv)); -#endif + Perl_dump_indent(aTHX_ level, file, " CUR = %"IVdf"\n", (IV)SvCUR(sv)); + Perl_dump_indent(aTHX_ level, file, " LEN = %"IVdf"\n", (IV)SvLEN(sv)); } else Perl_dump_indent(aTHX_ level, file, " PV = 0\n"); @@ -973,43 +960,23 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo switch (type) { case SVt_PVLV: Perl_dump_indent(aTHX_ level, file, " TYPE = %c\n", LvTYPE(sv)); -#ifdef IV_IS_QUAD - Perl_dump_indent(aTHX_ level, file, " TARGOFF = %" PERL_PRId64 "\n", (IV)LvTARGOFF(sv)); - Perl_dump_indent(aTHX_ level, file, " TARGLEN = %" PERL_PRId64 "\n", (IV)LvTARGLEN(sv)); - Perl_dump_indent(aTHX_ level, file, " TARG = 0x%" PERL_PRIx64 "\n", PTR2IV(LvTARG(sv))); -#else - Perl_dump_indent(aTHX_ level, file, " TARGOFF = %ld\n", (long)LvTARGOFF(sv)); - Perl_dump_indent(aTHX_ level, file, " TARGLEN = %ld\n", (long)LvTARGLEN(sv)); - Perl_dump_indent(aTHX_ level, file, " TARG = 0x%lx\n", (long)LvTARG(sv)); -#endif + Perl_dump_indent(aTHX_ level, file, " TARGOFF = %"IVdf"\n", (IV)LvTARGOFF(sv)); + Perl_dump_indent(aTHX_ level, file, " TARGLEN = %"IVdf"\n", (IV)LvTARGLEN(sv)); + Perl_dump_indent(aTHX_ level, file, " TARG = 0x%"UVxf"\n", PTR2UV(LvTARG(sv))); /* XXX level+1 ??? */ do_sv_dump(level, file, LvTARG(sv), nest+1, maxnest, dumpops, pvlim); break; case SVt_PVAV: -#ifdef IV_IS_QUAD - Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%" PERL_PRIx64 , PTR2IV(AvARRAY(sv))); -#else - Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%lx", (long)AvARRAY(sv)); -#endif + Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%"UVxf, PTR2UV(AvARRAY(sv))); if (AvARRAY(sv) != AvALLOC(sv)) { - PerlIO_printf(file, " (offset=%d)\n", (AvARRAY(sv) - AvALLOC(sv))); -#ifdef IV_IS_QUAD - Perl_dump_indent(aTHX_ level, file, " ALLOC = 0x%" PERL_PRIx64 "\n", PTR2IV(AvALLOC(sv))); -#else - Perl_dump_indent(aTHX_ level, file, " ALLOC = 0x%lx\n", (long)AvALLOC(sv)); -#endif + PerlIO_printf(file, " (offset=%"IVdf")\n", (IV)(AvARRAY(sv) - AvALLOC(sv))); + Perl_dump_indent(aTHX_ level, file, " ALLOC = 0x%"UVxf"\n", PTR2UV(AvALLOC(sv))); } else PerlIO_putc(file, '\n'); -#ifdef IV_IS_QUAD - Perl_dump_indent(aTHX_ level, file, " FILL = %" PERL_PRId64 "\n", (IV)AvFILLp(sv)); - Perl_dump_indent(aTHX_ level, file, " MAX = %" PERL_PRId64 "\n", (IV)AvMAX(sv)); - Perl_dump_indent(aTHX_ level, file, " ARYLEN = 0x%" PERL_PRIx64 "\n", PTR2IV(AvARYLEN(sv))); -#else - Perl_dump_indent(aTHX_ level, file, " FILL = %ld\n", (long)AvFILLp(sv)); - Perl_dump_indent(aTHX_ level, file, " MAX = %ld\n", (long)AvMAX(sv)); - Perl_dump_indent(aTHX_ level, file, " ARYLEN = 0x%lx\n", (long)AvARYLEN(sv)); -#endif + Perl_dump_indent(aTHX_ level, file, " FILL = %"IVdf"\n", (IV)AvFILLp(sv)); + Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)AvMAX(sv)); + Perl_dump_indent(aTHX_ level, file, " ARYLEN = 0x%"UVxf"\n", PTR2UV(AvARYLEN(sv))); flags = AvFLAGS(sv); sv_setpv(d, ""); if (flags & AVf_REAL) sv_catpv(d, ",REAL"); @@ -1021,22 +988,14 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo for (count = 0; count <= av_len((AV*)sv) && count < maxnest; count++) { SV** elt = av_fetch((AV*)sv,count,0); -#ifdef IV_IS_QUAD - Perl_dump_indent(aTHX_ level + 1, file, "Elt No. %" PERL_PRId64 "\n", (IV)count); -#else - Perl_dump_indent(aTHX_ level + 1, file, "Elt No. %ld\n", (long)count); -#endif + Perl_dump_indent(aTHX_ level + 1, file, "Elt No. %"IVdf"\n", (IV)count); if (elt) do_sv_dump(level+1, file, *elt, nest+1, maxnest, dumpops, pvlim); } } break; case SVt_PVHV: -#ifdef IV_IS_QUAD - Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%" PERL_PRIx64,PTR2IV(HvARRAY(sv))); -#else - Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%lx",(long)HvARRAY(sv)); -#endif + Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%"UVxf, PTR2UV(HvARRAY(sv))); if (HvARRAY(sv) && HvKEYS(sv)) { /* Show distribution of HEs in the ARRAY */ int freq[200]; @@ -1081,25 +1040,13 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo Perl_dump_indent(aTHX_ level, file, " hash quality = %.1f%%", theoret/sum*100); } PerlIO_putc(file, '\n'); -#ifdef IV_IS_QUAD - Perl_dump_indent(aTHX_ level, file, " KEYS = %" PERL_PRId64 "\n", (IV)HvKEYS(sv)); - Perl_dump_indent(aTHX_ level, file, " FILL = %" PERL_PRId64 "\n", (IV)HvFILL(sv)); - Perl_dump_indent(aTHX_ level, file, " MAX = %" PERL_PRId64 "\n", (IV)HvMAX(sv)); - Perl_dump_indent(aTHX_ level, file, " RITER = %" PERL_PRId64 "\n", (IV)HvRITER(sv)); - Perl_dump_indent(aTHX_ level, file, " EITER = 0x%" PERL_PRIx64 "\n",PTR2IV(HvEITER(sv))); -#else - Perl_dump_indent(aTHX_ level, file, " KEYS = %ld\n", (long)HvKEYS(sv)); - Perl_dump_indent(aTHX_ level, file, " FILL = %ld\n", (long)HvFILL(sv)); - Perl_dump_indent(aTHX_ level, file, " MAX = %ld\n", (long)HvMAX(sv)); - Perl_dump_indent(aTHX_ level, file, " RITER = %ld\n", (long)HvRITER(sv)); - Perl_dump_indent(aTHX_ level, file, " EITER = 0x%lx\n",(long) HvEITER(sv)); -#endif + Perl_dump_indent(aTHX_ level, file, " KEYS = %"IVdf"\n", (IV)HvKEYS(sv)); + Perl_dump_indent(aTHX_ level, file, " FILL = %"IVdf"\n", (IV)HvFILL(sv)); + Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)HvMAX(sv)); + Perl_dump_indent(aTHX_ level, file, " RITER = %"IVdf"\n", (IV)HvRITER(sv)); + Perl_dump_indent(aTHX_ level, file, " EITER = 0x%"UVxf"\n", PTR2UV(HvEITER(sv))); if (HvPMROOT(sv)) -#ifdef IV_IS_QUAD - Perl_dump_indent(aTHX_ level, file, " PMROOT = 0x%" PERL_PRIx64 "\n",PTR2IV(HvPMROOT(sv))); -#else - Perl_dump_indent(aTHX_ level, file, " PMROOT = 0x%lx\n",(long)HvPMROOT(sv)); -#endif + Perl_dump_indent(aTHX_ level, file, " PMROOT = 0x%"UVxf"\n", PTR2UV(HvPMROOT(sv))); if (HvNAME(sv)) Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n", HvNAME(sv)); if (nest < maxnest && !HvEITER(sv)) { /* Try to preserve iterator */ @@ -1116,11 +1063,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo key = hv_iterkey(he, &len); elt = hv_iterval(hv, he); -#ifdef IV_IS_QUAD - Perl_dump_indent(aTHX_ level+1, file, "Elt %s HASH = 0x%" PERL_PRIx64 "\n", pv_display(d, key, len, 0, pvlim), hash); -#else - Perl_dump_indent(aTHX_ level+1, file, "Elt %s HASH = 0x%lx\n", pv_display(d, key, len, 0, pvlim), hash); -#endif + Perl_dump_indent(aTHX_ level+1, file, "Elt %s HASH = 0x%"UVxf"\n", pv_display(d, key, len, 0, pvlim), (UV)hash); do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim); } hv_iterinit(hv); /* Return to status quo */ @@ -1133,54 +1076,23 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo case SVt_PVFM: do_hv_dump(level, file, " COMP_STASH", CvSTASH(sv)); if (CvSTART(sv)) -#ifdef IV_IS_QAUD - Perl_dump_indent(aTHX_ level, file, " START = 0x%" PERL_PRIx64 " ===> %d\n", (IV)CvSTART(sv), CvSTART(sv)->op_seq); - Perl_dump_indent(aTHX_ level, file, " ROOT = 0x%" PERL_PRIx64 "\n", (IV)CvROOT(sv)); -#else - Perl_dump_indent(aTHX_ level, file, " START = 0x%lx ===> %d\n", (long)CvSTART(sv), CvSTART(sv)->op_seq); - Perl_dump_indent(aTHX_ level, file, " ROOT = 0x%lx\n", (long)CvROOT(sv)); -#endif + Perl_dump_indent(aTHX_ level, file, " START = 0x%"UVxf" ===> %"IVdf"\n", PTR2UV(CvSTART(sv)), (IV)CvSTART(sv)->op_seq); + Perl_dump_indent(aTHX_ level, file, " ROOT = 0x%"UVxf"\n", PTR2UV(CvROOT(sv))); if (CvROOT(sv) && dumpops) do_op_dump(level+1, file, CvROOT(sv)); -#ifdef IV_IS_QUAD - Perl_dump_indent(aTHX_ level, file, " XSUB = 0x%" PERL_PRIx64 "\n", PTR2IV(CvXSUB(sv))); - Perl_dump_indent(aTHX_ level, file, " XSUBANY = %" PERL_PRId64 "\n", (IV)CvXSUBANY(sv).any_i32); -#else - Perl_dump_indent(aTHX_ level, file, " XSUB = 0x%lx\n", (long)CvXSUB(sv)); - Perl_dump_indent(aTHX_ level, file, " XSUBANY = %ld\n", (long)CvXSUBANY(sv).any_i32); -#endif + Perl_dump_indent(aTHX_ level, file, " XSUB = 0x%"UVxf"\n", PTR2UV(CvXSUB(sv))); + Perl_dump_indent(aTHX_ level, file, " XSUBANY = %"IVdf"\n", (IV)CvXSUBANY(sv).any_i32); do_gvgv_dump(level, file, " GVGV::GV", CvGV(sv)); - do_gv_dump(level, file, " FILEGV", CvFILEGV(sv)); -#ifdef IV_IS_QUAD - Perl_dump_indent(aTHX_ level, file, " DEPTH = %" PERL_PRId64 "\n", (IV)CvDEPTH(sv)); -#else - Perl_dump_indent(aTHX_ level, file, " DEPTH = %ld\n", (long)CvDEPTH(sv)); -#endif + Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", CvFILE(sv)); + Perl_dump_indent(aTHX_ level, file, " DEPTH = %"IVdf"\n", (IV)CvDEPTH(sv)); #ifdef USE_THREADS -#ifdef IV_IS_QUAD - Perl_dump_indent(aTHX_ level, file, " MUTEXP = 0x%" PERL_PRIx64 "\n", (IV)CvMUTEXP(sv)); - Perl_dump_indent(aTHX_ level, file, " OWNER = 0x%" PERL_PRIx64 "\n", (IV)CvOWNER(sv)); -#else - Perl_dump_indent(aTHX_ level, file, " MUTEXP = 0x%lx\n", (long)CvMUTEXP(sv)); - Perl_dump_indent(aTHX_ level, file, " OWNER = 0x%lx\n", (long)CvOWNER(sv)); -#endif /* IV_IS_QUAD */ + Perl_dump_indent(aTHX_ level, file, " MUTEXP = 0x%"UVxf"\n", PTR2UV(CvMUTEXP(sv))); + Perl_dump_indent(aTHX_ level, file, " OWNER = 0x%"UVxf"\n", PTR2UV(CvOWNER(sv))); #endif /* USE_THREADS */ -#ifdef IV_IS_QUAD - Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%" PERL_PRIx64 "\n", (UV)CvFLAGS(sv)); -#else - Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%lx\n", (unsigned long)CvFLAGS(sv)); -#endif + Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", CvFLAGS(sv)); if (type == SVt_PVFM) -#ifdef IV_IS_QUAD - Perl_dump_indent(aTHX_ level, file, " LINES = %" PERL_PRId64 "\n", (IV)FmLINES(sv)); -#else - Perl_dump_indent(aTHX_ level, file, " LINES = %ld\n", (long)FmLINES(sv)); -#endif -#ifdef IV_IS_QUAD - Perl_dump_indent(aTHX_ level, file, " PADLIST = 0x%" PERL_PRIx64 "\n", PTR2IV(CvPADLIST(sv))); -#else - Perl_dump_indent(aTHX_ level, file, " PADLIST = 0x%lx\n", (long)CvPADLIST(sv)); -#endif + Perl_dump_indent(aTHX_ level, file, " LINES = %"IVdf"\n", (IV)FmLINES(sv)); + Perl_dump_indent(aTHX_ level, file, " PADLIST = 0x%"UVxf"\n", PTR2UV(CvPADLIST(sv))); if (nest < maxnest && CvPADLIST(sv)) { AV* padlist = CvPADLIST(sv); AV* pad_name = (AV*)*av_fetch(padlist, 0, FALSE); @@ -1190,107 +1102,60 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo I32 ix; for (ix = 1; ix <= AvFILL(pad_name); ix++) { -#ifdef IV_IS_QUAD if (SvPOK(pname[ix])) - Perl_dump_indent(aTHX_ level, /* %5d below is enough whitespace. */ + Perl_dump_indent(aTHX_ level, + /* %5d below is enough whitespace. */ file, - "%5d. 0x%" PERL_PRIx64 " (%s\"%s\" %" PERL_PRId64 "-%" PERL_PRId64 ")\n", - ix, ppad[ix], + "%5d. 0x%"UVxf" (%s\"%s\" %"IVdf"-%"IVdf")\n", + ix, PTR2UV(ppad[ix]), SvFAKE(pname[ix]) ? "FAKE " : "", SvPVX(pname[ix]), (IV)SvNVX(pname[ix]), (IV)SvIVX(pname[ix])); -#else - if (SvPOK(pname[ix])) - Perl_dump_indent(aTHX_ level, /* %5d below is enough whitespace. */ - file, - "%5d. 0x%lx (%s\"%s\" %ld-%ld)\n", - ix, ppad[ix], - SvFAKE(pname[ix]) ? "FAKE " : "", - SvPVX(pname[ix]), - (long)I_32(SvNVX(pname[ix])), - (long)SvIVX(pname[ix])); -#endif } } { CV *outside = CvOUTSIDE(sv); -#ifdef IV_IS_QUAD - Perl_dump_indent(aTHX_ level, file, " OUTSIDE = 0x%" PERL_PRIx64 " (%s)\n", - PTR2IV(outside), - (!outside ? "null" - : CvANON(outside) ? "ANON" - : (outside == PL_main_cv) ? "MAIN" - : CvUNIQUE(outside) ? "UNIQUE" - : CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED")); -#else - Perl_dump_indent(aTHX_ level, file, " OUTSIDE = 0x%lx (%s)\n", - (long)outside, + Perl_dump_indent(aTHX_ level, file, " OUTSIDE = 0x%"UVxf" (%s)\n", + PTR2UV(outside), (!outside ? "null" : CvANON(outside) ? "ANON" : (outside == PL_main_cv) ? "MAIN" : CvUNIQUE(outside) ? "UNIQUE" : CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED")); -#endif } if (nest < maxnest && (CvCLONE(sv) || CvCLONED(sv))) do_sv_dump(level+1, file, (SV*)CvOUTSIDE(sv), nest+1, maxnest, dumpops, pvlim); break; case SVt_PVGV: Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n", GvNAME(sv)); -#ifdef IV_IS_QUAD - Perl_dump_indent(aTHX_ level, file, " NAMELEN = %" PERL_PRId64 "\n", (IV)GvNAMELEN(sv)); -#else - Perl_dump_indent(aTHX_ level, file, " NAMELEN = %ld\n", (long)GvNAMELEN(sv)); -#endif + Perl_dump_indent(aTHX_ level, file, " NAMELEN = %"IVdf"\n", (IV)GvNAMELEN(sv)); do_hv_dump (level, file, " GvSTASH", GvSTASH(sv)); -#ifdef IV_IS_QUAD - Perl_dump_indent(aTHX_ level, file, " GP = 0x%" PERL_PRIx64 "\n", PTR2IV(GvGP(sv))); - Perl_dump_indent(aTHX_ level, file, " SV = 0x%" PERL_PRIx64 "\n", PTR2IV(GvSV(sv))); - Perl_dump_indent(aTHX_ level, file, " REFCNT = %" PERL_PRId64 "\n", (IV)GvREFCNT(sv)); - Perl_dump_indent(aTHX_ level, file, " IO = 0x%" PERL_PRIx64 "\n", PTR2IV(GvIOp(sv))); - Perl_dump_indent(aTHX_ level, file, " FORM = 0x%" PERL_PRIx64 " \n", PTR2IV(GvFORM(sv))); - Perl_dump_indent(aTHX_ level, file, " AV = 0x%" PERL_PRIx64 "\n", PTR2IV(GvAV(sv))); - Perl_dump_indent(aTHX_ level, file, " HV = 0x%" PERL_PRIx64 "\n", PTR2IV(GvHV(sv))); - Perl_dump_indent(aTHX_ level, file, " CV = 0x%" PERL_PRIx64 "\n", PTR2IV(GvCV(sv))); - Perl_dump_indent(aTHX_ level, file, " CVGEN = 0x%" PERL_PRIx64 "\n", (IV)GvCVGEN(sv)); - Perl_dump_indent(aTHX_ level, file, " LASTEXPR = %" PERL_PRId64 "\n", (IV)GvLASTEXPR(sv)); - Perl_dump_indent(aTHX_ level, file, " LINE = %" PERL_PRId64 "\n", (IV)GvLINE(sv)); -#else - Perl_dump_indent(aTHX_ level, file, " GP = 0x%lx\n", (long)GvGP(sv)); - Perl_dump_indent(aTHX_ level, file, " SV = 0x%lx\n", (long)GvSV(sv)); - Perl_dump_indent(aTHX_ level, file, " REFCNT = %ld\n", (long)GvREFCNT(sv)); - Perl_dump_indent(aTHX_ level, file, " IO = 0x%lx\n", (long)GvIOp(sv)); - Perl_dump_indent(aTHX_ level, file, " FORM = 0x%lx\n", (long)GvFORM(sv)); - Perl_dump_indent(aTHX_ level, file, " AV = 0x%lx\n", (long)GvAV(sv)); - Perl_dump_indent(aTHX_ level, file, " HV = 0x%lx\n", (long)GvHV(sv)); - Perl_dump_indent(aTHX_ level, file, " CV = 0x%lx\n", (long)GvCV(sv)); - Perl_dump_indent(aTHX_ level, file, " CVGEN = 0x%lx\n", (long)GvCVGEN(sv)); - Perl_dump_indent(aTHX_ level, file, " LASTEXPR = %ld\n", (long)GvLASTEXPR(sv)); - Perl_dump_indent(aTHX_ level, file, " LINE = %ld\n", (long)GvLINE(sv)); -#endif - Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%x\n", (int)GvFLAGS(sv)); - do_gv_dump (level, file, " FILEGV", GvFILEGV(sv)); + Perl_dump_indent(aTHX_ level, file, " GP = 0x%"UVxf"\n", PTR2UV(GvGP(sv))); + if (!GvGP(sv)) + break; + Perl_dump_indent(aTHX_ level, file, " SV = 0x%"UVxf"\n", PTR2UV(GvSV(sv))); + Perl_dump_indent(aTHX_ level, file, " REFCNT = %"IVdf"\n", (IV)GvREFCNT(sv)); + Perl_dump_indent(aTHX_ level, file, " IO = 0x%"UVxf"\n", PTR2UV(GvIOp(sv))); + Perl_dump_indent(aTHX_ level, file, " FORM = 0x%"UVxf" \n", PTR2UV(GvFORM(sv))); + Perl_dump_indent(aTHX_ level, file, " AV = 0x%"UVxf"\n", PTR2UV(GvAV(sv))); + Perl_dump_indent(aTHX_ level, file, " HV = 0x%"UVxf"\n", PTR2UV(GvHV(sv))); + Perl_dump_indent(aTHX_ level, file, " CV = 0x%"UVxf"\n", PTR2UV(GvCV(sv))); + Perl_dump_indent(aTHX_ level, file, " CVGEN = 0x%"UVxf"\n", (UV)GvCVGEN(sv)); + Perl_dump_indent(aTHX_ level, file, " GPFLAGS = 0x%"UVxf"\n", (UV)GvGPFLAGS(sv)); + Perl_dump_indent(aTHX_ level, file, " LINE = %"IVdf"\n", (IV)GvLINE(sv)); + Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", GvFILE(sv)); + Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)GvFLAGS(sv)); do_gv_dump (level, file, " EGV", GvEGV(sv)); break; case SVt_PVIO: -#ifdef IV_IS_QUAD - Perl_dump_indent(aTHX_ level, file, " IFP = 0x%" PERL_PRIx64 "\n", PTR2IV(IoIFP(sv))); - Perl_dump_indent(aTHX_ level, file, " OFP = 0x%" PERL_PRIx64 "\n", PTR2IV(IoOFP(sv))); - Perl_dump_indent(aTHX_ level, file, " DIRP = 0x%" PERL_PRIx64 "\n", PTR2IV(IoDIRP(sv))); - Perl_dump_indent(aTHX_ level, file, " LINES = %" PERL_PRId64 "\n", (IV)IoLINES(sv)); - Perl_dump_indent(aTHX_ level, file, " PAGE = %" PERL_PRId64 "\n", (IV)IoPAGE(sv)); - Perl_dump_indent(aTHX_ level, file, " PAGE_LEN = %" PERL_PRId64 "\n", (IV)IoPAGE_LEN(sv)); - Perl_dump_indent(aTHX_ level, file, " LINES_LEFT = %" PERL_PRId64 "\n", (IV)IoLINES_LEFT(sv)); -#else - Perl_dump_indent(aTHX_ level, file, " IFP = 0x%lx\n", (long)IoIFP(sv)); - Perl_dump_indent(aTHX_ level, file, " OFP = 0x%lx\n", (long)IoOFP(sv)); - Perl_dump_indent(aTHX_ level, file, " DIRP = 0x%lx\n", (long)IoDIRP(sv)); - Perl_dump_indent(aTHX_ level, file, " LINES = %ld\n", (long)IoLINES(sv)); - Perl_dump_indent(aTHX_ level, file, " PAGE = %ld\n", (long)IoPAGE(sv)); - Perl_dump_indent(aTHX_ level, file, " PAGE_LEN = %ld\n", (long)IoPAGE_LEN(sv)); - Perl_dump_indent(aTHX_ level, file, " LINES_LEFT = %ld\n", (long)IoLINES_LEFT(sv)); -#endif + Perl_dump_indent(aTHX_ level, file, " IFP = 0x%"UVxf"\n", PTR2UV(IoIFP(sv))); + Perl_dump_indent(aTHX_ level, file, " OFP = 0x%"UVxf"\n", PTR2UV(IoOFP(sv))); + Perl_dump_indent(aTHX_ level, file, " DIRP = 0x%"UVxf"\n", PTR2UV(IoDIRP(sv))); + Perl_dump_indent(aTHX_ level, file, " LINES = %"IVdf"\n", (IV)IoLINES(sv)); + Perl_dump_indent(aTHX_ level, file, " PAGE = %"IVdf"\n", (IV)IoPAGE(sv)); + Perl_dump_indent(aTHX_ level, file, " PAGE_LEN = %"IVdf"\n", (IV)IoPAGE_LEN(sv)); + Perl_dump_indent(aTHX_ level, file, " LINES_LEFT = %"IVdf"\n", (IV)IoLINES_LEFT(sv)); if (IoTOP_NAME(sv)) Perl_dump_indent(aTHX_ level, file, " TOP_NAME = \"%s\"\n", IoTOP_NAME(sv)); do_gv_dump (level, file, " TOP_GV", IoTOP_GV(sv)); @@ -1300,20 +1165,12 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo if (IoBOTTOM_NAME(sv)) Perl_dump_indent(aTHX_ level, file, " BOTTOM_NAME = \"%s\"\n", IoBOTTOM_NAME(sv)); do_gv_dump (level, file, " BOTTOM_GV", IoBOTTOM_GV(sv)); -#ifdef IV_IS_QUAD - Perl_dump_indent(aTHX_ level, file, " SUBPROCESS = %" PERL_PRId64 "\n", (IV)IoSUBPROCESS(sv)); -#else - Perl_dump_indent(aTHX_ level, file, " SUBPROCESS = %ld\n", (long)IoSUBPROCESS(sv)); -#endif + Perl_dump_indent(aTHX_ level, file, " SUBPROCESS = %"IVdf"\n", (IV)IoSUBPROCESS(sv)); if (isPRINT(IoTYPE(sv))) Perl_dump_indent(aTHX_ level, file, " TYPE = '%c'\n", IoTYPE(sv)); else Perl_dump_indent(aTHX_ level, file, " TYPE = '\\%o'\n", IoTYPE(sv)); -#ifdef IV_IS_QUAD - Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%" PERL_PRIx64 "\n", (IV)IoFLAGS(sv)); -#else - Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%lx\n", (long)IoFLAGS(sv)); -#endif + Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)IoFLAGS(sv)); break; } } diff --git a/eg/cgi/dna.small.gif.uu b/eg/cgi/dna_small_gif.uu similarity index 99% rename from eg/cgi/dna.small.gif.uu rename to eg/cgi/dna_small_gif.uu index d3ce24c..1745c73 100644 --- a/eg/cgi/dna.small.gif.uu +++ b/eg/cgi/dna_small_gif.uu @@ -1,4 +1,4 @@ -begin 444 dna.small.gif +begin 444 dna_small.gif M1TE&.#=A)0`J`.<``+9%&Y@_&A$_5 TAGS.tm1 && mv TAGS.tm1 TAGS.tmp +# Now remove these Perl_, add empty- and perl_-flavors: +perl -w014pe 'if (s/^(Perl_ # 1: First group + (\w+) \( # 2: Stripped name + \x7F # End of description + ) # End of description + (\d+,\d+\n) # 3: TAGS Trail + /$1$3$1$2\x01$3$1perl_$2\x01$3/mgx) { # Repeat, add empty and perl_ flavors + $chars = chomp; + s/^((\n.+,)\d+)/ $2 . (length($_) - length($1) - 1) /e; + $_ .= ("\f" x $chars); + }' TAGS.tmp > TAGS.tm1 && mv TAGS.tm1 TAGS.tmp + +# Now remove these S_, add empty-flavor: +perl -w014pe 'if (s/^(S_ # 1: First group + (\w+) \( # 2: Stripped name + \x7F # End of description + ) # End of description + (\d+,\d+\n) # 3: TAGS Trail + /$1$3$1$2\x01$3/mgx) { # Repeat, add empty_ flavor + $chars = chomp; + s/^((\n.+,)\d+)/ $2 . (length($_) - length($1) - 1) /e; + $_ .= ("\f" x $chars); + }' TAGS.tmp > TAGS.tm1 && mv TAGS.tm1 TAGS.tmp etags -o TAGS.tmp -a -D -l none -r '/#define.*\t\(Perl_.*\)/\1/' embed.h -etags -o TAGS.tmp -a globals.c embedvar.h objXSUB.h objpp.h +etags -o TAGS.tmp -a globals.c embedvar.h objXSUB.h perlapi.c +# The above processes created a lot of descriptions with an +# an explicitly specified tag. Such descriptions have higher +# precedence than descriptions without an explicitely specified tag. +# To restore the justice, make all the descriptions explicit. perl -w014pe 'if (s/^( [^\n\x7F\x01]*\b # 1: TAG group (\w+) # 2: word [^\w\x7F\x01\n]* # Most anything diff --git a/embed.h b/embed.h index ac84905..27685ff 100644 --- a/embed.h +++ b/embed.h @@ -45,19 +45,37 @@ #if !defined(PERL_OBJECT) #if !defined(PERL_IMPLICIT_CONTEXT) +#if defined(PERL_IMPLICIT_SYS) +#else +#endif +#if defined(USE_ITHREADS) +# if defined(PERL_IMPLICIT_SYS) +# endif +#endif +#if defined(MYMALLOC) +#define malloced_size Perl_malloced_size +#endif #if defined(PERL_OBJECT) +#ifndef __BORLANDC__ +#endif +#endif +#if defined(PERL_OBJECT) +#else #endif #define amagic_call Perl_amagic_call #define Gv_AMupdate Perl_Gv_AMupdate #define append_elem Perl_append_elem #define append_list Perl_append_list #define apply Perl_apply +#define avhv_delete_ent Perl_avhv_delete_ent #define avhv_exists_ent Perl_avhv_exists_ent #define avhv_fetch_ent Perl_avhv_fetch_ent #define avhv_iternext Perl_avhv_iternext #define avhv_iterval Perl_avhv_iterval #define avhv_keys Perl_avhv_keys #define av_clear Perl_av_clear +#define av_delete Perl_av_delete +#define av_exists Perl_av_exists #define av_extend Perl_av_extend #define av_fake Perl_av_fake #define av_fetch Perl_av_fetch @@ -123,7 +141,6 @@ #define cxinc Perl_cxinc #define deb Perl_deb #define vdeb Perl_vdeb -#define deb_growlevel Perl_deb_growlevel #define debprofdump Perl_debprofdump #define debop Perl_debop #define debstack Perl_debstack @@ -356,9 +373,6 @@ #define magic_sizepack Perl_magic_sizepack #define magic_wipepack Perl_magic_wipepack #define magicname Perl_magicname -#if defined(MYMALLOC) -#define malloced_size Perl_malloced_size -#endif #define markstack_grow Perl_markstack_grow #if defined(USE_LOCALE_COLLATE) #define mem_collxfrm Perl_mem_collxfrm @@ -438,6 +452,7 @@ #define newHVhv Perl_newHVhv #define newIO Perl_newIO #define newLISTOP Perl_newLISTOP +#define newPADOP Perl_newPADOP #define newPMOP Perl_newPMOP #define newPVOP Perl_newPVOP #define newRV Perl_newRV @@ -473,11 +488,10 @@ #define pad_swipe Perl_pad_swipe #define peep Perl_peep #if defined(PERL_OBJECT) -#else +#endif #if defined(USE_THREADS) #define new_struct_thread Perl_new_struct_thread #endif -#endif #define call_atexit Perl_call_atexit #define call_argv Perl_call_argv #define call_method Perl_call_method @@ -540,6 +554,7 @@ #define save_clearsv Perl_save_clearsv #define save_delete Perl_save_delete #define save_destructor Perl_save_destructor +#define save_destructor_x Perl_save_destructor_x #define save_freesv Perl_save_freesv #define save_freeop Perl_save_freeop #define save_freepv Perl_save_freepv @@ -551,6 +566,7 @@ #define save_hptr Perl_save_hptr #define save_I16 Perl_save_I16 #define save_I32 Perl_save_I32 +#define save_I8 Perl_save_I8 #define save_int Perl_save_int #define save_item Perl_save_item #define save_iv Perl_save_iv @@ -560,6 +576,7 @@ #define save_op Perl_save_op #define save_scalar Perl_save_scalar #define save_pptr Perl_save_pptr +#define save_vptr Perl_save_vptr #define save_re_context Perl_save_re_context #define save_sptr Perl_save_sptr #define save_svref Perl_save_svref @@ -592,11 +609,15 @@ #define sv_2mortal Perl_sv_2mortal #define sv_2nv Perl_sv_2nv #define sv_2pv Perl_sv_2pv +#define sv_2pvutf8 Perl_sv_2pvutf8 +#define sv_2pvbyte Perl_sv_2pvbyte #define sv_2uv Perl_sv_2uv #define sv_iv Perl_sv_iv #define sv_uv Perl_sv_uv #define sv_nv Perl_sv_nv #define sv_pvn Perl_sv_pvn +#define sv_pvutf8n Perl_sv_pvutf8n +#define sv_pvbyten Perl_sv_pvbyten #define sv_true Perl_sv_true #define sv_add_arena Perl_sv_add_arena #define sv_backoff Perl_sv_backoff @@ -638,6 +659,8 @@ #define sv_pos_u2b Perl_sv_pos_u2b #define sv_pos_b2u Perl_sv_pos_b2u #define sv_pvn_force Perl_sv_pvn_force +#define sv_pvutf8n_force Perl_sv_pvutf8n_force +#define sv_pvbyten_force Perl_sv_pvbyten_force #define sv_reftype Perl_sv_reftype #define sv_replace Perl_sv_replace #define sv_report_used Perl_sv_report_used @@ -689,6 +712,7 @@ #define vivify_defelem Perl_vivify_defelem #define vivify_ref Perl_vivify_ref #define wait4pid Perl_wait4pid +#define report_uninit Perl_report_uninit #define warn Perl_warn #define vwarn Perl_vwarn #define warner Perl_warner @@ -752,7 +776,11 @@ #define vdefault_protect Perl_vdefault_protect #define reginitcolors Perl_reginitcolors #define sv_2pv_nolen Perl_sv_2pv_nolen +#define sv_2pvutf8_nolen Perl_sv_2pvutf8_nolen +#define sv_2pvbyte_nolen Perl_sv_2pvbyte_nolen #define sv_pv Perl_sv_pv +#define sv_pvutf8 Perl_sv_pvutf8 +#define sv_pvbyte Perl_sv_pvbyte #define sv_force_normal Perl_sv_force_normal #define tmps_grow Perl_tmps_grow #define sv_rvweaken Perl_sv_rvweaken @@ -762,7 +790,28 @@ #define newMYSUB Perl_newMYSUB #define my_attrs Perl_my_attrs #define boot_core_xsutils Perl_boot_core_xsutils +#if defined(USE_ITHREADS) +#define cx_dup Perl_cx_dup +#define si_dup Perl_si_dup +#define ss_dup Perl_ss_dup +#define any_dup Perl_any_dup +#define he_dup Perl_he_dup +#define re_dup Perl_re_dup +#define fp_dup Perl_fp_dup +#define dirp_dup Perl_dirp_dup +#define gp_dup Perl_gp_dup +#define mg_dup Perl_mg_dup +#define sv_dup Perl_sv_dup +#if defined(HAVE_INTERP_INTERN) +#define sys_intern_dup Perl_sys_intern_dup +#endif +#define ptr_table_new Perl_ptr_table_new +#define ptr_table_fetch Perl_ptr_table_fetch +#define ptr_table_store Perl_ptr_table_store +#define ptr_table_split Perl_ptr_table_split +#endif #if defined(PERL_OBJECT) +#else #endif #if defined(PERL_IN_AV_C) || defined(PERL_DECL_PROT) #define avhv_index_sv S_avhv_index_sv @@ -814,6 +863,7 @@ #define simplify_sort S_simplify_sort #define is_handle_constructor S_is_handle_constructor #define gv_ename S_gv_ename +#define cv_dump S_cv_dump #define cv_clone2 S_cv_clone2 #define scalar_mod_type S_scalar_mod_type #define my_kid S_my_kid @@ -903,7 +953,14 @@ #define regwhite S_regwhite #define nextchar S_nextchar #define dumpuntil S_dumpuntil +#define put_byte S_put_byte #define scan_commit S_scan_commit +#define cl_anything S_cl_anything +#define cl_is_anything S_cl_is_anything +#define cl_init S_cl_init +#define cl_init_zero S_cl_init_zero +#define cl_and S_cl_and +#define cl_or S_cl_or #define study_chunk S_study_chunk #define add_data S_add_data #define re_croak2 S_re_croak2 @@ -923,6 +980,7 @@ #define cache_re S_cache_re #define reghop S_reghop #define reghopmaybe S_reghopmaybe +#define find_byclass S_find_byclass #endif #if defined(PERL_IN_RUN_C) || defined(PERL_DECL_PROT) #define debprof S_debprof @@ -1024,8 +1082,8 @@ # if defined(CRIPPLED_CC) #define uni S_uni # endif -# if defined(WIN32) -#define win32_textfilter S_win32_textfilter +# if defined(PERL_CR_FILTER) +#define cr_textfilter S_cr_textfilter # endif #endif #if defined(PERL_IN_UNIVERSAL_C) || defined(PERL_DECL_PROT) @@ -1037,6 +1095,8 @@ #define xstat S_xstat # endif #endif +#if defined(PERL_OBJECT) +#endif #define ck_anoncode Perl_ck_anoncode #define ck_bitop Perl_ck_bitop #define ck_concat Perl_ck_concat @@ -1423,19 +1483,37 @@ #else /* PERL_IMPLICIT_CONTEXT */ +#if defined(PERL_IMPLICIT_SYS) +#else +#endif +#if defined(USE_ITHREADS) +# if defined(PERL_IMPLICIT_SYS) +# endif +#endif +#if defined(MYMALLOC) +#define malloced_size Perl_malloced_size +#endif #if defined(PERL_OBJECT) +#ifndef __BORLANDC__ +#endif +#endif +#if defined(PERL_OBJECT) +#else #endif #define amagic_call(a,b,c,d) Perl_amagic_call(aTHX_ a,b,c,d) #define Gv_AMupdate(a) Perl_Gv_AMupdate(aTHX_ a) #define append_elem(a,b,c) Perl_append_elem(aTHX_ a,b,c) #define append_list(a,b,c) Perl_append_list(aTHX_ a,b,c) #define apply(a,b,c) Perl_apply(aTHX_ a,b,c) +#define avhv_delete_ent(a,b,c,d) Perl_avhv_delete_ent(aTHX_ a,b,c,d) #define avhv_exists_ent(a,b,c) Perl_avhv_exists_ent(aTHX_ a,b,c) #define avhv_fetch_ent(a,b,c,d) Perl_avhv_fetch_ent(aTHX_ a,b,c,d) #define avhv_iternext(a) Perl_avhv_iternext(aTHX_ a) #define avhv_iterval(a,b) Perl_avhv_iterval(aTHX_ a,b) #define avhv_keys(a) Perl_avhv_keys(aTHX_ a) #define av_clear(a) Perl_av_clear(aTHX_ a) +#define av_delete(a,b,c) Perl_av_delete(aTHX_ a,b,c) +#define av_exists(a,b) Perl_av_exists(aTHX_ a,b) #define av_extend(a,b) Perl_av_extend(aTHX_ a,b) #define av_fake(a,b) Perl_av_fake(aTHX_ a,b) #define av_fetch(a,b,c) Perl_av_fetch(aTHX_ a,b,c) @@ -1486,7 +1564,6 @@ #define get_ppaddr() Perl_get_ppaddr(aTHX) #define cxinc() Perl_cxinc(aTHX) #define vdeb(a,b) Perl_vdeb(aTHX_ a,b) -#define deb_growlevel() Perl_deb_growlevel(aTHX) #define debprofdump() Perl_debprofdump(aTHX) #define debop(a) Perl_debop(aTHX_ a) #define debstack() Perl_debstack(aTHX) @@ -1717,9 +1794,6 @@ #define magic_sizepack(a,b) Perl_magic_sizepack(aTHX_ a,b) #define magic_wipepack(a,b) Perl_magic_wipepack(aTHX_ a,b) #define magicname(a,b,c) Perl_magicname(aTHX_ a,b,c) -#if defined(MYMALLOC) -#define malloced_size Perl_malloced_size -#endif #define markstack_grow() Perl_markstack_grow(aTHX) #if defined(USE_LOCALE_COLLATE) #define mem_collxfrm(a,b,c) Perl_mem_collxfrm(aTHX_ a,b,c) @@ -1740,20 +1814,20 @@ #define my(a) Perl_my(aTHX_ a) #define my_atof(a) Perl_my_atof(aTHX_ a) #if !defined(HAS_BCOPY) || !defined(HAS_SAFE_BCOPY) -#define my_bcopy(a,b,c) Perl_my_bcopy(aTHX_ a,b,c) +#define my_bcopy Perl_my_bcopy #endif #if !defined(HAS_BZERO) && !defined(HAS_MEMSET) -#define my_bzero(a,b) Perl_my_bzero(aTHX_ a,b) +#define my_bzero Perl_my_bzero #endif #define my_exit(a) Perl_my_exit(aTHX_ a) #define my_failure_exit() Perl_my_failure_exit(aTHX) #define my_fflush_all() Perl_my_fflush_all(aTHX) #define my_lstat() Perl_my_lstat(aTHX) #if !defined(HAS_MEMCMP) || !defined(HAS_SANE_MEMCMP) -#define my_memcmp(a,b,c) Perl_my_memcmp(aTHX_ a,b,c) +#define my_memcmp Perl_my_memcmp #endif #if !defined(HAS_MEMSET) -#define my_memset(a,b,c) Perl_my_memset(aTHX_ a,b,c) +#define my_memset Perl_my_memset #endif #if !defined(PERL_OBJECT) #define my_pclose(a) Perl_my_pclose(aTHX_ a) @@ -1798,6 +1872,7 @@ #define newHVhv(a) Perl_newHVhv(aTHX_ a) #define newIO() Perl_newIO(aTHX) #define newLISTOP(a,b,c,d) Perl_newLISTOP(aTHX_ a,b,c,d) +#define newPADOP(a,b,c) Perl_newPADOP(aTHX_ a,b,c) #define newPMOP(a,b) Perl_newPMOP(aTHX_ a,b) #define newPVOP(a,b,c) Perl_newPVOP(aTHX_ a,b,c) #define newRV(a) Perl_newRV(aTHX_ a) @@ -1832,11 +1907,10 @@ #define pad_swipe(a) Perl_pad_swipe(aTHX_ a) #define peep(a) Perl_peep(aTHX_ a) #if defined(PERL_OBJECT) -#else +#endif #if defined(USE_THREADS) #define new_struct_thread(a) Perl_new_struct_thread(aTHX_ a) #endif -#endif #define call_atexit(a,b) Perl_call_atexit(aTHX_ a,b) #define call_argv(a,b,c) Perl_call_argv(aTHX_ a,b,c) #define call_method(a,b) Perl_call_method(aTHX_ a,b) @@ -1899,6 +1973,7 @@ #define save_clearsv(a) Perl_save_clearsv(aTHX_ a) #define save_delete(a,b,c) Perl_save_delete(aTHX_ a,b,c) #define save_destructor(a,b) Perl_save_destructor(aTHX_ a,b) +#define save_destructor_x(a,b) Perl_save_destructor_x(aTHX_ a,b) #define save_freesv(a) Perl_save_freesv(aTHX_ a) #define save_freeop(a) Perl_save_freeop(aTHX_ a) #define save_freepv(a) Perl_save_freepv(aTHX_ a) @@ -1910,6 +1985,7 @@ #define save_hptr(a) Perl_save_hptr(aTHX_ a) #define save_I16(a) Perl_save_I16(aTHX_ a) #define save_I32(a) Perl_save_I32(aTHX_ a) +#define save_I8(a) Perl_save_I8(aTHX_ a) #define save_int(a) Perl_save_int(aTHX_ a) #define save_item(a) Perl_save_item(aTHX_ a) #define save_iv(a) Perl_save_iv(aTHX_ a) @@ -1919,6 +1995,7 @@ #define save_op() Perl_save_op(aTHX) #define save_scalar(a) Perl_save_scalar(aTHX_ a) #define save_pptr(a) Perl_save_pptr(aTHX_ a) +#define save_vptr(a) Perl_save_vptr(aTHX_ a) #define save_re_context() Perl_save_re_context(aTHX) #define save_sptr(a) Perl_save_sptr(aTHX_ a) #define save_svref(a) Perl_save_svref(aTHX_ a) @@ -1951,11 +2028,15 @@ #define sv_2mortal(a) Perl_sv_2mortal(aTHX_ a) #define sv_2nv(a) Perl_sv_2nv(aTHX_ a) #define sv_2pv(a,b) Perl_sv_2pv(aTHX_ a,b) +#define sv_2pvutf8(a,b) Perl_sv_2pvutf8(aTHX_ a,b) +#define sv_2pvbyte(a,b) Perl_sv_2pvbyte(aTHX_ a,b) #define sv_2uv(a) Perl_sv_2uv(aTHX_ a) #define sv_iv(a) Perl_sv_iv(aTHX_ a) #define sv_uv(a) Perl_sv_uv(aTHX_ a) #define sv_nv(a) Perl_sv_nv(aTHX_ a) #define sv_pvn(a,b) Perl_sv_pvn(aTHX_ a,b) +#define sv_pvutf8n(a,b) Perl_sv_pvutf8n(aTHX_ a,b) +#define sv_pvbyten(a,b) Perl_sv_pvbyten(aTHX_ a,b) #define sv_true(a) Perl_sv_true(aTHX_ a) #define sv_add_arena(a,b,c) Perl_sv_add_arena(aTHX_ a,b,c) #define sv_backoff(a) Perl_sv_backoff(aTHX_ a) @@ -1996,6 +2077,8 @@ #define sv_pos_u2b(a,b,c) Perl_sv_pos_u2b(aTHX_ a,b,c) #define sv_pos_b2u(a,b) Perl_sv_pos_b2u(aTHX_ a,b) #define sv_pvn_force(a,b) Perl_sv_pvn_force(aTHX_ a,b) +#define sv_pvutf8n_force(a,b) Perl_sv_pvutf8n_force(aTHX_ a,b) +#define sv_pvbyten_force(a,b) Perl_sv_pvbyten_force(aTHX_ a,b) #define sv_reftype(a,b) Perl_sv_reftype(aTHX_ a,b) #define sv_replace(a,b) Perl_sv_replace(aTHX_ a,b) #define sv_report_used() Perl_sv_report_used(aTHX) @@ -2046,6 +2129,7 @@ #define vivify_defelem(a) Perl_vivify_defelem(aTHX_ a) #define vivify_ref(a,b) Perl_vivify_ref(aTHX_ a,b) #define wait4pid(a,b,c) Perl_wait4pid(aTHX_ a,b,c) +#define report_uninit() Perl_report_uninit(aTHX) #define vwarn(a,b) Perl_vwarn(aTHX_ a,b) #define vwarner(a,b,c) Perl_vwarner(aTHX_ a,b,c) #define watch(a) Perl_watch(aTHX_ a) @@ -2100,10 +2184,14 @@ #define do_pmop_dump(a,b,c) Perl_do_pmop_dump(aTHX_ a,b,c) #define do_sv_dump(a,b,c,d,e,f,g) Perl_do_sv_dump(aTHX_ a,b,c,d,e,f,g) #define magic_dump(a) Perl_magic_dump(aTHX_ a) -#define vdefault_protect(a,b,c) Perl_vdefault_protect(aTHX_ a,b,c) +#define vdefault_protect(a,b,c,d) Perl_vdefault_protect(aTHX_ a,b,c,d) #define reginitcolors() Perl_reginitcolors(aTHX) #define sv_2pv_nolen(a) Perl_sv_2pv_nolen(aTHX_ a) +#define sv_2pvutf8_nolen(a) Perl_sv_2pvutf8_nolen(aTHX_ a) +#define sv_2pvbyte_nolen(a) Perl_sv_2pvbyte_nolen(aTHX_ a) #define sv_pv(a) Perl_sv_pv(aTHX_ a) +#define sv_pvutf8(a) Perl_sv_pvutf8(aTHX_ a) +#define sv_pvbyte(a) Perl_sv_pvbyte(aTHX_ a) #define sv_force_normal(a) Perl_sv_force_normal(aTHX_ a) #define tmps_grow(a) Perl_tmps_grow(aTHX_ a) #define sv_rvweaken(a) Perl_sv_rvweaken(aTHX_ a) @@ -2113,7 +2201,28 @@ #define newMYSUB(a,b,c,d,e) Perl_newMYSUB(aTHX_ a,b,c,d,e) #define my_attrs(a,b) Perl_my_attrs(aTHX_ a,b) #define boot_core_xsutils() Perl_boot_core_xsutils(aTHX) +#if defined(USE_ITHREADS) +#define cx_dup(a,b,c) Perl_cx_dup(aTHX_ a,b,c) +#define si_dup(a) Perl_si_dup(aTHX_ a) +#define ss_dup(a) Perl_ss_dup(aTHX_ a) +#define any_dup(a,b) Perl_any_dup(aTHX_ a,b) +#define he_dup(a,b) Perl_he_dup(aTHX_ a,b) +#define re_dup(a) Perl_re_dup(aTHX_ a) +#define fp_dup(a,b) Perl_fp_dup(aTHX_ a,b) +#define dirp_dup(a) Perl_dirp_dup(aTHX_ a) +#define gp_dup(a) Perl_gp_dup(aTHX_ a) +#define mg_dup(a) Perl_mg_dup(aTHX_ a) +#define sv_dup(a) Perl_sv_dup(aTHX_ a) +#if defined(HAVE_INTERP_INTERN) +#define sys_intern_dup(a,b) Perl_sys_intern_dup(aTHX_ a,b) +#endif +#define ptr_table_new() Perl_ptr_table_new(aTHX) +#define ptr_table_fetch(a,b) Perl_ptr_table_fetch(aTHX_ a,b) +#define ptr_table_store(a,b,c) Perl_ptr_table_store(aTHX_ a,b,c) +#define ptr_table_split(a) Perl_ptr_table_split(aTHX_ a) +#endif #if defined(PERL_OBJECT) +#else #endif #if defined(PERL_IN_AV_C) || defined(PERL_DECL_PROT) #define avhv_index_sv(a) S_avhv_index_sv(aTHX_ a) @@ -2165,6 +2274,7 @@ #define simplify_sort(a) S_simplify_sort(aTHX_ a) #define is_handle_constructor(a,b) S_is_handle_constructor(aTHX_ a,b) #define gv_ename(a) S_gv_ename(aTHX_ a) +#define cv_dump(a) S_cv_dump(aTHX_ a) #define cv_clone2(a,b) S_cv_clone2(aTHX_ a,b) #define scalar_mod_type(a,b) S_scalar_mod_type(aTHX_ a,b) #define my_kid(a,b) S_my_kid(aTHX_ a,b) @@ -2254,7 +2364,14 @@ #define regwhite(a,b) S_regwhite(aTHX_ a,b) #define nextchar() S_nextchar(aTHX) #define dumpuntil(a,b,c,d,e) S_dumpuntil(aTHX_ a,b,c,d,e) +#define put_byte(a,b) S_put_byte(aTHX_ a,b) #define scan_commit(a) S_scan_commit(aTHX_ a) +#define cl_anything(a) S_cl_anything(aTHX_ a) +#define cl_is_anything(a) S_cl_is_anything(aTHX_ a) +#define cl_init(a) S_cl_init(aTHX_ a) +#define cl_init_zero(a) S_cl_init_zero(aTHX_ a) +#define cl_and(a,b) S_cl_and(aTHX_ a,b) +#define cl_or(a,b) S_cl_or(aTHX_ a,b) #define study_chunk(a,b,c,d,e) S_study_chunk(aTHX_ a,b,c,d,e) #define add_data(a,b) S_add_data(aTHX_ a,b) #define regpposixcc(a) S_regpposixcc(aTHX_ a) @@ -2273,6 +2390,7 @@ #define cache_re(a) S_cache_re(aTHX_ a) #define reghop(a,b) S_reghop(aTHX_ a,b) #define reghopmaybe(a,b) S_reghopmaybe(aTHX_ a,b) +#define find_byclass(a,b,c,d,e,f) S_find_byclass(aTHX_ a,b,c,d,e,f) #endif #if defined(PERL_IN_RUN_C) || defined(PERL_DECL_PROT) #define debprof(a) S_debprof(aTHX_ a) @@ -2374,8 +2492,8 @@ # if defined(CRIPPLED_CC) #define uni(a,b) S_uni(aTHX_ a,b) # endif -# if defined(WIN32) -#define win32_textfilter(a,b,c) S_win32_textfilter(aTHX_ a,b,c) +# if defined(PERL_CR_FILTER) +#define cr_textfilter(a,b,c) S_cr_textfilter(aTHX_ a,b,c) # endif #endif #if defined(PERL_IN_UNIVERSAL_C) || defined(PERL_DECL_PROT) @@ -2387,6 +2505,8 @@ #define xstat(a) S_xstat(aTHX_ a) # endif #endif +#if defined(PERL_OBJECT) +#endif #define ck_anoncode(a) Perl_ck_anoncode(aTHX_ a) #define ck_bitop(a) Perl_ck_bitop(aTHX_ a) #define ck_concat(a) Perl_ck_concat(aTHX_ a) @@ -2774,7 +2894,26 @@ #endif /* PERL_IMPLICIT_CONTEXT */ #else /* PERL_OBJECT */ +#if defined(PERL_IMPLICIT_SYS) +#else +#endif +#if defined(USE_ITHREADS) +# if defined(PERL_IMPLICIT_SYS) +# endif +#endif +#if defined(MYMALLOC) +#define malloc Perl_malloc +#define calloc Perl_calloc +#define realloc Perl_realloc +#define mfree Perl_mfree +#define malloced_size Perl_malloced_size +#endif #if defined(PERL_OBJECT) +#ifndef __BORLANDC__ +#endif +#endif +#if defined(PERL_OBJECT) +#else #endif #define Perl_amagic_call CPerlObj::Perl_amagic_call #define amagic_call Perl_amagic_call @@ -2786,6 +2925,8 @@ #define append_list Perl_append_list #define Perl_apply CPerlObj::Perl_apply #define apply Perl_apply +#define Perl_avhv_delete_ent CPerlObj::Perl_avhv_delete_ent +#define avhv_delete_ent Perl_avhv_delete_ent #define Perl_avhv_exists_ent CPerlObj::Perl_avhv_exists_ent #define avhv_exists_ent Perl_avhv_exists_ent #define Perl_avhv_fetch_ent CPerlObj::Perl_avhv_fetch_ent @@ -2798,6 +2939,10 @@ #define avhv_keys Perl_avhv_keys #define Perl_av_clear CPerlObj::Perl_av_clear #define av_clear Perl_av_clear +#define Perl_av_delete CPerlObj::Perl_av_delete +#define av_delete Perl_av_delete +#define Perl_av_exists CPerlObj::Perl_av_exists +#define av_exists Perl_av_exists #define Perl_av_extend CPerlObj::Perl_av_extend #define av_extend Perl_av_extend #define Perl_av_fake CPerlObj::Perl_av_fake @@ -2922,8 +3067,6 @@ #define deb Perl_deb #define Perl_vdeb CPerlObj::Perl_vdeb #define vdeb Perl_vdeb -#define Perl_deb_growlevel CPerlObj::Perl_deb_growlevel -#define deb_growlevel Perl_deb_growlevel #define Perl_debprofdump CPerlObj::Perl_debprofdump #define debprofdump Perl_debprofdump #define Perl_debop CPerlObj::Perl_debop @@ -3374,10 +3517,6 @@ #define magic_wipepack Perl_magic_wipepack #define Perl_magicname CPerlObj::Perl_magicname #define magicname Perl_magicname -#if defined(MYMALLOC) -#define Perl_malloced_size CPerlObj::Perl_malloced_size -#define malloced_size Perl_malloced_size -#endif #define Perl_markstack_grow CPerlObj::Perl_markstack_grow #define markstack_grow Perl_markstack_grow #if defined(USE_LOCALE_COLLATE) @@ -3522,6 +3661,8 @@ #define newIO Perl_newIO #define Perl_newLISTOP CPerlObj::Perl_newLISTOP #define newLISTOP Perl_newLISTOP +#define Perl_newPADOP CPerlObj::Perl_newPADOP +#define newPADOP Perl_newPADOP #define Perl_newPMOP CPerlObj::Perl_newPMOP #define newPMOP Perl_newPMOP #define Perl_newPVOP CPerlObj::Perl_newPVOP @@ -3591,23 +3732,16 @@ #define Perl_peep CPerlObj::Perl_peep #define peep Perl_peep #if defined(PERL_OBJECT) -#define perl_construct CPerlObj::perl_construct -#define perl_destruct CPerlObj::perl_destruct -#define perl_free CPerlObj::perl_free -#define perl_run CPerlObj::perl_run -#define perl_parse CPerlObj::perl_parse -#else -#define perl_alloc CPerlObj::perl_alloc -#define perl_construct CPerlObj::perl_construct -#define perl_destruct CPerlObj::perl_destruct -#define perl_free CPerlObj::perl_free -#define perl_run CPerlObj::perl_run -#define perl_parse CPerlObj::perl_parse +#define Perl_construct CPerlObj::Perl_construct +#define Perl_destruct CPerlObj::Perl_destruct +#define Perl_free CPerlObj::Perl_free +#define Perl_run CPerlObj::Perl_run +#define Perl_parse CPerlObj::Perl_parse +#endif #if defined(USE_THREADS) #define Perl_new_struct_thread CPerlObj::Perl_new_struct_thread #define new_struct_thread Perl_new_struct_thread #endif -#endif #define Perl_call_atexit CPerlObj::Perl_call_atexit #define call_atexit Perl_call_atexit #define Perl_call_argv CPerlObj::Perl_call_argv @@ -3730,6 +3864,8 @@ #define save_delete Perl_save_delete #define Perl_save_destructor CPerlObj::Perl_save_destructor #define save_destructor Perl_save_destructor +#define Perl_save_destructor_x CPerlObj::Perl_save_destructor_x +#define save_destructor_x Perl_save_destructor_x #define Perl_save_freesv CPerlObj::Perl_save_freesv #define save_freesv Perl_save_freesv #define Perl_save_freeop CPerlObj::Perl_save_freeop @@ -3752,6 +3888,8 @@ #define save_I16 Perl_save_I16 #define Perl_save_I32 CPerlObj::Perl_save_I32 #define save_I32 Perl_save_I32 +#define Perl_save_I8 CPerlObj::Perl_save_I8 +#define save_I8 Perl_save_I8 #define Perl_save_int CPerlObj::Perl_save_int #define save_int Perl_save_int #define Perl_save_item CPerlObj::Perl_save_item @@ -3770,6 +3908,8 @@ #define save_scalar Perl_save_scalar #define Perl_save_pptr CPerlObj::Perl_save_pptr #define save_pptr Perl_save_pptr +#define Perl_save_vptr CPerlObj::Perl_save_vptr +#define save_vptr Perl_save_vptr #define Perl_save_re_context CPerlObj::Perl_save_re_context #define save_re_context Perl_save_re_context #define Perl_save_sptr CPerlObj::Perl_save_sptr @@ -3832,6 +3972,10 @@ #define sv_2nv Perl_sv_2nv #define Perl_sv_2pv CPerlObj::Perl_sv_2pv #define sv_2pv Perl_sv_2pv +#define Perl_sv_2pvutf8 CPerlObj::Perl_sv_2pvutf8 +#define sv_2pvutf8 Perl_sv_2pvutf8 +#define Perl_sv_2pvbyte CPerlObj::Perl_sv_2pvbyte +#define sv_2pvbyte Perl_sv_2pvbyte #define Perl_sv_2uv CPerlObj::Perl_sv_2uv #define sv_2uv Perl_sv_2uv #define Perl_sv_iv CPerlObj::Perl_sv_iv @@ -3842,6 +3986,10 @@ #define sv_nv Perl_sv_nv #define Perl_sv_pvn CPerlObj::Perl_sv_pvn #define sv_pvn Perl_sv_pvn +#define Perl_sv_pvutf8n CPerlObj::Perl_sv_pvutf8n +#define sv_pvutf8n Perl_sv_pvutf8n +#define Perl_sv_pvbyten CPerlObj::Perl_sv_pvbyten +#define sv_pvbyten Perl_sv_pvbyten #define Perl_sv_true CPerlObj::Perl_sv_true #define sv_true Perl_sv_true #define Perl_sv_add_arena CPerlObj::Perl_sv_add_arena @@ -3922,6 +4070,10 @@ #define sv_pos_b2u Perl_sv_pos_b2u #define Perl_sv_pvn_force CPerlObj::Perl_sv_pvn_force #define sv_pvn_force Perl_sv_pvn_force +#define Perl_sv_pvutf8n_force CPerlObj::Perl_sv_pvutf8n_force +#define sv_pvutf8n_force Perl_sv_pvutf8n_force +#define Perl_sv_pvbyten_force CPerlObj::Perl_sv_pvbyten_force +#define sv_pvbyten_force Perl_sv_pvbyten_force #define Perl_sv_reftype CPerlObj::Perl_sv_reftype #define sv_reftype Perl_sv_reftype #define Perl_sv_replace CPerlObj::Perl_sv_replace @@ -4020,6 +4172,8 @@ #define vivify_ref Perl_vivify_ref #define Perl_wait4pid CPerlObj::Perl_wait4pid #define wait4pid Perl_wait4pid +#define Perl_report_uninit CPerlObj::Perl_report_uninit +#define report_uninit Perl_report_uninit #define Perl_warn CPerlObj::Perl_warn #define warn Perl_warn #define Perl_vwarn CPerlObj::Perl_vwarn @@ -4048,14 +4202,6 @@ #if defined(MYMALLOC) #define Perl_dump_mstats CPerlObj::Perl_dump_mstats #define dump_mstats Perl_dump_mstats -#define Perl_malloc CPerlObj::Perl_malloc -#define malloc Perl_malloc -#define Perl_calloc CPerlObj::Perl_calloc -#define calloc Perl_calloc -#define Perl_realloc CPerlObj::Perl_realloc -#define realloc Perl_realloc -#define Perl_mfree CPerlObj::Perl_mfree -#define mfree Perl_mfree #endif #define Perl_safesysmalloc CPerlObj::Perl_safesysmalloc #define safesysmalloc Perl_safesysmalloc @@ -4145,8 +4291,16 @@ #define reginitcolors Perl_reginitcolors #define Perl_sv_2pv_nolen CPerlObj::Perl_sv_2pv_nolen #define sv_2pv_nolen Perl_sv_2pv_nolen +#define Perl_sv_2pvutf8_nolen CPerlObj::Perl_sv_2pvutf8_nolen +#define sv_2pvutf8_nolen Perl_sv_2pvutf8_nolen +#define Perl_sv_2pvbyte_nolen CPerlObj::Perl_sv_2pvbyte_nolen +#define sv_2pvbyte_nolen Perl_sv_2pvbyte_nolen #define Perl_sv_pv CPerlObj::Perl_sv_pv #define sv_pv Perl_sv_pv +#define Perl_sv_pvutf8 CPerlObj::Perl_sv_pvutf8 +#define sv_pvutf8 Perl_sv_pvutf8 +#define Perl_sv_pvbyte CPerlObj::Perl_sv_pvbyte +#define sv_pvbyte Perl_sv_pvbyte #define Perl_sv_force_normal CPerlObj::Perl_sv_force_normal #define sv_force_normal Perl_sv_force_normal #define Perl_tmps_grow CPerlObj::Perl_tmps_grow @@ -4165,7 +4319,44 @@ #define my_attrs Perl_my_attrs #define Perl_boot_core_xsutils CPerlObj::Perl_boot_core_xsutils #define boot_core_xsutils Perl_boot_core_xsutils +#if defined(USE_ITHREADS) +#define Perl_cx_dup CPerlObj::Perl_cx_dup +#define cx_dup Perl_cx_dup +#define Perl_si_dup CPerlObj::Perl_si_dup +#define si_dup Perl_si_dup +#define Perl_ss_dup CPerlObj::Perl_ss_dup +#define ss_dup Perl_ss_dup +#define Perl_any_dup CPerlObj::Perl_any_dup +#define any_dup Perl_any_dup +#define Perl_he_dup CPerlObj::Perl_he_dup +#define he_dup Perl_he_dup +#define Perl_re_dup CPerlObj::Perl_re_dup +#define re_dup Perl_re_dup +#define Perl_fp_dup CPerlObj::Perl_fp_dup +#define fp_dup Perl_fp_dup +#define Perl_dirp_dup CPerlObj::Perl_dirp_dup +#define dirp_dup Perl_dirp_dup +#define Perl_gp_dup CPerlObj::Perl_gp_dup +#define gp_dup Perl_gp_dup +#define Perl_mg_dup CPerlObj::Perl_mg_dup +#define mg_dup Perl_mg_dup +#define Perl_sv_dup CPerlObj::Perl_sv_dup +#define sv_dup Perl_sv_dup +#if defined(HAVE_INTERP_INTERN) +#define Perl_sys_intern_dup CPerlObj::Perl_sys_intern_dup +#define sys_intern_dup Perl_sys_intern_dup +#endif +#define Perl_ptr_table_new CPerlObj::Perl_ptr_table_new +#define ptr_table_new Perl_ptr_table_new +#define Perl_ptr_table_fetch CPerlObj::Perl_ptr_table_fetch +#define ptr_table_fetch Perl_ptr_table_fetch +#define Perl_ptr_table_store CPerlObj::Perl_ptr_table_store +#define ptr_table_store Perl_ptr_table_store +#define Perl_ptr_table_split CPerlObj::Perl_ptr_table_split +#define ptr_table_split Perl_ptr_table_split +#endif #if defined(PERL_OBJECT) +#else #endif #if defined(PERL_IN_AV_C) || defined(PERL_DECL_PROT) #define S_avhv_index_sv CPerlObj::S_avhv_index_sv @@ -4256,6 +4447,8 @@ #define is_handle_constructor S_is_handle_constructor #define S_gv_ename CPerlObj::S_gv_ename #define gv_ename S_gv_ename +#define S_cv_dump CPerlObj::S_cv_dump +#define cv_dump S_cv_dump #define S_cv_clone2 CPerlObj::S_cv_clone2 #define cv_clone2 S_cv_clone2 #define S_scalar_mod_type CPerlObj::S_scalar_mod_type @@ -4414,8 +4607,22 @@ #define nextchar S_nextchar #define S_dumpuntil CPerlObj::S_dumpuntil #define dumpuntil S_dumpuntil +#define S_put_byte CPerlObj::S_put_byte +#define put_byte S_put_byte #define S_scan_commit CPerlObj::S_scan_commit #define scan_commit S_scan_commit +#define S_cl_anything CPerlObj::S_cl_anything +#define cl_anything S_cl_anything +#define S_cl_is_anything CPerlObj::S_cl_is_anything +#define cl_is_anything S_cl_is_anything +#define S_cl_init CPerlObj::S_cl_init +#define cl_init S_cl_init +#define S_cl_init_zero CPerlObj::S_cl_init_zero +#define cl_init_zero S_cl_init_zero +#define S_cl_and CPerlObj::S_cl_and +#define cl_and S_cl_and +#define S_cl_or CPerlObj::S_cl_or +#define cl_or S_cl_or #define S_study_chunk CPerlObj::S_study_chunk #define study_chunk S_study_chunk #define S_add_data CPerlObj::S_add_data @@ -4452,6 +4659,8 @@ #define reghop S_reghop #define S_reghopmaybe CPerlObj::S_reghopmaybe #define reghopmaybe S_reghopmaybe +#define S_find_byclass CPerlObj::S_find_byclass +#define find_byclass S_find_byclass #endif #if defined(PERL_IN_RUN_C) || defined(PERL_DECL_PROT) #define S_debprof CPerlObj::S_debprof @@ -4639,9 +4848,9 @@ #define S_uni CPerlObj::S_uni #define uni S_uni # endif -# if defined(WIN32) -#define S_win32_textfilter CPerlObj::S_win32_textfilter -#define win32_textfilter S_win32_textfilter +# if defined(PERL_CR_FILTER) +#define S_cr_textfilter CPerlObj::S_cr_textfilter +#define cr_textfilter S_cr_textfilter # endif #endif #if defined(PERL_IN_UNIVERSAL_C) || defined(PERL_DECL_PROT) @@ -4656,6 +4865,8 @@ #define xstat S_xstat # endif #endif +#if defined(PERL_OBJECT) +#endif #define Perl_ck_anoncode CPerlObj::Perl_ck_anoncode #define ck_anoncode Perl_ck_anoncode #define Perl_ck_bitop CPerlObj::Perl_ck_bitop @@ -5442,23 +5653,23 @@ The following are not like that, but since they had a "perl_" prefix in previous versions, we provide compatibility macros. */ -# define perl_atexit call_atexit -# define perl_call_argv call_argv -# define perl_call_pv call_pv -# define perl_call_method call_method -# define perl_call_sv call_sv -# define perl_eval_sv eval_sv -# define perl_eval_pv eval_pv -# define perl_require_pv require_pv -# define perl_get_sv get_sv -# define perl_get_av get_av -# define perl_get_hv get_hv -# define perl_get_cv get_cv -# define perl_init_i18nl10n init_i18nl10n -# define perl_init_i18nl14n init_i18nl14n -# define perl_new_ctype new_ctype -# define perl_new_collate new_collate -# define perl_new_numeric new_numeric +# define perl_atexit(a,b) call_atexit(a,b) +# define perl_call_argv(a,b,c) call_argv(a,b,c) +# define perl_call_pv(a,b) call_pv(a,b) +# define perl_call_method(a,b) call_method(a,b) +# define perl_call_sv(a,b) call_sv(a,b) +# define perl_eval_sv(a,b) eval_sv(a,b) +# define perl_eval_pv(a,b) eval_pv(a,b) +# define perl_require_pv(a) require_pv(a) +# define perl_get_sv(a,b) get_sv(a,b) +# define perl_get_av(a,b) get_av(a,b) +# define perl_get_hv(a,b) get_hv(a,b) +# define perl_get_cv(a,b) get_cv(a,b) +# define perl_init_i18nl10n(a) init_i18nl10n(a) +# define perl_init_i18nl14n(a) init_i18nl14n(a) +# define perl_new_ctype(a) new_ctype(a) +# define perl_new_collate(a) new_collate(a) +# define perl_new_numeric(a) new_numeric(a) /* varargs functions can't be handled with CPP macros. :-( This provides a set of compatibility functions that don't take diff --git a/embed.pl b/embed.pl index aa17d9d..84d689e 100755 --- a/embed.pl +++ b/embed.pl @@ -31,6 +31,7 @@ sub walk_table (&@) { seek DATA, $END, 0; # so we may restart while () { chomp; + next if /^:/; while (s|\\$||) { $_ .= ; chomp; @@ -106,8 +107,7 @@ sub write_protos { my $ret = ""; if (@_ == 1) { my $arg = shift; - $ret .= "$arg\n" if $arg =~ /^#\s*(if|ifdef|else|endif)\b/ - or $arg =~ /^\s*(public|protected|private):/; + $ret .= "$arg\n"; } else { my ($flags,$retval,$func,@args) = @_; @@ -116,7 +116,7 @@ sub write_protos { $func = "S_$func"; } else { - $retval = "VIRTUAL $retval"; + $retval = "PERL_CALLCONV $retval"; if ($flags =~ /p/) { $func = "Perl_$func"; } @@ -144,7 +144,7 @@ sub write_global_sym { my $ret = ""; if (@_ > 1) { my ($flags,$retval,$func,@args) = @_; - unless ($flags =~ /s/) { + unless ($flags =~ /[sx]/) { $func = "Perl_$func" if $flags =~ /p/; $ret = "$func\n"; } @@ -324,7 +324,7 @@ walk_table { my $ret = ""; if (@_ == 1) { my $arg = shift; - $ret .= "$arg\n" if $arg =~ /^#\s*(if|ifdef|else|endif)\b/; + $ret .= "$arg\n" if $arg =~ /^#\s*(if|ifn?def|else|endif)\b/; } else { my ($flags,$retval,$func,@args) = @_; @@ -357,7 +357,7 @@ walk_table { my $ret = ""; if (@_ == 1) { my $arg = shift; - $ret .= "$arg\n" if $arg =~ /^#\s*(if|ifdef|else|endif)\b/; + $ret .= "$arg\n" if $arg =~ /^#\s*(if|ifn?def|else|endif)\b/; } else { my ($flags,$retval,$func,@args) = @_; @@ -417,20 +417,20 @@ walk_table { my $ret = ""; if (@_ == 1) { my $arg = shift; - $ret .= "$arg\n" if $arg =~ /^#\s*(if|ifdef|else|endif)\b/; + $ret .= "$arg\n" if $arg =~ /^#\s*(if|ifn?def|else|endif)\b/; } else { my ($flags,$retval,$func,@args) = @_; if ($flags =~ /s/) { - $ret .= hide("S_$func","CPerlObj::S_$func"); + $ret .= hide("S_$func","CPerlObj::S_$func") if $flags !~ /j/; $ret .= hide($func,"S_$func"); } elsif ($flags =~ /p/) { - $ret .= hide("Perl_$func","CPerlObj::Perl_$func"); + $ret .= hide("Perl_$func","CPerlObj::Perl_$func") if $flags !~ /j/; $ret .= hide($func,"Perl_$func"); } else { - $ret .= hide($func,"CPerlObj::$func"); + $ret .= hide($func,"CPerlObj::$func") if $flags !~ /j/; } } $ret; @@ -463,23 +463,23 @@ print EM <<'END'; The following are not like that, but since they had a "perl_" prefix in previous versions, we provide compatibility macros. */ -# define perl_atexit call_atexit -# define perl_call_argv call_argv -# define perl_call_pv call_pv -# define perl_call_method call_method -# define perl_call_sv call_sv -# define perl_eval_sv eval_sv -# define perl_eval_pv eval_pv -# define perl_require_pv require_pv -# define perl_get_sv get_sv -# define perl_get_av get_av -# define perl_get_hv get_hv -# define perl_get_cv get_cv -# define perl_init_i18nl10n init_i18nl10n -# define perl_init_i18nl14n init_i18nl14n -# define perl_new_ctype new_ctype -# define perl_new_collate new_collate -# define perl_new_numeric new_numeric +# define perl_atexit(a,b) call_atexit(a,b) +# define perl_call_argv(a,b,c) call_argv(a,b,c) +# define perl_call_pv(a,b) call_pv(a,b) +# define perl_call_method(a,b) call_method(a,b) +# define perl_call_sv(a,b) call_sv(a,b) +# define perl_eval_sv(a,b) eval_sv(a,b) +# define perl_eval_pv(a,b) eval_pv(a,b) +# define perl_require_pv(a) require_pv(a) +# define perl_get_sv(a,b) get_sv(a,b) +# define perl_get_av(a,b) get_av(a,b) +# define perl_get_hv(a,b) get_hv(a,b) +# define perl_get_cv(a,b) get_cv(a,b) +# define perl_init_i18nl10n(a) init_i18nl10n(a) +# define perl_init_i18nl14n(a) init_i18nl14n(a) +# define perl_new_ctype(a) new_ctype(a) +# define perl_new_collate(a) new_collate(a) +# define perl_new_numeric(a) new_numeric(a) /* varargs functions can't be handled with CPP macros. :-( This provides a set of compatibility functions that don't take @@ -597,7 +597,26 @@ print EM <<'END'; # endif /* USE_THREADS */ #else /* !MULTIPLICITY */ -/* cases 1, 4 and 6 above */ + +# if defined(PERL_OBJECT) +/* case 6 above */ + +END + +for $sym (sort keys %thread) { + print EM multon($sym,'T','aTHXo->interp.'); +} + + +for $sym (sort keys %intrp) { + print EM multon($sym,'I','aTHXo->interp.'); +} + +print EM <<'END'; + +# else /* !PERL_OBJECT */ + +/* cases 1 and 4 above */ END @@ -607,7 +626,7 @@ for $sym (sort keys %intrp) { print EM <<'END'; -# if defined(USE_THREADS) +# if defined(USE_THREADS) /* case 4 above */ END @@ -618,8 +637,8 @@ for $sym (sort keys %thread) { print EM <<'END'; -# else /* !USE_THREADS */ -/* cases 1 and 6 above */ +# else /* !USE_THREADS */ +/* case 1 above */ END @@ -629,7 +648,8 @@ for $sym (sort keys %thread) { print EM <<'END'; -# endif /* USE_THREADS */ +# endif /* USE_THREADS */ +# endif /* PERL_OBJECT */ #endif /* MULTIPLICITY */ #if defined(PERL_GLOBAL_STRUCT) @@ -712,11 +732,11 @@ walk_table { my $ret = ""; if (@_ == 1) { my $arg = shift; - $ret .= "$arg\n" if $arg =~ /^#\s*(if|ifdef|else|endif)\b/; + $ret .= "$arg\n" if $arg =~ /^#\s*(if|ifn?def|else|endif)\b/; } else { my ($flags,$retval,$func,@args) = @_; - unless ($flags =~ /s/) { + unless ($flags =~ /[js]/) { if ($flags =~ /p/) { $ret .= undefine("Perl_$func") . hide("Perl_$func","pPerl->Perl_$func"); $ret .= undefine($func) . hide($func,"Perl_$func"); @@ -813,9 +833,9 @@ START_EXTERN_C #undef PERLVARI #undef PERLVARIC #define PERLVAR(v,t) t* Perl_##v##_ptr(pTHXo) \ - { return &(aTHXo->PL_##v); } + { return &(aTHXo->interp.v); } #define PERLVARA(v,n,t) PL_##v##_t* Perl_##v##_ptr(pTHXo) \ - { return &(aTHXo->PL_##v); } + { return &(aTHXo->interp.v); } #define PERLVARI(v,t,i) PERLVAR(v,t) #define PERLVARIC(v,t,i) PERLVAR(v, const t) @@ -838,6 +858,7 @@ START_EXTERN_C EOT # functions that take va_list* for implementing vararg functions +# NOTE: makedef.pl must be updated if you add symbols to %vfuncs my %vfuncs = qw( Perl_croak Perl_vcroak Perl_warn Perl_vwarn @@ -922,12 +943,12 @@ walk_table { my $ret = ""; if (@_ == 1) { my $arg = shift; - $ret .= "$arg\n" if $arg =~ /^#\s*(if|ifdef|else|endif)\b/; + $ret .= "$arg\n" if $arg =~ /^#\s*(if|ifn?def|else|endif)\b/; } else { my ($flags,$retval,$func,@args) = @_; return $ret if exists $skipapi_funcs{$func}; - unless ($flags =~ /s/) { + unless ($flags =~ /[js]/) { $ret .= "\n"; my $addctx = 1 if $flags =~ /n/; if ($flags =~ /p/) { @@ -964,7 +985,7 @@ Perl_fprintf_nocontext(PerlIO *stream, const char *format, ...) dTHXo; va_list(arglist); va_start(arglist, format); - return (*pPerl->PL_StdIO->pVprintf)(pPerl->PL_StdIO, stream, format, arglist); + return (*PL_StdIO->pVprintf)(PL_StdIO, stream, format, arglist); } END_EXTERN_C @@ -974,44 +995,104 @@ EOT __END__ -# Lines are of the form: -# flags|return_type|function_name|arg1|arg2|...|argN -# -# A line may be continued on another by ending it with a backslash. -# Leading and trailing whitespace will be ignored in each component. -# -# flags are single letters with following meanings: -# s static function, should have an S_ prefix in source -# file -# n has no implicit interpreter/thread context argument -# p function has a Perl_ prefix -# r function never returns -# o has no compatibility macro (#define foo Perl_foo) -# -# Individual flags may be separated by whitespace. -# -# New global functions should be added at the end for binary compatibility -# in some configurations. -# -# TODO: 1) Add a flag to mark the functions that are part of the public API. -# 2) Add a field for documentation, so that L -# may be autogenerated. -# +: Lines are of the form: +: flags|return_type|function_name|arg1|arg2|...|argN +: +: A line may be continued on another by ending it with a backslash. +: Leading and trailing whitespace will be ignored in each component. +: +: flags are single letters with following meanings: +: s static function, should have an S_ prefix in source +: file +: n has no implicit interpreter/thread context argument +: p function has a Perl_ prefix +: r function never returns +: o has no compatibility macro (#define foo Perl_foo) +: j not a member of CPerlObj +: x not exported +: +: Individual flags may be separated by whitespace. +: +: New global functions should be added at the end for binary compatibility +: in some configurations. +: +: TODO: 1) Add a flag to mark the functions that are part of the public API. +: 2) Add a field for documentation, so that L +: may be autogenerated. + +START_EXTERN_C +#if defined(PERL_IMPLICIT_SYS) +jno |PerlInterpreter* |perl_alloc_using \ + |struct IPerlMem* m|struct IPerlMem* ms \ + |struct IPerlMem* mp|struct IPerlEnv* e \ + |struct IPerlStdIO* io|struct IPerlLIO* lio \ + |struct IPerlDir* d|struct IPerlSock* s \ + |struct IPerlProc* p +#else +jno |PerlInterpreter* |perl_alloc +#endif +jno |void |perl_construct |PerlInterpreter* interp +jno |void |perl_destruct |PerlInterpreter* interp +jno |void |perl_free |PerlInterpreter* interp +jno |int |perl_run |PerlInterpreter* interp +jno |int |perl_parse |PerlInterpreter* interp|XSINIT_t xsinit \ + |int argc|char** argv|char** env +#if defined(USE_ITHREADS) +jno |PerlInterpreter*|perl_clone|PerlInterpreter* interp, UV flags +# if defined(PERL_IMPLICIT_SYS) +jno |PerlInterpreter*|perl_clone_using|PerlInterpreter *interp|UV flags \ + |struct IPerlMem* m|struct IPerlMem* ms \ + |struct IPerlMem* mp|struct IPerlEnv* e \ + |struct IPerlStdIO* io|struct IPerlLIO* lio \ + |struct IPerlDir* d|struct IPerlSock* s \ + |struct IPerlProc* p +# endif +#endif + +#if defined(MYMALLOC) +jnop |Malloc_t|malloc |MEM_SIZE nbytes +jnop |Malloc_t|calloc |MEM_SIZE elements|MEM_SIZE size +jnop |Malloc_t|realloc |Malloc_t where|MEM_SIZE nbytes +jnop |Free_t |mfree |Malloc_t where +jnp |MEM_SIZE|malloced_size |void *p +#endif + +END_EXTERN_C + +/* functions with flag 'n' should come before here */ #if defined(PERL_OBJECT) +class CPerlObj { public: + struct interpreter interp; + CPerlObj(IPerlMem*, IPerlMem*, IPerlMem*, IPerlEnv*, IPerlStdIO*, + IPerlLIO*, IPerlDir*, IPerlSock*, IPerlProc*); + void* operator new(size_t nSize, IPerlMem *pvtbl); +#ifndef __BORLANDC__ + static void operator delete(void* pPerl, IPerlMem *pvtbl); +#endif + int do_aspawn (void *vreally, void **vmark, void **vsp); +#endif +#if defined(PERL_OBJECT) +public: +#else +START_EXTERN_C #endif +# include "pp_proto.h" p |SV* |amagic_call |SV* left|SV* right|int method|int dir p |bool |Gv_AMupdate |HV* stash p |OP* |append_elem |I32 optype|OP* head|OP* tail p |OP* |append_list |I32 optype|LISTOP* first|LISTOP* last p |I32 |apply |I32 type|SV** mark|SV** sp +p |SV* |avhv_delete_ent|AV *ar|SV* keysv|I32 flags|U32 hash p |bool |avhv_exists_ent|AV *ar|SV* keysv|U32 hash p |SV** |avhv_fetch_ent |AV *ar|SV* keysv|I32 lval|U32 hash p |HE* |avhv_iternext |AV *ar p |SV* |avhv_iterval |AV *ar|HE* entry p |HV* |avhv_keys |AV *ar p |void |av_clear |AV* ar +p |SV* |av_delete |AV* ar|I32 key|I32 flags +p |bool |av_exists |AV* ar|I32 key p |void |av_extend |AV* ar|I32 key p |AV* |av_fake |I32 size|SV** svp p |SV** |av_fetch |AV* ar|I32 key|I32 lval @@ -1046,7 +1127,7 @@ p |OP* |convert |I32 optype|I32 flags|OP* o pr |void |croak |const char* pat|... pr |void |vcroak |const char* pat|va_list* args #if defined(PERL_IMPLICIT_CONTEXT) -npr |void |croak_nocontext|const char* pat|... +nrp |void |croak_nocontext|const char* pat|... np |OP* |die_nocontext |const char* pat|... np |void |deb_nocontext |const char* pat|... np |char* |form_nocontext |const char* pat|... @@ -1077,7 +1158,6 @@ p |PPADDR_t*|get_ppaddr p |I32 |cxinc p |void |deb |const char* pat|... p |void |vdeb |const char* pat|va_list* args -p |void |deb_growlevel p |void |debprofdump p |I32 |debop |OP* o p |I32 |debstack @@ -1321,9 +1401,6 @@ p |int |magic_set_all_env|SV* sv|MAGIC* mg p |U32 |magic_sizepack |SV* sv|MAGIC* mg p |int |magic_wipepack |SV* sv|MAGIC* mg p |void |magicname |char* sym|char* name|I32 namlen -#if defined(MYMALLOC) -np |MEM_SIZE|malloced_size |void *p -#endif p |void |markstack_grow #if defined(USE_LOCALE_COLLATE) p |char* |mem_collxfrm |const char* s|STRLEN len|STRLEN* xlen @@ -1345,20 +1422,20 @@ p |char* |moreswitches |char* s p |OP* |my |OP* o p |NV |my_atof |const char *s #if !defined(HAS_BCOPY) || !defined(HAS_SAFE_BCOPY) -p |char* |my_bcopy |const char* from|char* to|I32 len +np |char* |my_bcopy |const char* from|char* to|I32 len #endif #if !defined(HAS_BZERO) && !defined(HAS_MEMSET) -p |char* |my_bzero |char* loc|I32 len +np |char* |my_bzero |char* loc|I32 len #endif pr |void |my_exit |U32 status pr |void |my_failure_exit p |I32 |my_fflush_all p |I32 |my_lstat #if !defined(HAS_MEMCMP) || !defined(HAS_SANE_MEMCMP) -p |I32 |my_memcmp |const char* s1|const char* s2|I32 len +np |I32 |my_memcmp |const char* s1|const char* s2|I32 len #endif #if !defined(HAS_MEMSET) -p |void* |my_memset |char* loc|I32 ch|I32 len +np |void* |my_memset |char* loc|I32 ch|I32 len #endif #if !defined(PERL_OBJECT) p |I32 |my_pclose |PerlIO* ptr @@ -1404,6 +1481,7 @@ p |HV* |newHV p |HV* |newHVhv |HV* hv p |IO* |newIO p |OP* |newLISTOP |I32 type|I32 flags|OP* first|OP* last +p |OP* |newPADOP |I32 type|I32 flags|SV* sv p |OP* |newPMOP |I32 type|I32 flags p |OP* |newPVOP |I32 type|I32 flags|char* pv p |SV* |newRV |SV* pref @@ -1442,24 +1520,16 @@ p |void |pad_reset p |void |pad_swipe |PADOFFSET po p |void |peep |OP* o #if defined(PERL_OBJECT) -no |void |perl_construct -no |void |perl_destruct -no |void |perl_free -no |int |perl_run -no |int |perl_parse |XSINIT_t xsinit \ - |int argc|char** argv|char** env -#else -no |PerlInterpreter* |perl_alloc -no |void |perl_construct |PerlInterpreter* sv_interp -no |void |perl_destruct |PerlInterpreter* sv_interp -no |void |perl_free |PerlInterpreter* sv_interp -no |int |perl_run |PerlInterpreter* sv_interp -no |int |perl_parse |PerlInterpreter* sv_interp|XSINIT_t xsinit \ +ox |void |Perl_construct +ox |void |Perl_destruct +ox |void |Perl_free +ox |int |Perl_run +ox |int |Perl_parse |XSINIT_t xsinit \ |int argc|char** argv|char** env +#endif #if defined(USE_THREADS) p |struct perl_thread* |new_struct_thread|struct perl_thread *t #endif -#endif p |void |call_atexit |ATEXIT_t fn|void *ptr p |I32 |call_argv |const char* sub_name|I32 flags|char** argv p |I32 |call_method |const char* methname|I32 flags @@ -1528,7 +1598,8 @@ p |void |save_aptr |AV** aptr p |AV* |save_ary |GV* gv p |void |save_clearsv |SV** svp p |void |save_delete |HV* hv|char* key|I32 klen -p |void |save_destructor|DESTRUCTORFUNC_t f|void* p +p |void |save_destructor|DESTRUCTORFUNC_NOCONTEXT_t f|void* p +p |void |save_destructor_x|DESTRUCTORFUNC_t f|void* p p |void |save_freesv |SV* sv p |void |save_freeop |OP* o p |void |save_freepv |char* pv @@ -1540,6 +1611,7 @@ p |void |save_hints p |void |save_hptr |HV** hptr p |void |save_I16 |I16* intp p |void |save_I32 |I32* intp +p |void |save_I8 |I8* bytep p |void |save_int |int* intp p |void |save_item |SV* item p |void |save_iv |IV* iv @@ -1549,6 +1621,7 @@ p |void |save_nogv |GV* gv p |void |save_op p |SV* |save_scalar |GV* gv p |void |save_pptr |char** pptr +p |void |save_vptr |void* pptr p |void |save_re_context p |void |save_sptr |SV** sptr p |SV* |save_svref |SV** sptr @@ -1582,11 +1655,15 @@ p |IV |sv_2iv |SV* sv p |SV* |sv_2mortal |SV* sv p |NV |sv_2nv |SV* sv p |char* |sv_2pv |SV* sv|STRLEN* lp +p |char* |sv_2pvutf8 |SV* sv|STRLEN* lp +p |char* |sv_2pvbyte |SV* sv|STRLEN* lp p |UV |sv_2uv |SV* sv p |IV |sv_iv |SV* sv p |UV |sv_uv |SV* sv p |NV |sv_nv |SV* sv p |char* |sv_pvn |SV *sv|STRLEN *len +p |char* |sv_pvutf8n |SV *sv|STRLEN *len +p |char* |sv_pvbyten |SV *sv|STRLEN *len p |I32 |sv_true |SV *sv p |void |sv_add_arena |char* ptr|U32 size|U32 flags p |int |sv_backoff |SV* sv @@ -1630,6 +1707,8 @@ p |char* |sv_peek |SV* sv p |void |sv_pos_u2b |SV* sv|I32* offsetp|I32* lenp p |void |sv_pos_b2u |SV* sv|I32* offsetp p |char* |sv_pvn_force |SV* sv|STRLEN* lp +p |char* |sv_pvutf8n_force|SV* sv|STRLEN* lp +p |char* |sv_pvbyten_force|SV* sv|STRLEN* lp p |char* |sv_reftype |SV* sv|int ob p |void |sv_replace |SV* sv|SV* nsv p |void |sv_report_used @@ -1665,7 +1744,7 @@ p |SV* |swash_init |char* pkg|char* name|SV* listsv \ |I32 minbits|I32 none p |UV |swash_fetch |SV *sv|U8 *ptr p |void |taint_env -p |void |taint_proper |const char* f|char* s +p |void |taint_proper |const char* f|const char* s p |UV |to_utf8_lower |U8 *p p |UV |to_utf8_upper |U8 *p p |UV |to_utf8_title |U8 *p @@ -1687,6 +1766,7 @@ p |U8* |uv_to_utf8 |U8 *d|UV uv p |void |vivify_defelem |SV* sv p |void |vivify_ref |SV* sv|U32 to_what p |I32 |wait4pid |Pid_t pid|int* statusp|int flags +p |void |report_uninit p |void |warn |const char* pat|... p |void |vwarn |const char* pat|va_list* args p |void |warner |U32 err|const char* pat|... @@ -1703,20 +1783,16 @@ p |int |yyparse p |int |yywarn |char* s #if defined(MYMALLOC) p |void |dump_mstats |char* s -pno |Malloc_t|malloc |MEM_SIZE nbytes -pno |Malloc_t|calloc |MEM_SIZE elements|MEM_SIZE size -pno |Malloc_t|realloc |Malloc_t where|MEM_SIZE nbytes -pno |Free_t |mfree |Malloc_t where #endif -pn |Malloc_t|safesysmalloc |MEM_SIZE nbytes -pn |Malloc_t|safesyscalloc |MEM_SIZE elements|MEM_SIZE size -pn |Malloc_t|safesysrealloc|Malloc_t where|MEM_SIZE nbytes -pn |Free_t |safesysfree |Malloc_t where +np |Malloc_t|safesysmalloc |MEM_SIZE nbytes +np |Malloc_t|safesyscalloc |MEM_SIZE elements|MEM_SIZE size +np |Malloc_t|safesysrealloc|Malloc_t where|MEM_SIZE nbytes +np |Free_t |safesysfree |Malloc_t where #if defined(LEAKTEST) -pn |Malloc_t|safexmalloc |I32 x|MEM_SIZE size -pn |Malloc_t|safexcalloc |I32 x|MEM_SIZE elements|MEM_SIZE size -pn |Malloc_t|safexrealloc |Malloc_t where|MEM_SIZE size -pn |void |safexfree |Malloc_t where +np |Malloc_t|safexmalloc |I32 x|MEM_SIZE size +np |Malloc_t|safexcalloc |I32 x|MEM_SIZE elements|MEM_SIZE size +np |Malloc_t|safexrealloc |Malloc_t where|MEM_SIZE size +np |void |safexfree |Malloc_t where #endif #if defined(PERL_GLOBAL_STRUCT) p |struct perl_vars *|GetVars @@ -1754,11 +1830,17 @@ p |void |do_pmop_dump |I32 level|PerlIO *file|PMOP *pm p |void |do_sv_dump |I32 level|PerlIO *file|SV *sv|I32 nest \ |I32 maxnest|bool dumpops|STRLEN pvlim p |void |magic_dump |MAGIC *mg -p |void* |default_protect|int *excpt|protect_body_t body|... -p |void* |vdefault_protect|int *excpt|protect_body_t body|va_list *args +p |void* |default_protect|volatile JMPENV *je|int *excpt \ + |protect_body_t body|... +p |void* |vdefault_protect|volatile JMPENV *je|int *excpt \ + |protect_body_t body|va_list *args p |void |reginitcolors p |char* |sv_2pv_nolen |SV* sv +p |char* |sv_2pvutf8_nolen|SV* sv +p |char* |sv_2pvbyte_nolen|SV* sv p |char* |sv_pv |SV *sv +p |char* |sv_pvutf8 |SV *sv +p |char* |sv_pvbyte |SV *sv p |void |sv_force_normal|SV *sv p |void |tmps_grow |I32 n p |SV* |sv_rvweaken |SV *sv @@ -1768,10 +1850,34 @@ p |CV* |newATTRSUB |I32 floor|OP *o|OP *proto|OP *attrs|OP *block p |void |newMYSUB |I32 floor|OP *o|OP *proto|OP *attrs|OP *block p |OP * |my_attrs |OP *o|OP *attrs p |void |boot_core_xsutils +#if defined(USE_ITHREADS) +p |PERL_CONTEXT*|cx_dup |PERL_CONTEXT* cx|I32 ix|I32 max +p |PERL_SI*|si_dup |PERL_SI* si +p |ANY* |ss_dup |PerlInterpreter* proto_perl +p |void* |any_dup |void* v|PerlInterpreter* proto_perl +p |HE* |he_dup |HE* e|bool shared +p |REGEXP*|re_dup |REGEXP* r +p |PerlIO*|fp_dup |PerlIO* fp|char type +p |DIR* |dirp_dup |DIR* dp +p |GP* |gp_dup |GP* gp +p |MAGIC* |mg_dup |MAGIC* mg +p |SV* |sv_dup |SV* sstr +#if defined(HAVE_INTERP_INTERN) +p |void |sys_intern_dup |struct interp_intern* src \ + |struct interp_intern* dst +#endif +p |PTR_TBL_t*|ptr_table_new +p |void* |ptr_table_fetch|PTR_TBL_t *tbl|void *sv +p |void |ptr_table_store|PTR_TBL_t *tbl|void *oldsv|void *newsv +p |void |ptr_table_split|PTR_TBL_t *tbl +#endif #if defined(PERL_OBJECT) protected: +#else +END_EXTERN_C #endif + #if defined(PERL_IN_AV_C) || defined(PERL_DECL_PROT) s |I32 |avhv_index_sv |SV* sv #endif @@ -1829,6 +1935,7 @@ s |OP* |new_logop |I32 type|I32 flags|OP **firstp|OP **otherp s |void |simplify_sort |OP *o s |bool |is_handle_constructor |OP *o|I32 argnum s |char* |gv_ename |GV *gv +s |void |cv_dump |CV *cv s |CV* |cv_clone2 |CV *proto|CV *outside s |bool |scalar_mod_type|OP *o|I32 type s |OP * |my_kid |OP *o|OP *attrs @@ -1925,7 +2032,16 @@ s |char*|regwhite |char *|char * s |char*|nextchar s |regnode*|dumpuntil |regnode *start|regnode *node \ |regnode *last|SV* sv|I32 l +s |void |put_byte |SV* sv|int c s |void |scan_commit |struct scan_data_t *data +s |void |cl_anything |struct regnode_charclass_class *cl +s |int |cl_is_anything |struct regnode_charclass_class *cl +s |void |cl_init |struct regnode_charclass_class *cl +s |void |cl_init_zero |struct regnode_charclass_class *cl +s |void |cl_and |struct regnode_charclass_class *cl \ + |struct regnode_charclass_class *and_with +s |void |cl_or |struct regnode_charclass_class *cl \ + |struct regnode_charclass_class *or_with s |I32 |study_chunk |regnode **scanp|I32 *deltap \ |regnode *last|struct scan_data_t *data \ |U32 flags @@ -1940,7 +2056,7 @@ s |I32 |regmatch |regnode *prog s |I32 |regrepeat |regnode *p|I32 max s |I32 |regrepeat_hard |regnode *p|I32 max|I32 *lp s |I32 |regtry |regexp *prog|char *startpos -s |bool |reginclass |char *p|I32 c +s |bool |reginclass |regnode *p|I32 c s |bool |reginclassutf8 |regnode *f|U8* p s |CHECKPOINT|regcppush |I32 parenfloor s |char*|regcppop @@ -1948,6 +2064,7 @@ s |char*|regcp_set_to |I32 ss s |void |cache_re |regexp *prog s |U8* |reghop |U8 *pos|I32 off s |U8* |reghopmaybe |U8 *pos|I32 off +s |char* |find_byclass |regexp * prog|regnode *c|char *s|char *strend|char *startpos|I32 norun #endif #if defined(PERL_IN_RUN_C) || defined(PERL_DECL_PROT) @@ -2039,7 +2156,7 @@ s |void |force_ident |char *s|int kind s |void |incline |char *s s |int |intuit_method |char *s|GV *gv s |int |intuit_more |char *s -s |I32 |lop |I32 f|expectation x|char *s +s |I32 |lop |I32 f|int x|char *s s |void |missingterm |char *s s |void |no_op |char *what|char *s s |void |set_csh @@ -2047,8 +2164,8 @@ s |I32 |sublex_done s |I32 |sublex_push s |I32 |sublex_start s |char * |filter_gets |SV *sv|PerlIO *fp|STRLEN append -s |SV* |new_constant |char *s|STRLEN len|char *key|SV *sv \ - |SV *pv|char *type +s |SV* |new_constant |char *s|STRLEN len|const char *key|SV *sv \ + |SV *pv|const char *type s |int |ao |int toketype s |void |depcom s |char* |incl_perldb @@ -2057,8 +2174,8 @@ s |I32 |utf16rev_textfilter|int idx|SV *sv|int maxlen # if defined(CRIPPLED_CC) s |int |uni |I32 f|char *s # endif -# if defined(WIN32) -s |I32 |win32_textfilter |int idx|SV *sv|int maxlen +# if defined(PERL_CR_FILTER) +s |I32 |cr_textfilter |int idx|SV *sv|int maxlen # endif #endif @@ -2072,3 +2189,7 @@ s |SV* |mess_alloc s |void |xstat |int # endif #endif + +#if defined(PERL_OBJECT) +}; +#endif diff --git a/embedvar.h b/embedvar.h index fcaa0d4..837c030 100644 --- a/embedvar.h +++ b/embedvar.h @@ -184,21 +184,21 @@ #define PL_Env (PERL_GET_INTERP->IEnv) #define PL_LIO (PERL_GET_INTERP->ILIO) #define PL_Mem (PERL_GET_INTERP->IMem) +#define PL_MemParse (PERL_GET_INTERP->IMemParse) +#define PL_MemShared (PERL_GET_INTERP->IMemShared) #define PL_Proc (PERL_GET_INTERP->IProc) #define PL_Sock (PERL_GET_INTERP->ISock) #define PL_StdIO (PERL_GET_INTERP->IStdIO) #define PL_amagic_generation (PERL_GET_INTERP->Iamagic_generation) -#define PL_ampergv (PERL_GET_INTERP->Iampergv) #define PL_an (PERL_GET_INTERP->Ian) -#define PL_archpat_auto (PERL_GET_INTERP->Iarchpat_auto) #define PL_argvgv (PERL_GET_INTERP->Iargvgv) +#define PL_argvout_stack (PERL_GET_INTERP->Iargvout_stack) #define PL_argvoutgv (PERL_GET_INTERP->Iargvoutgv) #define PL_basetime (PERL_GET_INTERP->Ibasetime) #define PL_beginav (PERL_GET_INTERP->Ibeginav) #define PL_bitcount (PERL_GET_INTERP->Ibitcount) #define PL_bufend (PERL_GET_INTERP->Ibufend) #define PL_bufptr (PERL_GET_INTERP->Ibufptr) -#define PL_cddir (PERL_GET_INTERP->Icddir) #define PL_collation_ix (PERL_GET_INTERP->Icollation_ix) #define PL_collation_name (PERL_GET_INTERP->Icollation_name) #define PL_collation_standard (PERL_GET_INTERP->Icollation_standard) @@ -220,14 +220,10 @@ #define PL_curstname (PERL_GET_INTERP->Icurstname) #define PL_curthr (PERL_GET_INTERP->Icurthr) #define PL_dbargs (PERL_GET_INTERP->Idbargs) -#define PL_debdelim (PERL_GET_INTERP->Idebdelim) -#define PL_debname (PERL_GET_INTERP->Idebname) #define PL_debstash (PERL_GET_INTERP->Idebstash) #define PL_debug (PERL_GET_INTERP->Idebug) #define PL_defgv (PERL_GET_INTERP->Idefgv) #define PL_diehook (PERL_GET_INTERP->Idiehook) -#define PL_dlevel (PERL_GET_INTERP->Idlevel) -#define PL_dlmax (PERL_GET_INTERP->Idlmax) #define PL_doextract (PERL_GET_INTERP->Idoextract) #define PL_doswitches (PERL_GET_INTERP->Idoswitches) #define PL_dowarn (PERL_GET_INTERP->Idowarn) @@ -244,12 +240,12 @@ #define PL_eval_root (PERL_GET_INTERP->Ieval_root) #define PL_eval_start (PERL_GET_INTERP->Ieval_start) #define PL_evalseq (PERL_GET_INTERP->Ievalseq) +#define PL_exit_flags (PERL_GET_INTERP->Iexit_flags) #define PL_exitlist (PERL_GET_INTERP->Iexitlist) #define PL_exitlistlen (PERL_GET_INTERP->Iexitlistlen) #define PL_expect (PERL_GET_INTERP->Iexpect) #define PL_fdpid (PERL_GET_INTERP->Ifdpid) #define PL_filemode (PERL_GET_INTERP->Ifilemode) -#define PL_filter_debug (PERL_GET_INTERP->Ifilter_debug) #define PL_forkprocess (PERL_GET_INTERP->Iforkprocess) #define PL_formfeed (PERL_GET_INTERP->Iformfeed) #define PL_generation (PERL_GET_INTERP->Igeneration) @@ -276,11 +272,8 @@ #define PL_last_swash_tmps (PERL_GET_INTERP->Ilast_swash_tmps) #define PL_last_uni (PERL_GET_INTERP->Ilast_uni) #define PL_lastfd (PERL_GET_INTERP->Ilastfd) -#define PL_lastsize (PERL_GET_INTERP->Ilastsize) -#define PL_lastspbase (PERL_GET_INTERP->Ilastspbase) #define PL_laststatval (PERL_GET_INTERP->Ilaststatval) #define PL_laststype (PERL_GET_INTERP->Ilaststype) -#define PL_leftgv (PERL_GET_INTERP->Ileftgv) #define PL_lex_brackets (PERL_GET_INTERP->Ilex_brackets) #define PL_lex_brackstack (PERL_GET_INTERP->Ilex_brackstack) #define PL_lex_casemods (PERL_GET_INTERP->Ilex_casemods) @@ -288,7 +281,6 @@ #define PL_lex_defer (PERL_GET_INTERP->Ilex_defer) #define PL_lex_dojoin (PERL_GET_INTERP->Ilex_dojoin) #define PL_lex_expect (PERL_GET_INTERP->Ilex_expect) -#define PL_lex_fakebrack (PERL_GET_INTERP->Ilex_fakebrack) #define PL_lex_formbrack (PERL_GET_INTERP->Ilex_formbrack) #define PL_lex_inpat (PERL_GET_INTERP->Ilex_inpat) #define PL_lex_inwhat (PERL_GET_INTERP->Ilex_inwhat) @@ -304,7 +296,6 @@ #define PL_main_cv (PERL_GET_INTERP->Imain_cv) #define PL_main_root (PERL_GET_INTERP->Imain_root) #define PL_main_start (PERL_GET_INTERP->Imain_start) -#define PL_malloc_mutex (PERL_GET_INTERP->Imalloc_mutex) #define PL_max_intro_pending (PERL_GET_INTERP->Imax_intro_pending) #define PL_maxo (PERL_GET_INTERP->Imaxo) #define PL_maxsysfd (PERL_GET_INTERP->Imaxsysfd) @@ -322,7 +313,6 @@ #define PL_multi_open (PERL_GET_INTERP->Imulti_open) #define PL_multi_start (PERL_GET_INTERP->Imulti_start) #define PL_multiline (PERL_GET_INTERP->Imultiline) -#define PL_mystrk (PERL_GET_INTERP->Imystrk) #define PL_nexttoke (PERL_GET_INTERP->Inexttoke) #define PL_nexttype (PERL_GET_INTERP->Inexttype) #define PL_nextval (PERL_GET_INTERP->Inextval) @@ -337,7 +327,6 @@ #define PL_numeric_standard (PERL_GET_INTERP->Inumeric_standard) #define PL_ofmt (PERL_GET_INTERP->Iofmt) #define PL_oldbufptr (PERL_GET_INTERP->Ioldbufptr) -#define PL_oldlastpm (PERL_GET_INTERP->Ioldlastpm) #define PL_oldname (PERL_GET_INTERP->Ioldname) #define PL_oldoldbufptr (PERL_GET_INTERP->Ioldoldbufptr) #define PL_op_mask (PERL_GET_INTERP->Iop_mask) @@ -353,7 +342,6 @@ #define PL_pad_reset_pending (PERL_GET_INTERP->Ipad_reset_pending) #define PL_padix (PERL_GET_INTERP->Ipadix) #define PL_padix_floor (PERL_GET_INTERP->Ipadix_floor) -#define PL_parsehook (PERL_GET_INTERP->Iparsehook) #define PL_patchlevel (PERL_GET_INTERP->Ipatchlevel) #define PL_pending_ident (PERL_GET_INTERP->Ipending_ident) #define PL_perl_destruct_level (PERL_GET_INTERP->Iperl_destruct_level) @@ -363,23 +351,23 @@ #define PL_preambled (PERL_GET_INTERP->Ipreambled) #define PL_preprocess (PERL_GET_INTERP->Ipreprocess) #define PL_profiledata (PERL_GET_INTERP->Iprofiledata) +#define PL_psig_name (PERL_GET_INTERP->Ipsig_name) +#define PL_psig_ptr (PERL_GET_INTERP->Ipsig_ptr) +#define PL_ptr_table (PERL_GET_INTERP->Iptr_table) #define PL_replgv (PERL_GET_INTERP->Ireplgv) -#define PL_rightgv (PERL_GET_INTERP->Irightgv) #define PL_rsfp (PERL_GET_INTERP->Irsfp) #define PL_rsfp_filters (PERL_GET_INTERP->Irsfp_filters) #define PL_runops (PERL_GET_INTERP->Irunops) #define PL_sawampersand (PERL_GET_INTERP->Isawampersand) -#define PL_sawstudy (PERL_GET_INTERP->Isawstudy) -#define PL_sawvec (PERL_GET_INTERP->Isawvec) #define PL_sh_path (PERL_GET_INTERP->Ish_path) -#define PL_siggv (PERL_GET_INTERP->Isiggv) #define PL_sighandlerp (PERL_GET_INTERP->Isighandlerp) #define PL_splitstr (PERL_GET_INTERP->Isplitstr) #define PL_srand_called (PERL_GET_INTERP->Isrand_called) #define PL_statusvalue (PERL_GET_INTERP->Istatusvalue) #define PL_statusvalue_vms (PERL_GET_INTERP->Istatusvalue_vms) +#define PL_stderrgv (PERL_GET_INTERP->Istderrgv) #define PL_stdingv (PERL_GET_INTERP->Istdingv) -#define PL_strchop (PERL_GET_INTERP->Istrchop) +#define PL_stopav (PERL_GET_INTERP->Istopav) #define PL_strtab (PERL_GET_INTERP->Istrtab) #define PL_strtab_mutex (PERL_GET_INTERP->Istrtab_mutex) #define PL_sub_generation (PERL_GET_INTERP->Isub_generation) @@ -397,7 +385,6 @@ #define PL_svref_mutex (PERL_GET_INTERP->Isvref_mutex) #define PL_sys_intern (PERL_GET_INTERP->Isys_intern) #define PL_tainting (PERL_GET_INTERP->Itainting) -#define PL_thisexpr (PERL_GET_INTERP->Ithisexpr) #define PL_thr_key (PERL_GET_INTERP->Ithr_key) #define PL_threadnum (PERL_GET_INTERP->Ithreadnum) #define PL_threads_mutex (PERL_GET_INTERP->Ithreads_mutex) @@ -461,21 +448,21 @@ #define PL_Env (vTHX->IEnv) #define PL_LIO (vTHX->ILIO) #define PL_Mem (vTHX->IMem) +#define PL_MemParse (vTHX->IMemParse) +#define PL_MemShared (vTHX->IMemShared) #define PL_Proc (vTHX->IProc) #define PL_Sock (vTHX->ISock) #define PL_StdIO (vTHX->IStdIO) #define PL_amagic_generation (vTHX->Iamagic_generation) -#define PL_ampergv (vTHX->Iampergv) #define PL_an (vTHX->Ian) -#define PL_archpat_auto (vTHX->Iarchpat_auto) #define PL_argvgv (vTHX->Iargvgv) +#define PL_argvout_stack (vTHX->Iargvout_stack) #define PL_argvoutgv (vTHX->Iargvoutgv) #define PL_basetime (vTHX->Ibasetime) #define PL_beginav (vTHX->Ibeginav) #define PL_bitcount (vTHX->Ibitcount) #define PL_bufend (vTHX->Ibufend) #define PL_bufptr (vTHX->Ibufptr) -#define PL_cddir (vTHX->Icddir) #define PL_collation_ix (vTHX->Icollation_ix) #define PL_collation_name (vTHX->Icollation_name) #define PL_collation_standard (vTHX->Icollation_standard) @@ -497,14 +484,10 @@ #define PL_curstname (vTHX->Icurstname) #define PL_curthr (vTHX->Icurthr) #define PL_dbargs (vTHX->Idbargs) -#define PL_debdelim (vTHX->Idebdelim) -#define PL_debname (vTHX->Idebname) #define PL_debstash (vTHX->Idebstash) #define PL_debug (vTHX->Idebug) #define PL_defgv (vTHX->Idefgv) #define PL_diehook (vTHX->Idiehook) -#define PL_dlevel (vTHX->Idlevel) -#define PL_dlmax (vTHX->Idlmax) #define PL_doextract (vTHX->Idoextract) #define PL_doswitches (vTHX->Idoswitches) #define PL_dowarn (vTHX->Idowarn) @@ -521,12 +504,12 @@ #define PL_eval_root (vTHX->Ieval_root) #define PL_eval_start (vTHX->Ieval_start) #define PL_evalseq (vTHX->Ievalseq) +#define PL_exit_flags (vTHX->Iexit_flags) #define PL_exitlist (vTHX->Iexitlist) #define PL_exitlistlen (vTHX->Iexitlistlen) #define PL_expect (vTHX->Iexpect) #define PL_fdpid (vTHX->Ifdpid) #define PL_filemode (vTHX->Ifilemode) -#define PL_filter_debug (vTHX->Ifilter_debug) #define PL_forkprocess (vTHX->Iforkprocess) #define PL_formfeed (vTHX->Iformfeed) #define PL_generation (vTHX->Igeneration) @@ -553,11 +536,8 @@ #define PL_last_swash_tmps (vTHX->Ilast_swash_tmps) #define PL_last_uni (vTHX->Ilast_uni) #define PL_lastfd (vTHX->Ilastfd) -#define PL_lastsize (vTHX->Ilastsize) -#define PL_lastspbase (vTHX->Ilastspbase) #define PL_laststatval (vTHX->Ilaststatval) #define PL_laststype (vTHX->Ilaststype) -#define PL_leftgv (vTHX->Ileftgv) #define PL_lex_brackets (vTHX->Ilex_brackets) #define PL_lex_brackstack (vTHX->Ilex_brackstack) #define PL_lex_casemods (vTHX->Ilex_casemods) @@ -565,7 +545,6 @@ #define PL_lex_defer (vTHX->Ilex_defer) #define PL_lex_dojoin (vTHX->Ilex_dojoin) #define PL_lex_expect (vTHX->Ilex_expect) -#define PL_lex_fakebrack (vTHX->Ilex_fakebrack) #define PL_lex_formbrack (vTHX->Ilex_formbrack) #define PL_lex_inpat (vTHX->Ilex_inpat) #define PL_lex_inwhat (vTHX->Ilex_inwhat) @@ -581,7 +560,6 @@ #define PL_main_cv (vTHX->Imain_cv) #define PL_main_root (vTHX->Imain_root) #define PL_main_start (vTHX->Imain_start) -#define PL_malloc_mutex (vTHX->Imalloc_mutex) #define PL_max_intro_pending (vTHX->Imax_intro_pending) #define PL_maxo (vTHX->Imaxo) #define PL_maxsysfd (vTHX->Imaxsysfd) @@ -599,7 +577,6 @@ #define PL_multi_open (vTHX->Imulti_open) #define PL_multi_start (vTHX->Imulti_start) #define PL_multiline (vTHX->Imultiline) -#define PL_mystrk (vTHX->Imystrk) #define PL_nexttoke (vTHX->Inexttoke) #define PL_nexttype (vTHX->Inexttype) #define PL_nextval (vTHX->Inextval) @@ -614,7 +591,6 @@ #define PL_numeric_standard (vTHX->Inumeric_standard) #define PL_ofmt (vTHX->Iofmt) #define PL_oldbufptr (vTHX->Ioldbufptr) -#define PL_oldlastpm (vTHX->Ioldlastpm) #define PL_oldname (vTHX->Ioldname) #define PL_oldoldbufptr (vTHX->Ioldoldbufptr) #define PL_op_mask (vTHX->Iop_mask) @@ -630,7 +606,6 @@ #define PL_pad_reset_pending (vTHX->Ipad_reset_pending) #define PL_padix (vTHX->Ipadix) #define PL_padix_floor (vTHX->Ipadix_floor) -#define PL_parsehook (vTHX->Iparsehook) #define PL_patchlevel (vTHX->Ipatchlevel) #define PL_pending_ident (vTHX->Ipending_ident) #define PL_perl_destruct_level (vTHX->Iperl_destruct_level) @@ -640,23 +615,23 @@ #define PL_preambled (vTHX->Ipreambled) #define PL_preprocess (vTHX->Ipreprocess) #define PL_profiledata (vTHX->Iprofiledata) +#define PL_psig_name (vTHX->Ipsig_name) +#define PL_psig_ptr (vTHX->Ipsig_ptr) +#define PL_ptr_table (vTHX->Iptr_table) #define PL_replgv (vTHX->Ireplgv) -#define PL_rightgv (vTHX->Irightgv) #define PL_rsfp (vTHX->Irsfp) #define PL_rsfp_filters (vTHX->Irsfp_filters) #define PL_runops (vTHX->Irunops) #define PL_sawampersand (vTHX->Isawampersand) -#define PL_sawstudy (vTHX->Isawstudy) -#define PL_sawvec (vTHX->Isawvec) #define PL_sh_path (vTHX->Ish_path) -#define PL_siggv (vTHX->Isiggv) #define PL_sighandlerp (vTHX->Isighandlerp) #define PL_splitstr (vTHX->Isplitstr) #define PL_srand_called (vTHX->Isrand_called) #define PL_statusvalue (vTHX->Istatusvalue) #define PL_statusvalue_vms (vTHX->Istatusvalue_vms) +#define PL_stderrgv (vTHX->Istderrgv) #define PL_stdingv (vTHX->Istdingv) -#define PL_strchop (vTHX->Istrchop) +#define PL_stopav (vTHX->Istopav) #define PL_strtab (vTHX->Istrtab) #define PL_strtab_mutex (vTHX->Istrtab_mutex) #define PL_sub_generation (vTHX->Isub_generation) @@ -674,7 +649,6 @@ #define PL_svref_mutex (vTHX->Isvref_mutex) #define PL_sys_intern (vTHX->Isys_intern) #define PL_tainting (vTHX->Itainting) -#define PL_thisexpr (vTHX->Ithisexpr) #define PL_thr_key (vTHX->Ithr_key) #define PL_threadnum (vTHX->Ithreadnum) #define PL_threads_mutex (vTHX->Ithreads_mutex) @@ -725,7 +699,407 @@ # endif /* USE_THREADS */ #else /* !MULTIPLICITY */ -/* cases 1, 4 and 6 above */ + +# if defined(PERL_OBJECT) +/* case 6 above */ + +#define PL_Sv (aTHXo->interp.TSv) +#define PL_Xpv (aTHXo->interp.TXpv) +#define PL_av_fetch_sv (aTHXo->interp.Tav_fetch_sv) +#define PL_bodytarget (aTHXo->interp.Tbodytarget) +#define PL_bostr (aTHXo->interp.Tbostr) +#define PL_chopset (aTHXo->interp.Tchopset) +#define PL_colors (aTHXo->interp.Tcolors) +#define PL_colorset (aTHXo->interp.Tcolorset) +#define PL_curcop (aTHXo->interp.Tcurcop) +#define PL_curpad (aTHXo->interp.Tcurpad) +#define PL_curpm (aTHXo->interp.Tcurpm) +#define PL_curstack (aTHXo->interp.Tcurstack) +#define PL_curstackinfo (aTHXo->interp.Tcurstackinfo) +#define PL_curstash (aTHXo->interp.Tcurstash) +#define PL_defoutgv (aTHXo->interp.Tdefoutgv) +#define PL_defstash (aTHXo->interp.Tdefstash) +#define PL_delaymagic (aTHXo->interp.Tdelaymagic) +#define PL_dirty (aTHXo->interp.Tdirty) +#define PL_dumpindent (aTHXo->interp.Tdumpindent) +#define PL_efloatbuf (aTHXo->interp.Tefloatbuf) +#define PL_efloatsize (aTHXo->interp.Tefloatsize) +#define PL_errors (aTHXo->interp.Terrors) +#define PL_extralen (aTHXo->interp.Textralen) +#define PL_firstgv (aTHXo->interp.Tfirstgv) +#define PL_formtarget (aTHXo->interp.Tformtarget) +#define PL_hv_fetch_ent_mh (aTHXo->interp.Thv_fetch_ent_mh) +#define PL_hv_fetch_sv (aTHXo->interp.Thv_fetch_sv) +#define PL_in_eval (aTHXo->interp.Tin_eval) +#define PL_last_in_gv (aTHXo->interp.Tlast_in_gv) +#define PL_lastgotoprobe (aTHXo->interp.Tlastgotoprobe) +#define PL_lastscream (aTHXo->interp.Tlastscream) +#define PL_localizing (aTHXo->interp.Tlocalizing) +#define PL_mainstack (aTHXo->interp.Tmainstack) +#define PL_markstack (aTHXo->interp.Tmarkstack) +#define PL_markstack_max (aTHXo->interp.Tmarkstack_max) +#define PL_markstack_ptr (aTHXo->interp.Tmarkstack_ptr) +#define PL_maxscream (aTHXo->interp.Tmaxscream) +#define PL_modcount (aTHXo->interp.Tmodcount) +#define PL_na (aTHXo->interp.Tna) +#define PL_nrs (aTHXo->interp.Tnrs) +#define PL_ofs (aTHXo->interp.Tofs) +#define PL_ofslen (aTHXo->interp.Tofslen) +#define PL_op (aTHXo->interp.Top) +#define PL_opsave (aTHXo->interp.Topsave) +#define PL_protect (aTHXo->interp.Tprotect) +#define PL_reg_call_cc (aTHXo->interp.Treg_call_cc) +#define PL_reg_curpm (aTHXo->interp.Treg_curpm) +#define PL_reg_eval_set (aTHXo->interp.Treg_eval_set) +#define PL_reg_flags (aTHXo->interp.Treg_flags) +#define PL_reg_ganch (aTHXo->interp.Treg_ganch) +#define PL_reg_leftiter (aTHXo->interp.Treg_leftiter) +#define PL_reg_magic (aTHXo->interp.Treg_magic) +#define PL_reg_maxiter (aTHXo->interp.Treg_maxiter) +#define PL_reg_oldcurpm (aTHXo->interp.Treg_oldcurpm) +#define PL_reg_oldpos (aTHXo->interp.Treg_oldpos) +#define PL_reg_oldsaved (aTHXo->interp.Treg_oldsaved) +#define PL_reg_oldsavedlen (aTHXo->interp.Treg_oldsavedlen) +#define PL_reg_poscache (aTHXo->interp.Treg_poscache) +#define PL_reg_poscache_size (aTHXo->interp.Treg_poscache_size) +#define PL_reg_re (aTHXo->interp.Treg_re) +#define PL_reg_start_tmp (aTHXo->interp.Treg_start_tmp) +#define PL_reg_start_tmpl (aTHXo->interp.Treg_start_tmpl) +#define PL_reg_starttry (aTHXo->interp.Treg_starttry) +#define PL_reg_sv (aTHXo->interp.Treg_sv) +#define PL_reg_whilem_seen (aTHXo->interp.Treg_whilem_seen) +#define PL_regbol (aTHXo->interp.Tregbol) +#define PL_regcc (aTHXo->interp.Tregcc) +#define PL_regcode (aTHXo->interp.Tregcode) +#define PL_regcomp_parse (aTHXo->interp.Tregcomp_parse) +#define PL_regcomp_rx (aTHXo->interp.Tregcomp_rx) +#define PL_regcompp (aTHXo->interp.Tregcompp) +#define PL_regdata (aTHXo->interp.Tregdata) +#define PL_regdummy (aTHXo->interp.Tregdummy) +#define PL_regendp (aTHXo->interp.Tregendp) +#define PL_regeol (aTHXo->interp.Tregeol) +#define PL_regexecp (aTHXo->interp.Tregexecp) +#define PL_regflags (aTHXo->interp.Tregflags) +#define PL_regfree (aTHXo->interp.Tregfree) +#define PL_regindent (aTHXo->interp.Tregindent) +#define PL_reginput (aTHXo->interp.Treginput) +#define PL_regint_start (aTHXo->interp.Tregint_start) +#define PL_regint_string (aTHXo->interp.Tregint_string) +#define PL_reginterp_cnt (aTHXo->interp.Treginterp_cnt) +#define PL_reglastparen (aTHXo->interp.Treglastparen) +#define PL_regnarrate (aTHXo->interp.Tregnarrate) +#define PL_regnaughty (aTHXo->interp.Tregnaughty) +#define PL_regnpar (aTHXo->interp.Tregnpar) +#define PL_regprecomp (aTHXo->interp.Tregprecomp) +#define PL_regprev (aTHXo->interp.Tregprev) +#define PL_regprogram (aTHXo->interp.Tregprogram) +#define PL_regsawback (aTHXo->interp.Tregsawback) +#define PL_regseen (aTHXo->interp.Tregseen) +#define PL_regsize (aTHXo->interp.Tregsize) +#define PL_regstartp (aTHXo->interp.Tregstartp) +#define PL_regtill (aTHXo->interp.Tregtill) +#define PL_regxend (aTHXo->interp.Tregxend) +#define PL_restartop (aTHXo->interp.Trestartop) +#define PL_retstack (aTHXo->interp.Tretstack) +#define PL_retstack_ix (aTHXo->interp.Tretstack_ix) +#define PL_retstack_max (aTHXo->interp.Tretstack_max) +#define PL_rs (aTHXo->interp.Trs) +#define PL_savestack (aTHXo->interp.Tsavestack) +#define PL_savestack_ix (aTHXo->interp.Tsavestack_ix) +#define PL_savestack_max (aTHXo->interp.Tsavestack_max) +#define PL_scopestack (aTHXo->interp.Tscopestack) +#define PL_scopestack_ix (aTHXo->interp.Tscopestack_ix) +#define PL_scopestack_max (aTHXo->interp.Tscopestack_max) +#define PL_screamfirst (aTHXo->interp.Tscreamfirst) +#define PL_screamnext (aTHXo->interp.Tscreamnext) +#define PL_secondgv (aTHXo->interp.Tsecondgv) +#define PL_seen_evals (aTHXo->interp.Tseen_evals) +#define PL_seen_zerolen (aTHXo->interp.Tseen_zerolen) +#define PL_sortcop (aTHXo->interp.Tsortcop) +#define PL_sortcxix (aTHXo->interp.Tsortcxix) +#define PL_sortstash (aTHXo->interp.Tsortstash) +#define PL_stack_base (aTHXo->interp.Tstack_base) +#define PL_stack_max (aTHXo->interp.Tstack_max) +#define PL_stack_sp (aTHXo->interp.Tstack_sp) +#define PL_start_env (aTHXo->interp.Tstart_env) +#define PL_statbuf (aTHXo->interp.Tstatbuf) +#define PL_statcache (aTHXo->interp.Tstatcache) +#define PL_statgv (aTHXo->interp.Tstatgv) +#define PL_statname (aTHXo->interp.Tstatname) +#define PL_tainted (aTHXo->interp.Ttainted) +#define PL_timesbuf (aTHXo->interp.Ttimesbuf) +#define PL_tmps_floor (aTHXo->interp.Ttmps_floor) +#define PL_tmps_ix (aTHXo->interp.Ttmps_ix) +#define PL_tmps_max (aTHXo->interp.Ttmps_max) +#define PL_tmps_stack (aTHXo->interp.Ttmps_stack) +#define PL_top_env (aTHXo->interp.Ttop_env) +#define PL_toptarget (aTHXo->interp.Ttoptarget) +#define PL_watchaddr (aTHXo->interp.Twatchaddr) +#define PL_watchok (aTHXo->interp.Twatchok) +#define PL_Argv (aTHXo->interp.IArgv) +#define PL_Cmd (aTHXo->interp.ICmd) +#define PL_DBcv (aTHXo->interp.IDBcv) +#define PL_DBgv (aTHXo->interp.IDBgv) +#define PL_DBline (aTHXo->interp.IDBline) +#define PL_DBsignal (aTHXo->interp.IDBsignal) +#define PL_DBsingle (aTHXo->interp.IDBsingle) +#define PL_DBsub (aTHXo->interp.IDBsub) +#define PL_DBtrace (aTHXo->interp.IDBtrace) +#define PL_Dir (aTHXo->interp.IDir) +#define PL_Env (aTHXo->interp.IEnv) +#define PL_LIO (aTHXo->interp.ILIO) +#define PL_Mem (aTHXo->interp.IMem) +#define PL_MemParse (aTHXo->interp.IMemParse) +#define PL_MemShared (aTHXo->interp.IMemShared) +#define PL_Proc (aTHXo->interp.IProc) +#define PL_Sock (aTHXo->interp.ISock) +#define PL_StdIO (aTHXo->interp.IStdIO) +#define PL_amagic_generation (aTHXo->interp.Iamagic_generation) +#define PL_an (aTHXo->interp.Ian) +#define PL_argvgv (aTHXo->interp.Iargvgv) +#define PL_argvout_stack (aTHXo->interp.Iargvout_stack) +#define PL_argvoutgv (aTHXo->interp.Iargvoutgv) +#define PL_basetime (aTHXo->interp.Ibasetime) +#define PL_beginav (aTHXo->interp.Ibeginav) +#define PL_bitcount (aTHXo->interp.Ibitcount) +#define PL_bufend (aTHXo->interp.Ibufend) +#define PL_bufptr (aTHXo->interp.Ibufptr) +#define PL_collation_ix (aTHXo->interp.Icollation_ix) +#define PL_collation_name (aTHXo->interp.Icollation_name) +#define PL_collation_standard (aTHXo->interp.Icollation_standard) +#define PL_collxfrm_base (aTHXo->interp.Icollxfrm_base) +#define PL_collxfrm_mult (aTHXo->interp.Icollxfrm_mult) +#define PL_compcv (aTHXo->interp.Icompcv) +#define PL_compiling (aTHXo->interp.Icompiling) +#define PL_comppad (aTHXo->interp.Icomppad) +#define PL_comppad_name (aTHXo->interp.Icomppad_name) +#define PL_comppad_name_fill (aTHXo->interp.Icomppad_name_fill) +#define PL_comppad_name_floor (aTHXo->interp.Icomppad_name_floor) +#define PL_cop_seqmax (aTHXo->interp.Icop_seqmax) +#define PL_copline (aTHXo->interp.Icopline) +#define PL_cred_mutex (aTHXo->interp.Icred_mutex) +#define PL_cryptseen (aTHXo->interp.Icryptseen) +#define PL_cshlen (aTHXo->interp.Icshlen) +#define PL_cshname (aTHXo->interp.Icshname) +#define PL_curcopdb (aTHXo->interp.Icurcopdb) +#define PL_curstname (aTHXo->interp.Icurstname) +#define PL_curthr (aTHXo->interp.Icurthr) +#define PL_dbargs (aTHXo->interp.Idbargs) +#define PL_debstash (aTHXo->interp.Idebstash) +#define PL_debug (aTHXo->interp.Idebug) +#define PL_defgv (aTHXo->interp.Idefgv) +#define PL_diehook (aTHXo->interp.Idiehook) +#define PL_doextract (aTHXo->interp.Idoextract) +#define PL_doswitches (aTHXo->interp.Idoswitches) +#define PL_dowarn (aTHXo->interp.Idowarn) +#define PL_e_script (aTHXo->interp.Ie_script) +#define PL_egid (aTHXo->interp.Iegid) +#define PL_endav (aTHXo->interp.Iendav) +#define PL_envgv (aTHXo->interp.Ienvgv) +#define PL_errgv (aTHXo->interp.Ierrgv) +#define PL_error_count (aTHXo->interp.Ierror_count) +#define PL_euid (aTHXo->interp.Ieuid) +#define PL_eval_cond (aTHXo->interp.Ieval_cond) +#define PL_eval_mutex (aTHXo->interp.Ieval_mutex) +#define PL_eval_owner (aTHXo->interp.Ieval_owner) +#define PL_eval_root (aTHXo->interp.Ieval_root) +#define PL_eval_start (aTHXo->interp.Ieval_start) +#define PL_evalseq (aTHXo->interp.Ievalseq) +#define PL_exit_flags (aTHXo->interp.Iexit_flags) +#define PL_exitlist (aTHXo->interp.Iexitlist) +#define PL_exitlistlen (aTHXo->interp.Iexitlistlen) +#define PL_expect (aTHXo->interp.Iexpect) +#define PL_fdpid (aTHXo->interp.Ifdpid) +#define PL_filemode (aTHXo->interp.Ifilemode) +#define PL_forkprocess (aTHXo->interp.Iforkprocess) +#define PL_formfeed (aTHXo->interp.Iformfeed) +#define PL_generation (aTHXo->interp.Igeneration) +#define PL_gensym (aTHXo->interp.Igensym) +#define PL_gid (aTHXo->interp.Igid) +#define PL_glob_index (aTHXo->interp.Iglob_index) +#define PL_globalstash (aTHXo->interp.Iglobalstash) +#define PL_he_root (aTHXo->interp.Ihe_root) +#define PL_hintgv (aTHXo->interp.Ihintgv) +#define PL_hints (aTHXo->interp.Ihints) +#define PL_in_clean_all (aTHXo->interp.Iin_clean_all) +#define PL_in_clean_objs (aTHXo->interp.Iin_clean_objs) +#define PL_in_my (aTHXo->interp.Iin_my) +#define PL_in_my_stash (aTHXo->interp.Iin_my_stash) +#define PL_incgv (aTHXo->interp.Iincgv) +#define PL_initav (aTHXo->interp.Iinitav) +#define PL_inplace (aTHXo->interp.Iinplace) +#define PL_last_lop (aTHXo->interp.Ilast_lop) +#define PL_last_lop_op (aTHXo->interp.Ilast_lop_op) +#define PL_last_swash_hv (aTHXo->interp.Ilast_swash_hv) +#define PL_last_swash_key (aTHXo->interp.Ilast_swash_key) +#define PL_last_swash_klen (aTHXo->interp.Ilast_swash_klen) +#define PL_last_swash_slen (aTHXo->interp.Ilast_swash_slen) +#define PL_last_swash_tmps (aTHXo->interp.Ilast_swash_tmps) +#define PL_last_uni (aTHXo->interp.Ilast_uni) +#define PL_lastfd (aTHXo->interp.Ilastfd) +#define PL_laststatval (aTHXo->interp.Ilaststatval) +#define PL_laststype (aTHXo->interp.Ilaststype) +#define PL_lex_brackets (aTHXo->interp.Ilex_brackets) +#define PL_lex_brackstack (aTHXo->interp.Ilex_brackstack) +#define PL_lex_casemods (aTHXo->interp.Ilex_casemods) +#define PL_lex_casestack (aTHXo->interp.Ilex_casestack) +#define PL_lex_defer (aTHXo->interp.Ilex_defer) +#define PL_lex_dojoin (aTHXo->interp.Ilex_dojoin) +#define PL_lex_expect (aTHXo->interp.Ilex_expect) +#define PL_lex_formbrack (aTHXo->interp.Ilex_formbrack) +#define PL_lex_inpat (aTHXo->interp.Ilex_inpat) +#define PL_lex_inwhat (aTHXo->interp.Ilex_inwhat) +#define PL_lex_op (aTHXo->interp.Ilex_op) +#define PL_lex_repl (aTHXo->interp.Ilex_repl) +#define PL_lex_starts (aTHXo->interp.Ilex_starts) +#define PL_lex_state (aTHXo->interp.Ilex_state) +#define PL_lex_stuff (aTHXo->interp.Ilex_stuff) +#define PL_lineary (aTHXo->interp.Ilineary) +#define PL_linestart (aTHXo->interp.Ilinestart) +#define PL_linestr (aTHXo->interp.Ilinestr) +#define PL_localpatches (aTHXo->interp.Ilocalpatches) +#define PL_main_cv (aTHXo->interp.Imain_cv) +#define PL_main_root (aTHXo->interp.Imain_root) +#define PL_main_start (aTHXo->interp.Imain_start) +#define PL_max_intro_pending (aTHXo->interp.Imax_intro_pending) +#define PL_maxo (aTHXo->interp.Imaxo) +#define PL_maxsysfd (aTHXo->interp.Imaxsysfd) +#define PL_mess_sv (aTHXo->interp.Imess_sv) +#define PL_min_intro_pending (aTHXo->interp.Imin_intro_pending) +#define PL_minus_F (aTHXo->interp.Iminus_F) +#define PL_minus_a (aTHXo->interp.Iminus_a) +#define PL_minus_c (aTHXo->interp.Iminus_c) +#define PL_minus_l (aTHXo->interp.Iminus_l) +#define PL_minus_n (aTHXo->interp.Iminus_n) +#define PL_minus_p (aTHXo->interp.Iminus_p) +#define PL_modglobal (aTHXo->interp.Imodglobal) +#define PL_multi_close (aTHXo->interp.Imulti_close) +#define PL_multi_end (aTHXo->interp.Imulti_end) +#define PL_multi_open (aTHXo->interp.Imulti_open) +#define PL_multi_start (aTHXo->interp.Imulti_start) +#define PL_multiline (aTHXo->interp.Imultiline) +#define PL_nexttoke (aTHXo->interp.Inexttoke) +#define PL_nexttype (aTHXo->interp.Inexttype) +#define PL_nextval (aTHXo->interp.Inextval) +#define PL_nice_chunk (aTHXo->interp.Inice_chunk) +#define PL_nice_chunk_size (aTHXo->interp.Inice_chunk_size) +#define PL_nomemok (aTHXo->interp.Inomemok) +#define PL_nthreads (aTHXo->interp.Inthreads) +#define PL_nthreads_cond (aTHXo->interp.Inthreads_cond) +#define PL_numeric_local (aTHXo->interp.Inumeric_local) +#define PL_numeric_name (aTHXo->interp.Inumeric_name) +#define PL_numeric_radix (aTHXo->interp.Inumeric_radix) +#define PL_numeric_standard (aTHXo->interp.Inumeric_standard) +#define PL_ofmt (aTHXo->interp.Iofmt) +#define PL_oldbufptr (aTHXo->interp.Ioldbufptr) +#define PL_oldname (aTHXo->interp.Ioldname) +#define PL_oldoldbufptr (aTHXo->interp.Ioldoldbufptr) +#define PL_op_mask (aTHXo->interp.Iop_mask) +#define PL_op_seqmax (aTHXo->interp.Iop_seqmax) +#define PL_origalen (aTHXo->interp.Iorigalen) +#define PL_origargc (aTHXo->interp.Iorigargc) +#define PL_origargv (aTHXo->interp.Iorigargv) +#define PL_origenviron (aTHXo->interp.Iorigenviron) +#define PL_origfilename (aTHXo->interp.Iorigfilename) +#define PL_ors (aTHXo->interp.Iors) +#define PL_orslen (aTHXo->interp.Iorslen) +#define PL_osname (aTHXo->interp.Iosname) +#define PL_pad_reset_pending (aTHXo->interp.Ipad_reset_pending) +#define PL_padix (aTHXo->interp.Ipadix) +#define PL_padix_floor (aTHXo->interp.Ipadix_floor) +#define PL_patchlevel (aTHXo->interp.Ipatchlevel) +#define PL_pending_ident (aTHXo->interp.Ipending_ident) +#define PL_perl_destruct_level (aTHXo->interp.Iperl_destruct_level) +#define PL_perldb (aTHXo->interp.Iperldb) +#define PL_pidstatus (aTHXo->interp.Ipidstatus) +#define PL_preambleav (aTHXo->interp.Ipreambleav) +#define PL_preambled (aTHXo->interp.Ipreambled) +#define PL_preprocess (aTHXo->interp.Ipreprocess) +#define PL_profiledata (aTHXo->interp.Iprofiledata) +#define PL_psig_name (aTHXo->interp.Ipsig_name) +#define PL_psig_ptr (aTHXo->interp.Ipsig_ptr) +#define PL_ptr_table (aTHXo->interp.Iptr_table) +#define PL_replgv (aTHXo->interp.Ireplgv) +#define PL_rsfp (aTHXo->interp.Irsfp) +#define PL_rsfp_filters (aTHXo->interp.Irsfp_filters) +#define PL_runops (aTHXo->interp.Irunops) +#define PL_sawampersand (aTHXo->interp.Isawampersand) +#define PL_sh_path (aTHXo->interp.Ish_path) +#define PL_sighandlerp (aTHXo->interp.Isighandlerp) +#define PL_splitstr (aTHXo->interp.Isplitstr) +#define PL_srand_called (aTHXo->interp.Isrand_called) +#define PL_statusvalue (aTHXo->interp.Istatusvalue) +#define PL_statusvalue_vms (aTHXo->interp.Istatusvalue_vms) +#define PL_stderrgv (aTHXo->interp.Istderrgv) +#define PL_stdingv (aTHXo->interp.Istdingv) +#define PL_stopav (aTHXo->interp.Istopav) +#define PL_strtab (aTHXo->interp.Istrtab) +#define PL_strtab_mutex (aTHXo->interp.Istrtab_mutex) +#define PL_sub_generation (aTHXo->interp.Isub_generation) +#define PL_sublex_info (aTHXo->interp.Isublex_info) +#define PL_subline (aTHXo->interp.Isubline) +#define PL_subname (aTHXo->interp.Isubname) +#define PL_sv_arenaroot (aTHXo->interp.Isv_arenaroot) +#define PL_sv_count (aTHXo->interp.Isv_count) +#define PL_sv_mutex (aTHXo->interp.Isv_mutex) +#define PL_sv_no (aTHXo->interp.Isv_no) +#define PL_sv_objcount (aTHXo->interp.Isv_objcount) +#define PL_sv_root (aTHXo->interp.Isv_root) +#define PL_sv_undef (aTHXo->interp.Isv_undef) +#define PL_sv_yes (aTHXo->interp.Isv_yes) +#define PL_svref_mutex (aTHXo->interp.Isvref_mutex) +#define PL_sys_intern (aTHXo->interp.Isys_intern) +#define PL_tainting (aTHXo->interp.Itainting) +#define PL_thr_key (aTHXo->interp.Ithr_key) +#define PL_threadnum (aTHXo->interp.Ithreadnum) +#define PL_threads_mutex (aTHXo->interp.Ithreads_mutex) +#define PL_threadsv_names (aTHXo->interp.Ithreadsv_names) +#define PL_thrsv (aTHXo->interp.Ithrsv) +#define PL_tokenbuf (aTHXo->interp.Itokenbuf) +#define PL_uid (aTHXo->interp.Iuid) +#define PL_unsafe (aTHXo->interp.Iunsafe) +#define PL_utf8_alnum (aTHXo->interp.Iutf8_alnum) +#define PL_utf8_alnumc (aTHXo->interp.Iutf8_alnumc) +#define PL_utf8_alpha (aTHXo->interp.Iutf8_alpha) +#define PL_utf8_ascii (aTHXo->interp.Iutf8_ascii) +#define PL_utf8_cntrl (aTHXo->interp.Iutf8_cntrl) +#define PL_utf8_digit (aTHXo->interp.Iutf8_digit) +#define PL_utf8_graph (aTHXo->interp.Iutf8_graph) +#define PL_utf8_lower (aTHXo->interp.Iutf8_lower) +#define PL_utf8_mark (aTHXo->interp.Iutf8_mark) +#define PL_utf8_print (aTHXo->interp.Iutf8_print) +#define PL_utf8_punct (aTHXo->interp.Iutf8_punct) +#define PL_utf8_space (aTHXo->interp.Iutf8_space) +#define PL_utf8_tolower (aTHXo->interp.Iutf8_tolower) +#define PL_utf8_totitle (aTHXo->interp.Iutf8_totitle) +#define PL_utf8_toupper (aTHXo->interp.Iutf8_toupper) +#define PL_utf8_upper (aTHXo->interp.Iutf8_upper) +#define PL_utf8_xdigit (aTHXo->interp.Iutf8_xdigit) +#define PL_uudmap (aTHXo->interp.Iuudmap) +#define PL_warnhook (aTHXo->interp.Iwarnhook) +#define PL_xiv_arenaroot (aTHXo->interp.Ixiv_arenaroot) +#define PL_xiv_root (aTHXo->interp.Ixiv_root) +#define PL_xnv_root (aTHXo->interp.Ixnv_root) +#define PL_xpv_root (aTHXo->interp.Ixpv_root) +#define PL_xpvav_root (aTHXo->interp.Ixpvav_root) +#define PL_xpvbm_root (aTHXo->interp.Ixpvbm_root) +#define PL_xpvcv_root (aTHXo->interp.Ixpvcv_root) +#define PL_xpvhv_root (aTHXo->interp.Ixpvhv_root) +#define PL_xpviv_root (aTHXo->interp.Ixpviv_root) +#define PL_xpvlv_root (aTHXo->interp.Ixpvlv_root) +#define PL_xpvmg_root (aTHXo->interp.Ixpvmg_root) +#define PL_xpvnv_root (aTHXo->interp.Ixpvnv_root) +#define PL_xrv_root (aTHXo->interp.Ixrv_root) +#define PL_yychar (aTHXo->interp.Iyychar) +#define PL_yydebug (aTHXo->interp.Iyydebug) +#define PL_yyerrflag (aTHXo->interp.Iyyerrflag) +#define PL_yylval (aTHXo->interp.Iyylval) +#define PL_yynerrs (aTHXo->interp.Iyynerrs) +#define PL_yyval (aTHXo->interp.Iyyval) + +# else /* !PERL_OBJECT */ + +/* cases 1 and 4 above */ #define PL_IArgv PL_Argv #define PL_ICmd PL_Cmd @@ -740,21 +1114,21 @@ #define PL_IEnv PL_Env #define PL_ILIO PL_LIO #define PL_IMem PL_Mem +#define PL_IMemParse PL_MemParse +#define PL_IMemShared PL_MemShared #define PL_IProc PL_Proc #define PL_ISock PL_Sock #define PL_IStdIO PL_StdIO #define PL_Iamagic_generation PL_amagic_generation -#define PL_Iampergv PL_ampergv #define PL_Ian PL_an -#define PL_Iarchpat_auto PL_archpat_auto #define PL_Iargvgv PL_argvgv +#define PL_Iargvout_stack PL_argvout_stack #define PL_Iargvoutgv PL_argvoutgv #define PL_Ibasetime PL_basetime #define PL_Ibeginav PL_beginav #define PL_Ibitcount PL_bitcount #define PL_Ibufend PL_bufend #define PL_Ibufptr PL_bufptr -#define PL_Icddir PL_cddir #define PL_Icollation_ix PL_collation_ix #define PL_Icollation_name PL_collation_name #define PL_Icollation_standard PL_collation_standard @@ -776,14 +1150,10 @@ #define PL_Icurstname PL_curstname #define PL_Icurthr PL_curthr #define PL_Idbargs PL_dbargs -#define PL_Idebdelim PL_debdelim -#define PL_Idebname PL_debname #define PL_Idebstash PL_debstash #define PL_Idebug PL_debug #define PL_Idefgv PL_defgv #define PL_Idiehook PL_diehook -#define PL_Idlevel PL_dlevel -#define PL_Idlmax PL_dlmax #define PL_Idoextract PL_doextract #define PL_Idoswitches PL_doswitches #define PL_Idowarn PL_dowarn @@ -800,12 +1170,12 @@ #define PL_Ieval_root PL_eval_root #define PL_Ieval_start PL_eval_start #define PL_Ievalseq PL_evalseq +#define PL_Iexit_flags PL_exit_flags #define PL_Iexitlist PL_exitlist #define PL_Iexitlistlen PL_exitlistlen #define PL_Iexpect PL_expect #define PL_Ifdpid PL_fdpid #define PL_Ifilemode PL_filemode -#define PL_Ifilter_debug PL_filter_debug #define PL_Iforkprocess PL_forkprocess #define PL_Iformfeed PL_formfeed #define PL_Igeneration PL_generation @@ -832,11 +1202,8 @@ #define PL_Ilast_swash_tmps PL_last_swash_tmps #define PL_Ilast_uni PL_last_uni #define PL_Ilastfd PL_lastfd -#define PL_Ilastsize PL_lastsize -#define PL_Ilastspbase PL_lastspbase #define PL_Ilaststatval PL_laststatval #define PL_Ilaststype PL_laststype -#define PL_Ileftgv PL_leftgv #define PL_Ilex_brackets PL_lex_brackets #define PL_Ilex_brackstack PL_lex_brackstack #define PL_Ilex_casemods PL_lex_casemods @@ -844,7 +1211,6 @@ #define PL_Ilex_defer PL_lex_defer #define PL_Ilex_dojoin PL_lex_dojoin #define PL_Ilex_expect PL_lex_expect -#define PL_Ilex_fakebrack PL_lex_fakebrack #define PL_Ilex_formbrack PL_lex_formbrack #define PL_Ilex_inpat PL_lex_inpat #define PL_Ilex_inwhat PL_lex_inwhat @@ -860,7 +1226,6 @@ #define PL_Imain_cv PL_main_cv #define PL_Imain_root PL_main_root #define PL_Imain_start PL_main_start -#define PL_Imalloc_mutex PL_malloc_mutex #define PL_Imax_intro_pending PL_max_intro_pending #define PL_Imaxo PL_maxo #define PL_Imaxsysfd PL_maxsysfd @@ -878,7 +1243,6 @@ #define PL_Imulti_open PL_multi_open #define PL_Imulti_start PL_multi_start #define PL_Imultiline PL_multiline -#define PL_Imystrk PL_mystrk #define PL_Inexttoke PL_nexttoke #define PL_Inexttype PL_nexttype #define PL_Inextval PL_nextval @@ -893,7 +1257,6 @@ #define PL_Inumeric_standard PL_numeric_standard #define PL_Iofmt PL_ofmt #define PL_Ioldbufptr PL_oldbufptr -#define PL_Ioldlastpm PL_oldlastpm #define PL_Ioldname PL_oldname #define PL_Ioldoldbufptr PL_oldoldbufptr #define PL_Iop_mask PL_op_mask @@ -909,7 +1272,6 @@ #define PL_Ipad_reset_pending PL_pad_reset_pending #define PL_Ipadix PL_padix #define PL_Ipadix_floor PL_padix_floor -#define PL_Iparsehook PL_parsehook #define PL_Ipatchlevel PL_patchlevel #define PL_Ipending_ident PL_pending_ident #define PL_Iperl_destruct_level PL_perl_destruct_level @@ -919,23 +1281,23 @@ #define PL_Ipreambled PL_preambled #define PL_Ipreprocess PL_preprocess #define PL_Iprofiledata PL_profiledata +#define PL_Ipsig_name PL_psig_name +#define PL_Ipsig_ptr PL_psig_ptr +#define PL_Iptr_table PL_ptr_table #define PL_Ireplgv PL_replgv -#define PL_Irightgv PL_rightgv #define PL_Irsfp PL_rsfp #define PL_Irsfp_filters PL_rsfp_filters #define PL_Irunops PL_runops #define PL_Isawampersand PL_sawampersand -#define PL_Isawstudy PL_sawstudy -#define PL_Isawvec PL_sawvec #define PL_Ish_path PL_sh_path -#define PL_Isiggv PL_siggv #define PL_Isighandlerp PL_sighandlerp #define PL_Isplitstr PL_splitstr #define PL_Isrand_called PL_srand_called #define PL_Istatusvalue PL_statusvalue #define PL_Istatusvalue_vms PL_statusvalue_vms +#define PL_Istderrgv PL_stderrgv #define PL_Istdingv PL_stdingv -#define PL_Istrchop PL_strchop +#define PL_Istopav PL_stopav #define PL_Istrtab PL_strtab #define PL_Istrtab_mutex PL_strtab_mutex #define PL_Isub_generation PL_sub_generation @@ -953,7 +1315,6 @@ #define PL_Isvref_mutex PL_svref_mutex #define PL_Isys_intern PL_sys_intern #define PL_Itainting PL_tainting -#define PL_Ithisexpr PL_thisexpr #define PL_Ithr_key PL_thr_key #define PL_Ithreadnum PL_threadnum #define PL_Ithreads_mutex PL_threads_mutex @@ -1001,7 +1362,7 @@ #define PL_Iyynerrs PL_yynerrs #define PL_Iyyval PL_yyval -# if defined(USE_THREADS) +# if defined(USE_THREADS) /* case 4 above */ #define PL_Sv (aTHX->TSv) @@ -1138,8 +1499,8 @@ #define PL_watchaddr (aTHX->Twatchaddr) #define PL_watchok (aTHX->Twatchok) -# else /* !USE_THREADS */ -/* cases 1 and 6 above */ +# else /* !USE_THREADS */ +/* case 1 above */ #define PL_TSv PL_Sv #define PL_TXpv PL_Xpv @@ -1275,7 +1636,8 @@ #define PL_Twatchaddr PL_watchaddr #define PL_Twatchok PL_watchok -# endif /* USE_THREADS */ +# endif /* USE_THREADS */ +# endif /* PERL_OBJECT */ #endif /* MULTIPLICITY */ #if defined(PERL_GLOBAL_STRUCT) @@ -1285,6 +1647,7 @@ #define PL_curinterp (PL_Vars.Gcurinterp) #define PL_do_undump (PL_Vars.Gdo_undump) #define PL_hexdigit (PL_Vars.Ghexdigit) +#define PL_malloc_mutex (PL_Vars.Gmalloc_mutex) #define PL_patleave (PL_Vars.Gpatleave) #else /* !PERL_GLOBAL_STRUCT */ @@ -1294,6 +1657,7 @@ #define PL_Gcurinterp PL_curinterp #define PL_Gdo_undump PL_do_undump #define PL_Ghexdigit PL_hexdigit +#define PL_Gmalloc_mutex PL_malloc_mutex #define PL_Gpatleave PL_patleave #endif /* PERL_GLOBAL_STRUCT */ diff --git a/epoc/config.h b/epoc/config.h deleted file mode 100644 index 0ff42e2..0000000 --- a/epoc/config.h +++ /dev/null @@ -1,2556 +0,0 @@ -/* This file (config_H) is a sample config.h file. If you are unable - to successfully run Configure, copy this file to config.h and - edit it to suit your system. -*/ -/* - * This file was produced by running the config_h.SH script, which - * gets its values from config.sh, which is generally produced by - * running Configure. - * - * Feel free to modify any of this as the need arises. Note, however, - * that running config_h.SH again will wipe out any changes you've made. - * For a more permanent change edit config.sh and rerun config_h.SH. - * - * $Id: Config_h.U,v 3.0.1.5 1997/02/28 14:57:43 ram Exp $ - */ - -/* - * Package name : perl5 - * Source directory : . - * Configuration time: Sat May 22 00:43:12 EET DST 1999 - * Configured by : jhi - * Target system : osf1 alpha.hut.fi v4.0 878 alpha - */ - -#ifndef _config_h_ -#define _config_h_ - -#define EPOC 1 -#define PERL_CORE 1 - -/* LOC_SED: - * This symbol holds the complete pathname to the sed program. - */ -/* #define LOC_SED "/usr/bin/sed" /**/ - -/* BIN: - * This symbol holds the path of the bin directory where the package will - * be installed. Program must be prepared to deal with ~name substitution. - */ -/* BIN_EXP: - * This symbol is the filename expanded version of the BIN symbol, for - * programs that do not want to deal with that at run-time. - */ -#define BIN "/perl" /**/ -#define BIN_EXP "/perl" /**/ - -/* HAS_ALARM: - * This symbol, if defined, indicates that the alarm routine is - * available. - */ -/* #define HAS_ALARM /**/ - -/* HASATTRIBUTE: - * This symbol indicates the C compiler can check for function attributes, - * such as printf formats. This is normally only supported by GNU cc. - */ -#ifdef __MARM__ -#define HASATTRIBUTE / **/ -#endif -#ifndef HASATTRIBUTE -#define __attribute__(_arg_) -#endif - -/* HAS_BCMP: - * This symbol is defined if the bcmp() routine is available to - * compare blocks of memory. - */ -#define HAS_BCMP /**/ - -/* HAS_BCOPY: - * This symbol is defined if the bcopy() routine is available to - * copy blocks of memory. - */ -#define HAS_BCOPY /**/ - -/* HAS_BZERO: - * This symbol is defined if the bzero() routine is available to - * set a memory block to 0. - */ -#define HAS_BZERO /**/ - -/* HAS_CHOWN: - * This symbol, if defined, indicates that the chown routine is - * available. - */ -/*#define HAS_CHOWN /**/ - -/* HAS_CHROOT: - * This symbol, if defined, indicates that the chroot routine is - * available. - */ -/*#define HAS_CHROOT /**/ - -/* HAS_CHSIZE: - * This symbol, if defined, indicates that the chsize routine is available - * to truncate files. You might need a -lx to get this routine. - */ -/*#define HAS_CHSIZE / **/ - -/* HASCONST: - * This symbol, if defined, indicates that this C compiler knows about - * the const type. There is no need to actually test for that symbol - * within your programs. The mere use of the "const" keyword will - * trigger the necessary tests. - */ -#define HASCONST /**/ -#ifndef HASCONST -#define const -#endif - -/* HAS_CRYPT: - * This symbol, if defined, indicates that the crypt routine is available - * to encrypt passwords and the like. - */ -/*#define HAS_CRYPT /**/ - -/* HAS_CUSERID: - * This symbol, if defined, indicates that the cuserid routine is - * available to get character login names. - */ -/*#define HAS_CUSERID /**/ - -/* HAS_DBL_DIG: - * This symbol, if defined, indicates that this system's - * or defines the symbol DBL_DIG, which is the number - * of significant digits in a double precision number. If this - * symbol is not defined, a guess of 15 is usually pretty good. - */ -/*#define HAS_DBL_DIG /* */ - -/* HAS_DIFFTIME: - * This symbol, if defined, indicates that the difftime routine is - * available. - */ -#define HAS_DIFFTIME /**/ - -/* HAS_DLERROR: - * This symbol, if defined, indicates that the dlerror routine is - * available to return a string describing the last error that - * occurred from a call to dlopen(), dlclose() or dlsym(). - */ -/*#define HAS_DLERROR /**/ - -/* SETUID_SCRIPTS_ARE_SECURE_NOW: - * This symbol, if defined, indicates that the bug that prevents - * setuid scripts from being secure is not present in this kernel. - */ -/* DOSUID: - * This symbol, if defined, indicates that the C program should - * check the script that it is executing for setuid/setgid bits, and - * attempt to emulate setuid/setgid on systems that have disabled - * setuid #! scripts because the kernel can't do it securely. - * It is up to the package designer to make sure that this emulation - * is done securely. Among other things, it should do an fstat on - * the script it just opened to make sure it really is a setuid/setgid - * script, it should make sure the arguments passed correspond exactly - * to the argument on the #! line, and it should not trust any - * subprocesses to which it must pass the filename rather than the - * file descriptor of the script to be executed. - */ -/*#define SETUID_SCRIPTS_ARE_SECURE_NOW / **/ -/*#define DOSUID / **/ - -/* HAS_DUP2: - * This symbol, if defined, indicates that the dup2 routine is - * available to duplicate file descriptors. - */ -/*#define HAS_DUP2 /**/ - -/* HAS_FCHMOD: - * This symbol, if defined, indicates that the fchmod routine is available - * to change mode of opened files. If unavailable, use chmod(). - */ -/*#define HAS_FCHMOD /**/ - -/* HAS_FCHOWN: - * This symbol, if defined, indicates that the fchown routine is available - * to change ownership of opened files. If unavailable, use chown(). - */ -/*#define HAS_FCHOWN /**/ - -/* HAS_FCNTL: - * This symbol, if defined, indicates to the C program that - * the fcntl() function exists. - */ -/*#define HAS_FCNTL /**/ - -/* HAS_FGETPOS: - * This symbol, if defined, indicates that the fgetpos routine is - * available to get the file position indicator, similar to ftell(). - */ -#define HAS_FGETPOS /**/ - -/* FLEXFILENAMES: - * This symbol, if defined, indicates that the system supports filenames - * longer than 14 characters. - */ -#define FLEXFILENAMES /**/ - -/* HAS_FLOCK: - * This symbol, if defined, indicates that the flock routine is - * available to do file locking. - */ -/*#define HAS_FLOCK /**/ - -/* HAS_FORK: - * This symbol, if defined, indicates that the fork routine is - * available. - */ -/*#define HAS_FORK /**/ - -/* HAS_FSETPOS: - * This symbol, if defined, indicates that the fsetpos routine is - * available to set the file position indicator, similar to fseek(). - */ -#define HAS_FSETPOS /**/ - -/* HAS_GETTIMEOFDAY: - * This symbol, if defined, indicates that the gettimeofday() system - * call is available for a sub-second accuracy clock. Usually, the file - * needs to be included (see I_SYS_RESOURCE). - * The type "Timeval" should be used to refer to "struct timeval". - */ -#define HAS_GETTIMEOFDAY /**/ -#ifdef HAS_GETTIMEOFDAY -#define Timeval struct timeval /* Structure used by gettimeofday() */ -#endif - -/* HAS_GETGROUPS: - * This symbol, if defined, indicates that the getgroups() routine is - * available to get the list of process groups. If unavailable, multiple - * groups are probably not supported. - */ -/*#define HAS_GETGROUPS /**/ - -/* HAS_GETLOGIN: - * This symbol, if defined, indicates that the getlogin routine is - * available to get the login name. - */ -/*#define HAS_GETLOGIN /**/ - -/* HAS_GETPGID: - * This symbol, if defined, indicates to the C program that - * the getpgid(pid) function is available to get the - * process group id. - */ -/*#define HAS_GETPGID /**/ - -/* HAS_GETPGRP: - * This symbol, if defined, indicates that the getpgrp routine is - * available to get the current process group. - */ -/* USE_BSD_GETPGRP: - * This symbol, if defined, indicates that getpgrp needs one - * arguments whereas USG one needs none. - */ -/*#define HAS_GETPGRP /**/ -/*#define USE_BSD_GETPGRP / **/ - -/* HAS_GETPGRP2: - * This symbol, if defined, indicates that the getpgrp2() (as in DG/UX) - * routine is available to get the current process group. - */ -/*#define HAS_GETPGRP2 / **/ - -/* HAS_GETPPID: - * This symbol, if defined, indicates that the getppid routine is - * available to get the parent process ID. - */ -/*#define HAS_GETPPID /**/ - -/* HAS_GETPRIORITY: - * This symbol, if defined, indicates that the getpriority routine is - * available to get a process's priority. - */ -/*#define HAS_GETPRIORITY /**/ - -/* HAS_INET_ATON: - * This symbol, if defined, indicates to the C program that the - * inet_aton() function is available to parse IP address "dotted-quad" - * strings. - */ -/*#define HAS_INET_ATON /**/ - -/* HAS_KILLPG: - * This symbol, if defined, indicates that the killpg routine is available - * to kill process groups. If unavailable, you probably should use kill - * with a negative process number. - */ -/*#define HAS_KILLPG /**/ - -/* HAS_LINK: - * This symbol, if defined, indicates that the link routine is - * available to create hard links. - */ -/*#define HAS_LINK /**/ - -/* HAS_LOCALECONV: - * This symbol, if defined, indicates that the localeconv routine is - * available for numeric and monetary formatting conventions. - */ -/*#define HAS_LOCALECONV /**/ - -/* HAS_LOCKF: - * This symbol, if defined, indicates that the lockf routine is - * available to do file locking. - */ -/*#define HAS_LOCKF /**/ - -/* HAS_LSTAT: - * This symbol, if defined, indicates that the lstat routine is - * available to do file stats on symbolic links. - */ -/*#define HAS_LSTAT /**/ - -/* HAS_MBLEN: - * This symbol, if defined, indicates that the mblen routine is available - * to find the number of bytes in a multibye character. - */ -/*#define HAS_MBLEN /**/ - -/* HAS_MBSTOWCS: - * This symbol, if defined, indicates that the mbstowcs routine is - * available to covert a multibyte string into a wide character string. - */ -/*#define HAS_MBSTOWCS /**/ - -/* HAS_MBTOWC: - * This symbol, if defined, indicates that the mbtowc routine is available - * to covert a multibyte to a wide character. - */ -/*#define HAS_MBTOWC /**/ - -/* HAS_MEMCMP: - * This symbol, if defined, indicates that the memcmp routine is available - * to compare blocks of memory. - */ -#define HAS_MEMCMP /**/ - -/* HAS_MEMCPY: - * This symbol, if defined, indicates that the memcpy routine is available - * to copy blocks of memory. - */ -#define HAS_MEMCPY /**/ - -/* HAS_MEMMOVE: - * This symbol, if defined, indicates that the memmove routine is available - * to copy potentially overlapping blocks of memory. This should be used - * only when HAS_SAFE_BCOPY is not defined. If neither is there, roll your - * own version. - */ -#define HAS_MEMMOVE /**/ - -/* HAS_MEMSET: - * This symbol, if defined, indicates that the memset routine is available - * to set blocks of memory. - */ -#define HAS_MEMSET /**/ - -/* HAS_MKDIR: - * This symbol, if defined, indicates that the mkdir routine is available - * to create directories. Otherwise you should fork off a new process to - * exec /bin/mkdir. - */ -#define HAS_MKDIR /**/ - -/* HAS_MKFIFO: - * This symbol, if defined, indicates that the mkfifo routine is - * available to create FIFOs. Otherwise, mknod should be able to - * do it for you. However, if mkfifo is there, mknod might require - * super-user privileges which mkfifo will not. - */ -/*#define HAS_MKFIFO /**/ - -/* HAS_MKTIME: - * This symbol, if defined, indicates that the mktime routine is - * available. - */ -#define HAS_MKTIME /**/ - -/* HAS_MSYNC: - * This symbol, if defined, indicates that the msync system call is - * available to synchronize a mapped file. - */ -/*#define HAS_MSYNC /**/ - -/* HAS_MUNMAP: - * This symbol, if defined, indicates that the munmap system call is - * available to unmap a region, usually mapped by mmap(). - */ -/*#define HAS_MUNMAP /**/ - -/* HAS_NICE: - * This symbol, if defined, indicates that the nice routine is - * available. - */ -/*#define HAS_NICE /**/ - -/* HAS_PATHCONF: - * This symbol, if defined, indicates that pathconf() is available - * to determine file-system related limits and options associated - * with a given filename. - */ -/* HAS_FPATHCONF: - * This symbol, if defined, indicates that pathconf() is available - * to determine file-system related limits and options associated - * with a given open file descriptor. - */ -/*#define HAS_PATHCONF /**/ -/*#define HAS_FPATHCONF /**/ - -/* HAS_PAUSE: - * This symbol, if defined, indicates that the pause routine is - * available to suspend a process until a signal is received. - */ -/*#define HAS_PAUSE /**/ - -/* HAS_PIPE: - * This symbol, if defined, indicates that the pipe routine is - * available to create an inter-process channel. - */ -/*#define HAS_PIPE /**/ - -/* HAS_POLL: - * This symbol, if defined, indicates that the poll routine is - * available to poll active file descriptors. You may safely - * include when this symbol is defined. - */ -/*#define HAS_POLL /**/ - -/* HAS_READDIR: - * This symbol, if defined, indicates that the readdir routine is - * available to read directory entries. You may have to include - * . See I_DIRENT. - */ -#define HAS_READDIR /**/ - -/* HAS_SEEKDIR: - * This symbol, if defined, indicates that the seekdir routine is - * available. You may have to include . See I_DIRENT. - */ -#define HAS_SEEKDIR /**/ - -/* HAS_TELLDIR: - * This symbol, if defined, indicates that the telldir routine is - * available. You may have to include . See I_DIRENT. - */ -#define HAS_TELLDIR /**/ - -/* HAS_REWINDDIR: - * This symbol, if defined, indicates that the rewinddir routine is - * available. You may have to include . See I_DIRENT. - */ -#define HAS_REWINDDIR /**/ - -/* HAS_READLINK: - * This symbol, if defined, indicates that the readlink routine is - * available to read the value of a symbolic link. - */ -/*#define HAS_READLINK /**/ - -/* HAS_RENAME: - * This symbol, if defined, indicates that the rename routine is available - * to rename files. Otherwise you should do the unlink(), link(), unlink() - * trick. - */ -#define HAS_RENAME /**/ - -/* HAS_RMDIR: - * This symbol, if defined, indicates that the rmdir routine is - * available to remove directories. Otherwise you should fork off a - * new process to exec /bin/rmdir. - */ -#define HAS_RMDIR /**/ - -/* HAS_SELECT: - * This symbol, if defined, indicates that the select routine is - * available to select active file descriptors. If the timeout field - * is used, may need to be included. - */ -/*#define HAS_SELECT /**/ - -/* HAS_SETEGID: - * This symbol, if defined, indicates that the setegid routine is available - * to change the effective gid of the current program. - */ -/*#define HAS_SETEGID /**/ - -/* HAS_SETEUID: - * This symbol, if defined, indicates that the seteuid routine is available - * to change the effective uid of the current program. - */ -/*#define HAS_SETEUID /**/ - -/* HAS_SETLINEBUF: - * This symbol, if defined, indicates that the setlinebuf routine is - * available to change stderr or stdout from block-buffered or unbuffered - * to a line-buffered mode. - */ -/*#define HAS_SETLINEBUF /**/ - -/* HAS_SETLOCALE: - * This symbol, if defined, indicates that the setlocale routine is - * available to handle locale-specific ctype implementations. - */ -/*#define HAS_SETLOCALE /**/ - -/* HAS_SETPGID: - * This symbol, if defined, indicates that the setpgid(pid, gpid) - * routine is available to set process group ID. - */ -/*#define HAS_SETPGID /**/ - -/* HAS_SETPGRP: - * This symbol, if defined, indicates that the setpgrp routine is - * available to set the current process group. - */ -/* USE_BSD_SETPGRP: - * This symbol, if defined, indicates that setpgrp needs two - * arguments whereas USG one needs none. See also HAS_SETPGID - * for a POSIX interface. - */ -/*#define HAS_SETPGRP /**/ -/*#define USE_BSD_SETPGRP /**/ - -/* HAS_SETPGRP2: - * This symbol, if defined, indicates that the setpgrp2() (as in DG/UX) - * routine is available to set the current process group. - */ -/*#define HAS_SETPGRP2 / **/ - -/* HAS_SETPRIORITY: - * This symbol, if defined, indicates that the setpriority routine is - * available to set a process's priority. - */ -/*#define HAS_SETPRIORITY /**/ - -/* HAS_SETREGID: - * This symbol, if defined, indicates that the setregid routine is - * available to change the real and effective gid of the current - * process. - */ -/* HAS_SETRESGID: - * This symbol, if defined, indicates that the setresgid routine is - * available to change the real, effective and saved gid of the current - * process. - */ -/*#define HAS_SETREGID /**/ -/*#define HAS_SETRESGID / **/ - -/* HAS_SETREUID: - * This symbol, if defined, indicates that the setreuid routine is - * available to change the real and effective uid of the current - * process. - */ -/* HAS_SETRESUID: - * This symbol, if defined, indicates that the setresuid routine is - * available to change the real, effective and saved uid of the current - * process. - */ -/*#define HAS_SETREUID /**/ -/*#define HAS_SETRESUID / **/ - -/* HAS_SETRGID: - * This symbol, if defined, indicates that the setrgid routine is available - * to change the real gid of the current program. - */ -/*#define HAS_SETRGID /**/ - -/* HAS_SETRUID: - * This symbol, if defined, indicates that the setruid routine is available - * to change the real uid of the current program. - */ -/*#define HAS_SETRUID /**/ - -/* HAS_SETSID: - * This symbol, if defined, indicates that the setsid routine is - * available to set the process group ID. - */ -/*#define HAS_SETSID /**/ - -/* Shmat_t: - * This symbol holds the return type of the shmat() system call. - * Usually set to 'void *' or 'char *'. - */ -/* HAS_SHMAT_PROTOTYPE: - * This symbol, if defined, indicates that the sys/shm.h includes - * a prototype for shmat(). Otherwise, it is up to the program to - * guess one. Shmat_t shmat _((int, Shmat_t, int)) is a good guess, - * but not always right so it should be emitted by the program only - * when HAS_SHMAT_PROTOTYPE is not defined to avoid conflicting defs. - */ -/*#define Shmat_t void * /**/ -/*#define HAS_SHMAT_PROTOTYPE /**/ - -/* HAS_STRCHR: - * This symbol is defined to indicate that the strchr()/strrchr() - * functions are available for string searching. If not, try the - * index()/rindex() pair. - */ -/* HAS_INDEX: - * This symbol is defined to indicate that the index()/rindex() - * functions are available for string searching. - */ -#define HAS_STRCHR /**/ -/*#define HAS_INDEX / **/ - -/* HAS_STRCOLL: - * This symbol, if defined, indicates that the strcoll routine is - * available to compare strings using collating information. - */ -#define HAS_STRCOLL /**/ - -/* USE_STRUCT_COPY: - * This symbol, if defined, indicates that this C compiler knows how - * to copy structures. If undefined, you'll need to use a block copy - * routine of some sort instead. - */ -#define USE_STRUCT_COPY /**/ - -/* HAS_STRTOD: - * This symbol, if defined, indicates that the strtod routine is - * available to provide better numeric string conversion than atof(). - */ -#define HAS_STRTOD /**/ - -/* HAS_STRTOL: - * This symbol, if defined, indicates that the strtol routine is available - * to provide better numeric string conversion than atoi() and friends. - */ -#define HAS_STRTOL /**/ - -/* HAS_STRTOUL: - * This symbol, if defined, indicates that the strtoul routine is - * available to provide conversion of strings to unsigned long. - */ -#define HAS_STRTOUL /**/ - -/* HAS_STRXFRM: - * This symbol, if defined, indicates that the strxfrm() routine is - * available to transform strings. - */ -#define HAS_STRXFRM /**/ - -/* HAS_SYMLINK: - * This symbol, if defined, indicates that the symlink routine is available - * to create symbolic links. - */ -/*#define HAS_SYMLINK /**/ - -/* HAS_SYSCALL: - * This symbol, if defined, indicates that the syscall routine is - * available to call arbitrary system calls. If undefined, that's tough. - */ -/*#define HAS_SYSCALL /**/ - -/* HAS_SYSCONF: - * This symbol, if defined, indicates that sysconf() is available - * to determine system related limits and options. - */ -#define HAS_SYSCONF /**/ - -/* HAS_SYSTEM: - * This symbol, if defined, indicates that the system routine is - * available to issue a shell command. - */ -#define HAS_SYSTEM /**/ - -/* HAS_TCGETPGRP: - * This symbol, if defined, indicates that the tcgetpgrp routine is - * available to get foreground process group ID. - */ -/*#define HAS_TCGETPGRP /**/ - -/* HAS_TCSETPGRP: - * This symbol, if defined, indicates that the tcsetpgrp routine is - * available to set foreground process group ID. - */ -/*#define HAS_TCSETPGRP /**/ - -/* HAS_TRUNCATE: - * This symbol, if defined, indicates that the truncate routine is - * available to truncate files. - */ -/*#define HAS_TRUNCATE /**/ - -/* HAS_TZNAME: - * This symbol, if defined, indicates that the tzname[] array is - * available to access timezone names. - */ -/*#define HAS_TZNAME /**/ - -/* HAS_UMASK: - * This symbol, if defined, indicates that the umask routine is - * available to set and get the value of the file creation mask. - */ -/*#define HAS_UMASK /**/ - -/* HASVOLATILE: - * This symbol, if defined, indicates that this C compiler knows about - * the volatile declaration. - */ -#define HASVOLATILE /**/ -#ifndef HASVOLATILE -#define volatile -#endif - -/* HAS_WAIT4: - * This symbol, if defined, indicates that wait4() exists. - */ -/*#define HAS_WAIT4 /**/ - -/* HAS_WAITPID: - * This symbol, if defined, indicates that the waitpid routine is - * available to wait for child process. - */ -/*#define HAS_WAITPID /**/ - -/* HAS_WCSTOMBS: - * This symbol, if defined, indicates that the wcstombs routine is - * available to convert wide character strings to multibyte strings. - */ -/*#define HAS_WCSTOMBS /**/ - -/* HAS_WCTOMB: - * This symbol, if defined, indicates that the wctomb routine is available - * to covert a wide character to a multibyte. - */ -/*#define HAS_WCTOMB /**/ - -/* I_ARPA_INET: - * This symbol, if defined, indicates to the C program that it should - * include to get inet_addr and friends declarations. - */ -#define I_ARPA_INET /**/ - -/* I_DBM: - * This symbol, if defined, indicates that exists and should - * be included. - */ -/* I_RPCSVC_DBM: - * This symbol, if defined, indicates that exists and - * should be included. - */ -/*#define I_DBM /**/ -/*#define I_RPCSVC_DBM / **/ - -/* I_DIRENT: - * This symbol, if defined, indicates to the C program that it should - * include . Using this symbol also triggers the definition - * of the Direntry_t define which ends up being 'struct dirent' or - * 'struct direct' depending on the availability of . - */ -/* DIRNAMLEN: - * This symbol, if defined, indicates to the C program that the length - * of directory entry names is provided by a d_namlen field. Otherwise - * you need to do strlen() on the d_name field. - */ -/* Direntry_t: - * This symbol is set to 'struct direct' or 'struct dirent' depending on - * whether dirent is available or not. You should use this pseudo type to - * portably declare your directory entries. - */ -#define I_DIRENT /**/ -/*#define DIRNAMLEN /**/ -#define Direntry_t struct dirent - -/* I_DLFCN: - * This symbol, if defined, indicates that exists and should - * be included. - */ -/*#define I_DLFCN /**/ - -/* I_FCNTL: - * This manifest constant tells the C program to include . - */ -#define I_FCNTL / **/ - -/* I_FLOAT: - * This symbol, if defined, indicates to the C program that it should - * include to get definition of symbols like DBL_MAX or - * DBL_MIN, i.e. machine dependent floating point values. - */ -/*#define I_FLOAT /**/ - -/* I_LIMITS: - * This symbol, if defined, indicates to the C program that it should - * include to get definition of symbols like WORD_BIT or - * LONG_MAX, i.e. machine dependant limitations. - */ -#define I_LIMITS /**/ - -/* I_LOCALE: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -/*#define I_LOCALE /**/ - -/* I_MATH: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -#define I_MATH /**/ - -/* I_MEMORY: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -/*#define I_MEMORY / **/ - -/* I_NDBM: - * This symbol, if defined, indicates that exists and should - * be included. - */ -/*#define I_NDBM /**/ - -/* I_NET_ERRNO: - * This symbol, if defined, indicates that exists and - * should be included. - */ -/*#define I_NET_ERRNO / **/ - -/* I_NETINET_IN: - * This symbol, if defined, indicates to the C program that it should - * include . Otherwise, you may try . - */ -#define I_NETINET_IN /**/ - -/* I_SFIO: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -/*#define I_SFIO / **/ - -/* I_STDDEF: - * This symbol, if defined, indicates that exists and should - * be included. - */ -#define I_STDDEF /**/ - -/* I_STDLIB: - * This symbol, if defined, indicates that exists and should - * be included. - */ -#define I_STDLIB /**/ - -/* I_STRING: - * This symbol, if defined, indicates to the C program that it should - * include (USG systems) instead of (BSD systems). - */ -#define I_STRING /**/ - -/* I_SYS_DIR: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -/*#define I_SYS_DIR /**/ - -/* I_SYS_FILE: - * This symbol, if defined, indicates to the C program that it should - * include to get definition of R_OK and friends. - */ -/*#define I_SYS_FILE /**/ - -/* I_SYS_IOCTL: - * This symbol, if defined, indicates that exists and should - * be included. Otherwise, include or . - */ -#define I_SYS_IOCTL /**/ - -/* I_SYS_NDIR: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -/*#define I_SYS_NDIR / **/ - -/* I_SYS_PARAM: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -#define I_SYS_PARAM /**/ - -/* I_SYS_RESOURCE: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -#define I_SYS_RESOURCE /**/ - -/* I_SYS_SELECT: - * This symbol, if defined, indicates to the C program that it should - * include in order to get definition of struct timeval. - */ -/*#define I_SYS_SELECT /**/ - -/* I_SYS_STAT: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -#define I_SYS_STAT /**/ - -/* I_SYS_TIMES: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -#define I_SYS_TIMES /**/ - -/* I_SYS_TYPES: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -#define I_SYS_TYPES /**/ - -/* I_SYS_UN: - * This symbol, if defined, indicates to the C program that it should - * include to get UNIX domain socket definitions. - */ -/*#define I_SYS_UN /**/ - -/* I_SYS_WAIT: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -#define I_SYS_WAIT /**/ - -/* I_TERMIO: - * This symbol, if defined, indicates that the program should include - * rather than . There are also differences in - * the ioctl() calls that depend on the value of this symbol. - */ -/* I_TERMIOS: - * This symbol, if defined, indicates that the program should include - * the POSIX termios.h rather than sgtty.h or termio.h. - * There are also differences in the ioctl() calls that depend on the - * value of this symbol. - */ -/* I_SGTTY: - * This symbol, if defined, indicates that the program should include - * rather than . There are also differences in - * the ioctl() calls that depend on the value of this symbol. - */ -/*#define I_TERMIO / **/ -/*#define I_TERMIOS /**/ -/*#define I_SGTTY / **/ - -/* I_UNISTD: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -#define I_UNISTD /**/ - -/* I_UTIME: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -/*#define I_UTIME /**/ - -/* I_VALUES: - * This symbol, if defined, indicates to the C program that it should - * include to get definition of symbols like MINFLOAT or - * MAXLONG, i.e. machine dependant limitations. Probably, you - * should use instead, if it is available. - */ -/*#define I_VALUES /**/ - -/* I_STDARG: - * This symbol, if defined, indicates that exists and should - * be included. - */ -/* I_VARARGS: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -#define I_STDARG /**/ -/*#define I_VARARGS / **/ - -/* I_VFORK: - * This symbol, if defined, indicates to the C program that it should - * include vfork.h. - */ -/*#define I_VFORK / **/ - -/* CAN_PROTOTYPE: - * If defined, this macro indicates that the C compiler can handle - * function prototypes. - */ -/* _: - * This macro is used to declare function parameters for folks who want - * to make declarations with prototypes using a different style than - * the above macros. Use double parentheses. For example: - * - * int main _((int argc, char *argv[])); - */ -#define CAN_PROTOTYPE /**/ -#ifdef CAN_PROTOTYPE -#define _(args) args -#else -#define _(args) () -#endif - -/* SH_PATH: - * This symbol contains the full pathname to the shell used on this - * on this system to execute Bourne shell scripts. Usually, this will be - * /bin/sh, though it's possible that some systems will have /bin/ksh, - * /bin/pdksh, /bin/ash, /bin/bash, or even something such as - * D:/bin/sh.exe. - */ -#define SH_PATH "/bin/sh" /**/ - -/* STDCHAR: - * This symbol is defined to be the type of char used in stdio.h. - * It has the values "unsigned char" or "char". - */ -#define STDCHAR char /**/ - -/* HAS_ACCESSX: - * This symbol, if defined, indicates that the accessx routine is - * available to do extended access checks. - */ -/*#define HAS_ACCESSX / **/ - -/* HAS_EACCESS: - * This symbol, if defined, indicates that the eaccess routine is - * available to do extended access checks. - */ -/*#define HAS_EACCESS / **/ - -/* I_SYS_ACCESS: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -/*#define I_SYS_ACCESS /**/ - -/* I_SYS_SECURITY: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -/*#define I_SYS_SECURITY /**/ - -/* CROSSCOMPILE: - * This symbol, if defined, signifies that we our - * build process is a cross-compilation. - */ -#define CROSSCOMPILE / **/ - -/* INTSIZE: - * This symbol contains the value of sizeof(int) so that the C - * preprocessor can make decisions based on it. - */ -/* LONGSIZE: - * This symbol contains the value of sizeof(long) so that the C - * preprocessor can make decisions based on it. - */ -/* SHORTSIZE: - * This symbol contains the value of sizeof(short) so that the C - * preprocessor can make decisions based on it. - */ -#define INTSIZE 4 /**/ -#define LONGSIZE 4 /**/ -#define SHORTSIZE 2 /**/ - -/* MULTIARCH: - * This symbol, if defined, signifies that the build - * process will produce some binary files that are going to be - * used in a cross-platform environment. This is the case for - * example with the NeXT "fat" binaries that contain executables - * for several CPUs. - */ -#define MULTIARCH / **/ - -/* MEM_ALIGNBYTES: - * This symbol contains the number of bytes required to align a - * double. Usual values are 2, 4 and 8. The default is eight, - * for safety. - */ -#if defined(CROSSCOMPILE) || defined(MULTIARCH) -# define MEM_ALIGNBYTES 8 -#else -#define MEM_ALIGNBYTES 8 -#endif - -/* BYTEORDER: - * This symbol holds the hexadecimal constant defined in byteorder, - * i.e. 0x1234 or 0x4321, etc... - * If the compiler supports cross-compiling or multiple-architecture - * binaries (eg. on NeXT systems), use compiler-defined macros to - * determine the byte order. - * On NeXT 3.2 (and greater), you can build "Fat" Multiple Architecture - * Binaries (MAB) on either big endian or little endian machines. - * The endian-ness is available at compile-time. This only matters - * for perl, where the config.h can be generated and installed on - * one system, and used by a different architecture to build an - * extension. Older versions of NeXT that might not have - * defined either *_ENDIAN__ were all on Motorola 680x0 series, - * so the default case (for NeXT) is big endian to catch them. - * This might matter for NeXT 3.0. - */ -#if defined(CROSSCOMPILE) || defined(MULTIARCH) -# ifdef __LITTLE_ENDIAN__ -# if LONGSIZE == 4 -# define BYTEORDER 0x1234 -# else -# if LONGSIZE == 8 -# define BYTEORDER 0x12345678 -# endif -# endif -# else -# ifdef __BIG_ENDIAN__ -# if LONGSIZE == 4 -# define BYTEORDER 0x4321 -# else -# if LONGSIZE == 8 -# define BYTEORDER 0x87654321 -# endif -# endif -# endif -# endif -# if !defined(BYTEORDER) && (defined(NeXT) || defined(__NeXT__)) -# define BYTEORDER 0x4321 -# endif -#else -#define BYTEORDER 0x12345678 /* large digits for MSB */ -#endif /* NeXT */ - -/* CASTI32: - * This symbol is defined if the C compiler can cast negative - * or large floating point numbers to 32-bit ints. - */ -/*#define CASTI32 / **/ - -/* CASTNEGFLOAT: - * This symbol is defined if the C compiler can cast negative - * numbers to unsigned longs, ints and shorts. - */ -/* CASTFLAGS: - * This symbol contains flags that say what difficulties the compiler - * has casting odd floating values to unsigned long: - * 0 = ok - * 1 = couldn't cast < 0 - * 2 = couldn't cast >= 0x80000000 - * 4 = couldn't cast in argument expression list - */ -/*#define CASTNEGFLOAT /**/ -/*#define CASTFLAGS 0 /**/ - -/* VOID_CLOSEDIR: - * This symbol, if defined, indicates that the closedir() routine - * does not return a value. - */ -/*#define VOID_CLOSEDIR / **/ - -/* HAS_FD_SET: - * This symbol, when defined, indicates presence of the fd_set typedef - * in - */ -#define HAS_FD_SET /**/ - -/* Gconvert: - * This preprocessor macro is defined to convert a floating point - * number to a string without a trailing decimal point. This - * emulates the behavior of sprintf("%g"), but is sometimes much more - * efficient. If gconvert() is not available, but gcvt() drops the - * trailing decimal point, then gcvt() is used. If all else fails, - * a macro using sprintf("%g") is used. Arguments for the Gconvert - * macro are: value, number of digits, whether trailing zeros should - * be retained, and the output buffer. - * Possible values are: - * d_Gconvert='gconvert((x),(n),(t),(b))' - * d_Gconvert='gcvt((x),(n),(b))' - * d_Gconvert='sprintf((b),"%.*g",(n),(x))' - * The last two assume trailing zeros should not be kept. - */ -#define Gconvert(x,n,t,b) sprintf((b),"%.*g",(n),(x)) - -/* HAS_GNULIBC: - * This symbol, if defined, indicates to the C program that - * the GNU C library is being used. - */ -/*#define HAS_GNULIBC / **/ -/* HAS_ISASCII: - * This manifest constant lets the C program know that isascii - * is available. - */ -#define HAS_ISASCII /**/ - -/* HAS_LCHOWN: - * This symbol, if defined, indicates that the lchown routine is - * available to operate on a symbolic link (instead of following the - * link). - */ -/*##define HAS_LCHOWN /**/ - -/* HAS_OPEN3: - * This manifest constant lets the C program know that the three - * argument form of open(2) is available. - */ -#define HAS_OPEN3 /**/ - -/* HAS_SAFE_BCOPY: - * This symbol, if defined, indicates that the bcopy routine is available - * to copy potentially overlapping memory blocks. Otherwise you should - * probably use memmove() or memcpy(). If neither is defined, roll your - * own version. - */ -/*##define HAS_SAFE_BCOPY /**/ - -/* HAS_SAFE_MEMCPY: - * This symbol, if defined, indicates that the memcpy routine is available - * to copy potentially overlapping memory blocks. Otherwise you should - * probably use memmove() or memcpy(). If neither is defined, roll your - * own version. - */ -/*#define HAS_SAFE_MEMCPY / **/ - -/* HAS_SANE_MEMCMP: - * This symbol, if defined, indicates that the memcmp routine is available - * and can be used to compare relative magnitudes of chars with their high - * bits set. If it is not defined, roll your own version. - */ -#define HAS_SANE_MEMCMP /**/ - -/* HAS_SIGACTION: - * This symbol, if defined, indicates that Vr4's sigaction() routine - * is available. - */ -/*##define HAS_SIGACTION /**/ - -/* HAS_SIGSETJMP: - * This variable indicates to the C program that the sigsetjmp() - * routine is available to save the calling process's registers - * and stack environment for later use by siglongjmp(), and - * to optionally save the process's signal mask. See - * Sigjmp_buf, Sigsetjmp, and Siglongjmp. - */ -/* Sigjmp_buf: - * This is the buffer type to be used with Sigsetjmp and Siglongjmp. - */ -/* Sigsetjmp: - * This macro is used in the same way as sigsetjmp(), but will invoke - * traditional setjmp() if sigsetjmp isn't available. - * See HAS_SIGSETJMP. - */ -/* Siglongjmp: - * This macro is used in the same way as siglongjmp(), but will invoke - * traditional longjmp() if siglongjmp isn't available. - * See HAS_SIGSETJMP. - */ -/*##define HAS_SIGSETJMP /**/ -#ifdef HAS_SIGSETJMP -#define Sigjmp_buf sigjmp_buf -#define Sigsetjmp(buf,save_mask) sigsetjmp((buf),(save_mask)) -#define Siglongjmp(buf,retval) siglongjmp((buf),(retval)) -#else -#define Sigjmp_buf jmp_buf -#define Sigsetjmp(buf,save_mask) setjmp((buf)) -#define Siglongjmp(buf,retval) longjmp((buf),(retval)) -#endif - -/* USE_STDIO_PTR: - * This symbol is defined if the _ptr and _cnt fields (or similar) - * of the stdio FILE structure can be used to access the stdio buffer - * for a file handle. If this is defined, then the FILE_ptr(fp) - * and FILE_cnt(fp) macros will also be defined and should be used - * to access these fields. - */ -/* FILE_ptr: - * This macro is used to access the _ptr field (or equivalent) of the - * FILE structure pointed to by its argument. This macro will always be - * defined if USE_STDIO_PTR is defined. - */ -/* STDIO_PTR_LVALUE: - * This symbol is defined if the FILE_ptr macro can be used as an - * lvalue. - */ -/* FILE_cnt: - * This macro is used to access the _cnt field (or equivalent) of the - * FILE structure pointed to by its argument. This macro will always be - * defined if USE_STDIO_PTR is defined. - */ -/* STDIO_CNT_LVALUE: - * This symbol is defined if the FILE_cnt macro can be used as an - * lvalue. - */ -/*##define USE_STDIO_PTR /**/ -#ifdef USE_STDIO_PTR -#define FILE_ptr(fp) ((fp)->_ptr) -#define STDIO_PTR_LVALUE /**/ -#define FILE_cnt(fp) ((fp)->_cnt) -#define STDIO_CNT_LVALUE /**/ -#endif - -/* USE_STDIO_BASE: - * This symbol is defined if the _base field (or similar) of the - * stdio FILE structure can be used to access the stdio buffer for - * a file handle. If this is defined, then the FILE_base(fp) macro - * will also be defined and should be used to access this field. - * Also, the FILE_bufsiz(fp) macro will be defined and should be used - * to determine the number of bytes in the buffer. USE_STDIO_BASE - * will never be defined unless USE_STDIO_PTR is. - */ -/* FILE_base: - * This macro is used to access the _base field (or equivalent) of the - * FILE structure pointed to by its argument. This macro will always be - * defined if USE_STDIO_BASE is defined. - */ -/* FILE_bufsiz: - * This macro is used to determine the number of bytes in the I/O - * buffer pointed to by _base field (or equivalent) of the FILE - * structure pointed to its argument. This macro will always be defined - * if USE_STDIO_BASE is defined. - */ -/*##define USE_STDIO_BASE /**/ -#ifdef USE_STDIO_BASE -#define FILE_base(fp) ((fp)->_base) -#define FILE_bufsiz(fp) ((fp)->_cnt + (fp)->_ptr - (fp)->_base) -#endif - -/* HAS_VPRINTF: - * This symbol, if defined, indicates that the vprintf routine is available - * to printf with a pointer to an argument list. If unavailable, you - * may need to write your own, probably in terms of _doprnt(). - */ -/* USE_CHAR_VSPRINTF: - * This symbol is defined if this system has vsprintf() returning type - * (char*). The trend seems to be to declare it as "int vsprintf()". It - * is up to the package author to declare vsprintf correctly based on the - * symbol. - */ -#define HAS_VPRINTF /**/ -/*#define USE_CHAR_VSPRINTF / **/ - -/* DOUBLESIZE: - * This symbol contains the size of a double, so that the C preprocessor - * can make decisions based on it. - */ -#define DOUBLESIZE 8 /**/ - -/* I_TIME: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -/* I_SYS_TIME: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -/* I_SYS_TIME_KERNEL: - * This symbol, if defined, indicates to the C program that it should - * include with KERNEL defined. - */ -#define I_TIME / **/ -#define I_SYS_TIME /**/ -/*#define I_SYS_TIME_KERNEL / **/ - -/* VAL_O_NONBLOCK: - * This symbol is to be used during open() or fcntl(F_SETFL) to turn on - * non-blocking I/O for the file descriptor. Note that there is no way - * back, i.e. you cannot turn it blocking again this way. If you wish to - * alternatively switch between blocking and non-blocking, use the - * ioctl(FIOSNBIO) call instead, but that is not supported by all devices. - */ -/* VAL_EAGAIN: - * This symbol holds the errno error code set by read() when no data was - * present on the non-blocking file descriptor. - */ -/* RD_NODATA: - * This symbol holds the return code from read() when no data is present - * on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is - * not defined, then you can't distinguish between no data and EOF by - * issuing a read(). You'll have to find another way to tell for sure! - */ -/* EOF_NONBLOCK: - * This symbol, if defined, indicates to the C program that a read() on - * a non-blocking file descriptor will return 0 on EOF, and not the value - * held in RD_NODATA (-1 usually, in that case!). - */ -#define VAL_O_NONBLOCK O_NONBLOCK -#define VAL_EAGAIN EAGAIN -#define RD_NODATA -1 -#define EOF_NONBLOCK - -/* PTRSIZE: - * This symbol contains the size of a pointer, so that the C preprocessor - * can make decisions based on it. It will be sizeof(void *) if - * the compiler supports (void *); otherwise it will be - * sizeof(char *). - */ -#define PTRSIZE 8 /**/ - -/* Drand01: - * This macro is to be used to generate uniformly distributed - * random numbers over the range [0., 1.[. You may have to supply - * an 'extern double drand48();' in your program since SunOS 4.1.3 - * doesn't provide you with anything relevant in it's headers. - * See HAS_DRAND48_PROTO. - */ -/* Rand_seed_t: - * This symbol defines the type of the argument of the - * random seed function. - */ -/* seedDrand01: - * This symbol defines the macro to be used in seeding the - * random number generator (see Drand01). - */ -/* RANDBITS: - * This symbol indicates how many bits are produced by the - * function used to generate normalized random numbers. - * Values include 15, 16, 31, and 48. - */ -#define Drand01() (rand()/(double)((unsigned)1< or - * to get any typedef'ed information. - * We will pick a type such that sizeof(SSize_t) == sizeof(Size_t). - */ -#define SSize_t long /* signed count of bytes */ - -/* EBCDIC: - * This symbol, if defined, indicates that this system uses - * EBCDIC encoding. - */ -/*#define EBCDIC / **/ - -/* OSNAME: - * This symbol contains the name of the operating system, as determined - * by Configure. You shouldn't rely on it too much; the specific - * feature tests from Configure are generally more reliable. - */ -#define OSNAME "epoc" /**/ - -/* CAT2: - * This macro catenates 2 tokens together. - */ -/* STRINGIFY: - * This macro surrounds its token with double quotes. - */ -#if 42 == 1 -#define CAT2(a,b)a/**/b -#define STRINGIFY(a)"a" - /* If you can get stringification with catify, tell me how! */ -#endif -#if 42 == 42 -#define CAT2(a,b)a ## b -#define StGiFy(a)# a -#define STRINGIFY(a)StGiFy(a) -#endif -#if 42 != 1 && 42 != 42 -#include "Bletch: How does this C preprocessor catenate tokens?" -#endif - -/* CPPSTDIN: - * This symbol contains the first part of the string which will invoke - * the C preprocessor on the standard input and produce to standard - * output. Typical value of "cc -E" or "/lib/cpp", but it can also - * call a wrapper. See CPPRUN. - */ -/* CPPMINUS: - * This symbol contains the second part of the string which will invoke - * the C preprocessor on the standard input and produce to standard - * output. This symbol will have the value "-" if CPPSTDIN needs a minus - * to specify standard input, otherwise the value is "". - */ -/* CPPRUN: - * This symbol contains the string which will invoke a C preprocessor on - * the standard input and produce to standard output. It needs to end - * with CPPLAST, after all other preprocessor flags have been specified. - * The main difference with CPPSTDIN is that this program will never be a - * pointer to a shell wrapper, i.e. it will be empty if no preprocessor is - * available directly to the user. Note that it may well be different from - * the preprocessor used to compile the C program. - */ -#define CPPSTDIN "cppstdin" -#define CPPMINUS "" -#define CPPRUN "/usr/bin/cpp" - -/* HAS_ACCESS: - * This manifest constant lets the C program know that the access() - * system call is available to check for accessibility using real UID/GID. - * (always present on UNIX.) - */ -/*#define HAS_ACCESS /**/ - -/* HAS_CSH: - * This symbol, if defined, indicates that the C-shell exists. - */ -/* CSH: - * This symbol, if defined, contains the full pathname of csh. - */ -/*#define HAS_CSH /**/ -#ifdef HAS_CSH -#define CSH "/usr/bin/csh" /**/ -#endif - -/* HAS_ENDGRENT: - * This symbol, if defined, indicates that the getgrent routine is - * available for finalizing sequential access of the group database. - */ -/*#define HAS_ENDGRENT /**/ - -/* HAS_ENDHOSTENT: - * This symbol, if defined, indicates that the endhostent() routine is - * available to close whatever was being used for host queries. - */ -/*#define HAS_ENDHOSTENT /**/ - -/* HAS_ENDNETENT: - * This symbol, if defined, indicates that the endnetent() routine is - * available to close whatever was being used for network queries. - */ -/*#define HAS_ENDNETENT /**/ - -/* HAS_ENDPROTOENT: - * This symbol, if defined, indicates that the endprotoent() routine is - * available to close whatever was being used for protocol queries. - */ -/*#define HAS_ENDPROTOENT /**/ - -/* HAS_ENDPWENT: - * This symbol, if defined, indicates that the getgrent routine is - * available for finalizing sequential access of the passwd database. - */ -/*#define HAS_ENDPWENT /**/ - -/* HAS_ENDSERVENT: - * This symbol, if defined, indicates that the endservent() routine is - * available to close whatever was being used for service queries. - */ -/*#define HAS_ENDSERVENT /**/ - -/* HAS_GETGRENT: - * This symbol, if defined, indicates that the getgrent routine is - * available for sequential access of the group database. - */ -/*#define HAS_GETGRENT /**/ - -/* HAS_GETHOSTBYADDR: - * This symbol, if defined, indicates that the gethostbyaddr() routine is - * available to look up hosts by their IP addresses. - */ -#define HAS_GETHOSTBYADDR /**/ - -/* HAS_GETHOSTBYNAME: - * This symbol, if defined, indicates that the gethostbyname() routine is - * available to look up host names in some data base or other. - */ -#define HAS_GETHOSTBYNAME /**/ - -/* HAS_GETHOSTENT: - * This symbol, if defined, indicates that the gethostent() routine is - * available to look up host names in some data base or another. - */ -/*#define HAS_GETHOSTENT /**/ - -/* HAS_GETHOSTNAME: - * This symbol, if defined, indicates that the C program may use the - * gethostname() routine to derive the host name. See also HAS_UNAME - * and PHOSTNAME. - */ -/* HAS_UNAME: - * This symbol, if defined, indicates that the C program may use the - * uname() routine to derive the host name. See also HAS_GETHOSTNAME - * and PHOSTNAME. - */ -/* PHOSTNAME: - * This symbol, if defined, indicates the command to feed to the - * popen() routine to derive the host name. See also HAS_GETHOSTNAME - * and HAS_UNAME. Note that the command uses a fully qualified path, - * so that it is safe even if used by a process with super-user - * privileges. - */ -/*#define HAS_GETHOSTNAME /**/ -/*#define HAS_UNAME /**/ -#undef HAS_PHOSTNAME -#ifdef HAS_PHOSTNAME -#define PHOSTNAME "" /* How to get the host name */ -#endif - -/* HAS_GETNETBYADDR: - * This symbol, if defined, indicates that the getnetbyaddr() routine is - * available to look up networks by their IP addresses. - */ -/*#define HAS_GETNETBYADDR /**/ - -/* HAS_GETNETBYNAME: - * This symbol, if defined, indicates that the getnetbyname() routine is - * available to look up networks by their names. - */ -/*#define HAS_GETNETBYNAME /**/ - -/* HAS_GETNETENT: - * This symbol, if defined, indicates that the getnetent() routine is - * available to look up network names in some data base or another. - */ -/*#define HAS_GETNETENT /**/ - -/* HAS_GETPROTOENT: - * This symbol, if defined, indicates that the getprotoent() routine is - * available to look up protocols in some data base or another. - */ -/*#define HAS_GETPROTOENT /**/ - -/* HAS_GETPROTOBYNAME: - * This symbol, if defined, indicates that the getprotobyname() - * routine is available to look up protocols by their name. - */ -/* HAS_GETPROTOBYNUMBER: - * This symbol, if defined, indicates that the getprotobynumber() - * routine is available to look up protocols by their number. - */ -/*#define HAS_GETPROTOBYNAME /**/ -/*#define HAS_GETPROTOBYNUMBER /**/ - -/* HAS_GETPWENT: - * This symbol, if defined, indicates that the getpwent routine is - * available for sequential access of the passwd database. - * If this is not available, the older getpw() function may be available. - */ -/*#define HAS_GETPWENT /**/ - -/* HAS_GETSERVENT: - * This symbol, if defined, indicates that the getservent() routine is - * available to look up network services in some data base or another. - */ -/*#define HAS_GETSERVENT /**/ - -/* HAS_GETSERVBYNAME: - * This symbol, if defined, indicates that the getservbyname() - * routine is available to look up services by their name. - */ -/* HAS_GETSERVBYPORT: - * This symbol, if defined, indicates that the getservbyport() - * routine is available to look up services by their port. - */ -/*#define HAS_GETSERVBYNAME /**/ -/*#define HAS_GETSERVBYPORT /**/ -/* -/* HAS_HTONL: - * This symbol, if defined, indicates that the htonl() routine (and - * friends htons() ntohl() ntohs()) are available to do network - * order byte swapping. - */ -/* HAS_HTONS: - * This symbol, if defined, indicates that the htons() routine (and - * friends htonl() ntohl() ntohs()) are available to do network - * order byte swapping. - */ -/* HAS_NTOHL: - * This symbol, if defined, indicates that the ntohl() routine (and - * friends htonl() htons() ntohs()) are available to do network - * order byte swapping. - */ -/* HAS_NTOHS: - * This symbol, if defined, indicates that the ntohs() routine (and - * friends htonl() htons() ntohl()) are available to do network - * order byte swapping. - */ -#define HAS_HTONL /**/ -#define HAS_HTONS /**/ -#define HAS_NTOHL /**/ -#define HAS_NTOHS /**/ - -/* HAS_LONG_DOUBLE: - * This symbol will be defined if the C compiler supports long - * doubles. - */ -/* LONG_DOUBLESIZE: - * This symbol contains the size of a long double, so that the - * C preprocessor can make decisions based on it. It is only - * defined if the system supports long doubles. - */ -/*#define HAS_LONG_DOUBLE /**/ -#ifdef HAS_LONG_DOUBLE -#define LONG_DOUBLESIZE 8 /**/ -#endif - -/* HAS_LONG_LONG: - * This symbol will be defined if the C compiler supports long long. - */ -/* LONGLONGSIZE: - * This symbol contains the size of a long long, so that the - * C preprocessor can make decisions based on it. It is only - * defined if the system supports long long. - */ -/*#define HAS_LONG_LONG /**/ -#ifdef HAS_LONG_LONG -#define LONGLONGSIZE 8 /**/ -#endif - -/* HAS_MEMCHR: - * This symbol, if defined, indicates that the memchr routine is available - * to locate characters within a C string. - */ -#define HAS_MEMCHR /**/ - -/* HAS_MMAP: - * This symbol, if defined, indicates that the mmap system call is - * available to map a file into memory. - */ -/* Mmap_t: - * This symbol holds the return type of the mmap() system call - * (and simultaneously the type of the first argument). - * Usually set to 'void *' or 'cadd_t'. - */ -/*#define HAS_MMAP /**/ -#define Mmap_t void * /**/ - -/* HAS_MSG: - * This symbol, if defined, indicates that the entire msg*(2) library is - * supported (IPC mechanism based on message queues). - */ -/*#define HAS_MSG /**/ - -/* HAS_SEM: - * This symbol, if defined, indicates that the entire sem*(2) library is - * supported. - */ -/*#define HAS_SEM /**/ - -/* HAS_SETGRENT: - * This symbol, if defined, indicates that the setgrent routine is - * available for initializing sequential access of the group database. - */ -/*#define HAS_SETGRENT /**/ - -/* HAS_SETGROUPS: - * This symbol, if defined, indicates that the setgroups() routine is - * available to set the list of process groups. If unavailable, multiple - * groups are probably not supported. - */ -/*#define HAS_SETGROUPS /**/ - -/* HAS_SETHOSTENT: - * This symbol, if defined, indicates that the sethostent() routine is - * available. - */ -/*#define HAS_SETHOSTENT /**/ - -/* HAS_SETNETENT: - * This symbol, if defined, indicates that the setnetent() routine is - * available. - */ -/*#define HAS_SETNETENT /**/ - -/* HAS_SETPROTOENT: - * This symbol, if defined, indicates that the setprotoent() routine is - * available. - */ -/*#define HAS_SETPROTOENT /**/ - -/* HAS_SETPWENT: - * This symbol, if defined, indicates that the setpwent routine is - * available for initializing sequential access of the passwd database. - */ -/*#define HAS_SETPWENT /**/ - -/* HAS_SETSERVENT: - * This symbol, if defined, indicates that the setservent() routine is - * available. - */ -/*#define HAS_SETSERVENT /**/ - -/* HAS_SETVBUF: - * This symbol, if defined, indicates that the setvbuf routine is - * available to change buffering on an open stdio stream. - * to a line-buffered mode. - */ -/*#define HAS_SETVBUF /**/ - -/* HAS_SHM: - * This symbol, if defined, indicates that the entire shm*(2) library is - * supported. - */ -/*#define HAS_SHM /**/ - -/* HAS_SOCKET: - * This symbol, if defined, indicates that the BSD socket interface is - * supported. - */ -/* HAS_SOCKETPAIR: - * This symbol, if defined, indicates that the BSD socketpair() call is - * supported. - */ -/* HAS_MSG_CTRUNC: - * This symbol, if defined, indicates that the MSG_CTRUNC is supported. - * Checking just with #ifdef might not be enough because this symbol - * has been known to be an enum. - */ -/* HAS_MSG_DONTROUTE: - * This symbol, if defined, indicates that the MSG_DONTROUTE is supported. - * Checking just with #ifdef might not be enough because this symbol - * has been known to be an enum. - */ -/* HAS_MSG_OOB: - * This symbol, if defined, indicates that the MSG_OOB is supported. - * Checking just with #ifdef might not be enough because this symbol - * has been known to be an enum. - */ -/* HAS_MSG_PEEK: - * This symbol, if defined, indicates that the MSG_PEEK is supported. - * Checking just with #ifdef might not be enough because this symbol - * has been known to be an enum. - */ -/* HAS_MSG_PROXY: - * This symbol, if defined, indicates that the MSG_PROXY is supported. - * Checking just with #ifdef might not be enough because this symbol - * has been known to be an enum. - */ -/* HAS_SCM_RIGHTS: - * This symbol, if defined, indicates that the SCM_RIGHTS is supported. - * Checking just with #ifdef might not be enough because this symbol - * has been known to be an enum. - */ -/* HAS_SENDMSG: - * This symbol, if defined, indicates that the sendmsg is supported - * to send messages between sockets. You will also need struct - * iovec from , HAS_STRUCT_IOVEC and I_SYSUIO. - */ -/* HAS_RECVMSG: - * This symbol, if defined, indicates that the recvmsg is supported - * to send messages between sockets. You will also need struct - * iovec from , HAS_STRUCT_IOVEC and I_SYSUIO. - */ -/* HAS_STRUCT_MSGHDR: - * This symbol, if defined, indicates that the struct msghdr - * (BSD 4.3 or 4.4) is supported. You will also need struct - * iovec from , HAS_STRUCT_IOVEC and I_SYSUIO. - */ -/* HAS_STRUCT_CMSGHDR: - * This symbol, if defined, indicates that the struct cmsghdr - * (BSD 4.4) is supported. You will also need struct - * iovec from , HAS_STRUCT_IOVEC and I_SYSUIO. - */ -#define HAS_SOCKET /**/ -/*#define HAS_SOCKETPAIR /**/ -/*#define HAS_MSG_CTRUNC /**/ -/*#define HAS_MSG_DONTROUTE /**/ -/*#define HAS_MSG_OOB /**/ -/*#define HAS_MSG_PEEK /**/ -/*#define HAS_MSG_PROXY / **/ -/*#define HAS_SCM_RIGHTS /**/ -/*##define HAS_SENDMSG /**/ -/*##define HAS_RECVMSG /**/ -/*##define HAS_STRUCT_MSGHDR /**/ -/*##define HAS_STRUCT_CMSGHDR /**/ - -/* USE_STAT_BLOCKS: - * This symbol is defined if this system has a stat structure declaring - * st_blksize and st_blocks. - */ -#define USE_STAT_BLOCKS /**/ - -/* HAS_STRERROR: - * This symbol, if defined, indicates that the strerror routine is - * available to translate error numbers to strings. See the writeup - * of Strerror() in this file before you try to define your own. - */ -/* HAS_SYS_ERRLIST: - * This symbol, if defined, indicates that the sys_errlist array is - * available to translate error numbers to strings. The extern int - * sys_nerr gives the size of that table. - */ -/* Strerror: - * This preprocessor symbol is defined as a macro if strerror() is - * not available to translate error numbers to strings but sys_errlist[] - * array is there. - */ -#define HAS_STRERROR /**/ -/*##define HAS_SYS_ERRLIST /**/ -#define Strerror(e) strerror(e) - -/* HAS_UNION_SEMUN: - * This symbol, if defined, indicates that the union semun is - * defined by including . If not, the user code - * probably needs to define it as: - * union semun { - * int val; - * struct semid_ds *buf; - * unsigned short *array; - * } - */ -/* USE_SEMCTL_SEMUN: - * This symbol, if defined, indicates that union semun is - * used for semctl IPC_STAT. - */ -/* USE_SEMCTL_SEMID_DS: - * This symbol, if defined, indicates that struct semid_ds * is - * used for semctl IPC_STAT. - */ -/*#define HAS_UNION_SEMUN / **/ -#define USE_SEMCTL_SEMUN /**/ -#define USE_SEMCTL_SEMID_DS /**/ - -/* HAS_VFORK: - * This symbol, if defined, indicates that vfork() exists. - */ -/*#define HAS_VFORK / **/ - -/* Signal_t: - * This symbol's value is either "void" or "int", corresponding to the - * appropriate return type of a signal handler. Thus, you can declare - * a signal handler using "Signal_t (*handler)()", and define the - * handler using "Signal_t handler(sig)". - */ -#define Signal_t void /* Signal handler's return type */ - -/* Groups_t: - * This symbol holds the type used for the second argument to - * getgroups() and setgropus(). Usually, this is the same as - * gidtype (gid_t) , but sometimes it isn't. - * It can be int, ushort, uid_t, etc... - * It may be necessary to include to get any - * typedef'ed information. This is only required if you have - * getgroups() or setgropus().. - */ -#if defined(HAS_GETGROUPS) || defined(HAS_SETGROUPS) -#define Groups_t gid_t /* Type for 2nd arg to [sg]etgroups() */ -#endif - -/* I_GRP: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -/* GRPASSWD: - * This symbol, if defined, indicates to the C program that struct group - * in contains gr_passwd. - */ -/*##define I_GRP /**/ -/*##define GRPASSWD /**/ - -/* I_NETDB: - * This symbol, if defined, indicates that exists and - * should be included. - */ -#define I_NETDB /**/ - -/* I_PWD: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -/* PWQUOTA: - * This symbol, if defined, indicates to the C program that struct passwd - * contains pw_quota. - */ -/* PWAGE: - * This symbol, if defined, indicates to the C program that struct passwd - * contains pw_age. - */ -/* PWCHANGE: - * This symbol, if defined, indicates to the C program that struct passwd - * contains pw_change. - */ -/* PWCLASS: - * This symbol, if defined, indicates to the C program that struct passwd - * contains pw_class. - */ -/* PWEXPIRE: - * This symbol, if defined, indicates to the C program that struct passwd - * contains pw_expire. - */ -/* PWCOMMENT: - * This symbol, if defined, indicates to the C program that struct passwd - * contains pw_comment. - */ -/* PWGECOS: - * This symbol, if defined, indicates to the C program that struct passwd - * contains pw_gecos. - */ -/* PWPASSWD: - * This symbol, if defined, indicates to the C program that struct passwd - * contains pw_passwd. - */ -/*#define I_PWD /**/ -/*#define PWQUOTA /**/ -/*#define PWAGE / **/ -/*#define PWCHANGE / **/ -/*#define PWCLASS / **/ -/*#define PWEXPIRE / **/ -/*#define PWCOMMENT /**/ -/*#define PWGECOS /**/ -/*#define PWPASSWD /**/ - -/* I_SYSUIO: - * This symbol, if defined, indicates that exists and - * should be included. - */ -#/*define I_SYSUIO /**/ - -/* Free_t: - * This variable contains the return type of free(). It is usually - * void, but occasionally int. - */ -/* Malloc_t: - * This symbol is the type of pointer returned by malloc and realloc. - */ -#define Malloc_t void * /**/ -#define Free_t void /**/ - -/* MYMALLOC: - * This symbol, if defined, indicates that we're using our own malloc. - */ -/*#define MYMALLOC / **/ - -/* SIG_NAME: - * This symbol contains a list of signal names in order of - * signal number. This is intended - * to be used as a static array initialization, like this: - * char *sig_name[] = { SIG_NAME }; - * The signals in the list are separated with commas, and each signal - * is surrounded by double quotes. There is no leading SIG in the signal - * name, i.e. SIGQUIT is known as "QUIT". - * Gaps in the signal numbers (up to NSIG) are filled in with NUMnn, - * etc., where nn is the actual signal number (e.g. NUM37). - * The signal number for sig_name[i] is stored in sig_num[i]. - * The last element is 0 to terminate the list with a NULL. This - * corresponds to the 0 at the end of the sig_num list. - */ -/* SIG_NUM: - * This symbol contains a list of signal numbers, in the same order as the - * SIG_NAME list. It is suitable for static array initialization, as in: - * int sig_num[] = { SIG_NUM }; - * The signals in the list are separated with commas, and the indices - * within that list and the SIG_NAME list match, so it's easy to compute - * the signal name from a number or vice versa at the price of a small - * dynamic linear lookup. - * Duplicates are allowed, but are moved to the end of the list. - * The signal number corresponding to sig_name[i] is sig_number[i]. - * if (i < NSIG) then sig_number[i] == i. - * The last element is 0, corresponding to the 0 at the end of - * the sig_name list. - */ -#define SIG_NAME "ZERO", 0 /**/ -#define SIG_NUM 0, 0 /**/ - -/* VOIDFLAGS: - * This symbol indicates how much support of the void type is given by this - * compiler. What various bits mean: - * - * 1 = supports declaration of void - * 2 = supports arrays of pointers to functions returning void - * 4 = supports comparisons between pointers to void functions and - * addresses of void functions - * 8 = suports declaration of generic void pointers - * - * The package designer should define VOIDUSED to indicate the requirements - * of the package. This can be done either by #defining VOIDUSED before - * including config.h, or by defining defvoidused in Myinit.U. If the - * latter approach is taken, only those flags will be tested. If the - * level of void support necessary is not present, defines void to int. - */ -#ifndef VOIDUSED -#define VOIDUSED 15 -#endif -#define VOIDFLAGS 15 -#if (VOIDFLAGS & VOIDUSED) != VOIDUSED -#define void int /* is void to be avoided? */ -#define M_VOID /* Xenix strikes again */ -#endif - -/* ARCHLIB: - * This variable, if defined, holds the name of the directory in - * which the user wants to put architecture-dependent public - * library files for perl5. It is most often a local directory - * such as /usr/local/lib. Programs using this variable must be - * prepared to deal with filename expansion. If ARCHLIB is the - * same as PRIVLIB, it is not defined, since presumably the - * program already searches PRIVLIB. - */ -/* ARCHLIB_EXP: - * This symbol contains the ~name expanded version of ARCHLIB, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -#define ARCHLIB "/perl/lib/5.00562/epoc" /**/ -#define ARCHLIB_EXP "/perl/lib/5.00562/epoc" /**/ - -/* DLSYM_NEEDS_UNDERSCORE: - * This symbol, if defined, indicates that we need to prepend an - * underscore to the symbol name before calling dlsym(). This only - * makes sense if you *have* dlsym, which we will presume is the - * case if you're using dl_dlopen.xs. - */ -/*#define DLSYM_NEEDS_UNDERSCORE / **/ - -/* HAS_FSEEKO: - * This symbol, if defined, indicates that the fseeko routine is - * available to fseek beyond 32 bits (useful for ILP32 hosts). - */ -/*#define HAS_FSEEKO / **/ - -/* HAS_FTELLO: - * This symbol, if defined, indicates that the ftello routine is - * available to ftell from beyond 32 bits (useful for ILP32 hosts). - */ -/*#define HAS_FTELLO / **/ - -/* HAS_GETMNTENT: - * This symbol, if defined, indicates that the getmntent routine is - * available to iterate through mounted file systems. - */ -/*#define HAS_GETMNTENT / **/ - -/* HAS_HASMNTOPT: - * This symbol, if defined, indicates that the hasmntopt routine is - * available to query the mount options of file systems. - */ -/*#define HAS_HASMNTOPT / **/ - -/* HAS_MADVISE: - * This symbol, if defined, indicates that the madvise system call is - * available to map a file into memory. - */ -/*#define HAS_MADVISE /**/ - -/* HAS_MPROTECT: - * This symbol, if defined, indicates that the mprotect system call is - * available to modify the access protection of a memory mapped file. - */ -/*#define HAS_MPROTECT /**/ - -/* HAS_READV: - * This symbol, if defined, indicates that the readv routine is - * available to do gather reads. You will also need - * and there I_SYSUIO. - */ -/*#define HAS_READV /**/ - -/* USE_SFIO: - * This symbol, if defined, indicates that sfio should - * be used. - */ -/*#define USE_SFIO / **/ - -/* HAS_FSTATFS: - * This symbol, if defined, indicates that the fstatfs routine is - * available to stat filesystems of file descriptors. - */ -/* HAS_STRUCT_STATFS_FLAGS: - * This symbol, if defined, indicates that the struct statfs - * does have the f_flags member containing the mount flags of - * the filesystem holding the file. - * This kind of struct statfs is coming from sys/mount.h (BSD), - * not from sys/statfs.h (SYSV). - */ -#define HAS_FSTATFS /**/ -#define HAS_STRUCT_STATFS_FLAGS /**/ - -/* HAS_FSTATVFS: - * This symbol, if defined, indicates that the fstatvfs routine is - * available to stat filesystems of file descriptors. - */ -/*#define HAS_FSTATVFS /**/ - -/* HAS_TELLDIR_PROTO: - * This symbol, if defined, indicates that the system provides - * a prototype for the telldir() function. Otherwise, it is up - * to the program to supply one. A good guess is - * extern long telldir _((DIR*)); - */ -#define HAS_TELLDIR_PROTO /**/ - -/* HAS_WRITEV: - * This symbol, if defined, indicates that the writev routine is - * available to do scatter writes. - */ -/*#define HAS_WRITEV /**/ - -/* USE_DYNAMIC_LOADING: - * This symbol, if defined, indicates that dynamic loading of - * some sort is available. - */ -/*#define USE_DYNAMIC_LOADING /**/ - -/* FFLUSH_NULL: - * This symbol, if defined, tells that fflush(NULL) does flush - * all pending stdio output. - */ -/* FFLUSH_ALL: - * This symbol, if defined, tells that to flush - * all pending stdio output one must loop through all - * the stdio file handles stored in an array and fflush them. - * Note that if fflushNULL is defined, fflushall will not - * even be probed for and will be left undefined. - */ -/*#define FFLUSH_NULL /**/ -#define FFLUSH_ALL / **/ - -/* DB_Prefix_t: - * This symbol contains the type of the prefix structure element - * in the header file. In older versions of DB, it was - * int, while in newer ones it is u_int32_t. - */ -/* DB_Hash_t: - * This symbol contains the type of the prefix structure element - * in the header file. In older versions of DB, it was - * int, while in newer ones it is size_t. - */ -/*#define DB_Hash_t u_int32_t /**/ -/*#define DB_Prefix_t size_t /**/ - -/* I_INTTYPES: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -/* HAS_INT64_T: - * This symbol will defined if the C compiler supports int64_t. - * Usually the needs to be included, but sometimes - * is enough. - */ -/*#define I_INTTYPES / **/ -/*#define HAS_INT64_T / **/ - -/* I_MNTENT: - * This symbol, if defined, indicates that exists and - * should be included. - */ -/*#define I_MNTENT / **/ - -/* I_NETINET_TCP: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -#define I_NETINET_TCP /**/ - -/* I_POLL: - * This symbol, if defined, indicates that exists and - * should be included. - */ -/*#define I_POLL /**/ - -/* I_SYS_MMAN: - * This symbol, if defined, indicates that exists and - * should be included. - */ -/*#define I_SYS_MMAN /**/ - -/* I_SYS_MOUNT: - * This symbol, if defined, indicates that exists and - * should be included. - */ -/*#define I_SYS_MOUNT /**/ - -/* I_SYS_STATVFS: - * This symbol, if defined, indicates that exists and - * should be included. - */ -/*#define I_SYS_STATVFS /**/ - -/* INSTALL_USR_BIN_PERL: - * This symbol, if defined, indicates that Perl is to be installed - * also as /usr/bin/perl. - */ -/*#define INSTALL_USR_BIN_PERL /**/ - -/* PRIVLIB: - * This symbol contains the name of the private library for this package. - * The library is private in the sense that it needn't be in anyone's - * execution path, but it should be accessible by the world. The program - * should be prepared to do ~ expansion. - */ -/* PRIVLIB_EXP: - * This symbol contains the ~name expanded version of PRIVLIB, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -#define PRIVLIB "/perl/lib/5.00562" /**/ -#define PRIVLIB_EXP "/perl/lib/5.00562" /**/ - -/* SELECT_MIN_BITS: - * This symbol holds the minimum number of bits operated by select. - * That is, if you do select(n, ...), how many bits at least will be - * cleared in the masks if some activity is detected. Usually this - * is either n or 32*ceil(n/32), especially many little-endians do - * the latter. This is only useful if you have select(), naturally. - */ -#define SELECT_MIN_BITS 32 /**/ - -/* SITEARCH: - * This symbol contains the name of the private library for this package. - * The library is private in the sense that it needn't be in anyone's - * execution path, but it should be accessible by the world. The program - * should be prepared to do ~ expansion. - * The standard distribution will put nothing in this directory. - * Individual sites may place their own extensions and modules in - * this directory. - */ -/* SITEARCH_EXP: - * This symbol contains the ~name expanded version of SITEARCH, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -#define SITEARCH "/perl/lib/site_perl/5.00562/epoc" /**/ -#define SITEARCH_EXP "/perl/lib/site_perl/5.00562/epoc" /**/ - -/* SITELIB: - * This symbol contains the name of the private library for this package. - * The library is private in the sense that it needn't be in anyone's - * execution path, but it should be accessible by the world. The program - * should be prepared to do ~ expansion. - * The standard distribution will put nothing in this directory. - * Individual sites may place their own extensions and modules in - * this directory. - */ -/* SITELIB_EXP: - * This symbol contains the ~name expanded version of SITELIB, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -#define SITELIB "/perl/lib/site_perl/5.00562" /**/ -#define SITELIB_EXP "/perl/lib/site_perl/5.00562" /**/ - -/* STARTPERL: - * This variable contains the string to put in front of a perl - * script to make sure (one hopes) that it runs with perl and not - * some shell. - */ -#define STARTPERL "#!/opt/perl/bin/perl" /**/ - -/* HAS_STDIO_STREAM_ARRAY: - * This symbol, if defined, tells that there is an array - * holding the stdio streams. - */ -/* STDIO_STREAM_ARRAY: - * This symbol tells the name of the array holding the stdio streams. - * Usual values include _iob, __iob, and __sF. - */ -/*#define HAS_STDIO_STREAM_ARRAY /**/ -/*#define STDIO_STREAM_ARRAY _iob - -/* USE_64_BITS: - * This symbol, if defined, indicates that 64-bit interfaces should - * be used when available. If not defined, the native default interfaces - * will be used (be they 32 or 64 bits). - */ -/*#define USE_64_BITS /**/ - -/* MULTIPLICITY: - * This symbol, if defined, indicates that Perl should - * be built to use multiplicity. - */ -/*#define MULTIPLICITY / **/ - -/* USE_PERLIO: - * This symbol, if defined, indicates that the PerlIO abstraction should - * be used throughout. If not defined, stdio should be - * used in a fully backward compatible manner. - */ -/*#define USE_PERLIO / **/ - -/* HAS_DRAND48_PROTO: - * This symbol, if defined, indicates that the system provides - * a prototype for the drand48() function. Otherwise, it is up - * to the program to supply one. A good guess is - * extern double drand48 _((void)); - */ -#define HAS_DRAND48_PROTO /**/ - -/* HAS_GETHOST_PROTOS: - * This symbol, if defined, indicates that includes - * prototypes for gethostent(), gethostbyname(), and - * gethostbyaddr(). Otherwise, it is up to the program to guess - * them. See netdbtype.U for probing for various Netdb_xxx_t types. - */ -#define HAS_GETHOST_PROTOS /**/ - -/* HAS_GETNET_PROTOS: - * This symbol, if defined, indicates that includes - * prototypes for getnetent(), getnetbyname(), and - * getnetbyaddr(). Otherwise, it is up to the program to guess - * them. See netdbtype.U for probing for various Netdb_xxx_t types. - */ -#define HAS_GETNET_PROTOS /**/ - -/* HAS_GETPROTO_PROTOS: - * This symbol, if defined, indicates that includes - * prototypes for getprotoent(), getprotobyname(), and - * getprotobyaddr(). Otherwise, it is up to the program to guess - * them. See netdbtype.U for probing for various Netdb_xxx_t types. - */ -#define HAS_GETPROTO_PROTOS /**/ - -/* HAS_GETSERV_PROTOS: - * This symbol, if defined, indicates that includes - * prototypes for getservent(), getservbyname(), and - * getservbyaddr(). Otherwise, it is up to the program to guess - * them. See netdbtype.U for probing for various Netdb_xxx_t types. - */ -#define HAS_GETSERV_PROTOS /**/ - -/* Netdb_host_t: - * This symbol holds the type used for the 1st argument - * to gethostbyaddr(). - */ -/* Netdb_hlen_t: - * This symbol holds the type used for the 2nd argument - * to gethostbyaddr(). - */ -/* Netdb_name_t: - * This symbol holds the type used for the argument to - * gethostbyname(). - */ -/* Netdb_net_t: - * This symbol holds the type used for the 1st argument to - * getnetbyaddr(). - */ -#define Netdb_host_t const char * /**/ -#define Netdb_hlen_t int /**/ -#define Netdb_name_t const char * /**/ -#define Netdb_net_t int /**/ - -/* Select_fd_set_t: - * This symbol holds the type used for the 2nd, 3rd, and 4th - * arguments to select. Usually, this is 'fd_set *', if HAS_FD_SET - * is defined, and 'int *' otherwise. This is only useful if you - * have select(), of course. - */ -#define Select_fd_set_t fd_set * /**/ - -/* ARCHNAME: - * This symbol holds a string representing the architecture name. - * It may be used to construct an architecture-dependant pathname - * where library files may be held under a private library, for - * instance. - */ -#define ARCHNAME "epoc" /**/ - -/* OLD_PTHREAD_CREATE_JOINABLE: - * This symbol, if defined, indicates how to create pthread - * in joinable (aka undetached) state. NOTE: not defined - * if pthread.h already has defined PTHREAD_CREATE_JOINABLE - * (the new version of the constant). - * If defined, known values are PTHREAD_CREATE_UNDETACHED - * and __UNDETACHED. - */ -/*#define OLD_PTHREAD_CREATE_JOINABLE / **/ - -/* HAS_PTHREAD_YIELD: - * This symbol, if defined, indicates that the pthread_yield - * routine is available to yield the execution of the current - * thread. sched_yield is preferable to pthread_yield. - */ -/* SCHED_YIELD: - * This symbol defines the way to yield the execution of - * the current thread. Known ways are sched_yield, - * pthread_yield, and pthread_yield with NULL. - */ -/* HAS_SCHED_YIELD: - * This symbol, if defined, indicates that the sched_yield - * routine is available to yield the execution of the current - * thread. sched_yield is preferable to pthread_yield. - */ -/*#define HAS_PTHREAD_YIELD / **/ -/*#define SCHED_YIELD sched_yield() /**/ -/*#define HAS_SCHED_YIELD /**/ - -/* I_MACH_CTHREADS: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -/*#define I_MACH_CTHREADS / **/ - -/* USE_THREADS: - * This symbol, if defined, indicates that Perl should - * be built to use threads. - */ -/* OLD_PTHREADS_API: - * This symbol, if defined, indicates that Perl should - * be built to use the old draft POSIX threads API. - */ -/*#define USE_THREADS /**/ -/*#define OLD_PTHREADS_API / **/ - -/* Time_t: - * This symbol holds the type returned by time(). It can be long, - * or time_t on BSD sites (in which case should be - * included). - */ -#define Time_t time_t /* Time type */ - -/* HAS_TIMES: - * This symbol, if defined, indicates that the times() routine exists. - * Note that this became obsolete on some systems (SUNOS), which now - * use getrusage(). It may be necessary to include . - */ -/*#define HAS_TIMES /**/ - -/* Fpos_t: - * This symbol holds the type used to declare file positions in libc. - * It can be fpos_t, long, uint, etc... It may be necessary to include - * to get any typedef'ed information. - */ -#define Fpos_t fpos_t /* File position type */ - -/* Gid_t: - * This symbol holds the return type of getgid() and the type of - * argument to setrgid() and related functions. Typically, - * it is the type of group ids in the kernel. It can be int, ushort, - * uid_t, etc... It may be necessary to include to get - * any typedef'ed information. - */ -#define Gid_t gid_t /* Type for getgid(), etc... */ - -/* Off_t: - * This symbol holds the type used to declare offsets in the kernel. - * It can be int, long, off_t, etc... It may be necessary to include - * to get any typedef'ed information. - */ -/* LSEEKSIZE: - * This symbol holds the number of bytes used by the Off_t. - */ -#define Off_t off_t /* type */ -#define LSEEKSIZE 8 /* size */ - -/* Mode_t: - * This symbol holds the type used to declare file modes - * for systems calls. It is usually mode_t, but may be - * int or unsigned short. It may be necessary to include - * to get any typedef'ed information. - */ -#define Mode_t mode_t /* file mode parameter for system calls */ - -/* Pid_t: - * This symbol holds the type used to declare process ids in the kernel. - * It can be int, uint, pid_t, etc... It may be necessary to include - * to get any typedef'ed information. - */ -#define Pid_t pid_t /* PID type */ - -/* Size_t: - * This symbol holds the type used to declare length parameters - * for string functions. It is usually size_t, but may be - * unsigned long, int, etc. It may be necessary to include - * to get any typedef'ed information. - */ -#define Size_t size_t /* length paramater for string functions */ - -/* Uid_t: - * This symbol holds the type used to declare user ids in the kernel. - * It can be int, ushort, uid_t, etc... It may be necessary to include - * to get any typedef'ed information. - */ -#define Uid_t uid_t /* UID type */ - -/* PERL_PRIfldbl: - * This symbol, if defined, contains the string used by stdio to - * format long doubles (format 'f') for output. - */ -/* PERL_PRIgldbl: - * This symbol, if defined, contains the string used by stdio to - * format long doubles (format 'g') for output. - */ -#define PERL_PRIfldbl "f" /**/ -#define PERL_PRIgldbl "g" /**/ - -#endif - diff --git a/epoc/config.sh b/epoc/config.sh new file mode 100644 index 0000000..55ca6bd --- /dev/null +++ b/epoc/config.sh @@ -0,0 +1,764 @@ +#!/bin/sh +# +# This file was produced by running the Configure script. It holds all the +# definitions figured out by Configure. Should you modify one of these values, +# do not forget to propagate your changes by running "Configure -der". You may +# instead choose to run each of the .SH files by yourself, or "Configure -S". +# + +# Package name : perl5 +# Source directory : . +# Configuration time: Sun Oct 3 02:17:38 EET DST 1999 +# Configured by : jhi +# Target system : osf1 alpha.hut.fi v4.0 878 alpha + +Author='' +Date='$Date' +Header='' +Id='$Id' +Locker='' +Log='$Log' +Mcc='' +RCSfile='$RCSfile' +Revision='$Revision' +Source='' +State='' +_a='.a' +_exe='.exe' +_o='.o' +afs='false' +alignbytes='8' +ansi2knr='' +aphostname='' +apirevision='' +apisubversion='' +apiversion='' +ar='arm-pe-ar' +archlib='/perl/lib/5.5.640/epoc' +archlibexp='/perl/lib/5.5.640/epoc' +archname64='' +archname='epoc' +archobjs='epoc.o epocish.o epoc_stubs.o' +awk='awk' +baserev='5.0' +bash='' +bin='' +bincompat5005='false' +binexp='' +bison='bison' +byacc='' +byteorder='1234' +c='' +castflags='0' +cat='cat' +cc='arm-pe-gcc -B/usr/local/lib/gcc-lib/arm-pe/cygnus-2.7.2-960323/ -nostdinc -D__SYMBIAN32__ -D__PSISOFT32__ -D__GCC32__ -D__EPOC32__ -D__MARM__ -D__EXE__ -I/usr/local/epoc/include/ -I/usr/local/epoc/include/libc -DEPOC' +cccdlflags='' +ccdlflags='' +ccflags='-Wno-ctor-dtor-privacy -mcpu-arm710 -mapcs-32 -mshort-load-bytes -msoft-float -fcheck-new -fvtable-thunks' +ccsymbols='' +cf_by='olaf' +cf_email='o.flebbe@gmx.de' +cf_time='Dec 1999' +chgrp='' +chmod='' +chown='' +clocktype='' +comm='' +compress='' +contains='grep' +cp='cp' +cpio='' +cpp='arm-pe-cpp' +cpp_stuff='42' +cppccsymbols='EPOC=1' +cppflags=' -nostdinc -D__SYMBIAN32__ -D__PSISOFT32__ -D__GCC32__ -D__EPOC32__ -D__MARM__ -D__EXE__ -I/usr/local/epoc/include/ -I/usr/local/epoc/include/libc' +cpplast='-' +cppminus='-' +cpprun='arm-pe-gcc -E -B/usr/local/lib/gcc-lib/arm-pe/cygnus-2.7.2-960323/' +cppstdin='arm-pe-gcc -E -B/usr/local/lib/gcc-lib/arm-pe/cygnus-2.7.2-960323/' +cppsymbols='' +crosscompile='define' +cryptlib='' +csh='csh' +d_Gconvert='sprintf((b),"%.*g",(n),(x))' +d_PRIEldbl='undef' +d_PRIFldbl='undef' +d_PRIGldbl='undef' +d_PRIX64='undef' +d_PRId64='undef' +d_PRIeldbl='undef' +d_PRIfldbl='define' +d_PRIgldbl='define' +d_PRIi64='undef' +d_PRIo64='undef' +d_PRIu64='undef' +d_PRIx64='undef' +d_access='undef' +d_accessx='undef' +d_alarm='undef' +d_archlib='define' +d_atolf='undef' +d_atoll='undef' +d_attribut='undef' +d_bcmp='define' +d_bcopy='define' +d_bincompat5005='undef' +d_bsd='undef' +d_bsdgetpgrp='undef' +d_bsdsetpgrp='undef' +d_bzero='define' +d_casti32='undef' +d_castneg='undef' +d_charvspr='undef' +d_chown='undef' +d_chroot='undef' +d_chsize='undef' +d_closedir='undef' +d_cmsghdr_s='undef' +d_const='define' +d_crypt='undef' +d_csh='undef' +d_cuserid='undef' +d_dbl_dig='undef' +d_difftime='define' +d_dirnamlen='undef' +d_dlerror='undef' +d_dlopen='undef' +d_dlsymun='undef' +d_dosuid='undef' +d_drand48proto='define' +d_dup2='undef' +d_eaccess='undef' +d_endgrent='undef' +d_endhent='undef' +d_endnent='undef' +d_endpent='undef' +d_endpwent='undef' +d_endsent='undef' +d_endspent='undef' +d_eofnblk='define' +d_eunice='undef' +d_fchmod='undef' +d_fchown='undef' +d_fcntl='undef' +d_fd_macros='undef' +d_fd_set='define' +d_fds_bits='undef' +d_fgetpos='define' +d_flexfnam='define' +d_flock='undef' +d_fork='undef' +d_fpathconf='undef' +d_fpos64_t='undef' +d_fseeko='undef' +d_fsetpos='define' +d_fstatfs='define' +d_fstatvfs='undef' +d_ftello='undef' +d_ftime='undef' +d_getgrent='undef' +d_getgrps='undef' +d_gethbyaddr='define' +d_gethbyname='define' +d_gethent='undef' +d_gethname='undef' +d_gethostprotos='define' +d_getlogin='undef' +d_getmntent='undef' +d_getnbyaddr='undef' +d_getnbyname='undef' +d_getnent='undef' +d_getnetprotos='define' +d_getpbyname='define' +d_getpbynumber='define' +d_getpent='undef' +d_getpgid='undef' +d_getpgrp2='undef' +d_getpgrp='undef' +d_getppid='undef' +d_getprior='undef' +d_getprotoprotos='define' +d_getpwent='undef' +d_getsbyname='undef' +d_getsbyport='undef' +d_getsent='undef' +d_getservprotos='define' +d_getspent='undef' +d_getspnam='undef' +d_gettimeod='define' +d_gnulibc='undef' +d_grpasswd='undef' +d_hasmntopt='undef' +d_htonl='define' +d_index='undef' +d_inetaton='define' +d_int64t='undef' +d_iovec_s='undef' +d_isascii='define' +d_killpg='undef' +d_lchown='undef' +d_ldbl_dig='undef' +d_link='undef' +d_llseek='undef' +d_locconv='undef' +d_lockf='undef' +d_longdbl='undef' +d_longlong='define' +d_lstat='undef' +d_madvise='undef' +d_mblen='undef' +d_mbstowcs='undef' +d_mbtowc='undef' +d_memchr='define' +d_memcmp='define' +d_memcpy='define' +d_memmove='define' +d_memset='define' +d_mkdir='define' +d_mkfifo='undef' +d_mktime='define' +d_mmap='undef' +d_mprotect='undef' +d_msg='undef' +d_msg_ctrunc='undef' +d_msg_dontroute='undef' +d_msg_oob='undef' +d_msg_peek='undef' +d_msg_proxy='undef' +d_msgctl='undef' +d_msgget='undef' +d_msghdr_s='undef' +d_msgrcv='undef' +d_msgsnd='undef' +d_msync='undef' +d_munmap='undef' +d_mymalloc='undef' +d_nice='undef' +d_off64_t='undef' +d_old_pthread_create_joinable='undef' +d_oldpthreads='undef' +d_oldsock='undef' +d_open3='define' +d_pathconf='undef' +d_pause='undef' +d_phostname='undef' +d_pipe='undef' +d_poll='undef' +d_portable='undef' +d_pthread_yield='undef' +d_pwage='undef' +d_pwchange='undef' +d_pwclass='undef' +d_pwcomment='undef' +d_pwexpire='undef' +d_pwgecos='undef' +d_pwpasswd='undef' +d_pwquota='undef' +d_readdir='define' +d_readlink='undef' +d_readv='undef' +d_recvmsg='undef' +d_rename='define' +d_rewinddir='define' +d_rmdir='define' +d_safebcpy='undef' +d_safemcpy='undef' +d_sanemcmp='define' +d_sched_yield='undef' +d_scm_rights='undef' +d_seekdir='define' +d_select='undef' +d_sem='undef' +d_semctl='undef' +d_semctl_semid_ds='define' +d_semctl_semun='define' +d_semget='undef' +d_semop='undef' +d_sendmsg='undef' +d_setegid='undef' +d_seteuid='undef' +d_setgrent='undef' +d_setgrps='undef' +d_sethent='undef' +d_setlinebuf='undef' +d_setlocale='undef' +d_setnent='undef' +d_setpent='undef' +d_setpgid='undef' +d_setpgrp2='undef' +d_setpgrp='undef' +d_setprior='undef' +d_setpwent='undef' +d_setregid='undef' +d_setresgid='undef' +d_setresuid='undef' +d_setreuid='undef' +d_setrgid='undef' +d_setruid='undef' +d_setsent='undef' +d_setsid='undef' +d_setspent='undef' +d_setvbuf='undef' +d_sfio='undef' +d_shm='undef' +d_shmat='undef' +d_shmatprototype='undef' +d_shmctl='undef' +d_shmdt='undef' +d_shmget='undef' +d_sigaction='undef' +d_sigsetjmp='undef' +d_socket='define' +d_sockpair='undef' +d_statblks='define' +d_statfs='undef' +d_statfsflags='define' +d_statvfs='undef' +d_stdio_cnt_lval='define' +d_stdio_ptr_lval='define' +d_stdio_stream_array='undef' +d_stdiobase='undef' +d_stdstdio='undef' +d_strchr='define' +d_strcoll='define' +d_strctcpy='define' +d_strerrm='strerror(e)' +d_strerror='define' +d_strtod='define' +d_strtol='define' +d_strtoul='define' +d_strtoull='undef' +d_strxfrm='define' +d_suidsafe='undef' +d_symlink='undef' +d_syscall='undef' +d_sysconf='define' +d_sysernlst='undef' +d_syserrlst='undef' +d_system='define' +d_tcgetpgrp='undef' +d_tcsetpgrp='undef' +d_telldir='define' +d_telldirproto='define' +d_time='undef' +d_times='undef' +d_truncate='undef' +d_tzname='undef' +d_umask='undef' +d_uname='undef' +d_union_semun='undef' +d_vendorlib='undef' +d_vfork='undef' +d_void_closedir='undef' +d_voidsig='undef' +d_voidtty='undef' +d_volatile='define' +d_vprintf='define' +d_wait4='undef' +d_waitpid='undef' +d_wcstombs='undef' +d_wctomb='undef' +d_writev='undef' +d_xenix='undef' +date='date' +db_hashtype='undef' +db_prefixtype='undef' +defvoidused='15' +direntrytype='struct dirent' +dlext='none' +dlsrc='dl_none.xs' +doublesize='8' +drand01='(rand()/(double)(1U<perl.pkg"; + +print OUT "#{\"perl$VERSION\"},(0x100051d8),$PATCH,$EPOC_VERSION,0\n"; + +print OUT "\"$CROSSREPLACEPATH\\perlmain.exe\"-\"!:\\perl.exe\"\n"; + +find(\&filefound, cwd.'/lib'); +print OUT "@\"G:\\lib\\stdlib.sis\",(0x010002c3)\n" + + diff --git a/epoc/epoc.c b/epoc/epoc.c index d0fae23..498036d 100644 --- a/epoc/epoc.c +++ b/epoc/epoc.c @@ -11,7 +11,6 @@ #include #include -char *environ = NULL; void Perl_epoc_init(int *argcp, char ***argvp) { int i; @@ -87,4 +86,62 @@ __fixunsdfsi (a) return (SItype) a; } +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +int +do_aspawn( pTHX_ SV *really,SV **mark,SV **sp) { + return do_spawn( really, mark, sp); +} + +int +do_spawn (pTHX_ SV *really,SV **mark,SV **sp) +{ + dTHR; + int rc; + char **a,*cmd,**ptr, *cmdline, **argv, *p2; + STRLEN n_a; + size_t len = 0; + + if (sp<=mark) + return -1; + + a=argv=ptr=(char**) malloc ((sp-mark+3)*sizeof (char*)); + + while (++mark <= sp) { + if (*mark) + *a = SvPVx(*mark, n_a); + else + *a = ""; + len += strlen( *a) + 1; + a++; + } + *a = Nullch; + + if (!(really && *(cmd = SvPV(really, n_a)))) { + cmd = argv[0]; + argv++; + } + + cmdline = (char * ) malloc( len + 1); + cmdline[ 0] = '\0'; + while (*argv != NULL) { + strcat( cmdline, *argv++); + strcat( cmdline, " "); + } + + for (p2=cmd; *p2 != '\0'; p2++) { + /* Change / to \ */ + if ( *p2 == '/') + *p2 = '\\'; + } + rc = epoc_spawn( cmd, cmdline); + free( ptr); + free( cmdline); + + return rc; +} + + #endif diff --git a/epoc/epoc_stubs.c b/epoc/epoc_stubs.c new file mode 100644 index 0000000..b11da40 --- /dev/null +++ b/epoc/epoc_stubs.c @@ -0,0 +1,69 @@ +/* + * Copyright (c) 1999 Olaf Flebbe o.flebbe@gmx.de + * + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. + * + */ + +#include + +char *environ = 0; + +int getgid() {return 0;} +int getegid() {return 0;} +int geteuid() {return 0;} +int getuid() {return 0;} +int setgid() {return -1;} +int setuid() {return -1;} + + +int Perl_my_popen( int a, int b) { + return NULL; +} +int Perl_my_pclose( int a) { + return NULL; +} + +int kill() {return -1;} +signal() { } + +int execv() { return -1;} +int execvp() { return -1;} + +void Perl_do_exec() {} + +/*------------------------------------------------------------------*/ +/* Two dummy functions implement getproto* */ +/*------------------------------------------------------------------*/ +#include +#include +#include + + +static struct protoent protos[2] = { + {"tcp", NULL, IPPROTO_TCP} , + {"udp", NULL, IPPROTO_UDP}}; + +struct protoent *getprotobyname (const char *st) { + + if (!strcmp( st, "tcp")) { + return &protos[0]; + } + if (!strcmp( st, "udp")) { + return &protos[1]; + } + return NULL; +} + +struct protoent *getprotobynumber ( int i) { + if (i == IPPROTO_TCP) { + return &protos[0]; + } + if (i == IPPROTO_UDP) { + return &protos[1]; + } + return NULL; +} + + diff --git a/epoc/epocish.c b/epoc/epocish.c new file mode 100644 index 0000000..134eaef --- /dev/null +++ b/epoc/epocish.c @@ -0,0 +1,34 @@ +/* + * Copyright (c) 1999 Olaf Flebbe o.flebbe@gmx.de + * + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. + * + */ + +/* This is indeed C++ Code !! */ + +#include + +extern "C" { + +epoc_spawn( char *cmd, char *cmdline) { + RProcess p; + TRequestStatus status; + TInt rc; + + rc = p.Create( _L( cmd), _L( cmdline)); + if (rc != KErrNone) + return -1; + + p.Resume(); + + p.Logon( status); + User::WaitForRequest( status); + if (status!=KErrNone) { + return -1; + } + return 0; +} + +} diff --git a/epoc/epocish.h b/epoc/epocish.h index 70d4cbd..ca992cf 100644 --- a/epoc/epocish.h +++ b/epoc/epocish.h @@ -90,12 +90,6 @@ /* #define ALTERNATE_SHEBANG "#!" / **/ -#ifndef SIGABRT -# define SIGABRT SIGILL -#endif -#ifndef SIGILL -# define SIGILL 6 /* blech */ -#endif #define ABORT() abort(); /* @@ -124,3 +118,18 @@ #define dXSUB_SYS +/* getsockname returns the size of struct sockaddr_in *without* padding */ +#define BOGUS_GETNAME_RETURN 8 + +/* Yes, size_t is size_t */ +#define Sock_size_t size_t + +/* + read() on a socket blocks until buf is filled completly, + recv() returns each massage +*/ +#define PERL_SOCK_SYSREAD_IS_RECV + +/* No /dev/random available*/ + +#define PERL_NO_DEV_RANDOM diff --git a/epoc/link.pl b/epoc/link.pl new file mode 100644 index 0000000..9da8a35 --- /dev/null +++ b/epoc/link.pl @@ -0,0 +1,25 @@ +#!/usr/bin/perl -w + +$epoc="/usr/local/epoc"; +@objs=@ARGV; +$basname=$objs[0]; +$basname =~ s/.o//; +$baspe = $basname . "pe"; + + +system("arm-pe-ld -s -e _E32Startup --base-file $basname.bas " . + "-o $baspe.exe $epoc/lib/eexe.o @objs " . + "$epoc/lib/ecrt0.o $epoc/lib/estlib.lib $epoc/lib/euser.lib"); + +system("arm-pe-dlltool --as=arm-pe-as --output-exp $basname.exp " . + "--base-file $basname.bas $epoc/lib/eexe.o @objs " . + "$epoc/lib/ecrt0.o $epoc/lib/estlib.lib $epoc/lib/euser.lib"); + +system("arm-pe-ld -s -e _E32Startup -o $basname.exe $basname.exp " . + "-o $baspe.exe $epoc/lib/eexe.o @objs " . + "$epoc/lib/ecrt0.o $epoc/lib/estlib.lib $epoc/lib/euser.lib"); + +system( "wine \"$epoc/bin/petran.exe $baspe.exe $basname.exe " . + "-nocall -heap 0x00000400 0x00400000 -stack 0x0000c000 " . + "-uid1 0x1000007a -uid2 0x100051d8 -uid3 0x00000000 \" "); + diff --git a/epoc/perl.mmp b/epoc/perl.mmp deleted file mode 100644 index d6c6399..0000000 --- a/epoc/perl.mmp +++ /dev/null @@ -1,20 +0,0 @@ -target perl.exe -targettype exe -uid 0x100051d8 - -project perl5.005 -subproject perl5.005_60 - -SOURCE av.c deb.c doio.c doop.c dump.c globals.c gv.c hv.c mg.c miniperlmain.c op.c perl.c perlio.c perly.c pp.c pp_ctl.c pp_hot.c pp_sys.c regcomp.c regexec.c run.c scope.c sv.c taint.c toke.c universal.c utf8.c util.c epoc.c epoc_stubs.c -systeminclude \epoc32\include\libc \epoc32\include - -#if defined(MARM) -LIBRARY ecrt0.o -#else -LIBRARY ecrt0.obj -#endif - -epocstacksize 49152 -epocheapsize 1024 2097152 - -LIBRARY estlib.lib euser.lib diff --git a/epoc/perl.pkg b/epoc/perl.pkg deleted file mode 100644 index 9456506..0000000 --- a/epoc/perl.pkg +++ /dev/null @@ -1,139 +0,0 @@ -#{"perl5.005"},(0x100051d8),60,10,0 -"\epoc32\release\marm\rel\perl.exe"-"!:\perl.exe" -"\perl5.005\perl5.005_60\epoc\Config.pm"-"!:\perl\lib\5.00560\Config.pm" -"\perl5.005\perl5.005_60\lib\AnyDBM_File.pm"-"!:\perl\lib\5.00560\AnyDBM_File.pm" -"\perl5.005\perl5.005_60\lib\AutoLoader.pm"-"!:\perl\lib\5.00560\AutoLoader.pm" -"\perl5.005\perl5.005_60\lib\AutoSplit.pm"-"!:\perl\lib\5.00560\AutoSplit.pm" -"\perl5.005\perl5.005_60\lib\Benchmark.pm"-"!:\perl\lib\5.00560\Benchmark.pm" -"\perl5.005\perl5.005_60\lib\Carp.pm"-"!:\perl\lib\5.00560\Carp.pm" -"\perl5.005\perl5.005_60\lib\Carp\Heavy.pm"-"!:\perl\lib\5.00560\Carp\Heavy.pm" -"\perl5.005\perl5.005_60\lib\Class\Struct.pm"-"!:\perl\lib\5.00560\Class\Struct.pm" -"\perl5.005\perl5.005_60\lib\Cwd.pm"-"!:\perl\lib\5.00560\Cwd.pm" -"\perl5.005\perl5.005_60\lib\Devel\SelfStubber.pm"-"!:\perl\lib\5.00560\Devel\SelfStubber.pm" -"\perl5.005\perl5.005_60\lib\DirHandle.pm"-"!:\perl\lib\5.00560\DirHandle.pm" -"\perl5.005\perl5.005_60\lib\Dumpvalue.pm"-"!:\perl\lib\5.00560\Dumpvalue.pm" -"\perl5.005\perl5.005_60\lib\English.pm"-"!:\perl\lib\5.00560\English.pm" -"\perl5.005\perl5.005_60\lib\Env.pm"-"!:\perl\lib\5.00560\Env.pm" -"\perl5.005\perl5.005_60\lib\Exporter\Heavy.pm"-"!:\perl\lib\5.00560\Exporter\Heavy.pm" -"\perl5.005\perl5.005_60\lib\Exporter.pm"-"!:\perl\lib\5.00560\Exporter.pm" -"\perl5.005\perl5.005_60\lib\Fatal.pm"-"!:\perl\lib\5.00560\Fatal.pm" -"\perl5.005\perl5.005_60\lib\File\Basename.pm"-"!:\perl\lib\5.00560\File\Basename.pm" -"\perl5.005\perl5.005_60\lib\File\CheckTree.pm"-"!:\perl\lib\5.00560\File\CheckTree.pm" -"\perl5.005\perl5.005_60\lib\File\Compare.pm"-"!:\perl\lib\5.00560\File\Compare.pm" -"\perl5.005\perl5.005_60\lib\File\Copy.pm"-"!:\perl\lib\5.00560\File\Copy.pm" -"\perl5.005\perl5.005_60\lib\File\DosGlob.pm"-"!:\perl\lib\5.00560\File\DosGlob.pm" -"\perl5.005\perl5.005_60\lib\File\Find.pm"-"!:\perl\lib\5.00560\File\Find.pm" -"\perl5.005\perl5.005_60\lib\File\Path.pm"-"!:\perl\lib\5.00560\File\Path.pm" -"\perl5.005\perl5.005_60\lib\File\Spec.pm"-"!:\perl\lib\5.00560\File\Spec.pm" -"\perl5.005\perl5.005_60\lib\File\Spec\Functions.pm"-"!:\perl\lib\5.00560\File\Spec\Functions.pm" -"\perl5.005\perl5.005_60\lib\File\Spec\Mac.pm"-"!:\perl\lib\5.00560\File\Spec\Mac.pm" -"\perl5.005\perl5.005_60\lib\File\Spec\OS2.pm"-"!:\perl\lib\5.00560\File\Spec\OS2.pm" -"\perl5.005\perl5.005_60\lib\File\Spec\Unix.pm"-"!:\perl\lib\5.00560\File\Spec\Unix.pm" -"\perl5.005\perl5.005_60\lib\File\Spec\VMS.pm"-"!:\perl\lib\5.00560\File\Spec\VMS.pm" -"\perl5.005\perl5.005_60\lib\File\Spec\Win32.pm"-"!:\perl\lib\5.00560\File\Spec\Win32.pm" -"\perl5.005\perl5.005_60\lib\File\stat.pm"-"!:\perl\lib\5.00560\File\stat.pm" -"\perl5.005\perl5.005_60\lib\FileCache.pm"-"!:\perl\lib\5.00560\FileCache.pm" -"\perl5.005\perl5.005_60\lib\FileHandle.pm"-"!:\perl\lib\5.00560\FileHandle.pm" -"\perl5.005\perl5.005_60\lib\FindBin.pm"-"!:\perl\lib\5.00560\FindBin.pm" -"\perl5.005\perl5.005_60\lib\Getopt\Long.pm"-"!:\perl\lib\5.00560\Getopt\Long.pm" -"\perl5.005\perl5.005_60\lib\Getopt\Std.pm"-"!:\perl\lib\5.00560\Getopt\Std.pm" -"\perl5.005\perl5.005_60\lib\I18N\Collate.pm"-"!:\perl\lib\5.00560\I18N\Collate.pm" -"\perl5.005\perl5.005_60\lib\Math\BigFloat.pm"-"!:\perl\lib\5.00560\Math\BigFloat.pm" -"\perl5.005\perl5.005_60\lib\Math\BigInt.pm"-"!:\perl\lib\5.00560\Math\BigInt.pm" -"\perl5.005\perl5.005_60\lib\Math\Complex.pm"-"!:\perl\lib\5.00560\Math\Complex.pm" -"\perl5.005\perl5.005_60\lib\Math\Trig.pm"-"!:\perl\lib\5.00560\Math\Trig.pm" -"\perl5.005\perl5.005_60\lib\Pod\Checker.pm"-"!:\perl\lib\5.00560\Pod\Checker.pm" -"\perl5.005\perl5.005_60\lib\Pod\Functions.pm"-"!:\perl\lib\5.00560\Pod\Functions.pm" -"\perl5.005\perl5.005_60\lib\Pod\Html.pm"-"!:\perl\lib\5.00560\Pod\Html.pm" -"\perl5.005\perl5.005_60\lib\Pod\InputObjects.pm"-"!:\perl\lib\5.00560\Pod\InputObjects.pm" -"\perl5.005\perl5.005_60\lib\Pod\Parser.pm"-"!:\perl\lib\5.00560\Pod\Parser.pm" -"\perl5.005\perl5.005_60\lib\Pod\PlainText.pm"-"!:\perl\lib\5.00560\Pod\PlainText.pm" -"\perl5.005\perl5.005_60\lib\Pod\Select.pm"-"!:\perl\lib\5.00560\Pod\Select.pm" -"\perl5.005\perl5.005_60\lib\Pod\Text.pm"-"!:\perl\lib\5.00560\Pod\Text.pm" -"\perl5.005\perl5.005_60\lib\Pod\Text\Color.pm"-"!:\perl\lib\5.00560\Pod\Text\Color.pm" -"\perl5.005\perl5.005_60\lib\Pod\Text\Termcap.pm"-"!:\perl\lib\5.00560\Pod\Text\Termcap.pm" -"\perl5.005\perl5.005_60\lib\Pod\Usage.pm"-"!:\perl\lib\5.00560\Pod\Usage.pm" -"\perl5.005\perl5.005_60\lib\Search\Dict.pm"-"!:\perl\lib\5.00560\Search\Dict.pm" -"\perl5.005\perl5.005_60\lib\SelectSaver.pm"-"!:\perl\lib\5.00560\SelectSaver.pm" -"\perl5.005\perl5.005_60\lib\SelfLoader.pm"-"!:\perl\lib\5.00560\SelfLoader.pm" -"\perl5.005\perl5.005_60\lib\Shell.pm"-"!:\perl\lib\5.00560\Shell.pm" -"\perl5.005\perl5.005_60\lib\Symbol.pm"-"!:\perl\lib\5.00560\Symbol.pm" -"\perl5.005\perl5.005_60\lib\Sys\Hostname.pm"-"!:\perl\lib\5.00560\Sys\Hostname.pm" -"\perl5.005\perl5.005_60\lib\Sys\Syslog.pm"-"!:\perl\lib\5.00560\Sys\Syslog.pm" -"\perl5.005\perl5.005_60\lib\Term\Cap.pm"-"!:\perl\lib\5.00560\Term\Cap.pm" -"\perl5.005\perl5.005_60\lib\Term\Complete.pm"-"!:\perl\lib\5.00560\Term\Complete.pm" -"\perl5.005\perl5.005_60\lib\Term\ReadLine.pm"-"!:\perl\lib\5.00560\Term\ReadLine.pm" -"\perl5.005\perl5.005_60\lib\Test.pm"-"!:\perl\lib\5.00560\Test.pm" -"\perl5.005\perl5.005_60\lib\Test\Harness.pm"-"!:\perl\lib\5.00560\Test\Harness.pm" -"\perl5.005\perl5.005_60\lib\Text\Abbrev.pm"-"!:\perl\lib\5.00560\Text\Abbrev.pm" -"\perl5.005\perl5.005_60\lib\Text\ParseWords.pm"-"!:\perl\lib\5.00560\Text\ParseWords.pm" -"\perl5.005\perl5.005_60\lib\Text\Soundex.pm"-"!:\perl\lib\5.00560\Text\Soundex.pm" -"\perl5.005\perl5.005_60\lib\Text\Tabs.pm"-"!:\perl\lib\5.00560\Text\Tabs.pm" -"\perl5.005\perl5.005_60\lib\Text\Wrap.pm"-"!:\perl\lib\5.00560\Text\Wrap.pm" -"\perl5.005\perl5.005_60\lib\Tie\Array.pm"-"!:\perl\lib\5.00560\Tie\Array.pm" -"\perl5.005\perl5.005_60\lib\Tie\Handle.pm"-"!:\perl\lib\5.00560\Tie\Handle.pm" -"\perl5.005\perl5.005_60\lib\Tie\Hash.pm"-"!:\perl\lib\5.00560\Tie\Hash.pm" -"\perl5.005\perl5.005_60\lib\Tie\RefHash.pm"-"!:\perl\lib\5.00560\Tie\RefHash.pm" -"\perl5.005\perl5.005_60\lib\Tie\Scalar.pm"-"!:\perl\lib\5.00560\Tie\Scalar.pm" -"\perl5.005\perl5.005_60\lib\Tie\SubstrHash.pm"-"!:\perl\lib\5.00560\Tie\SubstrHash.pm" -"\perl5.005\perl5.005_60\lib\Time\Local.pm"-"!:\perl\lib\5.00560\Time\Local.pm" -"\perl5.005\perl5.005_60\lib\Time\gmtime.pm"-"!:\perl\lib\5.00560\Time\gmtime.pm" -"\perl5.005\perl5.005_60\lib\Time\localtime.pm"-"!:\perl\lib\5.00560\Time\localtime.pm" -"\perl5.005\perl5.005_60\lib\Time\tm.pm"-"!:\perl\lib\5.00560\Time\tm.pm" -"\perl5.005\perl5.005_60\lib\UNIVERSAL.pm"-"!:\perl\lib\5.00560\UNIVERSAL.pm" -"\perl5.005\perl5.005_60\lib\abbrev.pl"-"!:\perl\lib\5.00560\abbrev.pl" -"\perl5.005\perl5.005_60\lib\assert.pl"-"!:\perl\lib\5.00560\assert.pl" -"\perl5.005\perl5.005_60\lib\autouse.pm"-"!:\perl\lib\5.00560\autouse.pm" -"\perl5.005\perl5.005_60\lib\base.pm"-"!:\perl\lib\5.00560\base.pm" -"\perl5.005\perl5.005_60\lib\bigfloat.pl"-"!:\perl\lib\5.00560\bigfloat.pl" -"\perl5.005\perl5.005_60\lib\bigint.pl"-"!:\perl\lib\5.00560\bigint.pl" -"\perl5.005\perl5.005_60\lib\bigrat.pl"-"!:\perl\lib\5.00560\bigrat.pl" -"\perl5.005\perl5.005_60\lib\blib.pm"-"!:\perl\lib\5.00560\blib.pm" -"\perl5.005\perl5.005_60\lib\cacheout.pl"-"!:\perl\lib\5.00560\cacheout.pl" -"\perl5.005\perl5.005_60\lib\caller.pm"-"!:\perl\lib\5.00560\caller.pm" -"\perl5.005\perl5.005_60\lib\chat2.pl"-"!:\perl\lib\5.00560\chat2.pl" -"\perl5.005\perl5.005_60\lib\complete.pl"-"!:\perl\lib\5.00560\complete.pl" -"\perl5.005\perl5.005_60\lib\constant.pm"-"!:\perl\lib\5.00560\constant.pm" -"\perl5.005\perl5.005_60\lib\ctime.pl"-"!:\perl\lib\5.00560\ctime.pl" -"\perl5.005\perl5.005_60\lib\diagnostics.pm"-"!:\perl\lib\5.00560\diagnostics.pm" -"\perl5.005\perl5.005_60\lib\dotsh.pl"-"!:\perl\lib\5.00560\dotsh.pl" -"\perl5.005\perl5.005_60\lib\dumpvar.pl"-"!:\perl\lib\5.00560\dumpvar.pl" -"\perl5.005\perl5.005_60\lib\exceptions.pl"-"!:\perl\lib\5.00560\exceptions.pl" -"\perl5.005\perl5.005_60\lib\fastcwd.pl"-"!:\perl\lib\5.00560\fastcwd.pl" -"\perl5.005\perl5.005_60\lib\fields.pm"-"!:\perl\lib\5.00560\fields.pm" -"\perl5.005\perl5.005_60\lib\filetest.pm"-"!:\perl\lib\5.00560\filetest.pm" -"\perl5.005\perl5.005_60\lib\find.pl"-"!:\perl\lib\5.00560\find.pl" -"\perl5.005\perl5.005_60\lib\finddepth.pl"-"!:\perl\lib\5.00560\finddepth.pl" -"\perl5.005\perl5.005_60\lib\flush.pl"-"!:\perl\lib\5.00560\flush.pl" -"\perl5.005\perl5.005_60\lib\ftp.pl"-"!:\perl\lib\5.00560\ftp.pl" -"\perl5.005\perl5.005_60\lib\getcwd.pl"-"!:\perl\lib\5.00560\getcwd.pl" -"\perl5.005\perl5.005_60\lib\getopt.pl"-"!:\perl\lib\5.00560\getopt.pl" -"\perl5.005\perl5.005_60\lib\getopts.pl"-"!:\perl\lib\5.00560\getopts.pl" -"\perl5.005\perl5.005_60\lib\hostname.pl"-"!:\perl\lib\5.00560\hostname.pl" -"\perl5.005\perl5.005_60\lib\importenv.pl"-"!:\perl\lib\5.00560\importenv.pl" -"\perl5.005\perl5.005_60\lib\integer.pm"-"!:\perl\lib\5.00560\integer.pm" -"\perl5.005\perl5.005_60\lib\less.pm"-"!:\perl\lib\5.00560\less.pm" -"\perl5.005\perl5.005_60\lib\lib.pm"-"!:\perl\lib\5.00560\lib.pm" -"\perl5.005\perl5.005_60\lib\locale.pm"-"!:\perl\lib\5.00560\locale.pm" -"\perl5.005\perl5.005_60\lib\look.pl"-"!:\perl\lib\5.00560\look.pl" -"\perl5.005\perl5.005_60\lib\newgetopt.pl"-"!:\perl\lib\5.00560\newgetopt.pl" -"\perl5.005\perl5.005_60\lib\open2.pl"-"!:\perl\lib\5.00560\open2.pl" -"\perl5.005\perl5.005_60\lib\open3.pl"-"!:\perl\lib\5.00560\open3.pl" -"\perl5.005\perl5.005_60\lib\overload.pm"-"!:\perl\lib\5.00560\overload.pm" -"\perl5.005\perl5.005_60\lib\perl5db.pl"-"!:\perl\lib\5.00560\perl5db.pl" -"\perl5.005\perl5.005_60\lib\pwd.pl"-"!:\perl\lib\5.00560\pwd.pl" -"\perl5.005\perl5.005_60\lib\shellwords.pl"-"!:\perl\lib\5.00560\shellwords.pl" -"\perl5.005\perl5.005_60\lib\sigtrap.pm"-"!:\perl\lib\5.00560\sigtrap.pm" -"\perl5.005\perl5.005_60\lib\stat.pl"-"!:\perl\lib\5.00560\stat.pl" -"\perl5.005\perl5.005_60\lib\strict.pm"-"!:\perl\lib\5.00560\strict.pm" -"\perl5.005\perl5.005_60\lib\subs.pm"-"!:\perl\lib\5.00560\subs.pm" -"\perl5.005\perl5.005_60\lib\syslog.pl"-"!:\perl\lib\5.00560\syslog.pl" -"\perl5.005\perl5.005_60\lib\tainted.pl"-"!:\perl\lib\5.00560\tainted.pl" -"\perl5.005\perl5.005_60\lib\termcap.pl"-"!:\perl\lib\5.00560\termcap.pl" -"\perl5.005\perl5.005_60\lib\timelocal.pl"-"!:\perl\lib\5.00560\timelocal.pl" -"\perl5.005\perl5.005_60\lib\utf8.pm"-"!:\perl\lib\5.00560\utf8.pm" -"\perl5.005\perl5.005_60\lib\utf8_heavy.pl"-"!:\perl\lib\5.00560\utf8_heavy.pl" -"\perl5.005\perl5.005_60\lib\validate.pl"-"!:\perl\lib\5.00560\validate.pl" -"\perl5.005\perl5.005_60\lib\vars.pm"-"!:\perl\lib\5.00560\vars.pm" -"\perl5.005\perl5.005_60\lib\warning.pm"-"!:\perl\lib\5.00560\warning.pm" -@"\epoc32\release\marm\rel\stdlib.sis",(0x010002c3) diff --git a/ext/B/B.pm b/ext/B/B.pm index 2187e59..8c46479 100644 --- a/ext/B/B.pm +++ b/ext/B/B.pm @@ -6,9 +6,9 @@ # License or the Artistic License, as specified in the README file. # package B; -require DynaLoader; +use XSLoader (); require Exporter; -@ISA = qw(Exporter DynaLoader); +@ISA = qw(Exporter); @EXPORT_OK = qw(minus_c ppname class peekop cast_I32 cstring cchar hash threadsv_names main_root main_start main_cv svref_2object opnumber amagic_generation @@ -40,7 +40,7 @@ use strict; @B::LOGOP::ISA = 'B::UNOP'; @B::LISTOP::ISA = 'B::BINOP'; @B::SVOP::ISA = 'B::OP'; -@B::GVOP::ISA = 'B::OP'; +@B::PADOP::ISA = 'B::OP'; @B::PVOP::ISA = 'B::OP'; @B::CVOP::ISA = 'B::OP'; @B::LOOP::ISA = 'B::LISTOP'; @@ -259,7 +259,7 @@ sub walksymtable { } } -bootstrap B; +XSLoader::load 'B'; 1; @@ -442,6 +442,8 @@ C (corresponding to the C function C). =item LINE +=item FILE + =item FILEGV =item GvREFCNT @@ -510,7 +512,7 @@ C (corresponding to the C function C). =item GV -=item FILEGV +=item FILE =item DEPTH @@ -549,7 +551,7 @@ C (corresponding to the C function C). =head2 OP-RELATED CLASSES B::OP, B::UNOP, B::BINOP, B::LOGOP, B::LISTOP, B::PMOP, -B::SVOP, B::GVOP, B::PVOP, B::CVOP, B::LOOP, B::COP. +B::SVOP, B::PADOP, B::PVOP, B::CVOP, B::LOOP, B::COP. These classes correspond in the obvious way to the underlying C structures of similar names. The inheritance hierarchy mimics the underlying C "inheritance". Access @@ -648,13 +650,15 @@ This returns the op description from the global C PL_op_desc array =item sv +=item gv + =back -=head2 B::GVOP METHOD +=head2 B::PADOP METHOD =over 4 -=item gv +=item padix =back @@ -686,7 +690,7 @@ This returns the op description from the global C PL_op_desc array =item stash -=item filegv +=item file =item cop_seq diff --git a/ext/B/B.xs b/ext/B/B.xs index 2d6145d..260c0c7 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -56,7 +56,7 @@ typedef enum { OPc_LISTOP, /* 5 */ OPc_PMOP, /* 6 */ OPc_SVOP, /* 7 */ - OPc_GVOP, /* 8 */ + OPc_PADOP, /* 8 */ OPc_PVOP, /* 9 */ OPc_CVOP, /* 10 */ OPc_LOOP, /* 11 */ @@ -72,7 +72,7 @@ static char *opclassnames[] = { "B::LISTOP", "B::PMOP", "B::SVOP", - "B::GVOP", + "B::PADOP", "B::PVOP", "B::CVOP", "B::LOOP", @@ -117,8 +117,8 @@ cc_opclass(pTHX_ OP *o) case OA_SVOP: return OPc_SVOP; - case OA_GVOP: - return OPc_GVOP; + case OA_PADOP: + return OPc_PADOP; case OA_PVOP_OR_SVOP: /* @@ -155,10 +155,10 @@ cc_opclass(pTHX_ OP *o) * return OPc_UNOP so that walkoptree can find our children. If * OPf_KIDS is not set then we check OPf_REF. Without OPf_REF set * (no argument to the operator) it's an OP; with OPf_REF set it's - * a GVOP (and op_gv is the GV for the filehandle argument). + * an SVOP (and op_sv is the GV for the filehandle argument). */ return ((o->op_flags & OPf_KIDS) ? OPc_UNOP : - (o->op_flags & OPf_REF) ? OPc_GVOP : OPc_BASEOP); + (o->op_flags & OPf_REF) ? OPc_SVOP : OPc_BASEOP); case OA_LOOPEXOP: /* @@ -345,7 +345,7 @@ typedef LOGOP *B__LOGOP; typedef LISTOP *B__LISTOP; typedef PMOP *B__PMOP; typedef SVOP *B__SVOP; -typedef GVOP *B__GVOP; +typedef PADOP *B__PADOP; typedef PVOP *B__PVOP; typedef LOOP *B__LOOP; typedef COP *B__COP; @@ -491,10 +491,10 @@ hash(sv) char *s; STRLEN len; U32 hash = 0; - char hexhash[19]; /* must fit "0xffffffff" plus trailing \0 */ + char hexhash[19]; /* must fit "0xffffffffffffffff" plus trailing \0 */ s = SvPV(sv, len); PERL_HASH(hash, s, len); - sprintf(hexhash, "0x%x", hash); + sprintf(hexhash, "0x%"UVxf, (UV)hash); ST(0) = sv_2mortal(newSVpv(hexhash, 0)); #define cast_I32(foo) (I32)foo @@ -575,7 +575,7 @@ char * OP_desc(o) B::OP o -U16 +PADOFFSET OP_targ(o) B::OP o @@ -679,23 +679,38 @@ PMOP_precomp(o) if (rx) sv_setpvn(ST(0), rx->precomp, rx->prelen); -#define SVOP_sv(o) o->op_sv +#define SVOP_sv(o) cSVOPx_sv(o) +#define SVOP_gv(o) cGVOPx_gv(o) MODULE = B PACKAGE = B::SVOP PREFIX = SVOP_ - B::SV SVOP_sv(o) B::SVOP o -#define GVOP_gv(o) o->op_gv +B::GV +SVOP_gv(o) + B::SVOP o + +#define PADOP_padix(o) o->op_padix +#define PADOP_sv(o) (o->op_padix ? PL_curpad[o->op_padix] : Nullsv) +#define PADOP_gv(o) ((o->op_padix \ + && SvTYPE(PL_curpad[o->op_padix]) == SVt_PVGV) \ + ? (GV*)PL_curpad[o->op_padix] : Nullgv) -MODULE = B PACKAGE = B::GVOP PREFIX = GVOP_ +MODULE = B PACKAGE = B::PADOP PREFIX = PADOP_ +PADOFFSET +PADOP_padix(o) + B::PADOP o + +B::SV +PADOP_sv(o) + B::PADOP o B::GV -GVOP_gv(o) - B::GVOP o +PADOP_gv(o) + B::PADOP o MODULE = B PACKAGE = B::PVOP PREFIX = PVOP_ @@ -730,11 +745,12 @@ LOOP_lastop(o) B::LOOP o #define COP_label(o) o->cop_label -#define COP_stash(o) o->cop_stash -#define COP_filegv(o) o->cop_filegv +#define COP_stashpv(o) CopSTASHPV(o) +#define COP_stash(o) CopSTASH(o) +#define COP_file(o) CopFILE(o) #define COP_cop_seq(o) o->cop_seq #define COP_arybase(o) o->cop_arybase -#define COP_line(o) o->cop_line +#define COP_line(o) CopLINE(o) #define COP_warnings(o) o->cop_warnings MODULE = B PACKAGE = B::COP PREFIX = COP_ @@ -743,12 +759,16 @@ char * COP_label(o) B::COP o +char * +COP_stashpv(o) + B::COP o + B::HV COP_stash(o) B::COP o -B::GV -COP_filegv(o) +char * +COP_file(o) B::COP o U32 @@ -1012,6 +1032,10 @@ U16 GvLINE(gv) B::GV gv +char * +GvFILE(gv) + B::GV gv + B::GV GvFILEGV(gv) B::GV gv @@ -1133,8 +1157,8 @@ B::GV CvGV(cv) B::CV cv -B::GV -CvFILEGV(cv) +char * +CvFILE(cv) B::CV cv long diff --git a/ext/B/B/Asmdata.pm b/ext/B/B/Asmdata.pm index 1d0e7ed..a7dbbe2 100644 --- a/ext/B/B/Asmdata.pm +++ b/ext/B/B/Asmdata.pm @@ -14,7 +14,7 @@ use Exporter; @EXPORT_OK = qw(%insn_data @insn_name @optype @specialsv_name); use vars qw(%insn_data @insn_name @optype @specialsv_name); -@optype = qw(OP UNOP BINOP LOGOP LISTOP PMOP SVOP GVOP PVOP LOOP COP); +@optype = qw(OP UNOP BINOP LOGOP LISTOP PMOP SVOP PADOP PVOP LOOP COP); @specialsv_name = qw(Nullsv &PL_sv_undef &PL_sv_yes &PL_sv_no); # XXX insn_data is initialised this way because with a large @@ -68,7 +68,7 @@ $insn_data{xcv_stash} = [44, \&PUT_svindex, "GET_svindex"]; $insn_data{xcv_start} = [45, \&PUT_opindex, "GET_opindex"]; $insn_data{xcv_root} = [46, \&PUT_opindex, "GET_opindex"]; $insn_data{xcv_gv} = [47, \&PUT_svindex, "GET_svindex"]; -$insn_data{xcv_filegv} = [48, \&PUT_svindex, "GET_svindex"]; +$insn_data{xcv_file} = [48, \&PUT_pvcontents, "GET_pvcontents"]; $insn_data{xcv_depth} = [49, \&PUT_I32, "GET_I32"]; $insn_data{xcv_padlist} = [50, \&PUT_svindex, "GET_svindex"]; $insn_data{xcv_outside} = [51, \&PUT_svindex, "GET_svindex"]; @@ -95,7 +95,7 @@ $insn_data{gp_refcnt_add} = [71, \&PUT_I32, "GET_I32"]; $insn_data{gp_av} = [72, \&PUT_svindex, "GET_svindex"]; $insn_data{gp_hv} = [73, \&PUT_svindex, "GET_svindex"]; $insn_data{gp_cv} = [74, \&PUT_svindex, "GET_svindex"]; -$insn_data{gp_filegv} = [75, \&PUT_svindex, "GET_svindex"]; +$insn_data{gp_file} = [75, \&PUT_pvcontents, "GET_pvcontents"]; $insn_data{gp_io} = [76, \&PUT_svindex, "GET_svindex"]; $insn_data{gp_form} = [77, \&PUT_svindex, "GET_svindex"]; $insn_data{gp_cvgen} = [78, \&PUT_U32, "GET_U32"]; @@ -122,15 +122,15 @@ $insn_data{pregcomp} = [98, \&PUT_pvcontents, "GET_pvcontents"]; $insn_data{op_pmflags} = [99, \&PUT_U16, "GET_U16"]; $insn_data{op_pmpermflags} = [100, \&PUT_U16, "GET_U16"]; $insn_data{op_sv} = [101, \&PUT_svindex, "GET_svindex"]; -$insn_data{op_gv} = [102, \&PUT_svindex, "GET_svindex"]; +$insn_data{op_padix} = [102, \&PUT_U32, "GET_U32"]; $insn_data{op_pv} = [103, \&PUT_pvcontents, "GET_pvcontents"]; $insn_data{op_pv_tr} = [104, \&PUT_op_tr_array, "GET_op_tr_array"]; $insn_data{op_redoop} = [105, \&PUT_opindex, "GET_opindex"]; $insn_data{op_nextop} = [106, \&PUT_opindex, "GET_opindex"]; $insn_data{op_lastop} = [107, \&PUT_opindex, "GET_opindex"]; $insn_data{cop_label} = [108, \&PUT_pvcontents, "GET_pvcontents"]; -$insn_data{cop_stash} = [109, \&PUT_svindex, "GET_svindex"]; -$insn_data{cop_filegv} = [110, \&PUT_svindex, "GET_svindex"]; +$insn_data{cop_stashpv} = [109, \&PUT_pvcontents, "GET_pvcontents"]; +$insn_data{cop_file} = [110, \&PUT_pvcontents, "GET_pvcontents"]; $insn_data{cop_seq} = [111, \&PUT_U32, "GET_U32"]; $insn_data{cop_arybase} = [112, \&PUT_I32, "GET_I32"]; $insn_data{cop_line} = [113, \&PUT_U16, "GET_U16"]; diff --git a/ext/B/B/Bytecode.pm b/ext/B/B/Bytecode.pm index 5694531..cb061f3 100644 --- a/ext/B/B/Bytecode.pm +++ b/ext/B/B/Bytecode.pm @@ -226,13 +226,11 @@ sub B::SVOP::bytecode { $sv->bytecode; } -sub B::GVOP::bytecode { +sub B::PADOP::bytecode { my $op = shift; - my $gv = $op->gv; - my $gvix = $gv->objix; + my $padix = $op->padix; $op->B::OP::bytecode; - print "op_gv $gvix\n"; - $gv->bytecode; + print "op_padix $padix\n"; } sub B::PVOP::bytecode { @@ -280,29 +278,27 @@ sub B::LOOP::bytecode { sub B::COP::bytecode { my $op = shift; - my $stash = $op->stash; - my $stashix = $stash->objix; - my $filegv = $op->filegv; - my $filegvix = $filegv->objix; + my $stashpv = $op->stashpv; + my $file = $op->file; my $line = $op->line; my $warnings = $op->warnings; my $warningsix = $warnings->objix; if ($debug_bc) { - printf "# line %s:%d\n", $filegv->SV->PV, $line; + printf "# line %s:%d\n", $file, $line; } $op->B::OP::bytecode; - printf <<"EOT", pvstring($op->label), $op->cop_seq, $op->arybase; + printf <<"EOT", pvstring($op->label), pvstring($stashpv), $op->cop_seq, pvstring($file), $op->arybase; newpv %s cop_label -cop_stash $stashix +newpv %s +cop_stashpv cop_seq %d -cop_filegv $filegvix +newpv %s +cop_file cop_arybase %d cop_line $line cop_warnings $warningsix EOT - $filegv->bytecode; - $stash->bytecode; } sub B::PMOP::bytecode { @@ -472,10 +468,12 @@ sub B::GV::bytecode { my $egv = $gv->EGV; my $egvix = $egv->objix; ldsv($ix); - printf <<"EOT", $gv->FLAGS, $gv->GvFLAGS, $gv->LINE; + printf <<"EOT", $gv->FLAGS, $gv->GvFLAGS, $gv->LINE, pvstring($gv->FILE); sv_flags 0x%x xgv_flags 0x%x gp_line %d +newpv %s +gp_file EOT my $refcnt = $gv->REFCNT; printf("sv_refcnt_add %d\n", $refcnt - 1) if $refcnt > 1; @@ -486,7 +484,7 @@ EOT } else { if ($gvname !~ /^([^A-Za-z]|STDIN|STDOUT|STDERR|ARGV|SIG|ENV)$/) { my $i; - my @subfield_names = qw(SV AV HV CV FILEGV FORM IO); + my @subfield_names = qw(SV AV HV CV FORM IO); my @subfields = map($gv->$_(), @subfield_names); my @ixes = map($_->objix, @subfields); # Reset sv register for $gv @@ -569,7 +567,7 @@ sub B::CV::bytecode { my $ix = $cv->objix; $cv->B::PVMG::bytecode; my $i; - my @subfield_names = qw(ROOT START STASH GV FILEGV PADLIST OUTSIDE); + my @subfield_names = qw(ROOT START STASH GV PADLIST OUTSIDE); my @subfields = map($cv->$_(), @subfield_names); my @ixes = map($_->objix, @subfields); # Save OP tree from CvROOT (first element of @subfields) @@ -583,6 +581,7 @@ sub B::CV::bytecode { printf "xcv_%s %d\n", lc($subfield_names[$i]), $ixes[$i]; } printf "xcv_depth %d\nxcv_flags 0x%x\n", $cv->DEPTH, $cv->FLAGS; + printf "newpv %s\nxcv_file\n", pvstring($cv->FILE); # Now save all the subfields (except for CvROOT which was handled # above) and CvSTART (now the initial element of @subfields). shift @subfields; # bye-bye CvSTART @@ -705,6 +704,10 @@ sub compile { $arg ||= shift @options; open(OUT, ">$arg") or return "$arg: $!\n"; binmode OUT; + } elsif ($opt eq "a") { + $arg ||= shift @options; + open(OUT, ">>$arg") or return "$arg: $!\n"; + binmode OUT; } elsif ($opt eq "D") { $arg ||= shift @options; foreach $arg (split(//, $arg)) { @@ -814,6 +817,10 @@ extra arguments, it saves the main program. Output to filename instead of STDOUT. +=item B<-afilename> + +Append output to filename. + =item B<--> Force end of options. diff --git a/ext/B/B/C.pm b/ext/B/B/C.pm index b9e005b..6e3af0d 100644 --- a/ext/B/B/C.pm +++ b/ext/B/B/C.pm @@ -83,7 +83,7 @@ BEGIN { # Code sections my ($init, $decl, $symsect, $binopsect, $condopsect, $copsect, - $gvopsect, $listopsect, $logopsect, $loopsect, $opsect, $pmopsect, + $padopsect, $listopsect, $logopsect, $loopsect, $opsect, $pmopsect, $pvopsect, $svopsect, $unopsect, $svsect, $xpvsect, $xpvavsect, $xpvhvsect, $xpvcvsect, $xpvivsect, $xpvnvsect, $xpvmgsect, $xpvlvsect, $xrvsect, $xpvbmsect, $xpviosect ); @@ -269,33 +269,32 @@ sub B::SVOP::save { my $sym = objsym($op); return $sym if defined $sym; my $svsym = $op->sv->save; - $svopsect->add(sprintf("s\\_%x, s\\_%x, %s,$handle_VC_problem %u, %u, %u, 0x%x, 0x%x, %s", + $svopsect->add(sprintf("s\\_%x, s\\_%x, %s,$handle_VC_problem %u, %u, %u, 0x%x, 0x%x, Nullsv", ${$op->next}, ${$op->sibling}, $op->ppaddr, $op->targ, $op->type, $op_seq, $op->flags, - $op->private, "(SV*)$svsym")); + $op->private)); + $init->add(sprintf("svop_list[%d].op_sv = %s;", $svopsect->index, "(SV*)$svsym")); savesym($op, sprintf("(OP*)&svop_list[%d]", $svopsect->index)); } -sub B::GVOP::save { +sub B::PADOP::save { my ($op, $level) = @_; my $sym = objsym($op); return $sym if defined $sym; - my $gvsym = $op->gv->save; - $gvopsect->add(sprintf("s\\_%x, s\\_%x, %s,$handle_VC_problem %u, %u, %u, 0x%x, 0x%x, Nullgv", + $padopsect->add(sprintf("s\\_%x, s\\_%x, %s,$handle_VC_problem %u, %u, %u, 0x%x, 0x%x, Nullgv", ${$op->next}, ${$op->sibling}, $op->ppaddr, $op->targ, $op->type, $op_seq, $op->flags, $op->private)); - $init->add(sprintf("gvop_list[%d].op_gv = %s;", $gvopsect->index, $gvsym)); - savesym($op, sprintf("(OP*)&gvop_list[%d]", $gvopsect->index)); + $init->add(sprintf("padop_list[%d].op_padix = %ld;", + $padopsect->index, $op->padix)); + savesym($op, sprintf("(OP*)&padop_list[%d]", $padopsect->index)); } sub B::COP::save { my ($op, $level) = @_; my $sym = objsym($op); return $sym if defined $sym; - my $gvsym = $op->filegv->save; - my $stashsym = $op->stash->save; - warn sprintf("COP: line %d file %s\n", $op->line, $op->filegv->SV->PV) + warn sprintf("COP: line %d file %s\n", $op->line, $op->file) if $debug_cops; $copsect->add(sprintf("s\\_%x, s\\_%x, %s,$handle_VC_problem %u, %u, %u, 0x%x, 0x%x, %s, Nullhv, Nullgv, %u, %d, %u", ${$op->next}, ${$op->sibling}, $op->ppaddr, @@ -303,8 +302,8 @@ sub B::COP::save { $op->private, cstring($op->label), $op->cop_seq, $op->arybase, $op->line)); my $copix = $copsect->index; - $init->add(sprintf("cop_list[%d].cop_filegv = %s;", $copix, $gvsym), - sprintf("cop_list[%d].cop_stash = %s;", $copix, $stashsym)); + $init->add(sprintf("CopFILE_set(&cop_list[%d], %s);", $copix, cstring($op->file)), + sprintf("CopSTASHPV_set(&cop_list[%d], %s);", $copix, cstring($op->stashpv))); savesym($op, "(OP*)&cop_list[$copix]"); } @@ -595,8 +594,11 @@ sub B::CV::save { } # Reserve a place in svsect and xpvcvsect and record indices my $gv = $cv->GV; - my $cvstashname = $gv->STASH->NAME; - my $cvname = $gv->NAME; + my ($cvname, $cvstashname); + if ($$gv){ + $cvname = $gv->NAME; + $cvstashname = $gv->STASH->NAME; + } my $root = $cv->ROOT; my $cvxsub = $cv->XSUB; #INIT is removed from the symbol table, so this call must come @@ -607,7 +609,7 @@ sub B::CV::save { my $stashname = $egv->STASH->NAME; if ($cvname eq "bootstrap") { - my $file = $cv->FILEGV->SV->PV; + my $file = $gv->FILE; $decl->add("/* bootstrap $file */"); warn "Bootstrap $stashname $file\n"; $xsub{$stashname}='Dynamic'; @@ -681,7 +683,7 @@ sub B::CV::save { $cvstashname, $cvname); # debug } $pv = '' unless defined $pv; # Avoid use of undef warnings - $symsect->add(sprintf("xpvcvix%d\t%s, %u, 0, %d, %s, 0, Nullhv, Nullhv, %s, s\\_%x, $xsub, $xsubany, Nullgv, Nullgv, %d, s\\_%x, (CV*)s\\_%x, 0x%x", + $symsect->add(sprintf("xpvcvix%d\t%s, %u, 0, %d, %s, 0, Nullhv, Nullhv, %s, s\\_%x, $xsub, $xsubany, Nullgv, \"\", %d, s\\_%x, (CV*)s\\_%x, 0x%x", $xpvcv_ix, cstring($pv), length($pv), $cv->IVX, $cv->NVX, $startfield, ${$cv->ROOT}, $cv->DEPTH, $$padlist, ${$cv->OUTSIDE}, $cv->CvFLAGS)); @@ -697,13 +699,7 @@ sub B::CV::save { warn sprintf("done saving GV 0x%x for CV 0x%x\n", $$gv, $$cv) if $debug_cv; } - my $filegv = $cv->FILEGV; - if ($$filegv) { - $filegv->save; - $init->add(sprintf("CvFILEGV(s\\_%x) = s\\_%x;", $$cv, $$filegv)); - warn sprintf("done saving FILEGV 0x%x for CV 0x%x\n", - $$filegv, $$cv) if $debug_cv; - } + $init->add(sprintf("CvFILE($sym) = %s;", cstring($cv->FILE))); my $stash = $cv->STASH; if ($$stash) { $stash->save; @@ -790,12 +786,8 @@ sub B::GV::save { # warn "GV::save &$name\n"; # debug } } - my $gvfilegv = $gv->FILEGV; - if ($$gvfilegv) { - $gvfilegv->save; - $init->add(sprintf("GvFILEGV($sym) = (GV*)s\\_%x;",$$gvfilegv)); -# warn "GV::save GvFILEGV(*$name)\n"; # debug - } + $init->add(sprintf("GvFILE($sym) = %s;", cstring($gv->FILE))); +# warn "GV::save GvFILE(*$name)\n"; # debug my $gvform = $gv->FORM; if ($$gvform) { $gvform->save; @@ -948,7 +940,7 @@ sub output_all { my $init_name = shift; my $section; my @sections = ($opsect, $unopsect, $binopsect, $logopsect, $condopsect, - $listopsect, $pmopsect, $svopsect, $gvopsect, $pvopsect, + $listopsect, $pmopsect, $svopsect, $padopsect, $pvopsect, $loopsect, $copsect, $svsect, $xpvsect, $xpvavsect, $xpvhvsect, $xpvcvsect, $xpvivsect, $xpvnvsect, $xpvmgsect, $xpvlvsect, $xrvsect, $xpvbmsect, $xpviosect); @@ -1019,8 +1011,8 @@ typedef struct { void (*xcv_xsub) (CV*); void * xcv_xsubany; GV * xcv_gv; - GV * xcv_filegv; - long xcv_depth; /* >= 2 indicates recursive call */ + char * xcv_file; + long xcv_depth; /* >= 2 indicates recursive call */ AV * xcv_padlist; CV * xcv_outside; #ifdef USE_THREADS @@ -1054,10 +1046,10 @@ sub output_boilerplate { #undef Perl_pp_mapstart #define Perl_pp_mapstart Perl_pp_grepstart #define XS_DynaLoader_boot_DynaLoader boot_DynaLoader -EXTERN_C void boot_DynaLoader (CV* cv); +EXTERN_C void boot_DynaLoader (pTHX_ CV* cv); -static void xs_init (void); -static void dl_init (void); +static void xs_init (pTHX); +static void dl_init (pTHX); static PerlInterpreter *my_perl; EOT } @@ -1065,28 +1057,20 @@ EOT sub output_main { print <<'EOT'; int -#ifndef CAN_PROTOTYPE -main(argc, argv, env) -int argc; -char **argv; -char **env; -#else /* def(CAN_PROTOTYPE) */ main(int argc, char **argv, char **env) -#endif /* def(CAN_PROTOTYPE) */ { int exitstatus; int i; char **fakeargv; - PERL_SYS_INIT(&argc,&argv); + PERL_SYS_INIT3(&argc,&argv,&env); - perl_init_i18nl10n(1); - if (!PL_do_undump) { my_perl = perl_alloc(); if (!my_perl) exit(1); perl_construct( my_perl ); + PL_perl_destruct_level = 0; } #ifdef CSH @@ -1122,19 +1106,21 @@ main(int argc, char **argv, char **env) exitstatus = perl_init(); if (exitstatus) exit( exitstatus ); - dl_init(); + dl_init(aTHX); exitstatus = perl_run( my_perl ); perl_destruct( my_perl ); perl_free( my_perl ); + PERL_SYS_TERM(); + exit( exitstatus ); } /* yanked from perl.c */ static void -xs_init() +xs_init(pTHX) { char *file = __FILE__; dTARG; @@ -1151,7 +1137,7 @@ EOT print "\tPUSHMARK(sp);\n"; print qq/\tXPUSHp("DynaLoader",strlen("DynaLoader"));\n/; print qq/\tPUTBACK;\n/; - print "\tboot_DynaLoader(NULL);\n"; + print "\tboot_DynaLoader(aTHX_ NULL);\n"; print qq/\tSPAGAIN;\n/; print "#endif\n"; foreach my $stashname (keys %xsub){ @@ -1161,7 +1147,7 @@ EOT print "\tPUSHMARK(sp);\n"; print qq/\tXPUSHp("$stashname",strlen("$stashname"));\n/; print qq/\tPUTBACK;\n/; - print "\tboot_$stashxsub(NULL);\n"; + print "\tboot_$stashxsub(aTHX_ NULL);\n"; print qq/\tSPAGAIN;\n/; } } @@ -1170,7 +1156,7 @@ EOT print <<'EOT'; static void -dl_init() +dl_init(pTHX) { char *file = __FILE__; dTARG; @@ -1190,7 +1176,7 @@ EOT warn "bootstrapping $stashname added to xs_init\n"; print qq/\tperl_call_method("bootstrap",G_DISCARD);\n/; print "\n#else\n"; - print "\tboot_$stashxsub(NULL);\n"; + print "\tboot_$stashxsub(aTHX_ NULL);\n"; print "#endif\n"; print qq/\tSPAGAIN;\n/; } @@ -1243,7 +1229,7 @@ sub mark_package { no strict 'refs'; $unused_sub_packages{$package} = 1; - if (@{$package.'::ISA'}) + if (defined @{$package.'::ISA'}) { foreach my $isa (@{$package.'::ISA'}) { @@ -1396,7 +1382,7 @@ sub save_main { sub init_sections { my @sections = (init => \$init, decl => \$decl, sym => \$symsect, binop => \$binopsect, condop => \$condopsect, - cop => \$copsect, gvop => \$gvopsect, + cop => \$copsect, padop => \$padopsect, listop => \$listopsect, logop => \$logopsect, loop => \$loopsect, op => \$opsect, pmop => \$pmopsect, pvop => \$pvopsect, svop => \$svopsect, unop => \$unopsect, diff --git a/ext/B/B/CC.pm b/ext/B/B/CC.pm index 1c31599..cf0e81f 100644 --- a/ext/B/B/CC.pm +++ b/ext/B/B/CC.pm @@ -374,7 +374,7 @@ sub dopoptolabel { sub error { my $format = shift; - my $file = $curcop->[0]->filegv->SV->PV; + my $file = $curcop->[0]->file; my $line = $curcop->[0]->line; $errors++; if (@_) { @@ -598,7 +598,7 @@ sub pp_nextstate { my $op = shift; $curcop->load($op); @stack = (); - debug(sprintf("%s:%d\n", $op->filegv->SV->PV, $op->line)) if $debug_lineno; + debug(sprintf("%s:%d\n", $op->file, $op->line)) if $debug_lineno; runtime("TAINT_NOT;") unless $omit_taint; runtime("sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;"); if ($freetmps_each_bblock || $freetmps_each_loop) { @@ -1644,8 +1644,8 @@ XS(boot_$cmodule) perl_init(); ENTER; SAVETMPS; - SAVESPTR(PL_curpad); - SAVESPTR(PL_op); + SAVEVPTR(PL_curpad); + SAVEVPTR(PL_op); PL_curpad = AvARRAY($curpad_sym); PL_op = $start; pp_main(aTHX); diff --git a/ext/B/B/Debug.pm b/ext/B/B/Debug.pm index 8910068..ae7a973 100644 --- a/ext/B/B/Debug.pm +++ b/ext/B/B/Debug.pm @@ -60,17 +60,15 @@ sub B::PMOP::debug { sub B::COP::debug { my ($op) = @_; $op->B::OP::debug(); - my ($filegv) = $op->filegv; - printf <<'EOT', $op->label, ${$op->stash}, $$filegv, $op->seq, $op->arybase, $op->line, ${$op->warnings}; + printf <<'EOT', $op->label, $op->stashpv, $op->file, $op->seq, $op->arybase, $op->line, ${$op->warnings}; cop_label %s - cop_stash 0x%x - cop_filegv 0x%x + cop_stashpv %s + cop_file %s cop_seq %d cop_arybase %d cop_line %d cop_warnings 0x%x EOT - $filegv->debug; } sub B::SVOP::debug { @@ -86,11 +84,10 @@ sub B::PVOP::debug { printf "\top_pv\t\t0x%x\n", $op->pv; } -sub B::GVOP::debug { +sub B::PADOP::debug { my ($op) = @_; $op->B::OP::debug(); - printf "\top_gv\t\t0x%x\n", ${$op->gv}; - $op->gv->debug; + printf "\top_padix\t\t%ld\n", $op->padix; } sub B::CVOP::debug { @@ -178,14 +175,14 @@ sub B::CV::debug { my ($start) = $sv->START; my ($root) = $sv->ROOT; my ($padlist) = $sv->PADLIST; + my ($file) = $sv->FILE; my ($gv) = $sv->GV; - my ($filegv) = $sv->FILEGV; - printf <<'EOT', $$stash, $$start, $$root, $$gv, $$filegv, $sv->DEPTH, $padlist, ${$sv->OUTSIDE}; + printf <<'EOT', $$stash, $$start, $$root, $$gv, $file, $sv->DEPTH, $padlist, ${$sv->OUTSIDE}; STASH 0x%x START 0x%x ROOT 0x%x GV 0x%x - FILEGV 0x%x + FILE %s DEPTH %d PADLIST 0x%x OUTSIDE 0x%x @@ -193,7 +190,6 @@ EOT $start->debug if $start; $root->debug if $root; $gv->debug if $gv; - $filegv->debug if $filegv; $padlist->debug if $padlist; } @@ -220,7 +216,7 @@ sub B::GV::debug { my ($av) = $gv->AV; my ($cv) = $gv->CV; $gv->B::SV::debug; - printf <<'EOT', $gv->NAME, $gv->STASH->NAME, $gv->STASH, $$sv, $gv->GvREFCNT, $gv->FORM, $$av, ${$gv->HV}, ${$gv->EGV}, $$cv, $gv->CVGEN, $gv->LINE, $gv->FILEGV, $gv->GvFLAGS; + printf <<'EOT', $gv->NAME, $gv->STASH->NAME, $gv->STASH, $$sv, $gv->GvREFCNT, $gv->FORM, $$av, ${$gv->HV}, ${$gv->EGV}, $$cv, $gv->CVGEN, $gv->LINE, $gv->FILE, $gv->GvFLAGS; NAME %s STASH %s (0x%x) SV 0x%x @@ -232,7 +228,7 @@ sub B::GV::debug { CV 0x%x CVGEN %d LINE %d - FILEGV 0x%x + FILE %s GvFLAGS 0x%x EOT $sv->debug if $sv; diff --git a/ext/B/B/Deparse.pm b/ext/B/B/Deparse.pm index ede68f5..be7088e 100644 --- a/ext/B/B/Deparse.pm +++ b/ext/B/B/Deparse.pm @@ -770,14 +770,14 @@ sub pp_nextstate { and $seq > $self->{'subs_todo'}[0][0]) { push @text, $self->next_todo; } - my $stash = $op->stash->NAME; + my $stash = $op->stashpv; if ($stash ne $self->{'curstash'}) { push @text, "package $stash;\n"; $self->{'curstash'} = $stash; } if ($self->{'linenums'}) { push @text, "\f#line " . $op->line . - ' "' . substr($op->filegv->NAME, 2), qq'"\n'; + ' "' . $op->file, qq'"\n'; } return join("", @text); } @@ -1109,7 +1109,7 @@ sub ftst { # Genuine `-X' filetests are exempt from the LLAFR, but not # l?stat(); for the sake of clarity, give'em all parens return $self->maybe_parens_unop($name, $op->first, $cx); - } elsif (class($op) eq "GVOP") { + } elsif (class($op) eq "SVOP") { return $self->maybe_parens_func($name, $self->pp_gv($op, 1), $cx, 16); } else { # I don't think baseop filetests ever survive ck_ftst, but... return $name; diff --git a/ext/B/B/Lint.pm b/ext/B/B/Lint.pm index 67abe3d..ed0d07d 100644 --- a/ext/B/B/Lint.pm +++ b/ext/B/B/Lint.pm @@ -172,7 +172,7 @@ sub B::OP::lint {} sub B::COP::lint { my $op = shift; if ($op->name eq "nextstate") { - $file = $op->filegv->SV->PV; + $file = $op->file; $line = $op->line; $curstash = $op->stash->NAME; } @@ -232,7 +232,7 @@ sub B::LOOP::lint { } } -sub B::GVOP::lint { +sub B::SVOP::lint { my $op = shift; if ($check{dollar_underscore} && $op->name eq "gvsv" && $op->gv->NAME eq "_") @@ -241,11 +241,11 @@ sub B::GVOP::lint { } if ($check{private_names}) { my $opname = $op->name; - my $gv = $op->gv; - if (($opname eq "gv" || $opname eq "gvsv") - && $gv->NAME =~ /^_./ && $gv->STASH->NAME ne $curstash) - { - warning('Illegal reference to private name %s', $gv->NAME); + if ($opname eq "gv" || $opname eq "gvsv") { + my $gv = $op->gv; + if ($gv->NAME =~ /^_./ && $gv->STASH->NAME ne $curstash) { + warning('Illegal reference to private name %s', $gv->NAME); + } } } if ($check{undefined_subs}) { diff --git a/ext/B/B/Stash.pm b/ext/B/B/Stash.pm index 828ffac..d992a89 100644 --- a/ext/B/B/Stash.pm +++ b/ext/B/B/Stash.pm @@ -4,7 +4,7 @@ package B::Stash; BEGIN { %Seen = %INC } -END { +STOP { my @arr=scan($main::{"main::"}); @arr=map{s/\:\:$//;$_;} @arr; print "-umain,-u", join (",-u",@arr) ,"\n"; diff --git a/ext/B/B/Terse.pm b/ext/B/B/Terse.pm index bc9d943..66b5cfc 100644 --- a/ext/B/B/Terse.pm +++ b/ext/B/B/Terse.pm @@ -54,10 +54,9 @@ sub B::SVOP::terse { $op->sv->terse(0); } -sub B::GVOP::terse { +sub B::PADOP::terse { my ($op, $level) = @_; - print indent($level), peekop($op), " "; - $op->gv->terse(0); + print indent($level), peekop($op), " ", $op->padix, "\n"; } sub B::PMOP::terse { diff --git a/ext/B/B/Xref.pm b/ext/B/B/Xref.pm index 06159a4..53b655c 100644 --- a/ext/B/B/Xref.pm +++ b/ext/B/B/Xref.pm @@ -201,7 +201,7 @@ sub xref_main { sub pp_nextstate { my $op = shift; - $file = $op->filegv->SV->PV; + $file = $op->file; $line = $op->line; $top = UNKNOWN; } @@ -272,7 +272,7 @@ sub B::GV::xref { my $cv = $gv->CV; if ($$cv) { #return if $done{$$cv}++; - $file = $gv->FILEGV->SV->PV; + $file = $gv->FILE; $line = $gv->LINE; process([$gv->STASH->NAME, "&", $gv->NAME], "subdef"); push(@todo, $cv); @@ -280,7 +280,7 @@ sub B::GV::xref { my $form = $gv->FORM; if ($$form) { return if $done{$$form}++; - $file = $gv->FILEGV->SV->PV; + $file = $gv->FILE; $line = $gv->LINE; process([$gv->STASH->NAME, "", $gv->NAME], "formdef"); } diff --git a/ext/B/Makefile.PL b/ext/B/Makefile.PL index dcff65a..cb9696b 100644 --- a/ext/B/Makefile.PL +++ b/ext/B/Makefile.PL @@ -26,7 +26,7 @@ WriteMakefile( package MY; sub post_constants { - "\nLIBS = $Config{libs}\n" + "\nLIBS = $Config::Config{libs}\n" } sub postamble { diff --git a/ext/B/NOTES b/ext/B/NOTES index ee10ba0..8309892 100644 --- a/ext/B/NOTES +++ b/ext/B/NOTES @@ -161,8 +161,8 @@ O module it should return a sub ref (usually a closure) to perform the actual compilation. When O regains control, it ensures that the "-c" option is forced (so that the program being compiled doesn't - end up running) and registers an END block to call back the sub ref + end up running) and registers a STOP block to call back the sub ref returned from the backend's compile(). Perl then continues by parsing prog.pl (just as it would with "perl -c prog.pl") and after - doing so, assuming there are no parse-time errors, the END block + doing so, assuming there are no parse-time errors, the STOP block of O gets called and the actual backend compilation happens. Phew. diff --git a/ext/B/O.pm b/ext/B/O.pm index ad391a3..d07c4a5 100644 --- a/ext/B/O.pm +++ b/ext/B/O.pm @@ -11,7 +11,7 @@ sub import { my $compilesub = &{"B::${backend}::compile"}(@options); if (ref($compilesub) eq "CODE") { minus_c; - eval 'END { &$compilesub() }'; + eval 'STOP { &$compilesub() }'; } else { die $compilesub; } @@ -59,7 +59,7 @@ C module and calls the C function in that package, passing it OPTIONS. That function is expected to return a sub reference which we'll call CALLBACK. Next, the "compile-only" flag is switched on (equivalent to the command-line option C<-c>) -and an END block is registered which calls CALLBACK. Thus the main +and a STOP block is registered which calls CALLBACK. Thus the main Perl program mentioned on the command-line is read in, parsed and compiled into internal syntax tree form. Since the C<-c> flag is set, the program does not start running (excepting BEGIN blocks of diff --git a/ext/B/defsubs_h.PL b/ext/B/defsubs_h.PL index 8dfa3a5..80ef936 100644 --- a/ext/B/defsubs_h.PL +++ b/ext/B/defsubs_h.PL @@ -2,11 +2,10 @@ # this file as a template for defsubs.h # Extracting defsubs.h (with variable substitutions) #!perl -my ($out) = __FILE__ =~ /(^.*)\.PL/; -if ($^O eq 'VMS') { ($out) = __FILE__ =~ /^(.+)_PL$/i; } +my ($out) = __FILE__ =~ /(^.*)\.PL/i; $out =~ s/_h$/.h/; open(OUT,">$out") || die "Cannot open $file:$!"; -print "Extracting $out . . .\n"; +print "Extracting $out...\n"; foreach my $const (qw(AVf_REAL HEf_SVKEY SVf_IOK SVf_IVisUV SVf_NOK SVf_POK diff --git a/ext/B/ramblings/runtime.porting b/ext/B/ramblings/runtime.porting index 4699b25..d58b011 100644 --- a/ext/B/ramblings/runtime.porting +++ b/ext/B/ramblings/runtime.porting @@ -33,8 +33,10 @@ glob 5 2 do_readline readline 8 2 do_readline rcatline 8 2 regcmaybe 8 1 +regcreset 8 1 regcomp 8 9 pregcomp match 8 10 +qr 8 1 subst 8 10 substcont 8 7 trans 7 4 do_trans @@ -170,6 +172,7 @@ orassign 7 3 modifies flow of control method 8 5 entersub 10 7 leavesub 10 5 +leavesublv caller 2 8 warn 9 3 die 9 3 @@ -212,6 +215,7 @@ leavewrite 4 5 prtf 4 4 do_sprintf print 8 6 sysopen 8 2 +sysseek 8 2 sysread 8 4 syswrite 8 4 pp_send send 8 4 @@ -347,4 +351,7 @@ sgrent egrent getlogin syscall - \ No newline at end of file +lock 6 1 +threadsv 6 2 unused if not USE_THREADS +setstate 1 1 currently unused anywhere +method_named 10 2 diff --git a/ext/B/typemap b/ext/B/typemap index febadf8..bafba1c 100644 --- a/ext/B/typemap +++ b/ext/B/typemap @@ -7,7 +7,7 @@ B::LOGOP T_OP_OBJ B::LISTOP T_OP_OBJ B::PMOP T_OP_OBJ B::SVOP T_OP_OBJ -B::GVOP T_OP_OBJ +B::PADOP T_OP_OBJ B::PVOP T_OP_OBJ B::CVOP T_OP_OBJ B::LOOP T_OP_OBJ @@ -30,6 +30,7 @@ B::IO T_SV_OBJ B::MAGIC T_MG_OBJ SSize_t T_IV STRLEN T_IV +PADOFFSET T_UV INPUT T_OP_OBJ diff --git a/ext/ByteLoader/ByteLoader.pm b/ext/ByteLoader/ByteLoader.pm index 4687010..286d746 100644 --- a/ext/ByteLoader/ByteLoader.pm +++ b/ext/ByteLoader/ByteLoader.pm @@ -1,12 +1,10 @@ package ByteLoader; -require DynaLoader; - -@ISA = qw(DynaLoader); +use XSLoader (); $VERSION = 0.03; -bootstrap ByteLoader $VERSION; +XSLoader::load 'ByteLoader', $VERSION; # Preloaded methods go here. diff --git a/ext/ByteLoader/ByteLoader.xs b/ext/ByteLoader/ByteLoader.xs index c9d7d16..7c3746b 100644 --- a/ext/ByteLoader/ByteLoader.xs +++ b/ext/ByteLoader/ByteLoader.xs @@ -4,12 +4,22 @@ #include "XSUB.h" #include "byterun.h" -#ifdef NEED_FGETC_PROTOTYPE -extern int fgetc(); -#endif -#ifdef NEED_FREAD_PROTOTYPE -extern int fread(); -#endif +static int +xgetc(PerlIO *io) +{ + dTHX; + return PerlIO_getc(io); +} + +static int +xfread(char *buf, size_t size, size_t n, PerlIO *io) +{ + dTHX; + int i = PerlIO_read(io, buf, n * size); + if (i > 0) + i /= size; + return i; +} static void freadpv(U32 len, void *data, XPV *pv) @@ -30,8 +40,8 @@ byteloader_filter(pTHXo_ int idx, SV *buf_sv, int maxlen) struct bytestream bs; bs.data = PL_rsfp; - bs.pfgetc = (int(*) (void*))fgetc; - bs.pfread = (int(*) (char*,size_t,size_t,void*))fread; + bs.pfgetc = (int(*) (void*))xgetc; + bs.pfread = (int(*) (char*,size_t,size_t,void*))xfread; bs.pfreadpv = freadpv; byterun(aTHXo_ bs); diff --git a/ext/ByteLoader/bytecode.h b/ext/ByteLoader/bytecode.h index 5ca0d1a..6e19e12 100644 --- a/ext/ByteLoader/bytecode.h +++ b/ext/ByteLoader/bytecode.h @@ -137,6 +137,9 @@ typedef IV IV64; PL_comppad = (AV *)arg; \ pad = AvARRAY(arg); \ } STMT_END +#define BSET_cop_file(cop, arg) CopFILE_set(cop,arg) +#define BSET_cop_line(cop, arg) CopLINE_set(cop,arg) +#define BSET_cop_stashpv(cop, arg) CopSTASHPV_set(cop,arg) #define BSET_OBJ_STORE(obj, ix) \ (I32)ix > bytecode_obj_list_fill ? \ diff --git a/ext/ByteLoader/byterun.c b/ext/ByteLoader/byterun.c index 60dc98d..595fd4e 100644 --- a/ext/ByteLoader/byterun.c +++ b/ext/ByteLoader/byterun.c @@ -34,7 +34,7 @@ static int optype_size[] = { sizeof(LISTOP), sizeof(PMOP), sizeof(SVOP), - sizeof(GVOP), + sizeof(PADOP), sizeof(PVOP), sizeof(LOOP), sizeof(COP) @@ -401,11 +401,11 @@ byterun(pTHXo_ struct bytestream bs) *(SV**)&CvGV(bytecode_sv) = arg; break; } - case INSN_XCV_FILEGV: /* 48 */ + case INSN_XCV_FILE: /* 48 */ { - svindex arg; - BGET_svindex(arg); - *(SV**)&CvFILEGV(bytecode_sv) = arg; + pvcontents arg; + BGET_pvcontents(arg); + CvFILE(bytecode_sv) = arg; break; } case INSN_XCV_DEPTH: /* 49 */ @@ -590,11 +590,11 @@ byterun(pTHXo_ struct bytestream bs) *(SV**)&GvCV(bytecode_sv) = arg; break; } - case INSN_GP_FILEGV: /* 75 */ + case INSN_GP_FILE: /* 75 */ { - svindex arg; - BGET_svindex(arg); - *(SV**)&GvFILEGV(bytecode_sv) = arg; + pvcontents arg; + BGET_pvcontents(arg); + GvFILE(bytecode_sv) = arg; break; } case INSN_GP_IO: /* 76 */ @@ -779,11 +779,11 @@ byterun(pTHXo_ struct bytestream bs) cSVOP->op_sv = arg; break; } - case INSN_OP_GV: /* 102 */ + case INSN_OP_PADIX: /* 102 */ { - svindex arg; - BGET_svindex(arg); - *(SV**)&cGVOP->op_gv = arg; + PADOFFSET arg; + BGET_U32(arg); + cPADOP->op_padix = arg; break; } case INSN_OP_PV: /* 103 */ @@ -828,18 +828,18 @@ byterun(pTHXo_ struct bytestream bs) cCOP->cop_label = arg; break; } - case INSN_COP_STASH: /* 109 */ + case INSN_COP_STASHPV: /* 109 */ { - svindex arg; - BGET_svindex(arg); - *(SV**)&cCOP->cop_stash = arg; + pvcontents arg; + BGET_pvcontents(arg); + BSET_cop_stashpv(cCOP, arg); break; } - case INSN_COP_FILEGV: /* 110 */ + case INSN_COP_FILE: /* 110 */ { - svindex arg; - BGET_svindex(arg); - *(SV**)&cCOP->cop_filegv = arg; + pvcontents arg; + BGET_pvcontents(arg); + BSET_cop_file(cCOP, arg); break; } case INSN_COP_SEQ: /* 111 */ @@ -860,7 +860,7 @@ byterun(pTHXo_ struct bytestream bs) { line_t arg; BGET_U16(arg); - cCOP->cop_line = arg; + BSET_cop_line(cCOP, arg); break; } case INSN_COP_WARNINGS: /* 114 */ diff --git a/ext/ByteLoader/byterun.h b/ext/ByteLoader/byterun.h index 3b8f776..f0de6b4 100644 --- a/ext/ByteLoader/byterun.h +++ b/ext/ByteLoader/byterun.h @@ -64,7 +64,7 @@ enum { INSN_XCV_START, /* 45 */ INSN_XCV_ROOT, /* 46 */ INSN_XCV_GV, /* 47 */ - INSN_XCV_FILEGV, /* 48 */ + INSN_XCV_FILE, /* 48 */ INSN_XCV_DEPTH, /* 49 */ INSN_XCV_PADLIST, /* 50 */ INSN_XCV_OUTSIDE, /* 51 */ @@ -91,7 +91,7 @@ enum { INSN_GP_AV, /* 72 */ INSN_GP_HV, /* 73 */ INSN_GP_CV, /* 74 */ - INSN_GP_FILEGV, /* 75 */ + INSN_GP_FILE, /* 75 */ INSN_GP_IO, /* 76 */ INSN_GP_FORM, /* 77 */ INSN_GP_CVGEN, /* 78 */ @@ -118,15 +118,15 @@ enum { INSN_OP_PMFLAGS, /* 99 */ INSN_OP_PMPERMFLAGS, /* 100 */ INSN_OP_SV, /* 101 */ - INSN_OP_GV, /* 102 */ + INSN_OP_PADIX, /* 102 */ INSN_OP_PV, /* 103 */ INSN_OP_PV_TR, /* 104 */ INSN_OP_REDOOP, /* 105 */ INSN_OP_NEXTOP, /* 106 */ INSN_OP_LASTOP, /* 107 */ INSN_COP_LABEL, /* 108 */ - INSN_COP_STASH, /* 109 */ - INSN_COP_FILEGV, /* 110 */ + INSN_COP_STASHPV, /* 109 */ + INSN_COP_FILE, /* 110 */ INSN_COP_SEQ, /* 111 */ INSN_COP_ARYBASE, /* 112 */ INSN_COP_LINE, /* 113 */ @@ -145,7 +145,7 @@ enum { OPt_LISTOP, /* 4 */ OPt_PMOP, /* 5 */ OPt_SVOP, /* 6 */ - OPt_GVOP, /* 7 */ + OPt_PADOP, /* 7 */ OPt_PVOP, /* 8 */ OPt_LOOP, /* 9 */ OPt_COP /* 10 */ diff --git a/ext/DB_File/DB_File.pm b/ext/DB_File/DB_File.pm index 44bdad6..661a523 100644 --- a/ext/DB_File/DB_File.pm +++ b/ext/DB_File/DB_File.pm @@ -155,8 +155,8 @@ $DB_RECNO = new DB_File::RECNOINFO ; require Tie::Hash; require Exporter; use AutoLoader; -require DynaLoader; -@ISA = qw(Tie::Hash Exporter DynaLoader); +use XSLoader (); +@ISA = qw(Tie::Hash Exporter); @EXPORT = qw( $DB_BTREE $DB_HASH $DB_RECNO @@ -231,7 +231,7 @@ eval { # }; #} -bootstrap DB_File $VERSION; +XSLoader::load 'DB_File', $VERSION; # Preloaded methods go here. Autoload methods go after __END__, and are # processed by the autosplit program. diff --git a/ext/DB_File/hints/sco.pl b/ext/DB_File/hints/sco.pl new file mode 100644 index 0000000..ff60440 --- /dev/null +++ b/ext/DB_File/hints/sco.pl @@ -0,0 +1,2 @@ +# osr5 needs to explicitly link against libc to pull in some static symbols +$self->{LIBS} = ['-ldb -lc'] if $Config{'osvers'} =~ '3\.2v5\.0\..' ; diff --git a/ext/Data/Dumper/Dumper.pm b/ext/Data/Dumper/Dumper.pm index c37e6b5..a4aa328 100644 --- a/ext/Data/Dumper/Dumper.pm +++ b/ext/Data/Dumper/Dumper.pm @@ -9,22 +9,22 @@ package Data::Dumper; -$VERSION = $VERSION = '2.101'; +$VERSION = '2.101'; #$| = 1; require 5.004_02; require Exporter; -require DynaLoader; +use XSLoader (); require overload; use Carp; -@ISA = qw(Exporter DynaLoader); +@ISA = qw(Exporter); @EXPORT = qw(Dumper); @EXPORT_OK = qw(DumperX); -bootstrap Data::Dumper; +XSLoader::load 'Data::Dumper'; # module vars and their defaults $Indent = 2 unless defined $Indent; @@ -550,25 +550,35 @@ my %esc = ( sub qquote { local($_) = shift; s/([\\\"\@\$])/\\$1/g; - return qq("$_") unless /[^\040-\176]/; # fast exit + return qq("$_") unless + /[^ !"\#\$%&'()*+,\-.\/0-9:;<=>?\@A-Z[\\\]^_`a-z{|}~]/; # fast exit my $high = shift || ""; s/([\a\b\t\n\f\r\e])/$esc{$1}/g; - # no need for 3 digits in escape for these - s/([\0-\037])(?!\d)/'\\'.sprintf('%o',ord($1))/eg; - - s/([\0-\037\177])/'\\'.sprintf('%03o',ord($1))/eg; - if ($high eq "iso8859") { - s/([\200-\240])/'\\'.sprintf('%o',ord($1))/eg; - } elsif ($high eq "utf8") { -# use utf8; -# $str =~ s/([^\040-\176])/sprintf "\\x{%04x}", ord($1)/ge; - } elsif ($high eq "8bit") { - # leave it as it is - } else { - s/([\0-\037\177-\377])/'\\'.sprintf('%03o',ord($1))/eg; + if (ord('^')==94) { # ascii + # no need for 3 digits in escape for these + s/([\0-\037])(?!\d)/'\\'.sprintf('%o',ord($1))/eg; + s/([\0-\037\177])/'\\'.sprintf('%03o',ord($1))/eg; + # all but last branch below not supported --BEHAVIOR SUBJECT TO CHANGE-- + if ($high eq "iso8859") { + s/([\200-\240])/'\\'.sprintf('%o',ord($1))/eg; + } elsif ($high eq "utf8") { +# use utf8; +# $str =~ s/([^\040-\176])/sprintf "\\x{%04x}", ord($1)/ge; + } elsif ($high eq "8bit") { + # leave it as it is + } else { + s/([\200-\377])/'\\'.sprintf('%03o',ord($1))/eg; + } + } + else { # ebcdic + s{([^ !"\#\$%&'()*+,\-.\/0-9:;<=>?\@A-Z[\\\]^_`a-z{|}~])(?!\d)} + {my $v = ord($1); '\\'.sprintf(($v <= 037 ? '%o' : '%03o'), $v)}eg; + s{([^ !"\#\$%&'()*+,\-.\/0-9:;<=>?\@A-Z[\\\]^_`a-z{|}~])} + {'\\'.sprintf('%03o',ord($1))}eg; } + return qq("$_"); } @@ -1029,7 +1039,7 @@ SCALAR objects have the weirdest looking C workaround. =head1 AUTHOR -Gurusamy Sarathy gsar@umich.edu +Gurusamy Sarathy gsar@activestate.com Copyright (c) 1996-98 Gurusamy Sarathy. All rights reserved. This program is free software; you can redistribute it and/or diff --git a/ext/Data/Dumper/Dumper.xs b/ext/Data/Dumper/Dumper.xs index 054e0a9..125375f 100644 --- a/ext/Data/Dumper/Dumper.xs +++ b/ext/Data/Dumper/Dumper.xs @@ -45,11 +45,12 @@ TOP: } if (isIDFIRST(*s)) { while (*++s) - if (!isALNUM(*s)) + if (!isALNUM(*s)) { if (*s == ':') goto TOP; else return 1; + } } else return 1; @@ -384,7 +385,7 @@ DD_dump(pTHX_ SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv, ilen = inamelen; sv_setiv(ixsv, ix); - (void) sprintf(iname+ilen, "%ld", ix); + (void) sprintf(iname+ilen, "%"IVdf, (IV)ix); ilen = strlen(iname); iname[ilen++] = ']'; iname[ilen] = '\0'; if (indent >= 3) { @@ -584,7 +585,7 @@ DD_dump(pTHX_ SV *val, char *name, STRLEN namelen, SV *retval, HV *seenhv, if (SvIOK(val)) { STRLEN len; i = SvIV(val); - (void) sprintf(tmpbuf, "%d", i); + (void) sprintf(tmpbuf, "%"IVdf, (IV)i); len = strlen(tmpbuf); sv_catpvn(retval, tmpbuf, len); } @@ -705,7 +706,7 @@ Data_Dumper_Dumpxs(href, ...) SV **svp; SV *val, *name, *pad, *xpad, *apad, *sep, *tmp, *varname; SV *freezer, *toaster, *bless; - I32 purity, deepcopy, quotekeys, maxdepth; + I32 purity, deepcopy, quotekeys, maxdepth = 0; char tmpbuf[1024]; I32 gimme = GIMME; @@ -838,7 +839,7 @@ Data_Dumper_Dumpxs(href, ...) STRLEN nchars = 0; sv_setpvn(name, "$", 1); sv_catsv(name, varname); - (void) sprintf(tmpbuf, "%ld", i+1); + (void) sprintf(tmpbuf, "%"IVdf, (IV)(i+1)); nchars = strlen(tmpbuf); sv_catpvn(name, tmpbuf, nchars); } diff --git a/ext/Devel/DProf/DProf.pm b/ext/Devel/DProf/DProf.pm index 4c43f4d..e9372ff 100644 --- a/ext/Devel/DProf/DProf.pm +++ b/ext/Devel/DProf/DProf.pm @@ -133,6 +133,9 @@ C sets size of output buffer in words. Defaults to 2**14. C sets number of ticks per second on some systems where a replacement for times() is used. Defaults to the value of C macro. +C sets the name of the output file. If not set, +defaults to tmon.out. + =head1 BUGS Builtin functions cannot be measured by Devel::DProf. @@ -182,11 +185,11 @@ sub DB { # print "nonXS DBDB\n"; } -require DynaLoader; -@Devel::DProf::ISA = 'DynaLoader'; +use XSLoader (); + $Devel::DProf::VERSION = '19990108'; # this version not authorized by # Dean Roehrich. See "Changes" file. -bootstrap Devel::DProf $Devel::DProf::VERSION; +XSLoader::load 'Devel::DProf', $Devel::DProf::VERSION; 1; diff --git a/ext/Devel/DProf/DProf.xs b/ext/Devel/DProf/DProf.xs index 69f0b89..d59c9df 100644 --- a/ext/Devel/DProf/DProf.xs +++ b/ext/Devel/DProf/DProf.xs @@ -1,7 +1,4 @@ -/* XXX DProf could use some cleanups for PERL_IMPLICIT_CONTEXT */ - -#define PERL_POLLUTE - +#define PERL_NO_GET_CONTEXT #include "EXTERN.h" #include "perl.h" #include "XSUB.h" @@ -15,49 +12,23 @@ /*#define DBG_TIMER 1 */ #ifdef DBG_SUB -# define DBG_SUB_NOTIFY(A,B) warn( A, B ) +# define DBG_SUB_NOTIFY(A,B) warn(A, B) #else # define DBG_SUB_NOTIFY(A,B) /* nothing */ #endif #ifdef DBG_TIMER -# define DBG_TIMER_NOTIFY(A) warn( A ) +# define DBG_TIMER_NOTIFY(A) warn(A) #else # define DBG_TIMER_NOTIFY(A) /* nothing */ #endif -static U32 dprof_ticks; - /* HZ == clock ticks per second */ #ifdef VMS # define HZ ((I32)CLK_TCK) # define DPROF_HZ HZ # include /* prototype for sys$gettim() */ - clock_t dprof_times(struct tms *bufptr) { - clock_t retval; - dTHX; - /* Get wall time and convert to 10 ms intervals to - * produce the return value dprof expects */ -# if defined(__DECC) && defined (__ALPHA) -# include - uint64 vmstime; - _ckvmssts(sys$gettim(&vmstime)); - vmstime /= 100000; - retval = vmstime & 0x7fffffff; -# else - /* (Older hw or ccs don't have an atomic 64-bit type, so we - * juggle 32-bit ints (and a float) to produce a time_t result - * with minimal loss of information.) */ - long int vmstime[2],remainder,divisor = 100000; - _ckvmssts(sys$gettim((unsigned long int *)vmstime)); - vmstime[1] &= 0x7fff; /* prevent overflow in EDIV */ - _ckvmssts(lib$ediv(&divisor,vmstime,(long int *)&retval,&remainder)); -# endif - /* Fill in the struct tms using the CRTL routine . . .*/ - times((tbuffer_t *)bufptr); - return (clock_t) retval; - } -# define Times(ptr) (dprof_times(ptr)) +# define Times(ptr) (dprof_times(aTHX_ ptr)) #else # ifndef HZ # ifdef CLK_TCK @@ -67,37 +38,12 @@ static U32 dprof_ticks; # endif # endif # ifdef OS2 /* times() has significant overhead */ -# define Times(ptr) (dprof_times(ptr)) +# define Times(ptr) (dprof_times(aTHX_ ptr)) # define INCL_DOSPROFILE # define INCL_DOSERRORS # include # define toLongLong(arg) (*(long long*)&(arg)) -# define DPROF_HZ dprof_ticks - -static ULONG frequ; -static long long start_cnt; -clock_t -dprof_times(struct tms *t) -{ - ULONG rc; - QWORD cnt; - - if (!frequ) { - if (CheckOSError(DosTmrQueryFreq(&frequ))) - croak("DosTmrQueryFreq: %s", SvPV(perl_get_sv("!",TRUE),na)); - else - frequ = frequ/DPROF_HZ; /* count per tick */ - if (CheckOSError(DosTmrQueryTime(&cnt))) - croak("DosTmrQueryTime: %s", - SvPV(perl_get_sv("!",TRUE),na)); - start_cnt = toLongLong(cnt); - } - - if (CheckOSError(DosTmrQueryTime(&cnt))) - croak("DosTmrQueryTime: %s", SvPV(perl_get_sv("!",TRUE),na)); - t->tms_stime = 0; - return (t->tms_utime = (toLongLong(cnt) - start_cnt)/frequ); -} +# define DPROF_HZ g_dprof_ticks # else # define Times(ptr) (times(ptr)) # define DPROF_HZ HZ @@ -106,29 +52,10 @@ dprof_times(struct tms *t) XS(XS_Devel__DProf_END); /* used by prof_mark() */ -static SV * Sub; /* pointer to $DB::sub */ -static PerlIO *fp; /* pointer to tmon.out file */ - -/* Added -JH */ -static long TIMES_LOCATION=42;/* Where in the file to store the time totals */ -static int SAVE_STACK = 1<<14; /* How much data to buffer until */ - /* end of run */ - -static int prof_pid; /* pid of profiled process */ - /* Everything is built on times(2). See its manpage for a description * of the timings. */ -static -struct tms prof_start, - prof_end; - -static -clock_t rprof_start, /* elapsed real time, in ticks */ - rprof_end, - wprof_u, wprof_s, wprof_r; - union prof_any { clock_t tms_utime; /* cpu time spent in user space */ clock_t tms_stime; /* cpu time spent in system */ @@ -140,57 +67,161 @@ union prof_any { typedef union prof_any PROFANY; -static PROFANY *profstack; -static int profstack_max = 128; -static int profstack_ix = 0; +typedef struct { + U32 dprof_ticks; + char* out_file_name; /* output file (defaults to tmon.out) */ + PerlIO* fp; /* pointer to tmon.out file */ + long TIMES_LOCATION; /* Where in the file to store the time totals */ + int SAVE_STACK; /* How much data to buffer until end of run */ + int prof_pid; /* pid of profiled process */ + struct tms prof_start; + struct tms prof_end; + clock_t rprof_start; /* elapsed real time ticks */ + clock_t rprof_end; + clock_t wprof_u; + clock_t wprof_s; + clock_t wprof_r; + clock_t otms_utime; + clock_t otms_stime; + clock_t orealtime; + PROFANY* profstack; + int profstack_max; + int profstack_ix; + HV* cv_hash; + U32 total; + U32 lastid; + U32 default_perldb; + U32 depth; +#ifdef OS2 + ULONG frequ; + long long start_cnt; +#endif +#ifdef PERL_IMPLICIT_CONTEXT +# define register + pTHX; +# undef register +#endif +} prof_state_t; + +prof_state_t g_prof_state; + +#define g_dprof_ticks g_prof_state.dprof_ticks +#define g_out_file_name g_prof_state.out_file_name +#define g_fp g_prof_state.fp +#define g_TIMES_LOCATION g_prof_state.TIMES_LOCATION +#define g_SAVE_STACK g_prof_state.SAVE_STACK +#define g_prof_pid g_prof_state.prof_pid +#define g_prof_start g_prof_state.prof_start +#define g_prof_end g_prof_state.prof_end +#define g_rprof_start g_prof_state.rprof_start +#define g_rprof_end g_prof_state.rprof_end +#define g_wprof_u g_prof_state.wprof_u +#define g_wprof_s g_prof_state.wprof_s +#define g_wprof_r g_prof_state.wprof_r +#define g_otms_utime g_prof_state.otms_utime +#define g_otms_stime g_prof_state.otms_stime +#define g_orealtime g_prof_state.orealtime +#define g_profstack g_prof_state.profstack +#define g_profstack_max g_prof_state.profstack_max +#define g_profstack_ix g_prof_state.profstack_ix +#define g_cv_hash g_prof_state.cv_hash +#define g_total g_prof_state.total +#define g_lastid g_prof_state.lastid +#define g_default_perldb g_prof_state.default_perldb +#define g_depth g_prof_state.depth +#ifdef PERL_IMPLICIT_CONTEXT +# define g_THX g_prof_state.aTHX +#endif +#ifdef OS2 +# define g_frequ g_prof_state.frequ +# define g_start_cnt g_prof_state.start_cnt +#endif -static void -prof_dump(opcode ptype, char *name) +clock_t +dprof_times(pTHX_ struct tms *t) { - if(ptype == OP_LEAVESUB){ - PerlIO_printf(fp,"- & %s\n", name ); - } else if(ptype == OP_ENTERSUB) { - PerlIO_printf(fp,"+ & %s\n", name ); - } else if(ptype == OP_DIE) { - PerlIO_printf(fp,"/ & %s\n", name ); - } else { - PerlIO_printf(fp,"Profiler unknown prof code %d\n", ptype); +#ifdef OS2 + ULONG rc; + QWORD cnt; + + if (!g_frequ) { + if (CheckOSError(DosTmrQueryFreq(&g_frequ))) + croak("DosTmrQueryFreq: %s", SvPV(perl_get_sv("!",TRUE),na)); + else + g_frequ = g_frequ/DPROF_HZ; /* count per tick */ + if (CheckOSError(DosTmrQueryTime(&cnt))) + croak("DosTmrQueryTime: %s", + SvPV(perl_get_sv("!",TRUE),na)); + g_start_cnt = toLongLong(cnt); } - safefree(name); -} + + if (CheckOSError(DosTmrQueryTime(&cnt))) + croak("DosTmrQueryTime: %s", SvPV(perl_get_sv("!",TRUE),na)); + t->tms_stime = 0; + return (t->tms_utime = (toLongLong(cnt) - g_start_cnt)/g_frequ); +#else /* !OS2 */ +# ifdef VMS + clock_t retval; + /* Get wall time and convert to 10 ms intervals to + * produce the return value dprof expects */ +# if defined(__DECC) && defined (__ALPHA) +# include + uint64 vmstime; + _ckvmssts(sys$gettim(&vmstime)); + vmstime /= 100000; + retval = vmstime & 0x7fffffff; +# else + /* (Older hw or ccs don't have an atomic 64-bit type, so we + * juggle 32-bit ints (and a float) to produce a time_t result + * with minimal loss of information.) */ + long int vmstime[2],remainder,divisor = 100000; + _ckvmssts(sys$gettim((unsigned long int *)vmstime)); + vmstime[1] &= 0x7fff; /* prevent overflow in EDIV */ + _ckvmssts(lib$ediv(&divisor,vmstime,(long int *)&retval,&remainder)); +# endif + /* Fill in the struct tms using the CRTL routine . . .*/ + times((tbuffer_t *)t); + return (clock_t) retval; +# else /* !VMS && !OS2 */ + return times(t); +# endif +#endif +} static void -prof_dumpa(opcode ptype, U32 id) +prof_dumpa(pTHX_ opcode ptype, U32 id) { - if(ptype == OP_LEAVESUB){ - PerlIO_printf(fp,"- %lx\n", id ); - } else if(ptype == OP_ENTERSUB) { - PerlIO_printf(fp,"+ %lx\n", id ); - } else if(ptype == OP_GOTO) { - PerlIO_printf(fp,"* %lx\n", id ); - } else if(ptype == OP_DIE) { - PerlIO_printf(fp,"/ %lx\n", id ); - } else { - PerlIO_printf(fp,"Profiler unknown prof code %d\n", ptype); + if (ptype == OP_LEAVESUB) { + PerlIO_printf(g_fp,"- %"UVxf"\n", (UV)id); + } + else if(ptype == OP_ENTERSUB) { + PerlIO_printf(g_fp,"+ %"UVxf"\n", (UV)id); + } + else if(ptype == OP_GOTO) { + PerlIO_printf(g_fp,"* %"UVxf"\n", (UV)id); + } + else if(ptype == OP_DIE) { + PerlIO_printf(g_fp,"/ %"UVxf"\n", (UV)id); + } + else { + PerlIO_printf(g_fp,"Profiler unknown prof code %d\n", ptype); } } static void -prof_dumps(U32 id, char *pname, char *gname) +prof_dumps(pTHX_ U32 id, char *pname, char *gname) { - PerlIO_printf(fp,"& %lx %s %s\n", id, pname, gname); + PerlIO_printf(g_fp,"& %"UVxf" %s %s\n", (UV)id, pname, gname); } -static clock_t otms_utime, otms_stime, orealtime; - static void -prof_dumpt(long tms_utime, long tms_stime, long realtime) +prof_dumpt(pTHX_ long tms_utime, long tms_stime, long realtime) { - PerlIO_printf(fp,"@ %ld %ld %ld\n", tms_utime, tms_stime, realtime); + PerlIO_printf(g_fp,"@ %ld %ld %ld\n", tms_utime, tms_stime, realtime); } static void -prof_dump_until(long ix) +prof_dump_until(pTHX_ long ix) { long base = 0; struct tms t1, t2; @@ -198,266 +229,202 @@ prof_dump_until(long ix) realtime1 = Times(&t1); - while( base < ix ){ - opcode ptype = profstack[base++].ptype; + while (base < ix) { + opcode ptype = g_profstack[base++].ptype; if (ptype == OP_TIME) { - long tms_utime = profstack[base++].tms_utime; - long tms_stime = profstack[base++].tms_stime; - long realtime = profstack[base++].realtime; - - prof_dumpt(tms_utime, tms_stime, realtime); - } else if (ptype == OP_GV) { - U32 id = profstack[base++].id; - char *pname = profstack[base++].name; - char *gname = profstack[base++].name; - - prof_dumps(id, pname, gname); - } else { -#ifdef PERLDBf_NONAME - U32 id = profstack[base++].id; - prof_dumpa(ptype, id); -#else - char *name = profstack[base++].name; - prof_dump(ptype, name); -#endif + long tms_utime = g_profstack[base++].tms_utime; + long tms_stime = g_profstack[base++].tms_stime; + long realtime = g_profstack[base++].realtime; + + prof_dumpt(aTHX_ tms_utime, tms_stime, realtime); + } + else if (ptype == OP_GV) { + U32 id = g_profstack[base++].id; + char *pname = g_profstack[base++].name; + char *gname = g_profstack[base++].name; + + prof_dumps(aTHX_ id, pname, gname); + } + else { + U32 id = g_profstack[base++].id; + prof_dumpa(aTHX_ ptype, id); } } - PerlIO_flush(fp); + PerlIO_flush(g_fp); realtime2 = Times(&t2); if (realtime2 != realtime1 || t1.tms_utime != t2.tms_utime || t1.tms_stime != t2.tms_stime) { - wprof_r += realtime2 - realtime1; - wprof_u += t2.tms_utime - t1.tms_utime; - wprof_s += t2.tms_stime - t1.tms_stime; - - PerlIO_printf(fp,"+ & Devel::DProf::write\n" ); - PerlIO_printf(fp,"@ %ld %ld %ld\n", - t2.tms_utime - t1.tms_utime, t2.tms_stime - t1.tms_stime, - realtime2 - realtime1); - PerlIO_printf(fp,"- & Devel::DProf::write\n" ); - otms_utime = t2.tms_utime; - otms_stime = t2.tms_stime; - orealtime = realtime2; - PerlIO_flush(fp); + g_wprof_r += realtime2 - realtime1; + g_wprof_u += t2.tms_utime - t1.tms_utime; + g_wprof_s += t2.tms_stime - t1.tms_stime; + + PerlIO_printf(g_fp,"+ & Devel::DProf::write\n"); + PerlIO_printf(g_fp,"@ %"IVdf" %"IVdf" %"IVdf"\n", + /* The (IV) casts are one possibility: + * the Painfully Correct Way would be to + * have Clock_t_f. */ + (IV)(t2.tms_utime - t1.tms_utime), + (IV)(t2.tms_stime - t1.tms_stime), + (IV)(realtime2 - realtime1)); + PerlIO_printf(g_fp,"- & Devel::DProf::write\n"); + g_otms_utime = t2.tms_utime; + g_otms_stime = t2.tms_stime; + g_orealtime = realtime2; + PerlIO_flush(g_fp); } } -static HV* cv_hash; -static U32 total = 0; - static void -prof_mark( opcode ptype ) +prof_mark(pTHX_ opcode ptype) { - struct tms t; - clock_t realtime, rdelta, udelta, sdelta; - char *name, *pv; - char *hvname; - STRLEN len; - SV *sv; - U32 id; - - if( SAVE_STACK ){ - if( profstack_ix + 5 > profstack_max ){ - profstack_max = profstack_max * 3 / 2; - Renew( profstack, profstack_max, PROFANY ); - } - } + struct tms t; + clock_t realtime, rdelta, udelta, sdelta; + char *name, *pv; + char *hvname; + STRLEN len; + SV *sv; + U32 id; + SV *Sub = GvSV(PL_DBsub); /* name of current sub */ + + if (g_SAVE_STACK) { + if (g_profstack_ix + 5 > g_profstack_max) { + g_profstack_max = g_profstack_max * 3 / 2; + Renew(g_profstack, g_profstack_max, PROFANY); + } + } - realtime = Times(&t); - rdelta = realtime - orealtime; - udelta = t.tms_utime - otms_utime; - sdelta = t.tms_stime - otms_stime; - if (rdelta || udelta || sdelta) { - if (SAVE_STACK) { - profstack[profstack_ix++].ptype = OP_TIME; - profstack[profstack_ix++].tms_utime = udelta; - profstack[profstack_ix++].tms_stime = sdelta; - profstack[profstack_ix++].realtime = rdelta; - } else { /* Write it to disk now so's not to eat up core */ - if (prof_pid == (int)getpid()) { - prof_dumpt(udelta, sdelta, rdelta); - PerlIO_flush(fp); - } + realtime = Times(&t); + rdelta = realtime - g_orealtime; + udelta = t.tms_utime - g_otms_utime; + sdelta = t.tms_stime - g_otms_stime; + if (rdelta || udelta || sdelta) { + if (g_SAVE_STACK) { + g_profstack[g_profstack_ix++].ptype = OP_TIME; + g_profstack[g_profstack_ix++].tms_utime = udelta; + g_profstack[g_profstack_ix++].tms_stime = sdelta; + g_profstack[g_profstack_ix++].realtime = rdelta; + } + else { /* Write it to disk now so's not to eat up core */ + if (g_prof_pid == (int)getpid()) { + prof_dumpt(aTHX_ udelta, sdelta, rdelta); + PerlIO_flush(g_fp); } - orealtime = realtime; - otms_stime = t.tms_stime; - otms_utime = t.tms_utime; } + g_orealtime = realtime; + g_otms_stime = t.tms_stime; + g_otms_utime = t.tms_utime; + } -#ifdef PERLDBf_NONAME - { - dTHX; - SV **svp; - char *gname, *pname; - static U32 lastid; - CV *cv; - - cv = INT2PTR(CV*,SvIVX(Sub)); - svp = hv_fetch(cv_hash, (char*)&cv, sizeof(CV*), TRUE); - if (!SvOK(*svp)) { - GV *gv = CvGV(cv); - - sv_setiv(*svp, id = ++lastid); - pname = ((GvSTASH(gv) && HvNAME(GvSTASH(gv))) - ? HvNAME(GvSTASH(gv)) - : "(null)"); - gname = GvNAME(gv); - if (CvXSUB(cv) == XS_Devel__DProf_END) - return; - if (SAVE_STACK) { /* Store it for later recording -JH */ - profstack[profstack_ix++].ptype = OP_GV; - profstack[profstack_ix++].id = id; - profstack[profstack_ix++].name = pname; - profstack[profstack_ix++].name = gname; - } else { /* Write it to disk now so's not to eat up core */ - - /* Only record the parent's info */ - if (prof_pid == (int)getpid()) { - prof_dumps(id, pname, gname); - PerlIO_flush(fp); - } else - perldb = 0; /* Do not debug the kid. */ + { + SV **svp; + char *gname, *pname; + CV *cv; + + cv = INT2PTR(CV*,SvIVX(Sub)); + svp = hv_fetch(g_cv_hash, (char*)&cv, sizeof(CV*), TRUE); + if (!SvOK(*svp)) { + GV *gv = CvGV(cv); + + sv_setiv(*svp, id = ++g_lastid); + pname = ((GvSTASH(gv) && HvNAME(GvSTASH(gv))) + ? HvNAME(GvSTASH(gv)) + : "(null)"); + gname = GvNAME(gv); + if (CvXSUB(cv) == XS_Devel__DProf_END) + return; + if (g_SAVE_STACK) { /* Store it for later recording -JH */ + g_profstack[g_profstack_ix++].ptype = OP_GV; + g_profstack[g_profstack_ix++].id = id; + g_profstack[g_profstack_ix++].name = pname; + g_profstack[g_profstack_ix++].name = gname; + } + else { /* Write it to disk now so's not to eat up core */ + /* Only record the parent's info */ + if (g_prof_pid == (int)getpid()) { + prof_dumps(aTHX_ id, pname, gname); + PerlIO_flush(g_fp); } - } else { - id = SvIV(*svp); + else + PL_perldb = 0; /* Do not debug the kid. */ } } -#else - pv = SvPV( Sub, len ); - - if( SvROK(Sub) ){ - /* Attempt to make CODE refs slightly identifiable by - * including their package name. - */ - sv = (SV*)SvRV(Sub); - if( sv && SvTYPE(sv) == SVt_PVCV ){ - if( CvSTASH(sv) ){ - hvname = HvNAME(CvSTASH(sv)); - } - else if( CvXSUB(sv) == &XS_Devel__DProf_END ){ - /*warn( "prof_mark() found dprof::end");*/ - return; /* don't profile Devel::DProf::END */ - } - else{ - croak( "DProf prof_mark() lost on CODE ref %s\n", pv ); - } - len += strlen( hvname ) + 2; /* +2 for ::'s */ - - } - else{ - croak( "DProf prof_mark() lost on supposed CODE ref %s.\n", pv ); - } - name = (char *)safemalloc( len * sizeof(char) + 1 ); - strcpy( name, hvname ); - strcat( name, "::" ); - strcat( name, pv ); - } - else{ - if( *(pv+len-1) == 'D' ){ - /* It could be an &AUTOLOAD. */ - - /* I measured a bunch of *.pl and *.pm (from Perl - * distribution and other misc things) and found - * 780 fully-qualified names. They averaged - * about 19 chars each. Only 1 of those names - * ended with 'D' and wasn't an &AUTOLOAD--it - * was &overload::OVERLOAD. - * --dmr 2/19/96 - */ - - if( strcmp( pv+len-9, ":AUTOLOAD" ) == 0 ){ - /* The sub name is in $AUTOLOAD */ - sv = perl_get_sv( pv, 0 ); - if( sv == NULL ){ - croak("DProf prof_mark() lost on AUTOLOAD (%s).\n", pv ); - } - pv = SvPV( sv, na ); - DBG_SUB_NOTIFY( " AUTOLOAD(%s)\n", pv ); - } - } - name = savepv( pv ); - } -#endif /* PERLDBf_NONAME */ + else { + id = SvIV(*svp); + } + } - total++; - if (SAVE_STACK) { /* Store it for later recording -JH */ - profstack[profstack_ix++].ptype = ptype; -#ifdef PERLDBf_NONAME - profstack[profstack_ix++].id = id; -#else - profstack[profstack_ix++].name = name; -#endif - /* Only record the parent's info */ - if (SAVE_STACK < profstack_ix) { - if (prof_pid == (int)getpid()) - prof_dump_until(profstack_ix); - else - perldb = 0; /* Do not debug the kid. */ - profstack_ix = 0; - } - } else { /* Write it to disk now so's not to eat up core */ + g_total++; + if (g_SAVE_STACK) { /* Store it for later recording -JH */ + g_profstack[g_profstack_ix++].ptype = ptype; + g_profstack[g_profstack_ix++].id = id; + + /* Only record the parent's info */ + if (g_SAVE_STACK < g_profstack_ix) { + if (g_prof_pid == (int)getpid()) + prof_dump_until(aTHX_ g_profstack_ix); + else + PL_perldb = 0; /* Do not debug the kid. */ + g_profstack_ix = 0; + } + } + else { /* Write it to disk now so's not to eat up core */ - /* Only record the parent's info */ - if (prof_pid == (int)getpid()) { -#ifdef PERLDBf_NONAME - prof_dumpa(ptype, id); -#else - prof_dump(ptype, name); -#endif - PerlIO_flush(fp); - } else - perldb = 0; /* Do not debug the kid. */ - } + /* Only record the parent's info */ + if (g_prof_pid == (int)getpid()) { + prof_dumpa(aTHX_ ptype, id); + PerlIO_flush(g_fp); + } + else + PL_perldb = 0; /* Do not debug the kid. */ + } } -static U32 default_perldb; - #ifdef PL_NEEDED # define defstash PL_defstash #endif /* Counts overhead of prof_mark and extra XS call. */ static void -test_time(clock_t *r, clock_t *u, clock_t *s) +test_time(pTHX_ clock_t *r, clock_t *u, clock_t *s) { dTHR; - dTHX; CV *cv = perl_get_cv("Devel::DProf::NONESUCH_noxs", FALSE); int i, j, k = 0; - HV *oldstash = curstash; + HV *oldstash = PL_curstash; struct tms t1, t2; clock_t realtime1, realtime2; - U32 ototal = total; - U32 ostack = SAVE_STACK; - U32 operldb = perldb; + U32 ototal = g_total; + U32 ostack = g_SAVE_STACK; + U32 operldb = PL_perldb; - SAVE_STACK = 1000000; + g_SAVE_STACK = 1000000; realtime1 = Times(&t1); while (k < 2) { i = 0; /* Disable debugging of perl_call_sv on second pass: */ - curstash = (k == 0 ? defstash : debstash); - perldb = default_perldb; + PL_curstash = (k == 0 ? PL_defstash : PL_debstash); + PL_perldb = g_default_perldb; while (++i <= 100) { j = 0; - profstack_ix = 0; /* Do not let the stack grow */ + g_profstack_ix = 0; /* Do not let the stack grow */ while (++j <= 100) { -/* prof_mark( OP_ENTERSUB ); */ +/* prof_mark(aTHX_ OP_ENTERSUB); */ - PUSHMARK( stack_sp ); - perl_call_sv( (SV*)cv, G_SCALAR ); - stack_sp--; -/* prof_mark( OP_LEAVESUB ); */ + PUSHMARK(PL_stack_sp); + perl_call_sv((SV*)cv, G_SCALAR); + PL_stack_sp--; +/* prof_mark(aTHX_ OP_LEAVESUB); */ } } - curstash = oldstash; + PL_curstash = oldstash; if (k == 0) { /* Put time with debugging */ realtime2 = Times(&t2); *r = realtime2 - realtime1; *u = t2.tms_utime - t1.tms_utime; *s = t2.tms_stime - t1.tms_stime; - } else { /* Subtract time without debug */ + } + else { /* Subtract time without debug */ realtime1 = Times(&t1); *r -= realtime1 - realtime2; *u -= t1.tms_utime - t2.tms_utime; @@ -465,81 +432,88 @@ test_time(clock_t *r, clock_t *u, clock_t *s) } k++; } - total = ototal; - SAVE_STACK = ostack; - perldb = operldb; + g_total = ototal; + g_SAVE_STACK = ostack; + PL_perldb = operldb; } static void -prof_recordheader() +prof_recordheader(pTHX) { - clock_t r, u, s; - - /* fp is opened in the BOOT section */ - PerlIO_printf(fp, "#fOrTyTwO\n" ); - PerlIO_printf(fp, "$hz=%d;\n", DPROF_HZ ); - PerlIO_printf(fp, "$XS_VERSION='DProf %s';\n", XS_VERSION ); - PerlIO_printf(fp, "# All values are given in HZ\n" ); - test_time(&r, &u, &s); - PerlIO_printf(fp, "$over_utime=%ld; $over_stime=%ld; $over_rtime=%ld;\n", - u, s, r); - PerlIO_printf(fp, "$over_tests=10000;\n"); - - TIMES_LOCATION = PerlIO_tell(fp); - - /* Pad with whitespace. */ - /* This should be enough even for very large numbers. */ - PerlIO_printf(fp, "%*s\n", 240 , ""); - - PerlIO_printf(fp, "\n"); - PerlIO_printf(fp, "PART2\n" ); - - PerlIO_flush(fp); + clock_t r, u, s; + + /* g_fp is opened in the BOOT section */ + PerlIO_printf(g_fp, "#fOrTyTwO\n"); + PerlIO_printf(g_fp, "$hz=%"IVdf";\n", (IV)DPROF_HZ); + PerlIO_printf(g_fp, "$XS_VERSION='DProf %s';\n", XS_VERSION); + PerlIO_printf(g_fp, "# All values are given in HZ\n"); + test_time(aTHX_ &r, &u, &s); + PerlIO_printf(g_fp, + "$over_utime=%"IVdf"; $over_stime=%"IVdf"; $over_rtime=%"IVdf";\n", + /* The (IV) casts are one possibility: + * the Painfully Correct Way would be to + * have Clock_t_f. */ + (IV)u, (IV)s, (IV)r); + PerlIO_printf(g_fp, "$over_tests=10000;\n"); + + g_TIMES_LOCATION = PerlIO_tell(g_fp); + + /* Pad with whitespace. */ + /* This should be enough even for very large numbers. */ + PerlIO_printf(g_fp, "%*s\n", 240 , ""); + + PerlIO_printf(g_fp, "\n"); + PerlIO_printf(g_fp, "PART2\n"); + + PerlIO_flush(g_fp); } static void -prof_record() +prof_record(pTHX) { - /* fp is opened in the BOOT section */ + /* g_fp is opened in the BOOT section */ + + /* Now that we know the runtimes, fill them in at the recorded + location -JH */ - /* Now that we know the runtimes, fill them in at the recorded - location -JH */ + clock_t r, u, s; - clock_t r, u, s; + if (g_SAVE_STACK) { + prof_dump_until(aTHX_ g_profstack_ix); + } + PerlIO_seek(g_fp, g_TIMES_LOCATION, SEEK_SET); + /* Write into reserved 240 bytes: */ + PerlIO_printf(g_fp, + "$rrun_utime=%"IVdf"; $rrun_stime=%"IVdf"; $rrun_rtime=%"IVdf";", + /* The (IV) casts are one possibility: + * the Painfully Correct Way would be to + * have Clock_t_f. */ + (IV)(g_prof_end.tms_utime-g_prof_start.tms_utime-g_wprof_u), + (IV)(g_prof_end.tms_stime-g_prof_start.tms_stime-g_wprof_s), + (IV)(g_rprof_end-g_rprof_start-g_wprof_r)); + PerlIO_printf(g_fp, "\n$total_marks=%"IVdf, (IV)g_total); - if(SAVE_STACK){ - prof_dump_until(profstack_ix); - } - PerlIO_seek(fp, TIMES_LOCATION, SEEK_SET); - /* Write into reserved 240 bytes: */ - PerlIO_printf(fp, "$rrun_utime=%ld; $rrun_stime=%ld; $rrun_rtime=%ld;", - prof_end.tms_utime - prof_start.tms_utime - wprof_u, - prof_end.tms_stime - prof_start.tms_stime - wprof_s, - rprof_end - rprof_start - wprof_r ); - PerlIO_printf(fp, "\n$total_marks=%ld;", total); - - PerlIO_close( fp ); + PerlIO_close(g_fp); } #define NONESUCH() -static U32 depth = 0; - static void check_depth(pTHX_ void *foo) { U32 need_depth = (U32)foo; - if (need_depth != depth) { - if (need_depth > depth) { + if (need_depth != g_depth) { + if (need_depth > g_depth) { warn("garbled call depth when profiling"); - } else { - I32 marks = depth - need_depth; + } + else { + I32 marks = g_depth - need_depth; -/* warn("Check_depth: got %d, expected %d\n", depth, need_depth); */ +/* warn("Check_depth: got %d, expected %d\n", g_depth, need_depth); */ while (marks--) { - prof_mark( OP_DIE ); + prof_mark(aTHX_ OP_DIE); } - depth = need_depth; + g_depth = need_depth; } } } @@ -549,48 +523,44 @@ check_depth(pTHX_ void *foo) XS(XS_DB_sub) { - dXSARGS; - dORIGMARK; - HV *oldstash = curstash; - - SP -= items; - - DBG_SUB_NOTIFY( "XS DBsub(%s)\n", SvPV(Sub, na) ); - -#ifndef PERLDBf_NONAME /* Was needed on older Perls */ - sv_setiv( DBsingle, 0 ); /* disable DB single-stepping */ -#endif - - SAVEDESTRUCTOR(check_depth, (void*)depth); - depth++; - - prof_mark( OP_ENTERSUB ); - PUSHMARK( ORIGMARK ); + dXSARGS; + dORIGMARK; + SV *Sub = GvSV(PL_DBsub); /* name of current sub */ + +#ifdef PERL_IMPLICIT_CONTEXT + /* profile only the interpreter that loaded us */ + if (g_THX != aTHX) { + PUSHMARK(ORIGMARK); + perl_call_sv(INT2PTR(SV*,SvIV(Sub)), GIMME | G_NODEBUG); + } + else +#endif + { + HV *oldstash = PL_curstash; -#ifdef G_NODEBUG - perl_call_sv( INT2PTR(SV*,SvIV(Sub)), GIMME | G_NODEBUG); -#else - curstash = debstash; /* To disable debugging of perl_call_sv */ -#ifdef PERLDBf_NONAME - perl_call_sv( (SV*)SvIV(Sub), GIMME ); -#else - perl_call_sv( Sub, GIMME ); -#endif - curstash = oldstash; -#endif + DBG_SUB_NOTIFY("XS DBsub(%s)\n", SvPV(Sub, na)); - prof_mark( OP_LEAVESUB ); - depth--; + SAVEDESTRUCTOR_X(check_depth, (void*)g_depth); + g_depth++; - SPAGAIN; - PUTBACK; - return; + prof_mark(aTHX_ OP_ENTERSUB); + PUSHMARK(ORIGMARK); + perl_call_sv(INT2PTR(SV*,SvIV(Sub)), GIMME | G_NODEBUG); + prof_mark(aTHX_ OP_LEAVESUB); + g_depth--; + } + return; } XS(XS_DB_goto) { - prof_mark( OP_GOTO ); +#ifdef PERL_IMPLICIT_CONTEXT + if (g_THX == aTHX) +#endif + { + prof_mark(aTHX_ OP_GOTO); return; + } } #endif /* for_real */ @@ -601,26 +571,27 @@ XS(XS_DB_goto) void sub(...) - PPCODE: - + PPCODE: + { dORIGMARK; - HV *oldstash = curstash; + HV *oldstash = PL_curstash; + SV *Sub = GvSV(PL_DBsub); /* name of current sub */ /* SP -= items; added by xsubpp */ - DBG_SUB_NOTIFY( "XS DBsub(%s)\n", SvPV(Sub, na) ); + DBG_SUB_NOTIFY("XS DBsub(%s)\n", SvPV(Sub, na)); - sv_setiv( DBsingle, 0 ); /* disable DB single-stepping */ + sv_setiv(PL_DBsingle, 0); /* disable DB single-stepping */ - prof_mark( OP_ENTERSUB ); - PUSHMARK( ORIGMARK ); + prof_mark(aTHX_ OP_ENTERSUB); + PUSHMARK(ORIGMARK); - curstash = debstash; /* To disable debugging of perl_call_sv -*/ - perl_call_sv( Sub, GIMME ); - curstash = oldstash; + PL_curstash = PL_debstash; /* To disable debugging of perl_call_sv */ + perl_call_sv(Sub, GIMME); + PL_curstash = oldstash; - prof_mark( OP_LEAVESUB ); + prof_mark(aTHX_ OP_LEAVESUB); SPAGAIN; /* PUTBACK; added by xsubpp */ + } #endif /* testing */ @@ -628,80 +599,90 @@ MODULE = Devel::DProf PACKAGE = Devel::DProf void END() - PPCODE: - if( DBsub ){ - /* maybe the process forked--we want only - * the parent's profile. - */ - if( prof_pid == (int)getpid() ){ - rprof_end = Times(&prof_end); - DBG_TIMER_NOTIFY("Profiler timer is off.\n"); - prof_record(); - } - } +PPCODE: + { + if (PL_DBsub) { + /* maybe the process forked--we want only + * the parent's profile. + */ + if ( +#ifdef PERL_IMPLICIT_CONTEXT + g_THX == aTHX && +#endif + g_prof_pid == (int)getpid()) + { + g_rprof_end = Times(&g_prof_end); + DBG_TIMER_NOTIFY("Profiler timer is off.\n"); + prof_record(aTHX); + } + } + } void NONESUCH() BOOT: + { + g_TIMES_LOCATION = 42; + g_SAVE_STACK = 1<<14; + g_profstack_max = 128; +#ifdef PERL_IMPLICIT_CONTEXT + g_THX = aTHX; +#endif + /* Before we go anywhere make sure we were invoked * properly, else we'll dump core. */ - if( ! DBsub ) - croak("DProf: run perl with -d to use DProf.\n"); + if (!PL_DBsub) + croak("DProf: run perl with -d to use DProf.\n"); /* When we hook up the XS DB::sub we'll be redefining * the DB::sub from the PM file. Turn off warnings * while we do this. */ { - I32 warn_tmp = dowarn; - dowarn = 0; - newXS("DB::sub", XS_DB_sub, file); - newXS("DB::goto", XS_DB_goto, file); - dowarn = warn_tmp; + I32 warn_tmp = PL_dowarn; + PL_dowarn = 0; + newXS("DB::sub", XS_DB_sub, file); + newXS("DB::goto", XS_DB_goto, file); + PL_dowarn = warn_tmp; } - Sub = GvSV(DBsub); /* name of current sub */ - sv_setiv( DBsingle, 0 ); /* disable DB single-stepping */ + sv_setiv(PL_DBsingle, 0); /* disable DB single-stepping */ { char *buffer = getenv("PERL_DPROF_BUFFER"); if (buffer) { - SAVE_STACK = atoi(buffer); + g_SAVE_STACK = atoi(buffer); } buffer = getenv("PERL_DPROF_TICKS"); if (buffer) { - dprof_ticks = atoi(buffer); /* Used under OS/2 only */ - } else { - dprof_ticks = HZ; + g_dprof_ticks = atoi(buffer); /* Used under OS/2 only */ + } + else { + g_dprof_ticks = HZ; } - } - if( (fp = PerlIO_open( "tmon.out", "w" )) == NULL ) - croak("DProf: unable to write tmon.out, errno = %d\n", errno ); -#ifdef PERLDBf_NONAME - default_perldb = PERLDBf_NONAME | PERLDBf_SUB; /* no name needed. */ -#ifdef PERLDBf_GOTO - default_perldb = default_perldb | PERLDBf_GOTO; -#endif - cv_hash = newHV(); -#else -# ifdef PERLDBf_SUB - default_perldb = PERLDBf_SUB; /* debug subroutines only. */ -# endif -#endif - prof_pid = (int)getpid(); + buffer = getenv("PERL_DPROF_OUT_FILE_NAME"); + g_out_file_name = savepv(buffer ? buffer : "tmon.out"); + } - New( 0, profstack, profstack_max, PROFANY ); + if ((g_fp = PerlIO_open(g_out_file_name, "w")) == NULL) + croak("DProf: unable to write '%s', errno = %d\n", + g_out_file_name, errno); - prof_recordheader(); + g_default_perldb = PERLDBf_NONAME | PERLDBf_SUB | PERLDBf_GOTO; + g_cv_hash = newHV(); + g_prof_pid = (int)getpid(); + New(0, g_profstack, g_profstack_max, PROFANY); + prof_recordheader(aTHX); DBG_TIMER_NOTIFY("Profiler timer is on.\n"); - orealtime = rprof_start = Times(&prof_start); - otms_utime = prof_start.tms_utime; - otms_stime = prof_start.tms_stime; - perldb = default_perldb; + g_orealtime = g_rprof_start = Times(&g_prof_start); + g_otms_utime = g_prof_start.tms_utime; + g_otms_stime = g_prof_start.tms_stime; + PL_perldb = g_default_perldb; + } diff --git a/ext/Devel/Peek/Peek.pm b/ext/Devel/Peek/Peek.pm index 7b3cf74..4b472ad 100644 --- a/ext/Devel/Peek/Peek.pm +++ b/ext/Devel/Peek/Peek.pm @@ -3,17 +3,17 @@ package Devel::Peek; -$VERSION = $VERSION = 0.95; +$VERSION = 0.95; require Exporter; -require DynaLoader; +use XSLoader (); -@ISA = qw(Exporter DynaLoader); +@ISA = qw(Exporter); @EXPORT = qw(Dump mstat DeadCode DumpArray DumpWithOP DumpProg); @EXPORT_OK = qw(SvREFCNT SvREFCNT_inc SvREFCNT_dec); %EXPORT_TAGS = ('ALL' => [@EXPORT, @EXPORT_OK]); -bootstrap Devel::Peek; +XSLoader::load 'Devel::Peek'; sub DumpWithOP ($;$) { local($Devel::Peek::dump_ops)=1; @@ -364,7 +364,7 @@ Looks like this: XSUB = 0x0 XSUBANY = 0 GVGV::GV = 0x1d44e8 "MY" :: "top_targets" - FILEGV = 0x1fab74 "_<(eval 5)" + FILE = "(eval 5)" DEPTH = 0 PADLIST = 0x1c9338 diff --git a/ext/Devel/Peek/Peek.xs b/ext/Devel/Peek/Peek.xs index df91476..d2f66c4 100644 --- a/ext/Devel/Peek/Peek.xs +++ b/ext/Devel/Peek/Peek.xs @@ -34,12 +34,12 @@ DeadCode(pTHX) continue; /* file-level scope. */ } if (!CvROOT(cv)) { - /* PerlIO_printf(PerlIO_stderr(), " no root?!\n"); */ + /* PerlIO_printf(Perl_debug_log, " no root?!\n"); */ continue; /* autoloading stub. */ } - do_gvgv_dump(0, PerlIO_stderr(), "GVGV::GV", CvGV(sv)); + do_gvgv_dump(0, Perl_debug_log, "GVGV::GV", CvGV(sv)); if (CvDEPTH(cv)) { - PerlIO_printf(PerlIO_stderr(), " busy\n"); + PerlIO_printf(Perl_debug_log, " busy\n"); continue; } svp = AvARRAY(padlist); @@ -49,7 +49,7 @@ DeadCode(pTHX) pad = AvARRAY((AV*)svp[i]); argav = (AV*)pad[0]; if (!argav || (SV*)argav == &PL_sv_undef) { - PerlIO_printf(PerlIO_stderr(), " closure-template\n"); + PerlIO_printf(Perl_debug_log, " closure-template\n"); continue; } args = AvARRAY(argav); @@ -58,7 +58,7 @@ DeadCode(pTHX) if (AvREAL(argav)) { for (j = 0; j < AvFILL(argav); j++) { if (SvROK(args[j])) { - PerlIO_printf(PerlIO_stderr(), " ref in args!\n"); + PerlIO_printf(Perl_debug_log, " ref in args!\n"); levelref++; } /* else if (SvPOK(args[j]) && SvPVX(args[j])) { */ @@ -70,14 +70,14 @@ DeadCode(pTHX) for (j = 1; j < AvFILL((AV*)svp[1]); j++) { /* Vars. */ if (SvROK(pad[j])) { levelref++; - do_sv_dump(0, PerlIO_stderr(), pad[j], 0, 4, 0, 0); + do_sv_dump(0, Perl_debug_log, pad[j], 0, 4, 0, 0); dumpit = 1; } /* else if (SvPOK(pad[j]) && SvPVX(pad[j])) { */ else if (SvTYPE(pad[j]) >= SVt_PVAV) { if (!SvPADMY(pad[j])) { levelref++; - do_sv_dump(0, PerlIO_stderr(), pad[j], 0, 4, 0, 0); + do_sv_dump(0, Perl_debug_log, pad[j], 0, 4, 0, 0); dumpit = 1; } } @@ -89,7 +89,7 @@ DeadCode(pTHX) /* Dump(pad[j],4); */ } } - PerlIO_printf(PerlIO_stderr(), " level %i: refs: %i, strings: %i in %i,\targsarray: %i, argsstrings: %i\n", + PerlIO_printf(Perl_debug_log, " level %i: refs: %i, strings: %i in %i,\targsarray: %i, argsstrings: %i\n", i, levelref, levelm, levels, levela, levelas); totm += levelm; tota += levela; @@ -97,10 +97,10 @@ DeadCode(pTHX) tots += levels; totref += levelref; if (dumpit) - do_sv_dump(0, PerlIO_stderr(), (SV*)cv, 0, 2, 0, 0); + do_sv_dump(0, Perl_debug_log, (SV*)cv, 0, 2, 0, 0); } if (AvFILL(padlist) > 1) { - PerlIO_printf(PerlIO_stderr(), " total: refs: %i, strings: %i in %i,\targsarrays: %i, argsstrings: %i\n", + PerlIO_printf(Perl_debug_log, " total: refs: %i, strings: %i in %i,\targsarrays: %i, argsstrings: %i\n", totref, totm, tots, tota, totas); } tref += totref; @@ -111,7 +111,7 @@ DeadCode(pTHX) } } } - PerlIO_printf(PerlIO_stderr(), "total: refs: %i, strings: %i in %i\targsarray: %i, argsstrings: %i\n", tref, tm, ts, ta, tas); + PerlIO_printf(Perl_debug_log, "total: refs: %i, strings: %i in %i\targsarray: %i, argsstrings: %i\n", tref, tm, ts, ta, tas); return ret; } @@ -122,7 +122,7 @@ DeadCode(pTHX) # define mstat(str) dump_mstats(str) #else # define mstat(str) \ - PerlIO_printf(PerlIO_stderr(), "%s: perl not compiled with DEBUGGING_MSTATS\n",str); + PerlIO_printf(Perl_debug_log, "%s: perl not compiled with DEBUGGING_MSTATS\n",str); #endif MODULE = Devel::Peek PACKAGE = Devel::Peek @@ -142,7 +142,7 @@ PPCODE: SV *dumpop = perl_get_sv("Devel::Peek::dump_ops", FALSE); I32 save_dumpindent = PL_dumpindent; PL_dumpindent = 2; - do_sv_dump(0, PerlIO_stderr(), sv, 0, lim, dumpop && SvTRUE(dumpop), pv_lim); + do_sv_dump(0, Perl_debug_log, sv, 0, lim, dumpop && SvTRUE(dumpop), pv_lim); PL_dumpindent = save_dumpindent; } @@ -159,8 +159,8 @@ PPCODE: PL_dumpindent = 2; for (i=1; i [qw(dynamic dynamic_lib dynamic_bs)], XSPROTOARG => '-noprototypes', # XXX remove later? VERSION_FROM => 'DynaLoader_pm.PL', - PL_FILES => {'DynaLoader_pm.PL'=>'DynaLoader.pm'}, - PM => {'DynaLoader.pm' => '$(INST_LIBDIR)/DynaLoader.pm'}, + PL_FILES => {'DynaLoader_pm.PL'=>'DynaLoader.pm', + 'XSLoader_pm.PL'=>'XSLoader.pm'}, + PM => {'DynaLoader.pm' => '$(INST_LIBDIR)/DynaLoader.pm', + 'XSLoader.pm' => '$(INST_LIBDIR)/XSLoader.pm'}, clean => {FILES => 'DynaLoader.c DynaLoader.xs DynaLoader.pm'}, ); sub MY::postamble { ' DynaLoader.xs: $(DLSRC) + $(RM_F) $@ $(CP) $? $@ # Perform very simple tests just to check for major gaffs. diff --git a/ext/DynaLoader/XSLoader_pm.PL b/ext/DynaLoader/XSLoader_pm.PL new file mode 100644 index 0000000..8cdfd63 --- /dev/null +++ b/ext/DynaLoader/XSLoader_pm.PL @@ -0,0 +1,158 @@ +use Config; + +sub to_string { + my ($value) = @_; + $value =~ s/\\/\\\\/g; + $value =~ s/'/\\'/g; + return "'$value'"; +} + +unlink "XSLoader.pm" if -f "XSLoader.pm"; +open OUT, ">XSLoader.pm" or die $!; +print OUT <<'EOT'; +# Generated from XSLoader.pm.PL (resolved %Config::Config value) + +package XSLoader; + +# And Gandalf said: 'Many folk like to know beforehand what is to +# be set on the table; but those who have laboured to prepare the +# feast like to keep their secret; for wonder makes the words of +# praise louder.' + +# (Quote from Tolkien sugested by Anno Siegel.) +# +# See pod text at end of file for documentation. +# See also ext/DynaLoader/README in source tree for other information. +# +# Tim.Bunce@ig.co.uk, August 1994 + +$VERSION = "0.01"; # avoid typo warning + +# enable debug/trace messages from DynaLoader perl code +# $dl_debug = $ENV{PERL_DL_DEBUG} || 0 unless defined $dl_debug; + +EOT + +print OUT ' my $dl_dlext = ', to_string($Config::Config{'dlext'}), ";\n" ; + +print OUT <<'EOT'; + +# No prizes for guessing why we don't say 'bootstrap DynaLoader;' here. +package DynaLoader; +boot_DynaLoader('DynaLoader') if defined(&boot_DynaLoader) && + !defined(&dl_load_file); +package XSLoader; + +1; # End of main code + +# The bootstrap function cannot be autoloaded (without complications) +# so we define it here: + +sub load { + package DynaLoader; + + my($module) = $_[0]; + + # work with static linking too + my $b = "$module\::bootstrap"; + goto &$b if defined &$b; + + goto retry unless $module and defined &dl_load_file; + + my @modparts = split(/::/,$module); + my $modfname = $modparts[-1]; + +EOT + +print OUT <<'EOT' if defined &DynaLoader::mod2fname; + # Some systems have restrictions on files names for DLL's etc. + # mod2fname returns appropriate file base name (typically truncated) + # It may also edit @modparts if required. + $modfname = &mod2fname(\@modparts) if defined &mod2fname; + +EOT + +print OUT <<'EOT'; + my $modpname = join('/',@modparts); + my $modlibname = (caller())[1]; + my $c = @modparts; + $modlibname =~ s,[\\/][^\\/]+$,, while $c--; # Q&D basename + my $file = "$modlibname/auto/$modpname/$modfname.$dl_dlext"; + +# print STDERR "XSLoader::load for $module ($file)\n" if $dl_debug; + + my $bs = $file; + $bs =~ s/(\.\w+)?(;\d*)?$/\.bs/; # look for .bs 'beside' the library + + goto retry if not -f $file or -s $bs; + + my $bootname = "boot_$module"; + $bootname =~ s/\W/_/g; + @dl_require_symbols = ($bootname); + + # Many dynamic extension loading problems will appear to come from + # this section of code: XYZ failed at line 123 of DynaLoader.pm. + # Often these errors are actually occurring in the initialisation + # C code of the extension XS file. Perl reports the error as being + # in this perl code simply because this was the last perl code + # it executed. + + my $libref = dl_load_file($file, 0) or do { + require Carp; + Carp::croak("Can't load '$file' for module $module: " . dl_error()); + }; + push(@dl_librefs,$libref); # record loaded object + + my @unresolved = dl_undef_symbols(); + if (@unresolved) { + require Carp; + Carp::carp("Undefined symbols present after loading $file: @unresolved\n"); + } + + my $boot_symbol_ref = dl_find_symbol($libref, $bootname) or do { + require Carp; + Carp::croak("Can't find '$bootname' symbol in $file\n"); + }; + + my $xs = dl_install_xsub("${module}::bootstrap", $boot_symbol_ref, $file); + + push(@dl_modules, $module); # record loaded module + + # See comment block above + return &$xs(@_); + + retry: + require DynaLoader; + goto &DynaLoader::bootstrap_inherit; +} + +__END__ + +=head1 NAME + +XSLoader - Dynamically load C libraries into Perl code + +=head1 SYNOPSIS + + package YourPackage; + use XSLoader; + + XSLoader::load 'YourPackage', @args; + +=head1 DESCRIPTION + +This module defines a standard I interface to the dynamic +linking mechanisms available on many platforms. Its primary purpose is +to implement cheap automatic dynamic loading of Perl modules. + +For more complicated interface see L. + +=head1 AUTHOR + +Ilya Zakharevich: extraction from DynaLoader. + +=cut +EOT + +close OUT or die $!; + diff --git a/ext/DynaLoader/dl_aix.xs b/ext/DynaLoader/dl_aix.xs index 96bce4e..f845681 100644 --- a/ext/DynaLoader/dl_aix.xs +++ b/ext/DynaLoader/dl_aix.xs @@ -29,6 +29,21 @@ #include #include +/* When using Perl extensions written in C++ the longer versions + * of load() and unload() from libC and libC_r need to be used, + * otherwise statics in the extensions won't get initialized right. + * -- Stephanie Beals */ +#ifdef USE_libC /* The define comes, when it comes, from hints/aix.pl. */ +# define LOAD loadAndInit +# define UNLOAD terminateAndUnload +# ifdef USE_load_h +# include +# endif +#else +# define LOAD load +# define UNLOAD unload +#endif + /* * AIX 4.3 does remove some useful definitions from ldfcn.h. Define * these here to compensate for that lossage. @@ -193,7 +208,7 @@ void *dlopen(char *path, int mode) * load should be declared load(const char *...). Thus we * cast the path to a normal char *. Ugly. */ - if ((mp->entry = (void *)load((char *)path, + if ((mp->entry = (void *)LOAD((char *)path, #ifdef L_LIBPATH_EXEC L_LIBPATH_EXEC | #endif @@ -324,7 +339,7 @@ int dlclose(void *handle) if (--mp->refCnt > 0) return 0; - result = unload(mp->entry); + result = UNLOAD(mp->entry); if (result == -1) { errvalid++; strerrorcpy(errbuf, errno); @@ -426,7 +441,7 @@ static int readExports(ModulePtr mp) } /* * Traverse the list of loaded modules. The entry point - * returned by load() does actually point to the data + * returned by LOAD() does actually point to the data * segment origin. */ lp = (struct ld_info *)buf; @@ -543,7 +558,7 @@ static int readExports(ModulePtr mp) /* dl_dlopen.xs * * Platform: SunOS/Solaris, possibly others which use dlopen. - * Author: Paul Marquess (pmarquess@bfsec.bt.co.uk) + * Author: Paul Marquess (Paul.Marquess@btinternet.com) * Created: 10th July 1994 * * Modified: @@ -581,11 +596,11 @@ dl_load_file(filename, flags=0) char * filename int flags CODE: - DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags)); + DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags)); if (flags & 0x01) Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename); RETVAL = dlopen(filename, 1) ; - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%x\n", RETVAL)); + DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", RETVAL)); ST(0) = sv_newmortal() ; if (RETVAL == NULL) SaveError(aTHX_ "%s",dlerror()) ; @@ -598,10 +613,10 @@ dl_find_symbol(libhandle, symbolname) void * libhandle char * symbolname CODE: - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_find_symbol(handle=%x, symbol=%s)\n", + DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_find_symbol(handle=%x, symbol=%s)\n", libhandle, symbolname)); RETVAL = dlsym(libhandle, symbolname); - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " symbolref = %x\n", RETVAL)); + DLDEBUG(2,PerlIO_printf(Perl_debug_log, " symbolref = %x\n", RETVAL)); ST(0) = sv_newmortal() ; if (RETVAL == NULL) SaveError(aTHX_ "%s",dlerror()) ; @@ -623,7 +638,7 @@ dl_install_xsub(perl_name, symref, filename="$Package") void * symref char * filename CODE: - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%x)\n", + DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n", perl_name, symref)); ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)(pTHX_ CV *))symref, diff --git a/ext/DynaLoader/dl_beos.xs b/ext/DynaLoader/dl_beos.xs index c26824e..705c8bc 100644 --- a/ext/DynaLoader/dl_beos.xs +++ b/ext/DynaLoader/dl_beos.xs @@ -45,13 +45,13 @@ dl_load_file(filename, flags=0) strcpy(path, filename); } - DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", path, flags)); + DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", path, flags)); bogo = load_add_on(path); - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%lx\n", (unsigned long) RETVAL)); + DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) RETVAL)); ST(0) = sv_newmortal() ; if (bogo < 0) { SaveError(aTHX_ "%s", strerror(bogo)); - PerlIO_printf(PerlIO_stderr(), "load_add_on(%s) : %d (%s)\n", path, bogo, strerror(bogo)); + PerlIO_printf(Perl_debug_log, "load_add_on(%s) : %d (%s)\n", path, bogo, strerror(bogo)); } else { RETVAL = (void *) bogo; sv_setiv( ST(0), PTR2IV(RETVAL) ); @@ -67,21 +67,21 @@ dl_find_symbol(libhandle, symbolname) status_t retcode; void *adr = 0; #ifdef DLSYM_NEEDS_UNDERSCORE - symbolname = form("_%s", symbolname); + symbolname = Perl_form_nocontext("_%s", symbolname); #endif RETVAL = NULL; - DLDEBUG(2, PerlIO_printf(PerlIO_stderr(), + DLDEBUG(2, PerlIO_printf(Perl_debug_log, "dl_find_symbol(handle=%lx, symbol=%s)\n", (unsigned long) libhandle, symbolname)); retcode = get_image_symbol((image_id) libhandle, symbolname, B_SYMBOL_TYPE_TEXT, (void **) &adr); RETVAL = adr; - DLDEBUG(2, PerlIO_printf(PerlIO_stderr(), + DLDEBUG(2, PerlIO_printf(Perl_debug_log, " symbolref = %lx\n", (unsigned long) RETVAL)); ST(0) = sv_newmortal() ; if (RETVAL == NULL) { SaveError(aTHX_ "%s", strerror(retcode)) ; - PerlIO_printf(PerlIO_stderr(), "retcode = %p (%s)\n", retcode, strerror(retcode)); + PerlIO_printf(Perl_debug_log, "retcode = %p (%s)\n", retcode, strerror(retcode)); } else sv_setiv( ST(0), PTR2IV(RETVAL)); @@ -100,7 +100,7 @@ dl_install_xsub(perl_name, symref, filename="$Package") void * symref char * filename CODE: - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%lx)\n", + DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%lx)\n", perl_name, (unsigned long) symref)); ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)(pTHX_ CV *))symref, diff --git a/ext/DynaLoader/dl_cygwin.xs b/ext/DynaLoader/dl_cygwin.xs deleted file mode 100644 index 7f74cdd..0000000 --- a/ext/DynaLoader/dl_cygwin.xs +++ /dev/null @@ -1,148 +0,0 @@ -/* dl_cygwin.xs - * - * Platform: Win32 (Windows NT/Windows 95) - * Author: Wei-Yuen Tan (wyt@hip.com) - * Created: A warm day in June, 1995 - * - * Modified: - * August 23rd 1995 - rewritten after losing everything when I - * wiped off my NT partition (eek!) - */ -/* Modified from the original dl_win32.xs to work with cygwin - -John Cerney 3/26/97 -*/ -/* Porting notes: - -I merely took Paul's dl_dlopen.xs, took out extraneous stuff and -replaced the appropriate SunOS calls with the corresponding Win32 -calls. - -*/ - -#define WIN32_LEAN_AND_MEAN -// Defines from windows needed for this function only. Can't include full -// Cygwin windows headers because of problems with CONTEXT redefinition -// Removed logic to tell not dynamically load static modules. It is assumed that all -// modules are dynamically built. This should be similar to the behavoir on sunOS. -// Leaving in the logic would have required changes to the standard perlmain.c code -// -#include - -//#include -#define LOAD_WITH_ALTERED_SEARCH_PATH (8) -typedef void *HANDLE; -typedef HANDLE HINSTANCE; -#define STDCALL __attribute__ ((stdcall)) -typedef int STDCALL (*FARPROC)(); -#define MAX_PATH 260 - -HINSTANCE -STDCALL -LoadLibraryExA( - char* lpLibFileName, - HANDLE hFile, - unsigned int dwFlags - ); -unsigned int -STDCALL -GetLastError( - void - ); -FARPROC -STDCALL -GetProcAddress( - HINSTANCE hModule, - char* lpProcName - ); - -#include - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#include "dlutils.c" /* SaveError() etc */ - -static void -dl_private_init(pTHX) -{ - (void)dl_generic_private_init(aTHX); -} - - -MODULE = DynaLoader PACKAGE = DynaLoader - -BOOT: - (void)dl_private_init(aTHX); - -void * -dl_load_file(filename,flags=0) - char * filename - int flags - PREINIT: - CODE: - { - char win32_path[MAX_PATH]; - cygwin_conv_to_full_win32_path(filename, win32_path); - filename = win32_path; - - DLDEBUG(1,PerlIO_printf(PerlIO_stderr(),"dl_load_file(%s):\n", filename)); - - RETVAL = (void*) LoadLibraryExA(filename, NULL, LOAD_WITH_ALTERED_SEARCH_PATH ) ; - - DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," libref=%x\n", RETVAL)); - ST(0) = sv_newmortal() ; - if (RETVAL == NULL){ - SaveError(aTHX_ "%d",GetLastError()) ; - } else { - sv_setiv( ST(0), PTR2IV(RETVAL) ); - } - } - - - -void * -dl_find_symbol(libhandle, symbolname) - void * libhandle - char * symbolname - CODE: - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_find_symbol(handle=%x, symbol=%s)\n", - libhandle, symbolname)); - RETVAL = (void*) GetProcAddress((HINSTANCE) libhandle, symbolname); - DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," symbolref = %x\n", RETVAL)); - ST(0) = sv_newmortal() ; - if (RETVAL == NULL) - SaveError(aTHX_ "%d",GetLastError()) ; - else - sv_setiv( ST(0), PTR2IV(RETVAL)); - - -void -dl_undef_symbols() - PPCODE: - - - -# These functions should not need changing on any platform: - -void -dl_install_xsub(perl_name, symref, filename="$Package") - char * perl_name - void * symref - char * filename - CODE: - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_install_xsub(name=%s, symref=%x)\n", - perl_name, symref)); - ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name, - (void(*)(pTHX_ CV *))symref, - filename))); - - -char * -dl_error() - CODE: - RETVAL = LastError ; - OUTPUT: - RETVAL - -# end. diff --git a/ext/DynaLoader/dl_dld.xs b/ext/DynaLoader/dl_dld.xs index d427efa..d8fad2a 100644 --- a/ext/DynaLoader/dl_dld.xs +++ b/ext/DynaLoader/dl_dld.xs @@ -52,8 +52,8 @@ dl_private_init(pTHX) { int dlderr; dl_generic_private_init(aTHX); - dl_resolve_using = get_av("DynaLoader::dl_resolve_using", 0x4); - dl_require_symbols = get_av("DynaLoader::dl_require_symbols", 0x4); + dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI); + dl_require_symbols = get_av("DynaLoader::dl_require_symbols", GV_ADDMULTI); #ifdef __linux__ dlderr = dld_init("/proc/self/exe"); if (dlderr) { @@ -62,7 +62,7 @@ dl_private_init(pTHX) if (dlderr) { char *msg = dld_strerror(dlderr); SaveError(aTHX_ "dld_init(%s) failed: %s", PL_origargv[0], msg); - DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "%s", LastError)); + DLDEBUG(1,PerlIO_printf(Perl_debug_log, "%s", LastError)); } #ifdef __linux__ } @@ -85,13 +85,13 @@ dl_load_file(filename, flags=0) GV *gv; CODE: RETVAL = filename; - DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags)); + DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags)); if (flags & 0x01) Perl_croak(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename); max = AvFILL(dl_require_symbols); for (x = 0; x <= max; x++) { char *sym = SvPVX(*av_fetch(dl_require_symbols, x, 0)); - DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dld_create_ref(%s)\n", sym)); + DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_create_ref(%s)\n", sym)); if (dlderr = dld_create_reference(sym)) { SaveError(aTHX_ "dld_create_reference(%s): %s", sym, dld_strerror(dlderr)); @@ -99,7 +99,7 @@ dl_load_file(filename, flags=0) } } - DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dld_link(%s)\n", filename)); + DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_link(%s)\n", filename)); if (dlderr = dld_link(filename)) { SaveError(aTHX_ "dld_link(%s): %s", filename, dld_strerror(dlderr)); goto haverror; @@ -108,13 +108,13 @@ dl_load_file(filename, flags=0) max = AvFILL(dl_resolve_using); for (x = 0; x <= max; x++) { char *sym = SvPVX(*av_fetch(dl_resolve_using, x, 0)); - DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dld_link(%s)\n", sym)); + DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dld_link(%s)\n", sym)); if (dlderr = dld_link(sym)) { SaveError(aTHX_ "dld_link(%s): %s", sym, dld_strerror(dlderr)); goto haverror; } } - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "libref=%s\n", RETVAL)); + DLDEBUG(2,PerlIO_printf(Perl_debug_log, "libref=%s\n", RETVAL)); haverror: ST(0) = sv_newmortal() ; if (dlderr == 0) @@ -126,11 +126,11 @@ dl_find_symbol(libhandle, symbolname) void * libhandle char * symbolname CODE: - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_find_symbol(handle=%x, symbol=%s)\n", + DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_find_symbol(handle=%x, symbol=%s)\n", libhandle, symbolname)); RETVAL = (void *)dld_get_func(symbolname); /* if RETVAL==NULL we should try looking for a non-function symbol */ - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " symbolref = %x\n", RETVAL)); + DLDEBUG(2,PerlIO_printf(Perl_debug_log, " symbolref = %x\n", RETVAL)); ST(0) = sv_newmortal() ; if (RETVAL == NULL) SaveError(aTHX_ "dl_find_symbol: Unable to find '%s' symbol", symbolname) ; @@ -160,7 +160,7 @@ dl_install_xsub(perl_name, symref, filename="$Package") void * symref char * filename CODE: - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%x)\n", + DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n", perl_name, symref)); ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)(pTHX_ CV *))symref, diff --git a/ext/DynaLoader/dl_dlopen.xs b/ext/DynaLoader/dl_dlopen.xs index 641db33..135f511 100644 --- a/ext/DynaLoader/dl_dlopen.xs +++ b/ext/DynaLoader/dl_dlopen.xs @@ -1,7 +1,7 @@ /* dl_dlopen.xs * * Platform: SunOS/Solaris, possibly others which use dlopen. - * Author: Paul Marquess (pmarquess@bfsec.bt.co.uk) + * Author: Paul Marquess (Paul.Marquess@btinternet.com) * Created: 10th July 1994 * * Modified: @@ -146,9 +146,20 @@ void * dl_load_file(filename, flags=0) char * filename int flags - PREINIT: + PREINIT: int mode = RTLD_LAZY; - CODE: + CODE: +{ +#if defined(DLOPEN_WONT_DO_RELATIVE_PATHS) + char pathbuf[PATH_MAX + 2]; + if (*filename != '/' && strchr(filename, '/')) { + if (getcwd(pathbuf, PATH_MAX - strlen(filename))) { + strcat(pathbuf, "/"); + strcat(pathbuf, filename); + filename = pathbuf; + } + } +#endif #ifdef RTLD_NOW if (dl_nonlazy) mode = RTLD_NOW; @@ -159,15 +170,15 @@ dl_load_file(filename, flags=0) #else Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename); #endif - DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags)); + DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags)); RETVAL = dlopen(filename, mode) ; - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%lx\n", (unsigned long) RETVAL)); + DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) RETVAL)); ST(0) = sv_newmortal() ; if (RETVAL == NULL) SaveError(aTHX_ "%s",dlerror()) ; else sv_setiv( ST(0), PTR2IV(RETVAL)); - +} void * dl_find_symbol(libhandle, symbolname) @@ -175,13 +186,13 @@ dl_find_symbol(libhandle, symbolname) char * symbolname CODE: #ifdef DLSYM_NEEDS_UNDERSCORE - symbolname = form("_%s", symbolname); + symbolname = Perl_form_nocontext("_%s", symbolname); #endif - DLDEBUG(2, PerlIO_printf(PerlIO_stderr(), + DLDEBUG(2, PerlIO_printf(Perl_debug_log, "dl_find_symbol(handle=%lx, symbol=%s)\n", (unsigned long) libhandle, symbolname)); RETVAL = dlsym(libhandle, symbolname); - DLDEBUG(2, PerlIO_printf(PerlIO_stderr(), + DLDEBUG(2, PerlIO_printf(Perl_debug_log, " symbolref = %lx\n", (unsigned long) RETVAL)); ST(0) = sv_newmortal() ; if (RETVAL == NULL) @@ -204,7 +215,7 @@ dl_install_xsub(perl_name, symref, filename="$Package") void * symref char * filename CODE: - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%lx)\n", + DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%lx)\n", perl_name, (unsigned long) symref)); ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)(pTHX_ CV *))symref, diff --git a/ext/DynaLoader/dl_hpux.xs b/ext/DynaLoader/dl_hpux.xs index 180679f..582c047 100644 --- a/ext/DynaLoader/dl_hpux.xs +++ b/ext/DynaLoader/dl_hpux.xs @@ -36,7 +36,7 @@ static void dl_private_init(pTHX) { (void)dl_generic_private_init(aTHX); - dl_resolve_using = get_av("DynaLoader::dl_resolve_using", 0x4); + dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI); } MODULE = DynaLoader PACKAGE = DynaLoader @@ -53,7 +53,7 @@ dl_load_file(filename, flags=0) shl_t obj = NULL; int i, max, bind_type; CODE: - DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags)); + DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags)); if (flags & 0x01) Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename); if (dl_nonlazy) { @@ -76,17 +76,17 @@ dl_load_file(filename, flags=0) max = AvFILL(dl_resolve_using); for (i = 0; i <= max; i++) { char *sym = SvPVX(*av_fetch(dl_resolve_using, i, 0)); - DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s) (dependent)\n", sym)); + DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s) (dependent)\n", sym)); obj = shl_load(sym, bind_type, 0L); if (obj == NULL) { goto end; } } - DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s): ", filename)); + DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s): ", filename)); obj = shl_load(filename, bind_type, 0L); - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%x\n", obj)); + DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", obj)); end: ST(0) = sv_newmortal() ; if (obj == NULL) @@ -104,9 +104,9 @@ dl_find_symbol(libhandle, symbolname) void *symaddr = NULL; int status; #ifdef __hp9000s300 - symbolname = form("_%s", symbolname); + symbolname = Perl_form_nocontext("_%s", symbolname); #endif - DLDEBUG(2, PerlIO_printf(PerlIO_stderr(), + DLDEBUG(2, PerlIO_printf(Perl_debug_log, "dl_find_symbol(handle=%lx, symbol=%s)\n", (unsigned long) libhandle, symbolname)); @@ -114,11 +114,11 @@ dl_find_symbol(libhandle, symbolname) errno = 0; status = shl_findsym(&obj, symbolname, TYPE_PROCEDURE, &symaddr); - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " symbolref(PROCEDURE) = %x\n", symaddr)); + DLDEBUG(2,PerlIO_printf(Perl_debug_log, " symbolref(PROCEDURE) = %x\n", symaddr)); if (status == -1 && errno == 0) { /* try TYPE_DATA instead */ status = shl_findsym(&obj, symbolname, TYPE_DATA, &symaddr); - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " symbolref(DATA) = %x\n", symaddr)); + DLDEBUG(2,PerlIO_printf(Perl_debug_log, " symbolref(DATA) = %x\n", symaddr)); } if (status == -1) { @@ -142,7 +142,7 @@ dl_install_xsub(perl_name, symref, filename="$Package") void * symref char * filename CODE: - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%x)\n", + DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n", perl_name, symref)); ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)(pTHX_ CV *))symref, diff --git a/ext/DynaLoader/dl_mpeix.xs b/ext/DynaLoader/dl_mpeix.xs index 913e259..7d27901 100644 --- a/ext/DynaLoader/dl_mpeix.xs +++ b/ext/DynaLoader/dl_mpeix.xs @@ -36,7 +36,7 @@ static void dl_private_init(pTHX) { (void)dl_generic_private_init(aTHX); - dl_resolve_using = get_av("DynaLoader::dl_resolve_using", 0x4); + dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI); } MODULE = DynaLoader PACKAGE = DynaLoader @@ -53,7 +53,7 @@ dl_load_file(filename, flags=0) p_mpe_dld obj = NULL; int i; CODE: - DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename, + DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename, flags)); if (flags & 0x01) Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s @@ -68,7 +68,7 @@ flags)); else sprintf(obj->filename," %s ",filename); - DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," libref=%x\n", obj)); + DLDEBUG(2,PerlIO_printf(Perl_debug_log," libref=%x\n", obj)); ST(0) = sv_newmortal() ; if (obj == NULL) @@ -86,7 +86,7 @@ dl_find_symbol(libhandle, symbolname) char symname[PATH_MAX + 3]; void * symaddr = NULL; int status; - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_find_symbol(handle=%x, symbol=%s)\n", + DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_find_symbol(handle=%x, symbol=%s)\n", libhandle, symbolname)); ST(0) = sv_newmortal() ; errno = 0; @@ -95,7 +95,7 @@ dl_find_symbol(libhandle, symbolname) HPGETPROCPLABEL(8, symname, &symaddr, &status, obj->filename, 1, 0, &datalen, 1, 0, 0); - DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," symbolref(PROCEDURE) = %x, status=%x\n", symaddr, status)); + DLDEBUG(2,PerlIO_printf(Perl_debug_log," symbolref(PROCEDURE) = %x, status=%x\n", symaddr, status)); if (status != 0) { SaveError(aTHX_"%s",(errno) ? Strerror(errno) : "Symbol not found") ; @@ -115,7 +115,7 @@ dl_install_xsub(perl_name, symref, filename="$Package") void * symref char * filename CODE: - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_install_xsub(name=%s, symref=%x)\n", + DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_install_xsub(name=%s, symref=%x)\n", perl_name, symref)); ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)(pTHX_ CV *))symref, diff --git a/ext/DynaLoader/dl_next.xs b/ext/DynaLoader/dl_next.xs index 54d4be0..b8c19f2 100644 --- a/ext/DynaLoader/dl_next.xs +++ b/ext/DynaLoader/dl_next.xs @@ -93,11 +93,11 @@ static void TranslateError index = number; if (index > NUM_OFI_ERRORS - 1) index = NUM_OFI_ERRORS - 1; - error = form(OFIErrorStrings[index], path, number); + error = Perl_form_nocontext(OFIErrorStrings[index], path, number); break; default: - error = form("%s(%d): Totally unknown error type %d\n", + error = Perl_form_nocontext("%s(%d): Totally unknown error type %d\n", path, number, type); break; } @@ -210,7 +210,7 @@ char *symbol; NXStream *nxerr = OpenError(); unsigned long symref = 0; - if (!rld_lookup(nxerr, form("_%s", symbol), &symref)) + if (!rld_lookup(nxerr, Perl_form_nocontext("_%s", symbol), &symref)) TransferError(nxerr); CloseError(nxerr); return (void*) symref; @@ -226,7 +226,7 @@ static void dl_private_init(pTHX) { (void)dl_generic_private_init(aTHX); - dl_resolve_using = get_av("DynaLoader::dl_resolve_using", 0x4); + dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI); } MODULE = DynaLoader PACKAGE = DynaLoader @@ -243,11 +243,11 @@ dl_load_file(filename, flags=0) PREINIT: int mode = 1; CODE: - DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags)); + DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags)); if (flags & 0x01) Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename); RETVAL = dlopen(filename, mode) ; - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%x\n", RETVAL)); + DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", RETVAL)); ST(0) = sv_newmortal() ; if (RETVAL == NULL) SaveError(aTHX_ "%s",dlerror()) ; @@ -261,13 +261,13 @@ dl_find_symbol(libhandle, symbolname) char * symbolname CODE: #if NS_TARGET_MAJOR >= 4 - symbolname = form("_%s", symbolname); + symbolname = Perl_form_nocontext("_%s", symbolname); #endif - DLDEBUG(2, PerlIO_printf(PerlIO_stderr(), + DLDEBUG(2, PerlIO_printf(Perl_debug_log, "dl_find_symbol(handle=%lx, symbol=%s)\n", (unsigned long) libhandle, symbolname)); RETVAL = dlsym(libhandle, symbolname); - DLDEBUG(2, PerlIO_printf(PerlIO_stderr(), + DLDEBUG(2, PerlIO_printf(Perl_debug_log, " symbolref = %lx\n", (unsigned long) RETVAL)); ST(0) = sv_newmortal() ; if (RETVAL == NULL) @@ -290,7 +290,7 @@ dl_install_xsub(perl_name, symref, filename="$Package") void * symref char * filename CODE: - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%x)\n", + DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n", perl_name, symref)); ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)(pTHX_ CV *))symref, diff --git a/ext/DynaLoader/dl_rhapsody.xs b/ext/DynaLoader/dl_rhapsody.xs index a56452e..768e99ed 100644 --- a/ext/DynaLoader/dl_rhapsody.xs +++ b/ext/DynaLoader/dl_rhapsody.xs @@ -85,11 +85,11 @@ static void TranslateError index = number; if (index > NUM_OFI_ERRORS - 1) index = NUM_OFI_ERRORS - 1; - error = form(OFIErrorStrings[index], path, number); + error = Perl_form_nocontext(OFIErrorStrings[index], path, number); break; default: - error = form("%s(%d): Totally unknown error type %d\n", + error = Perl_form_nocontext("%s(%d): Totally unknown error type %d\n", path, number, type); break; } @@ -140,7 +140,7 @@ static void dl_private_init(pTHX) { (void)dl_generic_private_init(aTHX); - dl_resolve_using = get_av("DynaLoader::dl_resolve_using", 0x4); + dl_resolve_using = get_av("DynaLoader::dl_resolve_using", GV_ADDMULTI); } MODULE = DynaLoader PACKAGE = DynaLoader @@ -157,11 +157,11 @@ dl_load_file(filename, flags=0) PREINIT: int mode = 1; CODE: - DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags)); + DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags)); if (flags & 0x01) Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename); RETVAL = dlopen(filename, mode) ; - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%x\n", RETVAL)); + DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", RETVAL)); ST(0) = sv_newmortal() ; if (RETVAL == NULL) SaveError(aTHX_ "%s",dlerror()) ; @@ -174,12 +174,12 @@ dl_find_symbol(libhandle, symbolname) void * libhandle char * symbolname CODE: - symbolname = form("_%s", symbolname); - DLDEBUG(2, PerlIO_printf(PerlIO_stderr(), + symbolname = Perl_form_nocontext("_%s", symbolname); + DLDEBUG(2, PerlIO_printf(Perl_debug_log, "dl_find_symbol(handle=%lx, symbol=%s)\n", (unsigned long) libhandle, symbolname)); RETVAL = dlsym(libhandle, symbolname); - DLDEBUG(2, PerlIO_printf(PerlIO_stderr(), + DLDEBUG(2, PerlIO_printf(Perl_debug_log, " symbolref = %lx\n", (unsigned long) RETVAL)); ST(0) = sv_newmortal() ; if (RETVAL == NULL) @@ -202,7 +202,7 @@ dl_install_xsub(perl_name, symref, filename="$Package") void * symref char * filename CODE: - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%x)\n", + DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n", perl_name, symref)); ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)(pTHX_ CV *))symref, diff --git a/ext/DynaLoader/dl_vmesa.xs b/ext/DynaLoader/dl_vmesa.xs index 9e4908c..8595e44 100644 --- a/ext/DynaLoader/dl_vmesa.xs +++ b/ext/DynaLoader/dl_vmesa.xs @@ -116,9 +116,9 @@ dl_load_file(filename, flags=0) CODE: if (flags & 0x01) Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename); - DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filename,flags)); + DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags)); RETVAL = dlopen(filename) ; - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), " libref=%lx\n", (unsigned long) RETVAL)); + DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%lx\n", (unsigned long) RETVAL)); ST(0) = sv_newmortal() ; if (RETVAL == NULL) SaveError(aTHX_ "%s",dlerror()) ; @@ -131,11 +131,11 @@ dl_find_symbol(libhandle, symbolname) void * libhandle char * symbolname CODE: - DLDEBUG(2, PerlIO_printf(PerlIO_stderr(), + DLDEBUG(2, PerlIO_printf(Perl_debug_log, "dl_find_symbol(handle=%lx, symbol=%s)\n", (unsigned long) libhandle, symbolname)); RETVAL = dlsym(libhandle, symbolname); - DLDEBUG(2, PerlIO_printf(PerlIO_stderr(), + DLDEBUG(2, PerlIO_printf(Perl_debug_log, " symbolref = %lx\n", (unsigned long) RETVAL)); ST(0) = sv_newmortal() ; if (RETVAL == NULL) @@ -158,7 +158,7 @@ dl_install_xsub(perl_name, symref, filename="$Package") void * symref char * filename CODE: - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%lx)\n", + DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%lx)\n", perl_name, (unsigned long) symref)); ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)(pTHX_ CV *))symref, diff --git a/ext/DynaLoader/dl_vms.xs b/ext/DynaLoader/dl_vms.xs index 409d586..29ab7c3 100644 --- a/ext/DynaLoader/dl_vms.xs +++ b/ext/DynaLoader/dl_vms.xs @@ -128,7 +128,7 @@ findsym_handler(void *sig, void *mech) myvec[0] = args = usig[0] > 10 ? 9 : usig[0] - 1; while (--args) myvec[args] = usig[args]; _ckvmssts(sys$putmsg(myvec,copy_errmsg,0,0)); - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "findsym_handler: received\n\t%s\n",LastError)); + DLDEBUG(2,PerlIO_printf(Perl_debug_log, "findsym_handler: received\n\t%s\n",LastError)); return SS$_CONTINUE; } @@ -179,11 +179,11 @@ dl_expandspec(filespec) dlfab.fab$b_fns = strlen(vmsspec); dlfab.fab$l_dna = 0; dlfab.fab$b_dns = 0; - DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_expand_filespec(%s):\n",vmsspec)); + DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_expand_filespec(%s):\n",vmsspec)); /* On the first pass, just parse the specification string */ dlnam.nam$b_nop = NAM$M_SYNCHK; sts = sys$parse(&dlfab); - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tSYNCHK sys$parse = %d\n",sts)); + DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tSYNCHK sys$parse = %d\n",sts)); if (!(sts & 1)) { dl_set_error(dlfab.fab$l_sts,dlfab.fab$l_stv); ST(0) = &PL_sv_undef; @@ -196,7 +196,7 @@ dl_expandspec(filespec) dlnam.nam$b_type + dlnam.nam$b_ver); deflen += dlnam.nam$b_type + dlnam.nam$b_ver; memcpy(vmsspec,dlnam.nam$l_name,dlnam.nam$b_name); - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tsplit filespec: name = %.*s, default = %.*s\n", + DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tsplit filespec: name = %.*s, default = %.*s\n", dlnam.nam$b_name,vmsspec,deflen,defspec)); /* . . . and go back to expand it */ dlnam.nam$b_nop = 0; @@ -204,7 +204,7 @@ dl_expandspec(filespec) dlfab.fab$b_dns = deflen; dlfab.fab$b_fns = dlnam.nam$b_name; sts = sys$parse(&dlfab); - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tname/default sys$parse = %d\n",sts)); + DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tname/default sys$parse = %d\n",sts)); if (!(sts & 1)) { dl_set_error(dlfab.fab$l_sts,dlfab.fab$l_stv); ST(0) = &PL_sv_undef; @@ -212,14 +212,14 @@ dl_expandspec(filespec) else { /* Now find the actual file */ sts = sys$search(&dlfab); - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tsys$search = %d\n",sts)); + DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tsys$search = %d\n",sts)); if (!(sts & 1)) { dl_set_error(dlfab.fab$l_sts,dlfab.fab$l_stv); ST(0) = &PL_sv_undef; } else { ST(0) = sv_2mortal(newSVpvn(dlnam.nam$l_rsa,dlnam.nam$b_rsl)); - DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "\tresult = \\%.*s\\\n", + DLDEBUG(1,PerlIO_printf(Perl_debug_log, "\tresult = \\%.*s\\\n", dlnam.nam$b_rsl,dlnam.nam$l_rsa)); } } @@ -247,16 +247,16 @@ dl_load_file(filespec, flags) void (*entry)(); CODE: - DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filespec,flags)); + DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filespec,flags)); specdsc.dsc$a_pointer = tovmsspec(filespec,vmsspec); specdsc.dsc$w_length = strlen(specdsc.dsc$a_pointer); - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tVMS-ified filespec is %s\n", + DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tVMS-ified filespec is %s\n", specdsc.dsc$a_pointer)); New(1399,dlptr,1,struct libref); dlptr->name.dsc$b_dtype = dlptr->defspec.dsc$b_dtype = DSC$K_DTYPE_T; dlptr->name.dsc$b_class = dlptr->defspec.dsc$b_class = DSC$K_CLASS_S; sts = sys$filescan(&specdsc,namlst,0); - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tsys$filescan: returns %d, name is %.*s\n", + DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tsys$filescan: returns %d, name is %.*s\n", sts,namlst[0].len,namlst[0].string)); if (!(sts & 1)) { failed = 1; @@ -272,21 +272,21 @@ dl_load_file(filespec, flags) memcpy(dlptr->defspec.dsc$a_pointer + deflen, namlst[0].string + namlst[0].len, dlptr->defspec.dsc$w_length - deflen); - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tlibref = name: %s, defspec: %.*s\n", + DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tlibref = name: %s, defspec: %.*s\n", dlptr->name.dsc$a_pointer, dlptr->defspec.dsc$w_length, dlptr->defspec.dsc$a_pointer)); if (!(reqSVhndl = av_fetch(dl_require_symbols,0,FALSE)) || !(reqSV = *reqSVhndl)) { - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\t@dl_require_symbols empty, returning untested libref\n")); + DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\t@dl_require_symbols empty, returning untested libref\n")); } else { symdsc.dsc$w_length = SvCUR(reqSV); symdsc.dsc$a_pointer = SvPVX(reqSV); - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\t$dl_require_symbols[0] = %.*s\n", + DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\t$dl_require_symbols[0] = %.*s\n", symdsc.dsc$w_length, symdsc.dsc$a_pointer)); sts = my_find_image_symbol(&(dlptr->name),&symdsc, &entry,&(dlptr->defspec)); - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tlib$find_image_symbol returns %d\n",sts)); + DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tlib$find_image_symbol returns %d\n",sts)); if (!(sts&1)) { failed = 1; dl_set_error(sts,0); @@ -316,13 +316,13 @@ dl_find_symbol(librefptr,symname) void (*entry)(); vmssts sts; - DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_find_dymbol(%.*s,%.*s):\n", + DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_find_dymbol(%.*s,%.*s):\n", thislib.name.dsc$w_length, thislib.name.dsc$a_pointer, symdsc.dsc$w_length,symdsc.dsc$a_pointer)); sts = my_find_image_symbol(&(thislib.name),&symdsc, &entry,&(thislib.defspec)); - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tlib$find_image_symbol returns %d\n",sts)); - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tentry point is %d\n", + DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tlib$find_image_symbol returns %d\n",sts)); + DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tentry point is %d\n", (unsigned long int) entry)); if (!(sts & 1)) { /* error message already saved by findsym_handler */ @@ -344,7 +344,7 @@ dl_install_xsub(perl_name, symref, filename="$Package") void * symref char * filename CODE: - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%x)\n", + DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n", perl_name, symref)); ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)(pTHX_ CV *))symref, diff --git a/ext/DynaLoader/dlutils.c b/ext/DynaLoader/dlutils.c index 7391156..664e331 100644 --- a/ext/DynaLoader/dlutils.c +++ b/ext/DynaLoader/dlutils.c @@ -30,12 +30,13 @@ dl_generic_private_init(pTHXo) /* called by dl_*.xs dl_private_init() */ { char *perl_dl_nonlazy; #ifdef DEBUGGING - dl_debug = SvIV(get_sv("DynaLoader::dl_debug", 0x04) ); + SV *sv = get_sv("DynaLoader::dl_debug", 0); + dl_debug = sv ? SvIV(sv) : 0; #endif if ( (perl_dl_nonlazy = getenv("PERL_DL_NONLAZY")) != NULL ) dl_nonlazy = atoi(perl_dl_nonlazy); if (dl_nonlazy) - DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "DynaLoader bind mode is 'non-lazy'\n")); + DLDEBUG(1,PerlIO_printf(Perl_debug_log, "DynaLoader bind mode is 'non-lazy'\n")); #ifdef DL_LOADONCEONLY if (!dl_loaded_files) dl_loaded_files = newHV(); /* provide cache for dl_*.xs if needed */ @@ -69,6 +70,6 @@ SaveError(pTHXo_ char* pat, ...) /* Copy message into LastError (including terminating null char) */ strncpy(LastError, message, len) ; - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "DynaLoader: stored error msg '%s'\n",LastError)); + DLDEBUG(2,PerlIO_printf(Perl_debug_log, "DynaLoader: stored error msg '%s'\n",LastError)); } diff --git a/ext/DynaLoader/hints/aix.pl b/ext/DynaLoader/hints/aix.pl new file mode 100644 index 0000000..4225979 --- /dev/null +++ b/ext/DynaLoader/hints/aix.pl @@ -0,0 +1,10 @@ +# See dl_aix.xs for details. +use Config; +if ($Config{libs} =~ /-lC/ && -f '/lib/libC.a') { + $self->{CCFLAGS} = $Config{ccflags} . ' -DUSE_libC'; + if (-f '/usr/ibmcxx/include/load.h') { + $self->{CCFLAGS} .= ' -I/usr/ibmcxx/include -DUSE_load_h'; + } elsif (-f '/usr/lpp/xlC/include/load.h') { + $self->{CCFLAGS} .= ' -I/usr/lpp/xlC/include -DUSE_load_h'; + } +} diff --git a/ext/DynaLoader/hints/openbsd.pl b/ext/DynaLoader/hints/openbsd.pl new file mode 100644 index 0000000..aeaa92c --- /dev/null +++ b/ext/DynaLoader/hints/openbsd.pl @@ -0,0 +1,3 @@ +# XXX Configure test needed? +# Some OpenBSDs seem to have a dlopen() that won't accept relative paths +$self->{CCFLAGS} = $Config{ccflags} . ' -DDLOPEN_WONT_DO_RELATIVE_PATHS'; diff --git a/ext/Errno/Errno_pm.PL b/ext/Errno/Errno_pm.PL index c0598a4..75dacfc 100644 --- a/ext/Errno/Errno_pm.PL +++ b/ext/Errno/Errno_pm.PL @@ -21,7 +21,7 @@ unlink "errno.c" if -f "errno.c"; sub process_file { my($file) = @_; - return unless defined $file; + return unless defined $file and -f $file; local *FH; if (($^O eq 'VMS') && ($Config{vms_cc_type} ne 'gnuc')) { @@ -180,8 +180,9 @@ use Exporter (); use Config; use strict; -\$Config{'myarchname'} eq "$Config{'myarchname'}" or - die "Errno architecture ($Config{'myarchname'}) does not match executable architecture (\$Config{'myarchname'})"; +"\$Config{'archname'}-\$Config{'osvers'}" eq +"$Config{'archname'}-$Config{'osvers'}" or + die "Errno architecture ($Config{'archname'}-$Config{'osvers'}) does not match executable architecture (\$Config{'archname'}-\$Config{'osvers'})"; \$VERSION = "$VERSION"; \@ISA = qw(Exporter); diff --git a/ext/Fcntl/Fcntl.pm b/ext/Fcntl/Fcntl.pm index 699ee4a..1eb14e9 100644 --- a/ext/Fcntl/Fcntl.pm +++ b/ext/Fcntl/Fcntl.pm @@ -45,8 +45,8 @@ what constants are implemented in your system. use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $AUTOLOAD); require Exporter; -require DynaLoader; -@ISA = qw(Exporter DynaLoader); +use XSLoader (); +@ISA = qw(Exporter); $VERSION = "1.03"; # Items to export into callers namespace by default # (move infrequently used names to @EXPORT_OK below) @@ -110,6 +110,8 @@ $VERSION = "1.03"; O_TEXT O_TRUNC O_WRONLY + O_ALIAS + O_RSRC SEEK_SET SEEK_CUR SEEK_END @@ -159,6 +161,6 @@ sub AUTOLOAD { goto &$AUTOLOAD; } -bootstrap Fcntl $VERSION; +XSLoader::load 'Fcntl', $VERSION; 1; diff --git a/ext/Fcntl/Fcntl.xs b/ext/Fcntl/Fcntl.xs index 0dab7f1..08252b6 100644 --- a/ext/Fcntl/Fcntl.xs +++ b/ext/Fcntl/Fcntl.xs @@ -504,6 +504,18 @@ constant(char *name, int arg) #else goto not_there; #endif + if (strEQ(name, "O_ALIAS")) +#ifdef O_ALIAS + return O_ALIAS; +#else + goto not_there; +#endif + if (strEQ(name, "O_RSRC")) +#ifdef O_RSRC + return O_RSRC; +#else + goto not_there; +#endif } else goto not_there; break; diff --git a/ext/File/Glob/Changes b/ext/File/Glob/Changes new file mode 100644 index 0000000..e246c6d --- /dev/null +++ b/ext/File/Glob/Changes @@ -0,0 +1,47 @@ +Revision history for Perl extension File::Glob + +0.00 Tue Dec 17 10:51:33 1996 + - original version; created by h2xs 1.16 + +0.90 Tue Dec 17 13:58:32 MST 1996 + - implemented first pass access to glob(3), + but it's clumsy and it looks like it leaks + memory. + +0.91 Thu Sep 4 08:43:55 CDT 1997 + - included CORE/config.h portability macros + - s/glob/bsd_glob/ to avoid calling and including the + system's glob stuff + - added GLOB_DEBUG for (surprise!) glob debugging + - tainted all filenames returned from &Glob::BSD::glob + +0.92 Tue Sep 30 08:31:57 CDT 1997 + - only use lstat if HAS_LSTAT is defined + - renamed the glob flags to GLOB_* + - added GLOB_CSH convenience macro for csh(1) globbing + These changes thanks to Hans Mulder + - fixed an incompatibility with csh(1) globbing where a + pattern like {A*,b,c} wouldn't expand properly + - various compatibility changes + - fixed and added tests + +0.93 Wed Jul 1 10:39:47 CDT 1998 + - renamed module to File::BSDGlob + - enabled 'globally' import directive to override the core + glob + - added Sarathy's tests for File::DosGlob +0.99 Tue Oct 12 06:42:02 PDT 1999 + - renamed module to File::Glob for incorporation into the + Perl source distribution + - ansified prototypes + - s/struct stat/Stat_t/ + - split on spaces to make <*.c *.h> work (for compatibility) +0.991 Tue Oct 26 09:48:00 BST 1999 + - Add case-insensitive matching (GLOB_NOCASE) + - Make glob_csh case insensitive by default on Win32, VMS, + OS/2, DOS, RISC OS, and Mac OS + - Add support for :case and :nocase tags + - Hack to make patterns like C:* work on DOSISH systems + - Add support for either \ or / as separators on DOSISH systems + - Limit effect of \ as a quoting operator on DOSISH systems to + when it precedes one of []{}-~\ (to minimise backslashitis). diff --git a/ext/File/Glob/Glob.pm b/ext/File/Glob/Glob.pm new file mode 100644 index 0000000..6b5ff84 --- /dev/null +++ b/ext/File/Glob/Glob.pm @@ -0,0 +1,373 @@ +package File::Glob; + +use strict; +use Carp; +use vars qw($VERSION @ISA @EXPORT_OK @EXPORT_FAIL + %EXPORT_TAGS $AUTOLOAD $DEFAULT_FLAGS); + +require Exporter; +use XSLoader (); +require AutoLoader; + +@ISA = qw(Exporter AutoLoader); + +@EXPORT_OK = qw( + csh_glob + glob + GLOB_ABEND + GLOB_ALTDIRFUNC + GLOB_BRACE + GLOB_CSH + GLOB_ERR + GLOB_ERROR + GLOB_MARK + GLOB_NOCASE + GLOB_NOCHECK + GLOB_NOMAGIC + GLOB_NOSORT + GLOB_NOSPACE + GLOB_QUOTE + GLOB_TILDE +); + +%EXPORT_TAGS = ( + 'glob' => [ qw( + GLOB_ABEND + GLOB_ALTDIRFUNC + GLOB_BRACE + GLOB_CSH + GLOB_ERR + GLOB_ERROR + GLOB_MARK + GLOB_NOCASE + GLOB_NOCHECK + GLOB_NOMAGIC + GLOB_NOSORT + GLOB_NOSPACE + GLOB_QUOTE + GLOB_TILDE + glob + ) ], +); + +$VERSION = '0.991'; + +sub import { + my $i = 1; + while ($i < @_) { + if ($_[$i] =~ /^:(case|nocase|globally)$/) { + splice(@_, $i, 1); + $DEFAULT_FLAGS &= ~GLOB_NOCASE() if $1 eq 'case'; + $DEFAULT_FLAGS |= GLOB_NOCASE() if $1 eq 'nocase'; + if ($1 eq 'globally') { + local $^W; + *CORE::GLOBAL::glob = \&File::Glob::csh_glob; + } + next; + } + ++$i; + } + goto &Exporter::import; +} + +sub AUTOLOAD { + # This AUTOLOAD is used to 'autoload' constants from the constant() + # XS function. If a constant is not found then control is passed + # to the AUTOLOAD in AutoLoader. + + my $constname; + ($constname = $AUTOLOAD) =~ s/.*:://; + my $val = constant($constname, @_ ? $_[0] : 0); + if ($! != 0) { + if ($! =~ /Invalid/) { + $AutoLoader::AUTOLOAD = $AUTOLOAD; + goto &AutoLoader::AUTOLOAD; + } + else { + croak "Your vendor has not defined File::Glob macro $constname"; + } + } + eval "sub $AUTOLOAD { $val }"; + goto &$AUTOLOAD; +} + +XSLoader::load 'File::Glob', $VERSION; + +# Preloaded methods go here. + +sub GLOB_ERROR { + return constant('GLOB_ERROR', 0); +} + +sub GLOB_CSH () { GLOB_BRACE() | GLOB_NOMAGIC() | GLOB_QUOTE() | GLOB_TILDE() } + +$DEFAULT_FLAGS = GLOB_CSH(); +if ($^O =~ /^(?:MSWin32|VMS|os2|dos|riscos|MacOS)$/) { + $DEFAULT_FLAGS |= GLOB_NOCASE(); +} + +# Autoload methods go after =cut, and are processed by the autosplit program. + +sub glob { + return doglob(@_); +} + +## borrowed heavily from gsar's File::DosGlob +my %iter; +my %entries; + +sub csh_glob { + my $pat = shift; + my $cxix = shift; + my @pat; + + # glob without args defaults to $_ + $pat = $_ unless defined $pat; + + # extract patterns + if ($pat =~ /\s/) { + # XXX this is needed for compatibility with the csh + # implementation in Perl. Need to support a flag + # to disable this behavior. + require Text::ParseWords; + @pat = Text::ParseWords::parse_line('\s+',0,$pat); + } + + # assume global context if not provided one + $cxix = '_G_' unless defined $cxix; + $iter{$cxix} = 0 unless exists $iter{$cxix}; + + # if we're just beginning, do it all first + if ($iter{$cxix} == 0) { + if (@pat) { + $entries{$cxix} = [ map { doglob($_, $DEFAULT_FLAGS) } @pat ]; + } + else { + $entries{$cxix} = [ doglob($pat, $DEFAULT_FLAGS) ]; + } + } + + # chuck it all out, quick or slow + if (wantarray) { + delete $iter{$cxix}; + return @{delete $entries{$cxix}}; + } + else { + if ($iter{$cxix} = scalar @{$entries{$cxix}}) { + return shift @{$entries{$cxix}}; + } + else { + # return undef for EOL + delete $iter{$cxix}; + delete $entries{$cxix}; + return undef; + } + } +} + +1; +__END__ + +=head1 NAME + +File::Glob - Perl extension for BSD glob routine + +=head1 SYNOPSIS + + use File::Glob ':glob'; + @list = glob('*.[ch]'); + $homedir = glob('~gnat', GLOB_TILDE | GLOB_ERR); + if (GLOB_ERROR) { + # an error occurred reading $homedir + } + + ## override the core glob (even with -T) + use File::Glob ':globally'; + my @sources = <*.{c,h,y}> + + ## override the core glob, forcing case sensitivity + use File::Glob qw(:globally :case); + my @sources = <*.{c,h,y}> + + ## override the core glob forcing case insensitivity + use File::Glob qw(:globally :nocase); + my @sources = <*.{c,h,y}> + +=head1 DESCRIPTION + +File::Glob implements the FreeBSD glob(3) routine, which is a superset +of the POSIX glob() (described in IEEE Std 1003.2 "POSIX.2"). The +glob() routine takes a mandatory C argument, and an optional +C argument, and returns a list of filenames matching the +pattern, with interpretation of the pattern modified by the C +variable. The POSIX defined flags are: + +=over 4 + +=item C + +Force glob() to return an error when it encounters a directory it +cannot open or read. Ordinarily glob() continues to find matches. + +=item C + +Each pathname that is a directory that matches the pattern has a slash +appended. + +=item C + +By default, file names are assumed to be case sensitive; this flag +makes glob() treat case differences as not significant. + +=item C + +If the pattern does not match any pathname, then glob() returns a list +consisting of only the pattern. If C is set, its effect +is present in the pattern returned. + +=item C + +By default, the pathnames are sorted in ascending ASCII order; this +flag prevents that sorting (speeding up glob()). + +=back + +The FreeBSD extensions to the POSIX standard are the following flags: + +=over 4 + +=item C + +Pre-process the string to expand C<{pat,pat,...} strings like csh(1). +The pattern '{}' is left unexpanded for historical reasons (and csh(1) +does the same thing to ease typing of find(1) patterns). + +=item C + +Same as C but it only returns the pattern if it does not +contain any of the special characters "*", "?" or "[". C is +provided to simplify implementing the historic csh(1) globbing +behaviour and should probably not be used anywhere else. + +=item C + +Use the backslash ('\') character for quoting: every occurrence of a +backslash followed by a character in the pattern is replaced by that +character, avoiding any special interpretation of the character. +(But see below for exceptions on DOSISH systems). + +=item C + +Expand patterns that start with '~' to user name home directories. + +=item C + +For convenience, C is a synonym for +C. + +=back + +The POSIX provided C, C, and the FreeBSD +extensions C, and C flags have not been +implemented in the Perl version because they involve more complex +interaction with the underlying C structures. + +=head1 DIAGNOSTICS + +glob() returns a list of matching paths, possibly zero length. If an +error occurred, &File::Glob::GLOB_ERROR will be non-zero and C<$!> will be +set. &File::Glob::GLOB_ERROR is guaranteed to be zero if no error occurred, +or one of the following values otherwise: + +=over 4 + +=item C + +An attempt to allocate memory failed. + +=item C + +The glob was stopped because an error was encountered. + +=back + +In the case where glob() has found some matching paths, but is +interrupted by an error, glob() will return a list of filenames B +set &File::Glob::ERROR. + +Note that glob() deviates from POSIX and FreeBSD glob(3) behaviour by +not considering C and C as errors - glob() will +continue processing despite those errors, unless the C flag is +set. + +Be aware that all filenames returned from File::Glob are tainted. + +=head1 NOTES + +=over 4 + +=item * + +If you want to use multiple patterns, e.g. C, you should +probably throw them in a set as in C. This is because +the argument to glob isn't subjected to parsing by the C shell. Remember +that you can use a backslash to escape things. + +=item * + +On DOSISH systems, backslash is a valid directory separator character. +In this case, use of backslash as a quoting character (via GLOB_QUOTE) +interferes with the use of backslash as a directory separator. The +best (simplest, most portable) solution is to use forward slashes for +directory separators, and backslashes for quoting. However, this does +not match "normal practice" on these systems. As a concession to user +expectation, therefore, backslashes (under GLOB_QUOTE) only quote the +glob metacharacters '[', ']', '{', '}', '-', '~', and backslash itself. +All other backslashes are passed through unchanged. + +=item * + +Win32 users should use the real slash. If you really want to use +backslashes, consider using Sarathy's File::DosGlob, which comes with +the standard Perl distribution. + +=head1 AUTHOR + +The Perl interface was written by Nathan Torkington Egnat@frii.comE, +and is released under the artistic license. Further modifications were +made by Greg Bacon Egbacon@cs.uah.eduE and Gurusamy Sarathy +Egsar@activestate.comE. The C glob code has the +following copyright: + + Copyright (c) 1989, 1993 The Regents of the University of California. + All rights reserved. + + This code is derived from software contributed to Berkeley by + Guido van Rossum. + + Redistribution and use in source and binary forms, with or without + modification, are permitted provided that the following conditions + are met: + + 1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + 2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + 3. Neither the name of the University nor the names of its contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + + THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND + ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE + FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS + OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) + HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT + LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY + OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF + SUCH DAMAGE. + +=cut diff --git a/ext/File/Glob/Glob.xs b/ext/File/Glob/Glob.xs new file mode 100644 index 0000000..1805f68 --- /dev/null +++ b/ext/File/Glob/Glob.xs @@ -0,0 +1,209 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#include "bsd_glob.h" + +static int GLOB_ERROR = 0; + +static int +not_here(char *s) +{ + croak("%s not implemented on this architecture", s); + return -1; +} + + +static double +constant(char *name, int arg) +{ + errno = 0; + if (strlen(name) <= 5) + goto not_there; + switch (*(name+5)) { + case 'A': + if (strEQ(name, "GLOB_ABEND")) +#ifdef GLOB_ABEND + return GLOB_ABEND; +#else + goto not_there; +#endif + if (strEQ(name, "GLOB_ALTDIRFUNC")) +#ifdef GLOB_ALTDIRFUNC + return GLOB_ALTDIRFUNC; +#else + goto not_there; +#endif + break; + case 'B': + if (strEQ(name, "GLOB_BRACE")) +#ifdef GLOB_BRACE + return GLOB_BRACE; +#else + goto not_there; +#endif + break; + case 'C': + break; + case 'D': + break; + case 'E': + if (strEQ(name, "GLOB_ERR")) +#ifdef GLOB_ERR + return GLOB_ERR; +#else + goto not_there; +#endif + if (strEQ(name, "GLOB_ERROR")) + return GLOB_ERROR; + break; + case 'F': + break; + case 'G': + break; + case 'H': + break; + case 'I': + break; + case 'J': + break; + case 'K': + break; + case 'L': + break; + case 'M': + if (strEQ(name, "GLOB_MARK")) +#ifdef GLOB_MARK + return GLOB_MARK; +#else + goto not_there; +#endif + break; + case 'N': + if (strEQ(name, "GLOB_NOCASE")) +#ifdef GLOB_NOCASE + return GLOB_NOCASE; +#else + goto not_there; +#endif + if (strEQ(name, "GLOB_NOCHECK")) +#ifdef GLOB_NOCHECK + return GLOB_NOCHECK; +#else + goto not_there; +#endif + if (strEQ(name, "GLOB_NOMAGIC")) +#ifdef GLOB_NOMAGIC + return GLOB_NOMAGIC; +#else + goto not_there; +#endif + if (strEQ(name, "GLOB_NOSORT")) +#ifdef GLOB_NOSORT + return GLOB_NOSORT; +#else + goto not_there; +#endif + if (strEQ(name, "GLOB_NOSPACE")) +#ifdef GLOB_NOSPACE + return GLOB_NOSPACE; +#else + goto not_there; +#endif + break; + case 'O': + break; + case 'P': + break; + case 'Q': + if (strEQ(name, "GLOB_QUOTE")) +#ifdef GLOB_QUOTE + return GLOB_QUOTE; +#else + goto not_there; +#endif + break; + case 'R': + break; + case 'S': + break; + case 'T': + if (strEQ(name, "GLOB_TILDE")) +#ifdef GLOB_TILDE + return GLOB_TILDE; +#else + goto not_there; +#endif + break; + case 'U': + break; + case 'V': + break; + case 'W': + break; + case 'X': + break; + case 'Y': + break; + case 'Z': + break; + } + errno = EINVAL; + return 0; + +not_there: + errno = ENOENT; + return 0; +} + +#ifdef WIN32 +#define errfunc NULL +#else +int +errfunc(const char *foo, int bar) { + return !(bar == ENOENT || bar == ENOTDIR); +} +#endif + +MODULE = File::Glob PACKAGE = File::Glob + +void +doglob(pattern,...) + char *pattern +PROTOTYPE: +PREINIT: + glob_t pglob; + int i; + int retval; + int flags = 0; + SV *tmp; +PPCODE: + { + /* allow for optional flags argument */ + if (items > 1) { + flags = (int) SvIV(ST(1)); + } + + /* call glob */ + retval = bsd_glob(pattern, flags, errfunc, &pglob); + GLOB_ERROR = retval; + + /* return any matches found */ + EXTEND(sp, pglob.gl_pathc); + for (i = 0; i < pglob.gl_pathc; i++) { + /* printf("# bsd_glob: %s\n", pglob.gl_pathv[i]); */ + tmp = sv_2mortal(newSVpvn(pglob.gl_pathv[i], + strlen(pglob.gl_pathv[i]))); + TAINT; + SvTAINT(tmp); + PUSHs(tmp); + } + + bsd_globfree(&pglob); + } + +double +constant(name,arg) + char *name + int arg +PROTOTYPE: diff --git a/ext/File/Glob/Makefile.PL b/ext/File/Glob/Makefile.PL new file mode 100644 index 0000000..c82988f --- /dev/null +++ b/ext/File/Glob/Makefile.PL @@ -0,0 +1,11 @@ +use ExtUtils::MakeMaker; +WriteMakefile( + NAME => 'File::Glob', + VERSION_FROM => 'Glob.pm', + MAN3PODS => {}, # Pods will be built by installman. + OBJECT => 'bsd_glob$(OBJ_EXT) Glob$(OBJ_EXT)', + +## uncomment for glob debugging (will cause make test to fail) +# DEFINE => '-DGLOB_DEBUG', +# OPTIMIZE => '-g', +); diff --git a/ext/File/Glob/TODO b/ext/File/Glob/TODO new file mode 100644 index 0000000..ef2547f --- /dev/null +++ b/ext/File/Glob/TODO @@ -0,0 +1,21 @@ +Some issues left to take care of: + + o sane ~ handling on non-Unix platforms + + Currently on non-Unix, when the glob code encounters a tilde glob + (.e.g ~user/foo or ~/.cshrc), it simply returns that pattern + without doing any expansion (meaning perl will weed it out since a + file of that name isn't likely to exist). + + Please, if you have strong feelings about how tilde expansion + should be done on your favorite non-Unix platform(s), submit a + patch. + + o path separator handling + + Guido's code contains the assumption that the path separator is one + character (byte, probably) in length. Win32 doesn't object to the + true slash as a separator. I imagine MacPerl could change the SEP + cpp #define to ":". I have no idea what it is for VMS. Again, if + you have ideas and especially patches, please feel free to share + them. diff --git a/ext/File/Glob/bsd_glob.c b/ext/File/Glob/bsd_glob.c new file mode 100644 index 0000000..c422d60 --- /dev/null +++ b/ext/File/Glob/bsd_glob.c @@ -0,0 +1,930 @@ +/* + * Copyright (c) 1989, 1993 + * The Regents of the University of California. All rights reserved. + * + * This code is derived from software contributed to Berkeley by + * Guido van Rossum. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * 3. Neither the name of the University nor the names of its contributors + * may be used to endorse or promote products derived from this software + * without specific prior written permission. + * + * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND + * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE + * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS + * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) + * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT + * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY + * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF + * SUCH DAMAGE. + */ + +#if defined(LIBC_SCCS) && !defined(lint) +static char sccsid[] = "@(#)glob.c 8.3 (Berkeley) 10/13/93"; +#endif /* LIBC_SCCS and not lint */ + +/* + * glob(3) -- a superset of the one defined in POSIX 1003.2. + * + * The [!...] convention to negate a range is supported (SysV, Posix, ksh). + * + * Optional extra services, controlled by flags not defined by POSIX: + * + * GLOB_QUOTE: + * Escaping convention: \ inhibits any special meaning the following + * character might have (except \ at end of string is retained). + * GLOB_MAGCHAR: + * Set in gl_flags if pattern contained a globbing character. + * GLOB_NOMAGIC: + * Same as GLOB_NOCHECK, but it will only append pattern if it did + * not contain any magic characters. [Used in csh style globbing] + * GLOB_ALTDIRFUNC: + * Use alternately specified directory access functions. + * GLOB_TILDE: + * expand ~user/foo to the /home/dir/of/user/foo + * GLOB_BRACE: + * expand {1,2}{a,b} to 1a 1b 2a 2b + * gl_matchc: + * Number of matches in the current invocation of glob. + */ + +#include +#include +#include + +#include "bsd_glob.h" +#ifdef I_PWD +# include +#else +#ifdef HAS_PASSWD + struct passwd *getpwnam(char *); + struct passwd *getpwuid(Uid_t); +#endif +#endif + +#ifndef MAXPATHLEN +# ifdef PATH_MAX +# define MAXPATHLEN PATH_MAX +# else +# define MAXPATHLEN 1024 +# endif +#endif + +#define BG_DOLLAR '$' +#define BG_DOT '.' +#define BG_EOS '\0' +#define BG_LBRACKET '[' +#define BG_NOT '!' +#define BG_QUESTION '?' +#define BG_QUOTE '\\' +#define BG_RANGE '-' +#define BG_RBRACKET ']' +#define BG_SEP '/' +#ifdef DOSISH +#define BG_SEP2 '\\' +#endif +#define BG_STAR '*' +#define BG_TILDE '~' +#define BG_UNDERSCORE '_' +#define BG_LBRACE '{' +#define BG_RBRACE '}' +#define BG_SLASH '/' +#define BG_COMMA ',' + +#ifndef GLOB_DEBUG + +#define M_QUOTE 0x8000 +#define M_PROTECT 0x4000 +#define M_MASK 0xffff +#define M_ASCII 0x00ff + +typedef U16 Char; + +#else + +#define M_QUOTE 0x80 +#define M_PROTECT 0x40 +#define M_MASK 0xff +#define M_ASCII 0x7f + +typedef U8 Char; + +#endif /* !GLOB_DEBUG */ + + +#define CHAR(c) ((Char)((c)&M_ASCII)) +#define META(c) ((Char)((c)|M_QUOTE)) +#define M_ALL META('*') +#define M_END META(']') +#define M_NOT META('!') +#define M_ONE META('?') +#define M_RNG META('-') +#define M_SET META('[') +#define ismeta(c) (((c)&M_QUOTE) != 0) + + +static int compare(const void *, const void *); +static int ci_compare(const void *, const void *); +static void g_Ctoc(const Char *, char *); +static int g_lstat(Char *, Stat_t *, glob_t *); +static DIR *g_opendir(Char *, glob_t *); +static Char *g_strchr(Char *, int); +#ifdef notdef +static Char *g_strcat(Char *, const Char *); +#endif +static int g_stat(Char *, Stat_t *, glob_t *); +static int glob0(const Char *, glob_t *); +static int glob1(Char *, glob_t *); +static int glob2(Char *, Char *, Char *, glob_t *); +static int glob3(Char *, Char *, Char *, Char *, glob_t *); +static int globextend(const Char *, glob_t *); +static const Char * globtilde(const Char *, Char *, glob_t *); +static int globexp1(const Char *, glob_t *); +static int globexp2(const Char *, const Char *, glob_t *, int *); +static int match(Char *, Char *, Char *, int); +#ifdef GLOB_DEBUG +static void qprintf(const char *, Char *); +#endif /* GLOB_DEBUG */ + +#ifdef PERL_IMPLICIT_CONTEXT +static Direntry_t * my_readdir(DIR*); + +static Direntry_t * +my_readdir(DIR *d) +{ + return PerlDir_read(d); +} +#else +#define my_readdir readdir +#endif + +int +bsd_glob(const char *pattern, int flags, + int (*errfunc)(const char *, int), glob_t *pglob) +{ + const U8 *patnext; + int c; + Char *bufnext, *bufend, patbuf[MAXPATHLEN+1]; + + patnext = (U8 *) pattern; + if (!(flags & GLOB_APPEND)) { + pglob->gl_pathc = 0; + pglob->gl_pathv = NULL; + if (!(flags & GLOB_DOOFFS)) + pglob->gl_offs = 0; + } + pglob->gl_flags = flags & ~GLOB_MAGCHAR; + pglob->gl_errfunc = errfunc; + pglob->gl_matchc = 0; + + bufnext = patbuf; + bufend = bufnext + MAXPATHLEN; +#ifdef DOSISH + /* Nasty hack to treat patterns like "C:*" correctly. In this + * case, the * should match any file in the current directory + * on the C: drive. However, the glob code does not treat the + * colon specially, so it looks for files beginning "C:" in + * the current directory. To fix this, change the pattern to + * add an explicit "./" at the start (just after the drive + * letter and colon - ie change to "C:./*"). + */ + if (isalpha(pattern[0]) && pattern[1] == ':' && + pattern[2] != BG_SEP && pattern[2] != BG_SEP2 && + bufend - bufnext > 4) { + *bufnext++ = pattern[0]; + *bufnext++ = ':'; + *bufnext++ = '.'; + *bufnext++ = BG_SEP; + patnext += 2; + } +#endif + if (flags & GLOB_QUOTE) { + /* Protect the quoted characters. */ + while (bufnext < bufend && (c = *patnext++) != BG_EOS) + if (c == BG_QUOTE) { +#ifdef DOSISH + /* To avoid backslashitis on Win32, + * we only treat \ as a quoting character + * if it precedes one of the + * metacharacters []-{}~\ + */ + if ((c = *patnext++) != '[' && c != ']' && + c != '-' && c != '{' && c != '}' && + c != '~' && c != '\\') { +#else + if ((c = *patnext++) == BG_EOS) { +#endif + c = BG_QUOTE; + --patnext; + } + *bufnext++ = c | M_PROTECT; + } + else + *bufnext++ = c; + } + else + while (bufnext < bufend && (c = *patnext++) != BG_EOS) + *bufnext++ = c; + *bufnext = BG_EOS; + + if (flags & GLOB_BRACE) + return globexp1(patbuf, pglob); + else + return glob0(patbuf, pglob); +} + +/* + * Expand recursively a glob {} pattern. When there is no more expansion + * invoke the standard globbing routine to glob the rest of the magic + * characters + */ +static int globexp1(const Char *pattern, glob_t *pglob) +{ + const Char* ptr = pattern; + int rv; + + /* Protect a single {}, for find(1), like csh */ + if (pattern[0] == BG_LBRACE && pattern[1] == BG_RBRACE && pattern[2] == BG_EOS) + return glob0(pattern, pglob); + + while ((ptr = (const Char *) g_strchr((Char *) ptr, BG_LBRACE)) != NULL) + if (!globexp2(ptr, pattern, pglob, &rv)) + return rv; + + return glob0(pattern, pglob); +} + + +/* + * Recursive brace globbing helper. Tries to expand a single brace. + * If it succeeds then it invokes globexp1 with the new pattern. + * If it fails then it tries to glob the rest of the pattern and returns. + */ +static int globexp2(const Char *ptr, const Char *pattern, + glob_t *pglob, int *rv) +{ + int i; + Char *lm, *ls; + const Char *pe, *pm, *pl; + Char patbuf[MAXPATHLEN + 1]; + + /* copy part up to the brace */ + for (lm = patbuf, pm = pattern; pm != ptr; *lm++ = *pm++) + continue; + ls = lm; + + /* Find the balanced brace */ + for (i = 0, pe = ++ptr; *pe; pe++) + if (*pe == BG_LBRACKET) { + /* Ignore everything between [] */ + for (pm = pe++; *pe != BG_RBRACKET && *pe != BG_EOS; pe++) + continue; + if (*pe == BG_EOS) { + /* + * We could not find a matching BG_RBRACKET. + * Ignore and just look for BG_RBRACE + */ + pe = pm; + } + } + else if (*pe == BG_LBRACE) + i++; + else if (*pe == BG_RBRACE) { + if (i == 0) + break; + i--; + } + + /* Non matching braces; just glob the pattern */ + if (i != 0 || *pe == BG_EOS) { + *rv = glob0(patbuf, pglob); + return 0; + } + + for (i = 0, pl = pm = ptr; pm <= pe; pm++) + switch (*pm) { + case BG_LBRACKET: + /* Ignore everything between [] */ + for (pl = pm++; *pm != BG_RBRACKET && *pm != BG_EOS; pm++) + continue; + if (*pm == BG_EOS) { + /* + * We could not find a matching BG_RBRACKET. + * Ignore and just look for BG_RBRACE + */ + pm = pl; + } + break; + + case BG_LBRACE: + i++; + break; + + case BG_RBRACE: + if (i) { + i--; + break; + } + /* FALLTHROUGH */ + case BG_COMMA: + if (i && *pm == BG_COMMA) + break; + else { + /* Append the current string */ + for (lm = ls; (pl < pm); *lm++ = *pl++) + continue; + /* + * Append the rest of the pattern after the + * closing brace + */ + for (pl = pe + 1; (*lm++ = *pl++) != BG_EOS;) + continue; + + /* Expand the current pattern */ +#ifdef GLOB_DEBUG + qprintf("globexp2:", patbuf); +#endif /* GLOB_DEBUG */ + *rv = globexp1(patbuf, pglob); + + /* move after the comma, to the next string */ + pl = pm + 1; + } + break; + + default: + break; + } + *rv = 0; + return 0; +} + + + +/* + * expand tilde from the passwd file. + */ +static const Char * +globtilde(const Char *pattern, Char *patbuf, glob_t *pglob) +{ + struct passwd *pwd; + char *h; + const Char *p; + Char *b; + + if (*pattern != BG_TILDE || !(pglob->gl_flags & GLOB_TILDE)) + return pattern; + + /* Copy up to the end of the string or / */ + for (p = pattern + 1, h = (char *) patbuf; *p && *p != BG_SLASH; + *h++ = *p++) + continue; + + *h = BG_EOS; + + if (((char *) patbuf)[0] == BG_EOS) { + /* + * handle a plain ~ or ~/ by expanding $HOME + * first and then trying the password file + */ + if ((h = getenv("HOME")) == NULL) { +#ifdef HAS_PASSWD + if ((pwd = getpwuid(getuid())) == NULL) + return pattern; + else + h = pwd->pw_dir; +#else + return pattern; +#endif + } + } + else { + /* + * Expand a ~user + */ +#ifdef HAS_PASSWD + if ((pwd = getpwnam((char*) patbuf)) == NULL) + return pattern; + else + h = pwd->pw_dir; +#else + return pattern; +#endif + } + + /* Copy the home directory */ + for (b = patbuf; *h; *b++ = *h++) + continue; + + /* Append the rest of the pattern */ + while ((*b++ = *p++) != BG_EOS) + continue; + + return patbuf; +} + + +/* + * The main glob() routine: compiles the pattern (optionally processing + * quotes), calls glob1() to do the real pattern matching, and finally + * sorts the list (unless unsorted operation is requested). Returns 0 + * if things went well, nonzero if errors occurred. It is not an error + * to find no matches. + */ +static int +glob0(const Char *pattern, glob_t *pglob) +{ + const Char *qpat, *qpatnext; + int c, err, oldflags, oldpathc; + Char *bufnext, patbuf[MAXPATHLEN+1]; + + qpat = globtilde(pattern, patbuf, pglob); + qpatnext = qpat; + oldflags = pglob->gl_flags; + oldpathc = pglob->gl_pathc; + bufnext = patbuf; + + /* We don't need to check for buffer overflow any more. */ + while ((c = *qpatnext++) != BG_EOS) { + switch (c) { + case BG_LBRACKET: + c = *qpatnext; + if (c == BG_NOT) + ++qpatnext; + if (*qpatnext == BG_EOS || + g_strchr((Char *) qpatnext+1, BG_RBRACKET) == NULL) { + *bufnext++ = BG_LBRACKET; + if (c == BG_NOT) + --qpatnext; + break; + } + *bufnext++ = M_SET; + if (c == BG_NOT) + *bufnext++ = M_NOT; + c = *qpatnext++; + do { + *bufnext++ = CHAR(c); + if (*qpatnext == BG_RANGE && + (c = qpatnext[1]) != BG_RBRACKET) { + *bufnext++ = M_RNG; + *bufnext++ = CHAR(c); + qpatnext += 2; + } + } while ((c = *qpatnext++) != BG_RBRACKET); + pglob->gl_flags |= GLOB_MAGCHAR; + *bufnext++ = M_END; + break; + case BG_QUESTION: + pglob->gl_flags |= GLOB_MAGCHAR; + *bufnext++ = M_ONE; + break; + case BG_STAR: + pglob->gl_flags |= GLOB_MAGCHAR; + /* collapse adjacent stars to one, + * to avoid exponential behavior + */ + if (bufnext == patbuf || bufnext[-1] != M_ALL) + *bufnext++ = M_ALL; + break; + default: + *bufnext++ = CHAR(c); + break; + } + } + *bufnext = BG_EOS; +#ifdef GLOB_DEBUG + qprintf("glob0:", patbuf); +#endif /* GLOB_DEBUG */ + + if ((err = glob1(patbuf, pglob)) != 0) { + pglob->gl_flags = oldflags; + return(err); + } + + /* + * If there was no match we are going to append the pattern + * if GLOB_NOCHECK was specified or if GLOB_NOMAGIC was specified + * and the pattern did not contain any magic characters + * GLOB_NOMAGIC is there just for compatibility with csh. + */ + if (pglob->gl_pathc == oldpathc && + ((pglob->gl_flags & GLOB_NOCHECK) || + ((pglob->gl_flags & GLOB_NOMAGIC) && + !(pglob->gl_flags & GLOB_MAGCHAR)))) + { +#ifdef GLOB_DEBUG + printf("calling globextend from glob0\n"); +#endif /* GLOB_DEBUG */ + pglob->gl_flags = oldflags; + return(globextend(qpat, pglob)); + } + else if (!(pglob->gl_flags & GLOB_NOSORT)) + qsort(pglob->gl_pathv + pglob->gl_offs + oldpathc, + pglob->gl_pathc - oldpathc, sizeof(char *), + (pglob->gl_flags & GLOB_NOCASE) ? ci_compare : compare); + pglob->gl_flags = oldflags; + return(0); +} + +static int +ci_compare(const void *p, const void *q) +{ + const char *pp = *(const char **)p; + const char *qq = *(const char **)q; + while (*pp && *qq) { + if (tolower(*pp) != tolower(*qq)) + break; + ++pp; + ++qq; + } + return (tolower(*pp) - tolower(*qq)); +} + +static int +compare(const void *p, const void *q) +{ + return(strcmp(*(char **)p, *(char **)q)); +} + +static int +glob1(Char *pattern, glob_t *pglob) +{ + Char pathbuf[MAXPATHLEN+1]; + + /* A null pathname is invalid -- POSIX 1003.1 sect. 2.4. */ + if (*pattern == BG_EOS) + return(0); + return(glob2(pathbuf, pathbuf, pattern, pglob)); +} + +/* + * The functions glob2 and glob3 are mutually recursive; there is one level + * of recursion for each segment in the pattern that contains one or more + * meta characters. + */ +static int +glob2(Char *pathbuf, Char *pathend, Char *pattern, glob_t *pglob) +{ + Stat_t sb; + Char *p, *q; + int anymeta; + + /* + * Loop over pattern segments until end of pattern or until + * segment with meta character found. + */ + for (anymeta = 0;;) { + if (*pattern == BG_EOS) { /* End of pattern? */ + *pathend = BG_EOS; + + if (g_lstat(pathbuf, &sb, pglob)) + return(0); + + if (((pglob->gl_flags & GLOB_MARK) && + pathend[-1] != BG_SEP +#ifdef DOSISH + && pathend[-1] != BG_SEP2 +#endif + ) && (S_ISDIR(sb.st_mode) + || (S_ISLNK(sb.st_mode) && + (g_stat(pathbuf, &sb, pglob) == 0) && + S_ISDIR(sb.st_mode)))) { + *pathend++ = BG_SEP; + *pathend = BG_EOS; + } + ++pglob->gl_matchc; +#ifdef GLOB_DEBUG + printf("calling globextend from glob2\n"); +#endif /* GLOB_DEBUG */ + return(globextend(pathbuf, pglob)); + } + + /* Find end of next segment, copy tentatively to pathend. */ + q = pathend; + p = pattern; + while (*p != BG_EOS && *p != BG_SEP +#ifdef DOSISH + && *p != BG_SEP2 +#endif + ) { + if (ismeta(*p)) + anymeta = 1; + *q++ = *p++; + } + + if (!anymeta) { /* No expansion, do next segment. */ + pathend = q; + pattern = p; + while (*pattern == BG_SEP +#ifdef DOSISH + || *pattern == BG_SEP2 +#endif + ) + *pathend++ = *pattern++; + } else /* Need expansion, recurse. */ + return(glob3(pathbuf, pathend, pattern, p, pglob)); + } + /* NOTREACHED */ +} + +static int +glob3(Char *pathbuf, Char *pathend, Char *pattern, + Char *restpattern, glob_t *pglob) +{ + register Direntry_t *dp; + DIR *dirp; + int err; + int nocase; + char buf[MAXPATHLEN]; + + /* + * The readdirfunc declaration can't be prototyped, because it is + * assigned, below, to two functions which are prototyped in glob.h + * and dirent.h as taking pointers to differently typed opaque + * structures. + */ + Direntry_t *(*readdirfunc)(); + + *pathend = BG_EOS; + errno = 0; + + if ((dirp = g_opendir(pathbuf, pglob)) == NULL) { + /* TODO: don't call for ENOENT or ENOTDIR? */ + if (pglob->gl_errfunc) { + g_Ctoc(pathbuf, buf); + if (pglob->gl_errfunc(buf, errno) || + (pglob->gl_flags & GLOB_ERR)) + return (GLOB_ABEND); + } + return(0); + } + + err = 0; + nocase = ((pglob->gl_flags & GLOB_NOCASE) != 0); + + /* Search directory for matching names. */ + if (pglob->gl_flags & GLOB_ALTDIRFUNC) + readdirfunc = pglob->gl_readdir; + else + readdirfunc = my_readdir; + while ((dp = (*readdirfunc)(dirp))) { + register U8 *sc; + register Char *dc; + + /* Initial BG_DOT must be matched literally. */ + if (dp->d_name[0] == BG_DOT && *pattern != BG_DOT) + continue; + for (sc = (U8 *) dp->d_name, dc = pathend; + (*dc++ = *sc++) != BG_EOS;) + continue; + if (!match(pathend, pattern, restpattern, nocase)) { + *pathend = BG_EOS; + continue; + } + err = glob2(pathbuf, --dc, restpattern, pglob); + if (err) + break; + } + + if (pglob->gl_flags & GLOB_ALTDIRFUNC) + (*pglob->gl_closedir)(dirp); + else + PerlDir_close(dirp); + return(err); +} + + +/* + * Extend the gl_pathv member of a glob_t structure to accomodate a new item, + * add the new item, and update gl_pathc. + * + * This assumes the BSD realloc, which only copies the block when its size + * crosses a power-of-two boundary; for v7 realloc, this would cause quadratic + * behavior. + * + * Return 0 if new item added, error code if memory couldn't be allocated. + * + * Invariant of the glob_t structure: + * Either gl_pathc is zero and gl_pathv is NULL; or gl_pathc > 0 and + * gl_pathv points to (gl_offs + gl_pathc + 1) items. + */ +static int +globextend(const Char *path, glob_t *pglob) +{ + register char **pathv; + register int i; + char *copy; + const Char *p; + +#ifdef GLOB_DEBUG + printf("Adding "); + for (p = path; *p; p++) + (void)printf("%c", CHAR(*p)); + printf("\n"); +#endif /* GLOB_DEBUG */ + + if (pglob->gl_pathv) + pathv = Renew(pglob->gl_pathv, + (2 + pglob->gl_pathc + pglob->gl_offs),char*); + else + New(0,pathv,(2 + pglob->gl_pathc + pglob->gl_offs),char*); + if (pathv == NULL) + return(GLOB_NOSPACE); + + if (pglob->gl_pathv == NULL && pglob->gl_offs > 0) { + /* first time around -- clear initial gl_offs items */ + pathv += pglob->gl_offs; + for (i = pglob->gl_offs; --i >= 0; ) + *--pathv = NULL; + } + pglob->gl_pathv = pathv; + + for (p = path; *p++;) + continue; + New(0, copy, p-path, char); + if (copy != NULL) { + g_Ctoc(path, copy); + pathv[pglob->gl_offs + pglob->gl_pathc++] = copy; + } + pathv[pglob->gl_offs + pglob->gl_pathc] = NULL; + return(copy == NULL ? GLOB_NOSPACE : 0); +} + + +/* + * pattern matching function for filenames. Each occurrence of the * + * pattern causes a recursion level. + */ +static int +match(register Char *name, register Char *pat, register Char *patend, int nocase) +{ + int ok, negate_range; + Char c, k; + + while (pat < patend) { + c = *pat++; + switch (c & M_MASK) { + case M_ALL: + if (pat == patend) + return(1); + do + if (match(name, pat, patend, nocase)) + return(1); + while (*name++ != BG_EOS); + return(0); + case M_ONE: + if (*name++ == BG_EOS) + return(0); + break; + case M_SET: + ok = 0; + if ((k = *name++) == BG_EOS) + return(0); + if ((negate_range = ((*pat & M_MASK) == M_NOT)) != BG_EOS) + ++pat; + while (((c = *pat++) & M_MASK) != M_END) + if ((*pat & M_MASK) == M_RNG) { + if (nocase) { + if (tolower(c) <= tolower(k) && tolower(k) <= tolower(pat[1])) + ok = 1; + } else { + if (c <= k && k <= pat[1]) + ok = 1; + } + pat += 2; + } else if (nocase ? (tolower(c) == tolower(k)) : (c == k)) + ok = 1; + if (ok == negate_range) + return(0); + break; + default: + k = *name++; + if (nocase ? (tolower(k) != tolower(c)) : (k != c)) + return(0); + break; + } + } + return(*name == BG_EOS); +} + +/* Free allocated data belonging to a glob_t structure. */ +void +bsd_globfree(glob_t *pglob) +{ + register int i; + register char **pp; + + if (pglob->gl_pathv != NULL) { + pp = pglob->gl_pathv + pglob->gl_offs; + for (i = pglob->gl_pathc; i--; ++pp) + if (*pp) + Safefree(*pp); + Safefree(pglob->gl_pathv); + } +} + +static DIR * +g_opendir(register Char *str, glob_t *pglob) +{ + char buf[MAXPATHLEN]; + + if (!*str) + strcpy(buf, "."); + else + g_Ctoc(str, buf); + + if (pglob->gl_flags & GLOB_ALTDIRFUNC) + return((*pglob->gl_opendir)(buf)); + else + return(PerlDir_open(buf)); +} + +static int +g_lstat(register Char *fn, Stat_t *sb, glob_t *pglob) +{ + char buf[MAXPATHLEN]; + + g_Ctoc(fn, buf); + if (pglob->gl_flags & GLOB_ALTDIRFUNC) + return((*pglob->gl_lstat)(buf, sb)); +#ifdef HAS_LSTAT + return(PerlLIO_lstat(buf, sb)); +#else + return(PerlLIO_stat(buf, sb)); +#endif /* HAS_LSTAT */ +} + +static int +g_stat(register Char *fn, Stat_t *sb, glob_t *pglob) +{ + char buf[MAXPATHLEN]; + + g_Ctoc(fn, buf); + if (pglob->gl_flags & GLOB_ALTDIRFUNC) + return((*pglob->gl_stat)(buf, sb)); + return(PerlLIO_stat(buf, sb)); +} + +static Char * +g_strchr(Char *str, int ch) +{ + do { + if (*str == ch) + return (str); + } while (*str++); + return (NULL); +} + +#ifdef notdef +static Char * +g_strcat(Char *dst, const Char *src) +{ + Char *sdst = dst; + + while (*dst++) + continue; + --dst; + while((*dst++ = *src++) != BG_EOS) + continue; + + return (sdst); +} +#endif + +static void +g_Ctoc(register const Char *str, char *buf) +{ + register char *dc; + + for (dc = buf; (*dc++ = *str++) != BG_EOS;) + continue; +} + +#ifdef GLOB_DEBUG +static void +qprintf(const char *str, register Char *s) +{ + register Char *p; + + (void)printf("%s:\n", str); + for (p = s; *p; p++) + (void)printf("%c", CHAR(*p)); + (void)printf("\n"); + for (p = s; *p; p++) + (void)printf("%c", *p & M_PROTECT ? '"' : ' '); + (void)printf("\n"); + for (p = s; *p; p++) + (void)printf("%c", ismeta(*p) ? '_' : ' '); + (void)printf("\n"); +} +#endif /* GLOB_DEBUG */ diff --git a/ext/File/Glob/bsd_glob.h b/ext/File/Glob/bsd_glob.h new file mode 100644 index 0000000..10d1de5 --- /dev/null +++ b/ext/File/Glob/bsd_glob.h @@ -0,0 +1,82 @@ +/* + * Copyright (c) 1989, 1993 + * The Regents of the University of California. All rights reserved. + * + * This code is derived from software contributed to Berkeley by + * Guido van Rossum. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * 3. Neither the name of the University nor the names of its contributors + * may be used to endorse or promote products derived from this software + * without specific prior written permission. + * + * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND + * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE + * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS + * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) + * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT + * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY + * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF + * SUCH DAMAGE. + * + * @(#)glob.h 8.1 (Berkeley) 6/2/93 + */ + +#ifndef _BSD_GLOB_H_ +#define _BSD_GLOB_H_ + +/* #include */ + +typedef struct { + int gl_pathc; /* Count of total paths so far. */ + int gl_matchc; /* Count of paths matching pattern. */ + int gl_offs; /* Reserved at beginning of gl_pathv. */ + int gl_flags; /* Copy of flags parameter to glob. */ + char **gl_pathv; /* List of paths matching pattern. */ + /* Copy of errfunc parameter to glob. */ + int (*gl_errfunc)(const char *, int); + + /* + * Alternate filesystem access methods for glob; replacement + * versions of closedir(3), readdir(3), opendir(3), stat(2) + * and lstat(2). + */ + void (*gl_closedir)(void *); + Direntry_t *(*gl_readdir)(void *); + void *(*gl_opendir)(const char *); + int (*gl_lstat)(const char *, Stat_t *); + int (*gl_stat)(const char *, Stat_t *); +} glob_t; + +#define GLOB_APPEND 0x0001 /* Append to output from previous call. */ +#define GLOB_DOOFFS 0x0002 /* Use gl_offs. */ +#define GLOB_ERR 0x0004 /* Return on error. */ +#define GLOB_MARK 0x0008 /* Append / to matching directories. */ +#define GLOB_NOCHECK 0x0010 /* Return pattern itself if nothing matches. */ +#define GLOB_NOSORT 0x0020 /* Don't sort. */ + +#define GLOB_ALTDIRFUNC 0x0040 /* Use alternately specified directory funcs. */ +#define GLOB_BRACE 0x0080 /* Expand braces ala csh. */ +#define GLOB_MAGCHAR 0x0100 /* Pattern had globbing characters. */ +#define GLOB_NOMAGIC 0x0200 /* GLOB_NOCHECK without magic chars (csh). */ +#define GLOB_QUOTE 0x0400 /* Quote special chars with \. */ +#define GLOB_TILDE 0x0800 /* Expand tilde names from the passwd file. */ +#define GLOB_NOCASE 0x1000 /* Treat filenames without regard for case. */ + +#define GLOB_NOSPACE (-1) /* Malloc call failed. */ +#define GLOB_ABEND (-2) /* Unignored error. */ + +int bsd_glob(const char *, int, int (*)(const char *, int), glob_t *); +void bsd_globfree(glob_t *); + +#endif /* !_BSD_GLOB_H_ */ diff --git a/ext/GDBM_File/GDBM_File.pm b/ext/GDBM_File/GDBM_File.pm index 99ad60b..663a679 100644 --- a/ext/GDBM_File/GDBM_File.pm +++ b/ext/GDBM_File/GDBM_File.pm @@ -46,8 +46,8 @@ require Carp; require Tie::Hash; require Exporter; use AutoLoader; -require DynaLoader; -@ISA = qw(Tie::Hash Exporter DynaLoader); +use XSLoader (); +@ISA = qw(Tie::Hash Exporter); @EXPORT = qw( GDBM_CACHESIZE GDBM_FAST @@ -78,7 +78,7 @@ sub AUTOLOAD { goto &$AUTOLOAD; } -bootstrap GDBM_File $VERSION; +XSLoader::load 'GDBM_File', $VERSION; # Preloaded methods go here. Autoload methods go after __END__, and are # processed by the autosplit program. diff --git a/ext/IO/IO.pm b/ext/IO/IO.pm index b6ce216..0087530 100644 --- a/ext/IO/IO.pm +++ b/ext/IO/IO.pm @@ -2,15 +2,11 @@ package IO; -require DynaLoader; -require Exporter; +use XSLoader (); use Carp; -use vars qw(@ISA $VERSION @EXPORT); - -@ISA = qw(DynaLoader); $VERSION = "1.20"; -bootstrap IO $VERSION; +XSLoader::load 'IO', $VERSION; sub import { shift; diff --git a/ext/IO/IO.xs b/ext/IO/IO.xs index e614cff..e5ce83d 100644 --- a/ext/IO/IO.xs +++ b/ext/IO/IO.xs @@ -357,8 +357,7 @@ setvbuf(handle, buf, type, size) int type int size CODE: -/* Should check HAS_SETVBUF once Configure tests for that */ -#if defined(PERLIO_IS_STDIO) && defined(_IOFBF) +#if defined(PERLIO_IS_STDIO) && defined(_IOFBF) && defined(HAS_SETVBUF) if (!handle) /* Try input stream. */ handle = IoIFP(sv_2io(ST(0))); if (handle) diff --git a/ext/IO/lib/IO/Select.pm b/ext/IO/lib/IO/Select.pm index f021a79..7917102 100644 --- a/ext/IO/lib/IO/Select.pm +++ b/ext/IO/lib/IO/Select.pm @@ -46,7 +46,9 @@ sub remove sub exists { my $vec = shift; - $vec->[$vec->_fileno(shift) + FIRST_FD]; + my $fno = $vec->_fileno(shift); + return undef unless defined $fno; + $vec->[$fno + FIRST_FD]; } diff --git a/ext/IO/lib/IO/Socket.pm b/ext/IO/lib/IO/Socket.pm index 5cf9e72..b843999 100644 --- a/ext/IO/lib/IO/Socket.pm +++ b/ext/IO/lib/IO/Socket.pm @@ -18,7 +18,7 @@ use Exporter; # legacy require IO::Socket::INET; -require IO::Socket::UNIX; +require IO::Socket::UNIX if ($^O ne 'epoc'); @ISA = qw(IO::Handle); @@ -169,6 +169,7 @@ sub accept { } $peer = accept($new,$sock) || undef; }; + croak "$@" if $@ and $sock; return wantarray ? defined $peer ? ($new, $peer) : () diff --git a/ext/IPC/SysV/hints/cygwin.pl b/ext/IPC/SysV/hints/cygwin.pl new file mode 100644 index 0000000..e1a1dea --- /dev/null +++ b/ext/IPC/SysV/hints/cygwin.pl @@ -0,0 +1,2 @@ +# SysV IPC is an optional Cygwin package +$self->{LIBS} = ['-lcygipc'] diff --git a/ext/NDBM_File/NDBM_File.pm b/ext/NDBM_File/NDBM_File.pm index 8db59ee..578148c 100644 --- a/ext/NDBM_File/NDBM_File.pm +++ b/ext/NDBM_File/NDBM_File.pm @@ -8,13 +8,13 @@ BEGIN { use vars qw($VERSION @ISA); require Tie::Hash; -require DynaLoader; +use DynaLoader (); -@ISA = qw(Tie::Hash DynaLoader); +@ISA = qw(Tie::Hash); $VERSION = "1.03"; -bootstrap NDBM_File $VERSION; +XSLoader::load 'NDBM_File', $VERSION; 1; diff --git a/ext/NDBM_File/hints/cygwin.pl b/ext/NDBM_File/hints/cygwin.pl new file mode 100644 index 0000000..0a4b762 --- /dev/null +++ b/ext/NDBM_File/hints/cygwin.pl @@ -0,0 +1,2 @@ +# uses GDBM ndbm compatibility feature +$self->{LIBS} = ['-lgdbm']; diff --git a/ext/NDBM_File/hints/sco.pl b/ext/NDBM_File/hints/sco.pl new file mode 100644 index 0000000..f551578 --- /dev/null +++ b/ext/NDBM_File/hints/sco.pl @@ -0,0 +1,4 @@ +# SCO ODT 3.2v4.2 has a -ldbm library that is missing dbmclose. +# This system should have a complete library installed as -ldbm.nfs which +# should be used instead (Probably need the networking product add-on) +$self->{LIBS} = ['-lndbm',-e "/usr/lib/libdbm.nfs.a"?'-ldbm.nfs':'-ldbm']; diff --git a/ext/ODBM_File/ODBM_File.pm b/ext/ODBM_File/ODBM_File.pm index 0af875d..6199443 100644 --- a/ext/ODBM_File/ODBM_File.pm +++ b/ext/ODBM_File/ODBM_File.pm @@ -4,13 +4,13 @@ use strict; use vars qw($VERSION @ISA); require Tie::Hash; -require DynaLoader; +use DynaLoader (); -@ISA = qw(Tie::Hash DynaLoader); +@ISA = qw(Tie::Hash); $VERSION = "1.02"; -bootstrap ODBM_File $VERSION; +XSLoader::load 'ODBM_File', $VERSION; 1; diff --git a/ext/ODBM_File/hints/cygwin.pl b/ext/ODBM_File/hints/cygwin.pl new file mode 100644 index 0000000..a0d33c8 --- /dev/null +++ b/ext/ODBM_File/hints/cygwin.pl @@ -0,0 +1,2 @@ +# uses GDBM dbm compatibility feature +$self->{LIBS} = ['-lgdbm']; diff --git a/ext/ODBM_File/hints/sco.pl b/ext/ODBM_File/hints/sco.pl index 4664f2b..f551578 100644 --- a/ext/ODBM_File/hints/sco.pl +++ b/ext/ODBM_File/hints/sco.pl @@ -1,4 +1,4 @@ -# Some versions of SCO contain a broken -ldbm library that is missing -# dbmclose. Some of those might have a fixed library installed as -# -ldbm.nfs. -$self->{LIBS} = ['-ldbm.nfs', '-ldbm']; +# SCO ODT 3.2v4.2 has a -ldbm library that is missing dbmclose. +# This system should have a complete library installed as -ldbm.nfs which +# should be used instead (Probably need the networking product add-on) +$self->{LIBS} = ['-lndbm',-e "/usr/lib/libdbm.nfs.a"?'-ldbm.nfs':'-ldbm']; diff --git a/ext/Opcode/Opcode.pm b/ext/Opcode/Opcode.pm index ff3899f..3915b40 100644 --- a/ext/Opcode/Opcode.pm +++ b/ext/Opcode/Opcode.pm @@ -10,8 +10,8 @@ $XS_VERSION = "1.03"; use strict; use Carp; use Exporter (); -use DynaLoader (); -@ISA = qw(Exporter DynaLoader); +use XSLoader (); +@ISA = qw(Exporter); BEGIN { @EXPORT_OK = qw( @@ -28,7 +28,7 @@ sub opset_to_hex ($); sub opdump (;$); use subs @EXPORT_OK; -bootstrap Opcode $XS_VERSION; +XSLoader::load 'Opcode', $XS_VERSION; _init_optags(); diff --git a/ext/Opcode/Opcode.xs b/ext/Opcode/Opcode.xs index 9b6e016..581cbc9 100644 --- a/ext/Opcode/Opcode.xs +++ b/ext/Opcode/Opcode.xs @@ -204,7 +204,7 @@ static void opmask_addlocal(pTHX_ SV *opset, char *op_mask_buf) /* Localise PL_op_mask then opmask_add() */ { char *orig_op_mask = PL_op_mask; - SAVEPPTR(PL_op_mask); + SAVEVPTR(PL_op_mask); #if !defined(PERL_OBJECT) /* XXX casting to an ordinary function ptr from a member function ptr * is disallowed by Borland @@ -253,6 +253,8 @@ PPCODE: save_hptr(&PL_defstash); /* save current default stack */ /* the assignment to global defstash changes our sense of 'main' */ PL_defstash = gv_stashpv(Package, GV_ADDWARN); /* should exist already */ + save_hptr(&PL_curstash); + PL_curstash = PL_defstash; /* defstash must itself contain a main:: so we'll add that now */ /* take care with the ref counts (was cause of long standing bug) */ diff --git a/ext/POSIX/Makefile.PL b/ext/POSIX/Makefile.PL index fda7528..15256cf 100644 --- a/ext/POSIX/Makefile.PL +++ b/ext/POSIX/Makefile.PL @@ -1,9 +1,7 @@ use ExtUtils::MakeMaker; WriteMakefile( NAME => 'POSIX', - ($^O eq 'MSWin32' ? () : ($^O =~ /cygwin/ ? () : - (LIBS => ["-lm -lposix -lcposix"]) - )), + ($^O eq 'MSWin32' ? () : (LIBS => ["-lm -lposix -lcposix"])), MAN3PODS => {}, # Pods will be built by installman. XSPROTOARG => '-noprototypes', # XXX remove later? VERSION_FROM => 'POSIX.pm', diff --git a/ext/POSIX/POSIX.pm b/ext/POSIX/POSIX.pm index d43b8ca..a38c74d 100644 --- a/ext/POSIX/POSIX.pm +++ b/ext/POSIX/POSIX.pm @@ -9,10 +9,10 @@ require Config; use Symbol; require Exporter; -require DynaLoader; -@ISA = qw(Exporter DynaLoader); +use XSLoader (); +@ISA = qw(Exporter); -$VERSION = $VERSION = "1.03" ; +$VERSION = "1.03" ; %EXPORT_TAGS = ( @@ -195,7 +195,7 @@ sub import { } -bootstrap POSIX $VERSION; +XSLoader::load 'POSIX', $VERSION; my $EINVAL = constant("EINVAL", 0); my $EAGAIN = constant("EAGAIN", 0); diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index 23c38b5..4c96f12 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -8,7 +8,7 @@ #define PERLIO_NOT_STDIO 1 #include "perl.h" #include "XSUB.h" -#if defined(PERL_OBJECT) || defined(PERL_CAPI) +#if defined(PERL_OBJECT) || defined(PERL_CAPI) || defined(PERL_IMPLICIT_SYS) # undef signal # undef open # undef setmode @@ -108,7 +108,6 @@ #else #if defined (CYGWIN) # define tzname _tzname -# undef MB_CUR_MAX /* XXX: bug in b20.1 */ #endif #if defined (WIN32) # undef mkfifo @@ -290,7 +289,7 @@ unsigned long strtoul (const char *, char **, int); #endif #ifdef HAS_TZNAME -# ifndef WIN32 +# if !defined(WIN32) && !defined(CYGWIN) extern char *tzname[]; # endif #else @@ -3369,15 +3368,13 @@ sigaction(sig, action, oldaction = 0) # This code is really grody because we're trying to make the signal # interface look beautiful, which is hard. - if (!PL_siggv) - gv_fetchpv("SIG", TRUE, SVt_PVHV); - { + GV *siggv = gv_fetchpv("SIG", TRUE, SVt_PVHV); struct sigaction act; struct sigaction oact; POSIX__SigSet sigset; SV** svp; - SV** sigsvp = hv_fetch(GvHVn(PL_siggv), + SV** sigsvp = hv_fetch(GvHVn(siggv), PL_sig_name[sig], strlen(PL_sig_name[sig]), TRUE); @@ -3858,28 +3855,35 @@ strftime(fmt, sec, min, hour, mday, mon, year, wday = -1, yday = -1, isdst = -1) ** If there is a better way to make it portable, go ahead by ** all means. */ - if ( ( len > 0 && len < sizeof(tmpbuf) ) - || ( len == 0 && strlen(fmt) == 0 ) ) { + if ((len > 0 && len < sizeof(tmpbuf)) || (len == 0 && *fmt == '\0')) ST(0) = sv_2mortal(newSVpv(tmpbuf, len)); - } else { + else { /* Possibly buf overflowed - try again with a bigger buf */ - int bufsize = strlen(fmt) + sizeof(tmpbuf); + int fmtlen = strlen(fmt); + int bufsize = fmtlen + sizeof(tmpbuf); char* buf; int buflen; New(0, buf, bufsize, char); - while( buf ) { + while (buf) { buflen = strftime(buf, bufsize, fmt, &mytm); - if ( buflen > 0 && buflen < bufsize ) break; + if (buflen > 0 && buflen < bufsize) + break; + /* heuristic to prevent out-of-memory errors */ + if (bufsize > 100*fmtlen) { + Safefree(buf); + buf = NULL; + break; + } bufsize *= 2; Renew(buf, bufsize, char); } - if ( buf ) { + if (buf) { ST(0) = sv_2mortal(newSVpvn(buf, buflen)); Safefree(buf); - } else { - ST(0) = sv_2mortal(newSVpvn(tmpbuf, len)); } + else + ST(0) = sv_2mortal(newSVpvn(tmpbuf, len)); } } diff --git a/ext/SDBM_File/Makefile.PL b/ext/SDBM_File/Makefile.PL index afce3f1..a1debb9 100644 --- a/ext/SDBM_File/Makefile.PL +++ b/ext/SDBM_File/Makefile.PL @@ -20,13 +20,26 @@ WriteMakefile( ); sub MY::postamble { - if ($^O ne 'VMS') { + if ($^O =~ /MSWin32/ && Win32::IsWin95()) { + # XXX: dmake-specific, like rest of Win95 port + return + ' +$(MYEXTLIB): sdbm/Makefile +@[ + cd sdbm + $(MAKE) all + cd .. +] +'; + } + elsif ($^O ne 'VMS') { ' $(MYEXTLIB): sdbm/Makefile cd sdbm && $(MAKE) all '; - } else { - ' + } + else { + ' $(MYEXTLIB) : [.sdbm]descrip.mms set def [.sdbm] $(MMS) all diff --git a/ext/SDBM_File/SDBM_File.pm b/ext/SDBM_File/SDBM_File.pm index 34c9717..1f3b400 100644 --- a/ext/SDBM_File/SDBM_File.pm +++ b/ext/SDBM_File/SDBM_File.pm @@ -4,13 +4,13 @@ use strict; use vars qw($VERSION @ISA); require Tie::Hash; -require DynaLoader; +use XSLoader (); -@ISA = qw(Tie::Hash DynaLoader); +@ISA = qw(Tie::Hash); $VERSION = "1.02" ; -bootstrap SDBM_File $VERSION; +XSLoader::load 'SDBM_File', $VERSION; 1; diff --git a/ext/SDBM_File/sdbm/pair.c b/ext/SDBM_File/sdbm/pair.c index a30894b..c2ed213 100644 --- a/ext/SDBM_File/sdbm/pair.c +++ b/ext/SDBM_File/sdbm/pair.c @@ -9,7 +9,6 @@ #include "config.h" #ifdef CYGWIN -# define EXT extern # define EXTCONST extern const #else # include "EXTERN.h" diff --git a/ext/Socket/Socket.pm b/ext/Socket/Socket.pm index a0bb95d..1fa108f 100644 --- a/ext/Socket/Socket.pm +++ b/ext/Socket/Socket.pm @@ -162,8 +162,8 @@ have AF_UNIX in the right place. use Carp; require Exporter; -require DynaLoader; -@ISA = qw(Exporter DynaLoader); +use XSLoader (); +@ISA = qw(Exporter); @EXPORT = qw( inet_aton inet_ntoa pack_sockaddr_in unpack_sockaddr_in pack_sockaddr_un unpack_sockaddr_un @@ -333,6 +333,6 @@ sub AUTOLOAD { goto &$AUTOLOAD; } -bootstrap Socket $VERSION; +XSLoader::load 'Socket', $VERSION; 1; diff --git a/ext/Thread/Thread.pm b/ext/Thread/Thread.pm index 1dacdc0..f15883e 100644 --- a/ext/Thread/Thread.pm +++ b/ext/Thread/Thread.pm @@ -1,11 +1,11 @@ package Thread; require Exporter; -require DynaLoader; +use XSLoader (); use vars qw($VERSION @ISA @EXPORT); $VERSION = "1.0"; -@ISA = qw(Exporter DynaLoader); +@ISA = qw(Exporter); @EXPORT_OK = qw(yield cond_signal cond_broadcast cond_wait async); =head1 NAME @@ -77,8 +77,8 @@ of that container are not locked. For example, if a thread does a C a sub, using C. Any calls to that sub from another thread will block until the lock is released. This behaviour is not -equvalent to C in the sub. C -serializes access to a subroutine, but allows different threads +equivalent to declaring the sub with the C attribute. The C +attribute serializes access to a subroutine, but allows different threads non-simultaneous access. C, on the other hand, will not allow I other thread access for the duration of the lock. @@ -185,7 +185,7 @@ duplicate tids. This limitation may be lifted in a future version of Perl. =head1 SEE ALSO -L, L, L, L. +L, L, L, L. =cut @@ -204,6 +204,6 @@ sub eval { return eval { shift->join; }; } -bootstrap Thread; +XSLoader::load 'Thread'; 1; diff --git a/ext/Thread/Thread.xs b/ext/Thread/Thread.xs index e01f29d..6cc1081 100644 --- a/ext/Thread/Thread.xs +++ b/ext/Thread/Thread.xs @@ -24,13 +24,14 @@ static void remove_thread(pTHX_ struct perl_thread *t) { #ifdef USE_THREADS - DEBUG_S(WITH_THR(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(WITH_THR(PerlIO_printf(Perl_debug_log, "%p: remove_thread %p\n", thr, t))); MUTEX_LOCK(&PL_threads_mutex); MUTEX_DESTROY(&t->mutex); PL_nthreads--; t->prev->next = t->next; t->next->prev = t->prev; + SvREFCNT_dec(t->oursv); COND_BROADCAST(&PL_nthreads_cond); MUTEX_UNLOCK(&PL_threads_mutex); #endif @@ -49,7 +50,7 @@ threadstart(void *arg) AV *av; int i; - DEBUG_S(PerlIO_printf(PerlIO_stderr(), "new thread %p starting at %s\n", + DEBUG_S(PerlIO_printf(Perl_debug_log, "new thread %p starting at %s\n", thr, SvPEEK(TOPs))); thr = (Thread) arg; savemark = TOPMARK; @@ -69,7 +70,7 @@ threadstart(void *arg) myop.op_flags |= OPf_WANT_LIST; PL_op = pp_entersub(ARGS); DEBUG_S(if (!PL_op) - PerlIO_printf(PerlIO_stderr(), "thread starts at Nullop\n")); + PerlIO_printf(Perl_debug_log, "thread starts at Nullop\n")); /* * When this thread is next scheduled, we start in the right * place. When the thread runs off the end of the sub, perl.c @@ -94,7 +95,7 @@ threadstart(void *arg) PERL_SET_INTERP(thr->interp); #endif - DEBUG_S(PerlIO_printf(PerlIO_stderr(), "new thread %p waiting to start\n", + DEBUG_S(PerlIO_printf(Perl_debug_log, "new thread %p waiting to start\n", thr)); /* Don't call *anything* requiring dTHR until after SET_THR() */ @@ -116,7 +117,7 @@ threadstart(void *arg) SET_THR(thr); /* Only now can we use SvPEEK (which calls sv_newmortal which does dTHR) */ - DEBUG_S(PerlIO_printf(PerlIO_stderr(), "new thread %p starting at %s\n", + DEBUG_S(PerlIO_printf(Perl_debug_log, "new thread %p starting at %s\n", thr, SvPEEK(TOPs))); av = newAV(); @@ -134,12 +135,13 @@ threadstart(void *arg) MUTEX_UNLOCK(&thr->mutex); av_store(av, 0, &PL_sv_no); av_store(av, 1, newSVsv(thr->errsv)); - DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p died: %s\n", + DEBUG_S(PerlIO_printf(Perl_debug_log, "%p died: %s\n", thr, SvPV(thr->errsv, PL_na))); - } else { + } + else { DEBUG_S(STMT_START { for (i = 1; i <= retval; i++) { - PerlIO_printf(PerlIO_stderr(), "%p return[%d] = %s\n", + PerlIO_printf(Perl_debug_log, "%p return[%d] = %s\n", thr, i, SvPEEK(SP[i - 1])); } } STMT_END); @@ -159,7 +161,6 @@ threadstart(void *arg) SvREFCNT_dec(thr->threadsv); SvREFCNT_dec(thr->specific); SvREFCNT_dec(thr->errsv); - SvREFCNT_dec(thr->errhv); /*Safefree(cxstack);*/ while (PL_curstackinfo->si_next) @@ -190,28 +191,28 @@ threadstart(void *arg) Safefree(PL_reg_poscache); MUTEX_LOCK(&thr->mutex); - DEBUG_S(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: threadstart finishing: state is %u\n", thr, ThrSTATE(thr))); switch (ThrSTATE(thr)) { case THRf_R_JOINABLE: ThrSETSTATE(thr, THRf_ZOMBIE); MUTEX_UNLOCK(&thr->mutex); - DEBUG_S(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: R_JOINABLE thread finished\n", thr)); break; case THRf_R_JOINED: ThrSETSTATE(thr, THRf_DEAD); MUTEX_UNLOCK(&thr->mutex); remove_thread(aTHX_ thr); - DEBUG_S(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: R_JOINED thread finished\n", thr)); break; case THRf_R_DETACHED: ThrSETSTATE(thr, THRf_DEAD); MUTEX_UNLOCK(&thr->mutex); SvREFCNT_dec(av); - DEBUG_S(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: DETACHED thread finished\n", thr)); remove_thread(aTHX_ thr); /* This might trigger main thread to finish */ break; @@ -253,7 +254,7 @@ newthread (pTHX_ SV *startsv, AV *initargs, char *classname) * are the only ones who know about it */ SET_THR(thr); SPAGAIN; - DEBUG_S(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: newthread (%p), tid is %u, preparing stack\n", savethread, thr, thr->tid)); /* The following pushes the arg list and startsv onto the *new* stack */ @@ -293,13 +294,12 @@ newthread (pTHX_ SV *startsv, AV *initargs, char *classname) if (err) { MUTEX_UNLOCK(&thr->mutex); - DEBUG_S(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: create of %p failed %d\n", savethread, thr, err)); /* Thread creation failed--clean up */ SvREFCNT_dec(thr->cvcache); remove_thread(aTHX_ thr); - MUTEX_DESTROY(&thr->mutex); for (i = 0; i <= AvFILL(initargs); i++) SvREFCNT_dec(*av_fetch(initargs, i, FALSE)); SvREFCNT_dec(startsv); @@ -340,7 +340,7 @@ handle_thread_signal(int sig) * so don't be surprised if this isn't robust while debugging * with -DL. */ - DEBUG_S(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(Perl_debug_log, "handle_thread_signal: got signal %d\n", sig);); write(sig_pipe[1], &c, 1); } @@ -365,7 +365,7 @@ join(t) #ifdef USE_THREADS if (t == thr) croak("Attempt to join self"); - DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: joining %p (state %u)\n", + DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: joining %p (state %u)\n", thr, t, ThrSTATE(t));); MUTEX_LOCK(&t->mutex); switch (ThrSTATE(t)) { @@ -386,14 +386,17 @@ join(t) } JOIN(t, &av); + sv_2mortal((SV*)av); + if (SvTRUE(*av_fetch(av, 0, FALSE))) { /* Could easily speed up the following if necessary */ for (i = 1; i <= AvFILL(av); i++) - XPUSHs(sv_2mortal(*av_fetch(av, i, FALSE))); - } else { + XPUSHs(*av_fetch(av, i, FALSE)); + } + else { STRLEN n_a; char *mess = SvPV(*av_fetch(av, 1, FALSE), n_a); - DEBUG_S(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: join propagating die message: %s\n", thr, mess)); croak(mess); @@ -405,7 +408,7 @@ detach(t) Thread t CODE: #ifdef USE_THREADS - DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: detaching %p (state %u)\n", + DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: detaching %p (state %u)\n", thr, t, ThrSTATE(t));); MUTEX_LOCK(&t->mutex); switch (ThrSTATE(t)) { @@ -497,7 +500,7 @@ CODE: sv = SvRV(sv); mg = condpair_magic(sv); - DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: cond_wait %p\n", thr, sv)); + DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: cond_wait %p\n", thr, sv)); MUTEX_LOCK(MgMUTEXP(mg)); if (MgOWNER(mg) != thr) { MUTEX_UNLOCK(MgMUTEXP(mg)); @@ -522,7 +525,7 @@ CODE: sv = SvRV(sv); mg = condpair_magic(sv); - DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: cond_signal %p\n",thr,sv)); + DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: cond_signal %p\n",thr,sv)); MUTEX_LOCK(MgMUTEXP(mg)); if (MgOWNER(mg) != thr) { MUTEX_UNLOCK(MgMUTEXP(mg)); @@ -542,7 +545,7 @@ CODE: sv = SvRV(sv); mg = condpair_magic(sv); - DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: cond_broadcast %p\n", + DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: cond_broadcast %p\n", thr, sv)); MUTEX_LOCK(MgMUTEXP(mg)); if (MgOWNER(mg) != thr) { @@ -645,7 +648,7 @@ await_signal() ST(0) = sv_newmortal(); if (ret) sv_setsv(ST(0), c ? PL_psig_ptr[c] : &PL_sv_no); - DEBUG_S(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(Perl_debug_log, "await_signal returning %s\n", SvPEEK(ST(0)));); MODULE = Thread PACKAGE = Thread::Specific diff --git a/ext/Thread/Thread/Queue.pm b/ext/Thread/Thread/Queue.pm index 6d5f82b..6e2fba8 100644 --- a/ext/Thread/Thread/Queue.pm +++ b/ext/Thread/Thread/Queue.pm @@ -67,15 +67,13 @@ sub new { return bless [@_], $class; } -sub dequeue { - use attrs qw(locked method); +sub dequeue : locked, method { my $q = shift; cond_wait $q until @$q; return shift @$q; } -sub dequeue_nb { - use attrs qw(locked method); +sub dequeue_nb : locked, method { my $q = shift; if (@$q) { return shift @$q; @@ -84,14 +82,12 @@ sub dequeue_nb { } } -sub enqueue { - use attrs qw(locked method); +sub enqueue : locked, method { my $q = shift; push(@$q, @_) and cond_broadcast $q; } -sub pending { - use attrs qw(locked method); +sub pending : locked, method { my $q = shift; return scalar(@$q); } diff --git a/ext/Thread/Thread/Semaphore.pm b/ext/Thread/Thread/Semaphore.pm index 915808c..f50f96c 100644 --- a/ext/Thread/Thread/Semaphore.pm +++ b/ext/Thread/Thread/Semaphore.pm @@ -69,16 +69,14 @@ sub new { bless \$val, $class; } -sub down { - use attrs qw(locked method); +sub down : locked, method { my $s = shift; my $inc = @_ ? shift : 1; cond_wait $s until $$s >= $inc; $$s -= $inc; } -sub up { - use attrs qw(locked method); +sub up : locked, method { my $s = shift; my $inc = @_ ? shift : 1; ($$s += $inc) > 0 and cond_broadcast $s; diff --git a/ext/Thread/Thread/Specific.pm b/ext/Thread/Thread/Specific.pm index 46b9b60..da3f937 100644 --- a/ext/Thread/Thread/Specific.pm +++ b/ext/Thread/Thread/Specific.pm @@ -15,14 +15,12 @@ C returns a unique thread-specific key. =cut -sub import { - use attrs qw(locked method); +sub import : locked, method { require fields; fields::->import(@_); } -sub key_create { - use attrs qw(locked method); +sub key_create : locked, method { return ++$FIELDS{__MAX__}; } diff --git a/ext/Thread/sync.t b/ext/Thread/sync.t index 9c2e589..6445b55 100644 --- a/ext/Thread/sync.t +++ b/ext/Thread/sync.t @@ -2,8 +2,7 @@ use Thread; $level = 0; -sub single_file { - use attrs 'locked'; +sub single_file : locked { my $arg = shift; $level++; print "Level $level for $arg\n"; diff --git a/ext/Thread/sync2.t b/ext/Thread/sync2.t index 0901da4..ffc74b4 100644 --- a/ext/Thread/sync2.t +++ b/ext/Thread/sync2.t @@ -2,8 +2,7 @@ use Thread; $global = undef; -sub single_file { - use attrs 'locked'; +sub single_file : locked { my $who = shift; my $i; diff --git a/ext/Thread/typemap b/ext/Thread/typemap index 21eb6c3..7ce7d5c 100644 --- a/ext/Thread/typemap +++ b/ext/Thread/typemap @@ -13,7 +13,7 @@ T_XSCPTR || mg->mg_private != ${ntype}_MAGIC_SIGNATURE) croak(\"XSUB ${func_name}: $var is a forged ${ntype} object\"); $var = ($type) SvPVX(mg->mg_obj); - DEBUG_S(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(Perl_debug_log, \"XSUB ${func_name}: %p\\n\", $var);) } STMT_END T_IVREF diff --git a/ext/attrs/attrs.pm b/ext/attrs/attrs.pm index e97fa1e..f744e36 100644 --- a/ext/attrs/attrs.pm +++ b/ext/attrs/attrs.pm @@ -1,14 +1,11 @@ package attrs; -require DynaLoader; -use vars '@ISA'; -@ISA = 'DynaLoader'; +use XSLoader (); -use vars qw($VERSION); $VERSION = "1.0"; =head1 NAME -attrs - set/get attributes of a subroutine +attrs - set/get attributes of a subroutine (deprecated) =head1 SYNOPSIS @@ -21,11 +18,17 @@ attrs - set/get attributes of a subroutine =head1 DESCRIPTION -This module lets you set and get attributes for subroutines. +NOTE: Use of this pragma is deprecated. Use the syntax + + sub foo : locked, method { } + +to declare attributes instead. See also L. + +This pragma lets you set and get attributes for subroutines. Setting attributes takes place at compile time; trying to set invalid attribute names causes a compile-time error. Calling -C on a subroutine reference or name returns its list -of attribute names. Notice that C is not exported. +C on a subroutine reference or name returns its list +of attribute names. Notice that C is not exported. Valid attributes are as follows. =over @@ -46,15 +49,10 @@ execution. The semantics of the lock are exactly those of one explicitly taken with the C operator immediately after the subroutine is entered. -=item lvalue - -Setting this attribute enables the subroutine to be used in -lvalue context. See L. - =back =cut -bootstrap attrs $VERSION; +XSLoader::load 'attrs', $VERSION; 1; diff --git a/ext/attrs/attrs.xs b/ext/attrs/attrs.xs index a92922d..4c00cd7 100644 --- a/ext/attrs/attrs.xs +++ b/ext/attrs/attrs.xs @@ -10,8 +10,6 @@ get_flag(char *attr) return CVf_METHOD; else if (strnEQ(attr, "locked", 6)) return CVf_LOCKED; - else if (strnEQ(attr, "lvalue", 6)) - return CVf_LVALUE; else return 0; } @@ -29,6 +27,10 @@ char * Class PPCODE: if (!PL_compcv || !(cv = CvOUTSIDE(PL_compcv))) croak("can't set attributes outside a subroutine scope"); + if (ckWARN(WARN_DEPRECATED)) + Perl_warner(aTHX_ WARN_DEPRECATED, + "pragma \"attrs\" is deprecated, " + "use \"sub NAME : ATTRS\" instead"); for (i = 1; i < items; i++) { STRLEN n_a; char *attr = SvPV(ST(i), n_a); diff --git a/ext/re/re.pm b/ext/re/re.pm index 842e39a..3f142d9 100644 --- a/ext/re/re.pm +++ b/ext/re/re.pm @@ -105,9 +105,8 @@ sub bits { foreach my $s (@_){ if ($s eq 'debug' or $s eq 'debugcolor') { setcolor() if $s eq 'debugcolor'; - require DynaLoader; - @ISA = ('DynaLoader'); - bootstrap re; + require XSLoader; + XSLoader::load('re'); install() if $on; uninstall() unless $on; next; diff --git a/global.sym b/global.sym index 7200c60..0fc9739 100644 --- a/global.sym +++ b/global.sym @@ -4,17 +4,34 @@ # and run 'make regen_headers' to effect changes. # +perl_alloc_using +perl_alloc +perl_construct +perl_destruct +perl_free +perl_run +perl_parse +perl_clone +perl_clone_using +Perl_malloc +Perl_calloc +Perl_realloc +Perl_mfree +Perl_malloced_size Perl_amagic_call Perl_Gv_AMupdate Perl_append_elem Perl_append_list Perl_apply +Perl_avhv_delete_ent Perl_avhv_exists_ent Perl_avhv_fetch_ent Perl_avhv_iternext Perl_avhv_iterval Perl_avhv_keys Perl_av_clear +Perl_av_delete +Perl_av_exists Perl_av_extend Perl_av_fake Perl_av_fetch @@ -74,7 +91,6 @@ Perl_get_ppaddr Perl_cxinc Perl_deb Perl_vdeb -Perl_deb_growlevel Perl_debprofdump Perl_debop Perl_debstack @@ -293,7 +309,6 @@ Perl_magic_set_all_env Perl_magic_sizepack Perl_magic_wipepack Perl_magicname -Perl_malloced_size Perl_markstack_grow Perl_mem_collxfrm Perl_mess @@ -359,6 +374,7 @@ Perl_newHV Perl_newHVhv Perl_newIO Perl_newLISTOP +Perl_newPADOP Perl_newPMOP Perl_newPVOP Perl_newRV @@ -393,17 +409,6 @@ Perl_pad_free Perl_pad_reset Perl_pad_swipe Perl_peep -perl_construct -perl_destruct -perl_free -perl_run -perl_parse -perl_alloc -perl_construct -perl_destruct -perl_free -perl_run -perl_parse Perl_new_struct_thread Perl_call_atexit Perl_call_argv @@ -465,6 +470,7 @@ Perl_save_ary Perl_save_clearsv Perl_save_delete Perl_save_destructor +Perl_save_destructor_x Perl_save_freesv Perl_save_freeop Perl_save_freepv @@ -476,6 +482,7 @@ Perl_save_hints Perl_save_hptr Perl_save_I16 Perl_save_I32 +Perl_save_I8 Perl_save_int Perl_save_item Perl_save_iv @@ -485,6 +492,7 @@ Perl_save_nogv Perl_save_op Perl_save_scalar Perl_save_pptr +Perl_save_vptr Perl_save_re_context Perl_save_sptr Perl_save_svref @@ -515,11 +523,15 @@ Perl_sv_2iv Perl_sv_2mortal Perl_sv_2nv Perl_sv_2pv +Perl_sv_2pvutf8 +Perl_sv_2pvbyte Perl_sv_2uv Perl_sv_iv Perl_sv_uv Perl_sv_nv Perl_sv_pvn +Perl_sv_pvutf8n +Perl_sv_pvbyten Perl_sv_true Perl_sv_add_arena Perl_sv_backoff @@ -559,6 +571,8 @@ Perl_sv_peek Perl_sv_pos_u2b Perl_sv_pos_b2u Perl_sv_pvn_force +Perl_sv_pvutf8n_force +Perl_sv_pvbyten_force Perl_sv_reftype Perl_sv_replace Perl_sv_report_used @@ -606,6 +620,7 @@ Perl_uv_to_utf8 Perl_vivify_defelem Perl_vivify_ref Perl_wait4pid +Perl_report_uninit Perl_warn Perl_vwarn Perl_warner @@ -618,10 +633,6 @@ Perl_yylex Perl_yyparse Perl_yywarn Perl_dump_mstats -Perl_malloc -Perl_calloc -Perl_realloc -Perl_mfree Perl_safesysmalloc Perl_safesyscalloc Perl_safesysrealloc @@ -664,7 +675,11 @@ Perl_default_protect Perl_vdefault_protect Perl_reginitcolors Perl_sv_2pv_nolen +Perl_sv_2pvutf8_nolen +Perl_sv_2pvbyte_nolen Perl_sv_pv +Perl_sv_pvutf8 +Perl_sv_pvbyte Perl_sv_force_normal Perl_tmps_grow Perl_sv_rvweaken @@ -674,3 +689,19 @@ Perl_newATTRSUB Perl_newMYSUB Perl_my_attrs Perl_boot_core_xsutils +Perl_cx_dup +Perl_si_dup +Perl_ss_dup +Perl_any_dup +Perl_he_dup +Perl_re_dup +Perl_fp_dup +Perl_dirp_dup +Perl_gp_dup +Perl_mg_dup +Perl_sv_dup +Perl_sys_intern_dup +Perl_ptr_table_new +Perl_ptr_table_fetch +Perl_ptr_table_store +Perl_ptr_table_split diff --git a/globals.c b/globals.c index 9777273..41dc924 100644 --- a/globals.c +++ b/globals.c @@ -9,11 +9,12 @@ #undef PERLVARA #define PERLVARA(x, n, y) #undef PERLVARI -#define PERLVARI(x, y, z) PL_##x = z; +#define PERLVARI(x, y, z) interp.x = z; #undef PERLVARIC -#define PERLVARIC(x, y, z) PL_##x = z; +#define PERLVARIC(x, y, z) interp.x = z; -CPerlObj::CPerlObj(IPerlMem* ipM, IPerlEnv* ipE, IPerlStdIO* ipStd, +CPerlObj::CPerlObj(IPerlMem* ipM, IPerlMem* ipMS, IPerlMem* ipMP, + IPerlEnv* ipE, IPerlStdIO* ipStd, IPerlLIO* ipLIO, IPerlDir* ipD, IPerlSock* ipS, IPerlProc* ipP) { @@ -21,9 +22,10 @@ CPerlObj::CPerlObj(IPerlMem* ipM, IPerlEnv* ipE, IPerlStdIO* ipStd, #include "thrdvar.h" #include "intrpvar.h" -#include "perlvars.h" PL_Mem = ipM; + PL_MemShared = ipMS; + PL_MemParse = ipMP; PL_Env = ipE; PL_StdIO = ipStd; PL_LIO = ipLIO; @@ -37,21 +39,20 @@ CPerlObj::operator new(size_t nSize, IPerlMem *pvtbl) { if(pvtbl) return pvtbl->pMalloc(pvtbl, nSize); - +#ifndef __MINGW32__ + /* operator new is supposed to throw std::bad_alloc */ return NULL; +#endif } +#ifndef __BORLANDC__ void CPerlObj::operator delete(void *pPerl, IPerlMem *pvtbl) { if(pvtbl) pvtbl->pFree(pvtbl, pPerl); } - -void -CPerlObj::Init(void) -{ -} +#endif #ifdef WIN32 /* XXX why are these needed? */ bool diff --git a/globvar.sym b/globvar.sym index 3cb8ccc..0d76888 100644 --- a/globvar.sym +++ b/globvar.sym @@ -32,8 +32,6 @@ opargs ppaddr sig_name sig_num -psig_name -psig_ptr regkind simple utf8skip diff --git a/gv.c b/gv.c index d257114..0305ad5 100644 --- a/gv.c +++ b/gv.c @@ -59,6 +59,9 @@ Perl_gv_fetchfile(pTHX_ const char *name) STRLEN tmplen; GV *gv; + if (!PL_defstash) + return Nullgv; + tmplen = strlen(name) + 2; if (tmplen < sizeof smallbuf) tmpbuf = smallbuf; @@ -68,15 +71,14 @@ Perl_gv_fetchfile(pTHX_ const char *name) tmpbuf[1] = '<'; strcpy(tmpbuf + 2, name); gv = *(GV**)hv_fetch(PL_defstash, tmpbuf, tmplen, TRUE); - if (!isGV(gv)) + if (!isGV(gv)) { gv_init(gv, PL_defstash, tmpbuf, tmplen, FALSE); + sv_setpv(GvSV(gv), name); + if (PERLDB_LINE) + hv_magic(GvHVn(gv_AVadd(gv)), gv, 'L'); + } if (tmpbuf != smallbuf) Safefree(tmpbuf); - sv_setpv(GvSV(gv), name); - if (*name == '/' && (instr(name, "/lib/") || instr(name, ".pm"))) - GvMULTI_on(gv); - if (PERLDB_LINE) - hv_magic(GvHVn(gv_AVadd(gv)), gv, 'L'); return gv; } @@ -100,8 +102,8 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi) Newz(602, gp, 1, GP); GvGP(gv) = gp_ref(gp); GvSV(gv) = NEWSV(72,0); - GvLINE(gv) = PL_curcop->cop_line; - GvFILEGV(gv) = PL_curcop->cop_filegv; + GvLINE(gv) = CopLINE(PL_curcop); + GvFILE(gv) = CopFILE(PL_curcop) ? CopFILE(PL_curcop) : ""; GvCVGEN(gv) = 0; GvEGV(gv) = gv; sv_magic((SV*)gv, (SV*)gv, '*', name, len); @@ -120,7 +122,7 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi) PL_sub_generation++; CvGV(GvCV(gv)) = (GV*)SvREFCNT_inc(gv); - CvFILEGV(GvCV(gv)) = PL_curcop->cop_filegv; + CvFILE(GvCV(gv)) = CopFILE(PL_curcop); CvSTASH(GvCV(gv)) = PL_curstash; #ifdef USE_THREADS CvOWNER(GvCV(gv)) = 0; @@ -301,7 +303,7 @@ Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload) if ((nsplit - origname) == 5 && strnEQ(origname, "SUPER", 5)) { /* ->SUPER::method should really be looked up in original stash */ SV *tmpstr = sv_2mortal(Perl_newSVpvf(aTHX_ "%s::SUPER", - HvNAME(PL_curcop->cop_stash))); + CopSTASHPV(PL_curcop))); stash = gv_stashpvn(SvPVX(tmpstr), SvCUR(tmpstr), TRUE); DEBUG_o( Perl_deb(aTHX_ "Treating %s as %s::%s\n", origname, HvNAME(stash), name) ); @@ -446,8 +448,8 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) name++; for (namend = name; *namend; namend++) { - if ((*namend == '\'' && namend[1]) || - (*namend == ':' && namend[1] == ':')) + if ((*namend == ':' && namend[1] == ':') + || (*namend == '\'' && namend[1])) { if (!stash) stash = PL_defstash; @@ -531,7 +533,6 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) else if ((COP*)PL_curcop == &PL_compiling) { stash = PL_curstash; if (add && (PL_hints & HINT_STRICT_VARS) && - !(add & GV_ADDOUR) && sv_type != SVt_PVCV && sv_type != SVt_PVGV && sv_type != SVt_PVFM && @@ -560,7 +561,7 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) } } else - stash = PL_curcop->cop_stash; + stash = CopSTASH(PL_curcop); } else stash = PL_defstash; @@ -653,15 +654,19 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) if (strEQ(name, "SIG")) { HV *hv; I32 i; - PL_siggv = gv; - GvMULTI_on(PL_siggv); - hv = GvHVn(PL_siggv); - hv_magic(hv, PL_siggv, 'S'); - for(i=1;PL_sig_name[i];i++) { + if (!PL_psig_ptr) { + int sig_num[] = { SIG_NUM }; + New(73, PL_psig_ptr, sizeof(sig_num)/sizeof(*sig_num), SV*); + New(73, PL_psig_name, sizeof(sig_num)/sizeof(*sig_num), SV*); + } + GvMULTI_on(gv); + hv = GvHVn(gv); + hv_magic(hv, gv, 'S'); + for (i = 1; PL_sig_name[i]; i++) { SV ** init; - init=hv_fetch(hv,PL_sig_name[i],strlen(PL_sig_name[i]),1); - if(init) - sv_setsv(*init,&PL_sv_undef); + init = hv_fetch(hv, PL_sig_name[i], strlen(PL_sig_name[i]), 1); + if (init) + sv_setsv(*init, &PL_sv_undef); PL_psig_ptr[i] = 0; PL_psig_name[i] = 0; } @@ -675,21 +680,18 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) case '&': if (len > 1) break; - PL_ampergv = gv; PL_sawampersand = TRUE; goto ro_magicalize; case '`': if (len > 1) break; - PL_leftgv = gv; PL_sawampersand = TRUE; goto ro_magicalize; case '\'': if (len > 1) break; - PL_rightgv = gv; PL_sawampersand = TRUE; goto ro_magicalize; @@ -810,8 +812,9 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) if (len == 1) { SV *sv = GvSV(gv); (void)SvUPGRADE(sv, SVt_PVNV); - sv_setpv(sv, PL_patchlevel); - (void)sv_2nv(sv); + SvNVX(sv) = SvNVX(PL_patchlevel); + SvNOK_on(sv); + (void)SvPV_nolen(sv); SvREADONLY_on(sv); } break; @@ -883,7 +886,6 @@ Perl_gv_check(pTHX_ HV *stash) register I32 i; register GV *gv; HV *hv; - GV *filegv; if (!HvARRAY(stash)) return; @@ -896,14 +898,25 @@ Perl_gv_check(pTHX_ HV *stash) gv_check(hv); /* nested package */ } else if (isALPHA(*HeKEY(entry))) { + char *file; gv = (GV*)HeVAL(entry); if (SvTYPE(gv) != SVt_PVGV || GvMULTI(gv)) continue; - PL_curcop->cop_line = GvLINE(gv); - filegv = GvFILEGV(gv); - PL_curcop->cop_filegv = filegv; - if (filegv && GvMULTI(filegv)) /* Filename began with slash */ + file = GvFILE(gv); + /* performance hack: if filename is absolute and it's a standard + * module, don't bother warning */ + if (file + && PERL_FILE_IS_ABSOLUTE(file) + && (instr(file, "/lib/") || instr(file, ".pm"))) + { continue; + } + CopLINE_set(PL_curcop, GvLINE(gv)); +#ifdef USE_ITHREADS + CopFILE(PL_curcop) = file; /* set for warning */ +#else + CopFILEGV(PL_curcop) = gv_fetchfile(file); +#endif Perl_warner(aTHX_ WARN_ONCE, "Name \"%s::%s\" used only once: possible typo", HvNAME(stash), GvNAME(gv)); @@ -924,6 +937,8 @@ Perl_newGVgen(pTHX_ char *pack) GP* Perl_gp_ref(pTHX_ GP *gp) { + if (!gp) + return (GP*)NULL; gp->gp_refcnt++; if (gp->gp_cv) { if (gp->gp_cvgen) { diff --git a/gv.h b/gv.h index fc9985a..f489d2d 100644 --- a/gv.h +++ b/gv.h @@ -17,9 +17,9 @@ struct gp { GV * gp_egv; /* effective gv, if *glob */ CV * gp_cv; /* subroutine value */ U32 gp_cvgen; /* generational validity of cached gv_cv */ - I32 gp_lastexpr; /* used by nothing_in_common() */ + U32 gp_flags; /* XXX unused */ line_t gp_line; /* line first declared at (for -w) */ - GV * gp_filegv; /* file first declared in (for -w) */ + char * gp_file; /* file first declared in (for -w) */ }; #if defined(CRIPPLED_CC) && (defined(iAPX286) || defined(M_I286) || defined(I80286)) @@ -67,10 +67,11 @@ HV *GvHVn(); #define GvCVGEN(gv) (GvGP(gv)->gp_cvgen) #define GvCVu(gv) (GvGP(gv)->gp_cvgen ? Nullcv : GvGP(gv)->gp_cv) -#define GvLASTEXPR(gv) (GvGP(gv)->gp_lastexpr) +#define GvGPFLAGS(gv) (GvGP(gv)->gp_flags) #define GvLINE(gv) (GvGP(gv)->gp_line) -#define GvFILEGV(gv) (GvGP(gv)->gp_filegv) +#define GvFILE(gv) (GvGP(gv)->gp_file) +#define GvFILEGV(gv) (gv_fetchfile(GvFILE(gv))) #define GvEGV(gv) (GvGP(gv)->gp_egv) #define GvENAME(gv) GvNAME(GvEGV(gv) ? GvEGV(gv) : gv) @@ -79,6 +80,7 @@ HV *GvHVn(); #define GVf_INTRO 0x01 #define GVf_MULTI 0x02 #define GVf_ASSUMECV 0x04 +#define GVf_IN_PAD 0x08 #define GVf_IMPORTED 0xF0 #define GVf_IMPORTED_SV 0x10 #define GVf_IMPORTED_AV 0x20 @@ -117,6 +119,10 @@ HV *GvHVn(); #define GvIMPORTED_CV_on(gv) (GvFLAGS(gv) |= GVf_IMPORTED_CV) #define GvIMPORTED_CV_off(gv) (GvFLAGS(gv) &= ~GVf_IMPORTED_CV) +#define GvIN_PAD(gv) (GvFLAGS(gv) & GVf_IN_PAD) +#define GvIN_PAD_on(gv) (GvFLAGS(gv) |= GVf_IN_PAD) +#define GvIN_PAD_off(gv) (GvFLAGS(gv) &= ~GVf_IN_PAD) + #define Nullgv Null(GV*) #define DM_UID 0x003 @@ -135,4 +141,3 @@ HV *GvHVn(); #define GV_ADDWARN 0x04 /* add, but warn if symbol wasn't already there */ #define GV_ADDINEVAL 0x08 /* add, as though we're doing so within an eval */ #define GV_NOINIT 0x10 /* add, but don't init symbol, if type != PVGV */ -#define GV_ADDOUR 0x20 /* add "our" variable */ diff --git a/handy.h b/handy.h index 5ffd01d..92d163e 100644 --- a/handy.h +++ b/handy.h @@ -91,6 +91,7 @@ For dealing with issues that may arise from various 32/64-bit systems, we will ask Configure to check out + SHORTSIZE == sizeof(short) INTSIZE == sizeof(int) LONGSIZE == sizeof(long) @@ -98,31 +99,43 @@ PTRSIZE == sizeof(void *) DOUBLESIZE == sizeof(double) LONG_DOUBLESIZE == sizeof(long double) (if HAS_LONG_DOUBLE). - Most of these are currently unused, but they are mentioned here so - metaconfig will include the appropriate tests in Configure and - we can then start to consider how best to deal with long long - variables. - Andy Dougherty April 1998 + */ +typedef I8TYPE I8; +typedef U8TYPE U8; +typedef I16TYPE I16; +typedef U16TYPE U16; +typedef I32TYPE I32; +typedef U32TYPE U32; +#ifdef PERL_CORE +# ifdef HAS_QUAD +# if QUADKIND == QUAD_IS_INT64_T +# include +# ifdef I_INTTYPES /* e.g. Linux has int64_t without */ +# include +# endif +# endif +typedef I64TYPE I64; +typedef U64TYPE U64; +# endif +#endif /* PERL_CORE */ + +/* Mention I8SIZE, U8SIZE, I16SIZE, U16SIZE, I32SIZE, U32SIZE, + I64SIZE, and U64SIZE here so that metaconfig pulls them in. */ + #if defined(UINT8_MAX) && defined(INT16_MAX) && defined(INT32_MAX) -typedef int8_t I8; -typedef uint8_t U8; /* I8_MAX and I8_MIN constants are not defined, as I8 is an ambiguous type. Please search CHAR_MAX in perl.h for further details. */ #define U8_MAX UINT8_MAX #define U8_MIN UINT8_MIN -typedef int16_t I16; -typedef uint16_t U16; #define I16_MAX INT16_MAX #define I16_MIN INT16_MIN #define U16_MAX UINT16_MAX #define U16_MIN UINT16_MIN -typedef int32_t I32; -typedef uint32_t U32; #define I32_MAX INT32_MAX #define I32_MIN INT32_MIN #define U32_MAX UINT32_MAX @@ -130,31 +143,22 @@ typedef uint32_t U32; #else -typedef char I8; -typedef unsigned char U8; /* I8_MAX and I8_MIN constants are not defined, as I8 is an ambiguous type. Please search CHAR_MAX in perl.h for further details. */ #define U8_MAX PERL_UCHAR_MAX #define U8_MIN PERL_UCHAR_MIN -/* Beware. SHORTSIZE > 2 in Cray C90ties. */ -typedef short I16; -typedef unsigned short U16; #define I16_MAX PERL_SHORT_MAX #define I16_MIN PERL_SHORT_MIN #define U16_MAX PERL_USHORT_MAX #define U16_MIN PERL_USHORT_MIN #if LONGSIZE > 4 - typedef int I32; - typedef unsigned int U32; # define I32_MAX PERL_INT_MAX # define I32_MIN PERL_INT_MIN # define U32_MAX PERL_UINT_MAX # define U32_MIN PERL_UINT_MIN #else - typedef long I32; - typedef unsigned long U32; # define I32_MAX PERL_LONG_MAX # define I32_MIN PERL_LONG_MIN # define U32_MAX PERL_ULONG_MAX diff --git a/hints/README.hints b/hints/README.hints index 015e1c1..5f23b29 100644 --- a/hints/README.hints +++ b/hints/README.hints @@ -11,7 +11,9 @@ over from perl4. Please send any problems or suggested changes to perlbug@perl.com. -Hint file naming convention: Each hint file name should have only +=head1 Hint file naming convention. + +Each hint file name should have only one '.'. (This is for portability to non-unix file systems.) Names should also fit in <= 14 characters, for portability to older SVR3 systems. File names are of the form $osname_$osvers.sh, with all '.' @@ -51,6 +53,56 @@ detect what is needed. A glossary of config.sh variables is in the file Porting/Glossary. +=head1 Setting variables + +=head2 Optimizer + +If you want to set a variable, try to allow for Configure command-line +overrides. For example, suppose you think the default optimizer +setting to be -O2 for a particular platform. You should allow for +command line overrides with something like + + case "$optimize" in + '') optimize='-O2' ;; + esac + +or, if your system has a decent test(1) command, + + test -z "$optimize" && optimize='-O2' + +This allows the user to select a different optimization level, e.g. +-O6 or -g. + +=head2 Compiler and Linker flags + +If you want to set $ccflags or $ldflags, you should append to the existing +value to allow Configure command-line settings, e.g. use + + ccflags="$ccflags -DANOTHER_OPTION_I_NEED" + +so that the user can do something like + + sh Configure -Dccflags='FIX_NEGATIVE_ZERO' + +and have the FIX_NEGATIVE_ZERO value preserved by the hints file. + +=head2 Libraries + +Configure will attempt to use the libraries listed in the variable +$libswanted. If necessary, you should remove broken libraries from +that list, or add additional libraries to that list. You should +*not* simply set $libs -- that ignores the possibilities of local +variations. For example, a setting of libs='-lgdbm -lm -lc' would +fail if another user were to try to compile Perl on a system without +GDBM but with Berkeley DB. See hints/dec_osf.sh and hints/solaris_2.sh +for examples. + +=head2 Other + +In general, try to avoid hard-wiring something that Configure will +figure out anyway. Also try to allow for Configure command-line +overrides. + =head1 Hint file tricks =head2 Printing critical messages @@ -204,4 +256,4 @@ say things like "sh Configure -Dcc=gcc -Dusethreads" on the command line. Have the appropriate amount of fun :-) - Andy Dougherty doughera@lafcol.lafayette.edu + Andy Dougherty doughera@lafayette.edu diff --git a/hints/aix.sh b/hints/aix.sh index 5a027b3..fec963b 100644 --- a/hints/aix.sh +++ b/hints/aix.sh @@ -2,7 +2,7 @@ # AIX 3.x.x hints thanks to Wayne Scott # AIX 4.1 hints thanks to Christopher Chan-Nui . # AIX 4.1 pthreading by Christopher Chan-Nui and -# Jarkko Hietaniemi . +# Jarkko Hietaniemi . # Merged on Mon Feb 6 10:22:35 EST 1995 by # Andy Dougherty @@ -37,7 +37,7 @@ # pages state: # setrgid: The EPERM error code is always returned. # setruid: The EPERM error code is always returned. Processes cannot -# reset only their real user IDs. +# reset only their real user IDs. d_setrgid='undef' d_setruid='undef' @@ -61,7 +61,11 @@ case "$osvers" in esac so="a" -dlext="o" +# AIX itself uses .o (libc.o) but we prefer compatibility +# with the rest of the world and with rest of the scripting +# languages (Tcl, Python) and related systems (SWIG). +# Stephanie Beals +dlext="so" # Trying to set this breaks the POSIX.c compilation @@ -73,6 +77,8 @@ case "$archname" in '') archname="$osname" ;; esac +cc=${cc:-cc} + case "$osvers" in 3*) d_fchmod=undef ccflags="$ccflags -D_ALL_SOURCE" @@ -107,14 +113,14 @@ esac # The first 3 options would not be needed if dynamic libs. could be linked # with the compiler instead of ld. # -bI:$(PERL_INC)/perl.exp Read the exported symbols from the perl binary -# -bE:$(BASEEXT).exp Export these symbols. This file contains only one -# symbol: boot_$(EXP) can it be auto-generated? +# -bE:$(BASEEXT).exp Export these symbols. This file contains only one +# symbol: boot_$(EXP) can it be auto-generated? case "$osvers" in 3*) - lddlflags="$lddlflags -H512 -T512 -bhalt:4 -bM:SRE -bI:$(PERL_INC)/perl.exp -bE:$(BASEEXT).exp -e _nostart -lc" + lddlflags="$lddlflags -H512 -T512 -bhalt:4 -bM:SRE -bI:\$(PERL_INC)/perl.exp -bE:\$(BASEEXT).exp -e _nostart -lc" ;; *) - lddlflags="$lddlflags -bhalt:4 -bM:SRE -bI:$(PERL_INC)/perl.exp -bE:$(BASEEXT).exp -b noentry -lc" + lddlflags="$lddlflags -bhalt:4 -bM:SRE -bI:\$(PERL_INC)/perl.exp -bE:\$(BASEEXT).exp -b noentry -lc" ;; esac @@ -123,48 +129,88 @@ esac cat > UU/usethreads.cbu <<'EOCBU' case "$usethreads" in $define|true|[yY]*) - ccflags="$ccflags -DNEED_PTHREAD_INIT" - case "$cc" in - gcc) ;; - cc_r) ;; - cc|xlc_r) + ccflags="$ccflags -DNEED_PTHREAD_INIT" + case "$cc" in + gcc) ;; + cc_r) ;; + cc|xl[cC]_r) echo >&4 "Switching cc to cc_r because of POSIX threads." # xlc_r has been known to produce buggy code in AIX 4.3.2. - # (e.g. pragma/overload core dumps) + # (e.g. pragma/overload core dumps) Let's suspect xlC_r, too. # --jhi@iki.fi cc=cc_r if test ! -e /bin/cc_r; then - cat >&4 <&4 <&4 <&4 < UU/uselfs.cbu <<'EOCBU' +case "$uselargefiles" in +$define|true|[yY]*) + lfcflags="`getconf XBS5_ILP32_OFFBIG_CFLAGS 2>/dev/null`" + lfldflags="`getconf XBS5_ILP32_OFFBIG_LDFLAGS 2>/dev/null`" + # _Somehow_ in AIX 4.3.1.0 the above getconf call manages to + # insert(?) *something* to $ldflags so that later (in Configure) evaluating + # $ldflags causes a newline after the '-b64' (the result of the getconf). + # (nothing strange shows up in $ldflags even in hexdump; + # so it may be something in the shell, instead?) + # Try it out: just uncomment the below line and rerun Configure: +# echo >&4 "AIX 4.3.1.0 $lfldflags mystery" ; exit 1 + # Just don't ask me how AIX does it, I spent hours wondering. + # Therefore the line re-evaluating lfldflags: it seems to fix + # the whatever it was that AIX managed to break. --jhi + lfldflags="`echo $lfldflags`" + lflibs="`getconf XBS5_ILP32_OFFBIG_LIBS 2>/dev/null|sed -e 's@^-l@@' -e 's@ -l@ @g`" + case "$lfcflags$lfldflags$lflibs" in + '');; + *) ccflags="$ccflags $lfcflags" + ldflags="$ldflags $ldldflags" + libswanted="$libswanted $lflibs" + ;; + esac + lfcflags='' + lfldflags='' + lflibs='' ;; esac EOCBU @@ -183,23 +229,10 @@ EOM exit 1 ;; esac - ccflags="$ccflags -DUSE_LONG_LONG" - ccflags="$ccflags `getconf XBS5_ILP32_OFFBIG_CFLAGS 2>/dev/null`" - - ldflags="$ldflags `getconf XBS5_ILP32_OFFBIG_LDFLAGS 2>/dev/null`" - # _Somehow_ in AIX 4.3.1.0 the above getconf call manages to - # insert(?) *something* to $ldflags so that later (in Configure) evaluating - # $ldflags causes a newline after the '-b64' (the result of the getconf). - # (nothing strange shows up in $ldflags even in hexdump; - # so it may be something in the shell, instead?) - # Try it out: just uncomment the below line and rerun Configure: -# echo >& "AIX $ldflags mystery" ; exit 1 - # Just don't ask me how AIX does it. - # Therefore the line re-evaluating ldflags: it seems to bypass - # the whatever it was AIX managed to break. --jhi - ldflags="`echo $ldflags`" - - libswanted="$libswanted `getconf XBS5_ILP32_OFFBIG_LIBS 2>/dev/null|sed -e 's@^-l@@' -e 's@ -l@ @g'`" + case "$ccflags" in + *-DUSE_LONG_LONG*) ;; + *) ccflags="$ccflags -DUSE_LONG_LONG" ;; + esac # When a 64-bit cc becomes available $archname64 # may need setting so that $archname gets it attached. ;; @@ -212,8 +245,26 @@ cat > UU/uselongdouble.cbu <<'EOCBU' case "$uselongdouble" in $define|true|[yY]*) ccflags="$ccflags -qlongdouble" + # The explicit cc128, xlc128, xlC128 are not needed, + # the -qlongdouble should do the trick. --jhi ;; esac EOCBU +# If the C++ libraries, libC and libC_r, are available we will prefer them +# over the vanilla libc, because the libC contain loadAndInit() and +# terminateAndUnload() which work correctly with C++ statics while libc +# load() and unload() do not. See ext/DynaLoader/dl_aix.xs. +# The C-to-C_r switch is done by usethreads.cbu, if needed. +if test -f /lib/libC.a -a X"`$cc -v 2>&1 | grep gcc`" = X; then + # Cify libswanted. + set `echo X "$libswanted "| sed -e 's/ c / C c /'` + shift + libswanted="$*" + # Cify lddlflags. + set `echo X "$lddlflags "| sed -e 's/ -lc / -lC -lc /'` + shift + lddlflags="$*" +fi + # EOF diff --git a/hints/amigaos.sh b/hints/amigaos.sh index 9d86e52..fff55b0 100644 --- a/hints/amigaos.sh +++ b/hints/amigaos.sh @@ -22,15 +22,20 @@ libpth="$prefix/lib /local/lib" glibpth="$libpth" xlibpth="$libpth" +# This should remove unwanted libraries instead of limiting the set +# to just these few. E.g. what about Berkeley DB? libswanted='gdbm m dld' so=' ' # compiler & linker flags +# Respect command-line values. -ccflags='-DAMIGAOS -mstackextend' -ldflags='' -optimize='-O2 -fomit-frame-pointer' +ccflags="$ccflags -DAMIGAOS -mstackextend" +case "$optimize" in +'') optimize='-O2 -fomit-frame-pointer';; +esac dlext='o' +# Are these two different from the defaults? cccdlflags='none' ccdlflags='none' lddlflags='-oformat a.out-amiga -r' diff --git a/hints/cygwin.sh b/hints/cygwin.sh index 23d055f..71c9a83 100644 --- a/hints/cygwin.sh +++ b/hints/cygwin.sh @@ -2,34 +2,39 @@ # cygwin.sh - hints for building perl using the Cygwin environment for Win32 # -_exe='.exe' +# not otherwise settable exe_ext='.exe' -# work around case-insensitive file names firstmakefile='GNUmakefile' -sharpbang='#!' -startsh='#!/bin/sh' +case "$ldlibpthname" in +'') ldlibpthname=PATH ;; +esac -archname='cygwin' -cc='gcc' -libpth='/usr/i586-cygwin32/lib /usr/lib /usr/local/lib' +# mandatory (overrides incorrect defaults) +test -z "$cc" && cc='gcc' +if test -z "$plibpth" +then + plibpth=`gcc -print-file-name=libc.a` + plibpth=`dirname $plibpth` + plibpth=`cd $plibpth && pwd` +fi so='dll' -libs='-lcygwin -lm -lkernel32' -#optimize='-g' -ccflags='-DCYGWIN -I/usr/include -I/usr/local/include' -ldflags='-L/usr/i586-cygwin32/lib -L/usr/lib -L/usr/local/lib' -usemymalloc='n' -dlsrc='dl_cygwin.xs' -cccdlflags=' ' +# - eliminate -lc, implied by gcc +libswanted=`echo " $libswanted " | sed -e 's/ c / /g'` +libswanted="$libswanted cygipc cygwin kernel32" +ccflags="$ccflags -DCYGWIN" +# - otherwise i686-cygwin +archname='cygwin' + +# dynamic loading ld='ld2' -lddlflags='-L/usr/local/lib' -useshrplib='true' -libperl='libperl.a' -dlext='dll' -dynamic_ext=' ' +# - otherwise -fpic +cccdlflags=' ' -man1dir=/usr/local/man/man1 -man3dir=/usr/local/man/man3 +# optional(ish) +# - perl malloc needs to be unpolluted +bincompat5005='undef' -case "$ldlibpthname" in -'') ldlibpthname=PATH ;; -esac +# strip exe's and dll's +#ldflags="$ldflags -s" +#ccdlflags="$ccdlflags -s" +#lddlflags="$lddlflags -s" diff --git a/hints/dec_osf.sh b/hints/dec_osf.sh index fd7f479..5eb7e80 100644 --- a/hints/dec_osf.sh +++ b/hints/dec_osf.sh @@ -58,11 +58,13 @@ # and it is called GEM. Many of the options we are going to use depend # on the compiler style. +cc=${cc:-cc} + # do NOT, I repeat, *NOT* take away the leading tabs # Configure Black Magic (TM) # reset _DEC_cc_style= -case "$cc" in +case "`$cc -v 2>&1 | grep cc`" in *gcc*) ;; # pass *) # compile something small: taint.c is fine for this. # the main point is the '-v' flag of 'cc'. @@ -80,7 +82,7 @@ case "$cc" in esac # be nauseatingly ANSI -case "$cc" in +case "`$cc -v 2>&1 | grep gcc`" in *gcc*) ccflags="$ccflags -ansi" ;; *) ccflags="$ccflags -std" @@ -93,7 +95,7 @@ esac # we want optimisation case "$optimize" in -'') case "$cc" in +'') case "`$cc -v 2>&1 | grep gcc`" in *gcc*) optimize='-O3' ;; *) case "$_DEC_cc_style" in @@ -202,22 +204,26 @@ esac pp_sys_cflags='ccflags="$ccflags -DNO_EFF_ONLY_OK"' +# The off_t is already 8 bytes, so we do have largefileness. + # This script UU/usethreads.cbu will get 'called-back' by Configure # after it has prompted the user for whether to use threads. cat > UU/usethreads.cbu <<'EOCBU' case "$usethreads" in $define|true|[yY]*) - # Threads interfaces changed with V4.0. - case "`uname -r`" in - *[123].*) - libswanted="$libswanted pthreads mach exc c_r" - ccflags="-threads $ccflags" - ;; - *) - libswanted="$libswanted pthread exc" - ccflags="-pthread $ccflags" + # Threads interfaces changed with V4.0. + case "`$cc -v 2>&1 | grep gcc`" in + *gcc*)ccflags="-D_REENTRANT $ccflags" ;; + *) case "`uname -r`" in + *[123].*) ccflags="-threads $ccflags" ;; + *) ccflags="-pthread $ccflags" ;; + esac ;; - esac + esac + case "`uname -r`" in + *[123].*) libswanted="$libswanted pthreads mach exc c_r" ;; + *) libswanted="$libswanted pthread exc" ;; + esac usemymalloc='n' ;; @@ -359,5 +365,3 @@ unset _DEC_cc_style # * Set -Olimit to 3200 because perl_yylex.c got too big # for the optimizer. # - - diff --git a/hints/dynixptx.sh b/hints/dynixptx.sh index 2edf026..5320030 100644 --- a/hints/dynixptx.sh +++ b/hints/dynixptx.sh @@ -22,7 +22,9 @@ usenm='n' # for performance, apparently this makes a huge difference (~krader) d_vfork='define' -optimize='-Wc,-O3 -W0,-xstring' +case "$optimize" in +'') optimize='-Wc,-O3 -W0,-xstring' ;; +esac # We override d_socket because it's very hard for Configure to get it right # in Dynix/Ptx, for several reasons. @@ -49,9 +51,9 @@ case "$osvers" in d_sockpair='define' ;; 4.2*) # on ptx/TCP 4.2, we can use BSD sockets, but they're not the default. - cppflags='-Wc,+bsd-socket' - ccflags='-Wc,+bsd-socket' - ldflags='-Wc,+bsd-socket' + cppflags="$cppflags -Wc,+bsd-socket" + ccflags="$ccflags -Wc,+bsd-socket" + ldflags="$ldflags -Wc,+bsd-socket" d_socket='define' d_oldsock='undef' d_sockpair='define' diff --git a/hints/epix.sh b/hints/epix.sh index 03d5be5..dcad3c5 100644 --- a/hints/epix.sh +++ b/hints/epix.sh @@ -43,9 +43,9 @@ d_flock='undef' # of libswanted excludes some libraries found there. You may want to # prevent "ucb" from being removed from libswanted and see if perl will # build on your system. -ldflags='-non_shared -systype svr4 -L/svr4/usr/lib -L/svr4/usr/lib/cmplrs/cc -L/usr/ccs/lib -L/svr4/usr/ucblib' -ccflags='-systype svr4 -D__STDC__=0 -I/svr4/usr/include -I/svr4/usr/ucbinclude' -cppflags='-D__STDC__=0 -I/svr4/usr/include -I/svr4/usr/ucbinclude' +ldflags="$ldflags -non_shared -systype svr4 -L/svr4/usr/lib -L/svr4/usr/lib/cmplrs/cc -L/usr/ccs/lib -L/svr4/usr/ucblib" +ccflags="$ccflags -systype svr4 -D__STDC__=0 -I/svr4/usr/include -I/svr4/usr/ucbinclude" +cppflags="$ccflags -D__STDC__=0 -I/svr4/usr/include -I/svr4/usr/ucbinclude" # Don't use problematic libraries: diff --git a/hints/esix4.sh b/hints/esix4.sh index 695f8b8..9967207 100644 --- a/hints/esix4.sh +++ b/hints/esix4.sh @@ -3,14 +3,18 @@ # Kevin O'Gorman ( kevin@kosman.UUCP, kevin%kosman.uucp@nrc.com ) # # Use Configure -Dcc=gcc to use gcc. + +# Why can't we just use PATH? It contains /usr/ccs/bin. case "$cc" in '') cc='/bin/cc' test -f $cc || cc='/usr/ccs/bin/cc' ;; esac -ldflags='-L/usr/ccs/lib -L/usr/ucblib' + +ldflags="$ldflags -L/usr/ccs/lib -L/usr/ucblib" test -d /usr/local/man || mansrc='none' -ccflags='-I/usr/include -I/usr/ucbinclude' +# Do we really need to tell cc to look in /usr/include? +ccflags="$ccflags -I/usr/include -I/usr/ucbinclude" libswanted=`echo " $libswanted " | sed -e 's/ malloc / /' ` d_index='undef' d_suidsafe=define diff --git a/hints/hpux.sh b/hints/hpux.sh index 8b2023a..66fe7c4 100644 --- a/hints/hpux.sh +++ b/hints/hpux.sh @@ -197,6 +197,36 @@ case "$cc" in *gcc*) ccflags="$ccflags -DUINT32_MAX_BROKEN" ;; esac +cat > UU/cc.cbu <<'EOSH' +# XXX This script UU/cc.cbu will get 'called-back' by Configure after it +# XXX has prompted the user for the C compiler to use. +# Get gcc to share its secrets. +echo 'main() { return 0; }' > try.c + # Indent to avoid propagation to config.sh + verbose=`${cc:-cc} -v -o try try.c 2>&1` +if echo "$verbose" | grep '^Reading specs from' >/dev/null 2>&1; then + # Using gcc. + : nothing to see here, move on. +else + # Using cc. + ar=${ar:-ar} + case "`$ar -V 2>&1`" in + *GNU*) + if test -x /usr/bin/ar; then + cat <&2 + +NOTE: You are using HP cc(1) but GNU ar(1). This might lead into trouble +later on, I'm switching to HP ar to play safe. + +END + ar=/usr/bin/ar + fi + ;; + esac +fi + +EOSH + # Date: Fri, 6 Sep 96 23:15:31 CDT # From: "Daniel S. Lewart" # I looked through the gcc.info and found this: @@ -260,10 +290,47 @@ EOM esac EOCBU +# This script UU/uselfs.cbu will get 'called-back' by Configure +# after it has prompted the user for whether to use 64 bits. +cat > UU/uselfs.cbu <<'EOCBU' +case "$uselargefiles" in +$define|true|[yY]*) + lfcflags="`getconf _CS_XBS5_ILP32_OFFBIG_CFLAGS 2>/dev/null`" + lfldflags="`getconf _CS_XBS5_ILP32_OFFBIG_LDFLAGS 2>/dev/null`" + lflibs="`getconf _CS_XBS5_ILP32_OFFBIG_LIBS 2>/dev/null|sed -e 's@^-l@@' -e 's@ -l@ @g`" + case "$lfcflags$lfldflags$lflibs" in + '');; + *) # This sucks. To get the HP-UX strict ANSI mode (-Aa) to + # approve of large file offsets, we must turn on the 64-bitness + # (+DD64), too. A callback file (a hack) calling another, yuck. + case "$use64bits" in + $undef|false|[nN]*|'') + use64bits="$define" + if $test -f use64bits.cbu; then + echo "(Large files in HP-UX require also 64-bitness, picking up 64-bit hints...)" + . ./use64bits.cbu + fi + ;; + esac + ccflags="$ccflags $lfcflags" + ldflags="$ldflags $ldldflags" + libswanted="$libswanted $lflibs" + ;; + esac + lfcflags='' + lfldflags='' + lflibs='' + ;; +esac +EOCBU + # This script UU/use64bits.cbu will get 'called-back' by Configure # after it has prompted the user for whether to use 64 bits. cat > UU/use64bits.cbu <<'EOCBU' -case "$use64bits" in +case "$ccflags" in +*+DD64*) # Been here, done this (via uselfs.cbu, most likely.) + ;; +*) case "$use64bits" in $define|true|[yY]*) if [ "$xxOsRevMajor" -lt 11 ]; then cat <&4 @@ -281,11 +348,16 @@ Cannot continue, aborting. EOM exit 1 fi - ccflags="$ccflags +DD64 -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64" + ccflags="$ccflags +DD64" ldflags="$ldflags +DD64" ld=/usr/bin/ld set `echo " $libswanted " | sed -e 's@ dl @ @'` libswanted="$*" glibpth="/lib/pa20_64" + esac + ;; esac EOCBU + + + diff --git a/hints/irix_6.sh b/hints/irix_6.sh index 2881385..f4bbf32 100644 --- a/hints/irix_6.sh +++ b/hints/irix_6.sh @@ -130,6 +130,8 @@ malloc_cflags='ccflags="-DSTRICT_ALIGNMENT $ccflags"' ldflags="$ldflags -mabi=64 -L/usr/lib64" lddlflags="$lddlflags -mabi=64" ;; + *) ccflags="$ccflags -DIRIX32_SEMUN_BROKEN_BY_GCC" + ;; esac ;; *) @@ -224,6 +226,8 @@ EOM esac EOCBU +# The -n32 makes off_t to be 8 bytes, so we should have largefileness. + # This script UU/use64bits.cbu will get 'called-back' by Configure # after it has prompted the user for whether to use 64 bits. cat > UU/use64bits.cbu <<'EOCBU' @@ -239,9 +243,12 @@ EOM exit 1 ;; esac - case "$ccflags" in + case "$cc $ccflags" in *-n32*) - ccflags="$ccflags -DUSE_LONG_LONG" + case "$ccflags" in + *-DUSE_LONG_LONG) ;; + *) ccflags="$ccflags -DUSE_LONG_LONG" ;; + esac archname64="-n32" ;; esac diff --git a/hints/linux.sh b/hints/linux.sh index c1172ca..e9af509 100644 --- a/hints/linux.sh +++ b/hints/linux.sh @@ -258,6 +258,15 @@ fi #'osfmach3ppc') ccdlflags='-Wl,-E' ;; #esac +case "`uname -r`" in +sparc-linux) + case "$cccdlflags" in + *-fpic*) cccdlflags="`echo $cccdlflags|sed 's/-fpic/-fPIC/'`" ;; + *) cccdlflags="$cccdlflags -fPIC" ;; + esac + ;; +esac + # This script UU/usethreads.cbu will get 'called-back' by Configure # after it has prompted the user for whether to use threads. cat > UU/usethreads.cbu <<'EOCBU' diff --git a/hints/lynxos.sh b/hints/lynxos.sh index ddffcbe..bde461f 100644 --- a/hints/lynxos.sh +++ b/hints/lynxos.sh @@ -9,3 +9,6 @@ cc='gcc' so='none' usemymalloc='n' + +# When LynxOS runs a script with "#!" it sets argv[0] to the script name +toke_cflags='ccflags="$ccflags -DARG_ZERO_IS_SCRIPT"' diff --git a/hints/mint.sh b/hints/mint.sh index 22d854c..ab55e61 100644 --- a/hints/mint.sh +++ b/hints/mint.sh @@ -18,7 +18,7 @@ cc='gcc' # The weird include path is really to work around some bugs in # broken system header files. -ccflags="-D__MINT__ -Uatarist -DDEBUGGING -I$here/../mint" +ccflags="$ccflags -D__MINT__ -Uatarist -DDEBUGGING -I$here/../mint" # libs @@ -44,6 +44,7 @@ util_cflags='ccflags="$ccflags -DLOCALE_ENVIRON_REQUIRED"' # # Some good answers to the questions in Configure: +# Does Configure really get all these wrong? usenm='true' d_suidsafe='true' clocktype='long' diff --git a/hints/mpeix.sh b/hints/mpeix.sh index 9ebb0ba..556d221 100644 --- a/hints/mpeix.sh +++ b/hints/mpeix.sh @@ -12,7 +12,7 @@ # Revised again for 5.004_69 by Mark Bixby, markb@cccd.edu. # osname='mpeix' -osvers='5.5' +osvers='5.5' # Isn't there a way to determine this dynamically? # # Force Configure to use our wrapper mpeix/nm script # @@ -24,7 +24,8 @@ usenm='true' # # Various directory locations. # -prefix='/PERL/PUB' +# Which ones of these does Configure get wrong? +test -z "$prefix" && prefix='/PERL/PUB' archname='PA-RISC1.1' bin="$prefix" installman1dir="$prefix/man/man1" @@ -38,24 +39,30 @@ startsh='#!/bin/sh' # # Compiling. # -cc='gcc' +test -z "$cc" && cc='gcc' cccdlflags='none' -ccflags='-DMPE -D_POSIX_SOURCE -D_SOCKET_SOURCE -D_POSIX_JOB_CONTROL -DIS_SOCKET_CLIB_ITSELF' -locincpth='/usr/local/include /usr/contrib/include /BIND/PUB/include' -optimize='-O2' +ccflags="$ccflags -DMPE -D_POSIX_SOURCE -D_SOCKET_SOURCE -D_POSIX_JOB_CONTROL -DIS_SOCKET_CLIB_ITSELF" +locincpth="$locincpth /usr/local/include /usr/contrib/include /BIND/PUB/include" +test -z "$optimize" && optimize="-O2" ranlib='/bin/true' # Special compiling options for certain source files. +# But what if you want -g? regcomp_cflags='optimize=-O' toke_cflags='ccflags="$ccflags -DARG_ZERO_IS_SCRIPT"' # # Linking. # lddlflags='-b' -libs='-lbind -lsyslog -lcurses -lsvipc -lsocket -lm -lc' -loclibpth='/usr/local/lib /usr/contrib/lib /BIND/PUB/lib /SYSLOG/PUB' +# What if you want additional libs (e.g. gdbm)? +# This should remove the unwanted libraries from $libswanted and +# add on whatever ones are needed instead. +libs="$libs -lbind -lsyslog -lcurses -lsvipc -lsocket -lm -lc" +loclibpth="$loclibpth /usr/local/lib /usr/contrib/lib /BIND/PUB/lib /SYSLOG/PUB" # # External functions and data items. # +# Does Configure *really* get *all* of these wrong? +# d_crypt='define' d_difftime='define' d_dlerror='undef' diff --git a/hints/next_3.sh b/hints/next_3.sh index 1a174b8..27c9bd9 100644 --- a/hints/next_3.sh +++ b/hints/next_3.sh @@ -47,7 +47,7 @@ # use the following two lines if you have perl5.003_22 or better and # do not encounter intermittent core dumps. -ccflags='-DUSE_NEXT_CTYPE' +ccflags="$ccflags -DUSE_NEXT_CTYPE" usemymalloc='n' ###################################################################### diff --git a/hints/next_3_0.sh b/hints/next_3_0.sh index b8cc2c2..b444578 100644 --- a/hints/next_3_0.sh +++ b/hints/next_3_0.sh @@ -16,11 +16,11 @@ echo find it. By default, it is placed in /usr/local/include/gdbm.h. >&4 echo It will not be found there. Try moving it to >&4 echo /NextDeveloper/Headers/bsd/gdbm.h. >&4 -ccflags='-DUSE_NEXT_CTYPE -DNEXT30_NO_ATTRIBUTE' +ccflags="$ccflags -DUSE_NEXT_CTYPE -DNEXT30_NO_ATTRIBUTE" POSIX_cflags='ccflags="-posix $ccflags"' useposix='undef' -ldflags='-u libsys_s' -libswanted='dbm gdbm db' +ldflags="$ldflags -u libsys_s" +libswanted="$libswanted dbm gdbm db" # lddlflags='-r' # Give cccdlflags an empty value since Configure will detect we are diff --git a/hints/next_4.sh b/hints/next_4.sh index ba096ac..d5c8ba7 100644 --- a/hints/next_4.sh +++ b/hints/next_4.sh @@ -6,9 +6,9 @@ libpth='/lib /usr/lib /usr/local/lib' libswanted=' ' libc='/NextLibrary/Frameworks/System.framework/System' -ldflags='-dynamic -prebind' -lddlflags='-dynamic -bundle -undefined suppress' -ccflags='-dynamic -fno-common -DUSE_NEXT_CTYPE -DUSE_PERL_SBRK' +ldflags="$ldflags -dynamic -prebind" +lddlflags="$lddlflags -dynamic -bundle -undefined suppress" +ccflags="$ccflags -dynamic -fno-common -DUSE_NEXT_CTYPE -DUSE_PERL_SBRK" cccdlflags='none' ld='cc' #optimize='-g -O' diff --git a/hints/os2.sh b/hints/os2.sh index 6eef5e3..1d9df36 100644 --- a/hints/os2.sh +++ b/hints/os2.sh @@ -95,6 +95,8 @@ libpth="$libpth $libemx/mt $libemx" set `emxrev -f emxlibcm` emxcrtrev=$5 +# indented to not put it into config.sh + _defemxcrtrev=-D_EMX_CRT_REV_=$emxcrtrev so='dll' @@ -124,8 +126,8 @@ fi aout_ldflags="$aout_ldflags" aout_d_fork='define' -aout_ccflags='-DPERL_CORE -DDOSISH -DPERL_IS_AOUT -DOS2=2 -DEMBED -I.' -aout_cppflags='-DPERL_CORE -DDOSISH -DPERL_IS_AOUT -DOS2=2 -DEMBED -I.' +aout_ccflags="-DDOSISH -DPERL_IS_AOUT -DOS2=2 -DEMBED -I. $_defemxcrtrev" +aout_cppflags="-DDOSISH -DPERL_IS_AOUT -DOS2=2 -DEMBED -I. $_defemxcrtrev" aout_use_clib='c' aout_usedl='undef' aout_archobjs="os2.o dl_os2.o" @@ -165,9 +167,9 @@ else # Recursive regmatch may eat 2.5M of stack alone. ldflags='-Zexe -Zomf -Zmt -Zcrtdll -Zstack 32000' if [ $emxcrtrev -ge 50 ]; then - ccflags='-Zomf -Zmt -DDOSISH -DOS2=2 -DEMBED -I.' + ccflags="-Zomf -Zmt -DDOSISH -DOS2=2 -DEMBED -I. $_defemxcrtrev" else - ccflags='-Zomf -Zmt -DDOSISH -DOS2=2 -DEMBED -I. -DEMX_BAD_SBRK' + ccflags="-Zomf -Zmt -DDOSISH -DOS2=2 -DEMBED -I. -DEMX_BAD_SBRK $_defemxcrtrev" fi use_clib='c_import' usedl='define' diff --git a/hints/solaris_2.sh b/hints/solaris_2.sh index 9b4f5e2..8c280e3 100644 --- a/hints/solaris_2.sh +++ b/hints/solaris_2.sh @@ -333,6 +333,30 @@ EOM esac EOCBU +# This script UU/uselfs.cbu will get 'called-back' by Configure +# after it has prompted the user for whether to use large files. +cat > UU/uselfs.cbu <<'EOCBU' +case "$uselargefiles" in +$define|true|[yY]*) + lfcflags="`getconf LFS_CFLAGS 2>/dev/null`" + lfldflags="`getconf LFS_LDFLAGS 2>/dev/null`" + lflibs="`getconf LFS_LIBS 2>/dev/null|sed -e 's@^-l@@' -e 's@ -l@ @g`" + case "$lfcflags$lfldflags$lflibs" in + '');; + *) uselonglong="$define" + echo "(Large files in Solaris require also long longs, using long longs...)" + ccflags="$ccflags -DUSE_LONG_LONG $lfcflags" + ldflags="$ldflags $ldldflags" + libswanted="$libswanted $lflibs" + ;; + esac + lfcflags='' + lfldflags='' + lflibs='' + ;; +esac +EOCBU + # This script UU/use64bits.cbu will get 'called-back' by Configure # after it has prompted the user for whether to use 64 bits. cat > UU/use64bits.cbu <<'EOCBU' @@ -347,10 +371,10 @@ EOM exit 1 ;; esac - ccflags="$ccflags `getconf LFS_CFLAGS`" - ldflags="$ldflags `getconf LFS_LDFLAGS`" - libswanted="$libswanted `getconf LFS_LIBS`" - ccflags="$ccflags -DUSE_LONG_LONG" + case "$ccflags" in + *-DUSE_LONG_LONG*) ;; + *) ccflags="$ccflags -DUSE_LONG_LONG" ;; + esac # When a 64-bit cc becomes available $archname64 # may need setting so that $archname gets it attached. ;; diff --git a/hints/svr5.sh b/hints/svr5.sh index 44c03c9..f736895 100644 --- a/hints/svr5.sh +++ b/hints/svr5.sh @@ -1,101 +1,98 @@ -# svr5 hints, System V Release 5.x -# Last modified 1999/09/21 by Boyd Gerber, gerberb@zenez.com - +# svr5 hints, System V Release 5.x (UnixWare 7) +# mods after mail fm Andy Dougherty +# Reworked by hops@sco.com Sept/Oct 1999 for UW7.1 platform support +# Boyd Gerber, gerberb@zenez.com 1999/09/21 for threads support. +# Originally taken from svr4 hints.sh 21-Sep-98 hops@sco.com +# which was version of 1996/10/25 by Tye McQueen, tye@metronet.com + +# Use Configure -Dusethreads to enable threads. # Use Configure -Dcc=gcc to use gcc. case "$cc" in -'') cc='/bin/cc' - test -f $cc || cc='/usr/ccs/bin/cc' - ;; - *) - case "$gccversion" in - *2.95*) - ccflags='-fno-strict-aliasing' - ;; - *);; +*gcc*) + # "$gccversion" not set yet + vers=`gcc -v 2>&1 | sed -n -e 's@.*version \([^ ][^ ]*\) .*@\1@p'` + case $vers in + *2.95*) + ccflags='-fno-strict-aliasing' + # More optimisation provided in gcc-2.95 causes miniperl to segv. + # -fno-strict-aliasing is supposed to correct this but + # if it doesn't and you get segv when the build runs miniperl then + # disable optimisation as below + # optimize=' ' + ;; esac - ;; + ;; esac -# want_ucb='' -# want_dbm='yes' -want_gdbm='yes' - -# We include support for using libraries in /usr/ucblib, but the setting -# of libswanted excludes some libraries found there. If you run into -# problems, you may have to remove "ucb" from libswanted. Just delete -# the comment '#' from the sed command below. -# ldflags='-L/usr/ccs/lib -L/usr/ucblib' -# ccflags='-I/usr/include -I/usr/ucbinclude' -# Don't use problematic libraries: -libswanted=`echo " $libswanted " | sed -e 's/ malloc / /'` # -e 's/ ucb / /'` -# libmalloc.a - Probably using Perl's malloc() anyway. -# libucb.a - Remove it if you have problems ld'ing. We include it because -# it is needed for ODBM_File and NDBM_File extensions. +# Hardwire the processor to 586 for consistancy with autoconf +# archname='i586-svr5' +# -- seems this is generally disliked by perl porters so leave it to float + +# Our default setup excludes anything from /usr/ucblib (and consequently dbm) +# as later modules assume symbols found are available in shared libs +# On svr5 these are static archives which causes problems for +# dynamic modules loaded later (and ucblib is a bad dream anyway) +# +# However there is a dbm library built from the ucb sources outside ucblib +# at http://www.sco.com/skunkware (installing into /usr/local) so if we +# detect this we'll use it. You can change the default +# (to allow ucblib and its dbm or disallowing non ucb dbm) by +# changing 'want_*' config values below to '' to disable or otherwise to enable + +# Leave leading tabs so Configure doesn't propagate variables to config.sh + + want_ucb='' # don't use anything from /usr/ucblib - icky + want_dbm='yes' # use dbm if can find library in /usr/local/lib + want_gdbm='yes' # use gdbm if can find library in /usr/local/lib + want_udk70='' # link with old static libc pieces + # link with udk70 if building on 7.1 abd want resulting binary + # to run on uw7.0* - it will link in referenced static symbols + # of libc that are (now) in the shared libc.so on 7.1 but were + # not there in 7.0. + # There are still scenarios where this is still insufficient so + # overall it is preferable to get ptf7051e + # ftp://ftp.sco.com/SLS/ptf7051e.Z + # installed on any/all 7.0 systems and leave the above unset. if [ "$want_ucb" ] ; then - ldflags= '-L/usr/ccs/lib -L/usr/ucblib' - ccflags='-I/usr/include -I/usr/ucbinclude' - if [ -r /usr/ucblib/libucb.a ]; then # If using BSD-compat. library: - d_Gconvert='gcvt((x),(n),(b))' # Try gcvt() before gconvert(). - # Use the "native" counterparts, not the BSD emulation stuff: - d_bcmp='undef' d_bcopy='undef' d_bzero='undef' d_safebcpy='undef' - d_index='undef' d_killpg='undef' d_getprior='undef' d_setprior='undef' - d_setlinebuf='undef' - # d_setregid='undef' d_setreuid='undef' # ??? - fi + ldflags= '-L/usr/ucblib' + ccflags='-I/usr/ucbinclude' + # /usr/ccs/include and /usr/ccs/lib are used implicitly by cc as reqd else -# libswanted=`echo " $libswanted " | sed -e 's/ ucb / /' -e 's/ dbm / /'` libswanted=`echo " $libswanted " | sed -e 's/ ucb / /'` glibpth=`echo " $glibpth " | sed -e 's/ \/usr\/ucblib / /'` - # a non ucb native version of libdbm for /usr/local is available from - # http://www.sco.com/skunkware - # if its installed (and not overidden) we'll use it. + # If see libdbm in /usr/local and not overidden assume its the + # non ucblib rebuild from skunkware and use it if [ ! -f /usr/local/lib/libdbm.so -o ! "$want_dbm" ] ; then + i_dbm='undef' libswanted=`echo " $libswanted " | sed -e 's/ dbm / /'` fi fi -if [ "$want_gdbm" -a -f /usr/local/lib/libgdbm.so ] ; then - i_gdbm='define' -else - i_gdbm='undef' +if [ ! "$want_gdbm" ] ; then + i_gdbm='undef' libswanted=`echo " $libswanted " | sed -e 's/ gdbm / /'` fi + # Don't use problematic libraries: # libmalloc.a - Probably using Perl's malloc() anyway. -# libc: on UW7 don't want -lc explicitly - cc gives warnings/errors +# libc: on UW7 don't want -lc explicitly as native cc gives warnings/errors libswanted=`echo " $libswanted " | sed -e 's/ malloc / /' -e 's/ c / /'` # remove /shlib and /lib from library search path as both symlink to /usr/lib # where runtime shared libc is glibpth=`echo " $glibpth " | sed -e 's/ \/shlib / /' -e 's/ \/lib / /` -# UnixWare has /usr/lib/libc.so.1, /usr/lib/libc.so.1.1, and -# /usr/ccs/lib/libc.so. Configure chooses libc.so.1.1 while it -# appears that /usr/ccs/lib/libc.so contains more symbols: -# -# Try the following if you want to use nm-extraction. We'll just -# skip the nm-extraction phase, since searching for all the different -# library versions will be hard to keep up-to-date. -# -# if [ "" = "$libc" -a -f /usr/ccs/lib/libc.so -a \ -# -f /usr/lib/libc.so.1 -a -f /usr/lib/libc.so.1.1 ]; then -# if nm -h /usr/ccs/lib/libc.so | egrep '\<_?select$' >/dev/null; then -# if nm -h /usr/lib/libc.so.1 | egrep '\<_?select$'` >/dev/null || -# nm -h /usr/lib/libc.so.1.1 | egrep '\<_?select$'` >/dev/null; then -# : -# else -# libc=/usr/ccs/lib/libc.so -# fi -# fi -# fi -# -# Don't bother with nm. Just compile & link a small C program. -case "$usenm" in -'') usenm=false;; -esac +# Don't use BSD emulation pieces (/usr/ucblib) regardless +# these would probably be autonondetected anyway but ... +d_Gconvert='gcvt((x),(n),(b))' # Try gcvt() before gconvert(). +d_bcopy='undef' d_bcmp='undef' d_bzero='undef' d_safebcpy='undef' +d_index='undef' d_killpg='undef' d_getprior='undef' d_setprior='undef' +d_setlinebuf='undef' +d_setregid='undef' d_setreuid='undef' # -- in /usr/lib/libc.so.1 + # Broken C-Shell tests (Thanks to Tye McQueen): # The OS-specific checks may be obsoleted by the this generic test. @@ -107,18 +104,34 @@ if [ "$sh_cnt" -ne "$csh_cnt" ]; then d_csh='undef' fi -# Unixware-specific problems. The undocumented -X argument to uname -# is probably a reasonable way of detecting UnixWare. +# Unixware-specific problems. UW7 give correctname with uname -s # UnixWare has a broken csh. (This might already be detected above). # Configure can't detect memcpy or memset on Unixware 2 or 7 # # Leave leading tabs on the next two lines so Configure doesn't # propagate these variables to config.sh uw_ver=`uname -v` - uw_isuw=`uname -X 2>&1 | grep Release` + uw_isuw=`uname -s 2>&1` -if [ "$uw_isuw" = "Release = 5" ]; then +if [ "$uw_isuw" = "UnixWare" ]; then case $uw_ver in + 7.1*) + d_csh='undef' + d_memcpy='define' + d_memset='define' + stdio_cnt='((fp)->__cnt)' + d_stdio_cnt_lval='define' + stdio_ptr='((fp)->__ptr)' + d_stdio_ptr_lval='define' + + d_bcopy='define' # In /usr/lib/libc.so.1 + d_setregid='define' # " + d_setreuid='define' # " + + if [ -f /usr/ccs/lib/libcudk70.a -a "$want_udk70" ] ; then + libswanted=" $libswanted cudk70" + fi + ;; 7*) d_csh='undef' d_memcpy='define' @@ -130,93 +143,79 @@ if [ "$uw_isuw" = "Release = 5" ]; then ;; esac fi +# End of Unixware-specific tests. ############################################################### -# Dynamic loading section: +# Dynamic loading section: Is default so it should just happen. +# set below to explicitly force. +# usedl='define' +# dlext='so' +# dlsrc='dl_dlopen.xs' # # ccdlflags : must tell the linker to export all global symbols # cccdlflags: must tell the compiler to generate relocatable code # lddlflags : must tell the linker to output a shared library -# -# /usr/local/lib is added for convenience, since additional libraries -# are usually put there -# + # use shared perl lib useshrplib='true' case "$cc" in *gcc*) - ccdlflags='-Xlinker -Bexport -L/usr/local/lib' + ccdlflags='-Xlinker -Bexport ' cccdlflags='-fpic' - lddlflags='-G -L/usr/local/lib' + lddlflags='-G ' ;; + *) - ccdlflags='-Wl,-Bexport -L/usr/local/lib' - cccdlflags='-KPIC' - lddlflags='-G -Wl,-Bexport -L/usr/local/lib' + ccdlflags='-Wl,-Bexport' + cccdlflags='-Kpic' + lddlflags='-G -Wl,-Bexport' ;; esac -############################################################### -# Use dynamic loading -usedl='define' -dlext='so' -dlsrc='dl_dlopen.xs' - -# Configure may fail to find lstat() since it's a static/inline function -# in on Unisys U6000 SVR4, UnixWare 2.x, and possibly other -# SVR4 derivatives. (Though UnixWare has it in /usr/ccs/lib/libc.so.) -d_lstat=define - - -# DDE SMES Supermax Enterprise Server -case "`uname -sm`" in -"UNIX_SV SMES") - # the *grent functions are in libgen. - libswanted="$libswanted gen" - # csh is broken (also) in SMES - # This may already be detected by the generic test above. - d_csh='undef' - case "$cc" in - *gcc*) ;; - *) # for cc we need -K PIC (not -K pic) - cccdlflags="$cccdlflags -K PIC" - ;; - esac - ;; -esac - +############################################################################ +# Thread support +# use Configure -Dusethreads to enable # This script UU/usethreads.cbu will get 'called-back' by Configure # after it has prompted the user for whether to use threads. cat > UU/usethreads.cbu <<'EOCBU' case "$usethreads" in $define|true|[yY]*) ccflags="$ccflags" - set `echo X "$libswanted "| sed -e 's/ c / pthread c /'` shift libswanted="$*" case "$cc" in *gcc*) ccflags="-D_REENTRANT $ccflags -fpic -pthread" cccdlflags='-fpic' - lddlflags='-pthread -G -L/usr/local/lib ' + lddlflags='-pthread -G ' ;; *) ccflags="-D_REENTRANT $ccflags -KPIC -Kthread" - ccdlflags='-Kthread -Wl,-Bexport -L/usr/local/lib' + ccdlflags='-Kthread -Wl,-Bexport' cccdlflags='-KPIC -Kthread' - lddlflags='-G -Kthread -Wl,-Bexport -L/usr/local/lib' - ldflags='-Kthread -L/usr/local/lib -L/usr/gnu/lib' + lddlflags='-G -Kthread -Wl,-Bexport ' + ldflags='-Kthread' ;; esac esac EOCBU -# End of Unixware-specific tests. -# Configure may fail to find lstat() since it's a static/inline function -# in on Unisys U6000 SVR4, UnixWare 2.x, and possibly other -# SVR4 derivatives. (Though UnixWare has it in /usr/ccs/lib/libc.so.) -d_lstat=define -d_suidsafe='define' # "./Configure -d" can't figure this out easilly +d_suidsafe='define' # "./Configure -d" can't figure this out easily + +################## final caveat msgs to builder ############### +cat <<'EOM' >&4 + +If you wish to use dynamic linking, you must use + LD_LIBRARY_PATH=`pwd`; export LD_LIBRARY_PATH +or + setenv LD_LIBRARY_PATH `pwd` +before running make. + +If you are using shared libraries from /usr/local/lib +for libdbm or libgdbm you may need to set + LD_RUN_PATH=/usr/local/lib; export LD_RUN_PATH +in order for Configure to compile the simple test program +EOM diff --git a/hv.c b/hv.c index 857bd70..9b01db7 100644 --- a/hv.c +++ b/hv.c @@ -15,15 +15,6 @@ #define PERL_IN_HV_C #include "perl.h" -#if defined(STRANGE_MALLOC) || defined(MYMALLOC) -# define ARRAY_ALLOC_BYTES(size) ( (size)*sizeof(HE*) ) -#else -# define MALLOC_OVERHEAD 16 -# define ARRAY_ALLOC_BYTES(size) ( ((size) < 64) \ - ? (size)*sizeof(HE*) \ - : (size)*sizeof(HE*)*2 - MALLOC_OVERHEAD ) -#endif - STATIC HE* S_new_he(pTHX) { @@ -82,6 +73,35 @@ Perl_unshare_hek(pTHX_ HEK *hek) unsharepvn(HEK_KEY(hek),HEK_LEN(hek),HEK_HASH(hek)); } +#if defined(USE_ITHREADS) +HE * +Perl_he_dup(pTHX_ HE *e, bool shared) +{ + HE *ret; + + if (!e) + return Nullhe; + /* look for it in the table first */ + ret = (HE*)ptr_table_fetch(PL_ptr_table, e); + if (ret) + return ret; + + /* create anew and remember what it is */ + ret = new_he(); + ptr_table_store(PL_ptr_table, e, ret); + + HeNEXT(ret) = he_dup(HeNEXT(e),shared); + if (HeKLEN(e) == HEf_SVKEY) + HeKEY_sv(ret) = SvREFCNT_inc(sv_dup(HeKEY_sv(e))); + else if (shared) + HeKEY_hek(ret) = share_hek(HeKEY(e), HeKLEN(e), HeHASH(e)); + else + HeKEY_hek(ret) = save_hek(HeKEY(e), HeKLEN(e), HeHASH(e)); + HeVAL(ret) = SvREFCNT_inc(sv_dup(HeVAL(e))); + return ret; +} +#endif /* USE_ITHREADS */ + /* (klen == HEf_SVKEY) is special for MAGICAL hv entries, meaning key slot * contains an SV* */ @@ -126,7 +146,8 @@ Perl_hv_fetch(pTHX_ HV *hv, const char *key, U32 klen, I32 lval) || (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) #endif ) - Newz(503,xhv->xhv_array, ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char); + Newz(503, xhv->xhv_array, + PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char); else return 0; } @@ -214,7 +235,8 @@ Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash) || (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) #endif ) - Newz(503,xhv->xhv_array, ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char); + Newz(503, xhv->xhv_array, + PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char); else return 0; } @@ -304,7 +326,8 @@ Perl_hv_store(pTHX_ HV *hv, const char *key, U32 klen, SV *val, register U32 has PERL_HASH(hash, key, klen); if (!xhv->xhv_array) - Newz(505, xhv->xhv_array, ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char); + Newz(505, xhv->xhv_array, + PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char); oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; i = 1; @@ -385,7 +408,8 @@ Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, register U32 hash) PERL_HASH(hash, key, klen); if (!xhv->xhv_array) - Newz(505, xhv->xhv_array, ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char); + Newz(505, xhv->xhv_array, + PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char); oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; i = 1; @@ -478,8 +502,10 @@ Perl_hv_delete(pTHX_ HV *hv, const char *key, U32 klen, I32 flags) xhv->xhv_fill--; if (flags & G_DISCARD) sv = Nullsv; - else - sv = sv_mortalcopy(HeVAL(entry)); + else { + sv = sv_2mortal(HeVAL(entry)); + HeVAL(entry) = &PL_sv_undef; + } if (entry == xhv->xhv_eiter) HvLAZYDEL_on(hv); else @@ -552,8 +578,10 @@ Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash) xhv->xhv_fill--; if (flags & G_DISCARD) sv = Nullsv; - else - sv = sv_mortalcopy(HeVAL(entry)); + else { + sv = sv_2mortal(HeVAL(entry)); + HeVAL(entry) = &PL_sv_undef; + } if (entry == xhv->xhv_eiter) HvLAZYDEL_on(hv); else @@ -714,21 +742,21 @@ S_hsplit(pTHX_ HV *hv) PL_nomemok = TRUE; #if defined(STRANGE_MALLOC) || defined(MYMALLOC) - Renew(a, ARRAY_ALLOC_BYTES(newsize), char); + Renew(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char); if (!a) { PL_nomemok = FALSE; return; } #else #define MALLOC_OVERHEAD 16 - New(2, a, ARRAY_ALLOC_BYTES(newsize), char); + New(2, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char); if (!a) { PL_nomemok = FALSE; return; } Copy(xhv->xhv_array, a, oldsize * sizeof(HE*), char); if (oldsize >= 64) { - offer_nice_chunk(xhv->xhv_array, ARRAY_ALLOC_BYTES(oldsize)); + offer_nice_chunk(xhv->xhv_array, PERL_HV_ARRAY_ALLOC_BYTES(oldsize)); } else Safefree(xhv->xhv_array); @@ -789,20 +817,20 @@ Perl_hv_ksplit(pTHX_ HV *hv, IV newmax) if (a) { PL_nomemok = TRUE; #if defined(STRANGE_MALLOC) || defined(MYMALLOC) - Renew(a, ARRAY_ALLOC_BYTES(newsize), char); + Renew(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char); if (!a) { PL_nomemok = FALSE; return; } #else - New(2, a, ARRAY_ALLOC_BYTES(newsize), char); + New(2, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char); if (!a) { PL_nomemok = FALSE; return; } Copy(xhv->xhv_array, a, oldsize * sizeof(HE*), char); if (oldsize >= 64) { - offer_nice_chunk(xhv->xhv_array, ARRAY_ALLOC_BYTES(oldsize)); + offer_nice_chunk(xhv->xhv_array, PERL_HV_ARRAY_ALLOC_BYTES(oldsize)); } else Safefree(xhv->xhv_array); @@ -811,7 +839,7 @@ Perl_hv_ksplit(pTHX_ HV *hv, IV newmax) Zero(&a[oldsize * sizeof(HE*)], (newsize-oldsize) * sizeof(HE*), char); /* zero 2nd half*/ } else { - Newz(0, a, ARRAY_ALLOC_BYTES(newsize), char); + Newz(0, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char); } xhv->xhv_max = --newsize; xhv->xhv_array = a; @@ -1079,7 +1107,8 @@ Perl_hv_iternext(pTHX_ HV *hv) #endif if (!xhv->xhv_array) - Newz(506,xhv->xhv_array, ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char); + Newz(506, xhv->xhv_array, + PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char); if (entry) entry = HeNEXT(entry); while (!entry) { diff --git a/hv.h b/hv.h index 3977b1c..11a602c 100644 --- a/hv.h +++ b/hv.h @@ -114,3 +114,13 @@ struct xpvhv { #define HEK_HASH(hek) (hek)->hek_hash #define HEK_LEN(hek) (hek)->hek_len #define HEK_KEY(hek) (hek)->hek_key + +#if defined(STRANGE_MALLOC) || defined(MYMALLOC) +# define PERL_HV_ARRAY_ALLOC_BYTES(size) ((size) * sizeof(HE*)) +#else +# define MALLOC_OVERHEAD 16 +# define PERL_HV_ARRAY_ALLOC_BYTES(size) \ + (((size) < 64) \ + ? (size) * sizeof(HE*) \ + : (size) * sizeof(HE*) * 2 - MALLOC_OVERHEAD) +#endif diff --git a/installhtml b/installhtml index d73124c..c268f54 100755 --- a/installhtml +++ b/installhtml @@ -9,8 +9,6 @@ use Getopt::Long; # for command-line parsing use Cwd; use Pod::Html; -umask 022; - =head1 NAME installhtml - converts a collection of POD pages to HTML format. diff --git a/installman b/installman index 04ef578..c9fb0fe 100755 --- a/installman +++ b/installman @@ -10,12 +10,11 @@ use subs qw(unlink chmod rename link); use vars qw($packlist); require Cwd; -umask 022; $ENV{SHELL} = 'sh' if $^O eq 'os2'; -$ver = $]; -$release = substr($ver,0,3); # Not used presently. -$patchlevel = substr($ver,3,2); +$ver = $Config{version}; +$release = substr($],0,3); # Not used presently. +$patchlevel = substr($],3,2); die "Patchlevel of perl ($patchlevel)", "and patchlevel of config.sh ($Config{'PERL_VERSION'}) don't match\n" if $patchlevel != $Config{'PERL_VERSION'}; @@ -73,8 +72,10 @@ runpod2man('utils', $man1dir, $man1ext, 'splain'); runpod2man('utils', $man1dir, $man1ext, 'dprofpp'); runpod2man('x2p', $man1dir, $man1ext, 's2p'); runpod2man('x2p', $man1dir, $man1ext, 'a2p.pod'); +runpod2man('x2p', $man1dir, $man1ext, 'find2perl'); runpod2man('pod', $man1dir, $man1ext, 'pod2man'); runpod2man('pod', $man1dir, $man1ext, 'pod2html'); +runpod2man('pod', $man1dir, $man1ext, 'pod2text'); runpod2man('pod', $man1dir, $man1ext, 'pod2usage'); runpod2man('pod', $man1dir, $man1ext, 'podchecker'); runpod2man('pod', $man1dir, $man1ext, 'podselect'); @@ -125,7 +126,8 @@ sub runpod2man { # of the pod. This might be useful for pod2man someday. if ($script) { @modpods = ($script); - } else { + } + else { @modpods = (); find(\&lsmodpods, '.'); } @@ -139,18 +141,22 @@ sub runpod2man { # Convert name from File/Basename.pm to File::Basename.3 format, # if necessary. $manpage =~ s#\.p(m|od)$##; - if ($^O eq 'os2' || $^O eq 'amigaos' || $^O eq 'uwin' || $^O =~ /cygwin/) { + if ($^O eq 'os2' || $^O eq 'amigaos' || $^O eq 'uwin' || $^O eq 'cygwin') { $manpage =~ s#/#.#g; - } else { + } + else { $manpage =~ s#/#::#g; } $tmp = "${mandir}/${manpage}.tmp"; $manpage = "${mandir}/${manpage}.${manext}"; if (&cmd("$pod2man $mod > $tmp") == 0 && !$notify && -s $tmp) { - rename($tmp, $manpage) && next; + if (rename($tmp, $manpage)) { + $packlist->{$manpage} = { type => 'file' }; + next; + } } unless ($notify) { - unlink($tmp); + unlink($tmp); } } chdir "$builddir" || die "Unable to cd back to $builddir directory!\n$!\n"; @@ -195,11 +201,11 @@ sub unlink { my $cnt = 0; foreach $name (@names) { -next unless -e $name; -chmod 0777, $name if $^O eq 'os2'; -print STDERR " unlink $name\n"; -( CORE::unlink($name) and ++$cnt - or warn "Couldn't unlink $name: $!\n" ) unless $notify; + next unless -e $name; + chmod 0777, $name if $^O eq 'os2'; + print STDERR " unlink $name\n"; + ( CORE::unlink($name) and ++$cnt + or warn "Couldn't unlink $name: $!\n" ) unless $notify; } return $cnt; } @@ -216,14 +222,12 @@ sub link { ? die "AFS" # okay inside eval {} : warn "Couldn't link $from to $to: $!\n" unless $notify; - $packlist->{$to} = { type => 'file' }; }; if ($@) { File::Copy::copy($from, $to) ? $success++ : warn "Couldn't copy $from to $to: $!\n" unless $notify; - $packlist->{$to} = { type => 'file' }; } $success; } @@ -231,16 +235,15 @@ sub link { sub rename { local($from,$to) = @_; if (-f $to and not unlink($to)) { -my($i); -for ($i = 1; $i < 50; $i++) { - last if CORE::rename($to, "$to.$i"); -} -warn("Cannot rename to `$to.$i': $!"), return 0 - if $i >= 50; # Give up! + my($i); + for ($i = 1; $i < 50; $i++) { + last if CORE::rename($to, "$to.$i"); + } + warn("Cannot rename to `$to.$i': $!"), return 0 + if $i >= 50; # Give up! } link($from,$to) || return 0; unlink($from); - $packlist->{$to} = { type => 'file' }; } sub chmod { diff --git a/installperl b/installperl index faf1c70..dae86a5 100755 --- a/installperl +++ b/installperl @@ -14,7 +14,7 @@ BEGIN { $Is_VMS = $^O eq 'VMS'; $Is_W32 = $^O eq 'MSWin32'; $Is_OS2 = $^O eq 'os2'; - $Is_Cygwin = $^O =~ /cygwin/i; + $Is_Cygwin = $^O eq 'cygwin'; if ($Is_VMS) { eval 'use VMS::Filespec;' } } @@ -40,10 +40,10 @@ my $exe_ext = $Config{exe_ext}; # Allow ``make install PERLNAME=something_besides_perl'': my $perl = defined($ENV{PERLNAME}) ? $ENV{PERLNAME} : 'perl'; -# This is the base used for versioned names, like "perl5.005". +# This is the base used for versioned names, like "perl5.6.0". # It's separate because a common use of $PERLNAME is to install # perl as "perl5", if that's used as base for versioned files you -# get "perl55.005". +# get "perl55.6.0". my $perl_verbase = defined($ENV{PERLNAME_VERBASE}) ? $ENV{PERLNAME_VERBASE} : $perl; @@ -54,8 +54,6 @@ while (@ARGV) { shift; } -umask 022 unless $Is_VMS; - my @scripts = qw(utils/c2ph utils/h2ph utils/h2xs utils/perlbug utils/perldoc utils/pl2pm utils/splain utils/perlcc utils/dprofpp x2p/s2p x2p/find2perl @@ -93,9 +91,9 @@ find(sub { } }, 'ext'); -my $ver = $]; -my $release = substr($ver,0,3); # Not used presently. -my $patchlevel = substr($ver,3,2); +my $ver = $Config{version}; +my $release = substr($],0,3); # Not used presently. +my $patchlevel = substr($],3,2); die "Patchlevel of perl ($patchlevel)", "and patchlevel of config.sh ($Config{'PERL_VERSION'}) don't match\n" if $patchlevel != $Config{'PERL_VERSION'}; @@ -113,6 +111,7 @@ my $libperl = $Config{libperl}; # Shared library and dynamic loading suffixes. my $so = $Config{so}; my $dlext = $Config{dlext}; +my $dlsrc = $Config{dlsrc}; my $d_dosuid = $Config{d_dosuid}; my $binexp = $Config{binexp}; @@ -161,14 +160,16 @@ if ($Is_Cygwin) { $perldll = 'perl56.' . $dlext if $Config{'ccflags'} =~ /PERL_OBJECT/i; } --f $perldll || die "No perl DLL built\n"; - + if ($dlsrc ne "dl_none.xs") { + -f $perldll || die "No perl DLL built\n"; + } # Install the DLL -safe_unlink("$installbin/$perldll"); -copy("$perldll", "$installbin/$perldll"); -chmod(0755, "$installbin/$perldll"); -} + safe_unlink("$installbin/$perldll"); + copy("$perldll", "$installbin/$perldll"); + chmod(0755, "$installbin/$perldll"); + +} # if ($Is_W32 or $Is_Cygwin) # This will be used to store the packlist my $packlist = ExtUtils::Packlist->new("$installarchlib/.packlist"); @@ -222,7 +223,7 @@ mkpath($installsitearch, 1, 0777) if ($installsitearch); if (chdir "lib") { $do_installarchlib = ! samepath($installarchlib, '.'); $do_installprivlib = ! samepath($installprivlib, '.'); - $do_installprivlib = 0 if $versiononly && !($installprivlib =~ m/\Q$]/); + $do_installprivlib = 0 if $versiononly && !($installprivlib =~ m/\Q$ver/); if ($do_installarchlib || $do_installprivlib) { find(\&installlib, '.'); @@ -237,7 +238,7 @@ else { mkpath("$installarchlib/CORE", 1, 0777); my @corefiles; if ($Is_VMS) { # We did core file selection during build - my $coredir = "lib/$Config{'arch'}/$]"; + my $coredir = "lib/$Config{'arch'}/$ver"; $coredir =~ tr/./_/; @corefiles = <$coredir/*.*>; } @@ -365,19 +366,21 @@ if (! $versiononly) { } } -# Install pod pages. Where? I guess in $installprivlib/pod. +# Install pod pages. Where? I guess in $installprivlib/pod +# ($installprivlib/pods for cygwin). -unless ( $versiononly && !($installprivlib =~ m/\Q$]/)) { - mkpath("${installprivlib}/pod", 1, 0777); +my $pod = $Is_Cygwin ? 'pods' : 'pod'; +unless ( $versiononly && !($installprivlib =~ m/\Q$ver/)) { + mkpath("${installprivlib}/$pod", 1, 0777); # If Perl 5.003's perldiag.pod is there, rename it. - if (open POD, "${installprivlib}/pod/perldiag.pod") { + if (open POD, "${installprivlib}/$pod/perldiag.pod") { read POD, $_, 4000; close POD; # Some of Perl 5.003's diagnostic messages ended with periods. if (/^=.*\.$/m) { - my ($from, $to) = ("${installprivlib}/pod/perldiag.pod", - "${installprivlib}/pod/perldiag-5.003.pod"); + my ($from, $to) = ("${installprivlib}/$pod/perldiag.pod", + "${installprivlib}/$pod/perldiag-5.003.pod"); print " rename $from $to"; rename($from, $to) or warn "Couldn't rename $from to $to: $!\n" @@ -385,9 +388,10 @@ unless ( $versiononly && !($installprivlib =~ m/\Q$]/)) { } } - foreach my $file (@pods) { - # $file is a name like pod/perl.pod - copy_if_diff($file, "${installprivlib}/${file}"); + for (@pods) { + # $_ is a name like pod/perl.pod + (my $base = $_) =~ s#.*/##; + copy_if_diff($_, "${installprivlib}/$pod/${base}"); } } @@ -399,7 +403,7 @@ unless ( $versiononly && !($installprivlib =~ m/\Q$]/)) { # installed perl. if (!$versiononly) { - my ($path, @path); + my ($path, @path); my $dirsep = ($Is_OS2 || $Is_W32) ? ';' : ':' ; ($path = $ENV{"PATH"}) =~ s:\\:/:g ; @path = split(/$dirsep/, $path); @@ -508,11 +512,13 @@ sub link { ? $success++ : ($from =~ m#^/afs/# || $to =~ m#^/afs/#) ? die "AFS" # okay inside eval {} - : warn "Couldn't link $from to $to: $!\n" + : die "Couldn't link $from to $to: $!\n" unless $nonono; $packlist->{$to} = { from => $from, type => 'link' }; }; if ($@) { + warn $@; + print " cp $from $to\n"; print " creating new version of $to\n" if $Is_VMS and -e $to; File::Copy::copy($from, $to) ? $success++ @@ -567,13 +573,15 @@ sub installlib { my $name = $_; - if ($name eq 'CVS' && -d $name) { + # Ignore RCS and CVS directories. + if (($name eq 'CVS' or $name eq 'RCS') and -d $name) { $File::Find::prune = 1; return; } - # ignore patch backups and the .exists files. - return if $name =~ m{\.orig$|~$|^\.exists}; + # ignore patch backups, RCS files, emacs backup & temp files and the + # .exists files. + return if $name =~ m{\.orig$|~$|^#.+#$|,v$|^\.exists}; $name = "$dir/$name" if $dir ne ''; diff --git a/intrpvar.h b/intrpvar.h index a53d38b..606a892 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -17,16 +17,15 @@ PERLVAR(Iorigargc, int) PERLVAR(Iorigargv, char **) PERLVAR(Ienvgv, GV *) -PERLVAR(Isiggv, GV *) PERLVAR(Iincgv, GV *) PERLVAR(Ihintgv, GV *) PERLVAR(Iorigfilename, char *) PERLVAR(Idiehook, SV *) PERLVAR(Iwarnhook, SV *) -PERLVAR(Iparsehook, SV *) -PERLVAR(Icddir, char *) /* switches */ + +/* switches */ PERLVAR(Iminus_c, bool) -PERLVARA(Ipatchlevel,10,char) +PERLVAR(Ipatchlevel, SV *) PERLVAR(Ilocalpatches, char **) PERLVARI(Isplitstr, char *, " ") PERLVAR(Ipreprocess, bool) @@ -39,14 +38,12 @@ PERLVAR(Idoswitches, bool) PERLVAR(Idowarn, bool) PERLVAR(Idoextract, bool) PERLVAR(Isawampersand, bool) /* must save all match strings */ -PERLVAR(Isawstudy, bool) /* do fbm_instr on all strings */ -PERLVAR(Isawvec, bool) PERLVAR(Iunsafe, bool) PERLVAR(Iinplace, char *) PERLVAR(Ie_script, SV *) PERLVAR(Iperldb, U32) -/* This value may be raised by extensions for testing purposes */ +/* This value may be set when embedding for full cleanup */ /* 0=none, 1=full, 2=full with checks */ PERLVARI(Iperl_destruct_level, int, 0) @@ -59,22 +56,20 @@ PERLVARI(Imaxsysfd, I32, MAXSYSFD) /* top fd to pass to subprocesses */ PERLVAR(Imultiline, int) /* $*--do strings hold >1 line? */ PERLVAR(Istatusvalue, I32) /* $? */ +PERLVAR(Iexit_flags, U8) /* was exit() unexpected, etc. */ #ifdef VMS PERLVAR(Istatusvalue_vms,U32) #endif /* shortcuts to various I/O objects */ PERLVAR(Istdingv, GV *) +PERLVAR(Istderrgv, GV *) PERLVAR(Idefgv, GV *) PERLVAR(Iargvgv, GV *) PERLVAR(Iargvoutgv, GV *) +PERLVAR(Iargvout_stack, AV *) /* shortcuts to regexp stuff */ -/* XXX these three aren't used anywhere */ -PERLVAR(Ileftgv, GV *) -PERLVAR(Iampergv, GV *) -PERLVAR(Irightgv, GV *) - /* this one needs to be moved to thrdvar.h and accessed via * find_threadsv() when USE_THREADS */ PERLVAR(Ireplgv, GV *) @@ -98,6 +93,7 @@ PERLVAR(Iglobalstash, HV *) /* global keyword overrides imported here */ PERLVAR(Icurstname, SV *) /* name of current package */ PERLVAR(Ibeginav, AV *) /* names of BEGIN subroutines */ PERLVAR(Iendav, AV *) /* names of END subroutines */ +PERLVAR(Istopav, AV *) /* names of STOP subroutines */ PERLVAR(Iinitav, AV *) /* names of INIT subroutines */ PERLVAR(Istrtab, HV *) /* shared string table */ PERLVARI(Isub_generation,U32,1) /* incr to invalidate method cache */ @@ -109,8 +105,6 @@ PERLVAR(Isv_root, SV*) /* storage for SVs belonging to interp */ PERLVAR(Isv_arenaroot, SV*) /* list of areas for garbage collection */ /* funky return mechanisms */ -PERLVAR(Ilastspbase, I32) -PERLVAR(Ilastsize, I32) PERLVAR(Iforkprocess, int) /* so do_open |- can return proc# */ /* subprocess state */ @@ -120,12 +114,6 @@ PERLVAR(Ifdpid, AV *) /* keep fd-to-pid mappings for my_popen */ PERLVAR(Itainting, bool) /* doing taint checks */ PERLVARI(Iop_mask, char *, NULL) /* masked operations for safe evals */ -/* trace state */ -PERLVAR(Idlevel, I32) -PERLVARI(Idlmax, I32, 128) -PERLVAR(Idebname, char *) -PERLVAR(Idebdelim, char *) - /* current interpreter roots */ PERLVAR(Imain_cv, CV *) PERLVAR(Imain_root, OP *) @@ -138,14 +126,11 @@ PERLVARI(Icurcopdb, COP *, NULL) PERLVARI(Icopline, line_t, NOLINE) /* statics moved here for shared library purposes */ -PERLVAR(Istrchop, SV) /* return value from chop */ PERLVAR(Ifilemode, int) /* so nextargv() can preserve mode */ PERLVAR(Ilastfd, int) /* what to preserve mode on */ PERLVAR(Ioldname, char *) /* what to preserve mode on */ PERLVAR(IArgv, char **) /* stuff to free from do_aexec, vfork safe */ PERLVAR(ICmd, char *) /* stuff to free from do_aexec, vfork safe */ -PERLVAR(Imystrk, SV *) /* temp key string for do_each() */ -PERLVAR(Ioldlastpm, PMOP *) /* for saving regexp context in debugger */ PERLVAR(Igensym, I32) /* next symbol for getsym() to define */ PERLVAR(Ipreambled, bool) PERLVAR(Ipreambleav, AV *) @@ -185,7 +170,6 @@ PERLVAR(Isys_intern, struct interp_intern) /* more statics moved here */ PERLVARI(Igeneration, int, 100) /* from op.c */ PERLVAR(IDBcv, CV *) /* from perl.c */ -PERLVAR(Iarchpat_auto, char*) /* from perl.c */ PERLVARI(Iin_clean_objs,bool, FALSE) /* from sv.c */ PERLVARI(Iin_clean_all, bool, FALSE) /* from sv.c */ @@ -249,10 +233,9 @@ PERLVAR(Icshlen, I32) PERLVAR(Ilex_state, U32) /* next token is determined */ PERLVAR(Ilex_defer, U32) /* state after determined token */ -PERLVAR(Ilex_expect, expectation) /* expect after determined token */ +PERLVAR(Ilex_expect, int) /* expect after determined token */ PERLVAR(Ilex_brackets, I32) /* bracket count */ PERLVAR(Ilex_formbrack, I32) /* bracket count at outer format level */ -PERLVAR(Ilex_fakebrack, I32) /* outer bracket is mere delimiter */ PERLVAR(Ilex_casemods, I32) /* casemod count */ PERLVAR(Ilex_dojoin, I32) /* doing an array interpolation */ PERLVAR(Ilex_starts, I32) /* how many interps done on level */ @@ -274,7 +257,7 @@ PERLVAR(Ibufptr, char *) PERLVAR(Ioldbufptr, char *) PERLVAR(Ioldoldbufptr, char *) PERLVAR(Ibufend, char *) -PERLVARI(Iexpect,expectation, XSTATE) /* how to interpret ambiguous tokens */ +PERLVARI(Iexpect,int, XSTATE) /* how to interpret ambiguous tokens */ PERLVAR(Imulti_start, I32) /* 1st line of multi-line string */ PERLVAR(Imulti_end, I32) /* last line of multi-line string */ @@ -291,17 +274,16 @@ PERLVAR(Ipadix, I32) /* max used index in current "register" pad */ PERLVAR(Ipadix_floor, I32) /* how low may inner block reset padix */ PERLVAR(Ipad_reset_pending, I32) /* reset pad on next attempted alloc */ -PERLVAR(Ithisexpr, I32) /* name id for nothing_in_common() */ PERLVAR(Ilast_uni, char *) /* position of last named-unary op */ PERLVAR(Ilast_lop, char *) /* position of last list operator */ PERLVAR(Ilast_lop_op, OPCODE) /* last list operator */ PERLVAR(Iin_my, I32) /* we're compiling a "my" (or "our") declaration */ PERLVAR(Iin_my_stash, HV *) /* declared class of this "my" declaration */ #ifdef FCRYPT -PERLVAR(Icryptseen, I32) /* has fast crypt() been initialized? */ +PERLVAR(Icryptseen, bool) /* has fast crypt() been initialized? */ #endif -PERLVAR(Ihints, U32) /* pragma-tic compile-time flags */ +PERLVAR(Ihints, U32) /* pragma-tic compile-time flags */ PERLVAR(Idebug, VOL U32) /* flags given to -D switch */ @@ -364,12 +346,10 @@ PERLVAR(Iglob_index, int) PERLVAR(Isrand_called, bool) PERLVARA(Iuudmap,256, char) PERLVAR(Ibitcount, char *) -PERLVAR(Ifilter_debug, int) #ifdef USE_THREADS PERLVAR(Ithr_key, perl_key) /* For per-thread struct perl_thread* */ PERLVAR(Isv_mutex, perl_mutex) /* Mutex for allocating SVs in sv.c */ -PERLVAR(Imalloc_mutex, perl_mutex) /* Mutex for malloc */ PERLVAR(Ieval_mutex, perl_mutex) /* Mutex for doeval */ PERLVAR(Ieval_cond, perl_cond) /* Condition variable for doeval */ PERLVAR(Ieval_owner, struct perl_thread *) @@ -388,12 +368,21 @@ PERLVAR(Icred_mutex, perl_mutex) /* altered credentials in effect */ #endif /* USE_THREADS */ +PERLVAR(Ipsig_ptr, SV**) +PERLVAR(Ipsig_name, SV**) + #if defined(PERL_IMPLICIT_SYS) -PERLVARI(IMem, struct IPerlMem*, NULL) -PERLVARI(IEnv, struct IPerlEnv*, NULL) -PERLVARI(IStdIO, struct IPerlStdIO*, NULL) -PERLVARI(ILIO, struct IPerlLIO*, NULL) -PERLVARI(IDir, struct IPerlDir*, NULL) -PERLVARI(ISock, struct IPerlSock*, NULL) -PERLVARI(IProc, struct IPerlProc*, NULL) +PERLVAR(IMem, struct IPerlMem*) +PERLVAR(IMemShared, struct IPerlMem*) +PERLVAR(IMemParse, struct IPerlMem*) +PERLVAR(IEnv, struct IPerlEnv*) +PERLVAR(IStdIO, struct IPerlStdIO*) +PERLVAR(ILIO, struct IPerlLIO*) +PERLVAR(IDir, struct IPerlDir*) +PERLVAR(ISock, struct IPerlSock*) +PERLVAR(IProc, struct IPerlProc*) +#endif + +#if defined(USE_ITHREADS) +PERLVAR(Iptr_table, PTR_TBL_t*) #endif diff --git a/iperlsys.h b/iperlsys.h index 3ecea42..7b20d5d 100644 --- a/iperlsys.h +++ b/iperlsys.h @@ -74,6 +74,10 @@ extern void PerlIO_init (void); #endif +#ifndef Sighandler_t +typedef Signal_t (*Sighandler_t) (int); +#endif + #if defined(PERL_IMPLICIT_SYS) #ifndef PerlIO @@ -82,6 +86,7 @@ typedef struct _PerlIO PerlIO; /* IPerlStdIO */ struct IPerlStdIO; +struct IPerlStdIOInfo; typedef PerlIO* (*LPStdin)(struct IPerlStdIO*); typedef PerlIO* (*LPStdout)(struct IPerlStdIO*); typedef PerlIO* (*LPStderr)(struct IPerlStdIO*); @@ -128,6 +133,7 @@ typedef int (*LPSetpos)(struct IPerlStdIO*, PerlIO*, const Fpos_t*); typedef void (*LPInit)(struct IPerlStdIO*); typedef void (*LPInitOSExtras)(struct IPerlStdIO*); +typedef PerlIO* (*LPFdupopen)(struct IPerlStdIO*, PerlIO*); struct IPerlStdIO { @@ -169,6 +175,7 @@ struct IPerlStdIO LPSetpos pSetpos; LPInit pInit; LPInitOSExtras pInitOSExtras; + LPFdupopen pFdupopen; }; struct IPerlStdIOInfo @@ -279,11 +286,14 @@ struct IPerlStdIOInfo #undef init_os_extras #define init_os_extras() \ (*PL_StdIO->pInitOSExtras)(PL_StdIO) +#define PerlIO_fdupopen(f) \ + (*PL_StdIO->pFdupopen)(PL_StdIO, (f)) #else /* PERL_IMPLICIT_SYS */ #include "perlsdio.h" #include "perl.h" +#define PerlIO_fdupopen(f) (f) #endif /* PERL_IMPLICIT_SYS */ @@ -334,7 +344,7 @@ struct _PerlIO; #ifndef PerlIO_stdoutf extern int PerlIO_stdoutf (const char *,...) - __attribute__((format (printf, 1, 2))); + __attribute__((__format__ (__printf__, 1, 2))); #endif #ifndef PerlIO_puts extern int PerlIO_puts (PerlIO *,const char *); @@ -395,11 +405,11 @@ extern void PerlIO_setlinebuf (PerlIO *); #endif #ifndef PerlIO_printf extern int PerlIO_printf (PerlIO *, const char *,...) - __attribute__((format (printf, 2, 3))); + __attribute__((__format__ (__printf__, 2, 3))); #endif #ifndef PerlIO_sprintf extern int PerlIO_sprintf (char *, int, const char *,...) - __attribute__((format (printf, 3, 4))); + __attribute__((__format__ (__printf__, 3, 4))); #endif #ifndef PerlIO_vprintf extern int PerlIO_vprintf (PerlIO *, const char *, va_list); @@ -461,6 +471,9 @@ extern int PerlIO_getpos (PerlIO *,Fpos_t *); #ifndef PerlIO_setpos extern int PerlIO_setpos (PerlIO *,const Fpos_t *); #endif +#ifndef PerlIO_fdupopen +extern PerlIO * PerlIO_fdupopen (PerlIO *); +#endif /* @@ -471,6 +484,7 @@ extern int PerlIO_setpos (PerlIO *,const Fpos_t *); /* IPerlDir */ struct IPerlDir; +struct IPerlDirInfo; typedef int (*LPMakedir)(struct IPerlDir*, const char*, int); typedef int (*LPChdir)(struct IPerlDir*, const char*); typedef int (*LPRmdir)(struct IPerlDir*, const char*); @@ -480,6 +494,10 @@ typedef struct direct* (*LPDirRead)(struct IPerlDir*, DIR*); typedef void (*LPDirRewind)(struct IPerlDir*, DIR*); typedef void (*LPDirSeek)(struct IPerlDir*, DIR*, long); typedef long (*LPDirTell)(struct IPerlDir*, DIR*); +#ifdef WIN32 +typedef char* (*LPDirMapPathA)(struct IPerlDir*, const char*); +typedef WCHAR* (*LPDirMapPathW)(struct IPerlDir*, const WCHAR*); +#endif struct IPerlDir { @@ -492,6 +510,10 @@ struct IPerlDir LPDirRewind pRewind; LPDirSeek pSeek; LPDirTell pTell; +#ifdef WIN32 + LPDirMapPathA pMapPathA; + LPDirMapPathW pMapPathW; +#endif }; struct IPerlDirInfo @@ -518,6 +540,12 @@ struct IPerlDirInfo (*PL_Dir->pSeek)(PL_Dir, (dir), (loc)) #define PerlDir_tell(dir) \ (*PL_Dir->pTell)(PL_Dir, (dir)) +#ifdef WIN32 +#define PerlDir_mapA(dir) \ + (*PL_Dir->pMapPathA)(PL_Dir, (dir)) +#define PerlDir_mapW(dir) \ + (*PL_Dir->pMapPathW)(PL_Dir, (dir)) +#endif #else /* PERL_IMPLICIT_SYS */ @@ -534,6 +562,10 @@ struct IPerlDirInfo #define PerlDir_rewind(dir) rewinddir((dir)) #define PerlDir_seek(dir, loc) seekdir((dir), (loc)) #define PerlDir_tell(dir) telldir((dir)) +#ifdef WIN32 +#define PerlDir_mapA(dir) dir +#define PerlDir_mapW(dir) dir +#endif #endif /* PERL_IMPLICIT_SYS */ @@ -545,6 +577,7 @@ struct IPerlDirInfo /* IPerlEnv */ struct IPerlEnv; +struct IPerlEnvInfo; typedef char* (*LPEnvGetenv)(struct IPerlEnv*, const char*); typedef int (*LPEnvPutenv)(struct IPerlEnv*, const char*); typedef char* (*LPEnvGetenv_len)(struct IPerlEnv*, @@ -637,7 +670,7 @@ struct IPerlEnvInfo #define PerlEnv_putenv(str) putenv((str)) #define PerlEnv_getenv(str) getenv((str)) #define PerlEnv_getenv_len(str,l) getenv_len((str), (l)) -#define PerlEnv_clear() clearenv() +#define PerlEnv_clearenv() clearenv() #define PerlEnv_get_childenv() get_childenv() #define PerlEnv_free_childenv(e) free_childenv((e)) #define PerlEnv_get_childdir() get_childdir() @@ -665,6 +698,7 @@ struct IPerlEnvInfo /* IPerlLIO */ struct IPerlLIO; +struct IPerlLIOInfo; typedef int (*LPLIOAccess)(struct IPerlLIO*, const char*, int); typedef int (*LPLIOChmod)(struct IPerlLIO*, const char*, int); typedef int (*LPLIOChown)(struct IPerlLIO*, const char*, uid_t, @@ -678,6 +712,8 @@ typedef int (*LPLIOFileStat)(struct IPerlLIO*, int, struct stat*); typedef int (*LPLIOIOCtl)(struct IPerlLIO*, int, unsigned int, char*); typedef int (*LPLIOIsatty)(struct IPerlLIO*, int); +typedef int (*LPLIOLink)(struct IPerlLIO*, const char*, + const char *); typedef long (*LPLIOLseek)(struct IPerlLIO*, int, long, int); typedef int (*LPLIOLstat)(struct IPerlLIO*, const char*, struct stat*); @@ -710,6 +746,7 @@ struct IPerlLIO LPLIOFileStat pFileStat; LPLIOIOCtl pIOCtl; LPLIOIsatty pIsatty; + LPLIOLink pLink; LPLIOLseek pLseek; LPLIOLstat pLstat; LPLIOMktemp pMktemp; @@ -754,6 +791,8 @@ struct IPerlLIOInfo (*PL_LIO->pIOCtl)(PL_LIO, (fd), (u), (buf)) #define PerlLIO_isatty(fd) \ (*PL_LIO->pIsatty)(PL_LIO, (fd)) +#define PerlLIO_link(oldname, newname) \ + (*PL_LIO->pLink)(PL_LIO, (oldname), (newname)) #define PerlLIO_lseek(fd, offset, mode) \ (*PL_LIO->pLseek)(PL_LIO, (fd), (offset), (mode)) #define PerlLIO_lstat(name, buf) \ @@ -796,6 +835,7 @@ struct IPerlLIOInfo #define PerlLIO_fstat(fd, buf) Fstat((fd), (buf)) #define PerlLIO_ioctl(fd, u, buf) ioctl((fd), (u), (buf)) #define PerlLIO_isatty(fd) isatty((fd)) +#define PerlLIO_link(oldname, newname) link((oldname), (newname)) #define PerlLIO_lseek(fd, offset, mode) lseek((fd), (offset), (mode)) #define PerlLIO_stat(name, buf) Stat((name), (buf)) #ifdef HAS_LSTAT @@ -826,15 +866,24 @@ struct IPerlLIOInfo /* IPerlMem */ struct IPerlMem; +struct IPerlMemInfo; typedef void* (*LPMemMalloc)(struct IPerlMem*, size_t); typedef void* (*LPMemRealloc)(struct IPerlMem*, void*, size_t); typedef void (*LPMemFree)(struct IPerlMem*, void*); +typedef void* (*LPMemCalloc)(struct IPerlMem*, size_t, size_t); +typedef void (*LPMemGetLock)(struct IPerlMem*); +typedef void (*LPMemFreeLock)(struct IPerlMem*); +typedef int (*LPMemIsLocked)(struct IPerlMem*); struct IPerlMem { LPMemMalloc pMalloc; LPMemRealloc pRealloc; LPMemFree pFree; + LPMemCalloc pCalloc; + LPMemGetLock pGetLock; + LPMemFreeLock pFreeLock; + LPMemIsLocked pIsLocked; }; struct IPerlMemInfo @@ -843,18 +892,84 @@ struct IPerlMemInfo struct IPerlMem perlMemList; }; +/* Interpreter specific memory macros */ #define PerlMem_malloc(size) \ (*PL_Mem->pMalloc)(PL_Mem, (size)) #define PerlMem_realloc(buf, size) \ (*PL_Mem->pRealloc)(PL_Mem, (buf), (size)) #define PerlMem_free(buf) \ (*PL_Mem->pFree)(PL_Mem, (buf)) +#define PerlMem_calloc(num, size) \ + (*PL_Mem->pCalloc)(PL_Mem, (num), (size)) +#define PerlMem_get_lock() \ + (*PL_Mem->pGetLock)(PL_Mem) +#define PerlMem_free_lock() \ + (*PL_Mem->pFreeLock)(PL_Mem) +#define PerlMem_is_locked() \ + (*PL_Mem->pIsLocked)(PL_Mem) + +/* Shared memory macros */ +#define PerlMemShared_malloc(size) \ + (*PL_MemShared->pMalloc)(PL_Mem, (size)) +#define PerlMemShared_realloc(buf, size) \ + (*PL_MemShared->pRealloc)(PL_Mem, (buf), (size)) +#define PerlMemShared_free(buf) \ + (*PL_MemShared->pFree)(PL_Mem, (buf)) +#define PerlMemShared_calloc(num, size) \ + (*PL_MemShared->pCalloc)(PL_Mem, (num), (size)) +#define PerlMemShared_get_lock() \ + (*PL_MemShared->pGetLock)(PL_Mem) +#define PerlMemShared_free_lock() \ + (*PL_MemShared->pFreeLock)(PL_Mem) +#define PerlMemShared_is_locked() \ + (*PL_MemShared->pIsLocked)(PL_Mem) + + +/* Parse tree memory macros */ +#define PerlMemParse_malloc(size) \ + (*PL_MemParse->pMalloc)(PL_Mem, (size)) +#define PerlMemParse_realloc(buf, size) \ + (*PL_MemParse->pRealloc)(PL_Mem, (buf), (size)) +#define PerlMemParse_free(buf) \ + (*PL_MemParse->pFree)(PL_Mem, (buf)) +#define PerlMemParse_calloc(num, size) \ + (*PL_MemParse->pCalloc)(PL_Mem, (num), (size)) +#define PerlMemParse_get_lock() \ + (*PL_MemParse->pGetLock)(PL_Mem) +#define PerlMemParse_free_lock() \ + (*PL_MemParse->pFreeLock)(PL_Mem) +#define PerlMemParse_is_locked() \ + (*PL_MemParse->pIsLocked)(PL_Mem) + #else /* PERL_IMPLICIT_SYS */ +/* Interpreter specific memory macros */ #define PerlMem_malloc(size) malloc((size)) #define PerlMem_realloc(buf, size) realloc((buf), (size)) #define PerlMem_free(buf) free((buf)) +#define PerlMem_calloc(num, size) calloc((num), (size)) +#define PerlMem_get_lock() +#define PerlMem_free_lock() +#define PerlMem_is_locked() 0 + +/* Shared memory macros */ +#define PerlMemShared_malloc(size) malloc((size)) +#define PerlMemShared_realloc(buf, size) realloc((buf), (size)) +#define PerlMemShared_free(buf) free((buf)) +#define PerlMemShared_calloc(num, size) calloc((num), (size)) +#define PerlMemShared_get_lock() +#define PerlMemShared_free_lock() +#define PerlMemShared_is_locked() 0 + +/* Parse tree memory macros */ +#define PerlMemParse_malloc(size) malloc((size)) +#define PerlMemParse_realloc(buf, size) realloc((buf), (size)) +#define PerlMemParse_free(buf) free((buf)) +#define PerlMemParse_calloc(num, size) calloc((num), (size)) +#define PerlMemParse_get_lock() +#define PerlMemParse_free_lock() +#define PerlMemParse_is_locked() 0 #endif /* PERL_IMPLICIT_SYS */ @@ -865,15 +980,13 @@ struct IPerlMemInfo #if defined(PERL_IMPLICIT_SYS) -#ifndef Sighandler_t -typedef Signal_t (*Sighandler_t) (int); -#endif #ifndef jmp_buf #include #endif /* IPerlProc */ struct IPerlProc; +struct IPerlProcInfo; typedef void (*LPProcAbort)(struct IPerlProc*); typedef char* (*LPProcCrypt)(struct IPerlProc*, const char*, const char*); @@ -905,8 +1018,10 @@ typedef int (*LPProcTimes)(struct IPerlProc*, struct tms*); typedef int (*LPProcWait)(struct IPerlProc*, int*); typedef int (*LPProcWaitpid)(struct IPerlProc*, int, int*, int); typedef Sighandler_t (*LPProcSignal)(struct IPerlProc*, int, Sighandler_t); -typedef void* (*LPProcDynaLoader)(struct IPerlProc*, const char*); +typedef int (*LPProcFork)(struct IPerlProc*); +typedef int (*LPProcGetpid)(struct IPerlProc*); #ifdef WIN32 +typedef void* (*LPProcDynaLoader)(struct IPerlProc*, const char*); typedef void (*LPProcGetOSError)(struct IPerlProc*, SV* sv, DWORD dwErr); typedef void (*LPProcFreeBuf)(struct IPerlProc*, char*); @@ -944,6 +1059,8 @@ struct IPerlProc LPProcWait pWait; LPProcWaitpid pWaitpid; LPProcSignal pSignal; + LPProcFork pFork; + LPProcGetpid pGetpid; #ifdef WIN32 LPProcDynaLoader pDynaLoader; LPProcGetOSError pGetOSError; @@ -1010,6 +1127,10 @@ struct IPerlProcInfo (*PL_Proc->pWaitpid)(PL_Proc, (p), (s), (f)) #define PerlProc_signal(n, h) \ (*PL_Proc->pSignal)(PL_Proc, (n), (h)) +#define PerlProc_fork() \ + (*PL_Proc->pFork)(PL_Proc) +#define PerlProc_getpid() \ + (*PL_Proc->pGetpid)(PL_Proc) #define PerlProc_setjmp(b, n) Sigsetjmp((b), (n)) #define PerlProc_longjmp(b, n) Siglongjmp((b), (n)) @@ -1058,6 +1179,8 @@ struct IPerlProcInfo #define PerlProc_setjmp(b, n) Sigsetjmp((b), (n)) #define PerlProc_longjmp(b, n) Siglongjmp((b), (n)) #define PerlProc_signal(n, h) signal((n), (h)) +#define PerlProc_fork() fork() +#define PerlProc_getpid() getpid() #ifdef WIN32 #define PerlProc_DynaLoad(f) \ @@ -1075,6 +1198,7 @@ struct IPerlProcInfo /* PerlSock */ struct IPerlSock; +struct IPerlSockInfo; typedef u_long (*LPHtonl)(struct IPerlSock*, u_long); typedef u_short (*LPHtons)(struct IPerlSock*, u_short); typedef u_long (*LPNtohl)(struct IPerlSock*, u_long); @@ -1345,22 +1469,5 @@ struct IPerlSockInfo #endif /* PERL_IMPLICIT_SYS */ -/* Mention - - HAS_READV - HAS_RECVMSG - HAS_SENDMSG - HAS_WRITEV - HAS_STRUCT_MSGHDR - HAS_STRUCT_CMSGHDR - - here so that Configure picks them up. Perl core does not - use them but somebody might want to extend Socket:: or IO:: - someday. - - Jarkko Hietaniemi November 1998 - - */ - #endif /* __Inc__IPerl___ */ diff --git a/keywords.h b/keywords.h index f6b98aa..972240f 100644 --- a/keywords.h +++ b/keywords.h @@ -16,236 +16,237 @@ #define KEY_LE 15 #define KEY_LT 16 #define KEY_NE 17 -#define KEY_abs 18 -#define KEY_accept 19 -#define KEY_alarm 20 -#define KEY_and 21 -#define KEY_atan2 22 -#define KEY_bind 23 -#define KEY_binmode 24 -#define KEY_bless 25 -#define KEY_caller 26 -#define KEY_chdir 27 -#define KEY_chmod 28 -#define KEY_chomp 29 -#define KEY_chop 30 -#define KEY_chown 31 -#define KEY_chr 32 -#define KEY_chroot 33 -#define KEY_close 34 -#define KEY_closedir 35 -#define KEY_cmp 36 -#define KEY_connect 37 -#define KEY_continue 38 -#define KEY_cos 39 -#define KEY_crypt 40 -#define KEY_dbmclose 41 -#define KEY_dbmopen 42 -#define KEY_defined 43 -#define KEY_delete 44 -#define KEY_die 45 -#define KEY_do 46 -#define KEY_dump 47 -#define KEY_each 48 -#define KEY_else 49 -#define KEY_elsif 50 -#define KEY_endgrent 51 -#define KEY_endhostent 52 -#define KEY_endnetent 53 -#define KEY_endprotoent 54 -#define KEY_endpwent 55 -#define KEY_endservent 56 -#define KEY_eof 57 -#define KEY_eq 58 -#define KEY_eval 59 -#define KEY_exec 60 -#define KEY_exists 61 -#define KEY_exit 62 -#define KEY_exp 63 -#define KEY_fcntl 64 -#define KEY_fileno 65 -#define KEY_flock 66 -#define KEY_for 67 -#define KEY_foreach 68 -#define KEY_fork 69 -#define KEY_format 70 -#define KEY_formline 71 -#define KEY_ge 72 -#define KEY_getc 73 -#define KEY_getgrent 74 -#define KEY_getgrgid 75 -#define KEY_getgrnam 76 -#define KEY_gethostbyaddr 77 -#define KEY_gethostbyname 78 -#define KEY_gethostent 79 -#define KEY_getlogin 80 -#define KEY_getnetbyaddr 81 -#define KEY_getnetbyname 82 -#define KEY_getnetent 83 -#define KEY_getpeername 84 -#define KEY_getpgrp 85 -#define KEY_getppid 86 -#define KEY_getpriority 87 -#define KEY_getprotobyname 88 -#define KEY_getprotobynumber 89 -#define KEY_getprotoent 90 -#define KEY_getpwent 91 -#define KEY_getpwnam 92 -#define KEY_getpwuid 93 -#define KEY_getservbyname 94 -#define KEY_getservbyport 95 -#define KEY_getservent 96 -#define KEY_getsockname 97 -#define KEY_getsockopt 98 -#define KEY_glob 99 -#define KEY_gmtime 100 -#define KEY_goto 101 -#define KEY_grep 102 -#define KEY_gt 103 -#define KEY_hex 104 -#define KEY_if 105 -#define KEY_index 106 -#define KEY_int 107 -#define KEY_ioctl 108 -#define KEY_join 109 -#define KEY_keys 110 -#define KEY_kill 111 -#define KEY_last 112 -#define KEY_lc 113 -#define KEY_lcfirst 114 -#define KEY_le 115 -#define KEY_length 116 -#define KEY_link 117 -#define KEY_listen 118 -#define KEY_local 119 -#define KEY_localtime 120 -#define KEY_lock 121 -#define KEY_log 122 -#define KEY_lstat 123 -#define KEY_lt 124 -#define KEY_m 125 -#define KEY_map 126 -#define KEY_mkdir 127 -#define KEY_msgctl 128 -#define KEY_msgget 129 -#define KEY_msgrcv 130 -#define KEY_msgsnd 131 -#define KEY_my 132 -#define KEY_ne 133 -#define KEY_next 134 -#define KEY_no 135 -#define KEY_not 136 -#define KEY_oct 137 -#define KEY_open 138 -#define KEY_opendir 139 -#define KEY_or 140 -#define KEY_ord 141 -#define KEY_our 142 -#define KEY_pack 143 -#define KEY_package 144 -#define KEY_pipe 145 -#define KEY_pop 146 -#define KEY_pos 147 -#define KEY_print 148 -#define KEY_printf 149 -#define KEY_prototype 150 -#define KEY_push 151 -#define KEY_q 152 -#define KEY_qq 153 -#define KEY_qr 154 -#define KEY_quotemeta 155 -#define KEY_qw 156 -#define KEY_qx 157 -#define KEY_rand 158 -#define KEY_read 159 -#define KEY_readdir 160 -#define KEY_readline 161 -#define KEY_readlink 162 -#define KEY_readpipe 163 -#define KEY_recv 164 -#define KEY_redo 165 -#define KEY_ref 166 -#define KEY_rename 167 -#define KEY_require 168 -#define KEY_reset 169 -#define KEY_return 170 -#define KEY_reverse 171 -#define KEY_rewinddir 172 -#define KEY_rindex 173 -#define KEY_rmdir 174 -#define KEY_s 175 -#define KEY_scalar 176 -#define KEY_seek 177 -#define KEY_seekdir 178 -#define KEY_select 179 -#define KEY_semctl 180 -#define KEY_semget 181 -#define KEY_semop 182 -#define KEY_send 183 -#define KEY_setgrent 184 -#define KEY_sethostent 185 -#define KEY_setnetent 186 -#define KEY_setpgrp 187 -#define KEY_setpriority 188 -#define KEY_setprotoent 189 -#define KEY_setpwent 190 -#define KEY_setservent 191 -#define KEY_setsockopt 192 -#define KEY_shift 193 -#define KEY_shmctl 194 -#define KEY_shmget 195 -#define KEY_shmread 196 -#define KEY_shmwrite 197 -#define KEY_shutdown 198 -#define KEY_sin 199 -#define KEY_sleep 200 -#define KEY_socket 201 -#define KEY_socketpair 202 -#define KEY_sort 203 -#define KEY_splice 204 -#define KEY_split 205 -#define KEY_sprintf 206 -#define KEY_sqrt 207 -#define KEY_srand 208 -#define KEY_stat 209 -#define KEY_study 210 -#define KEY_sub 211 -#define KEY_substr 212 -#define KEY_symlink 213 -#define KEY_syscall 214 -#define KEY_sysopen 215 -#define KEY_sysread 216 -#define KEY_sysseek 217 -#define KEY_system 218 -#define KEY_syswrite 219 -#define KEY_tell 220 -#define KEY_telldir 221 -#define KEY_tie 222 -#define KEY_tied 223 -#define KEY_time 224 -#define KEY_times 225 -#define KEY_tr 226 -#define KEY_truncate 227 -#define KEY_uc 228 -#define KEY_ucfirst 229 -#define KEY_umask 230 -#define KEY_undef 231 -#define KEY_unless 232 -#define KEY_unlink 233 -#define KEY_unpack 234 -#define KEY_unshift 235 -#define KEY_untie 236 -#define KEY_until 237 -#define KEY_use 238 -#define KEY_utime 239 -#define KEY_values 240 -#define KEY_vec 241 -#define KEY_wait 242 -#define KEY_waitpid 243 -#define KEY_wantarray 244 -#define KEY_warn 245 -#define KEY_while 246 -#define KEY_write 247 -#define KEY_x 248 -#define KEY_xor 249 -#define KEY_y 250 +#define KEY_STOP 18 +#define KEY_abs 19 +#define KEY_accept 20 +#define KEY_alarm 21 +#define KEY_and 22 +#define KEY_atan2 23 +#define KEY_bind 24 +#define KEY_binmode 25 +#define KEY_bless 26 +#define KEY_caller 27 +#define KEY_chdir 28 +#define KEY_chmod 29 +#define KEY_chomp 30 +#define KEY_chop 31 +#define KEY_chown 32 +#define KEY_chr 33 +#define KEY_chroot 34 +#define KEY_close 35 +#define KEY_closedir 36 +#define KEY_cmp 37 +#define KEY_connect 38 +#define KEY_continue 39 +#define KEY_cos 40 +#define KEY_crypt 41 +#define KEY_dbmclose 42 +#define KEY_dbmopen 43 +#define KEY_defined 44 +#define KEY_delete 45 +#define KEY_die 46 +#define KEY_do 47 +#define KEY_dump 48 +#define KEY_each 49 +#define KEY_else 50 +#define KEY_elsif 51 +#define KEY_endgrent 52 +#define KEY_endhostent 53 +#define KEY_endnetent 54 +#define KEY_endprotoent 55 +#define KEY_endpwent 56 +#define KEY_endservent 57 +#define KEY_eof 58 +#define KEY_eq 59 +#define KEY_eval 60 +#define KEY_exec 61 +#define KEY_exists 62 +#define KEY_exit 63 +#define KEY_exp 64 +#define KEY_fcntl 65 +#define KEY_fileno 66 +#define KEY_flock 67 +#define KEY_for 68 +#define KEY_foreach 69 +#define KEY_fork 70 +#define KEY_format 71 +#define KEY_formline 72 +#define KEY_ge 73 +#define KEY_getc 74 +#define KEY_getgrent 75 +#define KEY_getgrgid 76 +#define KEY_getgrnam 77 +#define KEY_gethostbyaddr 78 +#define KEY_gethostbyname 79 +#define KEY_gethostent 80 +#define KEY_getlogin 81 +#define KEY_getnetbyaddr 82 +#define KEY_getnetbyname 83 +#define KEY_getnetent 84 +#define KEY_getpeername 85 +#define KEY_getpgrp 86 +#define KEY_getppid 87 +#define KEY_getpriority 88 +#define KEY_getprotobyname 89 +#define KEY_getprotobynumber 90 +#define KEY_getprotoent 91 +#define KEY_getpwent 92 +#define KEY_getpwnam 93 +#define KEY_getpwuid 94 +#define KEY_getservbyname 95 +#define KEY_getservbyport 96 +#define KEY_getservent 97 +#define KEY_getsockname 98 +#define KEY_getsockopt 99 +#define KEY_glob 100 +#define KEY_gmtime 101 +#define KEY_goto 102 +#define KEY_grep 103 +#define KEY_gt 104 +#define KEY_hex 105 +#define KEY_if 106 +#define KEY_index 107 +#define KEY_int 108 +#define KEY_ioctl 109 +#define KEY_join 110 +#define KEY_keys 111 +#define KEY_kill 112 +#define KEY_last 113 +#define KEY_lc 114 +#define KEY_lcfirst 115 +#define KEY_le 116 +#define KEY_length 117 +#define KEY_link 118 +#define KEY_listen 119 +#define KEY_local 120 +#define KEY_localtime 121 +#define KEY_lock 122 +#define KEY_log 123 +#define KEY_lstat 124 +#define KEY_lt 125 +#define KEY_m 126 +#define KEY_map 127 +#define KEY_mkdir 128 +#define KEY_msgctl 129 +#define KEY_msgget 130 +#define KEY_msgrcv 131 +#define KEY_msgsnd 132 +#define KEY_my 133 +#define KEY_ne 134 +#define KEY_next 135 +#define KEY_no 136 +#define KEY_not 137 +#define KEY_oct 138 +#define KEY_open 139 +#define KEY_opendir 140 +#define KEY_or 141 +#define KEY_ord 142 +#define KEY_our 143 +#define KEY_pack 144 +#define KEY_package 145 +#define KEY_pipe 146 +#define KEY_pop 147 +#define KEY_pos 148 +#define KEY_print 149 +#define KEY_printf 150 +#define KEY_prototype 151 +#define KEY_push 152 +#define KEY_q 153 +#define KEY_qq 154 +#define KEY_qr 155 +#define KEY_quotemeta 156 +#define KEY_qw 157 +#define KEY_qx 158 +#define KEY_rand 159 +#define KEY_read 160 +#define KEY_readdir 161 +#define KEY_readline 162 +#define KEY_readlink 163 +#define KEY_readpipe 164 +#define KEY_recv 165 +#define KEY_redo 166 +#define KEY_ref 167 +#define KEY_rename 168 +#define KEY_require 169 +#define KEY_reset 170 +#define KEY_return 171 +#define KEY_reverse 172 +#define KEY_rewinddir 173 +#define KEY_rindex 174 +#define KEY_rmdir 175 +#define KEY_s 176 +#define KEY_scalar 177 +#define KEY_seek 178 +#define KEY_seekdir 179 +#define KEY_select 180 +#define KEY_semctl 181 +#define KEY_semget 182 +#define KEY_semop 183 +#define KEY_send 184 +#define KEY_setgrent 185 +#define KEY_sethostent 186 +#define KEY_setnetent 187 +#define KEY_setpgrp 188 +#define KEY_setpriority 189 +#define KEY_setprotoent 190 +#define KEY_setpwent 191 +#define KEY_setservent 192 +#define KEY_setsockopt 193 +#define KEY_shift 194 +#define KEY_shmctl 195 +#define KEY_shmget 196 +#define KEY_shmread 197 +#define KEY_shmwrite 198 +#define KEY_shutdown 199 +#define KEY_sin 200 +#define KEY_sleep 201 +#define KEY_socket 202 +#define KEY_socketpair 203 +#define KEY_sort 204 +#define KEY_splice 205 +#define KEY_split 206 +#define KEY_sprintf 207 +#define KEY_sqrt 208 +#define KEY_srand 209 +#define KEY_stat 210 +#define KEY_study 211 +#define KEY_sub 212 +#define KEY_substr 213 +#define KEY_symlink 214 +#define KEY_syscall 215 +#define KEY_sysopen 216 +#define KEY_sysread 217 +#define KEY_sysseek 218 +#define KEY_system 219 +#define KEY_syswrite 220 +#define KEY_tell 221 +#define KEY_telldir 222 +#define KEY_tie 223 +#define KEY_tied 224 +#define KEY_time 225 +#define KEY_times 226 +#define KEY_tr 227 +#define KEY_truncate 228 +#define KEY_uc 229 +#define KEY_ucfirst 230 +#define KEY_umask 231 +#define KEY_undef 232 +#define KEY_unless 233 +#define KEY_unlink 234 +#define KEY_unpack 235 +#define KEY_unshift 236 +#define KEY_untie 237 +#define KEY_until 238 +#define KEY_use 239 +#define KEY_utime 240 +#define KEY_values 241 +#define KEY_vec 242 +#define KEY_wait 243 +#define KEY_waitpid 244 +#define KEY_wantarray 245 +#define KEY_warn 246 +#define KEY_while 247 +#define KEY_write 248 +#define KEY_x 249 +#define KEY_xor 250 +#define KEY_y 251 diff --git a/keywords.pl b/keywords.pl index 438849a..acdf807 100755 --- a/keywords.pl +++ b/keywords.pl @@ -42,6 +42,7 @@ INIT LE LT NE +STOP abs accept alarm diff --git a/lib/AutoLoader.pm b/lib/AutoLoader.pm index 8e15c1f..4bbcb33 100644 --- a/lib/AutoLoader.pm +++ b/lib/AutoLoader.pm @@ -11,7 +11,7 @@ BEGIN { @EXPORT_OK = @EXPORT_OK = qw(AUTOLOAD); $is_dosish = $^O eq 'dos' || $^O eq 'os2' || $^O eq 'MSWin32'; $is_vms = $^O eq 'VMS'; - $VERSION = $VERSION = '5.57'; + $VERSION = '5.57'; } AUTOLOAD { diff --git a/lib/Benchmark.pm b/lib/Benchmark.pm index 767cb67..487ddd5 100644 --- a/lib/Benchmark.pm +++ b/lib/Benchmark.pm @@ -2,13 +2,7 @@ package Benchmark; =head1 NAME -Benchmark - benchmark running times of code - -timethis - run a chunk of code several times - -timethese - run several chunks of code several times - -timeit - run a chunk of code and see how long it goes +Benchmark - benchmark running times of Perl code =head1 SYNOPSIS @@ -26,14 +20,50 @@ timeit - run a chunk of code and see how long it goes 'Name2' => sub { ...code2... }, }); + # cmpthese can be used both ways as well + cmpthese($count, { + 'Name1' => '...code1...', + 'Name2' => '...code2...', + }); + + cmpthese($count, { + 'Name1' => sub { ...code1... }, + 'Name2' => sub { ...code2... }, + }); + + # ...or in two stages + $results = timethese($count, + { + 'Name1' => sub { ...code1... }, + 'Name2' => sub { ...code2... }, + }, + 'none' + ); + cmpthese( $results ) ; + $t = timeit($count, '...other code...') print "$count loops of other code took:",timestr($t),"\n"; + $t = countit($time, '...other code...') + $count = $t->iters ; + print "$count loops of other code took:",timestr($t),"\n"; + =head1 DESCRIPTION The Benchmark module encapsulates a number of routines to help you figure out how long it takes to execute some code. +timethis - run a chunk of code several times + +timethese - run several chunks of code several times + +cmpthese - print results of timethese as a comparison chart + +timeit - run a chunk of code and see how long it goes + +countit - see how many times a chunk of code runs in a given time + + =head2 Methods =over 10 @@ -57,6 +87,10 @@ Enables or disable debugging by setting the C<$Benchmark::Debug> flag: $t = timeit(10, ' 5 ** $Global '); debug Benchmark 0; +=item iters + +Returns the number of iterations. + =back =head2 Standard Exports @@ -119,28 +153,26 @@ The routines are called in string comparison order of KEY. The COUNT can be zero or negative, see timethis(). +Returns a hash of Benchmark objects, keyed by name. + =item timediff ( T1, T2 ) Returns the difference between two Benchmark times as a Benchmark object suitable for passing to timestr(). -=item timesum ( T1, T2 ) - -Returns the sum of two Benchmark times as a Benchmark object suitable -for passing to timestr(). - =item timestr ( TIMEDIFF, [ STYLE, [ FORMAT ] ] ) Returns a string that formats the times in the TIMEDIFF object in the requested STYLE. TIMEDIFF is expected to be a Benchmark object similar to that returned by timediff(). -STYLE can be any of 'all', 'noc', 'nop' or 'auto'. 'all' shows each -of the 5 times available ('wallclock' time, user time, system time, +STYLE can be any of 'all', 'none', 'noc', 'nop' or 'auto'. 'all' shows +each of the 5 times available ('wallclock' time, user time, system time, user time of children, and system time of children). 'noc' shows all except the two children times. 'nop' shows only wallclock and the two children times. 'auto' (the default) will act as 'all' unless the children times are both zero, in which case it acts as 'noc'. +'none' prevents output. FORMAT is the L-style format specifier (without the leading '%') to use to print the times. It defaults to '5.2f'. @@ -162,6 +194,34 @@ Clear the cached time for COUNT rounds of the null loop. Clear all cached times. +=item cmpthese ( COUT, CODEHASHREF, [ STYLE ] ) + +=item cmpthese ( RESULTSHASHREF ) + +Optionally calls timethese(), then outputs comparison chart. This +chart is sorted from slowest to fastest, and shows the percent +speed difference between each pair of tests. Can also be passed +the data structure that timethese() returns: + + $results = timethese( .... ); + cmpthese( $results ); + +Returns the data structure returned by timethese() (or passed in). + +=item countit(TIME, CODE) + +Arguments: TIME is the minimum length of time to run CODE for, and CODE is +the code to run. CODE may be either a code reference or a string to +be eval'd; either way it will be run in the caller's package. + +TIME is I negative. countit() will run the loop many times to +calculate the speed of CODE before running it for TIME. The actual +time run for will usually be greater than TIME due to system clock +resolution, so it's best to look at the number of iterations divided +by the times that you are concerned with, not just the iterations. + +Returns: a Benchmark object. + =item disablecache ( ) Disable caching of timings for the null loop. This will force Benchmark @@ -173,6 +233,11 @@ Enable caching of timings for the null loop. The time taken for COUNT rounds of the null loop will be calculated only once for each different COUNT used. +=item timesum ( T1, T2 ) + +Returns the sum of two Benchmark times as a Benchmark object suitable +for passing to timestr(). + =back =head1 NOTES @@ -180,7 +245,7 @@ different COUNT used. The data is stored as a list of values from the time and times functions: - ($real, $user, $system, $children_user, $children_system) + ($real, $user, $system, $children_user, $children_system, $iters) in seconds for the whole loop (not divided by the number of rounds). @@ -192,7 +257,7 @@ The time of the null loop (a loop with the same number of rounds but empty loop body) is subtracted from the time of the real loop. -The null loop times are cached, the key being the +The null loop times can be cached, the key being the number of rounds. The caching can be controlled using calls like these: @@ -202,6 +267,38 @@ calls like these: disablecache(); enablecache(); +Caching is off by default, as it can (usually slightly) decrease +accuracy and does not usually noticably affect runtimes. + +=head1 EXAMPLES + +For example, + + use Benchmark;$x=3;cmpthese(-5,{a=>sub{$x*$x},b=>sub{$x**2}}) + +outputs something like this: + + Benchmark: running a, b, each for at least 5 CPU seconds... + a: 10 wallclock secs ( 5.14 usr + 0.13 sys = 5.27 CPU) @ 3835055.60/s (n=20210743) + b: 5 wallclock secs ( 5.41 usr + 0.00 sys = 5.41 CPU) @ 1574944.92/s (n=8520452) + Rate b a + b 1574945/s -- -59% + a 3835056/s 144% -- + +while + + use Benchmark; + $x=3; + $r=timethese(-5,{a=>sub{$x*$x},b=>sub{$x**2}},'none'); + cmpthese($r); + +outputs something like this: + + Rate b a + b 1559428/s -- -62% + a 4152037/s 166% -- + + =head1 INHERITANCE Benchmark inherits from no other class, except of course @@ -210,7 +307,7 @@ for Exporter. =head1 CAVEATS Comparing eval'd strings with code references will give you -inaccurate results: a code reference will show a slower +inaccurate results: a code reference will show a slightly slower execution time than the equivalent eval'd string. The real time timing is done using time(2) and @@ -226,6 +323,10 @@ The system time of the null loop might be slightly more than the system time of the loop with the actual code and therefore the difference might end up being E 0. +=head1 SEE ALSO + +L - a Perl code profiler + =head1 AUTHORS Jarkko Hietaniemi >, Tim Bunce > @@ -241,6 +342,10 @@ documentation. April 04-07th, 1997: by Jarkko Hietaniemi, added the run-for-some-time functionality. +September, 1999; by Barrie Slaymaker: math fixes and accuracy and +efficiency tweaks. Added cmpthese(). A result is now returned from +timethese(). Exposed countit() (was runfor()). + =cut # evaluate something in a clean lexical environment @@ -253,8 +358,11 @@ sub _doeval { eval shift } use Carp; use Exporter; @ISA=(Exporter); -@EXPORT=qw(timeit timethis timethese timediff timesum timestr); -@EXPORT_OK=qw(clearcache clearallcache disablecache enablecache); +@EXPORT=qw(timeit timethis timethese timediff timestr); +@EXPORT_OK=qw(timesum cmpthese countit + clearcache clearallcache disablecache enablecache); + +$VERSION = 1.00; &init; @@ -290,6 +398,7 @@ sub cpu_p { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps ; } sub cpu_c { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $cu+$cs ; } sub cpu_a { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $pu+$ps+$cu+$cs ; } sub real { my($r,$pu,$ps,$cu,$cs) = @{$_[0]}; $r ; } +sub iters { $_[0]->[5] ; } sub timediff { my($a, $b) = @_; @@ -364,15 +473,14 @@ sub runloop { croak "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@; print STDERR "runloop $n '$subcode'\n" if $debug; - # Wait for the user timer to tick. This makes the error range more like -0.01, +0. If - # we don't wait, then it's more like -0.01, +0.01. This may not seem important, but it - # significantly reduces the chances of getting too low initial $n in the initial, 'find - # the minimum' loop in &runfor. This, in turn, can reduce the number of calls to + # Wait for the user timer to tick. This makes the error range more like + # -0.01, +0. If we don't wait, then it's more like -0.01, +0.01. This + # may not seem important, but it significantly reduces the chances of + # getting a too low initial $n in the initial, 'find the minimum' loop + # in &countit. This, in turn, can reduce the number of calls to # &runloop a lot, and thus reduce additive errors. my $tbase = Benchmark->new(0)->[1]; - do { - $t0 = Benchmark->new(0); - } while ( $t0->[1] == $tbase ) ; + while ( ( $t0 = Benchmark->new(0) )->[1] == $tbase ) {} ; &$subref; $t1 = Benchmark->new($n); $td = &timediff($t1, $t0); @@ -386,18 +494,20 @@ sub timeit { my($wn, $wc, $wd); printf STDERR "timeit $n $code\n" if $debug; - my $cache_key = $n . ( ref( $code ) ? 'c' : 's' ) ; + my $cache_key = $n . ( ref( $code ) ? 'c' : 's' ); if ($cache && exists $cache{$cache_key} ) { $wn = $cache{$cache_key}; } else { $wn = &runloop($n, ref( $code ) ? sub { undef } : '' ); + # Can't let our baseline have any iterations, or they get subtracted + # out of the result. + $wn->[5] = 0; $cache{$cache_key} = $wn; } $wc = &runloop($n, $code); $wd = timediff($wc, $wn); - timedebug("timeit: ",$wc); timedebug(" - ",$wn); timedebug(" = ",$wd); @@ -409,8 +519,9 @@ sub timeit { my $default_for = 3; my $min_for = 0.1; -sub runfor { - my ($code, $tmax) = @_; + +sub countit { + my ( $tmax, $code ) = @_; if ( not defined $tmax or $tmax == 0 ) { $tmax = $default_for; @@ -418,52 +529,61 @@ sub runfor { $tmax = -$tmax; } - die "runfor(..., $tmax): timelimit cannot be less than $min_for.\n" + die "countit($tmax, ...): timelimit cannot be less than $min_for.\n" if $tmax < $min_for; - my ($n, $td, $tc, $ntot, $rtot, $utot, $stot, $cutot, $cstot ); + my ($n, $tc); # First find the minimum $n that gives a significant timing. - - my $nmin; + for ($n = 1; ; $n *= 2 ) { + my $td = timeit($n, $code); + $tc = $td->[1] + $td->[2]; + last if $tc > 0.1; + } - for ($n = 1, $tc = 0; ; $n *= 2 ) { - $td = timeit($n, $code); + my $nmin = $n; + + # Get $n high enough that we can guess the final $n with some accuracy. + my $tpra = 0.1 * $tmax; # Target/time practice. + while ( $tc < $tpra ) { + # The 5% fudge is to keep us from iterating again all + # that often (this speeds overall responsiveness when $tmax is big + # and we guess a little low). This does not noticably affect + # accuracy since we're not couting these times. + $n = int( $tpra * 1.05 * $n / $tc ); # Linear approximation. + my $td = timeit($n, $code); $tc = $td->[1] + $td->[2]; - last if $tc > 0.1 ; } - $nmin = $n; - - my $ttot = 0; - my $tpra = 0.05 * $tmax; # Target/time practice. - # Double $n until we have think we have practiced enough. - for ( ; $ttot < $tpra; $n *= 2 ) { - $td = timeit($n, $code); - $ntot += $n; - $rtot += $td->[0]; - $utot += $td->[1]; - $stot += $td->[2]; - $ttot = $utot + $stot; + # Now, do the 'for real' timing(s), repeating until we exceed + # the max. + my $ntot = 0; + my $rtot = 0; + my $utot = 0.0; + my $stot = 0.0; + my $cutot = 0.0; + my $cstot = 0.0; + my $ttot = 0.0; + + # The 5% fudge is because $n is often a few % low even for routines + # with stable times and avoiding extra timeit()s is nice for + # accuracy's sake. + $n = int( $n * ( 1.05 * $tmax / $tc ) ); + + while () { + my $td = timeit($n, $code); + $ntot += $n; + $rtot += $td->[0]; + $utot += $td->[1]; + $stot += $td->[2]; $cutot += $td->[3]; $cstot += $td->[4]; - } - - my $r; + $ttot = $utot + $stot; + last if $ttot >= $tmax; - # Then iterate towards the $tmax. - while ( $ttot < $tmax ) { - $r = $tmax / $ttot - 1; # Linear approximation. + my $r = $tmax / $ttot - 1; # Linear approximation. $n = int( $r * $ntot ); $n = $nmin if $n < $nmin; - $td = timeit($n, $code); - $ntot += $n; - $rtot += $td->[0]; - $utot += $td->[1]; - $stot += $td->[2]; - $ttot = $utot + $stot; - $cutot += $td->[3]; - $cstot += $td->[4]; } return bless [ $rtot, $utot, $stot, $cutot, $cstot, $ntot ]; @@ -486,14 +606,14 @@ sub timethis{ $title = "timethis $n" unless defined $title; } else { $fort = n_to_for( $n ); - $t = runfor($code, $fort); + $t = countit( $fort, $code ); $title = "timethis for $fort" unless defined $title; $forn = $t->[-1]; } local $| = 1; $style = "" unless defined $style; - printf("%10s: ", $title); - print timestr($t, $style, $defaultfmt),"\n"; + printf("%10s: ", $title) unless $style eq 'none'; + print timestr($t, $style, $defaultfmt),"\n" unless $style eq 'none'; $n = $forn if defined $forn; @@ -513,25 +633,163 @@ sub timethese{ unless ref $alt eq HASH; my @names = sort keys %$alt; $style = "" unless defined $style; - print "Benchmark: "; + print "Benchmark: " unless $style eq 'none'; if ( $n > 0 ) { croak "non-integer loopcount $n, stopped" if int($n)<$n; - print "timing $n iterations of"; + print "timing $n iterations of" unless $style eq 'none'; } else { - print "running"; + print "running" unless $style eq 'none'; } - print " ", join(', ',@names); + print " ", join(', ',@names) unless $style eq 'none'; unless ( $n > 0 ) { my $for = n_to_for( $n ); - print ", each for at least $for CPU seconds"; + print ", each for at least $for CPU seconds" unless $style eq 'none'; } - print "...\n"; + print "...\n" unless $style eq 'none'; # we could save the results in an array and produce a summary here # sum, min, max, avg etc etc + my %results; foreach my $name (@names) { - timethis ($n, $alt -> {$name}, $name, $style); + $results{$name} = timethis ($n, $alt -> {$name}, $name, $style); } + + return \%results; } +sub cmpthese{ + my $results = ref $_[0] ? $_[0] : timethese( @_ ); + + return $results + if defined $_[2] && $_[2] eq 'none'; + + # Flatten in to an array of arrays with the name as the first field + my @vals = map{ [ $_, @{$results->{$_}} ] } keys %$results; + + for (@vals) { + # The epsilon fudge here is to prevent div by 0. Since clock + # resolutions are much larger, it's below the noise floor. + my $rate = $_->[6] / ( $_->[2] + $_->[3] + 0.000000000000001 ); + $_->[7] = $rate; + } + + # Sort by rate + @vals = sort { $a->[7] <=> $b->[7] } @vals; + + # If more than half of the rates are greater than one... + my $display_as_rate = $vals[$#vals>>1]->[7] > 1; + + my @rows; + my @col_widths; + + my @top_row = ( + '', + $display_as_rate ? 'Rate' : 's/iter', + map { $_->[0] } @vals + ); + + push @rows, \@top_row; + @col_widths = map { length( $_ ) } @top_row; + + # Build the data rows + # We leave the last column in even though it never has any data. Perhaps + # it should go away. Also, perhaps a style for a single column of + # percentages might be nice. + for my $row_val ( @vals ) { + my @row; + + # Column 0 = test name + push @row, $row_val->[0]; + $col_widths[0] = length( $row_val->[0] ) + if length( $row_val->[0] ) > $col_widths[0]; + + # Column 1 = performance + my $row_rate = $row_val->[7]; + + # We assume that we'll never get a 0 rate. + my $a = $display_as_rate ? $row_rate : 1 / $row_rate; + + # Only give a few decimal places before switching to sci. notation, + # since the results aren't usually that accurate anyway. + my $format = + $a >= 100 ? + "%0.0f" : + $a >= 10 ? + "%0.1f" : + $a >= 1 ? + "%0.2f" : + $a >= 0.1 ? + "%0.3f" : + "%0.2e"; + + $format .= "/s" + if $display_as_rate; + # Using $b here due to optimizing bug in _58 through _61 + my $b = sprintf( $format, $a ); + push @row, $b; + $col_widths[1] = length( $b ) + if length( $b ) > $col_widths[1]; + + # Columns 2..N = performance ratios + my $skip_rest = 0; + for ( my $col_num = 0 ; $col_num < @vals ; ++$col_num ) { + my $col_val = $vals[$col_num]; + my $out; + if ( $skip_rest ) { + $out = ''; + } + elsif ( $col_val->[0] eq $row_val->[0] ) { + $out = "--"; + # $skip_rest = 1; + } + else { + my $col_rate = $col_val->[7]; + $out = sprintf( "%.0f%%", 100*$row_rate/$col_rate - 100 ); + } + push @row, $out; + $col_widths[$col_num+2] = length( $out ) + if length( $out ) > $col_widths[$col_num+2]; + + # A little wierdness to set the first column width properly + $col_widths[$col_num+2] = length( $col_val->[0] ) + if length( $col_val->[0] ) > $col_widths[$col_num+2]; + } + push @rows, \@row; + } + + # Equalize column widths in the chart as much as possible without + # exceeding 80 characters. This does not use or affect cols 0 or 1. + my @sorted_width_refs = + sort { $$a <=> $$b } map { \$_ } @col_widths[2..$#col_widths]; + my $max_width = ${$sorted_width_refs[-1]}; + + my $total = @col_widths - 1 ; + for ( @col_widths ) { $total += $_ } + + STRETCHER: + while ( $total < 80 ) { + my $min_width = ${$sorted_width_refs[0]}; + last + if $min_width == $max_width; + for ( @sorted_width_refs ) { + last + if $$_ > $min_width; + ++$$_; + ++$total; + last STRETCHER + if $total >= 80; + } + } + + # Dump the output + my $format = join( ' ', map { "%${_}s" } @col_widths ) . "\n"; + substr( $format, 1, 0 ) = '-'; + for ( @rows ) { + printf $format, @$_; + } + + return $results; +} + + 1; diff --git a/lib/CPAN.pm b/lib/CPAN.pm index 432e72d..2f22b77 100644 --- a/lib/CPAN.pm +++ b/lib/CPAN.pm @@ -3325,7 +3325,8 @@ sub perl { $perl ||= $candidate if MM->maybe_command($candidate); unless ($perl) { my ($component,$perl_name); - DIST_PERLNAME: foreach $perl_name ($^X, 'perl', 'perl5', "perl$]") { + DIST_PERLNAME: + foreach $perl_name ($^X, 'perl', 'perl5', "perl$Config::Config{version}") { PATH_COMPONENT: foreach $component (MM->path(), $Config::Config{'binexp'}) { next unless defined($component) && $component; diff --git a/lib/CPAN/FirstTime.pm b/lib/CPAN/FirstTime.pm index 731d3ff..2899849 100644 --- a/lib/CPAN/FirstTime.pm +++ b/lib/CPAN/FirstTime.pm @@ -78,7 +78,8 @@ dialog anytime later by typing 'o conf init' at the cpan prompt.) } else { $fastread = 1; $CPAN::Config->{urllist} ||= []; - *prompt = sub { + # prototype should match that of &MakeMaker::prompt + *prompt = sub ($;$) { my($q,$a) = @_; my($ret) = defined $a ? $a : ""; printf qq{%s [%s]\n\n}, $q, $ret; diff --git a/lib/Cwd.pm b/lib/Cwd.pm index 8a99da9..ee1bc28 100644 --- a/lib/Cwd.pm +++ b/lib/Cwd.pm @@ -372,7 +372,7 @@ sub _qnx_abs_path { *abs_path = \&_qnx_abs_path; *fast_abs_path = \&_qnx_abs_path; } - elsif ($^O =~ /cygwin/) { + elsif ($^O eq 'cygwin') { *getcwd = \&cwd; *fastgetcwd = \&cwd; *fastcwd = \&cwd; diff --git a/lib/DB.pm b/lib/DB.pm index 1395c81..2575423 100644 --- a/lib/DB.pm +++ b/lib/DB.pm @@ -794,7 +794,7 @@ highly experimental and subject to change. =head1 AUTHOR -Gurusamy Sarathy gsar@umich.edu +Gurusamy Sarathy gsar@activestate.com This code heavily adapted from an early version of perl5db.pl attributable to Larry Wall and the Perl Porters. diff --git a/lib/Exporter.pm b/lib/Exporter.pm index bc07e9b..585109e 100644 --- a/lib/Exporter.pm +++ b/lib/Exporter.pm @@ -4,6 +4,7 @@ require 5.001; $ExportLevel = 0; $Verbose ||= 0; +$VERSION = '5.562'; sub export_to_level { require Exporter::Heavy; @@ -118,6 +119,18 @@ in L and L. Understanding the concept of modules and how the C statement operates is important to understanding the Exporter. +=head2 How to Export + +The arrays C<@EXPORT> and C<@EXPORT_OK> in a module hold lists of +symbols that are going to be exported into the users name space by +default, or which they can request to be exported, respectively. The +symbols can represent functions, scalars, arrays, hashes, or typeglobs. +The symbols must be given by full name with the exception that the +ampersand in front of a function is optional, e.g. + + @EXPORT = qw(afunc $scalar @array); # afunc is a function + @EXPORT_OK = qw(&bfunc %hash *typeglob); # explicit prefix on &bfunc + =head2 Selecting What To Export Do B export method names! @@ -196,11 +209,12 @@ Exporter has a special method, 'export_to_level' which is used in situations where you can't directly call Export's import method. The export_to_level method looks like: -MyPackage->export_to_level($where_to_export, @what_to_export); +MyPackage->export_to_level($where_to_export, $package, @what_to_export); where $where_to_export is an integer telling how far up the calling stack to export your symbols, and @what_to_export is an array telling what -symbols *to* export (usually this is @_). +symbols *to* export (usually this is @_). The $package argument is +currently unused. For example, suppose that you have a module, A, which already has an import function: diff --git a/lib/Exporter/Heavy.pm b/lib/Exporter/Heavy.pm index 95ffc55..1f9b432 100644 --- a/lib/Exporter/Heavy.pm +++ b/lib/Exporter/Heavy.pm @@ -213,7 +213,8 @@ sub require_version { my $version = ${"${pkg}::VERSION"}; if (!$version or $version < $wanted) { $version ||= "(undef)"; - my $file = $INC{"$pkg.pm"}; + # %INC contains slashes, but $pkg contains double-colons. + my $file = (map {s,::,/,g; $INC{$_}} "$pkg.pm")[0]; $file &&= " ($file)"; require Carp; Carp::croak("$pkg $wanted required--this is only version $version$file") diff --git a/lib/ExtUtils/Embed.pm b/lib/ExtUtils/Embed.pm index e0ea068..b649b6b 100644 --- a/lib/ExtUtils/Embed.pm +++ b/lib/ExtUtils/Embed.pm @@ -332,7 +332,7 @@ B<[@modules]> is an array ref, same as additional arguments mentioned above. This will generate code with an B function that glues the perl B function -to the C B function and writes it to a file named "xsinit.c". +to the C B function and writes it to a file named F. Note that B is a special case where it must call B directly. @@ -378,7 +378,7 @@ we should find B When looking for B relative to a search path, we should find B -Keep in mind, you can always supply B +Keep in mind that you can always supply B as an additional linker argument. B<--> Elist of linker argsE @@ -392,7 +392,7 @@ When invoked with parameters the following are accepted and optional: C -Where, +Where: B<$std> is boolean, equivalent to the B<-std> option. diff --git a/lib/ExtUtils/Install.pm b/lib/ExtUtils/Install.pm index 47bde0d..d6b1375 100644 --- a/lib/ExtUtils/Install.pm +++ b/lib/ExtUtils/Install.pm @@ -67,7 +67,6 @@ sub install { } $packlist->read($pack{"read"}) if (-f $pack{"read"}); my $cwd = cwd(); - my $umask = umask 0 unless $Is_VMS; my($source); MOD_INSTALL: foreach $source (sort keys %hash) { @@ -140,7 +139,6 @@ sub install { print "Writing $pack{'write'}\n"; $packlist->write($pack{'write'}); } - umask $umask unless $Is_VMS; } sub directory_not_empty ($) { @@ -193,7 +191,6 @@ sub uninstall { forceunlink($_) unless $nonono; } print "unlink $fil\n" if $verbose; - close P; forceunlink($fil) unless $nonono; } @@ -259,7 +256,6 @@ sub pm_to_blib { close(FROMTO); } - my $umask = umask 0022 unless $Is_VMS; mkpath($autodir,0,0755); foreach (keys %$fromto) { next if -f $fromto->{$_} && -M $fromto->{$_} < -M $_; @@ -280,7 +276,6 @@ sub pm_to_blib { next unless /\.pm$/; autosplit($fromto->{$_},$autodir); } - umask $umask unless $Is_VMS; } package ExtUtils::Install::Warn; @@ -343,7 +338,7 @@ There are two keys with a special meaning in the hash: "read" and target files to the file named by C<$hashref-E{write}>. If there is another file named by C<$hashref-E{read}>, the contents of this file will be merged into the written file. The read and the written file may be -identical, but on AFS it is quite likely, people are installing to a +identical, but on AFS it is quite likely that people are installing to a different directory than the one where the files later appear. install_default() takes one or less arguments. If no arguments are @@ -356,7 +351,7 @@ The argument-less form is convenient for install scripts like perl -MExtUtils::Install -e install_default Tk/Canvas -Assuming this command is executed in a directory with populated F +Assuming this command is executed in a directory with a populated F directory, it will proceed as if the F was build by MakeMaker on this machine. This is useful for binary distributions. diff --git a/lib/ExtUtils/Installed.pm b/lib/ExtUtils/Installed.pm index dda594e..41f3c9b 100644 --- a/lib/ExtUtils/Installed.pm +++ b/lib/ExtUtils/Installed.pm @@ -56,7 +56,7 @@ my $self = {}; # Read the core packlist $self->{Perl}{packlist} = ExtUtils::Packlist->new("$Config{installarchlib}/.packlist"); -$self->{Perl}{version} = $]; +$self->{Perl}{version} = $Config{version}; # Read the module packlists my $sub = sub diff --git a/lib/ExtUtils/Liblist.pm b/lib/ExtUtils/Liblist.pm index 13e4e29..b992ec0 100644 --- a/lib/ExtUtils/Liblist.pm +++ b/lib/ExtUtils/Liblist.pm @@ -540,7 +540,7 @@ below. =head2 EXTRALIBS List of libraries that need to be linked with when linking a perl -binary which includes this extension Only those libraries that +binary which includes this extension. Only those libraries that actually exist are included. These are written to a file and used when linking perl. @@ -562,7 +562,7 @@ object file. This list is used to create a .bs (bootstrap) file. =head1 PORTABILITY This module deals with a lot of system dependencies and has quite a -few architecture specific Bs in the code. +few architecture specific Cs in the code. =head2 VMS implementation @@ -682,7 +682,7 @@ enable searching for default libraries specified by C<$Config{libs}>. The libraries specified may be a mixture of static libraries and import libraries (to link with DLLs). Since both kinds are used -pretty transparently on the win32 platform, we do not attempt to +pretty transparently on the Win32 platform, we do not attempt to distinguish between them. =item * diff --git a/lib/ExtUtils/MM_Unix.pm b/lib/ExtUtils/MM_Unix.pm index 8824076..f4329e1 100644 --- a/lib/ExtUtils/MM_Unix.pm +++ b/lib/ExtUtils/MM_Unix.pm @@ -377,10 +377,22 @@ sub cflags { if ($Is_PERL_OBJECT) { $self->{CCFLAGS} =~ s/-DPERL_OBJECT(\b|$)/-DPERL_CAPI/g; - if ($Is_Win32 && $Config{'cc'} =~ /^cl/i) { - # Turn off C++ mode of the MSC compiler - $self->{CCFLAGS} =~ s/-TP(\s|$)//; - $self->{OPTIMIZE} =~ s/-TP(\s|$)//; + if ($Is_Win32) { + if ($Config{'cc'} =~ /^cl/i) { + # Turn off C++ mode of the MSC compiler + $self->{CCFLAGS} =~ s/-TP(\s|$)//g; + $self->{OPTIMIZE} =~ s/-TP(\s|$)//g; + } + elsif ($Config{'cc'} =~ /^bcc32/i) { + # Turn off C++ mode of the Borland compiler + $self->{CCFLAGS} =~ s/-P(\s|$)//g; + $self->{OPTIMIZE} =~ s/-P(\s|$)//g; + } + elsif ($Config{'cc'} =~ /^gcc/i) { + # Turn off C++ mode of the GCC compiler + $self->{CCFLAGS} =~ s/-xc\+\+(\s|$)//g; + $self->{OPTIMIZE} =~ s/-xc\+\+(\s|$)//g; + } } } @@ -425,7 +437,19 @@ clean :: '); # clean subdirectories first for $dir (@{$self->{DIR}}) { - push @m, "\t-cd $dir && \$(TEST_F) $self->{MAKEFILE} && \$(MAKE) clean\n"; + if ($Is_Win32 && Win32::IsWin95()) { + push @m, <{MAKEFILE} + \$(MAKE) clean + cd .. +EOT + } + else { + push @m, <{MAKEFILE} && \$(MAKE) clean +EOT + } } my(@otherfiles) = values %{$self->{XS}}; # .c files from *.xs files @@ -1980,7 +2004,8 @@ usually solves this kind of problem. push @defpath, $component if defined $component; } $self->{PERL} ||= - $self->find_perl(5.0, [ $self->canonpath($^X), 'miniperl','perl','perl5',"perl$]" ], + $self->find_perl(5.0, [ $self->canonpath($^X), 'miniperl', + 'perl','perl5',"perl$Config{version}" ], \@defpath, $Verbose ); # don't check if perl is executable, maybe they have decided to # supply switches with perl @@ -2123,6 +2148,7 @@ pure_site_install :: }.$self->catdir('$(PERL_ARCHLIB)','auto','$(FULLEXT)').q{ doc_perl_install :: + -}.$self->{NOECHO}.q{$(MKPATH) $(INSTALLARCHLIB) -}.$self->{NOECHO}.q{$(DOC_INSTALL) \ "Module" "$(NAME)" \ "installed into" "$(INSTALLPRIVLIB)" \ @@ -2132,6 +2158,7 @@ doc_perl_install :: >> }.$self->catfile('$(INSTALLARCHLIB)','perllocal.pod').q{ doc_site_install :: + -}.$self->{NOECHO}.q{$(MKPATH) $(INSTALLARCHLIB) -}.$self->{NOECHO}.q{$(DOC_INSTALL) \ "Module" "$(NAME)" \ "installed into" "$(INSTALLSITELIB)" \ @@ -2498,6 +2525,7 @@ $tmp/perlmain.c: $makefilename}, q{ push @m, q{ doc_inst_perl: }.$self->{NOECHO}.q{echo Appending installation info to $(INSTALLARCHLIB)/perllocal.pod + -}.$self->{NOECHO}.q{$(MKPATH) $(INSTALLARCHLIB) -}.$self->{NOECHO}.q{$(DOC_INSTALL) \ "Perl binary" "$(MAP_TARGET)" \ MAP_STATIC "$(MAP_STATIC)" \ @@ -3071,7 +3099,9 @@ sub realclean { realclean purge :: clean '); # realclean subdirectories first (already cleaned) - my $sub = "\t-cd %s && \$(TEST_F) %s && \$(MAKE) %s realclean\n"; + my $sub = ($Is_Win32 && Win32::IsWin95()) ? + "\tcd %s\n\t\$(TEST_F) %s\n\t\$(MAKE) %s realclean\n\tcd ..\n" : + "\t-cd %s && \$(TEST_F) %s && \$(MAKE) %s realclean\n"; foreach(@{$self->{DIR}}){ push(@m, sprintf($sub,$_,"$self->{MAKEFILE}.old","-f $self->{MAKEFILE}.old")); push(@m, sprintf($sub,$_,"$self->{MAKEFILE}",'')); @@ -3215,12 +3245,25 @@ Helper subroutine for subdirs sub subdir_x { my($self, $subdir) = @_; my(@m); - qq{ + if ($Is_Win32 && Win32::IsWin95()) { + # XXX: dmake-specific, like rest of Win95 port + return <{NOECHO}cd $subdir && \$(MAKE) all \$(PASTHRU) -}; +EOT + } } =item subdirs (o) @@ -3471,7 +3514,7 @@ sub tool_xsubpp { XSUBPPDIR = $xsdir XSUBPP = \$(XSUBPPDIR)/$xsubpp XSPROTOARG = $self->{XSPROTOARG} -XSUBPPDEPS = @tmdeps +XSUBPPDEPS = @tmdeps \$(XSUBPP) XSUBPPARGS = @tmargs }; }; @@ -3569,12 +3612,6 @@ config :: $(INST_AUTODIR)/.exists '.$self->{NOECHO}.'$(NOOP) '; - push @m, qq{ -config :: Version_check - $self->{NOECHO}\$(NOOP) - -} unless $self->{PARENT} or ($self->{PERL_SRC} && $self->{INSTALLDIRS} eq "perl") or $self->{NO_VC}; - push @m, $self->dir_target(qw[$(INST_AUTODIR) $(INST_LIBDIR) $(INST_ARCHAUTODIR)]); if (%{$self->{HTMLLIBPODS}}) { diff --git a/lib/ExtUtils/MM_VMS.pm b/lib/ExtUtils/MM_VMS.pm index 31ca690..f3de323 100644 --- a/lib/ExtUtils/MM_VMS.pm +++ b/lib/ExtUtils/MM_VMS.pm @@ -1106,13 +1106,6 @@ config :: $(INST_AUTODIR).exists $(NOECHO) $(NOOP) '; - push @m, q{ -config :: Version_check - $(NOECHO) $(NOOP) - -} unless $self->{PARENT} or ($self->{PERL_SRC} && $self->{INSTALLDIRS} eq "perl") or $self->{NO_VC}; - - push @m, $self->dir_target(qw[$(INST_AUTODIR) $(INST_LIBDIR) $(INST_ARCHAUTODIR)]); if (%{$self->{MAN1PODS}}) { push @m, q[ diff --git a/lib/ExtUtils/MM_Win32.pm b/lib/ExtUtils/MM_Win32.pm index f6d19a2..534f26d 100644 --- a/lib/ExtUtils/MM_Win32.pm +++ b/lib/ExtUtils/MM_Win32.pm @@ -36,6 +36,49 @@ $NMAKE = 1 if $Config{'make'} =~ /^nmake/i; $PERLMAKE = 1 if $Config{'make'} =~ /^pmake/i; $OBJ = 1 if $Config{'ccflags'} =~ /PERL_OBJECT/i; +# a few workarounds for command.com (very basic) +{ + package ExtUtils::MM_Win95; + + # the $^O test may be overkill, but we want to be sure Win32::IsWin95() + # exists before we try it + + unshift @MM::ISA, 'ExtUtils::MM_Win95' + if ($^O =~ /Win32/ && Win32::IsWin95()); + + sub xs_c { + my($self) = shift; + return '' unless $self->needs_linking(); + ' +.xs.c: + $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) \\ + $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.c + ' + } + + sub xs_cpp { + my($self) = shift; + return '' unless $self->needs_linking(); + ' +.xs.cpp: + $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) \\ + $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.cpp + '; + } + + # many makes are too dumb to use xs_c then c_o + sub xs_o { + my($self) = shift; + return '' unless $self->needs_linking(); + ' +.xs$(OBJ_EXT): + $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) \\ + $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.c + $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.c + '; + } +} # end of command.com workarounds + sub dlsyms { my($self,%attribs) = @_; @@ -441,6 +484,18 @@ sub dynamic_lib { my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || ""; my($ldfrom) = '$(LDFROM)'; my(@m); + +# one thing for GCC/Mingw32: +# we try to overcome non-relocateable-DLL problems by generating +# a (hopefully unique) image-base from the dll's name +# -- BKS, 10-19-1999 + if ($GCC) { + my $dllname = $self->{BASEEXT} . "." . $self->{DLEXT}; + $dllname =~ /(....)(.{0,4})/; + my $baseaddr = unpack("n", $1 ^ $2); + $otherldflags .= sprintf("-Wl,--image-base,0x%x0000 ", $baseaddr); + } + push(@m,' # This section creates the dynamically loadable $(INST_DYNAMIC) # from $(OBJECT) and possibly $(MYEXTLIB). @@ -694,12 +749,6 @@ config :: $(INST_AUTODIR)\.exists '.$self->{NOECHO}.'$(NOOP) '; - push @m, qq{ -config :: Version_check - $self->{NOECHO}\$(NOOP) - -} unless $self->{PARENT} or ($self->{PERL_SRC} && $self->{INSTALLDIRS} eq "perl") or $self->{NO_VC}; - push @m, $self->dir_target(qw[$(INST_AUTODIR) $(INST_LIBDIR) $(INST_ARCHAUTODIR)]); if (%{$self->{HTMLLIBPODS}}) { diff --git a/lib/ExtUtils/MakeMaker.pm b/lib/ExtUtils/MakeMaker.pm index 0f00e39..0426575 100644 --- a/lib/ExtUtils/MakeMaker.pm +++ b/lib/ExtUtils/MakeMaker.pm @@ -2,7 +2,7 @@ BEGIN {require 5.002;} # MakeMaker 5.17 was the last MakeMaker that was compatib package ExtUtils::MakeMaker; -$VERSION = "5.4302"; +$VERSION = "5.44"; $Version_OK = "5.17"; # Makefiles older than $Version_OK will die # (Will be checked from MakeMaker version 4.13 onwards) ($Revision = substr(q$Revision: 1.222 $, 10)) =~ s/\s+$//; @@ -17,7 +17,7 @@ use Carp (); use vars qw( @ISA @EXPORT @EXPORT_OK $AUTOLOAD - $ISA_TTY $Is_Mac $Is_OS2 $Is_VMS $Revision $Setup_done + $ISA_TTY $Is_Mac $Is_OS2 $Is_VMS $Revision $VERSION $Verbose $Version_OK %Config %Keep_after_flush %MM_Sections %Prepend_dot_dot %Recognized_Att_Keys @Get_from_Config @MM_Sections @Overridable @Parent @@ -70,7 +70,7 @@ $Is_VMS = $^O eq 'VMS'; $Is_OS2 = $^O eq 'os2'; $Is_Mac = $^O eq 'MacOS'; $Is_Win32 = $^O eq 'MSWin32'; -$Is_Cygwin= $^O =~ /cygwin/i; +$Is_Cygwin= $^O eq 'cygwin'; require ExtUtils::MM_Unix; @@ -91,35 +91,11 @@ if ($Is_Cygwin) { require ExtUtils::MM_Cygwin; } -# The SelfLoader would bring a lot of overhead for MakeMaker, because -# we know for sure we will use most of the autoloaded functions once -# we have to use one of them. So we write our own loader - -sub AUTOLOAD { - my $code; - if (defined fileno(DATA)) { - my $fh = select DATA; - my $o = $/; # For future reads from the file. - $/ = "\n__END__\n"; - $code = ; - $/ = $o; - select $fh; - close DATA; - eval $code; - if ($@) { - $@ =~ s/ at .*\n//; - Carp::croak $@; - } - } else { - warn "AUTOLOAD called unexpectedly for $AUTOLOAD"; - } - defined(&$AUTOLOAD) or die "Myloader inconsistency error"; - goto &$AUTOLOAD; -} +full_setup(); -# The only subroutine we do not SelfLoad is Version_Check because it's -# called so often. Loading this minimum still requires 1.2 secs on my -# Indy :-( +# The use of the Version_check target has been dropped between perl +# 5.5.63 and 5.5.64. We must keep the subroutine for a while so that +# old Makefiles can satisfy the Version_check target. sub Version_check { my($checkversion) = @_; @@ -140,38 +116,10 @@ sub warnhandler { warn @_; } -sub ExtUtils::MakeMaker::eval_in_subdirs ; -sub ExtUtils::MakeMaker::eval_in_x ; -sub ExtUtils::MakeMaker::full_setup ; -sub ExtUtils::MakeMaker::writeMakefile ; -sub ExtUtils::MakeMaker::new ; -sub ExtUtils::MakeMaker::check_manifest ; -sub ExtUtils::MakeMaker::parse_args ; -sub ExtUtils::MakeMaker::check_hints ; -sub ExtUtils::MakeMaker::mv_all_methods ; -sub ExtUtils::MakeMaker::skipcheck ; -sub ExtUtils::MakeMaker::flush ; -sub ExtUtils::MakeMaker::mkbootstrap ; -sub ExtUtils::MakeMaker::mksymlists ; -sub ExtUtils::MakeMaker::neatvalue ; -sub ExtUtils::MakeMaker::selfdocument ; -sub ExtUtils::MakeMaker::WriteMakefile ; -sub ExtUtils::MakeMaker::prompt ($;$) ; - -1; - -__DATA__ - -package ExtUtils::MakeMaker; - sub WriteMakefile { Carp::croak "WriteMakefile: Need even number of args" if @_ % 2; local $SIG{__WARN__} = \&warnhandler; - unless ($Setup_done++){ - full_setup(); - undef &ExtUtils::MakeMaker::full_setup; #safe memory - } my %att = @_; MM->new(\%att)->flush; } @@ -382,9 +330,13 @@ sub ExtUtils::MakeMaker::new { my($prereq); foreach $prereq (sort keys %{$self->{PREREQ_PM}}) { - my $eval = "use $prereq $self->{PREREQ_PM}->{$prereq}"; + my $eval = "require $prereq"; eval $eval; - if ($@){ + + if ($@) { + warn "Warning: prerequisite $prereq failed to load: $@"; + } + elsif ($prereq->VERSION < $self->{PREREQ_PM}->{$prereq} ){ warn "Warning: prerequisite $prereq $self->{PREREQ_PM}->{$prereq} not found"; # Why is/was this 'delete' here? We need PREREQ_PM later to make PPDs. # } else { @@ -1183,7 +1135,7 @@ MakeMaker gives you much more freedom than needed to configure internal variables and get different results. It is worth to mention, that make(1) also lets you configure most of the variables that are used in the Makefile. But in the majority of situations this will not -be necessary, and should only be done, if the author of a package +be necessary, and should only be done if the author of a package recommends it (or you know what you're doing). =head2 Using Attributes and Parameters @@ -1598,9 +1550,9 @@ Makefile.PL. =item NEEDS_LINKING -MakeMaker will figure out, if an extension contains linkable code +MakeMaker will figure out if an extension contains linkable code anywhere down the directory tree, and will set this variable -accordingly, but you can speed it up a very little bit, if you define +accordingly, but you can speed it up a very little bit if you define this boolean variable yourself. =item NOECHO @@ -1615,7 +1567,7 @@ Boolean. Attribute to inhibit descending into subdirectories. =item NO_VC -In general any generated Makefile checks for the current version of +In general, any generated Makefile checks for the current version of MakeMaker and the version the Makefile was built under. If NO_VC is set, the version check is neglected. Do not write this into your Makefile.PL, use it interactively instead. @@ -1642,7 +1594,7 @@ to $(CC). =item PERL_ARCHLIB -Same as above for architecture dependent files +Same as above for architecture dependent files. =item PERL_LIB @@ -1699,14 +1651,14 @@ Defining PM in the Makefile.PL will override PMLIBDIRS. =item POLLUTE Release 5.005 grandfathered old global symbol names by providing preprocessor -macros for extension source compatibility. As of release 5.006, these +macros for extension source compatibility. As of release 5.6, these preprocessor definitions are not available by default. The POLLUTE flag specifies that the old names should still be defined: perl Makefile.PL POLLUTE=1 Please inform the module author if this is necessary to successfully install -a module under 5.006 or later. +a module under 5.6 or later. =item PPM_INSTALL_EXEC @@ -1736,8 +1688,8 @@ only check if any version is installed already. =item SKIP Arryref. E.g. [qw(name1 name2)] skip (do not write) sections of the -Makefile. Caution! Do not use the SKIP attribute for the neglectible -speedup. It may seriously damage the resulting Makefile. Only use it, +Makefile. Caution! Do not use the SKIP attribute for the negligible +speedup. It may seriously damage the resulting Makefile. Only use it if you really need it. =item TYPEMAPS @@ -1860,7 +1812,7 @@ NB: Extensions that have nothing but *.pm files had to say {LINKTYPE => ''} with Pre-5.0 MakeMakers. Since version 5.00 of MakeMaker such a line -can be deleted safely. MakeMaker recognizes, when there's nothing to +can be deleted safely. MakeMaker recognizes when there's nothing to be linked. =item macro @@ -1963,7 +1915,7 @@ details) =item make distclean does a realclean first and then the distcheck. Note that this is not -needed to build a new distribution as long as you are sure, that the +needed to build a new distribution as long as you are sure that the MANIFEST file is ok. =item make manifest diff --git a/lib/ExtUtils/Manifest.pm b/lib/ExtUtils/Manifest.pm index 52cfc2a..58c91bc 100644 --- a/lib/ExtUtils/Manifest.pm +++ b/lib/ExtUtils/Manifest.pm @@ -187,7 +187,6 @@ sub manicopy { require File::Basename; my(%dirs,$file); $target = VMS::Filespec::unixify($target) if $Is_VMS; - umask 0 unless $Is_VMS; File::Path::mkpath([ $target ],1,$Is_VMS ? undef : 0755); foreach $file (keys %$read){ $file = VMS::Filespec::unixify($file) if $Is_VMS; diff --git a/lib/ExtUtils/Mkbootstrap.pm b/lib/ExtUtils/Mkbootstrap.pm index 25c374c..323c3ab 100644 --- a/lib/ExtUtils/Mkbootstrap.pm +++ b/lib/ExtUtils/Mkbootstrap.pm @@ -81,8 +81,8 @@ C Mkbootstrap typically gets called from an extension Makefile. -There is no C<*.bs> file supplied with the extension. Instead a -C<*_BS> file which has code for the special cases, like posix for +There is no C<*.bs> file supplied with the extension. Instead, there may +be a C<*_BS> file which has code for the special cases, like posix for berkeley db on the NeXT. This file will get parsed, and produce a maybe empty diff --git a/lib/ExtUtils/Mksymlists.pm b/lib/ExtUtils/Mksymlists.pm index cfc1e7d..9dcedbf 100644 --- a/lib/ExtUtils/Mksymlists.pm +++ b/lib/ExtUtils/Mksymlists.pm @@ -78,7 +78,7 @@ sub _write_os2 { } my $distname = $data->{DISTNAME} || $data->{NAME}; $distname = "Distribution $distname"; - my $comment = "Perl (v$]$threaded) module $data->{NAME}"; + my $comment = "Perl (v$Config::Config{version}$threaded) module $data->{NAME}"; if ($data->{INSTALLDIRS} and $data->{INSTALLDIRS} eq 'perl') { $distname = 'perl5-porters@perl.org'; $comment = "Core $comment"; diff --git a/lib/ExtUtils/typemap b/lib/ExtUtils/typemap index d84435e..a34cd4f 100644 --- a/lib/ExtUtils/typemap +++ b/lib/ExtUtils/typemap @@ -251,7 +251,7 @@ T_REFOBJ T_OPAQUE sv_setpvn($arg, (char *)&$var, sizeof($var)); T_OPAQUEPTR - sv_setpvn($arg, (char *)$var, sizeof(*$var)), XFree((char *)$var); + sv_setpvn($arg, (char *)$var, sizeof(*$var)); T_PACKED XS_pack_$ntype($arg, $var); T_PACKEDARRAY diff --git a/lib/ExtUtils/xsubpp b/lib/ExtUtils/xsubpp index e5c7e09..ff9b452 100755 --- a/lib/ExtUtils/xsubpp +++ b/lib/ExtUtils/xsubpp @@ -6,10 +6,12 @@ xsubpp - compiler to convert Perl XS code into C code =head1 SYNOPSIS -B [B<-v>] [B<-C++>] [B<-except>] [B<-s pattern>] [B<-prototypes>] [B<-noversioncheck>] [B<-nolinenumbers>] [B<-typemap typemap>] ... file.xs +B [B<-v>] [B<-C++>] [B<-except>] [B<-s pattern>] [B<-prototypes>] [B<-noversioncheck>] [B<-nolinenumbers>] [B<-nooptimize>] [B<-typemap typemap>] ... file.xs =head1 DESCRIPTION +This compiler is typically run by the makefiles created by L. + I will compile XS code into C code by embedding the constructs necessary to let C functions manipulate Perl values and creates the glue necessary to let Perl access those functions. The compiler uses typemaps to @@ -23,13 +25,15 @@ typemap taking precedence. =head1 OPTIONS +Note that the C MakeMaker option may be used to add these options to +any makefiles generated by MakeMaker. + =over 5 =item B<-C++> Adds ``extern "C"'' to the C code. - =item B<-except> Adds exception handling stubs to the C code. @@ -59,6 +63,13 @@ number. Prevents the inclusion of `#line' directives in the output. +=item B<-nooptimize> + +Disables certain optimizations. The only optimization that is currently +affected is the use of Is by the output C code (see L). +This may significantly slow down the generated code, but this is the way +B of 5.005 and earlier operated. + =back =head1 ENVIRONMENT @@ -103,7 +114,7 @@ if ($^O eq 'VMS') { $FH = 'File0000' ; -$usage = "Usage: xsubpp [-v] [-C++] [-except] [-prototypes] [-noversioncheck] [-nolinenumbers] [-s pattern] [-typemap typemap]... file.xs\n"; +$usage = "Usage: xsubpp [-v] [-C++] [-except] [-prototypes] [-noversioncheck] [-nolinenumbers] [-nooptimize] [-s pattern] [-typemap typemap]... file.xs\n"; $proto_re = "[" . quotemeta('\$%&*@;') . "]" ; # mjn @@ -114,6 +125,7 @@ $WantPrototypes = -1 ; $WantVersionChk = 1 ; $ProtoUsed = 0 ; $WantLineNumbers = 1 ; +$WantOptimize = 1 ; SWITCH: while (@ARGV and $ARGV[0] =~ /^-./) { $flag = shift @ARGV; $flag =~ s/^-// ; @@ -129,7 +141,9 @@ SWITCH: while (@ARGV and $ARGV[0] =~ /^-./) { push(@tm,shift), next SWITCH if $flag eq 'typemap'; $WantLineNumbers = 0, next SWITCH if $flag eq 'nolinenumbers'; $WantLineNumbers = 1, next SWITCH if $flag eq 'linenumbers'; - (print "xsubpp version $XSUBPP_version\n"), exit + $WantOptimize = 0, next SWITCH if $flag eq 'nooptimize'; + $WantOptimize = 1, next SWITCH if $flag eq 'optimize'; + (print "xsubpp version $XSUBPP_version\n"), exit if $flag eq 'v'; die $usage; } @@ -235,6 +249,24 @@ foreach $key (keys %input_expr) { $input_expr{$key} =~ s/\n+$//; } +$bal = qr[(?:(?>[^()]+)|\((?p{ $bal })\))*]; # ()-balanced +$cast = qr[(?:\(\s*SV\s*\*\s*\)\s*)?]; # Optional (SV*) cast +$size = qr[,\s* (?p{ $bal }) ]x; # Third arg (to setpvn) + +foreach $key (keys %output_expr) { + use re 'eval'; + + my ($t, $with_size, $arg, $sarg) = + ($output_expr{$key} =~ + m[^ \s+ sv_set ( [iunp] ) v (n)? # Type, is_setpvn + \s* \( \s* $cast \$arg \s* , + \s* ( (?p{ $bal }) ) # Set from + ( (?p{ $size }) )? # Possible sizeof set-from + \) \s* ; \s* $ + ]x); + $targetable{$key} = [$t, $with_size, $arg, $sarg] if $t; +} + $END = "!End!\n\n"; # "impossible" keyword (multiple newline) # Match an XS keyword @@ -367,7 +399,17 @@ sub INPUT_handler { $thisdone |= $var_name eq "THIS"; $retvaldone |= $var_name eq "RETVAL"; $var_types{$var_name} = $var_type; - print "\t" . &map_type($var_type); + # XXXX This check is a safeguard against the unfinished conversion of + # generate_init(). When generate_init() is fixed, + # one can use 2-args map_type() unconditionally. + if ($var_type =~ / \( \s* \* \s* \) /x) { + # Function pointers are not yet supported with &output_init! + print "\t" . &map_type($var_type, $var_name); + $name_printed = 1; + } else { + print "\t" . &map_type($var_type); + $name_printed = 0; + } $var_num = $args_match{$var_name}; $proto_arg[$var_num] = ProtoString($var_type) @@ -377,12 +419,16 @@ sub INPUT_handler { $func_args =~ s/\b($var_name)\b/&$1/; } if ($var_init =~ /^[=;]\s*NO_INIT\s*;?\s*$/) { + if ($name_printed) { + print ";\n"; + } else { print "\t$var_name;\n"; + } } elsif ($var_init =~ /\S/) { - &output_init($var_type, $var_num, $var_name, $var_init); + &output_init($var_type, $var_num, $var_name, $var_init, $name_printed); } elsif ($var_num) { # generate initialization code - &generate_init($var_type, $var_num, $var_name); + &generate_init($var_type, $var_num, $var_name, $name_printed); } else { print ";\n"; } @@ -1081,10 +1127,12 @@ EOF $_ = '' ; } else { if ($ret_type ne "void") { - print "\t" . &map_type($ret_type) . "\tRETVAL;\n" + print "\t" . &map_type($ret_type, 'RETVAL') . ";\n" if !$retvaldone; $args_match{"RETVAL"} = 0; $var_types{"RETVAL"} = $ret_type; + print "\tdXSTARG;\n" + if $WantOptimize and $targetable{$type_kind{$ret_type}}; } print $deferred; @@ -1137,8 +1185,32 @@ EOF if ($gotRETVAL && $RETVAL_code) { print "\t$RETVAL_code\n"; } elsif ($gotRETVAL || $wantRETVAL) { - # RETVAL almost never needs SvSETMAGIC() - &generate_output($ret_type, 0, 'RETVAL', 0); + my $t = $WantOptimize && $targetable{$type_kind{$ret_type}}; + my $var = 'RETVAL'; + my $type = $ret_type; + + # 0: type, 1: with_size, 2: how, 3: how_size + if ($t and not $t->[1] and $t->[0] eq 'p') { + # PUSHp corresponds to setpvn. Treate setpv directly + my $what = eval qq("$t->[2]"); + warn $@ if $@; + + print "\tsv_setpv(TARG, $what); XSprePUSH; PUSHTARG;\n"; + } + elsif ($t) { + my $what = eval qq("$t->[2]"); + warn $@ if $@; + + my $size = $t->[3]; + $size = '' unless defined $size; + $size = eval qq("$size"); + warn $@ if $@; + print "\tXSprePUSH; PUSH$t->[0]($what$size);\n"; + } + else { + # RETVAL almost never needs SvSETMAGIC() + &generate_output($ret_type, 0, 'RETVAL', 0); + } } # do cleanup @@ -1305,15 +1377,22 @@ warn("Please specify prototyping behavior for $filename (see perlxs manual)\n") &Exit; sub output_init { - local($type, $num, $var, $init) = @_; + local($type, $num, $var, $init, $name_printed) = @_; local($arg) = "ST(" . ($num - 1) . ")"; if( $init =~ /^=/ ) { - eval qq/print "\\t$var $init\\n"/; + if ($name_printed) { + eval qq/print " $init\\n"/; + } else { + eval qq/print "\\t$var $init\\n"/; + } warn $@ if $@; } else { if( $init =~ s/^\+// && $num ) { - &generate_init($type, $num, $var); + &generate_init($type, $num, $var, $name_printed); + } elsif ($name_printed) { + print ";\n"; + $init =~ s/^;//; } else { eval qq/print "\\t$var;\\n"/; warn $@ if $@; @@ -1382,16 +1461,26 @@ sub generate_init { if (defined($defaults{$var})) { $expr =~ s/(\t+)/$1 /g; $expr =~ s/ /\t/g; - eval qq/print "\\t$var;\\n"/; - warn $@ if $@; + if ($name_printed) { + print ";\n"; + } else { + eval qq/print "\\t$var;\\n"/; + warn $@ if $@; + } $deferred .= eval qq/"\\n\\tif (items < $num)\\n\\t $var = $defaults{$var};\\n\\telse {\\n$expr;\\n\\t}\\n"/; warn $@ if $@; } elsif ($ScopeThisXSUB or $expr !~ /^\t\$var =/) { - eval qq/print "\\t$var;\\n"/; - warn $@ if $@; + if ($name_printed) { + print ";\n"; + } else { + eval qq/print "\\t$var;\\n"/; + warn $@ if $@; + } $deferred .= eval qq/"\\n$expr;\\n"/; warn $@ if $@; } else { + die "panic: do not know how to handle this branch for function pointers" + if $name_printed; eval qq/print "$expr;\\n"/; warn $@ if $@; } @@ -1405,7 +1494,7 @@ sub generate_output { $type = TidyType($type) ; if ($type =~ /^array\(([^,]*),(.*)\)/) { - print "\tsv_setpvn($arg, (char *)$var, $2 * sizeof($1)), XFree((char *)$var);\n"; + print "\tsv_setpvn($arg, (char *)$var, $2 * sizeof($1));\n"; print "\tSvSETMAGIC($arg);\n" if $do_setmagic; } else { blurt("Error: '$type' not in typemap"), return @@ -1468,10 +1557,17 @@ sub generate_output { } sub map_type { - my($type) = @_; + my($type, $varname) = @_; $type =~ tr/:/_/; $type =~ s/^array\(([^,]*),(.*)\).*/$1 */s; + if ($varname) { + if ($varname && $type =~ / \( \s* \* (?= \s* \) ) /xg) { + (substr $type, pos $type, 0) = " $varname "; + } else { + $type .= "\t$varname"; + } + } $type; } diff --git a/lib/File/Copy.pm b/lib/File/Copy.pm index fd812bc..8df54e5 100644 --- a/lib/File/Copy.pm +++ b/lib/File/Copy.pm @@ -10,14 +10,14 @@ package File::Copy; use strict; use Carp; use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION $Too_Big - © &syscopy &cp &mv); + © &syscopy &cp &mv $Syscopy_is_copy); # Note that this module implements only *part* of the API defined by # the File/Copy.pm module of the File-Tools-2.0 package. However, that # package has not yet been updated to work with Perl 5.004, and so it # would be a Bad Thing for the CPAN module to grab it and replace this # module. Therefore, we set this module's version higher than 2.0. -$VERSION = '2.02'; +$VERSION = '2.03'; require Exporter; @ISA = qw(Exporter); @@ -60,12 +60,12 @@ sub copy { $to = _catname($from, $to); } - if (defined &syscopy && \&syscopy != \© + if (defined &syscopy && !$Syscopy_is_copy && !$to_a_handle && !($from_a_handle && $^O eq 'os2' ) # OS/2 cannot handle handles && !($from_a_handle && $^O eq 'mpeix') # and neither can MPE/iX. && !($from_a_handle && $^O eq 'MSWin32') - ) + ) { return syscopy($from, $to); } @@ -83,16 +83,16 @@ sub copy { open(FROM, "< $from\0") or goto fail_open1; binmode FROM or die "($!,$^E)"; $closefrom = 1; - } - + } + if ($to_a_handle) { *TO = *$to{FILEHANDLE}; - } else { + } else { $to = "./$to" if $to =~ /^\s/; open(TO,"> $to\0") or goto fail_open2; binmode TO or die "($!,$^E)"; $closeto = 1; - } + } if (@_) { $size = shift(@_) + 0; @@ -120,7 +120,7 @@ sub copy { # Use this idiom to avoid uninitialized value warning. return 1; - + # All of these contortions try to preserve error messages... fail_inner: if ($closeto) { @@ -163,10 +163,10 @@ sub move { (($tosz2,$tomt2) = (stat($to))[7,9]) && # $to's there ($tosz1 != $tosz2 or $tomt1 != $tomt2) && # and changed $tosz2 == $fromsz; # it's all there - + ($tosz1,$tomt1) = (stat($to))[7,9]; # just in case rename did something return 1 if ($copied = copy($from,$to)) && unlink($from); - + ($tosz2,$tomt2) = ((stat($to))[7,9],0,0) if defined $tomt1; unlink($to) if !defined($tomt1) or $tomt1 != $tomt2 or $tosz1 != $tosz2; ($!,$^E) = ($sts,$ossts); @@ -193,6 +193,7 @@ unless (defined &syscopy) { return Win32::CopyFile(@_, 1); }; } else { + $Syscopy_is_copy = 1; *syscopy = \© } } diff --git a/lib/File/DosGlob.pm b/lib/File/DosGlob.pm index 594ee2e..e6fc311 100644 --- a/lib/File/DosGlob.pm +++ b/lib/File/DosGlob.pm @@ -206,7 +206,7 @@ pandering to DOS habits. Needs a dose of optimizium too. =head1 AUTHOR -Gurusamy Sarathy +Gurusamy Sarathy =head1 HISTORY diff --git a/lib/File/Find.pm b/lib/File/Find.pm index 28e2e90..c674b2c 100644 --- a/lib/File/Find.pm +++ b/lib/File/Find.pm @@ -1,5 +1,5 @@ package File::Find; -require 5.000; +require 5.005; require Exporter; require Cwd; @@ -12,70 +12,163 @@ finddepth - traverse a directory structure depth-first =head1 SYNOPSIS use File::Find; - find(\&wanted, '/foo','/bar'); + find(\&wanted, '/foo', '/bar'); sub wanted { ... } use File::Find; - finddepth(\&wanted, '/foo','/bar'); + finddepth(\&wanted, '/foo', '/bar'); sub wanted { ... } + + use File::Find; + find({ wanted => \&process, follow => 1 }, '.'); =head1 DESCRIPTION The first argument to find() is either a hash reference describing the -operations to be performed for each file, a code reference, or a string -that contains a subroutine name. If it is a hash reference, then the -value for the key C should be a code reference. This code -reference is called I below. +operations to be performed for each file, or a code reference. -Currently the only other supported key for the above hash is -C, in presense of which the walk over directories is -performed depth-first. Entry point finddepth() is a shortcut for -specifying C<{ bydepth => 1}> in the first argument of find(). +Here are the possible keys for the hash: + +=over 3 + +=item C + +The value should be a code reference. This code reference is called +I below. + +=item C + +Reports the name of a directory only AFTER all its entries +have been reported. Entry point finddepth() is a shortcut for +specifying C<{ bydepth => 1 }> in the first argument of find(). + +=item C + +Causes symbolic links to be followed. Since directory trees with symbolic +links (followed) may contain files more than once and may even have +cycles, a hash has to be built up with an entry for each file. +This might be expensive both in space and time for a large +directory tree. See I and I below. +If either I or I is in effect: + +=over 6 + +=item + +It is guarantueed that an I has been called before the user's +I function is called. This enables fast file checks involving S< _>. + +=item + +There is a variable C<$File::Find::fullname> which holds the absolute +pathname of the file with all symbolic links resolved + +=back + +=item C + +This is similar to I except that it may report some files +more than once. It does detect cycles however. +Since only symbolic links have to be hashed, this is +much cheaper both in space and time. +If processing a file more than once (by the user's I function) +is worse than just taking time, the option I should be used. + +=item C + +C, which is the default, causes all files which are +neither directories nor symbolic links to be ignored if they are about +to be processed a second time. If a directory or a symbolic link +are about to be processed a second time, File::Find dies. +C causes File::Find to die if any file is about to be +processed a second time. +C causes File::Find to ignore any duplicate files and +dirctories but to proceed normally otherwise. -The wanted() function does whatever verifications you want. -$File::Find::dir contains the current directory name, and $_ the -current filename within that directory. $File::Find::name contains -C<"$File::Find::dir/$_">. You are chdir()'d to $File::Find::dir when -the function is called. The function may set $File::Find::prune to -prune the tree. -File::Find assumes that you don't alter the $_ variable. If you do then -make sure you return it to its original value before exiting your function. +=item C + +Does not C to each directory as it recurses. The wanted() +function will need to be aware of this, of course. In this case, +C<$_> will be the same as C<$File::Find::name>. + +=item C + +If find is used in taint-mode (-T command line switch or if EUID != UID +or if EGID != GID) then internally directory names have to be untainted +before they can be cd'ed to. Therefore they are checked against a regular +expression I. Note, that all names passed to the +user's I function are still tainted. + +=item C + +See above. This should be set using the C quoting operator. +The default is set to C. +Note that the paranthesis which are vital. + +=item C + +If set, directories (subtrees) which fail the I +are skipped. The default is to 'die' in such a case. + +=back + +The wanted() function does whatever verifications you want. +C<$File::Find::dir> contains the current directory name, and C<$_> the +current filename within that directory. C<$File::Find::name> contains +the complete pathname to the file. You are chdir()'d to C<$File::Find::dir> when +the function is called, unless C was specified. +When or are in effect there is also a +C<$File::Find::fullname>. +The function may set C<$File::Find::prune> to prune the tree +unless C was specified. +Unless C or C is specified, for compatibility +reasons (find.pl, find2perl) there are in addition the following globals +available: C<$File::Find::topdir>, C<$File::Find::topdev>, C<$File::Find::topino>, +C<$File::Find::topmode> and C<$File::Find::topnlink>. This library is useful for the C tool, which when fed, find2perl / -name .nfs\* -mtime +7 \ - -exec rm -f {} \; -o -fstype nfs -prune + -exec rm -f {} \; -o -fstype nfs -prune produces something like: sub wanted { /^\.nfs.*$/ && - (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) && + (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_)) && int(-M _) > 7 && unlink($_) || - ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) && + ($nlink || (($dev, $ino, $mode, $nlink, $uid, $gid) = lstat($_))) && $dev < 0 && ($File::Find::prune = 1); } -Set the variable $File::Find::dont_use_nlink if you're using AFS, +Set the variable C<$File::Find::dont_use_nlink> if you're using AFS, since AFS cheats. -C is just like C, except that it does a depth-first -search. Here's another interesting wanted function. It will find all symlinks that don't resolve: sub wanted { - -l && !-e && print "bogus link: $File::Find::name\n"; + -l && !-e && print "bogus link: $File::Find::name\n"; } -=head1 BUGS +See also the script C on CPAN for a nice application of this +module. + +=head1 CAVEAT + +Be aware that the option to follow symblic links can be dangerous. +Depending on the structure of the directory tree (including symbolic +links to directories) you might traverse a given (physical) directory +more than once (only if C is in effect). +Furthermore, deleting or changing files in a symbolically linked directory +might cause very unpleasant surprises, since you delete or change files +in an unknown directory. -There is no way to make find or finddepth follow symlinks. =cut @@ -83,151 +176,522 @@ There is no way to make find or finddepth follow symlinks. @EXPORT = qw(find finddepth); -sub find_opt { - my $wanted = shift; - my $bydepth = $wanted->{bydepth}; - my $cwd = $bydepth ? Cwd::fastcwd() : Cwd::cwd(); - # Localize these rather than lexicalizing them for backwards - # compatibility. - local($topdir,$topdev,$topino,$topmode,$topnlink); - foreach $topdir (@_) { - (($topdev,$topino,$topmode,$topnlink) = - ($Is_VMS ? stat($topdir) : lstat($topdir))) - || (warn("Can't stat $topdir: $!\n"), next); - if (-d _) { - if (chdir($topdir)) { - $prune = 0; - unless ($bydepth) { - ($dir,$_) = ($topdir,'.'); - $name = $topdir; - $wanted->{wanted}->(); - } - next if $prune; - my $fixtopdir = $topdir; - $fixtopdir =~ s,/$,, ; - $fixtopdir =~ s/\.dir$// if $Is_VMS; - &finddir($wanted,$fixtopdir,$topnlink, $bydepth); - if ($bydepth) { - ($dir,$_) = ($fixtopdir,'.'); - $name = $fixtopdir; - $wanted->{wanted}->(); - } +use strict; +my $Is_VMS; + +require File::Basename; + +my %SLnkSeen; +my ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow, + $follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat); + +sub contract_name { + my ($cdir,$fn) = @_; + + return substr($cdir,0,rindex($cdir,'/')) if $fn eq '.'; + + $cdir = substr($cdir,0,rindex($cdir,'/')+1); + + $fn =~ s|^\./||; + + my $abs_name= $cdir . $fn; + + if (substr($fn,0,3) eq '../') { + do 1 while ($abs_name=~ s|/(?>[^/]+)/\.\./|/|); + } + + return $abs_name; +} + + +sub PathCombine($$) { + my ($Base,$Name) = @_; + my $AbsName; + + if (substr($Name,0,1) eq '/') { + $AbsName= $Name; + } + else { + $AbsName= contract_name($Base,$Name); + } + + # (simple) check for recursion + my $newlen= length($AbsName); + if ($newlen <= length($Base)) { + if (($newlen == length($Base) || substr($Base,$newlen,1) eq '/') + && $AbsName eq substr($Base,0,$newlen)) + { + return undef; + } + } + return $AbsName; +} + +sub Follow_SymLink($) { + my ($AbsName) = @_; + + my ($NewName,$DEV, $INO); + ($DEV, $INO)= lstat $AbsName; + + while (-l _) { + if ($SLnkSeen{$DEV, $INO}++) { + if ($follow_skip < 2) { + die "$AbsName is encountered a second time"; } else { - warn "Can't cd to $topdir: $!\n"; + return undef; } } - else { - require File::Basename; - unless (($_,$dir) = File::Basename::fileparse($topdir)) { - ($dir,$_) = ('.', $topdir); + $NewName= PathCombine($AbsName, readlink($AbsName)); + unless(defined $NewName) { + if ($follow_skip < 2) { + die "$AbsName is a recursive symbolic link"; + } + else { + return undef; } - if (chdir($dir)) { - $name = $topdir; - $wanted->{wanted}->(); + } + else { + $AbsName= $NewName; + } + ($DEV, $INO) = lstat($AbsName); + return undef unless defined $DEV; # dangling symbolic link + } + + if ($full_check && $SLnkSeen{$DEV, $INO}++) { + if ($follow_skip < 1) { + die "$AbsName encountered a second time"; + } + else { + return undef; + } + } + + return $AbsName; +} + +use vars qw/ $dir $name $fullname $prune /; +sub _find_dir_symlnk($$$); +sub _find_dir($$$); + +sub _find_opt { + my $wanted = shift; + die "invalid top directory" unless defined $_[0]; + + my $cwd = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::cwd(); + my $cwd_untainted = $cwd; + $wanted_callback = $wanted->{wanted}; + $bydepth = $wanted->{bydepth}; + $no_chdir = $wanted->{no_chdir}; + $full_check = $wanted->{follow}; + $follow = $full_check || $wanted->{follow_fast}; + $follow_skip = $wanted->{follow_skip}; + $untaint = $wanted->{untaint}; + $untaint_pat = $wanted->{untaint_pattern}; + $untaint_skip = $wanted->{untaint_skip}; + + # for compatability reasons (find.pl, find2perl) + our ($topdir, $topdev, $topino, $topmode, $topnlink); + + # a symbolic link to a directory doesn't increase the link count + $avoid_nlink = $follow || $File::Find::dont_use_nlink; + + if ( $untaint ) { + $cwd_untainted= $1 if $cwd_untainted =~ m|$untaint_pat|; + die "insecure cwd in find(depth)" unless defined($cwd_untainted); + } + + my ($abs_dir, $Is_Dir); + + Proc_Top_Item: + foreach my $TOP (@_) { + my $top_item = $TOP; + $top_item =~ s|/$|| unless $top_item eq '/'; + $Is_Dir= 0; + + if ($follow) { + if (substr($top_item,0,1) eq '/') { + $abs_dir = $top_item; + } + elsif ($top_item eq '.') { + $abs_dir = $cwd; } + else { # care about any ../ + $abs_dir = contract_name("$cwd/",$top_item); + } + $abs_dir= Follow_SymLink($abs_dir); + unless (defined $abs_dir) { + warn "$top_item is a dangling symbolic link\n"; + next Proc_Top_Item; + } + if (-d _) { + _find_dir_symlnk($wanted, $abs_dir, $top_item); + $Is_Dir= 1; + } + } + else { # no follow + $topdir = $top_item; + ($topdev,$topino,$topmode,$topnlink) = lstat $top_item; + unless (defined $topnlink) { + warn "Can't stat $top_item: $!\n"; + next Proc_Top_Item; + } + if (-d _) { + $top_item =~ s/\.dir$// if $Is_VMS; + _find_dir($wanted, $top_item, $topnlink); + $Is_Dir= 1; + } else { - warn "Can't cd to $dir: $!\n"; + $abs_dir= $top_item; + } + } + + unless ($Is_Dir) { + unless (($_,$dir) = File::Basename::fileparse($abs_dir)) { + ($dir,$_) = ('.', $top_item); + } + + $abs_dir = $dir; + if ($untaint) { + my $abs_dir_save = $abs_dir; + $abs_dir = $1 if $abs_dir =~ m|$untaint_pat|; + unless (defined $abs_dir) { + if ($untaint_skip == 0) { + die "directory $abs_dir_save is still tainted"; + } + else { + next Proc_Top_Item; + } + } + } + + unless ($no_chdir or chdir $abs_dir) { + warn "Couldn't chdir $abs_dir: $!\n"; + next Proc_Top_Item; + } + + $name = $abs_dir; + + &$wanted_callback; + + } + + $no_chdir or chdir $cwd_untainted; + } +} + +# API: +# $wanted +# $p_dir : "parent directory" +# $nlink : what came back from the stat +# preconditions: +# chdir (if not no_chdir) to dir + +sub _find_dir($$$) { + my ($wanted, $p_dir, $nlink) = @_; + my ($CdLvl,$Level) = (0,0); + my @Stack; + my @filenames; + my ($subcount,$sub_nlink); + my $SE= []; + my $dir_name= $p_dir; + my $dir_pref= ( $p_dir eq '/' ? '/' : "$p_dir/" ); + my $dir_rel= '.'; # directory name relative to current directory + + local ($dir, $name, $prune, *DIR); + + unless ($no_chdir or $p_dir eq '.') { + my $udir = $p_dir; + if ($untaint) { + $udir = $1 if $p_dir =~ m|$untaint_pat|; + unless (defined $udir) { + if ($untaint_skip == 0) { + die "directory $p_dir is still tainted"; + } + else { + return; + } } } + unless (chdir $udir) { + warn "Can't cd to $udir: $!\n"; + return; + } + } + + while (defined $SE) { + unless ($bydepth) { + $dir= $p_dir; + $name= $dir_name; + $_= ($no_chdir ? $dir_name : $dir_rel ); + # prune may happen here + $prune= 0; + &$wanted_callback; + next if $prune; + } + + # change to that directory + unless ($no_chdir or $dir_rel eq '.') { + my $udir= $dir_rel; + if ($untaint) { + $udir = $1 if $dir_rel =~ m|$untaint_pat|; + unless (defined $udir) { + if ($untaint_skip == 0) { + die "directory (" + . ($p_dir ne '/' ? $p_dir : '') + . "/) $dir_rel is still tainted"; + } + } + } + unless (chdir $udir) { + warn "Can't cd to (" + . ($p_dir ne '/' ? $p_dir : '') + . "/) $udir : $!\n"; + next; + } + $CdLvl++; + } + + $dir= $dir_name; + + # Get the list of files in the current directory. + unless (opendir DIR, ($no_chdir ? $dir_name : '.')) { + warn "Can't opendir($dir_name): $!\n"; + next; + } + @filenames = readdir DIR; + closedir(DIR); + + if ($nlink == 2 && !$avoid_nlink) { + # This dir has no subdirectories. + for my $FN (@filenames) { + next if $FN =~ /^\.{1,2}$/; + + $name = $dir_pref . $FN; + $_ = ($no_chdir ? $name : $FN); + &$wanted_callback; + } + + } + else { + # This dir has subdirectories. + $subcount = $nlink - 2; + + for my $FN (@filenames) { + next if $FN =~ /^\.{1,2}$/; + if ($subcount > 0 || $avoid_nlink) { + # Seen all the subdirs? + # check for directoriness. + # stat is faster for a file in the current directory + $sub_nlink = (lstat ($no_chdir ? $dir_pref . $FN : $FN))[3]; + + if (-d _) { + --$subcount; + $FN =~ s/\.dir$// if $Is_VMS; + push @Stack,[$CdLvl,$dir_name,$FN,$sub_nlink]; + } + else { + $name = $dir_pref . $FN; + $_= ($no_chdir ? $name : $FN); + &$wanted_callback; + } + } + else { + $name = $dir_pref . $FN; + $_= ($no_chdir ? $name : $FN); + &$wanted_callback; + } + } + } + if ($bydepth) { + $name = $dir_name; + $dir = $p_dir; + $_ = ($no_chdir ? $dir_name : $dir_rel ); + &$wanted_callback; + } } continue { - chdir $cwd; + if ( defined ($SE = pop @Stack) ) { + ($Level, $p_dir, $dir_rel, $nlink) = @$SE; + if ($CdLvl > $Level && !$no_chdir) { + die "Can't cd to $dir_name" . '../' x ($CdLvl-$Level) + unless chdir '../' x ($CdLvl-$Level); + $CdLvl = $Level; + } + $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel"); + $dir_pref = "$dir_name/"; + } } } -sub finddir { - my($wanted, $nlink, $bydepth); - local($dir, $name); - ($wanted, $dir, $nlink, $bydepth) = @_; - - my($dev, $ino, $mode, $subcount); - - # Get the list of files in the current directory. - opendir(DIR,'.') || (warn("Can't open $dir: $!\n"), $bydepth || return); - my(@filenames) = readdir(DIR); - closedir(DIR); - - if ($nlink == 2 && !$dont_use_nlink) { # This dir has no subdirectories. - for (@filenames) { - next if $_ eq '.'; - next if $_ eq '..'; - $name = "$dir/$_"; - $nlink = 0; - $wanted->{wanted}->(); - } - } - else { # This dir has subdirectories. - $subcount = $nlink - 2; - for (@filenames) { - next if $_ eq '.'; - next if $_ eq '..'; - $nlink = 0; - $prune = 0 unless $bydepth; - $name = "$dir/$_"; - $wanted->{wanted}->() unless $bydepth; - if ($subcount > 0 || $dont_use_nlink) { # Seen all the subdirs? - - # Get link count and check for directoriness. - - $_ = "" if (!defined($_)); - ($dev,$ino,$mode,$nlink) = ($Is_VMS ? stat($_) : lstat($_)); - # unless ($nlink || $dont_use_nlink); - - if (-d _) { - - # It really is a directory, so do it recursively. - - --$subcount; - next if $prune; - if (chdir $_) { - $name =~ s/\.dir$// if $Is_VMS; - &finddir($wanted,$name,$nlink, $bydepth); - chdir '..'; + +# API: +# $wanted +# $dir_loc : absolute location of a dir +# $p_dir : "parent directory" +# preconditions: +# chdir (if not no_chdir) to dir + +sub _find_dir_symlnk($$$) { + my ($wanted, $dir_loc, $p_dir) = @_; + my @Stack; + my @filenames; + my $new_loc; + my $SE = []; + my $dir_name = $p_dir; + my $dir_pref = ( $p_dir eq '/' ? '/' : "$p_dir/" ); + my $loc_pref = ( $dir_loc eq '/' ? '/' : "$dir_loc/" ); + my $dir_rel = '.'; # directory name relative to current directory + + local ($dir, $name, $fullname, $prune, *DIR); + + unless ($no_chdir or $p_dir eq '.') { + my $udir = $dir_loc; + if ($untaint) { + $udir = $1 if $dir_loc =~ m|$untaint_pat|; + unless (defined $udir) { + if ($untaint_skip == 0) { + die "directory $dir_loc is still tainted"; + } + else { + return; + } + } + } + unless (chdir $udir) { + warn "Can't cd to $udir: $!\n"; + return; + } + } + + while (defined $SE) { + + unless ($bydepth) { + $dir= $p_dir; + $name= $dir_name; + $_= ($no_chdir ? $dir_name : $dir_rel ); + $fullname= $dir_loc; + # prune may happen here + $prune= 0; + &$wanted_callback; + next if $prune; + } + + # change to that directory + unless ($no_chdir or $dir_rel eq '.') { + my $udir = $dir_loc; + if ($untaint) { + $udir = $1 if $dir_loc =~ m|$untaint_pat|; + unless (defined $udir ) { + if ($untaint_skip == 0) { + die "directory $dir_loc is still tainted"; } else { - warn "Can't cd to $_: $!\n"; + next; } } } - $wanted->{wanted}->() if $bydepth; + unless (chdir $udir) { + warn "Can't cd to $udir: $!\n"; + next; + } + } + + $dir = $dir_name; + + # Get the list of files in the current directory. + unless (opendir DIR, ($no_chdir ? $dir_loc : '.')) { + warn "Can't opendir($dir_loc): $!\n"; + next; + } + @filenames = readdir DIR; + closedir(DIR); + + for my $FN (@filenames) { + next if $FN =~ /^\.{1,2}$/; + + # follow symbolic links / do an lstat + $new_loc = Follow_SymLink($loc_pref.$FN); + + # ignore if invalid symlink + next unless defined $new_loc; + + if (-d _) { + push @Stack,[$new_loc,$dir_name,$FN]; + } + else { + $fullname = $new_loc; + $name = $dir_pref . $FN; + $_ = ($no_chdir ? $name : $FN); + &$wanted_callback; + } + } + + if ($bydepth) { + $fullname = $dir_loc; + $name = $dir_name; + $_ = ($no_chdir ? $dir_name : $dir_rel); + &$wanted_callback; + } + } + continue { + if (defined($SE = pop @Stack)) { + ($dir_loc, $p_dir, $dir_rel) = @$SE; + $dir_name = ($p_dir eq '/' ? "/$dir_rel" : "$p_dir/$dir_rel"); + $dir_pref = "$dir_name/"; + $loc_pref = "$dir_loc/"; } } } + sub wrap_wanted { - my $wanted = shift; - ref($wanted) eq 'HASH' ? $wanted : { wanted => $wanted }; + my $wanted = shift; + if ( ref($wanted) eq 'HASH' ) { + if ( $wanted->{follow} || $wanted->{follow_fast}) { + $wanted->{follow_skip} = 1 unless defined $wanted->{follow_skip}; + } + if ( $wanted->{untaint} ) { + $wanted->{untaint_pattern} = qr|^([-+@\w./]+)$| + unless defined $wanted->{untaint_pattern}; + $wanted->{untaint_skip} = 0 unless defined $wanted->{untaint_skip}; + } + return $wanted; + } + else { + return { wanted => $wanted }; + } } sub find { - my $wanted = shift; - find_opt(wrap_wanted($wanted), @_); + my $wanted = shift; + _find_opt(wrap_wanted($wanted), @_); + %SLnkSeen= (); # free memory } sub finddepth { - my $wanted = wrap_wanted(shift); - $wanted->{bydepth} = 1; - find_opt($wanted, @_); + my $wanted = wrap_wanted(shift); + $wanted->{bydepth} = 1; + _find_opt($wanted, @_); + %SLnkSeen= (); # free memory } # These are hard-coded for now, but may move to hint files. if ($^O eq 'VMS') { - $Is_VMS = 1; - $dont_use_nlink = 1; + $Is_VMS = 1; + $File::Find::dont_use_nlink = 1; } -$dont_use_nlink = 1 +$File::Find::dont_use_nlink = 1 if $^O eq 'os2' || $^O eq 'dos' || $^O eq 'amigaos' || $^O eq 'MSWin32'; # Set dont_use_nlink in your hint file if your system's stat doesn't # report the number of links in a directory as an indication # of the number of files. # See, e.g. hints/machten.sh for MachTen 2.2. -unless ($dont_use_nlink) { - require Config; - $dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'}); +unless ($File::Find::dont_use_nlink) { + require Config; + $File::Find::dont_use_nlink = 1 if ($Config::Config{'dont_use_nlink'}); } 1; - diff --git a/lib/File/Path.pm b/lib/File/Path.pm index 7290372..634b2cd 100644 --- a/lib/File/Path.pm +++ b/lib/File/Path.pm @@ -2,15 +2,14 @@ package File::Path; =head1 NAME -File::Path - create or remove a series of directories +File::Path - create or remove directory trees =head1 SYNOPSIS -C + use File::Path; -C - -C + mkpath(['/foo/bar/baz', 'blurfl/quux'], 1, 0711); + rmtree(['foo/bar/baz', 'blurfl/quux'], 1, 1); =head1 DESCRIPTION @@ -127,13 +126,15 @@ sub mkpath { my $parent = File::Basename::dirname($path); # Allow for creation of new logical filesystems under VMS if (not $Is_VMS or $parent !~ m:/[^/]+/000000/?:) { - push(@created,mkpath($parent, $verbose, $mode)) unless (-d $parent); + unless (-d $parent or $path eq $parent) { + push(@created,mkpath($parent, $verbose, $mode)); + } } print "mkdir $path\n" if $verbose; unless (mkdir($path,$mode)) { - my $e = $!; - # allow for another process to have created it meanwhile - croak "mkdir $path: $e" unless -d $path; + my $e = $!; + # allow for another process to have created it meanwhile + croak "mkdir $path: $e" unless -d $path; } push(@created, $path); } diff --git a/lib/File/Spec.pm b/lib/File/Spec.pm index b71e357..40f5345 100644 --- a/lib/File/Spec.pm +++ b/lib/File/Spec.pm @@ -86,4 +86,7 @@ Kenneth Albanowski >, Andy Dougherty >, Tim Bunce >. VMS support by Charles Bailey >. OS/2 support by Ilya Zakharevich >. Mac support by Paul Schinder ->. +>. abs2rel() and rel2abs() written by +Shigio Yamaguchi >, modified by Barrie Slaymaker +>. splitpath(), splitdir(), catpath() and catdir() +by Barrie Slaymaker. diff --git a/lib/File/Spec/Unix.pm b/lib/File/Spec/Unix.pm index 87ad643..85df2c2 100644 --- a/lib/File/Spec/Unix.pm +++ b/lib/File/Spec/Unix.pm @@ -41,7 +41,7 @@ ricochet (some scripts depend on it). sub canonpath { my ($self,$path,$reduce_ricochet) = @_; - $path =~ s|/+|/|g unless($^O =~ /cygwin/); # xx////xx -> xx/xx + $path =~ s|/+|/|g unless($^O eq 'cygwin'); # xx////xx -> xx/xx $path =~ s|(/\.)+/|/|g; # xx/././xx -> xx/xx $path =~ s|^(\./)+|| unless $path eq "./"; # ./xx -> xx $path =~ s|^/(\.\./)+|/|; # /../../xx -> xx diff --git a/lib/FindBin.pm b/lib/FindBin.pm index 9e1c0a0..9d35f6f 100644 --- a/lib/FindBin.pm +++ b/lib/FindBin.pm @@ -82,7 +82,7 @@ use File::Spec; %EXPORT_TAGS = (ALL => [qw($Bin $Script $RealBin $RealScript $Dir $RealDir)]); @ISA = qw(Exporter); -$VERSION = $VERSION = "1.42"; +$VERSION = "1.42"; BEGIN { diff --git a/lib/Getopt/Std.pm b/lib/Getopt/Std.pm index 390bf14..e027bad 100644 --- a/lib/Getopt/Std.pm +++ b/lib/Getopt/Std.pm @@ -42,7 +42,7 @@ the argument or 1 if no argument is specified. @ISA = qw(Exporter); @EXPORT = qw(getopt getopts); -$VERSION = $VERSION = '1.01'; +$VERSION = '1.01'; # Process single-character switches with switch clustering. Pass one argument # which is a string containing all switches that take an argument. For each diff --git a/lib/Math/BigFloat.pm b/lib/Math/BigFloat.pm index 8aa6a66..1a9195e 100644 --- a/lib/Math/BigFloat.pm +++ b/lib/Math/BigFloat.pm @@ -240,12 +240,13 @@ sub fcmp #(fnum_str, fnum_str) return cond_code if ($x eq "NaN" || $y eq "NaN") { undef; } else { + local($xm,$xe,$ym,$ye) = split('E', $x."E$y"); + if ($xm eq '+0' || $ym eq '+0') { + return $xm <=> $ym; + } ord($y) <=> ord($x) - || - ( local($xm,$xe,$ym,$ye) = split('E', $x."E$y"), - (($xe <=> $ye) * (substr($x,$[,1).'1') - || Math::BigInt::cmp($xm,$ym)) - ); + || ($xe <=> $ye) * (substr($x,$[,1).'1') + || Math::BigInt::cmp($xm,$ym); } } diff --git a/lib/Math/Complex.pm b/lib/Math/Complex.pm index 5b69039..b339573 100644 --- a/lib/Math/Complex.pm +++ b/lib/Math/Complex.pm @@ -1746,7 +1746,7 @@ Whatever it is, it does not manifest itself anywhere else where Perl runs. =head1 AUTHORS -Raphael Manfredi > and +Raphael Manfredi > and Jarkko Hietaniemi >. Extensive patches by Daniel S. Lewart >. diff --git a/lib/Math/Trig.pm b/lib/Math/Trig.pm index d987b5c..c659137 100644 --- a/lib/Math/Trig.pm +++ b/lib/Math/Trig.pm @@ -435,7 +435,7 @@ an answer instead of giving a fatal runtime error. =head1 AUTHORS Jarkko Hietaniemi > and -Raphael Manfredi >. +Raphael Manfredi >. =cut diff --git a/lib/Net/Ping.pm b/lib/Net/Ping.pm index 495b82f..5454060 100644 --- a/lib/Net/Ping.pm +++ b/lib/Net/Ping.pm @@ -4,7 +4,7 @@ package Net::Ping; # # Authors of the original pingecho(): # karrer@bernina.ethz.ch (Andreas Karrer) -# pmarquess@bfsec.bt.co.uk (Paul Marquess) +# Paul.Marquess@btinternet.com (Paul Marquess) # # Copyright (c) 1996 Russell Mosemann. All rights reserved. This # program is free software; you may redistribute it and/or modify it diff --git a/lib/Pod/Checker.pm b/lib/Pod/Checker.pm index 6607ad9..aa5c549 100644 --- a/lib/Pod/Checker.pm +++ b/lib/Pod/Checker.pm @@ -1,10 +1,7 @@ ############################################################################# # Pod/Checker.pm -- check pod documents for syntax errors # -# Based on Tom Christiansen's Pod::Text::pod2text() function -# (with modifications). -# -# Copyright (C) 1994-1999 Tom Christiansen. All rights reserved. +# Copyright (C) 1994-1999 by Bradford Appleton. All rights reserved. # This file is part of "PodParser". PodParser is free software; # you can redistribute it and/or modify it under the same terms # as Perl itself. @@ -13,7 +10,7 @@ package Pod::Checker; use vars qw($VERSION); -$VERSION = 1.081; ## Current version of this package +$VERSION = 1.090; ## Current version of this package require 5.004; ## requires this Perl version or later =head1 NAME @@ -24,7 +21,7 @@ Pod::Checker, podchecker() - check pod documents for syntax errors use Pod::Checker; - $syntax_okay = podchecker($filepath, $outputpath); + $syntax_okay = podchecker($filepath, $outputpath, %options); =head1 OPTIONS/ARGUMENTS @@ -34,6 +31,15 @@ indcating a file-path, or else a reference to an open filehandle. If unspecified, the input-file it defaults to C<\*STDIN>, and the output-file defaults to C<\*STDERR>. +=head2 Options + +=over 4 + +=item B<-warnings> =E I + +Turn warnings on/off. See L<"Warnings">. + +=back =head1 DESCRIPTION @@ -46,13 +52,83 @@ unknown 'X<...>' interior-sequences, and unterminated interior sequences. It is hoped that curious/ambitious user will help flesh out and add the additional features they wish to see in B and B. +The following additional checks are preformed: + +=over 4 + +=item * + +Check for proper balancing of C<=begin> and C<=end>. + +=item * + +Check for proper nesting and balancing of C<=over>, C<=item> and C<=back>. + +=item * + +Check for same nested interior-sequences (e.g. C...LE...E...E>). + +=item * + +Check for malformed entities. + +=item * + +Check for correct syntax of hyperlinks CE>. See L for +details. + +=item * + +Check for unresolved document-internal links. + +=back + +=head2 Warnings + +The following warnings are printed. These may not necessarily cause trouble, +but indicate mediocre style. + +=over 4 + +=item * + +Spurious characters after C<=back> and C<=end>. + +=item * + +Unescaped C> and C> in the text. + +=item * + +Missing arguments for C<=begin> and C<=over>. + +=item * + +Empty C<=over> / C<=back> list. + +=item * + +Hyperlinks: leading/trailing whitespace, brackets C<()> in the page name. + +=back + +=head1 DIAGNOSTICS + +I<[T.B.D.]> + +=head1 RETURN VALUE + +B returns the number of POD syntax errors found or -1 if +there were no POD commands at all found in the file. + =head1 EXAMPLES I<[T.B.D.]> =head1 AUTHOR -Brad Appleton Ebradapp@enteract.comE (initial version) +Brad Appleton Ebradapp@enteract.comE (initial version), +Marek Rouchal Emarek@saftsack.fs.uni-bayreuth.deE Based on code for B written by Tom Christiansen Etchrist@mox.perl.comE @@ -104,8 +180,8 @@ my %VALID_SEQUENCES = ( ## Function definitions begin here ##--------------------------------- -sub podchecker( $ ; $ ) { - my ($infile, $outfile) = @_; +sub podchecker( $ ; $ % ) { + my ($infile, $outfile, %options) = @_; local $_; ## Set defaults @@ -113,7 +189,7 @@ sub podchecker( $ ; $ ) { $outfile ||= \*STDERR; ## Now create a pod checker - my $checker = new Pod::Checker(); + my $checker = new Pod::Checker(%options); ## Now check the pod document for errors $checker->parse_from_file($infile, $outfile); @@ -140,45 +216,335 @@ sub new { sub initialize { my $self = shift; - $self->num_errors(0); + ## Initialize number of errors, and setup an error function to + ## increment this number and then print to the designated output. + $self->{_NUM_ERRORS} = 0; + $self->errorsub('poderror'); + $self->{_commands} = 0; # total number of POD commands encountered + $self->{_list_stack} = []; # stack for nested lists + $self->{_have_begin} = ''; # stores =begin + $self->{_links} = []; # stack for internal hyperlinks + $self->{_nodes} = []; # stack for =head/=item nodes + $self->{-warnings} = 1 unless(defined $self->{-warnings}); +} + +## Invoked as $self->poderror( @args ), or $self->poderror( {%opts}, @args ) +sub poderror { + my $self = shift; + my %opts = (ref $_[0]) ? %{shift()} : (); + + ## Retrieve options + chomp( my $msg = ($opts{-msg} || "")."@_" ); + my $line = (exists $opts{-line}) ? " at line $opts{-line}" : ""; + my $file = (exists $opts{-file}) ? " in file $opts{-file}" : ""; + my $severity = (exists $opts{-severity}) ? "*** $opts{-severity}: " : ""; + + ## Increment error count and print message " + ++($self->{_NUM_ERRORS}) + if(!%opts || ($opts{-severity} && $opts{-severity} eq 'ERROR')); + my $out_fh = $self->output_handle(); + print $out_fh ($severity, $msg, $line, $file, "\n"); } sub num_errors { return (@_ > 1) ? ($_[0]->{_NUM_ERRORS} = $_[1]) : $_[0]->{_NUM_ERRORS}; } +## overrides for Pod::Parser + sub end_pod { - ## Print the number of errors found + ## Do some final checks and + ## print the number of errors found my $self = shift; my $infile = $self->input_file(); my $out_fh = $self->output_handle(); + if(@{$self->{_list_stack}}) { + # _TODO_ display, but don't count them for now + my $list; + while($list = shift(@{$self->{_list_stack}})) { + $self->poderror({ -line => 'EOF', -file => $infile, + -severity => 'ERROR', -msg => "=over on line " . + $list->start() . " without closing =back" }); #" + } + } + + # check validity of document internal hyperlinks + # first build the node names from the paragraph text + my %nodes; + foreach($self->node()) { + #print "Have node: +$_+\n"; + $nodes{$_} = 1; + if(/^(\S+)\s+/) { + # we have more than one word. Use the first as a node, too. + # This is used heavily in perlfunc.pod + $nodes{$1} ||= 2; # derived node + } + } + foreach($self->hyperlink()) { + #print "Seek node: +$_+\n"; + my $line = ''; + s/^(\d+):// && ($line = $1); + if($_ && !$nodes{$_}) { + $self->poderror({ -line => $line, -file => $infile, + -severity => 'ERROR', + -msg => "unresolved internal link `$_'"}); + } + } + + ## Print the number of errors found my $num_errors = $self->num_errors(); if ($num_errors > 0) { printf $out_fh ("$infile has $num_errors pod syntax %s.\n", ($num_errors == 1) ? "error" : "errors"); } + elsif($self->{_commands} == 0) { + print $out_fh "$infile does not contain any pod commands.\n"; + $self->num_errors(-1); + } else { print $out_fh "$infile pod syntax OK.\n"; } } sub command { - my ($self, $command, $paragraph, $line_num, $pod_para) = @_; + my ($self, $cmd, $paragraph, $line_num, $pod_para) = @_; my ($file, $line) = $pod_para->file_line; - my $out_fh = $self->output_handle(); ## Check the command syntax - if (! $VALID_COMMANDS{$command}) { - ++($self->{_NUM_ERRORS}); - _invalid_cmd($out_fh, $command, $paragraph, $file, $line); + my $arg; # this will hold the command argument + if (! $VALID_COMMANDS{$cmd}) { + $self->poderror({ -line => $line, -file => $file, -severity => 'ERROR', + -msg => "Unknown command \"$cmd\"" }); } else { - ## check syntax of particular command + $self->{_commands}++; # found a valid command + ## check syntax of particular command + if($cmd eq 'over') { + # start a new list + unshift(@{$self->{_list_stack}}, + Pod::List->new( + -indent => $paragraph, + -start => $line, + -file => $file)); + } + elsif($cmd eq 'item') { + unless(@{$self->{_list_stack}}) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'ERROR', + -msg => "=item without previous =over" }); + } + else { + # check for argument + $arg = $self->_interpolate_and_check($paragraph, $line, $file); + unless($arg && $arg =~ /(\S+)/) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'WARNING', + -msg => "No argument for =item" }); + } + # add this item + $self->{_list_stack}[0]->item($arg || ''); + # remember this node + $self->node($arg) if($arg); + } + } + elsif($cmd eq 'back') { + # check if we have an open list + unless(@{$self->{_list_stack}}) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'ERROR', + -msg => "=back without previous =over" }); + } + else { + # check for spurious characters + $arg = $self->_interpolate_and_check($paragraph, $line,$file); + if($arg && $arg =~ /\S/) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'WARNING', + -msg => "Spurious character(s) after =back" }); + } + # close list + my $list = shift @{$self->{_list_stack}}; + # check for empty lists + if(!$list->item() && $self->{-warnings}) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'WARNING', + -msg => "No items in =over (at line " . + $list->start() . ") / =back list"}); #" + } + } + } + elsif($cmd =~ /^head/) { + # check if there is an open list + if(@{$self->{_list_stack}}) { + my $list; + while($list = shift(@{$self->{_list_stack}})) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'ERROR', + -msg => "unclosed =over (line ". $list->start() . + ") at $cmd" }); + } + } + # remember this node + $arg = $self->_interpolate_and_check($paragraph, $line,$file); + $self->node($arg) if($arg); + } + elsif($cmd eq 'begin') { + if($self->{_have_begin}) { + # already have a begin + $self->poderror({ -line => $line, -file => $file, + -severity => 'ERROR', + -msg => "Nested =begin's (first at line " . + $self->{_have_begin} . ")"}); + } + else { + # check for argument + $arg = $self->_interpolate_and_check($paragraph, $line,$file); + unless($arg && $arg =~ /(\S+)/) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'WARNING', + -msg => "No argument for =begin"}); + } + # remember the =begin + $self->{_have_begin} = "$line:$1"; + } + } + elsif($cmd eq 'end') { + if($self->{_have_begin}) { + # close the existing =begin + $self->{_have_begin} = ''; + # check for spurious characters + $arg = $self->_interpolate_and_check($paragraph, $line,$file); + if($arg && $arg =~ /\S/) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'WARNING', + -msg => "Spurious character(s) after =end" }); + } + } + else { + # don't have a matching =begin + $self->poderror({ -line => $line, -file => $file, + -severity => 'WARNING', + -msg => "=end without =begin" }); + } + } } ## Check the interior sequences in the command-text - my $expansion = $self->interpolate($paragraph, $line_num); + $self->_interpolate_and_check($paragraph, $line,$file) + unless(defined $arg); +} + +sub _interpolate_and_check { + my ($self, $paragraph, $line, $file) = @_; + ## Check the interior sequences in the command-text + # and return the text + $self->_check_ptree( + $self->parse_text($paragraph,$line), $line, $file, ''); +} + +sub _check_ptree { + my ($self,$ptree,$line,$file,$nestlist) = @_; + local($_); + my $text = ''; + # process each node in the parse tree + foreach(@$ptree) { + # regular text chunk + unless(ref) { + my $count; + # count the unescaped angle brackets + my $i = $_; + if($count = $i =~ s/[<>]/$self->expand_unescaped_bracket($&)/ge) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'WARNING', + -msg => "$count unescaped <>" }); + } + $text .= $i; + next; + } + # have an interior sequence + my $cmd = $_->cmd_name(); + my $contents = $_->parse_tree(); + ($file,$line) = $_->file_line(); + # check for valid tag + if (! $VALID_SEQUENCES{$cmd}) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'ERROR', + -msg => qq(Unknown interior-sequence "$cmd")}); + # expand it anyway + $text .= $self->_check_ptree($contents, $line, $file, "$nestlist$cmd"); + next; + } + if($nestlist =~ /$cmd/) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'ERROR', + -msg => "nested commands $cmd<...$cmd<...>...>"}); + # _TODO_ should we add the contents anyway? + # expand it anyway, see below + } + if($cmd eq 'E') { + # preserve entities + if(@$contents > 1 || ref $$contents[0] || $$contents[0] !~ /^\w+$/) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'ERROR', + -msg => "garbled entity " . $_->raw_text()}); + next; + } + $text .= $self->expand_entity($$contents[0]); + } + elsif($cmd eq 'L') { + # try to parse the hyperlink + my $link = Pod::Hyperlink->new($contents->raw_text()); + unless(defined $link) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'ERROR', + -msg => "malformed link L<>: $@"}); + next; + } + $link->line($line); # remember line + if($self->{-warnings}) { + foreach my $w ($link->warning()) { + $self->poderror({ -line => $line, -file => $file, + -severity => 'WARNING', + -msg => $w }); + } + } + # check the link text + $text .= $self->_check_ptree($self->parse_text($link->text(), + $line), $line, $file, "$nestlist$cmd"); + my $node = ''; + $node = $self->_check_ptree($self->parse_text($link->node(), + $line), $line, $file, "$nestlist$cmd") + if($link->node()); + # store internal link + # _TODO_ what if there is a link to the page itself by the name, + # e.g. Tk::Pod : L + $self->hyperlink("$line:$node") if($node && !$link->page()); + } + elsif($cmd =~ /[BCFIS]/) { + # add the guts + $text .= $self->_check_ptree($contents, $line, $file, "$nestlist$cmd"); + } + else { + # check, but add nothing to $text (X<>, Z<>) + $self->_check_ptree($contents, $line, $file, "$nestlist$cmd"); + } + } + $text; +} + +# default method - just return it +sub expand_unescaped_bracket { + my ($self,$bracket) = @_; + $bracket; +} + +# keep the entities +sub expand_entity { + my ($self,$entity) = @_; + "E<$entity>"; } +# _TODO_ overloadable methods for BC..Z<...> expansion + sub verbatim { ## Nothing to check ## my ($self, $paragraph, $line_num, $pod_para) = @_; @@ -186,39 +552,376 @@ sub verbatim { sub textblock { my ($self, $paragraph, $line_num, $pod_para) = @_; - my $out_fh = $self->output_handle(); - ## Check the interior sequences in the text (set $SIG{__WARN__} to - ## send parse_text warnings about untermnated sequences to $out_fh) - local $SIG{__WARN__} = sub { - ++($self->{_NUM_ERRORS}); - print $out_fh @_ - }; - my $expansion = $self->interpolate($paragraph, $line_num); -} - -sub interior_sequence { - my ($self, $seq_cmd, $seq_arg, $pod_seq) = @_; - my ($file, $line) = $pod_seq->file_line; - my $out_fh = $self->output_handle(); - ## Check the sequence syntax - if (! $VALID_SEQUENCES{$seq_cmd}) { - ++($self->{_NUM_ERRORS}); - _invalid_seq($out_fh, $seq_cmd, $seq_arg, $file, $line); + my ($file, $line) = $pod_para->file_line; + $self->_interpolate_and_check($paragraph, $line,$file); +} + +# set/return nodes of the current POD +sub node { + my ($self,$text) = @_; + if(defined $text) { + $text =~ s/[\s\n]+$//; # strip trailing whitespace + # add node + push(@{$self->{_nodes}}, $text); + return $text; + } + @{$self->{_nodes}}; +} + +# set/return hyperlinks of the current POD +sub hyperlink { + my $self = shift; + if($_[0]) { + push(@{$self->{_links}}, $_[0]); + return $_[0]; + } + @{$self->{_links}}; +} + +#----------------------------------------------------------------------------- +# Pod::List +# +# class to hold POD list info (=over, =item, =back) +#----------------------------------------------------------------------------- + +package Pod::List; + +use Carp; + +sub new { + my $this = shift; + my $class = ref($this) || $this; + my %params = @_; + my $self = {%params}; + bless $self, $class; + $self->initialize(); + return $self; +} + +sub initialize { + my $self = shift; + $self->{-file} ||= 'unknown'; + $self->{-start} ||= 'unknown'; + $self->{-indent} ||= 4; # perlpod: "should be the default" + $self->{_items} = []; +} + +# The POD file name the list appears in +sub file { + return (@_ > 1) ? ($_[0]->{-file} = $_[1]) : $_[0]->{-file}; +} + +# The line in the file the node appears +sub start { + return (@_ > 1) ? ($_[0]->{-start} = $_[1]) : $_[0]->{-start}; +} + +# indent level +sub indent { + return (@_ > 1) ? ($_[0]->{-indent} = $_[1]) : $_[0]->{-indent}; +} + +# The individual =items of this list +sub item { + my ($self,$item) = @_; + if(defined $item) { + push(@{$self->{_items}}, $item); + return $item; } else { - ## check syntax of the particular sequence + return @{$self->{_items}}; } } -sub _invalid_cmd { - my ($fh, $cmd, $text, $file, $line) = @_; - print $fh "*** ERROR: Unknown command \"$cmd\"" - . " at line $line of file $file\n"; +#----------------------------------------------------------------------------- +# Pod::Hyperlink +# +# class to hold hyperlinks (L<>) +#----------------------------------------------------------------------------- + +package Pod::Hyperlink; + +=head1 NAME + +Pod::Hyperlink - class for manipulation of POD hyperlinks + +=head1 SYNOPSIS + + my $link = Pod::Hyperlink->new('alternative text|page/"section in page"'); + +=head1 DESCRIPTION + +The B class is mainly designed to parse the contents of the +C...E> sequence, providing a simple interface for accessing the +different parts of a POD hyperlink. + +=head1 METHODS + +=over 4 + +=item new() + +The B method can either be passed a set of key/value pairs or a single +scalar value, namely the contents of a C...E> sequence. An object +of the class C is returned. The value C indicates a +failure, the error message is stored in C<$@>. + +=item parse() + +This method can be used to (re)parse a (new) hyperlink. The result is stored +in the current object. + +=item markup($on,$off,$pageon,$pageoff) + +The result of this method is a string the represents the textual value of the +link, but with included arbitrary markers that highlight the active portion +of the link. This will mainly be used by POD translators and saves the +effort of determining which words have to be highlighted. Examples: Depending +on the type of link, the following text will be returned, the C<*> represent +the places where the section/item specific on/off markers will be placed +(link to a specific node) and C<+> for the pageon/pageoff markers (link to the +top of the page). + + the +perl+ manpage + the *$|* entry in the +perlvar+ manpage + the section on *OPTIONS* in the +perldoc+ manpage + the section on *DESCRIPTION* elsewhere in this document + +This method is read-only. + +=item text() + +This method returns the textual representation of the hyperlink as above, +but without markers (read only). + +=item warning() + +After parsing, this method returns any warnings ecountered during the +parsing process. + +=item page() + +This method sets or returns the POD page this link points to. + +=item node() + +As above, but the destination node text of the link. + +=item type() + +The node type, either C
or C. + +=item alttext() + +Sets or returns an alternative text specified in the link. + +=item line(), file() + +Just simple slots for storing information about the line and the file +the link was incountered in. Has to be filled in manually. + +=back + +=head1 AUTHOR + +Marek Rouchal Emarek@saftsack.fs.uni-bayreuth.deE, borrowing +a lot of things from L and L. + +=cut + +use Carp; + +sub new { + my $this = shift; + my $class = ref($this) || $this; + my $self = +{}; + bless $self, $class; + $self->initialize(); + if(defined $_[0]) { + if(ref($_[0])) { + # called with a list of parameters + %$self = %{$_[0]}; + } + else { + # called with L<> contents + return undef unless($self->parse($_[0])); + } + } + return $self; +} + +sub initialize { + my $self = shift; + $self->{-line} ||= 'undef'; + $self->{-file} ||= 'undef'; + $self->{-page} ||= ''; + $self->{-node} ||= ''; + $self->{-alttext} ||= ''; + $self->{-type} ||= 'undef'; + $self->{_warnings} = []; + $self->_construct_text(); +} + +sub parse { + my $self = shift; + local($_) = $_[0]; + # syntax check the link and extract destination + my ($alttext,$page,$section,$item) = ('','','',''); + + # strip leading/trailing whitespace + if(s/^[\s\n]+//) { + $self->warning("ignoring leading whitespace in link"); + } + if(s/[\s\n]+$//) { + $self->warning("ignoring trailing whitespace in link"); + } + + # collapse newlines with whitespace + s/\s*\n\s*/ /g; + + # extract alternative text + if(s!^([^|/"\n]*)[|]!!) { + $alttext = $1; + } + # extract page + if(s!^([^|/"\s]*)(?=/|$)!!) { + $page = $1; + } + # extract section + if(s!^/?"([^"\n]+)"$!!) { # e.g. L + $section = $1; + } + # extact item + if(s!^/(.*)$!!) { + $item = $1; + } + # last chance here + if(s!^([^|"\s\n/][^"\n/]*)$!!) { # e.g. L + $section = $1; + } + # now there should be nothing left + if(length) { + _invalid_link("garbled entry (spurious characters `$_')"); + return undef; + } + elsif(!(length($page) || length($section) || length($item))) { + _invalid_link("empty link"); + return undef; + } + elsif($alttext =~ /[<>]/) { + _invalid_link("alternative text contains < or >"); + return undef; + } + else { # no errors so far + if($page =~ /[(]\d\w*[)]$/) { + $self->warning("brackets in `$page'"); + $page = $`; # strip that extension + } + if($page =~ /^(\s*)(\S+)(\s*)/ && (length($1) || length($3))) { + $self->warning("whitespace in `$page'"); + $page = $2; # strip that extension + } + } + $self->page($page); + $self->node($section || $item); # _TODO_ do not distinguish for now + $self->alttext($alttext); + $self->type($item ? 'item' : 'section'); + 1; +} + +sub _construct_text { + my $self = shift; + my $alttext = $self->alttext(); + my $type = $self->type(); + my $section = $self->node(); + my $page = $self->page(); + $self->{_text} = + $alttext ? $alttext : ( + !$section ? '' : + $type eq 'item' ? 'the ' . $section . ' entry' : + 'the section on ' . $section ) . + ($page ? ($section ? ' in ':''). 'the ' . $page . ' manpage' : + 'elsewhere in this document'); + # for being marked up later + $self->{_markup} = + $alttext ? '' . $alttext . '' : ( + !$section ? '' : + $type eq 'item' ? 'the ' . $section . ' entry' : + 'the section on ' . $section . '' ) . + ($page ? ($section ? ' in ':'') . 'the ' . + $page . ' manpage' : + ' elsewhere in this document'); +} + +# include markup +sub markup { + my ($self,$on,$off,$pageon,$pageoff) = @_; + $on ||= ''; + $off ||= ''; + $pageon ||= ''; + $pageoff ||= ''; + $_[0]->_construct_text; + my $str = $self->{_markup}; + $str =~ s//$on/; + $str =~ s//$off/; + $str =~ s//$pageon/; + $str =~ s//$pageoff/; + return $str; +} + +# The complete link's text +sub text { + $_[0]->_construct_text(); + $_[0]->{_text}; +} + +# The POD page the link appears on +sub warning { + my $self = shift; + if(@_) { + push(@{$self->{_warnings}}, @_); + return @_; + } + return @{$self->{_warnings}}; +} + +# The POD file name the link appears in +sub file { + return (@_ > 1) ? ($_[0]->{-file} = $_[1]) : $_[0]->{-file}; +} + +# The line in the file the link appears +sub line { + return (@_ > 1) ? ($_[0]->{-line} = $_[1]) : $_[0]->{-line}; +} + +# The POD page the link appears on +sub page { + return (@_ > 1) ? ($_[0]->{-page} = $_[1]) : $_[0]->{-page}; +} + +# The link destination +sub node { + return (@_ > 1) ? ($_[0]->{-node} = $_[1]) : $_[0]->{-node}; +} + +# Potential alternative text +sub alttext { + return (@_ > 1) ? ($_[0]->{-alttext} = $_[1]) : $_[0]->{-alttext}; +} + +# The type +sub type { + return (@_ > 1) ? ($_[0]->{-type} = $_[1]) : $_[0]->{-type}; } -sub _invalid_seq { - my ($fh, $cmd, $text, $file, $line) = @_; - print $fh "*** ERROR: Unknown interior-sequence \"$cmd\"" - . " at line $line of file $file\n"; +sub _invalid_link { + my ($msg) = @_; + # this sets @_ + #eval { die "$msg\n" }; + #chomp $@; + $@ = $msg; # this seems to work, too! + undef; } +1; diff --git a/lib/Pod/Html.pm b/lib/Pod/Html.pm index e9c640c..15757ec 100644 --- a/lib/Pod/Html.pm +++ b/lib/Pod/Html.pm @@ -1487,7 +1487,7 @@ sub process_L { if (m,^(.*?)/"?(.*?)"?$,) { # yes ($page, $section) = ($1, $2); } else { # no - ($page, $section) = ($str, ""); + ($page, $section) = ($_, ""); } # check if we know that this is a section in this page diff --git a/lib/Pod/InputObjects.pm b/lib/Pod/InputObjects.pm index 007fd74..1432895 100644 --- a/lib/Pod/InputObjects.pm +++ b/lib/Pod/InputObjects.pm @@ -2,7 +2,7 @@ # Pod/InputObjects.pm -- package which defines objects for input streams # and paragraphs and commands when parsing POD docs. # -# Copyright (C) 1996-1999 Tom Christiansen. All rights reserved. +# Copyright (C) 1996-1999 by Bradford Appleton. All rights reserved. # This file is part of "PodParser". PodParser is free software; # you can redistribute it and/or modify it under the same terms # as Perl itself. @@ -11,7 +11,7 @@ package Pod::InputObjects; use vars qw($VERSION); -$VERSION = 1.081; ## Current version of this package +$VERSION = 1.090; ## Current version of this package require 5.004; ## requires this Perl version or later ############################################################################# @@ -434,6 +434,9 @@ It has the following methods/attributes: -file => $filename, -line => $line_number); + my $pod_seq4 = new Pod::InteriorSequence(-name => $cmd, $ptree); + my $pod_seq5 = new Pod::InteriorSequence($cmd, $ptree); + This is a class method that constructs a C object and returns a reference to the new interior sequence object. It should be given two keyword arguments. The C<-ldelim> keyword indicates the @@ -441,7 +444,10 @@ corresponding left-delimiter of the interior sequence (e.g. 'E'). The C<-name> keyword indicates the name of the corresponding interior sequence command, such as C or C or C. The C<-file> and C<-line> keywords indicate the filename and line number corresponding -to the beginning of the interior sequence. +to the beginning of the interior sequence. If the C<$ptree> argument is +given, it must be the last argument, and it must be either string, or +else an array-ref suitable for passing to B (or +it may be a reference to an Pod::ParseTree object). =cut @@ -450,6 +456,18 @@ sub new { my $this = shift; my $class = ref($this) || $this; + ## See if first argument has no keyword + if (((@_ <= 2) or (@_ % 2)) and $_[0] !~ /^-\w/) { + ## Yup - need an implicit '-name' before first parameter + unshift @_, '-name'; + } + + ## See if odd number of args + if ((@_ % 2) != 0) { + ## Yup - need an implicit '-ptree' before the last parameter + splice @_, $#_, 0, '-ptree'; + } + ## Any remaining arguments are treated as initial values for the ## hash that is used to represent this object. Note that we default ## certain values by specifying them *before* the arguments passed. @@ -460,10 +478,18 @@ sub new { -line => 0, -ldelim => '<', -rdelim => '>', - -ptree => new Pod::ParseTree(), @_ }; + ## Initialize contents if they havent been already + my $ptree = $self->{'-ptree'} || new Pod::ParseTree(); + if ( ref $ptree =~ /^(ARRAY)?$/ ) { + ## We have an array-ref, or a normal scalar. Pass it as an + ## an argument to the ptree-constructor + $ptree = new Pod::ParseTree($1 ? [$ptree] : $ptree); + } + $self->{'-ptree'} = $ptree; + ## Bless ourselves into the desired class and perform any initialization bless $self, $class; return $self; @@ -496,7 +522,7 @@ sub _set_child2parent_links { my ($self, @children) = @_; ## Make sure any sequences know who their parent is for (@children) { - next unless ref; + next unless (ref || ref eq 'SCALAR'); if ($_->isa('Pod::InteriorSequence') or $_->can('nested')) { $_->nested($self); } @@ -510,8 +536,8 @@ sub _unset_child2parent_links { $self->{'-parent_sequence'} = undef; my $ptree = $self->{'-ptree'}; for (@$ptree) { - next unless (length and ref and $_->isa('Pod::InteriorSequence')); - $_->_unset_child2parent_links(); + next unless (length and ref and ref ne 'SCALAR'); + $_->_unset_child2parent_links() if $_->isa('Pod::InteriorSequence'); } } @@ -718,7 +744,7 @@ itself contain a parse-tree (since interior sequences may be nested). This is a class method that constructs a C object and returns a reference to the new parse-tree. If a single-argument is given, -it mist be a reference to an array, and is used to initialize the root +it must be a reference to an array, and is used to initialize the root (top) of the parse tree. =cut @@ -863,8 +889,8 @@ sub _unset_child2parent_links { my $self = shift; local *ptree = $self; for (@ptree) { - next unless (length and ref and $_->isa('Pod::InteriorSequence')); - $_->_unset_child2parent_links(); + next unless (length and ref and ref ne 'SCALAR'); + $_->_unset_child2parent_links() if $_->isa('Pod::InteriorSequence'); } } diff --git a/lib/Pod/Man.pm b/lib/Pod/Man.pm new file mode 100644 index 0000000..9aadd42 --- /dev/null +++ b/lib/Pod/Man.pm @@ -0,0 +1,1194 @@ +# Pod::Man -- Convert POD data to formatted *roff input. +# $Id: Man.pm,v 0.8 1999/10/07 09:39:37 eagle Exp $ +# +# Copyright 1999 by Russ Allbery +# +# This program is free software; you can redistribute it and/or modify it +# under the same terms as Perl itself. +# +# This module is intended to be a replacement for pod2man, and attempts to +# match its output except for some specific circumstances where other +# decisions seemed to produce better output. It uses Pod::Parser and is +# designed to be very easy to subclass. + +############################################################################ +# Modules and declarations +############################################################################ + +package Pod::Man; + +require 5.004; + +use Carp qw(carp croak); +use Pod::Parser (); + +use strict; +use subs qw(makespace); +use vars qw(@ISA %ESCAPES $PREAMBLE $VERSION); + +@ISA = qw(Pod::Parser); + +($VERSION = (split (' ', q$Revision: 0.8 $ ))[1]) =~ s/\.(\d)$/.0$1/; + + +############################################################################ +# Preamble and *roff output tables +############################################################################ + +# The following is the static preamble which starts all *roff output we +# generate. It's completely static except for the font to use as a +# fixed-width font, which is designed by @CFONT@. $PREAMBLE should +# therefore be run through s/\@CFONT\@//g before output. +$PREAMBLE = <<'----END OF PREAMBLE----'; +.de Sh \" Subsection heading +.br +.if t .Sp +.ne 5 +.PP +\fB\\$1\fR +.PP +.. +.de Sp \" Vertical space (when we can't use .PP) +.if t .sp .5v +.if n .sp +.. +.de Ip \" List item +.br +.ie \\n(.$>=3 .ne \\$3 +.el .ne 3 +.IP "\\$1" \\$2 +.. +.de Vb \" Begin verbatim text +.ft @CFONT@ +.nf +.ne \\$1 +.. +.de Ve \" End verbatim text +.ft R + +.fi +.. +.\" Set up some character translations and predefined strings. \*(-- will +.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left +.\" double quote, and \*(R" will give a right double quote. | will give a +.\" real vertical bar. \*(C+ will give a nicer C++. Capital omega is used +.\" to do unbreakable dashes and therefore won't be available. \*(C` and +.\" \*(C' expand to `' in nroff, nothing in troff, for use with C<> +.tr \(*W-|\(bv\*(Tr +.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' +.ie n \{\ +. ds -- \(*W- +. ds PI pi +. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch +. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch +. ds L" "" +. ds R" "" +. ds C` ` +. ds C' ' +'br\} +.el\{\ +. ds -- \|\(em\| +. ds PI \(*p +. ds L" `` +. ds R" '' +'br\} +.\" +.\" If the F register is turned on, we'll generate index entries on stderr +.\" for titles (.TH), headers (.SH), subsections (.Sh), items (.Ip), and +.\" index entries marked with X<> in POD. Of course, you'll have to process +.\" the output yourself in some meaningful fashion. +.if \nF \{\ +. de IX +. tm Index:\\$1\t\\n%\t"\\$2" +. . +. nr % 0 +. rr F +.\} +.\" +.\" For nroff, turn off justification. Always turn off hyphenation; it +.\" makes way too many mistakes in technical documents. +.hy 0 +.if n .na +.\" +.\" Accent mark definitions (@(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2). +.\" Fear. Run. Save yourself. No user-serviceable parts. +.bd B 3 +. \" fudge factors for nroff and troff +.if n \{\ +. ds #H 0 +. ds #V .8m +. ds #F .3m +. ds #[ \f1 +. ds #] \fP +.\} +.if t \{\ +. ds #H ((1u-(\\\\n(.fu%2u))*.13m) +. ds #V .6m +. ds #F 0 +. ds #[ \& +. ds #] \& +.\} +. \" simple accents for nroff and troff +.if n \{\ +. ds ' \& +. ds ` \& +. ds ^ \& +. ds , \& +. ds ~ ~ +. ds / +.\} +.if t \{\ +. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" +. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' +. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' +. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' +. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' +. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' +.\} +. \" troff and (daisy-wheel) nroff accents +.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' +.ds 8 \h'\*(#H'\(*b\h'-\*(#H' +.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] +.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' +.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' +.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] +.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] +.ds ae a\h'-(\w'a'u*4/10)'e +.ds Ae A\h'-(\w'A'u*4/10)'E +. \" corrections for vroff +.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' +.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' +. \" for low resolution devices (crt and lpr) +.if \n(.H>23 .if \n(.V>19 \ +\{\ +. ds : e +. ds 8 ss +. ds o a +. ds d- d\h'-1'\(ga +. ds D- D\h'-1'\(hy +. ds th \o'bp' +. ds Th \o'LP' +. ds ae ae +. ds Ae AE +.\} +.rm #[ #] #H #V #F C +----END OF PREAMBLE---- + +# This table is taken nearly verbatim from Tom Christiansen's pod2man. It +# assumes that the standard preamble has already been printed, since that's +# what defines all of the accent marks. Note that some of these are quoted +# with double quotes since they contain embedded single quotes, so use \\ +# uniformly for backslash for readability. +%ESCAPES = ( + 'amp' => '&', # ampersand + 'lt' => '<', # left chevron, less-than + 'gt' => '>', # right chevron, greater-than + 'quot' => '"', # double quote + + 'Aacute' => "A\\*'", # capital A, acute accent + 'aacute' => "a\\*'", # small a, acute accent + 'Acirc' => 'A\\*^', # capital A, circumflex accent + 'acirc' => 'a\\*^', # small a, circumflex accent + 'AElig' => '\*(AE', # capital AE diphthong (ligature) + 'aelig' => '\*(ae', # small ae diphthong (ligature) + 'Agrave' => "A\\*`", # capital A, grave accent + 'agrave' => "A\\*`", # small a, grave accent + 'Aring' => 'A\\*o', # capital A, ring + 'aring' => 'a\\*o', # small a, ring + 'Atilde' => 'A\\*~', # capital A, tilde + 'atilde' => 'a\\*~', # small a, tilde + 'Auml' => 'A\\*:', # capital A, dieresis or umlaut mark + 'auml' => 'a\\*:', # small a, dieresis or umlaut mark + 'Ccedil' => 'C\\*,', # capital C, cedilla + 'ccedil' => 'c\\*,', # small c, cedilla + 'Eacute' => "E\\*'", # capital E, acute accent + 'eacute' => "e\\*'", # small e, acute accent + 'Ecirc' => 'E\\*^', # capital E, circumflex accent + 'ecirc' => 'e\\*^', # small e, circumflex accent + 'Egrave' => 'E\\*`', # capital E, grave accent + 'egrave' => 'e\\*`', # small e, grave accent + 'ETH' => '\\*(D-', # capital Eth, Icelandic + 'eth' => '\\*(d-', # small eth, Icelandic + 'Euml' => 'E\\*:', # capital E, dieresis or umlaut mark + 'euml' => 'e\\*:', # small e, dieresis or umlaut mark + 'Iacute' => "I\\*'", # capital I, acute accent + 'iacute' => "i\\*'", # small i, acute accent + 'Icirc' => 'I\\*^', # capital I, circumflex accent + 'icirc' => 'i\\*^', # small i, circumflex accent + 'Igrave' => 'I\\*`', # capital I, grave accent + 'igrave' => 'i\\*`', # small i, grave accent + 'Iuml' => 'I\\*:', # capital I, dieresis or umlaut mark + 'iuml' => 'i\\*:', # small i, dieresis or umlaut mark + 'Ntilde' => 'N\*~', # capital N, tilde + 'ntilde' => 'n\*~', # small n, tilde + 'Oacute' => "O\\*'", # capital O, acute accent + 'oacute' => "o\\*'", # small o, acute accent + 'Ocirc' => 'O\\*^', # capital O, circumflex accent + 'ocirc' => 'o\\*^', # small o, circumflex accent + 'Ograve' => 'O\\*`', # capital O, grave accent + 'ograve' => 'o\\*`', # small o, grave accent + 'Oslash' => 'O\\*/', # capital O, slash + 'oslash' => 'o\\*/', # small o, slash + 'Otilde' => 'O\\*~', # capital O, tilde + 'otilde' => 'o\\*~', # small o, tilde + 'Ouml' => 'O\\*:', # capital O, dieresis or umlaut mark + 'ouml' => 'o\\*:', # small o, dieresis or umlaut mark + 'szlig' => '\*8', # small sharp s, German (sz ligature) + 'THORN' => '\\*(Th', # capital THORN, Icelandic + 'thorn' => '\\*(th', # small thorn, Icelandic + 'Uacute' => "U\\*'", # capital U, acute accent + 'uacute' => "u\\*'", # small u, acute accent + 'Ucirc' => 'U\\*^', # capital U, circumflex accent + 'ucirc' => 'u\\*^', # small u, circumflex accent + 'Ugrave' => 'U\\*`', # capital U, grave accent + 'ugrave' => 'u\\*`', # small u, grave accent + 'Uuml' => 'U\\*:', # capital U, dieresis or umlaut mark + 'uuml' => 'u\\*:', # small u, dieresis or umlaut mark + 'Yacute' => "Y\\*'", # capital Y, acute accent + 'yacute' => "y\\*'", # small y, acute accent + 'yuml' => 'y\\*:', # small y, dieresis or umlaut mark +); + + +############################################################################ +# Static helper functions +############################################################################ + +# Protect leading quotes and periods against interpretation as commands. +sub protect { local $_ = shift; s/^([.\'])/\\&$1/mg; $_ } + +# Given a command and a single argument that may or may not contain double +# quotes, handle double-quote formatting for it. If there are no double +# quotes, just return the command followed by the argument in double quotes. +# If there are double quotes, use an if statement to test for nroff, and for +# nroff output the command followed by the argument in double quotes with +# embedded double quotes doubled. For other formatters, remap paired double +# quotes to `` and ''. +sub switchquotes { + my $command = shift; + local $_ = shift; + my $extra = shift; + s/\\\*\([LR]\"/\"/g; + if (/\"/) { + s/\"/\"\"/g; + my $troff = $_; + $troff =~ s/\"\"([^\"]*)\"\"/\`\`$1\'\'/g; + s/\"/\"\"/g if $extra; + $troff =~ s/\"/\"\"/g if $extra; + $_ = qq("$_") . ($extra ? " $extra" : ''); + $troff = qq("$troff") . ($extra ? " $extra" : ''); + return ".if n $command $_\n.el $command $troff\n"; + } else { + $_ = qq("$_") . ($extra ? " $extra" : ''); + return "$command $_\n"; + } +} + +# Translate a font string into an escape. +sub toescape { (length ($_[0]) > 1 ? '\f(' : '\f') . $_[0] } + + +############################################################################ +# Initialization +############################################################################ + +# Initialize the object. Here, we also process any additional options +# passed to the constructor or set up defaults if none were given. center +# is the centered title, release is the version number, and date is the date +# for the documentation. Note that we can't know what file name we're +# processing due to the architecture of Pod::Parser, so that *has* to either +# be passed to the constructor or set separately with Pod::Man::name(). +sub initialize { + my $self = shift; + + # Figure out the fixed-width font. If user-supplied, make sure that + # they are the right length. + for (qw/fixed fixedbold fixeditalic fixedbolditalic/) { + if (defined $$self{$_}) { + if (length ($$self{$_}) < 1 || length ($$self{$_}) > 2) { + croak "roff font should be 1 or 2 chars, not `$$self{$_}'"; + } + } else { + $$self{$_} = ''; + } + } + + # Set the default fonts. We can't be sure what fixed bold-italic is + # going to be called, so default to just bold. + $$self{fixed} ||= 'CW'; + $$self{fixedbold} ||= 'CB'; + $$self{fixeditalic} ||= 'CI'; + $$self{fixedbolditalic} ||= 'CB'; + + # Set up a table of font escapes. First number is fixed-width, second + # is bold, third is italic. + $$self{FONTS} = { '000' => '\fR', '001' => '\fI', + '010' => '\fB', '011' => '\f(BI', + '100' => toescape ($$self{fixed}), + '101' => toescape ($$self{fixeditalic}), + '110' => toescape ($$self{fixedbold}), + '111' => toescape ($$self{fixedbolditalic})}; + + # Extra stuff for page titles. + $$self{center} = 'User Contributed Perl Documentation' + unless defined $$self{center}; + $$self{indent} = 4 unless defined $$self{indent}; + + # We used to try first to get the version number from a local binary, + # but we shouldn't need that any more. Get the version from the running + # Perl. + if (!defined $$self{release}) { + my ($rev, $ver, $sver) = ($] =~ /^(\d+)\.(\d{3})(\d{0,3})$/); + $sver ||= 0; $sver *= 10 ** (3-length($sver)); + $rev += 0; $ver += 0; $sver += 0; + $$self{release} = "perl v$rev.$ver.$sver"; + } + + # Double quotes in things that will be quoted. + for (qw/center date release/) { $$self{$_} =~ s/\"/\"\"/g } + + $$self{INDENT} = 0; # Current indentation level. + $$self{INDENTS} = []; # Stack of indentations. + $$self{INDEX} = []; # Index keys waiting to be printed. + + $self->SUPER::initialize; +} + +# For each document we process, output the preamble first. Note that the +# fixed width font is a global default; once we interpolate it into the +# PREAMBLE, it ain't ever changing. Maybe fix this later. +sub begin_pod { + my $self = shift; + + # Try to figure out the name and section from the file name. + my $section = $$self{section} || 1; + my $name = $$self{name}; + if (!defined $name) { + $name = $self->input_file; + $section = 3 if (!$$self{section} && $name =~ /\.pm$/i); + $name =~ s/\.p(od|[lm])$//i; + if ($section =~ /^1/) { + require File::Basename; + $name = uc File::Basename::basename ($name); + } else { + # Lose everything up to the first of + # */lib/*perl* standard or site_perl module + # */*perl*/lib from -D prefix=/opt/perl + # */*perl*/ random module hierarchy + # which works. Should be fixed to use File::Spec. + for ($name) { + s%//+%/%g; + if ( s%^.*?/lib/[^/]*perl[^/]*/%%i + or s%^.*?/[^/]*perl[^/]*/(?:lib/)?%%i) { + s%^site(_perl)?/%%; # site and site_perl + s%^(.*-$^O|$^O-.*)/%%o; # arch + s%^\d+\.\d+%%; # version + } + s%/%::%g; + } + } + } + + # Modification date header. Try to use the modification time of our + # input. + if (!defined $$self{date}) { + my $time = (stat $self->input_file)[9] || time; + my ($day, $month, $year) = (localtime $time)[3,4,5]; + $month++; + $year += 1900; + $$self{date} = join ('-', $year, $month, $day); + } + + # Now, print out the preamble and the title. + $PREAMBLE =~ s/\@CFONT\@/$$self{fixed}/; + chomp $PREAMBLE; + print { $self->output_handle } <<"----END OF HEADER----"; +.\\" Automatically generated by Pod::Man version $VERSION +.\\" @{[ scalar localtime ]} +.\\" +.\\" Standard preamble: +.\\" ====================================================================== +$PREAMBLE +.\\" ====================================================================== +.\\" +.IX Title "$name $section" +.TH $name $section "$$self{release}" "$$self{date}" "$$self{center}" +.UC +----END OF HEADER---- +#"# for cperl-mode + + # Initialize a few per-file variables. + $$self{INDENT} = 0; + $$self{NEEDSPACE} = 0; +} + + +############################################################################ +# Core overrides +############################################################################ + +# Called for each command paragraph. Gets the command, the associated +# paragraph, the line number, and a Pod::Paragraph object. Just dispatches +# the command to a method named the same as the command. =cut is handled +# internally by Pod::Parser. +sub command { + my $self = shift; + my $command = shift; + return if $command eq 'pod'; + return if ($$self{EXCLUDE} && $command ne 'end'); + $command = 'cmd_' . $command; + $self->$command (@_); +} + +# Called for a verbatim paragraph. Gets the paragraph, the line number, and +# a Pod::Paragraph object. Rofficate backslashes, untabify, put a +# zero-width character at the beginning of each line to protect against +# commands, and wrap in .Vb/.Ve. +sub verbatim { + my $self = shift; + return if $$self{EXCLUDE}; + local $_ = shift; + return if /^\s+$/; + s/\s+$/\n/; + my $lines = tr/\n/\n/; + 1 while s/^(.*?)(\t+)/$1 . ' ' x (length ($2) * 8 - length ($1) % 8)/me; + s/\\/\\e/g; + s/^(\s*\S)/'\&' . $1/gme; + $self->makespace if $$self{NEEDSPACE}; + $self->output (".Vb $lines\n$_.Ve\n"); + $$self{NEEDSPACE} = 0; +} + +# Called for a regular text block. Gets the paragraph, the line number, and +# a Pod::Paragraph object. Perform interpolation and output the results. +sub textblock { + my $self = shift; + return if $$self{EXCLUDE}; + $self->output ($_[0]), return if $$self{VERBATIM}; + + # Perform a little magic to collapse multiple L<> references. We'll + # just rewrite the whole thing into actual text at this part, bypassing + # the whole internal sequence parsing thing. + s{ + (L< # A link of the form L. + / + ( + [:\w]+ # The item has to be a simple word... + (\(\))? # ...or simple function. + ) + > + ( + ,?\s+(and\s+)? # Allow lots of them, conjuncted. + L< + / + ( [:\w]+ ( \(\) )? ) + > + )+ + ) + } { + local $_ = $1; + s{ L< / ([^>]+ ) } {$1}g; + my @items = split /(?:,?\s+(?:and\s+)?)/; + my $string = "the "; + my $i; + for ($i = 0; $i < @items; $i++) { + $string .= $items[$i]; + $string .= ", " if @items > 2 && $i != $#items; + $string .= " and " if ($i == $#items - 1); + } + $string .= " entries elsewhere in this document"; + $string; + }gex; + + # Parse the tree and output it. collapse knows about references to + # scalars as well as scalars and does the right thing with them. + local $_ = $self->parse (@_); + s/\n\s*$/\n/; + $self->makespace if $$self{NEEDSPACE}; + $self->output (protect $self->mapfonts ($_)); + $self->outindex; + $$self{NEEDSPACE} = 1; +} + +# Called for an interior sequence. Takes a Pod::InteriorSequence object and +# returns a reference to a scalar. This scalar is the final formatted text. +# It's returned as a reference so that other interior sequences above us +# know that the text has already been processed. +sub sequence { + my ($self, $seq) = @_; + my $command = $seq->cmd_name; + + # Zero-width characters. + if ($command eq 'Z') { + my $v = '\&'; return bless \ $v, 'Pod::Man::String'; + } + + # C<>, L<>, X<>, and E<> don't apply guesswork to their contents. + local $_ = $self->collapse ($seq->parse_tree, $command =~ /^[CELX]$/); + + # Handle E<> escapes. + if ($command eq 'E') { + if (/^\d+$/) { + return bless \ chr ($_), 'Pod::Man::String'; + } elsif (exists $ESCAPES{$_}) { + return bless \ "$ESCAPES{$_}", 'Pod::Man::String'; + } else { + carp "Unknown escape E<$1>"; + return bless \ "E<$_>", 'Pod::Man::String'; + } + } + + # For all the other sequences, empty content produces no output. + return '' if $_ eq ''; + + # Handle formatting sequences. + if ($command eq 'B') { + return bless \ ('\f(BS' . $_ . '\f(BE'), 'Pod::Man::String'; + } elsif ($command eq 'F') { + return bless \ ('\f(IS' . $_ . '\f(IE'), 'Pod::Man::String'; + } elsif ($command eq 'I') { + return bless \ ('\f(IS' . $_ . '\f(IE'), 'Pod::Man::String'; + } elsif ($command eq 'C') { + s/-/\\-/g; + s/__/_\\|_/g; + return bless \ ('\f(FS\*(C`' . $_ . "\\*(C'\\f(FE"), + 'Pod::Man::String'; + } + + # Handle links. + if ($command eq 'L') { + # XXX bug in lvalue subroutines prevents this from working + #return bless \ ($self->buildlink ($_)), 'Pod::Man::String'; + my $v = $self->buildlink($_); + return bless \$v, 'Pod::Man::String'; + } + + # Whitespace protection replaces whitespace with "\ ". + if ($command eq 'S') { + s/\s+/\\ /g; + return bless \ "$_", 'Pod::Man::String'; + } + + # Add an index entry to the list of ones waiting to be output. + if ($command eq 'X') { push (@{ $$self{INDEX} }, $_); return '' } + + # Anything else is unknown. + carp "Unknown sequence $command<$_>"; +} + + +############################################################################ +# Command paragraphs +############################################################################ + +# All command paragraphs take the paragraph and the line number. + +# First level heading. We can't output .IX in the NAME section due to a bug +# in some versions of catman, so don't output a .IX for that section. .SH +# already uses small caps, so remove any E<> sequences that would cause +# them. +sub cmd_head1 { + my $self = shift; + local $_ = $self->parse (@_); + s/\s+$//; + s/\\s-?\d//g; + $self->output (switchquotes ('.SH', $self->mapfonts ($_))); + $self->outindex (($_ eq 'NAME') ? () : ('Header', $_)); + $$self{NEEDSPACE} = 0; +} + +# Second level heading. +sub cmd_head2 { + my $self = shift; + local $_ = $self->parse (@_); + s/\s+$//; + $self->output (switchquotes ('.Sh', $self->mapfonts ($_))); + $self->outindex ('Subsection', $_); + $$self{NEEDSPACE} = 0; +} + +# Start a list. For indents after the first, wrap the outside indent in .RS +# so that hanging paragraph tags will be correct. +sub cmd_over { + my $self = shift; + local $_ = shift; + unless (/^[-+]?\d+\s+$/) { $_ = $$self{indent} } + if (@{ $$self{INDENTS} } > 0) { + $self->output (".RS $$self{INDENT}\n"); + } + push (@{ $$self{INDENTS} }, $$self{INDENT}); + $$self{INDENT} = ($_ + 0); +} + +# End a list. If we've closed an embedded indent, we've mangled the hanging +# paragraph indent, so temporarily replace it with .RS and set WEIRDINDENT. +# We'll close that .RS at the next =back or =item. +sub cmd_back { + my $self = shift; + $$self{INDENT} = pop @{ $$self{INDENTS} }; + unless (defined $$self{INDENT}) { + carp "Unmatched =back"; + $$self{INDENT} = 0; + } + if ($$self{WEIRDINDENT}) { + $self->output (".RE\n"); + $$self{WEIRDINDENT} = 0; + } + if (@{ $$self{INDENTS} } > 0) { + $self->output (".RE\n"); + $self->output (".RS $$self{INDENT}\n"); + $$self{WEIRDINDENT} = 1; + } + $$self{NEEDSPACE} = 1; +} + +# An individual list item. Emit an index entry for anything that's +# interesting, but don't emit index entries for things like bullets and +# numbers. rofficate bullets too while we're at it (so for nice output, use +# * for your lists rather than o or . or - or some other thing). +sub cmd_item { + my $self = shift; + local $_ = $self->parse (@_); + s/\s+$//; + my $index; + if (/\w/ && !/^\w[.\)]\s*$/) { + $index = $_; + $index =~ s/^\s*[-*+o.]?\s*//; + } + s/^\*(\s|\Z)/\\\(bu$1/; + if ($$self{WEIRDINDENT}) { + $self->output (".RE\n"); + $$self{WEIRDINDENT} = 0; + } + $_ = $self->mapfonts ($_); + $self->output (switchquotes ('.Ip', $_, $$self{INDENT})); + $self->outindex ($index ? ('Item', $index) : ()); + $$self{NEEDSPACE} = 0; +} + +# Begin a block for a particular translator. Setting VERBATIM triggers +# special handling in textblock(). +sub cmd_begin { + my $self = shift; + local $_ = shift; + my ($kind) = /^(\S+)/ or return; + if ($kind eq 'man' || $kind eq 'roff') { + $$self{VERBATIM} = 1; + } else { + $$self{EXCLUDE} = 1; + } +} + +# End a block for a particular translator. We assume that all =begin/=end +# pairs are properly closed. +sub cmd_end { + my $self = shift; + $$self{EXCLUDE} = 0; + $$self{VERBATIM} = 0; +} + +# One paragraph for a particular translator. Ignore it unless it's intended +# for man or roff, in which case we output it verbatim. +sub cmd_for { + my $self = shift; + local $_ = shift; + my $line = shift; + return unless s/^(?:man|roff)\b[ \t]*\n?//; + $self->output ($_); +} + + +############################################################################ +# Link handling +############################################################################ + +# Handle links. We can't actually make real hyperlinks, so this is all to +# figure out what text and formatting we print out. +sub buildlink { + my $self = shift; + local $_ = shift; + + # Smash whitespace in case we were split across multiple lines. + s/\s+/ /g; + + # If we were given any explicit text, just output it. + if (m{ ^ ([^|]+) \| }x) { return $1 } + + # Okay, leading and trailing whitespace isn't important. + s/^\s+//; + s/\s+$//; + + # Default to using the whole content of the link entry as a section + # name. Note that L forces a manpage interpretation, as does + # something looking like L. Do the same thing to + # L as we would to manpage(section) without the L<>; + # see guesswork(). If we've added italics, don't add the "manpage" + # text; markup is sufficient. + my ($manpage, $section) = ('', $_); + if (/^"\s*(.*?)\s*"$/) { + $section = '"' . $1 . '"'; + } elsif (m{ ^ [-:.\w]+ (?: \( \S+ \) )? $ }x) { + ($manpage, $section) = ($_, ''); + $manpage =~ s/^([^\(]+)\(/'\f(IS' . $1 . '\f(IE\|('/e; + } elsif (m%/%) { + ($manpage, $section) = split (/\s*\/\s*/, $_, 2); + if ($manpage =~ /^[-:.\w]+(?:\(\S+\))?$/) { + $manpage =~ s/^([^\(]+)\(/'\f(IS' . $1 . '\f(IE\|'/e; + } + $section =~ s/^\"\s*//; + $section =~ s/\s*\"$//; + } + if ($manpage && $manpage !~ /\\f\(IS/) { + $manpage = "the $manpage manpage"; + } + + # Now build the actual output text. + my $text = ''; + if (!length ($section) && !length ($manpage)) { + carp "Invalid link $_"; + } elsif (!length ($section)) { + $text = $manpage; + } elsif ($section =~ /^[:\w]+(?:\(\))?/) { + $text .= 'the ' . $section . ' entry'; + $text .= (length $manpage) ? " in $manpage" + : " elsewhere in this document"; + } else { + if ($section !~ /^".*"$/) { $section = '"' . $section . '"' } + $text .= 'the section on ' . $section; + $text .= " in $manpage" if length $manpage; + } + $text; +} + + +############################################################################ +# Escaping and fontification +############################################################################ + +# At this point, we'll have embedded font codes of the form \f([SE] +# where is one of B, I, or F. Turn those into the right font start +# or end codes. B else> should map to \fBsome\f(BIthing\fB +# else\fR. The old pod2man didn't get this right; the second \fB was \fR, +# so nested sequences didn't work right. We take care of this by using +# variables as a combined pointer to our current font sequence, and set each +# to the number of current nestings of start tags for that font. Use them +# as a vector to look up what font sequence to use. +sub mapfonts { + my $self = shift; + local $_ = shift; + + my ($fixed, $bold, $italic) = (0, 0, 0); + my %magic = (F => \$fixed, B => \$bold, I => \$italic); + s { \\f\((.)(.) } { + ${ $magic{$1} } += ($2 eq 'S') ? 1 : -1; + $$self{FONTS}{($fixed && 1) . ($bold && 1) . ($italic && 1)}; + }gxe; + $_; +} + + +############################################################################ +# *roff-specific parsing +############################################################################ + +# Called instead of parse_text, calls parse_text with the right flags. +sub parse { + my $self = shift; + $self->parse_text ({ -expand_seq => 'sequence', + -expand_ptree => 'collapse' }, @_); +} + +# Takes a parse tree and a flag saying whether or not to treat it as literal +# text (not call guesswork on it), and returns the concatenation of all of +# the text strings in that parse tree. If the literal flag isn't true, +# guesswork() will be called on all plain scalars in the parse tree. +# Assumes that everything in the parse tree is either a scalar or a +# reference to a scalar. +sub collapse { + my ($self, $ptree, $literal) = @_; + if ($literal) { + return join ('', map { + if (ref $_) { + $$_; + } else { + s/\\/\\e/g; + $_; + } + } $ptree->children); + } else { + return join ('', map { + ref ($_) ? $$_ : $self->guesswork ($_) + } $ptree->children); + } +} + +# Takes a text block to perform guesswork on; this is guaranteed not to +# contain any interior sequences. Returns the text block with remapping +# done. +sub guesswork { + my $self = shift; + local $_ = shift; + + # rofficate backslashes. + s/\\/\\e/g; + + # Ensure double underbars have a tiny space between them. + s/__/_\\|_/g; + + # Make all caps a little smaller. Be careful here, since we don't want + # to make @ARGV into small caps, nor do we want to fix the MIME in + # MIME-Version, since it looks weird with the full-height V. + s{ + ( ^ | [\s\(\"\'\`\[\{<>] ) + ( [A-Z] [A-Z] [/A-Z+:\d_\$&-]* ) + (?: (?= [\s>\}\]\)\'\".?!,;:] | -- ) | $ ) + } { $1 . '\s-1' . $2 . '\s0' . $3 }egx; + + # Turn PI into a pretty pi. + s{ (?: \\s-1 | \b ) PI (?: \\s0 | \b ) } {\\*\(PI}gx; + + # Italize functions in the form func(). + s{ + \b + ( + [:\w]+ (?:\\s-1)? \(\) + ) + } { '\f(IS' . $1 . '\f(IE' }egx; + + # func(n) is a reference to a manual page. Make it \fIfunc\fR\|(n). + s{ + \b + (\w[-:.\w]+ (?:\\s-1)?) + ( + \( [^\)] \) + ) + } { '\f(IS' . $1 . '\f(IE\|' . $2 }egx; + + # Convert simple Perl variable references to a fixed-width font. + s{ + ( \s+ ) + ( [\$\@%] [\w:]+ ) + (?! \( ) + } { $1 . '\f(FS' . $2 . '\f(FE'}egx; + + # Translate -- into a real em dash if it's used like one and fix up + # dashes, but keep hyphens hyphens. + s{ (\G|^|.) (-+) (\b|.) } { + my ($pre, $dash, $post) = ($1, $2, $3); + if (length ($dash) == 1) { + ($pre =~ /[a-zA-Z]/) ? "$pre-$post" : "$pre\\-$post"; + } elsif (length ($dash) == 2 + && ((!$pre && !$post) + || ($pre =~ /\w/ && !$post) + || ($pre eq ' ' && $post eq ' ') + || ($pre eq '=' && $post ne '=') + || ($pre ne '=' && $post eq '='))) { + "$pre\\*(--$post"; + } else { + $pre . ('\-' x length $dash) . $post; + } + }egxs; + + # Fix up double quotes. + s{ \" ([^\"]+) \" } { '\*(L"' . $1 . '\*(R"' }egx; + + # Make C++ into \*(C+, which is a squinched version. + s{ \b C\+\+ } {\\*\(C+}gx; + + # All done. + $_; +} + + +############################################################################ +# Output formatting +############################################################################ + +# Make vertical whitespace. +sub makespace { + my $self = shift; + $self->output ($$self{INDENT} > 0 ? ".Sp\n" : ".PP\n"); +} + +# Output any pending index entries, and optionally an index entry given as +# an argument. Support multiple index entries in X<> separated by slashes, +# and strip special escapes from index entries. +sub outindex { + my ($self, $section, $index) = @_; + my @entries = map { split m%\s*/\s*% } @{ $$self{INDEX} }; + return unless ($section || @entries); + $$self{INDEX} = []; + my $output; + if (@entries) { + my $output = '.IX Xref "' + . join (' ', map { s/\"/\"\"/; $_ } @entries) + . '"' . "\n"; + } + if ($section) { + $index =~ s/\"/\"\"/; + $index =~ s/\\-/-/g; + $index =~ s/\\(?:s-?\d|.\(..|.)//g; + $output .= ".IX $section " . '"' . $index . '"' . "\n"; + } + $self->output ($output); +} + +# Output text to the output device. +sub output { print { $_[0]->output_handle } $_[1] } + +__END__ + +.\" These are some extra bits of roff that I don't want to lose track of +.\" but that have been removed from the preamble to make it a bit shorter +.\" since they're not currently being used. They're accents and special +.\" characters we don't currently have escapes for. +.if n \{\ +. ds ? ? +. ds ! ! +. ds q +.\} +.if t \{\ +. ds ? \s-2c\h'-\w'c'u*7/10'\u\h'\*(#H'\zi\d\s+2\h'\w'c'u*8/10' +. ds ! \s-2\(or\s+2\h'-\w'\(or'u'\v'-.8m'.\v'.8m' +. ds q o\h'-\w'o'u*8/10'\s-4\v'.4m'\z\(*i\v'-.4m'\s+4\h'\w'o'u*8/10' +.\} +.ds v \\k:\h'-(\\n(.wu*9/10-\*(#H)'\v'-\*(#V'\*(#[\s-4v\s0\v'\*(#V'\h'|\\n:u'\*(#] +.ds _ \\k:\h'-(\\n(.wu*9/10-\*(#H+(\*(#F*2/3))'\v'-.4m'\z\(hy\v'.4m'\h'|\\n:u' +.ds . \\k:\h'-(\\n(.wu*8/10)'\v'\*(#V*4/10'\z.\v'-\*(#V*4/10'\h'|\\n:u' +.ds 3 \*(#[\v'.2m'\s-2\&3\s0\v'-.2m'\*(#] +.ds oe o\h'-(\w'o'u*4/10)'e +.ds Oe O\h'-(\w'O'u*4/10)'E +.if \n(.H>23 .if \n(.V>19 \ +\{\ +. ds v \h'-1'\o'\(aa\(ga' +. ds _ \h'-1'^ +. ds . \h'-1'. +. ds 3 3 +. ds oe oe +. ds Oe OE +.\} + +############################################################################ +# Documentation +############################################################################ + +=head1 NAME + +Pod::Man - Convert POD data to formatted *roff input + +=head1 SYNOPSIS + + use Pod::Man; + my $parser = Pod::Man->new (release => $VERSION, section => 8); + + # Read POD from STDIN and write to STDOUT. + $parser->parse_from_filehandle; + + # Read POD from file.pod and write to file.1. + $parser->parse_from_file ('file.pod', 'file.1'); + +=head1 DESCRIPTION + +Pod::Man is a module to convert documentation in the POD format (the +preferred language for documenting Perl) into *roff input using the man +macro set. The resulting *roff code is suitable for display on a terminal +using nroff(1), normally via man(1), or printing using troff(1). It is +conventionally invoked using the driver script B, but it can also +be used directly. + +As a derived class from Pod::Parser, Pod::Man supports the same methods and +interfaces. See L for all the details; briefly, one creates a +new parser with Cnew()> and then calls either +parse_from_filehandle() or parse_from_file(). + +new() can take options, in the form of key/value pairs that control the +behavior of the parser. See below for details. + +If no options are given, Pod::Man uses the name of the input file with any +trailing C<.pod>, C<.pm>, or C<.pl> stripped as the man page title, to +section 1 unless the file ended in C<.pm> in which case it defaults to +section 3, to a centered title of "User Contributed Perl Documentation", to +a centered footer of the Perl version it is run with, and to a left-hand +footer of the modification date of its input (or the current date if given +STDIN for input). + +Pod::Man assumes that your *roff formatters have a fixed-width font named +CW. If yours is called something else (like CR), use the C option to +specify it. This generally only matters for troff output for printing. +Similarly, you can set the fonts used for bold, italic, and bold italic +fixed-width output. + +Besides the obvious pod conversions, Pod::Man also takes care of formatting +func(), func(n), and simple variable references like $foo or @bar so you +don't have to use code escapes for them; complex expressions like +C<$fred{'stuff'}> will still need to be escaped, though. It also translates +dashes that aren't used as hyphens into en dashes, makes long dashes--like +this--into proper em dashes, fixes "paired quotes," makes C++ and PI look +right, puts a little space between double underbars, makes ALLCAPS a teeny +bit smaller in troff(1), and escapes stuff that *roff treats as special so +that you don't have to. + +The recognized options to new() are as follows. All options take a single +argument. + +=over 4 + +=item center + +Sets the centered page header to use instead of "User Contributed Perl +Documentation". + +=item date + +Sets the left-hand footer. By default, the modification date of the input +file will be used, or the current date if stat() can't find that file (the +case if the input is from STDIN), and the date will be formatted as +YYYY-MM-DD. + +=item fixed + +The fixed-width font to use for vertabim text and code. Defaults to CW. +Some systems may want CR instead. Only matters for troff(1) output. + +=item fixedbold + +Bold version of the fixed-width font. Defaults to CB. Only matters for +troff(1) output. + +=item fixeditalic + +Italic version of the fixed-width font (actually, something of a misnomer, +since most fixed-width fonts only have an oblique version, not an italic +version). Defaults to CI. Only matters for troff(1) output. + +=item fixedbolditalic + +Bold italic (probably actually oblique) version of the fixed-width font. +Pod::Man doesn't assume you have this, and defaults to CB. Some systems +(such as Solaris) have this font available as CX. Only matters for troff(1) +output. + +=item release + +Set the centered footer. By default, this is the version of Perl you run +Pod::Man under. Note that some system an macro sets assume that the +centered footer will be a modification date and will prepend something like +"Last modified: "; if this is the case, you may want to set C to +the last modified date and C to the version number. + +=item section + +Set the section for the C<.TH> macro. The standard section numbering +convention is to use 1 for user commands, 2 for system calls, 3 for +functions, 4 for devices, 5 for file formats, 6 for games, 7 for +miscellaneous information, and 8 for administrator commands. There is a lot +of variation here, however; some systems (like Solaris) use 4 for file +formats, 5 for miscellaneous information, and 7 for devices. Still others +use 1m instead of 8, or some mix of both. About the only section numbers +that are reliably consistent are 1, 2, and 3. + +By default, section 1 will be used unless the file ends in .pm in which case +section 3 will be selected. + +=back + +The standard Pod::Parser method parse_from_filehandle() takes up to two +arguments, the first being the file handle to read POD from and the second +being the file handle to write the formatted output to. The first defaults +to STDIN if not given, and the second defaults to STDOUT. The method +parse_from_file() is almost identical, except that its two arguments are the +input and output disk files instead. See L for the specific +details. + +=head1 DIAGNOSTICS + +=over 4 + +=item roff font should be 1 or 2 chars, not `%s' + +(F) You specified a *roff font (using C, C, etc.) that +wasn't either one or two characters. Pod::Man doesn't support *roff fonts +longer than two characters, although some *roff extensions do (the canonical +versions of nroff(1) and troff(1) don't either). + +=item Invalid link %s + +(W) The POD source contained a CE> sequence that Pod::Man was +unable to parse. You should never see this error message; it probably +indicates a bug in Pod::Man. + +=item Unknown escape EE%sE + +(W) The POD source contained an CE> escape that Pod::Man didn't +know about. C%sE> was printed verbatim in the output. + +=item Unknown sequence %s + +(W) The POD source contained a non-standard interior sequence (something of +the form CE>) that Pod::Man didn't know about. It was ignored. + +=item Unmatched =back + +(W) Pod::Man encountered a C<=back> command that didn't correspond to an +C<=over> command. + +=back + +=head1 BUGS + +The lint-like features and strict POD format checking done by B are +not yet implemented and should be, along with the corresponding C +option. + +The NAME section should be recognized specially and index entries emitted +for everything in that section. This would have to be deferred until the +next section, since extraneous things in NAME tends to confuse various man +page processors. + +The handling of hyphens, en dashes, and em dashes is somewhat fragile, and +one may get the wrong one under some circumstances. This should only matter +for troff(1) output. + +When and whether to use small caps is somewhat tricky, and Pod::Man doesn't +necessarily get it right. + +Pod::Man doesn't handle font names longer than two characters. Neither do +most troff(1) implementations, but GNU troff does as an extension. It would +be nice to support as an option for those who want to use it. + +The preamble added to each output file is rather verbose, and most of it is +only necessary in the presence of EEE escapes for non-ASCII +characters. It would ideally be nice if all of those definitions were only +output if needed, perhaps on the fly as the characters are used. + +Some of the automagic applied to file names assumes Unix directory +separators. + +Pod::Man is excessively slow. + +=head1 NOTES + +The intention is for this module and its driver script to eventually replace +B in Perl core. + +=head1 SEE ALSO + +L, perlpod(1), pod2man(1), nroff(1), troff(1), +man(1), man(7) + +Ossanna, Joseph F., and Brian W. Kernighan. "Troff User's Manual," +Computing Science Technical Report No. 54, AT&T Bell Laboratories. This is +the best documentation of standard nroff(1) and troff(1). At the time of +this writing, it's available at http://www.cs.bell-labs.com/cm/cs/cstr.html. + +The man page documenting the man macro set may be man(5) instead of man(7) +on your system. Also, please see pod2man(1) for extensive documentation on +writing manual pages if you've not done it before and aren't familiar with +the conventions. + +=head1 AUTHOR + +Russ Allbery Erra@stanford.eduE, based I heavily on the +original B by Tom Christiansen Etchrist@mox.perl.comE. + +=cut diff --git a/lib/Pod/Parser.pm b/lib/Pod/Parser.pm index cb1e3a6..c9c67bd8 100644 --- a/lib/Pod/Parser.pm +++ b/lib/Pod/Parser.pm @@ -1,10 +1,7 @@ ############################################################################# # Pod/Parser.pm -- package which defines a base class for parsing POD docs. # -# Based on Tom Christiansen's Pod::Text module -# (with extensive modifications). -# -# Copyright (C) 1996-1999 Tom Christiansen. All rights reserved. +# Copyright (C) 1996-1999 by Bradford Appleton. All rights reserved. # This file is part of "PodParser". PodParser is free software; # you can redistribute it and/or modify it under the same terms # as Perl itself. @@ -13,7 +10,7 @@ package Pod::Parser; use vars qw($VERSION); -$VERSION = 1.081; ## Current version of this package +$VERSION = 1.091; ## Current version of this package require 5.004; ## requires this Perl version or later ############################################################################# @@ -74,7 +71,7 @@ Pod::Parser - base class for creating POD filters and translators =head1 REQUIRES -perl5.004, Pod::InputObjects, Exporter, FileHandle, Carp +perl5.004, Pod::InputObjects, Exporter, Carp =head1 EXPORTS @@ -145,6 +142,50 @@ For the most part, the B base class should be able to do most of the input parsing for you and leave you free to worry about how to intepret the commands and translate the result. +Note that all we have described here in this quick overview overview is +the simplest most striaghtforward use of B to do stream-based +parsing. It is also possible to use the B function +to do more sophisticated tree-based parsing. See L<"TREE-BASED PARSING">. + +=head1 PARSING OPTIONS + +A I is simply a named option of B with a +value that corresponds to a certain specified behavior. These various +behaviors of B may be enabled/disabled by setting or +or unsetting one or more I using the B method. +The set of currently accepted parse-options is as follows: + +=over 3 + +=item B<-want_nonPODs> (default: unset) + +Normally (by default) B will only provide access to +the POD sections of the input. Input paragraphs that are not part +of the POD-format documentation are not made available to the caller +(not even using B). Setting this option to a +non-empty, non-zero value will allow B to see +non-POD sections of the input as well as POD sections. The B +method can be used to determine if the corresponding paragraph is a POD +paragraph, or some other input paragraph. + +=item B<-process_cut_cmd> (default: unset) + +Normally (by default) B handles the C<=cut> POD directive +by itself and does not pass it on to the caller for processing. Setting +this option to non-empty, non-zero value will cause B to +pass the C<=cut> directive to the caller just like any other POD command +(and hence it may be processed by the B method). + +B will still interpret the C<=cut> directive to mean that +"cutting mode" has been (re)entered, but the caller will get a chance +to capture the actual C<=cut> paragraph itself for whatever purpose +it desires. + +=back + +Please see L<"parseopts()"> for a complete description of the interface +for the setting and unsetting of parse-options. + =cut ############################################################################# @@ -154,12 +195,11 @@ use strict; #use diagnostics; use Pod::InputObjects; use Carp; -use FileHandle; use Exporter; @ISA = qw(Exporter); ## These "variables" are used as local "glob aliases" for performance -use vars qw(%myData @input_stack); +use vars qw(%myData %myOpts @input_stack); ############################################################################# @@ -547,18 +587,20 @@ The value returned should correspond to the new text to use in its place If the empty string is returned or an undefined value is returned, then the given C<$text> is ignored (not processed). -This method is invoked after gathering up all thelines in a paragraph +This method is invoked after gathering up all the lines in a paragraph +and after determining the cutting state of the paragraph, but before trying to further parse or interpret them. After B returns, the current cutting state (which is returned by C<$self-Ecutting()>) is examined. If it evaluates -to false then input text (including the given C<$text>) is cut (not +to true then input text (including the given C<$text>) is cut (not processed) until the next POD directive is encountered. Please note that the B method is invoked I the B method. After all (possibly preprocessed) -lines in a paragraph have been assembled together and it has been +lines in a paragraph have been assembled together and either it has been determined that the paragraph is part of the POD documentation from one -of the selected sections, then B is invoked. +of the selected sections or the C<-want_nonPODs> option is true, +then B is invoked. The base class implementation of this method returns the given text. @@ -574,8 +616,9 @@ sub preprocess_paragraph { =head1 METHODS FOR PARSING AND PROCESSING B provides several methods to process input text. These -methods typically won't need to be overridden, but subclasses may want -to invoke them to exploit their functionality. +methods typically won't need to be overridden (and in some cases they +can't be overridden), but subclasses may want to invoke them to exploit +their functionality. =cut @@ -629,6 +672,31 @@ is a reference to the interior-sequence object. [I: If the B method is specified, then it is invoked according to the interface specified in L<"interior_sequence()">]. +=item B<-expand_text> =E I|I + +Normally, the parse-tree returned by B will contain a +text-string for each contiguous sequence of characters outside of an +interior-sequence. Specifying B<-expand_text> tells B to +"preprocess" every such text-string it sees by invoking the referenced +function (or named method of the parser object) and using the return value +as the preprocessed (or "expanded") result. [Note that if the result is +an interior-sequence, then it will I be expanded as specified by the +B<-expand_seq> option; Any such recursive expansion needs to be handled by +the specified callback routine.] + +If a subroutine reference was given, it is invoked as: + + &$code_ref( $parser, $text, $ptree_node ) + +and if a method-name was given, it is invoked as: + + $parser->method_name( $text, $ptree_node ) + +where C<$parser> is a reference to the parser object, C<$text> is the +text-string encountered, and C<$ptree_node> is a reference to the current +node in the parse-tree (usually an interior-sequence object or else the +top-level node of the parse-tree). + =item B<-expand_ptree> =E I|I Rather than returning a C, pass the parse-tree as an @@ -652,10 +720,10 @@ is a reference to the parse-tree object. ## This global regex is used to see if the text before a '>' inside ## an interior sequence looks like '-' or '=', but not '--', '==', -## '$-', or '$=' +## '!=', '$-', '$=' or <>= use vars qw( $ARROW_RE ); -$ARROW_RE = join('', qw{ (?: [^-+*/=!&|%^x.<>$]= | [^$-]- )$ }); -#$ARROW_RE = qr/(?:[^=]+=|[^-]+-)$/; ## 5.005+ only! +$ARROW_RE = join('', qw{ (?: [^-+*/=!&|%^x.<>$]= | [^-$]- )$ }); +#$ARROW_RE = qr/(?:[^-+*/=!&|%^x.<>$]+=|[^-$]+-)$/; ## 5.005+ only! sub parse_text { my $self = shift; @@ -664,6 +732,7 @@ sub parse_text { ## Get options and set any defaults my %opts = (ref $_[0]) ? %{ shift() } : (); my $expand_seq = $opts{'-expand_seq'} || undef; + my $expand_text = $opts{'-expand_text'} || undef; my $expand_ptree = $opts{'-expand_ptree'} || undef; my $text = shift; @@ -673,6 +742,7 @@ sub parse_text { ## Convert method calls into closures, for our convenience my $xseq_sub = $expand_seq; + my $xtext_sub = $expand_text; my $xptree_sub = $expand_ptree; if (defined $expand_seq and $expand_seq eq 'interior_sequence') { ## If 'interior_sequence' is the method to use, we have to pass @@ -685,6 +755,7 @@ sub parse_text { }; } ref $xseq_sub or $xseq_sub = sub { shift()->$expand_seq(@_) }; + ref $xtext_sub or $xtext_sub = sub { shift()->$expand_text(@_) }; ref $xptree_sub or $xptree_sub = sub { shift()->$expand_ptree(@_) }; ## Keep track of the "current" interior sequence, and maintain a stack @@ -729,19 +800,24 @@ sub parse_text { ## Remember the current cmd-name $cmd = (@seq_stack > 1) ? $seq_stack[-1]->name : ''; } - else { - ## In the middle of a sequence, append this text to it - $seq->append($_) if length; + elsif (length) { + ## In the middle of a sequence, append this text to it, and + ## dont forget to "expand" it if that's what the caller wanted + $seq->append($expand_text ? &$xtext_sub($self,$_,$seq) : $_); } ## Remember the "current" sequence and the previously seen token ($seq, $prev) = ( $seq_stack[-1], $_ ); } ## Handle unterminated sequences + my $errorsub = (@seq_stack > 1) ? $self->errorsub() : undef; while (@seq_stack > 1) { ($cmd, $file, $line) = ($seq->name, $seq->file_line); pop @seq_stack; - warn "** Unterminated $cmd<...> at $file line $line\n"; + my $errmsg = "** Unterminated $cmd<...> at $file line $line\n"; + (ref $errorsub) and &{$errorsub}($errmsg) + or (defined $errorsub) and $self->$errorsub($errmsg) + or warn($errmsg); $seq_stack[-1]->append($expand_seq ? &$xseq_sub($self,$seq) : $seq); $seq = $seq_stack[-1]; } @@ -788,7 +864,8 @@ This method takes the text of a POD paragraph to be processed, along with its corresponding line number, and invokes the appropriate method (one of B, B, or B). -This method does I usually need to be overridden by subclasses. +For performance reasons, this method is invoked directly without any +dynamic lookup; Hence subclasses may I override it! =end __PRIVATE__ @@ -796,15 +873,21 @@ This method does I usually need to be overridden by subclasses. sub parse_paragraph { my ($self, $text, $line_num) = @_; - local *myData = $self; ## an alias to avoid deref-ing overhead + local *myData = $self; ## alias to avoid deref-ing overhead + local *myOpts = ($myData{_PARSEOPTS} ||= {}); ## get parse-options local $_; - ## This is the end of a non-empty paragraph + ## See if we want to preprocess nonPOD paragraphs as well as POD ones. + my $wantNonPods = $myOpts{'-want_nonPODs'}; + + ## Update cutting status + $myData{_CUTTING} = 0 if $text =~ /^={1,2}\S/; + + ## Perform any desired preprocessing if we wanted it this early + $wantNonPods and $text = $self->preprocess_paragraph($text, $line_num); + ## Ignore up until next POD directive if we are cutting - if ($myData{_CUTTING}) { - return unless ($text =~ /^={1,2}\S/); - $myData{_CUTTING} = 0; - } + return if $myData{_CUTTING}; ## Now we know this is block of text in a POD section! @@ -822,10 +905,13 @@ sub parse_paragraph { $self->is_selected($text) or return ($myData{_CUTTING} = 1); } - ## Perform any desired preprocessing and re-check the "cutting" state - $text = $self->preprocess_paragraph($text, $line_num); - return 1 unless ((defined $text) and (length $text)); - return 1 if ($myData{_CUTTING}); + ## If we havent already, perform any desired preprocessing and + ## then re-check the "cutting" state + unless ($wantNonPods) { + $text = $self->preprocess_paragraph($text, $line_num); + return 1 unless ((defined $text) and (length $text)); + return 1 if ($myData{_CUTTING}); + } ## Look for one of the three types of paragraphs my ($pfx, $cmd, $arg, $sep) = ('', '', '', ''); @@ -842,7 +928,7 @@ sub parse_paragraph { ## except return to "cutting" mode. if ($cmd eq 'cut') { $myData{_CUTTING} = 1; - return; + return unless $myOpts{'-process_cut_cmd'}; } } ## Save the attributes indicating how the command was specified. @@ -1012,7 +1098,7 @@ sub parse_from_file { my $self = shift; my %opts = (ref $_[0] eq 'HASH') ? %{ shift() } : (); my ($infile, $outfile) = @_; - my ($in_fh, $out_fh) = (undef, undef); + my ($in_fh, $out_fh); my ($close_input, $close_output) = (0, 0); local *myData = $self; local $_; @@ -1033,7 +1119,7 @@ sub parse_from_file { else { ## We have a filename, open it for reading $myData{_INFILE} = $infile; - $in_fh = FileHandle->new("< $infile") or + open($in_fh, "< $infile") or croak "Can't open $infile for reading: $!\n"; $close_input = 1; } @@ -1069,7 +1155,7 @@ sub parse_from_file { else { ## We have a filename, open it for writing $myData{_OUTFILE} = $outfile; - $out_fh = FileHandle->new("> $outfile") or + open($out_fh, "> $outfile") or croak "Can't open $outfile for writing: $!\n"; $close_output = 1; } @@ -1097,6 +1183,35 @@ instance data fields: ##--------------------------------------------------------------------------- +=head1 B + + $parser->errorsub("method_name"); + $parser->errorsub(\&warn_user); + $parser->errorsub(sub { print STDERR, @_ }); + +Specifies the method or subroutine to use when printing error messages +about POD syntax. The supplied method/subroutine I return TRUE upon +successful printing of the message. If C is given, then the B +builtin is used to issue error messages (this is the default behavior). + + my $errorsub = $parser->errorsub() + my $errmsg = "This is an error message!\n" + (ref $errorsub) and &{$errorsub}($errmsg) + or (defined $errorsub) and $parser->$errorsub($errmsg) + or warn($errmsg); + +Returns a method name, or else a reference to the user-supplied subroutine +used to print error messages. Returns C if the B builtin +is used to issue error messages (this is the default behavior). + +=cut + +sub errorsub { + return (@_ > 1) ? ($_[0]->{_ERRORSUB} = $_[1]) : $_[0]->{_ERRORSUB}; +} + +##--------------------------------------------------------------------------- + =head1 B $boolean = $parser->cutting(); @@ -1118,6 +1233,58 @@ sub cutting { ##--------------------------------------------------------------------------- +##--------------------------------------------------------------------------- + +=head1 B + +When invoked with no additional arguments, B returns a hashtable +of all the current parsing options. + + ## See if we are parsing non-POD sections as well as POD ones + my %opts = $parser->parseopts(); + $opts{'-want_nonPODs}' and print "-want_nonPODs\n"; + +When invoked using a single string, B treats the string as the +name of a parse-option and returns its corresponding value if it exists +(returns C if it doesn't). + + ## Did we ask to see '=cut' paragraphs? + my $want_cut = $parser->parseopts('-process_cut_cmd'); + $want_cut and print "-process_cut_cmd\n"; + +When invoked with multiple arguments, B treats them as +key/value pairs and the specified parse-option names are set to the +given values. Any unspecified parse-options are unaffected. + + ## Set them back to the default + $parser->parseopts(-process_cut_cmd => 0); + +When passed a single hash-ref, B uses that hash to completely +reset the existing parse-options, all previous parse-option values +are lost. + + ## Reset all options to default + $parser->parseopts( { } ); + +See L<"PARSING OPTIONS"> for more for the name and meaning of each +parse-option currently recognized. + +=cut + +sub parseopts { + local *myData = shift; + local *myOpts = ($myData{_PARSEOPTS} ||= {}); + return %myOpts if (@_ == 0); + if (@_ == 1) { + local $_ = shift; + return ref($_) ? $myData{_PARSEOPTS} = $_ : $myOpts{$_}; + } + my @newOpts = (%myOpts, @_); + $myData{_PARSEOPTS} = { @newOpts }; +} + +##--------------------------------------------------------------------------- + =head1 B $fname = $parser->output_file(); @@ -1361,6 +1528,159 @@ sub _pop_input_stream { ############################################################################# +=head1 TREE-BASED PARSING + +If straightforward stream-based parsing wont meet your needs (as is +likely the case for tasks such as translating PODs into structured +markup languages like HTML and XML) then you may need to take the +tree-based approach. Rather than doing everything in one pass and +calling the B method to expand sequences into text, it +may be desirable to instead create a parse-tree using the B +method to return a tree-like structure which may contain an ordered list +list of children (each of which may be a text-string, or a similar +tree-like structure). + +Pay special attention to L<"METHODS FOR PARSING AND PROCESSING"> and +to the objects described in L. The former describes +the gory details and parameters for how to customize and extend the +parsing behavior of B. B provides +several objects that may all be used interchangeably as parse-trees. The +most obvious one is the B object. It defines the basic +interface and functionality that all things trying to be a POD parse-tree +should do. A B is defined such that each "node" may be a +text-string, or a reference to another parse-tree. Each B +object and each B object also supports the basic +parse-tree interface. + +The B method takes a given paragraph of text, and +returns a parse-tree that contains one or more children, each of which +may be a text-string, or an InteriorSequence object. There are also +callback-options that may be passed to B to customize +the way it expands or transforms interior-sequences, as well as the +returned result. These callbacks can be used to create a parse-tree +with custom-made objects (which may or may not support the parse-tree +interface, depending on how you choose to do it). + +If you wish to turn an entire POD document into a parse-tree, that process +is fairly straightforward. The B method is the key to doing +this successfully. Every paragraph-callback (i.e. the polymorphic methods +for B, B, and B paragraphs) takes +a B object as an argument. Each paragraph object has a +B method that can be used to get or set a corresponding +parse-tree. So for each of those paragraph-callback methods, simply call +B with the options you desire, and then use the returned +parse-tree to assign to the given paragraph object. + +That gives you a parse-tree for each paragraph - so now all you need is +an ordered list of paragraphs. You can maintain that yourself as a data +element in the object/hash. The most straightforward way would be simply +to use an array-ref, with the desired set of custom "options" for each +invocation of B. Let's assume the desired option-set is +given by the hash C<%options>. Then we might do something like the +following: + + package MyPodParserTree; + + @ISA = qw( Pod::Parser ); + + ... + + sub begin_pod { + my $self = shift; + $self->{'-paragraphs'} = []; ## initialize paragraph list + } + + sub command { + my ($parser, $command, $paragraph, $line_num, $pod_para) = @_; + my $ptree = $parser->parse_text({%options}, $paragraph, ...); + $pod_para->parse_tree( $ptree ); + push @{ $self->{'-paragraphs'} }, $pod_para; + } + + sub verbatim { + my ($parser, $paragraph, $line_num, $pod_para) = @_; + push @{ $self->{'-paragraphs'} }, $pod_para; + } + + sub textblock { + my ($parser, $paragraph, $line_num, $pod_para) = @_; + my $ptree = $parser->parse_text({%options}, $paragraph, ...); + $pod_para->parse_tree( $ptree ); + push @{ $self->{'-paragraphs'} }, $pod_para; + } + + ... + + package main; + ... + my $parser = new MyPodParserTree(...); + $parser->parse_from_file(...); + my $paragraphs_ref = $parser->{'-paragraphs'}; + +Of course, in this module-author's humble opinion, I'd be more inclined to +use the existing B object than a simple array. That way +everything in it, paragraphs and sequences, all respond to the same core +interface for all parse-tree nodes. The result would look something like: + + package MyPodParserTree2; + + ... + + sub begin_pod { + my $self = shift; + $self->{'-ptree'} = new Pod::ParseTree; ## initialize parse-tree + } + + sub parse_tree { + ## convenience method to get/set the parse-tree for the entire POD + (@_ > 1) and $_[0]->{'-ptree'} = $_[1]; + return $_[0]->{'-ptree'}; + } + + sub command { + my ($parser, $command, $paragraph, $line_num, $pod_para) = @_; + my $ptree = $parser->parse_text({<>}, $paragraph, ...); + $pod_para->parse_tree( $ptree ); + $parser->parse_tree()->append( $pod_para ); + } + + sub verbatim { + my ($parser, $paragraph, $line_num, $pod_para) = @_; + $parser->parse_tree()->append( $pod_para ); + } + + sub textblock { + my ($parser, $paragraph, $line_num, $pod_para) = @_; + my $ptree = $parser->parse_text({<>}, $paragraph, ...); + $pod_para->parse_tree( $ptree ); + $parser->parse_tree()->append( $pod_para ); + } + + ... + + package main; + ... + my $parser = new MyPodParserTree2(...); + $parser->parse_from_file(...); + my $ptree = $parser->parse_tree; + ... + +Now you have the entire POD document as one great big parse-tree. You +can even use the B<-expand_seq> option to B to insert +whole different kinds of objects. Just don't expect B +to know what to do with them after that. That will need to be in your +code. Or, alternatively, you can insert any object you like so long as +it conforms to the B interface. + +One could use this to create subclasses of B and +B for specific commands (or to create your own +custom node-types in the parse-tree) and add some kind of B +method to each custom node/subclass object in the tree. Then all you'd +need to do is recursively walk the tree in the desired order, processing +the children (most likely from left to right) by formatting them if +they are text-strings, or by calling their B method if they +are objects/references. + =head1 SEE ALSO L, L diff --git a/lib/Pod/PlainText.pm b/lib/Pod/PlainText.pm deleted file mode 100644 index 3816bad..0000000 --- a/lib/Pod/PlainText.pm +++ /dev/null @@ -1,650 +0,0 @@ -############################################################################# -# Pod/PlainText.pm -- convert POD data to formatted ASCII text -# -# Derived from Tom Christiansen's Pod::PlainText module -# (with extensive modifications). -# -# Copyright (C) 1994-1999 Tom Christiansen. All rights reserved. -# This file is part of "PodParser". PodParser is free software; -# you can redistribute it and/or modify it under the same terms -# as Perl itself. -############################################################################# - -package Pod::PlainText; - -use vars qw($VERSION); -$VERSION = 1.081; ## Current version of this package -require 5.004; ## requires this Perl version or later - -=head1 NAME - -pod2plaintext - function to convert POD data to formatted ASCII text - -Pod::PlainText - a class for converting POD data to formatted ASCII text - -=head1 SYNOPSIS - - use Pod::PlainText; - pod2plaintext("perlfunc.pod"); - -or - - use Pod::PlainText; - package MyParser; - @ISA = qw(Pod::PlainText); - - sub new { - ## constructor code ... - } - - ## implementation of appropriate subclass methods ... - - package main; - $parser = new MyParser; - @ARGV = ('-') unless (@ARGV > 0); - for (@ARGV) { - $parser->parse_from_file($_); - } - -=head1 REQUIRES - -perl5.004, Pod::Select, Term::Cap, Exporter, Carp - -=head1 EXPORTS - -pod2plaintext() - -=head1 DESCRIPTION - -Pod::PlainText is a module that can convert documentation in the POD -format (such as can be found throughout the Perl distribution) into -formatted ASCII. Termcap is optionally supported for -boldface/underline, and can be enabled via C<$Pod::PlainText::termcap=1>. -If termcap has not been enabled, then backspaces will be used to -simulate bold and underlined text. - -A separate F program is included that is primarily a wrapper -for C. - -The single function C can take one or two arguments. The first -should be the name of a file to read the pod from, or "<&STDIN" to read from -STDIN. A second argument, if provided, should be a filehandle glob where -output should be sent. - -=head1 SEE ALSO - -L. - -=head1 AUTHOR - -Tom Christiansen Etchrist@mox.perl.comE - -Modified to derive from B by -Brad Appleton Ebradapp@enteract.comE - -=cut - -############################################################################# - -use strict; -#use diagnostics; -use Carp; -use Exporter; -use Pod::Select; -use Term::Cap; -use vars qw(@ISA @EXPORT %HTML_Escapes); - -@ISA = qw(Exporter Pod::Select); -@EXPORT = qw(&pod2plaintext); - -%HTML_Escapes = ( - 'amp' => '&', # ampersand - 'lt' => '<', # left chevron, less-than - 'gt' => '>', # right chevron, greater-than - 'quot' => '"', # double quote - - "Aacute" => "\xC1", # capital A, acute accent - "aacute" => "\xE1", # small a, acute accent - "Acirc" => "\xC2", # capital A, circumflex accent - "acirc" => "\xE2", # small a, circumflex accent - "AElig" => "\xC6", # capital AE diphthong (ligature) - "aelig" => "\xE6", # small ae diphthong (ligature) - "Agrave" => "\xC0", # capital A, grave accent - "agrave" => "\xE0", # small a, grave accent - "Aring" => "\xC5", # capital A, ring - "aring" => "\xE5", # small a, ring - "Atilde" => "\xC3", # capital A, tilde - "atilde" => "\xE3", # small a, tilde - "Auml" => "\xC4", # capital A, dieresis or umlaut mark - "auml" => "\xE4", # small a, dieresis or umlaut mark - "Ccedil" => "\xC7", # capital C, cedilla - "ccedil" => "\xE7", # small c, cedilla - "Eacute" => "\xC9", # capital E, acute accent - "eacute" => "\xE9", # small e, acute accent - "Ecirc" => "\xCA", # capital E, circumflex accent - "ecirc" => "\xEA", # small e, circumflex accent - "Egrave" => "\xC8", # capital E, grave accent - "egrave" => "\xE8", # small e, grave accent - "ETH" => "\xD0", # capital Eth, Icelandic - "eth" => "\xF0", # small eth, Icelandic - "Euml" => "\xCB", # capital E, dieresis or umlaut mark - "euml" => "\xEB", # small e, dieresis or umlaut mark - "Iacute" => "\xCD", # capital I, acute accent - "iacute" => "\xED", # small i, acute accent - "Icirc" => "\xCE", # capital I, circumflex accent - "icirc" => "\xEE", # small i, circumflex accent - "Igrave" => "\xCD", # capital I, grave accent - "igrave" => "\xED", # small i, grave accent - "Iuml" => "\xCF", # capital I, dieresis or umlaut mark - "iuml" => "\xEF", # small i, dieresis or umlaut mark - "Ntilde" => "\xD1", # capital N, tilde - "ntilde" => "\xF1", # small n, tilde - "Oacute" => "\xD3", # capital O, acute accent - "oacute" => "\xF3", # small o, acute accent - "Ocirc" => "\xD4", # capital O, circumflex accent - "ocirc" => "\xF4", # small o, circumflex accent - "Ograve" => "\xD2", # capital O, grave accent - "ograve" => "\xF2", # small o, grave accent - "Oslash" => "\xD8", # capital O, slash - "oslash" => "\xF8", # small o, slash - "Otilde" => "\xD5", # capital O, tilde - "otilde" => "\xF5", # small o, tilde - "Ouml" => "\xD6", # capital O, dieresis or umlaut mark - "ouml" => "\xF6", # small o, dieresis or umlaut mark - "szlig" => "\xDF", # small sharp s, German (sz ligature) - "THORN" => "\xDE", # capital THORN, Icelandic - "thorn" => "\xFE", # small thorn, Icelandic - "Uacute" => "\xDA", # capital U, acute accent - "uacute" => "\xFA", # small u, acute accent - "Ucirc" => "\xDB", # capital U, circumflex accent - "ucirc" => "\xFB", # small u, circumflex accent - "Ugrave" => "\xD9", # capital U, grave accent - "ugrave" => "\xF9", # small u, grave accent - "Uuml" => "\xDC", # capital U, dieresis or umlaut mark - "uuml" => "\xFC", # small u, dieresis or umlaut mark - "Yacute" => "\xDD", # capital Y, acute accent - "yacute" => "\xFD", # small y, acute accent - "yuml" => "\xFF", # small y, dieresis or umlaut mark - - "lchevron" => "\xAB", # left chevron (double less than) - "rchevron" => "\xBB", # right chevron (double greater than) -); - -##--------------------------------- -## Function definitions begin here -##--------------------------------- - - ## Try to find #columns for the tty -my %NotUnix = map {($_ => 1)} qw(MacOS MSWin32 VMS MVS); -sub get_screen { - ((defined $ENV{TERMCAP}) && ($ENV{TERMCAP} =~ /co#(\d+)/)[0]) - or ((defined $ENV{COLUMNS}) && $ENV{COLUMNS}) - or (!$NotUnix{$^O} && (`stty -a 2>/dev/null` =~ /(\d+) columns/)[0]) - or 72; - -} - -sub pod2plaintext { - my ($infile, $outfile) = @_; - local $_; - my $text_parser = new Pod::PlainText; - $text_parser->parse_from_file($infile, $outfile); -} - -##------------------------------- -## Method definitions begin here -##------------------------------- - -sub new { - my $this = shift; - my $class = ref($this) || $this; - my %params = @_; - my $self = {%params}; - bless $self, $class; - $self->initialize(); - return $self; -} - -sub initialize { - my $self = shift; - $self->SUPER::initialize(); - return; -} - -sub makespace { - my $self = shift; - my $out_fh = $self->output_handle(); - if ($self->{NEEDSPACE}) { - print $out_fh "\n"; - $self->{NEEDSPACE} = 0; - } -} - -sub bold { - my $self = shift; - my $line = shift; - my $map = $self->{FONTMAP}; - return $line if $self->{USE_FORMAT}; - if ($self->{TERMCAP}) { - $line = "$map->{BOLD}$line$map->{NORM}"; - } - else { - $line =~ s/(.)/$1\b$1/g; - } -# $line = "$map->{BOLD}$line$map->{NORM}" if $self->{ANSIFY}; - return $line; -} - -sub italic { - my $self = shift; - my $line = shift; - my $map = $self->{FONTMAP}; - return $line if $self->{USE_FORMAT}; - if ($self->{TERMCAP}) { - $line = "$map->{UNDL}$line$map->{NORM}"; - } - else { - $line =~ s/(.)/$1\b_/g; - } -# $line = "$map->{UNDL}$line$map->{NORM}" if $self->{ANSIFY}; - return $line; -} - -# Fill a paragraph including underlined and overstricken chars. -# It's not perfect for words longer than the margin, and it's probably -# slow, but it works. -sub fill { - my $self = shift; - local $_ = shift; - my $par = ""; - my $indent_space = " " x $self->{INDENT}; - my $marg = $self->{SCREEN} - $self->{INDENT}; - my $line = $indent_space; - my $line_length; - foreach (split) { - my $word_length = length; - $word_length -= 2 while /\010/g; # Subtract backspaces - - if ($line_length + $word_length > $marg) { - $par .= $line . "\n"; - $line= $indent_space . $_; - $line_length = $word_length; - } - else { - if ($line_length) { - $line_length++; - $line .= " "; - } - $line_length += $word_length; - $line .= $_; - } - } - $par .= "$line\n" if length $line; - $par .= "\n"; - return $par; -} - -## Handle a pending "item" paragraph. The paragraph (if given) is the -## corresponding item text. (the item tag should be in $self->{ITEM}). -sub item { - my $self = shift; - my $cmd = shift; - local $_ = shift; - my $line = shift; - $cmd = '' unless (defined $cmd); - $_ = '' unless (defined $_); - my $out_fh = $self->output_handle(); - return unless (defined $self->{ITEM}); - my $paratag = $self->{ITEM}; - my $prev_indent = $self->{INDENTS}->[-1] || $self->{DEF_INDENT}; - ## reset state - undef $self->{ITEM}; - #$self->rm_callbacks('*'); - - my $over = $self->{INDENT}; - $over -= $prev_indent if ($prev_indent < $over); - if (length $cmd) { # tricked - this is another command - $self->output($paratag, INDENT => $prev_indent); - $self->command($cmd, $_); - } - elsif (/^\s+/o) { # verbatim - $self->output($paratag, INDENT => $prev_indent); - s/\s+\Z//; - $self->verbatim($_); - } - else { # plain textblock - $_ = $self->interpolate($_, $line); - s/\s+\Z//; - if ((length $_) && (length($paratag) <= $over)) { - $self->IP_output($paratag, $_); - } - else { - $self->output($paratag, INDENT => $prev_indent); - $self->output($_, REFORMAT => 1); - } - } -} - -sub remap_whitespace { - my $self = shift; - local($_) = shift; - tr/\000-\177/\200-\377/; - return $_; -} - -sub unmap_whitespace { - my $self = shift; - local($_) = shift; - tr/\200-\377/\000-\177/; - return $_; -} - -sub IP_output { - my $self = shift; - my $tag = shift; - local($_) = @_; - my $out_fh = $self->output_handle(); - my $tag_indent = $self->{INDENTS}->[-1] || $self->{DEF_INDENT}; - my $tag_cols = $self->{SCREEN} - $tag_indent; - my $cols = $self->{SCREEN} - $self->{INDENT}; - $tag =~ s/\s*$//; - s/\s+/ /g; - s/^ //; - my $fmt_name = '_Pod_Text_IP_output_format_'; - my $str = "format $fmt_name = \n" - . (" " x ($tag_indent)) - . '@' . ('<' x ($self->{INDENT} - $tag_indent - 1)) - . "^" . ("<" x ($cols - 1)) . "\n" - . '$tag, $_' - . "\n~~" - . (" " x ($self->{INDENT} - 2)) - . "^" . ("<" x ($cols - 5)) . "\n" - . '$_' . "\n\n.\n1"; - #warn $str; warn "tag is $tag, _ is $_"; - { - ## reset format (turn off warning about redefining a format) - local($^W) = 0; - eval $str; - croak if ($@); - } - select((select($out_fh), $~ = $fmt_name)[0]); - local($:) = ($self->curr_headings(1) eq 'SYNOPSIS') ? "\n " : $: ; - write $out_fh; -} - -sub output { - my $self = shift; - local $_ = shift; - $_ = '' unless (defined $_); - return unless (length $_); - my $out_fh = $self->output_handle(); - my %options; - if (@_ > 1) { - ## usage was $self->output($text, NAME=>VALUE, ...); - %options = @_; - } - elsif (@_ == 1) { - if (ref $_[0]) { - ## usage was $self->output($text, { NAME=>VALUE, ... } ); - %options = %{$_[0]}; - } - else { - ## usage was $self->output($text, $number); - $options{"REFORMAT"} = shift; - } - } - $options{"INDENT"} = $self->{INDENT} unless (defined $options{"INDENT"}); - if ((defined $options{"REFORMAT"}) && $options{"REFORMAT"}) { - my $cols = $self->{SCREEN} - $options{"INDENT"}; - s/\s+/ /g; - s/^ //; - my $fmt_name = '_Pod_Text_output_format_'; - my $str = "format $fmt_name = \n~~" - . (" " x ($options{"INDENT"} - 2)) - . "^" . ("<" x ($cols - 5)) . "\n" - . '$_' . "\n\n.\n1"; - { - ## reset format (turn off warning about redefining a format) - local($^W) = 0; - eval $str; - croak if ($@); - } - select((select($out_fh), $~ = $fmt_name)[0]); - local($:) = ($self->curr_headings(1) eq 'SYNOPSIS') ? "\n " : $: ; - write $out_fh; - } - else { - s/^/' ' x $options{"INDENT"}/gem; - s/^\s+\n$/\n/gm; - print $out_fh $_; - } -} - -sub internal_lrefs { - my $self = shift; - local $_ = shift; - s{L]+)>}{$1}g; - my(@items) = split( /(?:,?\s+(?:and\s+)?)/ ); - my $retstr = "the "; - my $i; - for ($i = 0; $i <= $#items; $i++) { - $retstr .= "C<$items[$i]>"; - $retstr .= ", " if @items > 2 && $i != $#items; - $retstr .= " and " if $i+2 == @items; - } - - $retstr .= " entr" . ( @items > 1 ? "ies" : "y" ) - . " elsewhere in this document "; - - return $retstr; -} - -sub begin_pod { - my $self = shift; - - $self->{BEGUN} = []; - $self->{TERMCAP} = 0; - #$self->{USE_FORMAT} = 1; - - $self->{FONTMAP} = { - UNDL => "\x1b[4m", - INV => "\x1b[7m", - BOLD => "\x1b[1m", - NORM => "\x1b[0m", - }; - if ($self->{TERMCAP} and (! defined $self->{SETUPTERMCAP})) { - $self->{SETUPTERMCAP} = 1; - my ($term) = Tgetent Term::Cap { TERM => undef, OSPEED => 9600 }; - $self->{FONTMAP}->{UNDL} = $term->{'_us'}; - $self->{FONTMAP}->{INV} = $term->{'_mr'}; - $self->{FONTMAP}->{BOLD} = $term->{'_md'}; - $self->{FONTMAP}->{NORM} = $term->{'_me'}; - } - - $self->{SCREEN} = &get_screen; - $self->{FANCY} = 0; - $self->{DEF_INDENT} = 4; - $self->{INDENTS} = []; - $self->{INDENT} = $self->{DEF_INDENT}; - $self->{NEEDSPACE} = 0; -} - -sub end_pod { - my $self = shift; - $self->item('', '', '', 0) if (defined $self->{ITEM}); -} - -sub begun_excluded { - my $self = shift; - my @begun = @{ $self->{BEGUN} }; - return (@begun > 0) ? ($begun[-1] ne 'text') : 0; -} - -sub command { - my $self = shift; - my $cmd = shift; - local $_ = shift; - my $line = shift; - $cmd = '' unless (defined $cmd); - $_ = '' unless (defined $_); - my $out_fh = $self->output_handle(); - - return if (($cmd ne 'end') and $self->begun_excluded()); - return $self->item($cmd, $_, $line) if (defined $self->{ITEM}); - $_ = $self->interpolate($_, $line); - s/\s+\Z/\n/; - - return if ($cmd eq 'pod'); - if ($cmd eq 'head1') { - $self->makespace(); - print $out_fh $_; - # print $out_fh uc($_); - } - elsif ($cmd eq 'head2') { - $self->makespace(); - # s/(\w+)/\u\L$1/g; - #print ' ' x $self->{DEF_INDENT}, $_; - # print "\xA7"; - s/(\w)/\xA7 $1/ if $self->{FANCY}; - print $out_fh ' ' x ($self->{DEF_INDENT}/2), $_, "\n"; - } - elsif ($cmd eq 'over') { - /^[-+]?\d+$/ or $_ = $self->{DEF_INDENT}; - push(@{$self->{INDENTS}}, $self->{INDENT}); - $self->{INDENT} += ($_ + 0); - } - elsif ($cmd eq 'back') { - $self->{INDENT} = pop(@{$self->{INDENTS}}); - unless (defined $self->{INDENT}) { - carp "Unmatched =back\n"; - $self->{INDENT} = $self->{DEF_INDENT}; - } - } - elsif ($cmd eq 'begin') { - my ($kind) = /^(\S*)/; - push( @{ $self->{BEGUN} }, $kind ); - } - elsif ($cmd eq 'end') { - pop( @{ $self->{BEGUN} } ); - } - elsif ($cmd eq 'for') { - $self->textblock($1) if /^text\b\s*(.*)$/s; - } - elsif ($cmd eq 'item') { - $self->makespace(); - # s/\A(\s*)\*/$1\xb7/ if $self->{FANCY}; - # s/^(\s*\*\s+)/$1 /; - $self->{ITEM} = $_; - #$self->add_callbacks('*', SUB => \&item); - } - else { - carp "Unrecognized directive: $cmd\n"; - } -} - -sub verbatim { - my $self = shift; - local $_ = shift; - my $line = shift; - return if $self->begun_excluded(); - return $self->item('', $_, $line) if (defined $self->{ITEM}); - $self->output($_); - #$self->{NEEDSPACE} = 1; -} - -sub textblock { - my $self = shift; - my $text = shift; - my $line = shift; - return if $self->begun_excluded(); - return $self->item('', $text, $line) if (defined $self->{ITEM}); - local($_) = $self->interpolate($text, $line); - s/\s*\Z/\n/; - $self->makespace(); - $self->output($_, REFORMAT => 1); -} - -sub interior_sequence { - my $self = shift; - my $cmd = shift; - my $arg = shift; - local($_) = $arg; - if ($cmd eq 'C') { - my ($pre, $post) = ("`", "'"); - ($pre, $post) = ($HTML_Escapes{"lchevron"}, $HTML_Escapes{"rchevron"}) - if ((defined $self->{FANCY}) && $self->{FANCY}); - $_ = $pre . $_ . $post; - } - elsif ($cmd eq 'E') { - if (defined $HTML_Escapes{$_}) { - $_ = $HTML_Escapes{$_}; - } - else { - carp "Unknown escape: E<$_>"; - $_ = "E<$_>"; - } - # } - # elsif ($cmd eq 'B') { - # $_ = $self->bold($_); - } - elsif ($cmd eq 'I') { - # $_ = $self->italic($_); - $_ = "*" . $_ . "*"; - } - elsif (($cmd eq 'X') || ($cmd eq 'Z')) { - $_ = ''; - } - elsif ($cmd eq 'S') { - # Escape whitespace until we are ready to print - #$_ = $self->remap_whitespace($_); - } - elsif ($cmd eq 'L') { - s/\s+/ /g; - my ($text, $manpage, $sec, $ref) = ('', $_, '', ''); - if (/\A(.*?)\|(.*)\Z/) { - $text = $1; - $manpage = $_ = $2; - } - if (/^\s*"\s*(.*)\s*"\s*$/o) { - ($manpage, $sec) = ('', "\"$1\""); - } - elsif (m|\s*/\s*|s) { - ($manpage, $sec) = split(/\s*\/\s*/, $_, 2); - } - if (! length $sec) { - $ref .= "the $manpage manpage" if (length $manpage); - } - elsif ($sec =~ /^\s*"\s*(.*)\s*"\s*$/o) { - $ref .= "the section on \"$1\""; - $ref .= " in the $manpage manpage" if (length $manpage); - } - else { - $ref .= "the \"$sec\" entry"; - $ref .= (length $manpage) ? " in the $manpage manpage" - : " in this manpage" - } - $_ = $text || $ref; - #if ( m{^ ([a-zA-Z][^\s\/]+) (\([^\)]+\))? $}x ) { - # ## LREF: a manpage(3f) - # $_ = "the $1$2 manpage"; - #} - #elsif ( m{^ ([^/]+) / ([:\w]+(\(\))?) $}x ) { - # ## LREF: an =item on another manpage - # $_ = "the \"$2\" entry in the $1 manpage"; - #} - #elsif ( m{^ / ([:\w]+(\(\))?) $}x ) { - # ## LREF: an =item on this manpage - # $_ = $self->internal_lrefs($1); - #} - #elsif ( m{^ (?: ([a-zA-Z]\S+?) / )? "?(.*?)"? $}x ) { - # ## LREF: a =head2 (head1?), maybe on a manpage, maybe right here - # ## the "func" can disambiguate - # $_ = ((defined $1) && $1) - # ? "the section on \"$2\" in the $1 manpage" - # : "the section on \"$2\""; - #} - } - return $_; -} - -1; diff --git a/lib/Pod/Select.pm b/lib/Pod/Select.pm index 26cbe02..94ded86 100644 --- a/lib/Pod/Select.pm +++ b/lib/Pod/Select.pm @@ -1,10 +1,7 @@ ############################################################################# # Pod/Select.pm -- function to select portions of POD docs # -# Based on Tom Christiansen's pod2text() function -# (with extensive modifications). -# -# Copyright (C) 1996-1999 Tom Christiansen. All rights reserved. +# Copyright (C) 1996-1999 by Bradford Appleton. All rights reserved. # This file is part of "PodParser". PodParser is free software; # you can redistribute it and/or modify it under the same terms # as Perl itself. @@ -13,7 +10,7 @@ package Pod::Select; use vars qw($VERSION); -$VERSION = 1.081; ## Current version of this package +$VERSION = 1.090; ## Current version of this package require 5.004; ## requires this Perl version or later ############################################################################# @@ -65,7 +62,7 @@ or =head1 REQUIRES -perl5.004, Pod::Parser, Exporter, FileHandle, Carp +perl5.004, Pod::Parser, Exporter, Carp =head1 EXPORTS diff --git a/lib/Pod/Text.pm b/lib/Pod/Text.pm index 88c594f..1425ea2 100644 --- a/lib/Pod/Text.pm +++ b/lib/Pod/Text.pm @@ -1,16 +1,15 @@ # Pod::Text -- Convert POD data to formatted ASCII text. -# $Id: Text.pm,v 0.2 1999/06/13 02:44:01 eagle Exp $ +# $Id: Text.pm,v 2.3 1999/10/07 09:41:57 eagle Exp $ # # Copyright 1999 by Russ Allbery # # This program is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # -# This module may potentially be a replacement for Pod::Text, although it -# does not (at the current time) attempt to match the output of Pod::Text -# and makes several different formatting choices (mostly in the direction of -# less markup). It uses Pod::Parser and is designed to be very easy to -# subclass. +# This module is intended to be a replacement for Pod::Text, and attempts to +# match its output except for some specific circumstances where other +# decisions seemed to produce better output. It uses Pod::Parser and is +# designed to be very easy to subclass. ############################################################################ # Modules and declarations @@ -20,15 +19,21 @@ package Pod::Text; require 5.004; -use Carp qw(carp); -use Pod::Parser (); +use Carp qw(carp croak); +use Exporter (); +use Pod::Select (); use strict; -use vars qw(@ISA %ESCAPES $VERSION); +use vars qw(@ISA @EXPORT %ESCAPES $VERSION); -@ISA = qw(Pod::Parser); +# We inherit from Pod::Select instead of Pod::Parser so that we can be used +# by Pod::Usage. +@ISA = qw(Pod::Select Exporter); -$VERSION = '0.01'; +# We have to export pod2text for backward compatibility. +@EXPORT = qw(pod2text); + +($VERSION = (split (' ', q$Revision: 2.3 $ ))[1]) =~ s/\.(\d)$/.0$1/; ############################################################################ @@ -36,8 +41,8 @@ $VERSION = '0.01'; ############################################################################ # This table is taken near verbatim from Pod::PlainText in Pod::Parser, -# which got it near verbatim from Pod::Text. It is therefore credited to -# Tom Christiansen, and I'm glad I didn't have to write it. :) +# which got it near verbatim from the original Pod::Text. It is therefore +# credited to Tom Christiansen, and I'm glad I didn't have to write it. :) %ESCAPES = ( 'amp' => '&', # ampersand 'lt' => '<', # left chevron, less-than @@ -126,7 +131,6 @@ sub initialize { $$self{sentence} = 0 unless defined $$self{sentence}; $$self{width} = 76 unless defined $$self{width}; - $$self{BEGUN} = []; # Stack of =begin blocks. $$self{INDENTS} = []; # Stack of indentations. $$self{MARGIN} = $$self{indent}; # Current left margin in spaces. @@ -168,14 +172,16 @@ sub verbatim { # Called for a regular text block. Gets the paragraph, the line number, and # a Pod::Paragraph object. Perform interpolation and output the results. sub textblock { - my ($self, $text, $line) = @_; + my $self = shift; return if $$self{EXCLUDE}; - local $_ = $text; + $self->output ($_[0]), return if $$self{VERBATIM}; + local $_ = shift; + my $line = shift; # Perform a little magic to collapse multiple L<> references. This is - # here mostly for backwards-compatibility with Pod::Text. We'll just - # rewrite the whole thing into actual text at this part, bypassing the - # whole internal sequence parsing thing. + # here mostly for backwards-compatibility. We'll just rewrite the whole + # thing into actual text at this part, bypassing the whole internal + # sequence parsing thing. s{ ( L< # A link of the form L. @@ -233,13 +239,17 @@ sub interior_sequence { # Expand escapes into the actual character now, carping if invalid. if ($command eq 'E') { - return $ESCAPES{$_} if defined $ESCAPES{$_}; - carp "Unknown escape: E<$_>"; - return "E<$_>"; + if (/^\d+$/) { + return chr; + } else { + return $ESCAPES{$_} if defined $ESCAPES{$_}; + carp "Unknown escape: E<$_>"; + return "E<$_>"; + } } # For all the other sequences, empty content produces no output. - return unless $_; + return if $_ eq ''; # For S<>, compress all internal whitespace and then map spaces to \01. # When we output the text, we'll map this back. @@ -279,6 +289,7 @@ sub cmd_head1 { my $self = shift; local $_ = shift; s/\s+$//; + $_ = $self->interpolate ($_, shift); if ($$self{alt}) { $self->output ("\n==== $_ ====\n\n"); } else { @@ -292,6 +303,7 @@ sub cmd_head2 { my $self = shift; local $_ = shift; s/\s+$//; + $_ = $self->interpolate ($_, shift); if ($$self{alt}) { $self->output ("\n== $_ ==\n\n"); } else { @@ -327,38 +339,35 @@ sub cmd_item { $$self{ITEM} = $self->interpolate ($_); } -# Begin a block for a particular translator. To allow for weird nested -# =begin blocks, keep track of how many blocks we were excluded from and -# only unwind one level with each =end. +# Begin a block for a particular translator. Setting VERBATIM triggers +# special handling in textblock(). sub cmd_begin { my $self = shift; local $_ = shift; my ($kind) = /^(\S+)/ or return; - push (@{ $$self{BEGUN} }, $kind); - $$self{EXCLUDE}++ unless $kind eq 'text'; + if ($kind eq 'text') { + $$self{VERBATIM} = 1; + } else { + $$self{EXCLUDE} = 1; + } } # End a block for a particular translator. We assume that all =begin/=end -# pairs are properly nested and just pop the previous one. +# pairs are properly closed. sub cmd_end { my $self = shift; - my $kind = pop @{ $$self{BEGUN} }; - $$self{EXCLUDE}-- if $$self{EXCLUDE}; + $$self{EXCLUDE} = 0; + $$self{VERBATIM} = 0; } # One paragraph for a particular translator. Ignore it unless it's intended -# for text, in which case we treat it as either a normal text block or a -# verbatim text block, depending on whether it's indented. +# for text, in which case we treat it as a verbatim text block. sub cmd_for { my $self = shift; local $_ = shift; my $line = shift; - return unless s/^text\b[ \t]*//; - if (/^\n\s+/) { - $self->verbatim ($_, $line); - } else { - $self->textblock ($_, $line); - } + return unless s/^text\b[ \t]*\n?//; + $self->verbatim ($_, $line); } @@ -368,9 +377,9 @@ sub cmd_for { # The simple formatting ones. These are here mostly so that subclasses can # override them and do more complicated things. -sub seq_b { my $self = shift; return $$self{alt} ? "``$_[0]''" : $_[0] } -sub seq_c { my $self = shift; return $$self{alt} ? "``$_[0]''" : "`$_[0]'" } -sub seq_f { my $self = shift; return $$self{alt} ? "\"$_[0]\"" : $_[0] } +sub seq_b { return $_[0]{alt} ? "``$_[1]''" : $_[1] } +sub seq_c { return $_[0]{alt} ? "``$_[1]''" : "`$_[1]'" } +sub seq_f { return $_[0]{alt} ? "\"$_[1]\"" : $_[1] } sub seq_i { return '*' . $_[1] . '*' } # The complicated one. Handle links. Since this is plain text, we can't @@ -389,7 +398,6 @@ sub seq_l { # Okay, leading and trailing whitespace isn't important; get rid of it. s/^\s+//; s/\s+$//; - chomp; # Default to using the whole content of the link entry as a section # name. Note that L forces a manpage interpretation, as does @@ -447,7 +455,12 @@ sub item { my $space = ' ' x $indent; $space =~ s/^ /:/ if $$self{alt}; if (!$_ || /^\s+$/ || ($$self{MARGIN} - $indent < length ($tag) + 1)) { - $self->output ($space . $tag . "\n"); + my $margin = $$self{MARGIN}; + $$self{MARGIN} = $indent; + my $output = $self->reformat ($tag); + $output =~ s/\n*$/\n/; + $self->output ($output); + $$self{MARGIN} = $margin; $self->output ($self->reformat ($_)) if /\S/; } else { $_ = $self->reformat ($_); @@ -509,6 +522,49 @@ sub output { $_[1] =~ tr/\01/ /; print { $_[0]->output_handle } $_[1] } ############################################################################ +# Backwards compatibility +############################################################################ + +# The old Pod::Text module did everything in a pod2text() function. This +# tries to provide the same interface for legacy applications. +sub pod2text { + my @args; + + # This is really ugly; I hate doing option parsing in the middle of a + # module. But the old Pod::Text module supported passing flags to its + # entry function, so handle -a and -. + while ($_[0] =~ /^-/) { + my $flag = shift; + if ($flag eq '-a') { push (@args, alt => 1) } + elsif ($flag =~ /^-(\d+)$/) { push (@args, width => $1) } + else { + unshift (@_, $flag); + last; + } + } + + # Now that we know what arguments we're using, create the parser. + my $parser = Pod::Text->new (@args); + + # If two arguments were given, the second argument is going to be a file + # handle. That means we want to call parse_from_filehandle(), which + # means we need to turn the first argument into a file handle. Magic + # open will handle the <&STDIN case automagically. + if (defined $_[1]) { + local *IN; + unless (open (IN, $_[0])) { + croak ("Can't open $_[0] for reading: $!\n"); + return; + } + $_[0] = \*IN; + return $parser->parse_from_filehandle (@_); + } else { + return $parser->parse_from_file (@_); + } +} + + +############################################################################ # Module return value and documentation ############################################################################ @@ -532,17 +588,17 @@ Pod::Text - Convert POD data to formatted ASCII text =head1 DESCRIPTION -Pod::Text is a module that can convert documentation in the POD format -(such as can be found throughout the Perl distribution) into formatted -ASCII. It uses no special formatting controls or codes whatsoever, and its -output is therefore suitable for nearly any device. +Pod::Text is a module that can convert documentation in the POD format (the +preferred language for documenting Perl) into formatted ASCII. It uses no +special formatting controls or codes whatsoever, and its output is therefore +suitable for nearly any device. -As a derived class from Pod::Parser, Pod::Text supports the same -methods and interfaces. See L for all the details; briefly, -one creates a new parser with Cnew()> and then calls -either C or C. +As a derived class from Pod::Parser, Pod::Text supports the same methods and +interfaces. See L for all the details; briefly, one creates a +new parser with Cnew()> and then calls either +parse_from_filehandle() or parse_from_file(). -C can take options, in the form of key/value pairs, that control the +new() can take options, in the form of key/value pairs, that control the behavior of the parser. The currently recognized options are: =over 4 @@ -569,8 +625,8 @@ output. =item sentence -If set to a true value, Pod::Text will assume that each sentence ends -in two spaces, and will try to preserve that spacing. If set to false, all +If set to a true value, Pod::Text will assume that each sentence ends in two +spaces, and will try to preserve that spacing. If set to false, all consecutive whitespace in non-verbatim paragraphs is compressed into a single space. Defaults to true. @@ -580,49 +636,67 @@ The column at which to wrap text on the right-hand side. Defaults to 76. =back -The standard Pod::Parser method C takes up to two +The standard Pod::Parser method parse_from_filehandle() takes up to two arguments, the first being the file handle to read POD from and the second being the file handle to write the formatted output to. The first defaults to STDIN if not given, and the second defaults to STDOUT. The method -C is almost identical, except that its two arguments are -the input and output disk files instead. See L for the -specific details. +parse_from_file() is almost identical, except that its two arguments are the +input and output disk files instead. See L for the specific +details. =head1 DIAGNOSTICS =over 4 +=item Bizarre space in item + +(W) Something has gone wrong in internal C<=item> processing. This message +indicates a bug in Pod::Text; you should never see it. + +=item Can't open %s for reading: %s + +(F) Pod::Text was invoked via the compatibility mode pod2text() interface +and the input file it was given could not be opened. + =item Unknown escape: %s -The POD source contained an CE> escape that Pod::Text -didn't know about. +(W) The POD source contained an CE> escape that Pod::Text didn't +know about. =item Unknown sequence: %s -The POD source contained a non-standard internal sequence (something of the -form CE>) that Pod::Text didn't know about. +(W) The POD source contained a non-standard internal sequence (something of +the form CE>) that Pod::Text didn't know about. =item Unmatched =back -Pod::Text encountered a C<=back> command that didn't correspond to an +(W) Pod::Text encountered a C<=back> command that didn't correspond to an C<=over> command. =back +=head1 RESTRICTIONS + +Embedded Ctrl-As (octal 001) in the input will be mapped to spaces on +output, due to an internal implementation detail. + =head1 NOTES -I'm hoping this module will eventually replace Pod::Text in Perl core once -Pod::Parser has been added to Perl core. Accordingly, don't be surprised if -the name of this module changes to Pod::Text down the road. +This is a replacement for an earlier Pod::Text module written by Tom +Christiansen. It has a revamped interface, since it now uses Pod::Parser, +but an interface roughly compatible with the old Pod::Text::pod2text() +function is still available. Please change to the new calling convention, +though. The original Pod::Text contained code to do formatting via termcap sequences, although it wasn't turned on by default and it was problematic to -get it to work at all. This module doesn't even try to do that, but a -subclass of it does. Look for Pod::Text::Termcap. +get it to work at all. This rewrite doesn't even try to do that, but a +subclass of it does. Look for L. =head1 SEE ALSO -L, L +L, L, +pod2text(1) =head1 AUTHOR diff --git a/lib/Pod/Text/Color.pm b/lib/Pod/Text/Color.pm index 5eac57c..10e1d9f 100644 --- a/lib/Pod/Text/Color.pm +++ b/lib/Pod/Text/Color.pm @@ -1,5 +1,5 @@ # Pod::Text::Color -- Convert POD data to formatted color ASCII text -# $Id: Color.pm,v 0.1 1999/06/13 02:41:06 eagle Exp $ +# $Id: Color.pm,v 0.5 1999/09/20 10:15:16 eagle Exp $ # # Copyright 1999 by Russ Allbery # @@ -27,7 +27,7 @@ use vars qw(@ISA $VERSION); @ISA = qw(Pod::Text); # Use the CVS revision of this file as its version number. -($VERSION = (split (' ', q$Revision: 0.1 $ ))[1]) =~ s/\.(\d)$/.0$1/; +($VERSION = (split (' ', q$Revision: 0.5 $ ))[1]) =~ s/\.(\d)$/.0$1/; ############################################################################ @@ -100,10 +100,19 @@ Pod::Text::Color - Convert POD data to formatted color ASCII text =head1 DESCRIPTION -Pod::Text::Color is a simple subclass of Pod::Text that highlights -output text using ANSI color escape sequences. Apart from the color, it in -all ways functions like Pod::Text. See L for details -and available options. +Pod::Text::Color is a simple subclass of Pod::Text that highlights output +text using ANSI color escape sequences. Apart from the color, it in all +ways functions like Pod::Text. See L for details and available +options. + +Term::ANSIColor is used to get colors and therefore must be installed to use +this module. + +=head1 BUGS + +This is just a basic proof of concept. It should be seriously expanded to +support configurable coloration via options passed to the constructor, and +B should be taught about those. =head1 SEE ALSO diff --git a/lib/Pod/Text/Termcap.pm b/lib/Pod/Text/Termcap.pm index efb71a6..7e89ec6 100644 --- a/lib/Pod/Text/Termcap.pm +++ b/lib/Pod/Text/Termcap.pm @@ -1,14 +1,14 @@ # Pod::Text::Termcap -- Convert POD data to ASCII text with format escapes. -# $Id: Termcap.pm,v 0.1 1999/06/13 02:41:06 eagle Exp $ +# $Id: Termcap.pm,v 0.4 1999/09/20 10:17:45 eagle Exp $ # # Copyright 1999 by Russ Allbery # # This program is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # -# This is a simple subclass of Pod::Text that overrides a few key -# methods to output the right termcap escape sequences for formatted text -# on the current terminal type. +# This is a simple subclass of Pod::Text that overrides a few key methods to +# output the right termcap escape sequences for formatted text on the +# current terminal type. ############################################################################ # Modules and declarations @@ -21,13 +21,14 @@ require 5.004; use Pod::Text (); use POSIX (); use Term::Cap; + use strict; use vars qw(@ISA $VERSION); @ISA = qw(Pod::Text); # Use the CVS revision of this file as its version number. -($VERSION = (split (' ', q$Revision: 0.1 $ ))[1]) =~ s/\.(\d)$/.0$1/; +($VERSION = (split (' ', q$Revision: 0.4 $ ))[1]) =~ s/\.(\d)$/.0$1/; ############################################################################ @@ -125,10 +126,10 @@ Pod::Text::Color - Convert POD data to ASCII text with format escapes =head1 DESCRIPTION -Pod::Text::Termcap is a simple subclass of Pod::Text that highlights -output text using the correct termcap escape sequences for the current -terminal. Apart from the format codes, it in all ways functions like -Pod::Text. See L for details and available options. +Pod::Text::Termcap is a simple subclass of Pod::Text that highlights output +text using the correct termcap escape sequences for the current terminal. +Apart from the format codes, it in all ways functions like Pod::Text. See +L for details and available options. =head1 SEE ALSO diff --git a/lib/Pod/Usage.pm b/lib/Pod/Usage.pm index 9cb71e0..6e6fb7b 100644 --- a/lib/Pod/Usage.pm +++ b/lib/Pod/Usage.pm @@ -1,10 +1,7 @@ ############################################################################# # Pod/Usage.pm -- print usage messages for the running script. # -# Based on Tom Christiansen's Pod::Text::pod2text() function -# (with modifications). -# -# Copyright (C) 1994-1999 Tom Christiansen. All rights reserved. +# Copyright (C) 1996-1999 by Bradford Appleton. All rights reserved. # This file is part of "PodParser". PodParser is free software; # you can redistribute it and/or modify it under the same terms # as Perl itself. @@ -13,7 +10,7 @@ package Pod::Usage; use vars qw($VERSION); -$VERSION = 1.081; ## Current version of this package +$VERSION = 1.090; ## Current version of this package require 5.004; ## requires this Perl version or later =head1 NAME @@ -363,12 +360,21 @@ use strict; #use diagnostics; use Carp; use Exporter; -use Pod::PlainText; use File::Spec; use vars qw(@ISA @EXPORT); -@ISA = qw(Pod::PlainText); @EXPORT = qw(&pod2usage); +BEGIN { + if ( $] >= 5.005_58 ) { + require Pod::Text; + @ISA = qw( Pod::Text ); + } + else { + require Pod::PlainText; + @ISA = qw( Pod::PlainText ); + } +} + ##--------------------------------------------------------------------------- diff --git a/lib/Sys/Hostname.pm b/lib/Sys/Hostname.pm index e96822e..4d93f91 100644 --- a/lib/Sys/Hostname.pm +++ b/lib/Sys/Hostname.pm @@ -65,6 +65,10 @@ sub hostname { chomp($host = `hostname 2> NUL`) unless defined $host; return $host; } + elsif ($^O eq 'epoc') { + $host = 'localhost'; + return $host; + } else { # Unix # method 2 - syscall is preferred since it avoids tainting problems diff --git a/lib/Text/Tabs.pm b/lib/Text/Tabs.pm index acd7afb..c431019 100644 --- a/lib/Text/Tabs.pm +++ b/lib/Text/Tabs.pm @@ -7,7 +7,7 @@ require Exporter; @EXPORT = qw(expand unexpand $tabstop); use vars qw($VERSION $tabstop $debug); -$VERSION = 96.121201; +$VERSION = 98.112801; use strict; @@ -18,7 +18,7 @@ BEGIN { sub expand { - my @l = @_; + my (@l) = @_; for $_ (@l) { 1 while s/(^|\n)([^\t\n]*)(\t+)/ $1. $2 . (" " x @@ -32,7 +32,7 @@ sub expand sub unexpand { - my @l = @_; + my (@l) = @_; my @e; my $x; my $line; diff --git a/lib/Tie/Array.pm b/lib/Tie/Array.pm index 3f34c3b..5ef83c4 100644 --- a/lib/Tie/Array.pm +++ b/lib/Tie/Array.pm @@ -1,7 +1,8 @@ package Tie::Array; use vars qw($VERSION); use strict; -$VERSION = '1.00'; +use Carp; +$VERSION = '1.01'; # Pod documentation after __END__ below. @@ -74,6 +75,16 @@ sub SPLICE return @result; } +sub EXISTS { + my $pkg = ref $_[0]; + croak "$pkg dosn't define an EXISTS method"; +} + +sub DELETE { + my $pkg = ref $_[0]; + croak "$pkg dosn't define a DELETE method"; +} + package Tie::StdArray; use vars qw(@ISA); @ISA = 'Tie::Array'; @@ -88,6 +99,8 @@ sub POP { pop(@{$_[0]}) } sub PUSH { my $o = shift; push(@$o,@_) } sub SHIFT { shift(@{$_[0]}) } sub UNSHIFT { my $o = shift; unshift(@$o,@_) } +sub EXISTS { exists $_[0]->[$_[1]] } +sub DELETE { delete $_[0]->[$_[1]] } sub SPLICE { @@ -120,6 +133,8 @@ Tie::Array - base class for tied arrays sub STORE { ... } # mandatory if elements writeable sub STORESIZE { ... } # mandatory if elements can be added/deleted + sub EXISTS { ... } # mandatory if exists() expected to work + sub DELETE { ... } # mandatory if delete() expected to work # optional methods - for efficiency sub CLEAR { ... } @@ -150,9 +165,11 @@ Tie::Array - base class for tied arrays This module provides methods for array-tying classes. See L for a list of the functions required in order to tie an array -to a package. The basic B package provides stub C -and C methods, and implementations of C, C, C, -C, C and C in terms of basic C, C, +to a package. The basic B package provides stub C, +and C methods that do nothing, stub C and C +methods that croak() if the delete() or exists() builtins are ever called +on the tied array, and implementations of C, C, C, +C, C and C in terms of basic C, C, C, C. The B package provides efficient methods required for tied arrays @@ -203,6 +220,18 @@ deleted. Informative call that array is likely to grow to have I entries. Can be used to optimize allocation. This method need do nothing. +=item EXISTS this, key + +Verify that the element at index I exists in the tied array I. + +The B implementation is a stub that simply croaks. + +=item DELETE this, key + +Delete the element at index I from the tied array I. + +The B implementation is a stub that simply croaks. + =item CLEAR this Clear (remove, delete, ...) all values from the tied array associated with diff --git a/lib/Tie/Hash.pm b/lib/Tie/Hash.pm index 2902efb..928b798 100644 --- a/lib/Tie/Hash.pm +++ b/lib/Tie/Hash.pm @@ -73,6 +73,8 @@ Return the next key for the hash. Verify that I exists with the tied hash I. +The B implementation is a stub that simply croaks. + =item DELETE this, key Delete the key I from the tied hash I. diff --git a/lib/Time/Local.pm b/lib/Time/Local.pm index 75bcc38..f3f6f54 100644 --- a/lib/Time/Local.pm +++ b/lib/Time/Local.pm @@ -3,8 +3,9 @@ require 5.000; require Exporter; use Carp; -@ISA = qw(Exporter); -@EXPORT = qw(timegm timelocal); +@ISA = qw( Exporter ); +@EXPORT = qw( timegm timelocal ); +@EXPORT_OK = qw( timegm_nocheck timelocal_nocheck ); # Set up constants $SEC = 1; @@ -17,6 +18,8 @@ use Carp; $breakpoint = ($thisYear + 50) % 100; $nextCentury += 100 if $breakpoint < 50; +my %options; + sub timegm { my (@date) = @_; if ($date[5] > 999) { @@ -35,6 +38,11 @@ sub timegm { + ($date[3]-1) * $DAY; } +sub timegm_nocheck { + local $options{no_range_check} = 1; + &timegm; +} + sub timelocal { my $t = &timegm; my $tt = $t; @@ -44,14 +52,13 @@ sub timelocal { if ($t < $DAY and ($lt[5] >= 70 or $gt[5] >= 70 )) { # Wrap error, too early a date # Try a safer date - $tt = $DAY; + $tt += $DAY; @lt = localtime($tt); @gt = gmtime($tt); } my $tzsec = ($gt[1] - $lt[1]) * $MIN + ($gt[2] - $lt[2]) * $HR; - my($lday,$gday) = ($lt[7],$gt[7]); if($lt[5] > $gt[5]) { $tzsec -= $DAY; } @@ -70,14 +77,21 @@ sub timelocal { $time; } +sub timelocal_nocheck { + local $options{no_range_check} = 1; + &timelocal; +} + sub cheat { $year = $_[5]; $month = $_[4]; - croak "Month '$month' out of range 0..11" if $month > 11 || $month < 0; - croak "Day '$_[3]' out of range 1..31" if $_[3] > 31 || $_[3] < 1; - croak "Hour '$_[2]' out of range 0..23" if $_[2] > 23 || $_[2] < 0; - croak "Minute '$_[1]' out of range 0..59" if $_[1] > 59 || $_[1] < 0; - croak "Second '$_[0]' out of range 0..59" if $_[0] > 59 || $_[0] < 0; + unless ($options{no_range_check}) { + croak "Month '$month' out of range 0..11" if $month > 11 || $month < 0; + croak "Day '$_[3]' out of range 1..31" if $_[3] > 31 || $_[3] < 1; + croak "Hour '$_[2]' out of range 0..23" if $_[2] > 23 || $_[2] < 0; + croak "Minute '$_[1]' out of range 0..59" if $_[1] > 59 || $_[1] < 0; + croak "Second '$_[0]' out of range 0..59" if $_[0] > 59 || $_[0] < 0; + } $guess = $^T; @g = gmtime($guess); $lastguess = ""; @@ -137,6 +151,27 @@ the values provided. While the day of the month is expected to be in the range 1..31, the month should be in the range 0..11. This is consistent with the values returned from localtime() and gmtime(). +The timelocal() and timegm() functions perform range checking on the +input $sec, $min, $hours, $mday, and $mon values by default. If you'd +rather they didn't, you can explicitly import the timelocal_nocheck() +and timegm_nocheck() functions. + + use Time::Local 'timelocal_nocheck'; + + { + # The 365th day of 1999 + print scalar localtime timelocal_nocheck 0,0,0,365,0,99; + + # The twenty thousandth day since 1970 + print scalar localtime timelocal_nocheck 0,0,0,20000,0,70; + + # And even the 10,000,000th second since 1999! + print scalar localtime timelocal_nocheck 10000000,0,0,1,0,99; + } + +Your mileage may vary when trying these with minutes and hours, +and it doesn't work at all for months. + Strictly speaking, the year should also be specified in a form consistent with localtime(), i.e. the offset from 1900. In order to make the interpretation of the year easier for humans, diff --git a/lib/attributes.pm b/lib/attributes.pm index e49204f..09f3551 100644 --- a/lib/attributes.pm +++ b/lib/attributes.pm @@ -1,9 +1,10 @@ package attributes; -$VERSION = 0.01; +$VERSION = 0.02; -#@EXPORT_OK = qw(get reftype); -#@EXPORT = (); +@EXPORT_OK = qw(get reftype); +@EXPORT = (); +%EXPORT_TAGS = (ALL => [@EXPORT, @EXPORT_OK]); use strict; @@ -29,8 +30,10 @@ sub carp { BEGIN { bootstrap } sub import { - @_ > 2 && ref $_[2] or - croak 'Usage: use '.__PACKAGE__.' $home_stash, $ref, @attrlist'; + @_ > 2 && ref $_[2] or do { + require Exporter; + goto &Exporter::import; + }; my (undef,$home_stash,$svref,@attrs) = @_; my $svtype = uc reftype($svref); @@ -82,12 +85,7 @@ sub get ($) { ; } -#sub export { -# require Exporter; -# goto &Exporter::import; -#} -# -#sub require_version { goto &UNIVERSAL::VERSION } +sub require_version { goto &UNIVERSAL::VERSION } 1; __END__ @@ -106,13 +104,16 @@ attributes - get/set subroutine or variable attributes use attributes (); # optional, to get subroutine declarations my @attrlist = attributes::get(\&foo); + use attributes 'get'; # import the attributes::get subroutine + my @attrlist = get \&foo; + =head1 DESCRIPTION Subroutine declarations and definitions may optionally have attribute lists associated with them. (Variable C declarations also may, but see the warning below.) Perl handles these declarations by passing some information about the call site and the thing being declared along with the attribute -list to this module. In particular, first example above is equivalent to +list to this module. In particular, the first example above is equivalent to the following: use attributes __PACKAGE__, \&foo, 'method'; @@ -187,7 +188,7 @@ empty. If passed invalid arguments, it uses die() (via L) to raise a fatal exception. If it can find an appropriate package name for a class method lookup, it will include the results from a C_ATTRIBUTES> call in its return list, as described in -L"Package-specific Attribute Handling"> below. +L<"Package-specific Attribute Handling"> below. Otherwise, only L will be returned. =item reftype @@ -196,13 +197,11 @@ This routine expects a single parameter--a reference to a subroutine or variable. It returns the built-in type of the referenced variable, ignoring any package into which it might have been blessed. This can be useful for determining the I value which forms part of -the method names described in L"Package-specific Attribute Handling"> below. +the method names described in L<"Package-specific Attribute Handling"> below. =back -Note that these routines are I exported. This is primarily because -the C mechanism which would normally import them is already in use -by Perl itself to implement the C syntax. +Note that these routines are I exported by default. =head2 Package-specific Attribute Handling @@ -289,6 +288,20 @@ Some examples of syntactically invalid attribute lists (with annotation): Y2::north # "Y2::north" not a simple identifier foo + bar # "+" neither a comma nor whitespace +=head1 EXPORTS + +=head2 Default exports + +None. + +=head2 Available exports + +The routines C and C are exportable. + +=head2 Export tags defined + +The C<:ALL> tag will get all of the above exports. + =head1 EXAMPLES Here are some samples of syntactically valid declarations, with annotation diff --git a/lib/bigfloat.pl b/lib/bigfloat.pl index 6af5f17..8c28abd 100644 --- a/lib/bigfloat.pl +++ b/lib/bigfloat.pl @@ -79,7 +79,12 @@ sub norm { #(mantissa, exponent) return fnum_str sub main'fneg { #(fnum_str) return fnum_str local($_) = &'fnorm($_[$[]); vec($_,0,8) ^= ord('+') ^ ord('-') unless $_ eq '+0E+0'; # flip sign - s/^H/N/; + if ( ord("\t") == 9 ) { # ascii + s/^H/N/; + } + else { # ebcdic character set + s/\373/N/; + } $_; } diff --git a/lib/byte.pm b/lib/byte.pm new file mode 100644 index 0000000..cc23b40 --- /dev/null +++ b/lib/byte.pm @@ -0,0 +1,33 @@ +package byte; + +sub import { + $^H |= 0x00000010; +} + +sub unimport { + $^H &= ~0x00000010; +} + +sub AUTOLOAD { + require "byte_heavy.pl"; + goto &$AUTOLOAD; +} + +sub length ($); + +1; +__END__ + +=head1 NAME + +byte - Perl pragma to turn force treating strings as bytes not UNICODE + +=head1 SYNOPSIS + + use byte; + no byte; + +=head1 DESCRIPTION + + +=cut diff --git a/lib/byte_heavy.pl b/lib/byte_heavy.pl new file mode 100644 index 0000000..07c908a --- /dev/null +++ b/lib/byte_heavy.pl @@ -0,0 +1,8 @@ +package byte; + +sub length ($) +{ + return CORE::length($_[0]); +} + +1; diff --git a/lib/constant.pm b/lib/constant.pm index 5d3dd91..31f47fb 100644 --- a/lib/constant.pm +++ b/lib/constant.pm @@ -1,6 +1,112 @@ package constant; -$VERSION = '1.00'; +use strict; +use vars qw( $VERSION %declared ); +$VERSION = '1.01'; + +#======================================================================= + +require 5.005_62; + +# Some names are evil choices. +my %keywords = map +($_, 1), qw{ BEGIN INIT STOP END DESTROY AUTOLOAD }; + +my %forced_into_main = map +($_, 1), + qw{ STDIN STDOUT STDERR ARGV ARGVOUT ENV INC SIG }; + +my %forbidden = (%keywords, %forced_into_main); + +#======================================================================= +# import() - import symbols into user's namespace +# +# What we actually do is define a function in the caller's namespace +# which returns the value. The function we create will normally +# be inlined as a constant, thereby avoiding further sub calling +# overhead. +#======================================================================= +sub import { + my $class = shift; + return unless @_; # Ignore 'use constant;' + my $name = shift; + unless (defined $name) { + require Carp; + Carp::croak("Can't use undef as constant name"); + } + my $pkg = caller; + + # Normal constant name + if ($name =~ /^(?:[A-Z]\w|_[A-Z])\w*\z/ and !$forbidden{$name}) { + # Everything is okay + + # Name forced into main, but we're not in main. Fatal. + } elsif ($forced_into_main{$name} and $pkg ne 'main') { + require Carp; + Carp::croak("Constant name '$name' is forced into main::"); + + # Starts with double underscore. Fatal. + } elsif ($name =~ /^__/) { + require Carp; + Carp::croak("Constant name '$name' begins with '__'"); + + # Maybe the name is tolerable + } elsif ($name =~ /^[A-Za-z_]\w*\z/) { + # Then we'll warn only if you've asked for warnings + if ($^W) { + require Carp; + if ($keywords{$name}) { + Carp::carp("Constant name '$name' is a Perl keyword"); + } elsif ($forced_into_main{$name}) { + Carp::carp("Constant name '$name' is " . + "forced into package main::"); + } elsif (1 == length $name) { + Carp::carp("Constant name '$name' is too short"); + } elsif ($name =~ /^_?[a-z\d]/) { + Carp::carp("Constant name '$name' should " . + "have an initial capital letter"); + } else { + # Catch-all - what did I miss? If you get this error, + # please let me know what your constant's name was. + # Write to . Thanks! + Carp::carp("Constant name '$name' has unknown problems"); + } + } + + # Looks like a boolean + # use constant FRED == fred; + } elsif ($name =~ /^[01]?\z/) { + require Carp; + if (@_) { + Carp::croak("Constant name '$name' is invalid"); + } else { + Carp::croak("Constant name looks like boolean value"); + } + + } else { + # Must have bad characters + require Carp; + Carp::croak("Constant name '$name' has invalid characters"); + } + + { + no strict 'refs'; + my $full_name = "${pkg}::$name"; + $declared{$full_name}++; + if (@_ == 1) { + my $scalar = $_[0]; + *$full_name = sub () { $scalar }; + } elsif (@_) { + my @list = @_; + *$full_name = sub () { @list }; + } else { + *$full_name = sub () { }; + } + } + +} + +1; + +__END__ =head1 NAME @@ -20,7 +126,7 @@ constant - Perl pragma to declare constants print "This line does nothing" unless DEBUGGING; - # references can be declared constant + # references can be constants use constant CHASH => { foo => 42 }; use constant CARRAY => [ 1,2,3,4 ]; use constant CPSEUDOHASH => [ { foo => 1}, 42 ]; @@ -30,7 +136,7 @@ constant - Perl pragma to declare constants print CARRAY->[$i]; print CPSEUDOHASH->{foo}; print CCODE->("me"); - print CHASH->[10]; # compile-time error + print CHASH->[10]; # compile-time error =head1 DESCRIPTION @@ -63,7 +169,10 @@ List constants are returned as lists, not as arrays. The use of all caps for constant names is merely a convention, although it is recommended in order to make constants stand out and to help avoid collisions with other barewords, keywords, and -subroutine names. Constant names must begin with a letter. +subroutine names. Constant names must begin with a letter or +underscore. Names beginning with a double underscore are reserved. Some +poor choices for names will generate warnings, if warnings are enabled at +compile time. Constant symbols are package scoped (rather than block scoped, as C is). That is, you can refer to a constant from package @@ -98,7 +207,24 @@ constants at compile time, allowing for way cool stuff like this. print E2BIG, "\n"; # something like "Arg list too long" print 0+E2BIG, "\n"; # "7" -Errors in dereferencing constant references are trapped at compile-time. +Dereferencing constant references incorrectly (such as using an array +subscript on a constant hash reference, or vice versa) will be trapped at +compile time. + +In the rare case in which you need to discover at run time whether a +particular constant has been declared via this module, you may use +this function to examine the hash C<%constant::declared>. If the given +constant name does not include a package name, the current package is +used. + + sub declared ($) { + use constant 1.01; # don't omit this! + my $name = shift; + $name =~ s/^::/main::/; + my $pkg = caller; + my $full_name = $name =~ /::/ ? $name : "${pkg}::$name"; + $constant::declared{$full_name}; + } =head1 TECHNICAL NOTE @@ -115,7 +241,19 @@ In the current version of Perl, list constants are not inlined and some symbols may be redefined without generating a warning. It is not possible to have a subroutine or keyword with the same -name as a constant. This is probably a Good Thing. +name as a constant in the same package. This is probably a Good Thing. + +A constant with a name in the list C is not allowed anywhere but in package C, for +technical reasons. + +Even though a reference may be declared as a constant, the reference may +point to data which may be changed, as this code shows. + + use constant CARRAY => [ 1,2,3,4 ]; + print CARRAY->[1]; + CARRAY->[1] = " be changed"; + print CARRAY->[1]; Unlike constants in some languages, these cannot be overridden on the command line or via environment variables. @@ -126,61 +264,20 @@ For example, you can't say C<$hash{CONSTANT}> because C will be interpreted as a string. Use C<$hash{CONSTANT()}> or C<$hash{+CONSTANT}> to prevent the bareword quoting mechanism from kicking in. Similarly, since the C<=E> operator quotes a bareword -immediately to its left you have to say C 'value'> -instead of C 'value'>. +immediately to its left, you have to say C 'value'> +(or simply use a comma in place of the big arrow) instead of +C 'value'>. =head1 AUTHOR -Tom Phoenix, EFE, with help from +Tom Phoenix, EFE, with help from many other folks. =head1 COPYRIGHT -Copyright (C) 1997, Tom Phoenix +Copyright (C) 1997, 1999 Tom Phoenix This module is free software; you can redistribute it or modify it under the same terms as Perl itself. =cut - -use strict; -use Carp; -use vars qw($VERSION); - -#======================================================================= - -# Some of this stuff didn't work in version 5.003, alas. -require 5.003_96; - -#======================================================================= -# import() - import symbols into user's namespace -# -# What we actually do is define a function in the caller's namespace -# which returns the value. The function we create will normally -# be inlined as a constant, thereby avoiding further sub calling -# overhead. -#======================================================================= -sub import { - my $class = shift; - my $name = shift or return; # Ignore 'use constant;' - croak qq{Can't define "$name" as constant} . - qq{ (name contains invalid characters or is empty)} - unless $name =~ /^[^\W_0-9]\w*$/; - - my $pkg = caller; - { - no strict 'refs'; - if (@_ == 1) { - my $scalar = $_[0]; - *{"${pkg}::$name"} = sub () { $scalar }; - } elsif (@_) { - my @list = @_; - *{"${pkg}::$name"} = sub () { @list }; - } else { - *{"${pkg}::$name"} = sub () { }; - } - } - -} - -1; diff --git a/lib/diagnostics.pm b/lib/diagnostics.pm index f174ee5..e6a9127 100755 --- a/lib/diagnostics.pm +++ b/lib/diagnostics.pm @@ -167,9 +167,11 @@ Tom Christiansen >, 25 June 1995. =cut -require 5.001; +require 5.005_64; use Carp; +$VERSION = v1.0; + use Config; ($privlib, $archlib) = @Config{qw(privlibexp archlibexp)}; if ($^O eq 'VMS') { @@ -177,9 +179,14 @@ if ($^O eq 'VMS') { $privlib = VMS::Filespec::unixify($privlib); $archlib = VMS::Filespec::unixify($archlib); } -@trypod = ("$archlib/pod/perldiag.pod", - "$privlib/pod/perldiag-$].pod", - "$privlib/pod/perldiag.pod"); +@trypod = ( + "$archlib/pod/perldiag.pod", + "$privlib/pod/perldiag-$Config{version}.pod", + "$privlib/pod/perldiag.pod", + "$archlib/pods/perldiag.pod", + "$privlib/pods/perldiag-$Config{version}.pod", + "$privlib/pods/perldiag.pod", + ); # handy for development testing of new warnings etc unshift @trypod, "./pod/perldiag.pod" if -e "pod/perldiag.pod"; ($PODFILE) = ((grep { -e } @trypod), $trypod[$#trypod])[0]; @@ -328,7 +335,7 @@ EOFUNC # strip formatting directives in =item line ($header = $1) =~ s/[A-Z]<(.*?)>/$1/g; - if ($header =~ /%[sd]/) { + if ($header =~ /%[csd]/) { $rhs = $lhs = $header; #if ($lhs =~ s/(.*?)%d(?!%d)(.*)/\Q$1\E\\d+\Q$2\E\$/g) { if ($lhs =~ s/(.*?)%d(?!%d)(.*)/\Q$1\E\\d+\Q$2\E/g) { @@ -341,6 +348,7 @@ EOFUNC $lhs =~ s/\377//g; $lhs =~ s/\.\*\?$/.*/; # Allow %s at the end to eat it all } + $lhs =~ s/\\%c/./g; $transmo .= " s{^$lhs}\n {\Q$rhs\E}s\n\t&& return 1;\n"; } else { $transmo .= " m{^\Q$header\E} && return 1;\n"; @@ -371,7 +379,8 @@ if ($standalone) { } exit; } else { - $old_w = 0; $oldwarn = ''; $olddie = ''; + #$old_w = 0; + $oldwarn = ''; $olddie = ''; } sub import { diff --git a/lib/lib.pm b/lib/lib.pm index 6e6e15e..afc979b 100644 --- a/lib/lib.pm +++ b/lib/lib.pm @@ -4,19 +4,19 @@ use vars qw(@ORIG_INC); use Config; my $archname = $Config{'archname'}; +my $ver = $Config{'version'}; @ORIG_INC = @INC; # take a handy copy of 'original' value sub import { shift; + + my %names; foreach (reverse @_) { - ## Ignore this if not defined. - next unless defined($_); if ($_ eq '') { require Carp; Carp::carp("Empty compile time value given to use lib"); - # at foo.pl line ... } if (-e && ! -d _) { require Carp; @@ -27,29 +27,28 @@ sub import { # looks like $_ has an archlib directory below it. if (-d "$_/$archname") { unshift(@INC, "$_/$archname") if -d "$_/$archname/auto"; - unshift(@INC, "$_/$archname/$]") if -d "$_/$archname/$]/auto"; + unshift(@INC, "$_/$archname/$ver") if -d "$_/$archname/$ver/auto"; } } + + # remove trailing duplicates + @INC = grep { ++$names{$_} == 1 } @INC; + return; } sub unimport { shift; - my $mode = shift if $_[0] =~ m/^:[A-Z]+/; my %names; - foreach(@_) { + foreach (@_) { ++$names{$_}; ++$names{"$_/$archname"} if -d "$_/$archname/auto"; } - if ($mode and $mode eq ':ALL') { - # Remove ALL instances of each named directory. - @INC = grep { !exists $names{$_} } @INC; - } else { - # Remove INITIAL instance(s) of each named directory. - @INC = grep { --$names{$_} < 0 } @INC; - } + # Remove ALL instances of each named directory. + @INC = grep { !exists $names{$_} } @INC; + return; } 1; @@ -74,7 +73,7 @@ It is typically used to add extra directories to perl's search path so that later C or C statements will find modules which are not located on perl's default search path. -=head2 ADDING DIRECTORIES TO @INC +=head2 Adding directories to @INC The parameters to C are added to the start of the perl search path. Saying @@ -90,10 +89,10 @@ checks to see if a directory called $dir/$archname/auto exists. If so the $dir/$archname directory is assumed to be a corresponding architecture specific directory and is added to @INC in front of $dir. -If LIST includes both $dir and $dir/$archname then $dir/$archname will -be added to @INC twice (if $dir/$archname/auto exists). +To avoid memory leaks, all trailing duplicate entries in @INC are +removed. -=head2 DELETING DIRECTORIES FROM @INC +=head2 Deleting directories from @INC You should normally only add directories to @INC. If you need to delete directories from @INC take care to only delete those which you @@ -101,24 +100,15 @@ added yourself or which you are certain are not needed by other modules in your script. Other modules may have added directories which they need for correct operation. -By default the C statement deletes the I instance of -each named directory from @INC. To delete multiple instances of the -same name from @INC you can specify the name multiple times. - -To delete I instances of I the specified names from @INC you can -specify ':ALL' as the first parameter of C. For example: - - no lib qw(:ALL .); +The C statement deletes all instances of each named directory +from @INC. For each directory in LIST (called $dir here) the lib module also checks to see if a directory called $dir/$archname/auto exists. If so the $dir/$archname directory is assumed to be a corresponding architecture specific directory and is also deleted from @INC. -If LIST includes both $dir and $dir/$archname then $dir/$archname will -be deleted from @INC twice (if $dir/$archname/auto exists). - -=head2 RESTORING ORIGINAL @INC +=head2 Restoring original @INC When the lib module is first loaded it records the current value of @INC in an array C<@lib::ORIG_INC>. To restore @INC to that value you @@ -136,4 +126,3 @@ FindBin - optional module which deals with paths relative to the source file. Tim Bunce, 2nd June 1995. =cut - diff --git a/lib/perl5db.pl b/lib/perl5db.pl index 7b0567c..d2bd98e 100644 --- a/lib/perl5db.pl +++ b/lib/perl5db.pl @@ -2,7 +2,7 @@ package DB; # Debugger for Perl 5.00x; perl5db.pl patch level: -$VERSION = 1.0403; +$VERSION = 1.04041; $header = "perl5db.pl version $VERSION"; # Enhanced by ilya@math.ohio-state.edu (Ilya Zakharevich) @@ -76,6 +76,8 @@ $header = "perl5db.pl version $VERSION"; # LineInfo - file or pipe to print line number info to. If it is a # pipe, a short "emacs like" message is used. # +# RemotePort - host:port to connect to on remote host for remote debugging. +# # Example $rcfile: (delete leading hashes!) # # &parse_options("NonStop=1 LineInfo=db.out"); @@ -179,7 +181,8 @@ $inhibit_exit = $option{PrintRet} = 1; TTY noTTY ReadLine NonStop LineInfo maxTraceLen recallCommand ShellBang pager tkRunning ornaments signalLevel warnLevel dieLevel inhibit_exit - ImmediateStop bareStringify); + ImmediateStop bareStringify + RemotePort); %optionVars = ( hashDepth => \$dumpvar::hashDepth, @@ -197,6 +200,7 @@ $inhibit_exit = $option{PrintRet} = 1; inhibit_exit => \$inhibit_exit, maxTraceLen => \$maxtrace, ImmediateStop => \$ImmediateStop, + RemotePort => \$remoteport, ); %optionAction = ( @@ -216,6 +220,7 @@ $inhibit_exit = $option{PrintRet} = 1; dieLevel => \&dieLevel, tkRunning => \&tkRunning, ornaments => \&ornaments, + RemotePort => \&RemotePort, ); %optionRequire = ( @@ -296,7 +301,7 @@ if ($notty) { #require Term::ReadLine; - if ($^O =~ /cygwin/) { + if ($^O eq 'cygwin') { # /dev/tty is binary. use stdin for textmode undef $console; } elsif (-e "/dev/tty") { @@ -322,19 +327,30 @@ if ($notty) { $console = $tty if defined $tty; - if (defined $console) { - open(IN,"+<$console") || open(IN,"<$console") || open(IN,"<&STDIN"); - open(OUT,"+>$console") || open(OUT,">$console") || open(OUT,">&STDERR") - || open(OUT,">&STDOUT"); # so we don't dongle stdout - } else { - open(IN,"<&STDIN"); - open(OUT,">&STDERR") || open(OUT,">&STDOUT"); # so we don't dongle stdout - $console = 'STDIN/OUT'; + if (defined $remoteport) { + require IO::Socket; + $OUT = new IO::Socket::INET( Timeout => '10', + PeerAddr => $remoteport, + Proto => 'tcp', + ); + if (!$OUT) { die "Could not create socket to connect to remote host."; } + $IN = $OUT; } - # so open("|more") can read from STDOUT and so we don't dingle stdin - $IN = \*IN; + else { + if (defined $console) { + open(IN,"+<$console") || open(IN,"<$console") || open(IN,"<&STDIN"); + open(OUT,"+>$console") || open(OUT,">$console") || open(OUT,">&STDERR") + || open(OUT,">&STDOUT"); # so we don't dongle stdout + } else { + open(IN,"<&STDIN"); + open(OUT,">&STDERR") || open(OUT,">&STDOUT"); # so we don't dongle stdout + $console = 'STDIN/OUT'; + } + # so open("|more") can read from STDOUT and so we don't dingle stdin + $IN = \*IN; - $OUT = \*OUT; + $OUT = \*OUT; + } select($OUT); $| = 1; # for DB::OUT select(STDOUT); @@ -434,7 +450,7 @@ Debugged program terminated. Use B to quit or B to restart, B, B or B to get additional info. EOP $package = 'main'; - $usercontext = '($@, $!, $,, $/, $\, $^W) = @saved;' . + $usercontext = '($@, $!, $^E, $,, $/, $\, $^W) = @saved;' . "package $package;"; # this won't let them modify, alas } else { $sub =~ s/\'/::/; @@ -689,7 +705,7 @@ EOP for ($i = 1; $i <= $max; $i++) { if (defined $dbline{$i}) { - print "$file:\n" unless $was++; + print $OUT "$file:\n" unless $was++; print $OUT " $i:\t", $dbline[$i]; ($stop,$action) = split(/\0/, $dbline{$i}); print $OUT " break if (", $stop, ")\n" @@ -1525,7 +1541,15 @@ sub readline { } local $frame = 0; local $doret = -2; - $term->readline(@_); + if (ref $OUT and UNIVERSAL::isa($OUT, 'IO::Socket::INET')) { + print $OUT @_; + my $stuff; + $IN->recv( $stuff, 2048 ); + $stuff; + } + else { + $term->readline(@_); + } } sub dump_option { @@ -1673,6 +1697,14 @@ sub ReadLine { $rl; } +sub RemotePort { + if ($term) { + &warn("Too late to set RemotePort, enabled on next 'R'!\n") if @_; + } + $remoteport = shift if @_; + $remoteport; +} + sub tkRunning { if ($ {$term->Features}{tkRunning}) { return $term->tkRunning(@_); @@ -1823,6 +1855,7 @@ B [I[B<=>I]] [IB<\">IB<\">] [IB]... I I I: level of verbosity; I Allows stepping off the end of the script. I Debugger should stop as early as possible. + I: Remote hostname:port for remote debugging The following options affect what happens with B, B, and B commands: I, I: print only first N elements ('' for all); I, I: change style of array and hash dump; @@ -1839,7 +1872,8 @@ B [I[B<=>I]] [IB<\">IB<\">] [IB]... I affects screen appearance of the command line. During startup options are initialized from \$ENV{PERLDB_OPTS}. You can put additional initialization options I, I, - I, and I there (or use `B' after you set them). + I, I, and I there (or use + `B' after you set them). B<<> I Define Perl command to run before each prompt. B<<<> I Add to the list of Perl commands to run before each prompt. B<>> I Define Perl command to run after each prompt. diff --git a/lib/strict.pm b/lib/strict.pm index 940e8bf..99ed01d 100644 --- a/lib/strict.pm +++ b/lib/strict.pm @@ -56,6 +56,9 @@ L. The local() generated a compile-time error because you just touched a global name without fully qualifying it. +Because of their special use by sort(), the variables $a and $b are +exempted from this check. + =item C This disables the poetry optimization, generating a compile-time error if diff --git a/lib/unicode/Eq/Latin1 b/lib/unicode/Eq/Latin1.pl similarity index 69% rename from lib/unicode/Eq/Latin1 rename to lib/unicode/Eq/Latin1.pl index 89ecd76..e033d2c 100644 --- a/lib/unicode/Eq/Latin1 +++ b/lib/unicode/Eq/Latin1.pl @@ -1,3 +1,7 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; 0041 00C0 00C1 00C2 00C3 00C4 00C5 0043 00C7 0045 00C8 00C9 00CA 00CB @@ -14,3 +18,4 @@ 006F 00BA 00F2 00F3 00F4 00F5 00F6 00F8 0075 00F9 00FA 00FB 00FC 0079 00FD 00FF +END diff --git a/lib/unicode/Eq/Unicode b/lib/unicode/Eq/Unicode.pl similarity index 98% rename from lib/unicode/Eq/Unicode rename to lib/unicode/Eq/Unicode.pl index 29b2a1c..35edd61 100644 --- a/lib/unicode/Eq/Unicode +++ b/lib/unicode/Eq/Unicode.pl @@ -1,3 +1,7 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; 0041 00C0 00C1 00C2 00C3 00C4 00C5 0100 0102 0104 01CD 0200 0202 0226 1E00 1EA0 1EA2 FF21 0042 0181 0182 1E02 1E04 1E06 212C FF22 0043 00C7 0106 0108 010A 010C 0187 2102 212D FF23 @@ -659,3 +663,4 @@ 3163 FFDC 3164 FFA0 FB49 FB2C FB2D +END diff --git a/lib/unicode/In/BopomofoExtended.pl b/lib/unicode/In/BopomofoExtended.pl new file mode 100644 index 0000000..d0ee43a --- /dev/null +++ b/lib/unicode/In/BopomofoExtended.pl @@ -0,0 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +31A0 31BF +END diff --git a/lib/unicode/In/BraillePatterns.pl b/lib/unicode/In/BraillePatterns.pl new file mode 100644 index 0000000..e5c9e4c --- /dev/null +++ b/lib/unicode/In/BraillePatterns.pl @@ -0,0 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +2800 28FF +END diff --git a/lib/unicode/In/CJKRadicalsSupplement.pl b/lib/unicode/In/CJKRadicalsSupplement.pl new file mode 100644 index 0000000..d4c0c82 --- /dev/null +++ b/lib/unicode/In/CJKRadicalsSupplement.pl @@ -0,0 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +2E80 2EFF +END diff --git a/lib/unicode/In/CJKUnifiedIdeographsExtensionA.pl b/lib/unicode/In/CJKUnifiedIdeographsExtensionA.pl new file mode 100644 index 0000000..012f54c --- /dev/null +++ b/lib/unicode/In/CJKUnifiedIdeographsExtensionA.pl @@ -0,0 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +3400 4DB5 +END diff --git a/lib/unicode/In/Cherokee.pl b/lib/unicode/In/Cherokee.pl new file mode 100644 index 0000000..10cae1a --- /dev/null +++ b/lib/unicode/In/Cherokee.pl @@ -0,0 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +13A0 13FF +END diff --git a/lib/unicode/In/IdeographicDescriptionCharacters.pl b/lib/unicode/In/IdeographicDescriptionCharacters.pl new file mode 100644 index 0000000..4baae88 --- /dev/null +++ b/lib/unicode/In/IdeographicDescriptionCharacters.pl @@ -0,0 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +2FF0 2FFF +END diff --git a/lib/unicode/In/KangxiRadicals.pl b/lib/unicode/In/KangxiRadicals.pl new file mode 100644 index 0000000..d26fd6c --- /dev/null +++ b/lib/unicode/In/KangxiRadicals.pl @@ -0,0 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +2F00 2FDF +END diff --git a/lib/unicode/In/Khmer.pl b/lib/unicode/In/Khmer.pl new file mode 100644 index 0000000..f3e8685 --- /dev/null +++ b/lib/unicode/In/Khmer.pl @@ -0,0 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +1780 17FF +END diff --git a/lib/unicode/In/Mongolian.pl b/lib/unicode/In/Mongolian.pl new file mode 100644 index 0000000..394014d --- /dev/null +++ b/lib/unicode/In/Mongolian.pl @@ -0,0 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +1800 18AF +END diff --git a/lib/unicode/In/Myanmar.pl b/lib/unicode/In/Myanmar.pl new file mode 100644 index 0000000..4b3f318 --- /dev/null +++ b/lib/unicode/In/Myanmar.pl @@ -0,0 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +1000 109F +END diff --git a/lib/unicode/In/Ogham.pl b/lib/unicode/In/Ogham.pl new file mode 100644 index 0000000..e097d90 --- /dev/null +++ b/lib/unicode/In/Ogham.pl @@ -0,0 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +1680 169F +END diff --git a/lib/unicode/In/Runic.pl b/lib/unicode/In/Runic.pl new file mode 100644 index 0000000..0bd42df --- /dev/null +++ b/lib/unicode/In/Runic.pl @@ -0,0 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +16A0 16FF +END diff --git a/lib/unicode/In/Sinhala.pl b/lib/unicode/In/Sinhala.pl new file mode 100644 index 0000000..37e007c --- /dev/null +++ b/lib/unicode/In/Sinhala.pl @@ -0,0 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +0D80 0DFF +END diff --git a/lib/unicode/In/Syriac.pl b/lib/unicode/In/Syriac.pl new file mode 100644 index 0000000..7c81fb6 --- /dev/null +++ b/lib/unicode/In/Syriac.pl @@ -0,0 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +0700 074F +END diff --git a/lib/unicode/In/Thaana.pl b/lib/unicode/In/Thaana.pl new file mode 100644 index 0000000..361bd4d --- /dev/null +++ b/lib/unicode/In/Thaana.pl @@ -0,0 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +0780 07BF +END diff --git a/lib/unicode/In/UnifiedCanadianAboriginalSyllabics.pl b/lib/unicode/In/UnifiedCanadianAboriginalSyllabics.pl new file mode 100644 index 0000000..ad4eb27 --- /dev/null +++ b/lib/unicode/In/UnifiedCanadianAboriginalSyllabics.pl @@ -0,0 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +1400 167F +END diff --git a/lib/unicode/In/YiRadicals.pl b/lib/unicode/In/YiRadicals.pl new file mode 100644 index 0000000..f25c695 --- /dev/null +++ b/lib/unicode/In/YiRadicals.pl @@ -0,0 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +A490 A4CF +END diff --git a/lib/unicode/In/YiSyllables.pl b/lib/unicode/In/YiSyllables.pl new file mode 100644 index 0000000..f4e3a8b --- /dev/null +++ b/lib/unicode/In/YiSyllables.pl @@ -0,0 +1,6 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! +return <<'END'; +A000 A48F +END diff --git a/lib/unicode/Is/SylA.pl b/lib/unicode/Is/SylA.pl index 3054fd6..ec287c4 100644 --- a/lib/unicode/Is/SylA.pl +++ b/lib/unicode/Is/SylA.pl @@ -1,2 +1,5 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; END diff --git a/lib/unicode/Is/SylC.pl b/lib/unicode/Is/SylC.pl index 3054fd6..ec287c4 100644 --- a/lib/unicode/Is/SylC.pl +++ b/lib/unicode/Is/SylC.pl @@ -1,2 +1,5 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; END diff --git a/lib/unicode/Is/SylE.pl b/lib/unicode/Is/SylE.pl index 3054fd6..ec287c4 100644 --- a/lib/unicode/Is/SylE.pl +++ b/lib/unicode/Is/SylE.pl @@ -1,2 +1,5 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; END diff --git a/lib/unicode/Is/SylI.pl b/lib/unicode/Is/SylI.pl index 3054fd6..ec287c4 100644 --- a/lib/unicode/Is/SylI.pl +++ b/lib/unicode/Is/SylI.pl @@ -1,2 +1,5 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; END diff --git a/lib/unicode/Is/SylO.pl b/lib/unicode/Is/SylO.pl index 3054fd6..ec287c4 100644 --- a/lib/unicode/Is/SylO.pl +++ b/lib/unicode/Is/SylO.pl @@ -1,2 +1,5 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; END diff --git a/lib/unicode/Is/SylU.pl b/lib/unicode/Is/SylU.pl index 3054fd6..ec287c4 100644 --- a/lib/unicode/Is/SylU.pl +++ b/lib/unicode/Is/SylU.pl @@ -1,2 +1,5 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; END diff --git a/lib/unicode/Is/SylV.pl b/lib/unicode/Is/SylV.pl index 3054fd6..ec287c4 100644 --- a/lib/unicode/Is/SylV.pl +++ b/lib/unicode/Is/SylV.pl @@ -1,2 +1,5 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; END diff --git a/lib/unicode/Is/SylWA.pl b/lib/unicode/Is/SylWA.pl index 3054fd6..ec287c4 100644 --- a/lib/unicode/Is/SylWA.pl +++ b/lib/unicode/Is/SylWA.pl @@ -1,2 +1,5 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; END diff --git a/lib/unicode/Is/SylWC.pl b/lib/unicode/Is/SylWC.pl index 3054fd6..ec287c4 100644 --- a/lib/unicode/Is/SylWC.pl +++ b/lib/unicode/Is/SylWC.pl @@ -1,2 +1,5 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; END diff --git a/lib/unicode/Is/SylWE.pl b/lib/unicode/Is/SylWE.pl index 3054fd6..ec287c4 100644 --- a/lib/unicode/Is/SylWE.pl +++ b/lib/unicode/Is/SylWE.pl @@ -1,2 +1,5 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; END diff --git a/lib/unicode/Is/SylWI.pl b/lib/unicode/Is/SylWI.pl index 3054fd6..ec287c4 100644 --- a/lib/unicode/Is/SylWI.pl +++ b/lib/unicode/Is/SylWI.pl @@ -1,2 +1,5 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; END diff --git a/lib/unicode/Is/SylWV.pl b/lib/unicode/Is/SylWV.pl index 3054fd6..ec287c4 100644 --- a/lib/unicode/Is/SylWV.pl +++ b/lib/unicode/Is/SylWV.pl @@ -1,2 +1,5 @@ +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# This file is built by mktables.PL from e.g. Unicode.300. +# Any changes made here will be lost! return <<'END'; END diff --git a/lib/unicode/Jamo-2.txt b/lib/unicode/Jamo.txt similarity index 100% rename from lib/unicode/Jamo-2.txt rename to lib/unicode/Jamo.txt diff --git a/lib/unicode/NamesList.html b/lib/unicode/NamesList.html new file mode 100644 index 0000000..0bfc5db --- /dev/null +++ b/lib/unicode/NamesList.html @@ -0,0 +1,226 @@ + + + + +Unicode 3.0 NamesList File Structure + + + + +

Unicode NamesList File Format

+ +

Last updated: 1999-07-06

+ +

1.0 Introduction

+ +

The Unicode name list file NamesList.txt (also NamesList.lst) is a plain text file used +to drive the layout of the character code charts in the Unicode Standard. The information +in this file is a combination of several fields from the UnicodeData.txt and Blocks.txt files, +together with additional annotations for many characters. This document describes the +syntax rules for the file format, but also gives brief information on how each construct +is rendered when laid out for the book. Some of the syntax elements were used in +preparation of the drafts of the book and may not be present in the final, released form +of the NamesList.txt file.

+ +

The same input file can be used to do the draft preparation for ISO/IEC 10646 (referred +below as ISO-style). This necessitates the presence of some information in the name list +file that is not needed (and in fact removed during parsing) for the Unicode book.

+ +

With access to the layout program (unibook.exe) it is a simple matter of creating +name lists for the purpose of formatting working drafts containing proposed characters.

+ +

1.1 NamesList File Overview

+ +

The *.lst files are plain text files which in their most simple form look like this

+ +

@@<tab>0020<tab>BASIC LATIN<tab>007F
+; this is a file comment (ignored)
+0020<tab>SPACE
+0021<tab>EXCLAMATION MARK
+0022<tab>QUOTATION MARK
+. . .
+007F<tab>DELETE

+ +

The semicolon (as first character), @ and <tab> characters are used by the file +syntax and must be provided as shown. Hexadecimal digits must be in UPPER CASE). A double +@@ introduces a block header, with the title, and start and ending code of the block +provided as shown.

+ +

For an ISO-style, minimal name list, only the NAME_LINE and BLOCKHEADER and their +constituent syntax elements are needed.

+ +

The full syntax with all the options is provided in the following sections.

+ +

1.2 NamesList File Structure

+ +

This section gives defines the overall file structure

+ +
NAMELIST:     TITLE_PAGE* BLOCK* 
+
+TITLE_PAGE:   TITLE 
+		| TITLE_PAGE SUBTITLE 
+		| TITLE_PAGE SUBHEADER 
+		| TITLE_PAGE IGNORED_LINE 
+		| TITLE_PAGE EMPTY_LINE
+		| TITLE_PAGE COMMENTLINE
+		| TITLE_PAGE NOTICE
+		| TITLE_PAGE PAGEBREAK 
+
+BLOCK:	      BLOCKHEADER 
+		| BLOCK CHAR_ENTRY 
+		| BLOCK SUBHEADER 
+		| BLOCK NOTICE 
+		| BLOCK EMPTY_LINE 
+		| BLOCK IGNORED_LINE 
+		| BLOCK PAGEBREAK
+
+CHAR_ENTRY:   NAME_LINE | RESERVED_LINE
+		| CHAR_ENTRY ALIAS_LINE
+		| CHAR_ENTRY COMMENT_LINE
+		| CHAR_ENTRY CROSS_REF
+		| CHAR_ENTRY DECOMPOSITION
+		| CHAR_ENTRY COMPAT_MAPPING
+		| CHAR_ENTRY IGNORED_LINE
+		| CHAR_ENTRY EMPTY_LINE
+		| CHAR_ENTRY NOTICE
+
+ +

In other words:
+
+Neither TITLE nor  SUBTITLE may occur after the first BLOCKHEADER.

+ +

Only TITLE, SUBTITLE, SUBHEADER, PAGEBREAK, COMMENT_LINE,  and IGNORED_LINE may +occur before the first BLOCKHEADER.

+ +

Directly following either a NAME_LINE or a RESERVED_LINE an uninterrupted sequence of +the following lines may occur (in any order and repeated as often as needed): ALIAS_LINE, +CROSS_REF, DECOMPOSITION, COMPAT_MAPPING, NOTICE, EMPTY_LINE and IGNORED_LINE.

+ +

Except for EMPTY_LINE, NOTICE and IGNORED_LINE, none of these lines may occur in any other +place.

+ +

Note: A NOTICE displays differently depending on whether it follows a header or title +or is part of a CHAR_ENTRY.

+ +

1.3 NamesList File Elements

+ +

This section provides the details of the syntax for the individual elements.

+ +
ELEMENT		SYNTAX	// How rendered
+ +
NAME_LINE:	CHAR <tab> LINE
+			// the CHAR and the corresponding image are echoed, 
+			// followed by the name as given in LINE
+
+		CHAR TAB NAME COMMENT LF
+			// Names may have a comment, which is stripped off
+			// unless the file is parsed for an ISO style list
+										
+RESERVED_LINE:	CHAR TAB <reserved>		
+			// the CHAR is echoed followed by an icon for the
+			// reserved character and a fixed string e.g. <reserved>
+	
+COMMMENT_LINE:	<tab> "*" SP EXPAND_LINE
+			// * is replaced by BULLET, output line as comment
+		<tab> EXPAND_LINE	
+			// output line as comment
+
+ALIAS_LINE:	<tab> "=" SP LINE	
+			// replace = by itself, output line as alias
+
+CROSS_REF:	<tab> "X" SP EXPAND_LINE	
+			// X is replaced by a right arrow
+		<tab> "X" SP "(" STRING SP "-" SP CHAR ")"	
+			// X is replaced by a right arrow
+			// the "(", "-", ")" are removed, the
+			// order of CHAR and STRING is reversed
+			// i.e. both inputs result in the same output
+
+IGNORED_LINE:	<tab> ";" EXPAND_LINE	
+EMPTY_LINE:	LF			
+			// empty lines and file comments are ignored
+
+DECOMPOSITION:	<tab> ":" EXPAND_LINE	
+			// replace ':' by EQUIV, expand line into 
+			// decomposition 
+
+COMPAT_MAPPING:	<tab> "#" SP EXPAND_LINE	
+			// replace '#' by APPROX, output line as mapping 
+
+NOTICE:		"@+" <tab> LINE		
+			// skip '@+', output text as notice
+		"@+" TAB * SP LINE	
+			// skip '@', output text as notice
+			// "*" expands to a bullet character
+			// Notices following a character code apply to the
+			// character and are indented. Notices not following
+			// a character code apply to the page/block/column 
+			// and are italicized, but not indented
+
+SUBTITLE:	"@@@+" <tab> LINE	
+			// skip "@@@+", output text as subtitle
+
+SUBHEADER:	"@" <tab> LINE	
+			// skip '@', output line as text as column header
+
+BLOCKHEADER:	"@@" <tab> BLOCKSTART <tab> BLOCKNAME <tab> BLOCKEND
+			// skip "@@", cause a page break and optional
+			// blank page, then output one or more charts
+			// followed by the list of character names. 
+			// use BLOCKSTART and BLOCKEND to define the 
+			// what characters belong to a block
+			// use blockname in page and table headers
+		"@@" <tab> BLOCKSTART <tab> BLOCKNAME COMMENT <tab> BLOCKEND
+			// if a comment is present it replaces the blockname
+			// when an ISO-style namelist is laid out
+
+BLOCKSTART:	CHAR	// first character position in block
+BLOCKEND:	CHAR	// last character position in block
+PAGE_BREAK:	"@@"	// insert a (column) break
+
+TITLE:		"@@@" <tab> LINE	
+			// skip "@@@", output line as text
+			// Title is used in page headers
+
+EXPAND_LINE:	{CHAR | STRING}+ LF	
+			// all instances of CHAR *) are replaced by 
+			// CHAR NBSP x NBSP where x is the single Unicode
+			// character corresponding to char
+			// If character is combining, it is replaced with
+			// CHAR NBSP <circ> x NBSP where <circ> is the 
+			// dotted circle
+
+ +

1.4 NamesList File Primitives

+ +

The following are the primitives and terminals for the NamesList syntax.

+ +
LINE:		STRING LF
+COMMENT:	"(" NAME ")"
+		"(" NAME ")" "*"
+
+NAME:	  	<sequence of ASCII characters, except "(" or ")" > 
+STRING:	  	<sequence of Latin-1 characters> 
+CHAR:		X X X X
+		| X X X X X X X X X
+X:	  	"0"|"1"|"2"|"3"|"4"|"5"|"6"|"7"|"8"|"9"|"A"|"B"|"C"|"D"|"E"|"F" 
+<tab>:	  	<sequence of one or more ASCII tab characters 0x09>	
+SP:	  	<ASCII 0x20>
+LF:	  	<any sequence of ASCII 0x0A and 0x0D>
+
+ +

Notes: + +

    +
  • Special lookahead logic prevents a mention of a 4 digit standard, such as ISO 9999 from + being misinterpreted as ISO CHAR.
    • +
  • Use of Latin-1 is supported in unibook.exe, but not portably, unless the file is encoded as + UTF-16LE.
    • +
  • The final LF in the file must be present
    • +
  • A CHAR inside ' or " is expanded, but only its glyph image is printed,  the + code value is not echoed
    • +
  • Straight quotes in an EXPAND_LINE are replaced by curly quotes using English rules. + Apostrophes are supported, but nested quotes are not.
    • +
+ + diff --git a/lib/unicode/ReadMe.txt b/lib/unicode/ReadMe.txt index 889c325..c2c4aee 100644 --- a/lib/unicode/ReadMe.txt +++ b/lib/unicode/ReadMe.txt @@ -14,15 +14,32 @@ UnicodeCharacterDatabase.html. -------------------------------------------------------------------------- NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE -The files have been copied 1999-Sep-14 from +The files have been copied from ftp://ftp.unicode.org/Public/3.0-Update/ -and renamed to better fit 8.3 filename limitations. - -For example, the UnicodeCharacterDatabase.html referred above is -now called Unicode.html. - +and most of them have been renamed to better fit 8.3 filename limitations. + +long name at unicode.org short name latest '#' +------------------------ ---------- ---------- +ArabicShaping-#.txt ArabShap.txt 2 +Blocks-#.txt Blocks.txt 3 +CompositionExclusions-#.txt CompExcl.txt 1 +EastAsianWidth-#.txt EAWidth.txt 3 +Index-#.txt Index.txt 3.0.0 +Jamo-#.txt Jamo.txt 2 +LineBreak-#.txt LineBrk.txt 5 +NamesList-#.txt Names.txt 3.0.0 +NamesList-#.html NamesList.html 1 +PropList-#.txt Props.txt 3.0.0 +SpecialCasing-#.txt SpecCase.txt 2 +UnicodeData-#.txt Unicode.300 3.0.0 +UnicodeData-#.html Unicode3.html 3.0.0 +UnicodeCharacterDatabase-#.html UCD300.html 3.0.0 + +The *.pl files are generated from these files by the 'mktables.PL' script. + +While the files have been renamed the links in the html files haven't. + +-- jhi@iki.fi - - diff --git a/lib/unicode/Unicode.html b/lib/unicode/UCD300.html similarity index 100% rename from lib/unicode/Unicode.html rename to lib/unicode/UCD300.html diff --git a/lib/unicode/UnicodeData-Latest.txt b/lib/unicode/Unicode.300 similarity index 100% rename from lib/unicode/UnicodeData-Latest.txt rename to lib/unicode/Unicode.300 diff --git a/lib/unicode/Unicode3.html b/lib/unicode/Unicode3.html new file mode 100644 index 0000000..a08a25e --- /dev/null +++ b/lib/unicode/Unicode3.html @@ -0,0 +1,1988 @@ + + + + + + + + + + + + +UnicodeData File Format + + + + + + + + + +

UnicodeData File Format
+Version 3.0.0

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Revision3.0.0
AuthorsMark Davis and Ken Whistler
Date1999-09-12
This Versionftp://ftp.unicode.org/Public/3.0-Update/UnicodeData-3.0.0.html
Previous Versionn/a
Latest Versionftp://ftp.unicode.org/Public/3.0-Update/UnicodeData-3.0.0.html
+ + + +

Copyright © 1995-1999 Unicode, Inc. All Rights reserved.
+ +For more information, including Disclamer and Limitations, see UnicodeCharacterDatabase-3.0.0.html

+ + + +

This document describes the format of the UnicodeData.txt file, which is one of the + +files in the Unicode Character Database. The document is divided into the following + +sections: + + + +

+ + + +

Warning: the information in this file does not completely describe the use and + +interpretation of Unicode character properties and behavior. It must be used in + +conjunction with the data in the other files in the Unicode Character Database, and relies + +on the notation and definitions supplied in The Unicode +Standard. All chapter references + +are to Version 3.0 of the standard.

+ + + +

Field Formats

+ + + +

The file consists of lines containing fields terminated by semicolons. Each line + +represents the data for one encoded character in the Unicode Standard. Every encoded + +character has a data entry, with the exception of certain special ranges, as detailed + +below. + + + +

    + +
  • There are six special ranges of characters that are represented only by their start and + + end characters, since the properties in the file are uniform, except for code values + + (which are all sequential and assigned).
    • + +
  • The names of CJK ideograph characters and the names and decompositions of Hangul + + syllable characters are algorithmically derivable. (See the Unicode Standard and Unicode Technical Report #15 for + + more information).
    • + +
  • Surrogate code values and private use characters have no names.
    • + +
  • The Private Use character outside of the BMP (U+F0000..U+FFFFD, U+100000..U+10FFFD) are + + not listed. These correspond to surrogate pairs where the first surrogate is in the High + + Surrogate Private Use section.
    • + +
+ + + +

The exact ranges represented by start and end characters are: + + + +

    + +
  • CJK Ideographs Extension A (U+3400 - U+4DB5)
    • + +
  • CJK Ideographs (U+4E00 - U+9FA5)
    • + +
  • Hangul Syllables (U+AC00 - U+D7A3)
    • + +
  • Non-Private Use High Surrogates (U+D800 - U+DB7F)
    • + +
  • Private Use High Surrogates (U+DB80 - U+DBFF)
    • + +
  • Low Surrogates (U+DC00 - U+DFFF)
    • + +
  • The Private Use Area (U+E000 - U+F8FF)
    • + +
+ + + +

The following table describes the format and meaning of each field in a data entry in + +the UnicodeData file. Fields which contain normative information are so indicated.

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +

Field

Name

Status

Explanation

0Code valuenormativeCode value in 4-digit hexadecimal format.
1Character namenormativeThese names match exactly the names published in Chapter 14 of the + + Unicode Standard, Version 3.0.
2General Category normative / informative
+ + (see below)		This is a useful breakdown into various "character types" which + + can be used as a default categorization in implementations. See below for a brief + + explanation.
3Canonical Combining Classes normativeThe classes used for the Canonical Ordering Algorithm in the Unicode + + Standard. These classes are also printed in Chapter 4 of the Unicode Standard.
4Bidirectional Category normativeSee the list below for an explanation of the abbreviations used in this + + field. These are the categories required by the Bidirectional Behavior Algorithm in the + + Unicode Standard. These categories are summarized in Chapter 3 of the Unicode Standard.
5Character Decomposition + MappingnormativeIn the Unicode Standard, not all of the mappings are full (maximal) + + decompositions. Recursive application of look-up for decompositions will, in all cases, + + lead to a maximal decomposition. The decomposition mappings match exactly the + + decomposition mappings published with the character names in the Unicode Standard.
6Decimal digit valuenormativeThis is a numeric field. If the character has the decimal digit property, + + as specified in Chapter 4 of the Unicode Standard, the value of that digit is represented + + with an integer value in this field
7Digit valuenormativeThis is a numeric field. If the character represents a digit, not + + necessarily a decimal digit, the value is here. This covers digits which do not form + + decimal radix forms, such as the compatibility superscript digits
8Numeric valuenormativeThis is a numeric field. If the character has the numeric property, as + + specified in Chapter 4 of the Unicode Standard, the value of that character is represented + + with an integer or rational number in this field. This includes fractions as, e.g., + + "1/5" for U+2155 VULGAR FRACTION ONE FIFTH Also included are numerical values + + for compatibility characters such as circled numbers.
8MirrorednormativeIf the character has been identified as a "mirrored" character + + in bidirectional text, this field has the value "Y"; otherwise "N". + + The list of mirrored characters is also printed in Chapter 4 of the Unicode Standard.
10Unicode 1.0 NameinformativeThis is the old name as published in Unicode 1.0. This name is only + + provided when it is significantly different from the Unicode 3.0 name for the character.
1110646 comment fieldinformativeThis is the ISO 10646 comment field. It is in parantheses in the 10646 + + names list.
12Uppercase MappinginformativeUpper case equivalent mapping. If a character is part of an alphabet with + + case distinctions, and has an upper case equivalent, then the upper case equivalent is in + + this field. See the explanation below on case distinctions. These mappings are always + + one-to-one, not one-to-many or many-to-one. This field is informative.
13Lowercase MappinginformativeSimilar to Uppercase mapping
14Titlecase MappinginformativeSimilar to Uppercase mapping
+ + + +

General Category

+ + + +

The values in this field are abbreviations for the following. Some of the values are + +normative, and some are informative. For more information, see the Unicode Standard.

+ + + +

Note: the standard does not assign information to control characters (except for + +certain cases in the Bidirectional Algorithm). Implementations will generally also assign + +categories to certain control characters, notably CR and LF, according to platform + +conventions.

+ + + +

Normative Categories

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +

Abbr.

Description

LuLetter, Uppercase
LlLetter, Lowercase
LtLetter, Titlecase
MnMark, Non-Spacing
McMark, Spacing Combining
MeMark, Enclosing
NdNumber, Decimal Digit
NlNumber, Letter
NoNumber, Other
ZsSeparator, Space
ZlSeparator, Line
ZpSeparator, Paragraph
CcOther, Control
CfOther, Format
CsOther, Surrogate
CoOther, Private Use
CnOther, Not Assigned (no characters in the file have this property)
+ + + +

Informative Categories

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +

Abbr.

Description

LmLetter, Modifier
LoLetter, Other
PcPunctuation, Connector
PdPunctuation, Dash
PsPunctuation, Open
PePunctuation, Close
PiPunctuation, Initial quote (may behave like Ps or Pe depending on usage)
PfPunctuation, Final quote (may behave like Ps or Pe depending on usage)
PoPunctuation, Other
SmSymbol, Math
ScSymbol, Currency
SkSymbol, Modifier
SoSymbol, Other
+ + + +

Bidirectional Category

+ + + +

Please refer to Chapter 3 for an explanation of the algorithm for Bidirectional + +Behavior and an explanation of the significance of these categories. An up-to-date version + +can be found on Unicode Technical + +Report #9: The Bidirectional Algorithm. These values are normative.

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +

Type

Description

LLeft-to-Right
LRELeft-to-Right Embedding
LROLeft-to-Right Override
RRight-to-Left
ALRight-to-Left Arabic
RLERight-to-Left Embedding
RLORight-to-Left Override
PDFPop Directional Format
ENEuropean Number
ESEuropean Number Separator
ETEuropean Number Terminator
ANArabic Number
CSCommon Number Separator
NSMNon-Spacing Mark
BNBoundary Neutral
BParagraph Separator
SSegment Separator
WSWhitespace
ONOther Neutrals
+ + + +

Character Decomposition Mapping

+ + + +

The decomposition is a normative property of a character. The tags supplied with + +certain decomposition mappings generally indicate formatting information. Where no such + +tag is given, the mapping is designated as canonical. Conversely, the presence of a + +formatting tag also indicates that the mapping is a compatibility mapping and not a + +canonical mapping. In the absence of other formatting information in a compatibility + +mapping, the tag is used to distinguish it from canonical mappings.

+ + + +

In some instances a canonical mapping or a compatibility mapping may consist of a + +single character. For a canonical mapping, this indicates that the character is a + +canonical equivalent of another single character. For a compatibility mapping, this + +indicates that the character is a compatibility equivalent of another single character. + +The compatibility formatting tags used are:

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
Tag

Description

<font>  A font variant (e.g. a blackletter form).
<noBreak>  A no-break version of a space or hyphen.
<initial>  An initial presentation form (Arabic).
<medial>  A medial presentation form (Arabic).
<final>  A final presentation form (Arabic).
<isolated>  An isolated presentation form (Arabic).
<circle>  An encircled form.
<super>  A superscript form.
<sub>  A subscript form.
<vertical>  A vertical layout presentation form.
<wide>  A wide (or zenkaku) compatibility character.
<narrow>  A narrow (or hankaku) compatibility character.
<small>  A small variant form (CNS compatibility).
<square>  A CJK squared font variant.
<fraction>  A vulgar fraction form.
<compat>  Otherwise unspecified compatibility character.
+ + + +

Reminder: There is a difference between decomposition and decomposition mapping. + +The decomposition mappings are defined in the UnicodeData, while the decomposition (also + +termed "full decomposition") is defined in Chapter 3 to use those mappings + + +recursively. + + + +

    + +
  • The canonical decomposition is formed by recursively applying the canonical mappings, + + then applying the canonical reordering algorithm.
    • + +
  • The compatibility decomposition is formed by recursively applying the canonical and + + compatibility mappings, then applying the canonical reordering algorithm.
    • + +
+ + + +

Canonical Combining Classes

+ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +

Value

Description

0:Spacing, split, enclosing, reordrant, and Tibetan subjoined
1:Overlays and interior
7:Nuktas
8:Hiragana/Katakana voicing marks
9:Viramas
10:Start of fixed position classes
199:End of fixed position classes
200:Below left attached
202:Below attached
204:Below right attached
208:Left attached (reordrant around single base character)
210:Right attached
212:Above left attached
214:Above attached
216:Above right attached
218:Below left
220:Below
222:Below right
224:Left (reordrant around single base character)
226:Right
228:Above left
230:Above
232:Above right
233:Double below
234:Double above
240:Below (iota subscript)
+ + + +

Note: some of the combining classes in this list do not currently have + +members but are specified here for completeness.

+ + + +

Decompositions and Normalization

+ + + +

Decomposition is specified in Chapter 3. Unicode Technical Report #15: + +Normalization Forms specifies the interaction between decomposition and normalization. The + +most up-to-date version is found on http://www.unicode.org/unicode/reports/tr15/. + +That report specifies how the decompositions defined in UnicodeData.txt are used to derive + +normalized forms of Unicode text.

+ + + +

Note that as of the 2.1.9 update of the Unicode Character Database, the decompositions + +in the UnicodeData.txt file can be used to recursively derive the full decomposition in + +canonical order, without the need to separately apply canonical reordering. However, + +canonical reordering of combining character sequences must still be applied in + +decomposition when normalizing source text which contains any combining marks.

+ + + +

Case Mappings

+ + + +

The case mapping is an informative, default mapping. Case itself, on the other hand, + +has normative status. Thus, for example, 0041 LATIN CAPITAL LETTER A is normatively + +uppercase, but its lowercase mapping the 0061 LATIN SMALL LETTER A is informative. The + +reason for this is that case can be considered to be an inherent property of a particular + +character (and is usually, but not always, derivable from the presence of the terms + +"CAPITAL" or "SMALL" in the character name), but case mappings between + +characters are occasionally influenced by local conventions. For example, certain + +languages, such as Turkish, German, French, or Greek may have small deviations from the + +default mappings listed in UnicodeData.

+ + + +

In addition to uppercase and lowercase, because of the inclusion of certain composite + +characters for compatibility, such as 01F1 LATIN CAPITAL LETTER DZ, there is a third case, + +called titlecase, which is used where the first letter of a word is to be + +capitalized (e.g. UPPERCASE, Titlecase, lowercase). An example of such a titlecase letter + +is 01F2 LATIN CAPITAL LETTER D WITH SMALL LETTER Z.

+ + + +

The uppercase, titlecase and lowercase fields are only included for characters that + +have a single corresponding character of that type. Composite characters (such as + +"339D SQUARE CM") that do not have a single corresponding character of that type + +can be cased by decomposition.

+ + + +

For compatibility with existing parsers, UnicodeData only contains case mappings for + +characters where they are one-to-one mappings; it also omits information about + +context-sensitive case mappings. Information about these special cases can be found in a + +separate data file, SpecialCasing.txt, + +which has been added starting with the 2.1.8 update to the Unicode data files. + +SpecialCasing.txt contains additional informative case mappings that are either not + +one-to-one or which are context-sensitive.

+ + + +

Property Invariants

+ + + +

Values in UnicodeData.txt are subject to correction as errors are found; however, some + +characteristics of the categories themselves can be considered invariants. Applications + +may wish to take these invariants into account when choosing how to implement character + +properties. The following is a partial list of known invariants for the Unicode Character + +Database.

+ + + +

Database Fields

+ + + +
    + +
  • The number of fields in UnicodeData.txt is fixed.
    • + +
  • The order of the fields is also fixed.
      + +
    • Any additional information about character properties to be added in the future will + + appear in separate data tables, rather than being added on to the existing table or by + + subdivision or reinterpretation of existing fields.
      • + +
    + +
    • + +
+ + + +

General Category

+ + + +
    + +
  • There will never be more than 32 General Category values.
      + +
    • It is very unlikely that the Unicode Technical Committee will subdivide the General + + Category partition any further, since that can cause implementations to misbehave. Because + + the General Category is limited to 32 values, 5 bits can be used to represent the + + information, and a 32-bit integer can be used as a bitmask to represent arbitrary sets of + + categories.
      • + +
    + +
    • + +
+ + + +

Combining Classes

+ + + +
    + +
  • Combining classes are limited to the values 0 to 255.
      + +
    • In practice, there are far fewer than 256 values used. Implementations may take + + advantage of this fact for compression, since only the ordering of the non-zero values + + matters for the Canonical Reordering Algorithm. It is possible for up to 256 values to be + + used in the future; however, UTC decisions in the future may restrict the number of values + + to 128, since this has implementation advantages. [Signed bytes can be used without + + widening to ints in Java, for example.]
      • + +
    + +
    • + +
  • All characters other than those of General Category M* have the combining class 0.
      + +
    • Currently, all characters other than those of General Category Mn have the value 0. + + However, some characters of General Category Me or Mc may be given non-zero values in the + + future.
      • + +
    • The precise values above the value 0 are not invariant--only the relative ordering is + + considered normative. For example, it is not guaranteed in future versions that the class + + of U+05B4 will be precisely 14.
      • + +
    + +
    • + +
+ + + +

Case

+ + + +
    + +
  • Characters of type Lu, Lt, or Ll are called cased. All characters with an Upper, + + Lower, or Titlecase mapping are cased characters.
      + +
    • However, characters with the General Categories of Lu, Ll, or Lt may not always have + + case mappings, and case mappings may vary by locale. (See + + ftp://ftp.unicode.org/Public/UNIDATA/SpecialCasing.txt).
      • + +
    + +
    • + +
+ + + +

Canonical Decomposition

+ + + +
    + +
  • Canonical mappings are always in canonical order.
    • + +
  • Canonical mappings have only the first of a pair possibly further decomposing.
    • + +
  • Canonical decompositions are "transparent" to other character data:
      + +
    • BIDI(a) = BIDI(principal(canonicalDecomposition(a))
      • + +
    • Category(a) = Category(principal(canonicalDecomposition(a))
      • + +
    • CombiningClass(a) = CombiningClass(principal(canonicalDecomposition(a))
      + + where principal(a) is the first character not of type Mn, or the first character if all + + characters are of type Mn.
      • + +
    + +
    • + +
  • However, because there are sometimes missing case pairs, and because of some legacy + + characters, it is only generally true that:
      + +
    • upper(canonicalDecomposition(a)) = canonicalDecomposition(upper(a))
      • + +
    • lower(canonicalDecomposition(a)) = canonicalDecomposition(lower(a))
      • + +
    • title(canonicalDecomposition(a)) = canonicalDecomposition(title(a))
      • + +
    + +
    • + +
+ + + +

Modification History

+ + + +

This section provides a summary of the changes between update versions of the Unicode + +Standard.

+ + + +

Unicode 3.0.0

+ + + +

Modifications made for Version 3.0.0 of UnicodeData.txt include many new characters and + +a number of property changes. These are summarized in Appendex D of The Unicode + +Standard, Version 3.0.

+ + + +

Unicode 2.1.9

+ + + +

Modifications made for Version 2.1.9 of UnicodeData.txt include: + + + +

    + +
  • Corrected combining class for U+05AE HEBREW ACCENT ZINOR.
    • + +
  • Corrected combining class for U+20E1 COMBINING LEFT RIGHT ARROW ABOVE
    • + +
  • Corrected combining class for U+0F35 and U+0F37 to 220.
    • + +
  • Corrected combining class for U+0F71 to 129.
    • + +
  • Added a decomposition for U+0F0C TIBETAN MARK DELIMITER TSHEG BSTAR.
    • + +
  • Added  decompositions for several Greek symbol letters: U+03D0..U+03D2, U+03D5, + + U+03D6, U+03F0..U+03F2.
    • + +
  • Removed  decompositions from the conjoining jamo block: U+1100..U+11F8.
    • + +
  • Changes to decomposition mappings for some Tibetan vowels for consistency in + + normalization. (U+0F71, U+0F73, U+0F77, U+0F79, U+0F81)
    • + +
  • Updated the decomposition mappings for several Vietnamese characters with two diacritics + + (U+1EAC, U+1EAD, U+1EB6, U+1EB7, U+1EC6, U+1EC7, U+1ED8, U+1ED9), so that the recursive + + decomposition can be generated directly in canonically reordered form (not a normative + + change).
    • + +
  • Updated the decomposition mappings for several Arabic compatibility characters involving + + shadda (U+FC5E..U+FC62, U+FCF2..U+FCF4), and two Latin characters (U+1E1C, U+1E1D), so + + that the decompositions are generated directly in canonically reordered form (not a + + normative change).
    • + +
  • Changed BIDI category for: U+00A0 NO-BREAK SPACE, U+2007 FIGURE SPACE, U+2028 LINE + + SEPARATOR.
    • + +
  • Changed BIDI category for extenders of General Category Lm: U+3005, U+3021..U+3035, + + U+FF9E, U+FF9F.
    • + +
  • Changed General Category and BIDI category for the Greek numeral signs: U+0374, U+0375.
    • + +
  • Corrected General Category for U+FFE8 HALFWIDTH FORMS LIGHT VERTICAL.
    • + +
  • Added Unicode 1.0 names for many Tibetan characters (informative).
    • + +
+ + + +

Unicode 2.1.8

+ + + +

Modifications made for Version 2.1.8 of UnicodeData.txt include: + + + +

    + +
  • Added combining class 240 for U+0345 COMBINING GREEK YPOGEGRAMMENI so that + + decompositions involving iota subscript are derivable directly in canonically reordered + + form; this also has a bearing on simplification of casing of polytonic Greek.
    • + +
  • Changes in decompositions related to Greek tonos. These result from the clarification + + that monotonic Greek "tonos" should be equated with U+0301 COMBINING ACUTE, + + rather than with U+030D COMBINING VERTICAL LINE ABOVE. (All Greek characters in the Greek + + block involving "tonos"; some Greek characters in the polytonic Greek in the + + 1FXX block.)
    • + +
  • Changed decompositions involving dialytika tonos. (U+0390, U+03B0)
    • + +
  • Changed ternary decompositions to binary. (U+0CCB, U+FB2C, U+FB2D) These changes + + simplify normalization.
    • + +
  • Removed canonical decomposition for Latin Candrabindu. (U+0310)
    • + +
  • Corrected error in canonical decomposition for U+1FF4.
    • + +
  • Added compatibility decompositions to clarify collation tables. (U+2100, U+2101, U+2105, + + U+2106, U+1E9A)
    • + +
  • A series of general category changes to assist the convergence of of Unicode definition + + of identifier with ISO TR 10176:
      + +
    • So > Lo: U+0950, U+0AD0, U+0F00, U+0F88..U+0F8B
      • + +
    • Po > Lo: U+0E2F, U+0EAF, U+3006
      • + +
    • Lm > Sk: U+309B, U+309C
      • + +
    • Po > Pc: U+30FB, U+FF65
      • + +
    • Ps/Pe > Mn: U+0F3E, U+0F3F
      • + +
    + +
    • + +
  • A series of bidi property changes for consistency.
      + +
    • L > ET: U+09F2, U+09F3
      • + +
    • ON > L: U+3007
      • + +
    • L > ON: U+0F3A..U+0F3D, U+037E, U+0387
      • + +
    + +
    • + +
  • Add case mapping: U+01A6 <-> U+0280
    • + +
  • Updated symmetric swapping value for guillemets: U+00AB, U+00BB, U+2039, U+203A.
    • + +
  • Changes to combining class values. Most Indic fixed position class non-spacing marks + + were changed to combining class 0. This fixes some inconsistencies in how canonical + + reordering would apply to Indic scripts, including Tibetan. Indic interacting top/bottom + + fixed position classes were merged into single (non-zero) classes as part of this change. + + Tibetan subjoined consonants are changed from combining class 6 to combining class 0. Thai + + pinthu (U+0E3A) moved to combining class 9. Moved two Devanagari stress marks into generic + + above and below combining classes (U+0951, U+0952).
    • + +
  • Corrected placement of semicolon near symmetric swapping field. (U+FA0E, etc., scattered + + positions to U+FA29)
    • + +
+ + + +

Version 2.1.7

+ + + +

This version was for internal change tracking only, and never publicly released.

+ + + +

Version 2.1.6

+ + + +

This version was for internal change tracking only, and never publicly released.

+ + + +

Unicode 2.1.5

+ + + +

Modifications made for Version 2.1.5 of UnicodeData.txt include: + + + +

    + +
  • Changed decomposition for U+FF9E and U+FF9F so that correct collation weighting will + + automatically result from the canonical equivalences.
    • + +
  • Removed canonical decompositions for U+04D4, U+04D5, U+04D8, U+04D9, U+04E0, U+04E1, + + U+04E8, U+04E9 (the implication being that no canonical equivalence is claimed between + + these 8 characters and similar Latin letters), and updated 4 canonical decompositions for + + U+04DB, U+04DC, U+04EA, U+04EB to reflect the implied difference in the base character.
    • + +
  • Added Pi, and Pf categories and assigned the relevant quotation marks to those + + categories, based on the Unicode Technical Corrigendum on Quotation Characters.
    • + +
  • Updating of many bidi properties, following the advice of the ad hoc committee on bidi, + + and to make the bidi properties of compatibility characters more consistent.
    • + +
  • Changed category of several Tibetan characters: U+0F3E, U+0F3F, U+0F88..U+0F8B to make + + them non-combining, reflecting the combined opinion of Tibetan experts.
    • + +
  • Added case mapping for U+03F2.
    • + +
  • Corrected case mapping for U+0275.
    • + +
  • Added titlecase mappings for U+03D0, U+03D1, U+03D5, U+03D6, U+03F0.. U+03F2.
    • + +
  • Corrected compatibility label for U+2121.
    • + +
  • Add specific entries for all the CJK compatibility ideographs, U+F900..U+FA2D, so the + + canonical decomposition for each (the URO character it is equivalent to) can be carried in + + the database.
    • + +
+ + + +

Version 2.1.4

+ + + +

This version was for internal change tracking only, and never publicly released.

+ + + +

Version 2.1.3

+ + + +

This version was for internal change tracking only, and never publicly released.

+ + + +

Unicode 2.1.2

+ + + +

Modifications made in updating UnicodeData.txt to Version 2.1.2 for the Unicode + +Standard, Version 2.1 (from Version 2.0) include: + + + +

    + +
  • Added two characters (U+20AC and U+FFFC).
    • + +
  • Amended bidi properties for U+0026, U+002E, U+0040, U+2007.
    • + +
  • Corrected case mappings for U+018E, U+019F, U+01DD, U+0258, U+0275, U+03C2, U+1E9B.
    • + +
  • Changed combining order class for U+0F71.
    • + +
  • Corrected canonical decompositions for U+0F73, U+1FBE.
    • + +
  • Changed decomposition for U+FB1F from compatibility to canonical.
    • + +
  • Added compatibility decompositions for U+FBE8, U+FBE9, U+FBF9..U+FBFB.
    • + +
  • Corrected compatibility decompositions for U+2469, U+246A, U+3358.
    • + +
+ + + +

Version 2.1.1

+ + + +

This version was for internal change tracking only, and never publicly released.

+ + + +

Unicode 2.0.0

+ + + +

The modifications made in updating UnicodeData.txt for the Unicode + +Standard, Version 2.0 include: + + + +

    + +
  • Fixed decompositions with TONOS to use correct NSM: 030D.
    • + +
  • Removed old Hangul Syllables; mapping to new characters are in a separate table.
    • + +
  • Marked compatibility decompositions with additional tags.
    • + +
  • Changed old tag names for clarity.
    • + +
  • Revision of decompositions to use first-level decomposition, instead of maximal + + decomposition.
    • + +
  • Correction of all known errors in decompositions from earlier versions.
    • + +
  • Added control code names (as old Unicode names).
    • + +
  • Added Hangul Jamo decompositions.
    • + +
  • Added Number category to match properties list in book.
    • + +
  • Fixed categories of Koranic Arabic marks.
    • + +
  • Fixed categories of precomposed characters to match decomposition where possible.
    • + +
  • Added Hebrew cantillation marks and the Tibetan script.
    • + +
  • Added place holders for ranges such as CJK Ideographic Area and the Private Use Area.
    • + +
  • Added categories Me, Sk, Pc, Nl, Cs, Cf, and rectified a number of mistakes in the + + database.
    • + +
+ + + + + diff --git a/lib/unicode/mktables.PL b/lib/unicode/mktables.PL index 7d70b18..48d40f4 100755 --- a/lib/unicode/mktables.PL +++ b/lib/unicode/mktables.PL @@ -1,6 +1,6 @@ #!../../miniperl -$UnicodeData = "UnicodeData-Latest.txt"; +$UnicodeData = "Unicode.300"; # Note: we try to keep filenames unique within first 8 chars. Using # subdirectories for the following helps. @@ -181,6 +181,11 @@ foreach $file (@todo) { else { open(OUT, ">$table.pl") or die "Can't create $table.pl: $!\n"; } + print OUT <Block.pl") or die "Can't create $table.pl: $!\n"; +print OUT <) { print OUT "$code $last $name\n"; $name =~ s/\s+//g; open(BLOCK, ">In/$name.pl"); + print BLOCK <Eq/Unicode")) { +if (open(OUT, ">Eq/Unicode.pl")) { + print OUT <Eq/Latin1")) { +if (open(OUT, ">Eq/Latin1.pl")) { + print OUT < 255; my @c = grep { hex($_) < 256 } @{$unicode{$c}}; next unless @c; - print EQ_LATIN1 "$c @c\n"; + print OUT "$c @c\n"; } - close EQ_LATIN1; + print OUT "END\n"; + close OUT; } else { - die "$0: failed to open Eq/Latin1 for writing: $!\n"; + die "$0: failed to open Eq/Latin1.pl for writing: $!\n"; } # eof diff --git a/lib/vars.pm b/lib/vars.pm index ca2a08d..6ae5373 100644 --- a/lib/vars.pm +++ b/lib/vars.pm @@ -45,7 +45,7 @@ __END__ =head1 NAME -vars - Perl pragma to predeclare global variable names +vars - Perl pragma to predeclare global variable names (obsolete) =head1 SYNOPSIS @@ -53,6 +53,10 @@ vars - Perl pragma to predeclare global variable names =head1 DESCRIPTION +NOTE: The functionality provided by this pragma has been superseded +by C declarations, available in Perl v5.6.0 or later. See +L. + This will predeclare all the variables whose names are in the list, allowing you to use them under "use strict", and disabling any typo warnings. diff --git a/lib/warning.pm b/lib/warning.pm deleted file mode 100644 index 1df83d9..0000000 --- a/lib/warning.pm +++ /dev/null @@ -1,163 +0,0 @@ - -# This file was created by warning.pl -# Any changes made here will be lost. -# - -package warning; - -=head1 NAME - -warning - Perl pragma to control optional warnings - -=head1 SYNOPSIS - - use warning; - no warning; - - use warning "all"; - no warning "all"; - -=head1 DESCRIPTION - -If no import list is supplied, all possible warnings are either enabled -or disabled. - -See L and L. - - -=cut - -use Carp ; - -%Bits = ( - 'all' => "\x55\x55\x55\x55\x55\x55\x55\x55\x55", # [0..35] - 'ambiguous' => "\x00\x00\x00\x00\x01\x00\x00\x00\x00", # [16] - 'closed' => "\x04\x00\x00\x00\x00\x00\x00\x00\x00", # [1] - 'closure' => "\x00\x00\x00\x00\x00\x00\x10\x00\x00", # [26] - 'debugging' => "\x00\x00\x00\x01\x00\x00\x00\x00\x00", # [12] - 'deprecated' => "\x00\x00\x00\x00\x04\x00\x00\x00\x00", # [17] - 'exec' => "\x10\x00\x00\x00\x00\x00\x00\x00\x00", # [2] - 'inplace' => "\x00\x00\x00\x04\x00\x00\x00\x00\x00", # [13] - 'internal' => "\x00\x00\x00\x10\x00\x00\x00\x00\x00", # [14] - 'io' => "\x55\x05\x00\x00\x00\x00\x00\x00\x00", # [0..5] - 'misc' => "\x00\x10\x00\x00\x00\x00\x00\x00\x00", # [6] - 'newline' => "\x40\x00\x00\x00\x00\x00\x00\x00\x00", # [3] - 'numeric' => "\x00\x40\x00\x00\x00\x00\x00\x00\x00", # [7] - 'octal' => "\x00\x00\x00\x00\x10\x00\x00\x00\x00", # [18] - 'once' => "\x00\x00\x01\x00\x00\x00\x00\x00\x00", # [8] - 'parenthesis' => "\x00\x00\x00\x00\x40\x00\x00\x00\x00", # [19] - 'pipe' => "\x00\x01\x00\x00\x00\x00\x00\x00\x00", # [4] - 'precedence' => "\x00\x00\x00\x00\x00\x01\x00\x00\x00", # [20] - 'printf' => "\x00\x00\x00\x00\x00\x04\x00\x00\x00", # [21] - 'recursion' => "\x00\x00\x04\x00\x00\x00\x00\x00\x00", # [9] - 'redefine' => "\x00\x00\x10\x00\x00\x00\x00\x00\x00", # [10] - 'reserved' => "\x00\x00\x00\x00\x00\x10\x00\x00\x00", # [22] - 'semicolon' => "\x00\x00\x00\x00\x00\x40\x00\x00\x00", # [23] - 'severe' => "\x00\x00\x40\x15\x00\x00\x00\x00\x00", # [11..14] - 'signal' => "\x00\x00\x00\x00\x00\x00\x40\x00\x00", # [27] - 'substr' => "\x00\x00\x00\x00\x00\x00\x00\x01\x00", # [28] - 'syntax' => "\x00\x00\x00\x40\x55\x55\x00\x00\x00", # [15..23] - 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x04\x00", # [29] - 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x01\x00\x00", # [24] - 'unopened' => "\x00\x04\x00\x00\x00\x00\x00\x00\x00", # [5] - 'unsafe' => "\x00\x00\x00\x00\x00\x00\x54\x55\x00", # [25..31] - 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x10\x00", # [30] - 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x40\x00", # [31] - 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x01", # [32] - ); - -%DeadBits = ( - 'all' => "\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa\xaa", # [0..35] - 'ambiguous' => "\x00\x00\x00\x00\x02\x00\x00\x00\x00", # [16] - 'closed' => "\x08\x00\x00\x00\x00\x00\x00\x00\x00", # [1] - 'closure' => "\x00\x00\x00\x00\x00\x00\x20\x00\x00", # [26] - 'debugging' => "\x00\x00\x00\x02\x00\x00\x00\x00\x00", # [12] - 'deprecated' => "\x00\x00\x00\x00\x08\x00\x00\x00\x00", # [17] - 'exec' => "\x20\x00\x00\x00\x00\x00\x00\x00\x00", # [2] - 'inplace' => "\x00\x00\x00\x08\x00\x00\x00\x00\x00", # [13] - 'internal' => "\x00\x00\x00\x20\x00\x00\x00\x00\x00", # [14] - 'io' => "\xaa\x0a\x00\x00\x00\x00\x00\x00\x00", # [0..5] - 'misc' => "\x00\x20\x00\x00\x00\x00\x00\x00\x00", # [6] - 'newline' => "\x80\x00\x00\x00\x00\x00\x00\x00\x00", # [3] - 'numeric' => "\x00\x80\x00\x00\x00\x00\x00\x00\x00", # [7] - 'octal' => "\x00\x00\x00\x00\x20\x00\x00\x00\x00", # [18] - 'once' => "\x00\x00\x02\x00\x00\x00\x00\x00\x00", # [8] - 'parenthesis' => "\x00\x00\x00\x00\x80\x00\x00\x00\x00", # [19] - 'pipe' => "\x00\x02\x00\x00\x00\x00\x00\x00\x00", # [4] - 'precedence' => "\x00\x00\x00\x00\x00\x02\x00\x00\x00", # [20] - 'printf' => "\x00\x00\x00\x00\x00\x08\x00\x00\x00", # [21] - 'recursion' => "\x00\x00\x08\x00\x00\x00\x00\x00\x00", # [9] - 'redefine' => "\x00\x00\x20\x00\x00\x00\x00\x00\x00", # [10] - 'reserved' => "\x00\x00\x00\x00\x00\x20\x00\x00\x00", # [22] - 'semicolon' => "\x00\x00\x00\x00\x00\x80\x00\x00\x00", # [23] - 'severe' => "\x00\x00\x80\x2a\x00\x00\x00\x00\x00", # [11..14] - 'signal' => "\x00\x00\x00\x00\x00\x00\x80\x00\x00", # [27] - 'substr' => "\x00\x00\x00\x00\x00\x00\x00\x02\x00", # [28] - 'syntax' => "\x00\x00\x00\x80\xaa\xaa\x00\x00\x00", # [15..23] - 'taint' => "\x00\x00\x00\x00\x00\x00\x00\x08\x00", # [29] - 'uninitialized' => "\x00\x00\x00\x00\x00\x00\x02\x00\x00", # [24] - 'unopened' => "\x00\x08\x00\x00\x00\x00\x00\x00\x00", # [5] - 'unsafe' => "\x00\x00\x00\x00\x00\x00\xa8\xaa\x00", # [25..31] - 'untie' => "\x00\x00\x00\x00\x00\x00\x00\x20\x00", # [30] - 'utf8' => "\x00\x00\x00\x00\x00\x00\x00\x80\x00", # [31] - 'void' => "\x00\x00\x00\x00\x00\x00\x00\x00\x02", # [32] - ); - - -sub bits { - my $mask ; - my $catmask ; - my $fatal = 0 ; - foreach my $word (@_) { - if ($word eq 'FATAL') - { $fatal = 1 } - elsif ($catmask = $Bits{$word}) { - $mask |= $catmask ; - $mask |= $DeadBits{$word} if $fatal ; - } - else - { croak "unknown warning category '$word'" } - } - - return $mask ; -} - -sub import { - shift; - $^B |= bits(@_ ? @_ : 'all') ; -} - -sub unimport { - shift; - $^B &= ~ bits(@_ ? @_ : 'all') ; -} - - -sub make_fatal -{ - my $self = shift ; - my $bitmask = $self->bits(@_) ; - $SIG{__WARN__} = - sub - { - die @_ if $^B & $bitmask ; - warn @_ - } ; -} - -sub bitmask -{ - return $^B ; -} - -sub enabled -{ - my $string = shift ; - - return 1 - if $bits{$string} && $^B & $bits{$string} ; - - return 0 ; -} - -1; diff --git a/makedef.pl b/makedef.pl index c98d161..f640f2f 100644 --- a/makedef.pl +++ b/makedef.pl @@ -30,18 +30,21 @@ my %bincompat5005 = Perl_safesysmalloc => "Perl_safemalloc", Perl_safesysrealloc => "Perl_saferealloc", Perl_set_numeric_local => "perl_set_numeric_local", - Perl_set_numeric_standard => "perl_set_numeric_standard"); + Perl_set_numeric_standard => "perl_set_numeric_standard", + Perl_malloc => "malloc", + Perl_mfree => "free", + Perl_realloc => "realloc", + Perl_calloc => "calloc",); my $bincompat5005 = join("|", keys %bincompat5005); -while (@ARGV) - { - my $flag = shift; - $define{$1} = 1 if ($flag =~ /^-D(\w+)$/); - $define{$1} = $2 if ($flag =~ /^-D(\w+)=(.+)$/); - $CCTYPE = $1 if ($flag =~ /^CCTYPE=(\w+)$/); - $PLATFORM = $1 if ($flag =~ /^PLATFORM=(\w+)$/); - } +while (@ARGV) { + my $flag = shift; + $define{$1} = 1 if ($flag =~ /^-D(\w+)$/); + $define{$1} = $2 if ($flag =~ /^-D(\w+)=(.+)$/); + $CCTYPE = $1 if ($flag =~ /^CCTYPE=(\w+)$/); + $PLATFORM = $1 if ($flag =~ /^PLATFORM=(\w+)$/); +} my @PLATFORM = qw(aix win32 os2); my %PLATFORM; @@ -62,7 +65,8 @@ my $perlio_sym = "perlio.sym"; if ($PLATFORM eq 'aix') { # Nothing for now. -} elsif ($PLATFORM eq 'win32') { +} +elsif ($PLATFORM eq 'win32') { $CCTYPE = "MSVC" unless defined $CCTYPE; foreach ($thrdvar_h, $intrpvar_h, $perlvars_h, $global_sym, $pp_sym, $globvar_sym) { s!^!..\\!; @@ -71,8 +75,7 @@ if ($PLATFORM eq 'aix') { unless ($PLATFORM eq 'win32') { open(CFG,$config_sh) || die "Cannot open $config_sh: $!\n"; - while () - { + while () { if (/^(?:ccflags|optimize)='(.+)'$/) { $_ = $1; $define{$1} = 1 while /-D(\w+)/g; @@ -86,14 +89,14 @@ unless ($PLATFORM eq 'win32') { } open(CFG,$config_h) || die "Cannot open $config_h: $!\n"; -while () - { - $define{$1} = 1 if /^\s*#\s*define\s+(MYMALLOC)\b/; - $define{$1} = 1 if /^\s*#\s*define\s+(USE_THREADS)\b/; - $define{$1} = 1 if /^\s*#\s*define\s+(USE_PERLIO)\b/; - $define{$1} = 1 if /^\s*#\s*define\s+(MULTIPLICITY)\b/; - $define{$1} = 1 if /^\s*#\s*define\s+(PERL_BINCOMPAT_5005)\b/; - } +while () { + $define{$1} = 1 if /^\s*#\s*define\s+(MYMALLOC)\b/; + $define{$1} = 1 if /^\s*#\s*define\s+(USE_5005THREADS)\b/; + $define{$1} = 1 if /^\s*#\s*define\s+(USE_ITHREADS)\b/; + $define{$1} = 1 if /^\s*#\s*define\s+(USE_PERLIO)\b/; + $define{$1} = 1 if /^\s*#\s*define\s+(MULTIPLICITY)\b/; + $define{$1} = 1 if /^\s*#\s*define\s+(PERL_BINCOMPAT_5005)\b/; +} close(CFG); if ($PLATFORM eq 'win32') { @@ -104,7 +107,7 @@ if ($PLATFORM eq 'win32') { print "EXPORTS\n"; # output_symbol("perl_alloc"); output_symbol("perl_get_host_info"); - output_symbol("perl_alloc_using"); + output_symbol("perl_alloc_override"); # output_symbol("perl_construct"); # output_symbol("perl_destruct"); # output_symbol("perl_free"); @@ -114,17 +117,12 @@ if ($PLATFORM eq 'win32') { # exit(0); } else { - if ($CCTYPE ne 'GCC') { - print "LIBRARY Perl\n"; - print "DESCRIPTION 'Perl interpreter, export autogenerated'\n"; - } - else { - $define{'PERL_GLOBAL_STRUCT'} = 1; - $define{'MULTIPLICITY'} = 1; - } + print "LIBRARY Perl\n"; + print "DESCRIPTION 'Perl interpreter, export autogenerated'\n"; print "EXPORTS\n"; } -} elsif ($PLATFORM eq 'os2') { +} +elsif ($PLATFORM eq 'os2') { ($v = $]) =~ s/(\d\.\d\d\d)(\d\d)$/$1_$2/; $v .= '-thread' if $ARCHNAME =~ /-thread/; #$sum = 0; @@ -145,7 +143,8 @@ CODE LOADONCALL DATA LOADONCALL NONSHARED MULTIPLE EXPORTS ---EOP--- -} elsif ($PLATFORM eq 'aix') { +} +elsif ($PLATFORM eq 'aix') { print "#!\n"; } @@ -172,291 +171,319 @@ sub emit_symbols { } if ($PLATFORM eq 'win32') { -skip_symbols [qw( -PL_statusvalue_vms -PL_archpat_auto -PL_cryptseen -PL_DBcv -PL_generation -PL_lastgotoprobe -PL_linestart -PL_modcount -PL_pending_ident -PL_sortcxix -PL_sublex_info -PL_timesbuf -main -Perl_ErrorNo -Perl_GetVars -Perl_do_exec3 -Perl_do_ipcctl -Perl_do_ipcget -Perl_do_msgrcv -Perl_do_msgsnd -Perl_do_semop -Perl_do_shmio -Perl_dump_fds -Perl_init_thread_intern -Perl_my_bzero -Perl_my_htonl -Perl_my_ntohl -Perl_my_swap -Perl_my_chsize -Perl_same_dirent -Perl_setenv_getix -Perl_unlnk -Perl_watch -Perl_safexcalloc -Perl_safexmalloc -Perl_safexfree -Perl_safexrealloc -Perl_my_memcmp -Perl_my_memset -PL_cshlen -PL_cshname -PL_opsave -)]; -} elsif ($PLATFORM eq 'aix') { + skip_symbols [qw( + PL_statusvalue_vms + PL_archpat_auto + PL_cryptseen + PL_DBcv + PL_generation + PL_lastgotoprobe + PL_linestart + PL_modcount + PL_pending_ident + PL_sortcxix + PL_sublex_info + PL_timesbuf + main + Perl_ErrorNo + Perl_GetVars + Perl_do_exec3 + Perl_do_ipcctl + Perl_do_ipcget + Perl_do_msgrcv + Perl_do_msgsnd + Perl_do_semop + Perl_do_shmio + Perl_dump_fds + Perl_init_thread_intern + Perl_my_bzero + Perl_my_htonl + Perl_my_ntohl + Perl_my_swap + Perl_my_chsize + Perl_same_dirent + Perl_setenv_getix + Perl_unlnk + Perl_watch + Perl_safexcalloc + Perl_safexmalloc + Perl_safexfree + Perl_safexrealloc + Perl_my_memcmp + Perl_my_memset + PL_cshlen + PL_cshname + PL_opsave + Perl_do_exec + Perl_getenv_len + Perl_my_pclose + Perl_my_popen + )]; +} +elsif ($PLATFORM eq 'aix') { skip_symbols([qw( -Perl_dump_fds -Perl_ErrorNo -Perl_GetVars -Perl_my_bcopy -Perl_my_bzero -Perl_my_chsize -Perl_my_htonl -Perl_my_memcmp -Perl_my_memset -Perl_my_ntohl -Perl_my_swap -Perl_safexcalloc -Perl_safexfree -Perl_safexmalloc -Perl_safexrealloc -Perl_same_dirent -Perl_unlnk -PL_cryptseen -PL_opsave -PL_statusvalue_vms -PL_sys_intern -)]); -} - -if ($PLATFORM eq 'os2') { + Perl_dump_fds + Perl_ErrorNo + Perl_GetVars + Perl_my_bcopy + Perl_my_bzero + Perl_my_chsize + Perl_my_htonl + Perl_my_memcmp + Perl_my_memset + Perl_my_ntohl + Perl_my_swap + Perl_safexcalloc + Perl_safexfree + Perl_safexmalloc + Perl_safexrealloc + Perl_same_dirent + Perl_unlnk + PL_cryptseen + PL_opsave + PL_statusvalue_vms + PL_sys_intern + )]); +} +elsif ($PLATFORM eq 'os2') { emit_symbols([qw( -ctermid -get_sysinfo -Perl_OS2_init -OS2_Perl_data -dlopen -dlsym -dlerror -my_tmpfile -my_tmpnam -my_flock -malloc_mutex -threads_mutex -nthreads -nthreads_cond -os2_cond_wait -pthread_join -pthread_create -pthread_detach -XS_Cwd_change_drive -XS_Cwd_current_drive -XS_Cwd_extLibpath -XS_Cwd_extLibpath_set -XS_Cwd_sys_abspath -XS_Cwd_sys_chdir -XS_Cwd_sys_cwd -XS_Cwd_sys_is_absolute -XS_Cwd_sys_is_relative -XS_Cwd_sys_is_rooted -XS_DynaLoader_mod2fname -XS_File__Copy_syscopy -Perl_Register_MQ -Perl_Deregister_MQ -Perl_Serve_Messages -Perl_Process_Messages -init_PMWIN_entries -PMWIN_entries -Perl_hab_GET -)]); + ctermid + get_sysinfo + Perl_OS2_init + OS2_Perl_data + dlopen + dlsym + dlerror + my_tmpfile + my_tmpnam + my_flock + malloc_mutex + threads_mutex + nthreads + nthreads_cond + os2_cond_wait + os2_stat + pthread_join + pthread_create + pthread_detach + XS_Cwd_change_drive + XS_Cwd_current_drive + XS_Cwd_extLibpath + XS_Cwd_extLibpath_set + XS_Cwd_sys_abspath + XS_Cwd_sys_chdir + XS_Cwd_sys_cwd + XS_Cwd_sys_is_absolute + XS_Cwd_sys_is_relative + XS_Cwd_sys_is_rooted + XS_DynaLoader_mod2fname + XS_File__Copy_syscopy + Perl_Register_MQ + Perl_Deregister_MQ + Perl_Serve_Messages + Perl_Process_Messages + init_PMWIN_entries + PMWIN_entries + Perl_hab_GET + )]); } -if ($define{'PERL_OBJECT'}) { - skip_symbols [qw( - Perl_getenv_len - Perl_my_popen - Perl_my_pclose - )]; +unless ($define{'DEBUGGING'}) { + skip_symbols [qw( + Perl_deb + Perl_deb_growlevel + Perl_debop + Perl_debprofdump + Perl_debstack + Perl_debstackptrs + Perl_runops_debug + Perl_sv_peek + PL_block_type + PL_watchaddr + PL_watchok + )]; +} + +if ($define{'PERL_IMPLICIT_SYS'}) { + skip_symbols [qw( + Perl_getenv_len + Perl_my_popen + Perl_my_pclose + )]; } else { - skip_symbols [qw( - PL_Dir - PL_Env - PL_LIO - PL_Mem - PL_Proc - PL_Sock - PL_StdIO - )]; -} - -if ($define{'MYMALLOC'}) - { - emit_symbols [qw( - Perl_dump_mstats - Perl_malloc - Perl_mfree - Perl_realloc - Perl_calloc)]; - } -else - { - skip_symbols [qw( - Perl_dump_mstats - Perl_malloc - Perl_mfree - Perl_realloc - Perl_calloc - Perl_malloced_size)]; - } - -unless ($define{'USE_THREADS'}) - { - skip_symbols [qw( -PL_thr_key -PL_sv_mutex -PL_strtab_mutex -PL_svref_mutex -PL_malloc_mutex -PL_cred_mutex -PL_eval_mutex -PL_eval_cond -PL_eval_owner -PL_threads_mutex -PL_nthreads -PL_nthreads_cond -PL_threadnum -PL_threadsv_names -PL_thrsv -PL_vtbl_mutex -Perl_getTHR -Perl_setTHR -Perl_condpair_magic -Perl_new_struct_thread -Perl_per_thread_magicals -Perl_thread_create -Perl_find_threadsv -Perl_unlock_condpair -Perl_magic_mutexfree -)]; - } -unless ($define{'USE_THREADS'} or $define{'PERL_IMPLICIT_CONTEXT'} - or $define{'PERL_OBJECT'}) -{ - skip_symbols [qw( - Perl_croak_nocontext - Perl_die_nocontext - Perl_deb_nocontext - Perl_form_nocontext - Perl_warn_nocontext - Perl_warner_nocontext - Perl_newSVpvf_nocontext - Perl_sv_catpvf_nocontext - Perl_sv_setpvf_nocontext - Perl_sv_catpvf_mg_nocontext - Perl_sv_setpvf_mg_nocontext - )]; - } - -unless ($define{'FAKE_THREADS'}) - { - skip_symbols [qw(PL_curthr)]; - } - -sub readvar -{ - my $file = shift; - my $proc = shift || sub { "PL_$_[2]" }; - open(VARS,$file) || die "Cannot open $file: $!\n"; - my @syms; - while () - { - # All symbols have a Perl_ prefix because that's what embed.h - # sticks in front of them. - push(@syms, &$proc($1,$2,$3)) if (/\bPERLVAR(A?I?C?)\(([IGT])(\w+)/); - } - close(VARS); - return \@syms; -} - -if ($define{'USE_THREADS'} || $define{'MULTIPLICITY'}) - { - my $thrd = readvar($thrdvar_h); - skip_symbols $thrd; - } - -if ($define{'MULTIPLICITY'}) - { - my $interp = readvar($intrpvar_h); - skip_symbols $interp; - } - -if ($define{'PERL_GLOBAL_STRUCT'}) - { - my $global = readvar($perlvars_h); - skip_symbols $global; - emit_symbols [qw(Perl_GetVars)]; - emit_symbols [qw(PL_Vars PL_VarsPtr)] unless $CCTYPE eq 'GCC'; - } - -unless ($define{'DEBUGGING'}) - { - skip_symbols [qw( - Perl_deb - Perl_deb_growlevel - Perl_debop - Perl_debprofdump - Perl_debstack - Perl_debstackptrs - Perl_runops_debug - Perl_sv_peek - PL_block_type - PL_watchaddr - PL_watchok)]; - } - -if ($PLATFORM eq 'win32' && $define{'HAVE_DES_FCRYPT'}) - { - emit_symbols [qw(win32_crypt)]; - } + skip_symbols [qw( + PL_Mem + PL_MemShared + PL_MemParse + PL_Env + PL_StdIO + PL_LIO + PL_Dir + PL_Sock + PL_Proc + )]; +} + +if ($define{'MYMALLOC'}) { + emit_symbols [qw( + Perl_dump_mstats + Perl_malloc + Perl_mfree + Perl_realloc + Perl_calloc + )]; + if ($define{'USE_5005THREADS'} || $define{'USE_ITHREADS'}) { + emit_symbols [qw( + PL_malloc_mutex + )]; + } +} +else { + skip_symbols [qw( + PL_malloc_mutex + Perl_dump_mstats + Perl_malloc + Perl_mfree + Perl_realloc + Perl_calloc + Perl_malloced_size + )]; +} + +unless ($define{'USE_5005THREADS'}) { + skip_symbols [qw( + PL_thr_key + PL_sv_mutex + PL_strtab_mutex + PL_svref_mutex + PL_cred_mutex + PL_eval_mutex + PL_eval_cond + PL_eval_owner + PL_threads_mutex + PL_nthreads + PL_nthreads_cond + PL_threadnum + PL_threadsv_names + PL_thrsv + PL_vtbl_mutex + Perl_getTHR + Perl_setTHR + Perl_condpair_magic + Perl_new_struct_thread + Perl_per_thread_magicals + Perl_thread_create + Perl_find_threadsv + Perl_unlock_condpair + Perl_magic_mutexfree + )]; +} + +unless ($define{'USE_ITHREADS'}) { + skip_symbols [qw( + PL_ptr_table + Perl_dirp_dup + Perl_cx_dup + Perl_si_dup + Perl_any_dup + Perl_ss_dup + Perl_fp_dup + Perl_gp_dup + Perl_he_dup + Perl_mg_dup + Perl_re_dup + Perl_sv_dup + Perl_sys_intern_dup + Perl_ptr_table_fetch + Perl_ptr_table_new + Perl_ptr_table_split + Perl_ptr_table_store + perl_clone + perl_clone_using + )]; +} + +unless ($define{'PERL_IMPLICIT_CONTEXT'}) { + skip_symbols [qw( + Perl_croak_nocontext + Perl_die_nocontext + Perl_deb_nocontext + Perl_form_nocontext + Perl_mess_nocontext + Perl_warn_nocontext + Perl_warner_nocontext + Perl_newSVpvf_nocontext + Perl_sv_catpvf_nocontext + Perl_sv_setpvf_nocontext + Perl_sv_catpvf_mg_nocontext + Perl_sv_setpvf_mg_nocontext + )]; +} + +unless ($define{'PERL_IMPLICIT_SYS'}) { + skip_symbols [qw( + perl_alloc_using + perl_clone_using + )]; +} + +unless ($define{'FAKE_THREADS'}) { + skip_symbols [qw(PL_curthr)]; +} + +sub readvar { + my $file = shift; + my $proc = shift || sub { "PL_$_[2]" }; + open(VARS,$file) || die "Cannot open $file: $!\n"; + my @syms; + while () { + # All symbols have a Perl_ prefix because that's what embed.h + # sticks in front of them. + push(@syms, &$proc($1,$2,$3)) if (/\bPERLVAR(A?I?C?)\(([IGT])(\w+)/); + } + close(VARS); + return \@syms; +} + +if ($define{'USE_5005THREADS'} || $define{'MULTIPLICITY'}) { + my $thrd = readvar($thrdvar_h); + skip_symbols $thrd; +} + +if ($define{'MULTIPLICITY'}) { + my $interp = readvar($intrpvar_h); + skip_symbols $interp; +} + +if ($define{'PERL_GLOBAL_STRUCT'}) { + my $global = readvar($perlvars_h); + skip_symbols $global; + emit_symbol('Perl_GetVars'); + emit_symbols [qw(PL_Vars PL_VarsPtr)] unless $CCTYPE eq 'GCC'; +} # functions from *.sym files my @syms = ($global_sym, $pp_sym, $globvar_sym); -if ($define{'USE_PERLIO'}) - { +if ($define{'USE_PERLIO'}) { push @syms, $perlio_sym; - } - -for my $syms (@syms) - { - open (GLOBAL, "<$syms") || die "failed to open $syms: $!\n"; - while () - { - next if (!/^[A-Za-z]/); - # Functions have a Perl_ prefix - # Variables have a PL_ prefix - chomp($_); - my $symbol = ($syms =~ /var\.sym$/i ? "PL_" : ""); - $symbol .= $_; - emit_symbol($symbol) unless exists $skip{$symbol}; - } - close(GLOBAL); - } +} + +for my $syms (@syms) { + open (GLOBAL, "<$syms") || die "failed to open $syms: $!\n"; + while () { + next if (!/^[A-Za-z]/); + # Functions have a Perl_ prefix + # Variables have a PL_ prefix + chomp($_); + my $symbol = ($syms =~ /var\.sym$/i ? "PL_" : ""); + $symbol .= $_; + emit_symbol($symbol) unless exists $skip{$symbol}; + } + close(GLOBAL); +} # variables @@ -475,8 +502,7 @@ else { my $glob = readvar($intrpvar_h); emit_symbols $glob; } - - unless ($define{'MULTIPLICITY'} || $define{'USE_THREADS'}) { + unless ($define{'MULTIPLICITY'} || $define{'USE_5005THREADS'}) { my $glob = readvar($thrdvar_h); emit_symbols $glob; } @@ -499,176 +525,184 @@ while () { if ($PLATFORM eq 'win32') { foreach my $symbol (qw( -boot_DynaLoader -Perl_getTHR -Perl_init_os_extras -Perl_setTHR -Perl_thread_create -Perl_win32_init -RunPerl -GetPerlInterpreter -SetPerlInterpreter -win32_errno -win32_environ -win32_stdin -win32_stdout -win32_stderr -win32_ferror -win32_feof -win32_strerror -win32_fprintf -win32_printf -win32_vfprintf -win32_vprintf -win32_fread -win32_fwrite -win32_fopen -win32_fdopen -win32_freopen -win32_fclose -win32_fputs -win32_fputc -win32_ungetc -win32_getc -win32_fileno -win32_clearerr -win32_fflush -win32_ftell -win32_fseek -win32_fgetpos -win32_fsetpos -win32_rewind -win32_tmpfile -win32_abort -win32_fstat -win32_stat -win32_pipe -win32_popen -win32_pclose -win32_rename -win32_setmode -win32_lseek -win32_tell -win32_dup -win32_dup2 -win32_open -win32_close -win32_eof -win32_read -win32_write -win32_spawnvp -win32_mkdir -win32_rmdir -win32_chdir -win32_flock -win32_execv -win32_execvp -win32_htons -win32_ntohs -win32_htonl -win32_ntohl -win32_inet_addr -win32_inet_ntoa -win32_socket -win32_bind -win32_listen -win32_accept -win32_connect -win32_send -win32_sendto -win32_recv -win32_recvfrom -win32_shutdown -win32_closesocket -win32_ioctlsocket -win32_setsockopt -win32_getsockopt -win32_getpeername -win32_getsockname -win32_gethostname -win32_gethostbyname -win32_gethostbyaddr -win32_getprotobyname -win32_getprotobynumber -win32_getservbyname -win32_getservbyport -win32_select -win32_endhostent -win32_endnetent -win32_endprotoent -win32_endservent -win32_getnetent -win32_getnetbyname -win32_getnetbyaddr -win32_getprotoent -win32_getservent -win32_sethostent -win32_setnetent -win32_setprotoent -win32_setservent -win32_getenv -win32_putenv -win32_perror -win32_setbuf -win32_setvbuf -win32_flushall -win32_fcloseall -win32_fgets -win32_gets -win32_fgetc -win32_putc -win32_puts -win32_getchar -win32_putchar -win32_malloc -win32_calloc -win32_realloc -win32_free -win32_sleep -win32_times -win32_alarm -win32_open_osfhandle -win32_get_osfhandle -win32_ioctl -win32_utime -win32_uname -win32_wait -win32_waitpid -win32_kill -win32_str_os_error -win32_opendir -win32_readdir -win32_telldir -win32_seekdir -win32_rewinddir -win32_closedir -win32_longpath -win32_os_id - )) { + boot_DynaLoader + Perl_getTHR + Perl_init_os_extras + Perl_setTHR + Perl_thread_create + Perl_win32_init + RunPerl + GetPerlInterpreter + SetPerlInterpreter + win32_errno + win32_environ + win32_stdin + win32_stdout + win32_stderr + win32_ferror + win32_feof + win32_strerror + win32_fprintf + win32_printf + win32_vfprintf + win32_vprintf + win32_fread + win32_fwrite + win32_fopen + win32_fdopen + win32_freopen + win32_fclose + win32_fputs + win32_fputc + win32_ungetc + win32_getc + win32_fileno + win32_clearerr + win32_fflush + win32_ftell + win32_fseek + win32_fgetpos + win32_fsetpos + win32_rewind + win32_tmpfile + win32_abort + win32_fstat + win32_stat + win32_pipe + win32_popen + win32_pclose + win32_rename + win32_setmode + win32_lseek + win32_tell + win32_dup + win32_dup2 + win32_open + win32_close + win32_eof + win32_read + win32_write + win32_spawnvp + win32_mkdir + win32_rmdir + win32_chdir + win32_flock + win32_execv + win32_execvp + win32_htons + win32_ntohs + win32_htonl + win32_ntohl + win32_inet_addr + win32_inet_ntoa + win32_socket + win32_bind + win32_listen + win32_accept + win32_connect + win32_send + win32_sendto + win32_recv + win32_recvfrom + win32_shutdown + win32_closesocket + win32_ioctlsocket + win32_setsockopt + win32_getsockopt + win32_getpeername + win32_getsockname + win32_gethostname + win32_gethostbyname + win32_gethostbyaddr + win32_getprotobyname + win32_getprotobynumber + win32_getservbyname + win32_getservbyport + win32_select + win32_endhostent + win32_endnetent + win32_endprotoent + win32_endservent + win32_getnetent + win32_getnetbyname + win32_getnetbyaddr + win32_getprotoent + win32_getservent + win32_sethostent + win32_setnetent + win32_setprotoent + win32_setservent + win32_getenv + win32_putenv + win32_perror + win32_setbuf + win32_setvbuf + win32_flushall + win32_fcloseall + win32_fgets + win32_gets + win32_fgetc + win32_putc + win32_puts + win32_getchar + win32_putchar + win32_malloc + win32_calloc + win32_realloc + win32_free + win32_sleep + win32_times + win32_access + win32_alarm + win32_chmod + win32_open_osfhandle + win32_get_osfhandle + win32_ioctl + win32_link + win32_unlink + win32_utime + win32_uname + win32_wait + win32_waitpid + win32_kill + win32_str_os_error + win32_opendir + win32_readdir + win32_telldir + win32_seekdir + win32_rewinddir + win32_closedir + win32_longpath + win32_os_id + win32_getpid + win32_crypt + win32_dynaload + )) + { try_symbol($symbol); } } elsif ($PLATFORM eq 'os2') { - open MAP, 'miniperl.map' or die 'Cannot read miniperl.map'; - /^\s*[\da-f:]+\s+(\w+)/i and $mapped{$1}++ foreach ; - close MAP or die 'Cannot close miniperl.map'; - - @missing = grep { !exists $mapped{$_} } keys %export; - delete $export{$_} foreach @missing; + open MAP, 'miniperl.map' or die 'Cannot read miniperl.map'; + /^\s*[\da-f:]+\s+(\w+)/i and $mapped{$1}++ foreach ; + close MAP or die 'Cannot close miniperl.map'; + + @missing = grep { !exists $mapped{$_} and !exists $bincompat5005{$_} } + keys %export; + delete $export{$_} foreach @missing; } # Now all symbols should be defined because # next we are going to output them. -foreach my $symbol (sort keys %export) - { - output_symbol($symbol); - } +foreach my $symbol (sort keys %export) { + output_symbol($symbol); +} sub emit_symbol { - my $symbol = shift; - chomp($symbol); - $export{$symbol} = 1; + my $symbol = shift; + chomp($symbol); + $export{$symbol} = 1; } sub output_symbol { @@ -699,9 +733,11 @@ sub output_symbol { # print "\t$symbol\n"; # print "\t_$symbol = $symbol\n"; # } - } elsif ($PLATFORM eq 'os2') { + } + elsif ($PLATFORM eq 'os2') { print qq( "$symbol"\n); - } elsif ($PLATFORM eq 'aix') { + } + elsif ($PLATFORM eq 'aix') { print "$symbol\n"; } } @@ -710,6 +746,9 @@ sub output_symbol { __DATA__ # extra globals not included above. perl_alloc +perl_alloc_using +perl_clone +perl_clone_using perl_construct perl_destruct perl_free diff --git a/makedepend.SH b/makedepend.SH index f03f68b..994123e 100755 --- a/makedepend.SH +++ b/makedepend.SH @@ -130,6 +130,9 @@ for file in `$cat .clist`; do -e 's|\\$||' \ -e p \ -e '}' ) >UU/$file.c + if [ "$osname" = os390 -a "$file" = perly.c ]; then + $echo '#endif' >>UU/$file.c + fi $cppstdin $finc -I. $cppflags $cppminus /d' \ diff --git a/malloc.c b/malloc.c index 450142d..734ea06 100644 --- a/malloc.c +++ b/malloc.c @@ -900,6 +900,8 @@ emergency_sbrk(MEM_SIZE size) do_croak: MALLOC_UNLOCK; croak("Out of memory during request for %i bytes", size); + /* NOTREACHED */ + return Nullch; } #else /* !(defined(PERL_EMERGENCY_SBRK) && defined(PERL_CORE)) */ @@ -945,6 +947,7 @@ static u_int goodsbrk; static void botch(char *diag, char *s) { + dTHXo; PerlIO_printf(PerlIO_stderr(), "assertion botched (%s?): %s\n", diag, s); PerlProc_abort(); } @@ -1022,15 +1025,18 @@ Perl_malloc(register size_t nbytes) } DEBUG_m(PerlIO_printf(Perl_debug_log, - "0x%lx: (%05lu) malloc %ld bytes\n", - (unsigned long)(p+1), (unsigned long)(PL_an++), + "0x%"UVxf": (%05lu) malloc %ld bytes\n", + PTR2UV(p+1), (unsigned long)(PL_an++), (long)size)); /* remove from linked list */ #if defined(RCHECK) - if ((PTR2UV(p)) & (MEM_ALIGNBYTES - 1)) - PerlIO_printf(PerlIO_stderr(), "Corrupt malloc ptr 0x%lx at 0x%lx\n", - (unsigned long)*((int*)p),(unsigned long)p); + if ((PTR2UV(p)) & (MEM_ALIGNBYTES - 1)) { + dTHXo; + PerlIO_printf(PerlIO_stderr(), + "Corrupt malloc ptr 0x%lx at 0x%"UVxf"\n", + (unsigned long)*((int*)p),PTR2UV(p)); + } #endif nextf[bucket] = p->ov_next; @@ -1470,8 +1476,8 @@ Perl_mfree(void *mp) #endif DEBUG_m(PerlIO_printf(Perl_debug_log, - "0x%lx: (%05lu) free\n", - (unsigned long)cp, (unsigned long)(PL_an++))); + "0x%"UVxf": (%05lu) free\n", + PTR2UV(cp), (unsigned long)(PL_an++))); if (cp == NULL) return; @@ -1489,6 +1495,7 @@ Perl_mfree(void *mp) { static int bad_free_warn = -1; if (bad_free_warn == -1) { + dTHXo; char *pbf = PerlEnv_getenv("PERL_BADFREE"); bad_free_warn = (pbf) ? atoi(pbf) : 1; } @@ -1570,11 +1577,12 @@ Perl_realloc(void *mp, size_t nbytes) { static int bad_free_warn = -1; if (bad_free_warn == -1) { + dTHXo; char *pbf = PerlEnv_getenv("PERL_BADFREE"); bad_free_warn = (pbf) ? atoi(pbf) : 1; } if (!bad_free_warn) - return; + return Nullch; #ifdef RCHECK warn("%srealloc() %signored", (ovp->ov_rmagic == RMAGIC - 1 ? "" : "Bad "), @@ -1582,7 +1590,7 @@ Perl_realloc(void *mp, size_t nbytes) #else warn("%s", "Bad realloc() ignored"); #endif - return; /* sanity */ + return Nullch; /* sanity */ } onb = BUCKET_SIZE_REAL(bucket); @@ -1654,8 +1662,8 @@ Perl_realloc(void *mp, size_t nbytes) #endif res = cp; DEBUG_m(PerlIO_printf(Perl_debug_log, - "0x%lx: (%05lu) realloc %ld bytes inplace\n", - (unsigned long)res,(unsigned long)(PL_an++), + "0x%"UVxf": (%05lu) realloc %ld bytes inplace\n", + PTR2UV(res),(unsigned long)(PL_an++), (long)size)); } else if (incr == 1 && (cp - M_OVERHEAD == last_op) && (onb > (1 << LOG_OF_MIN_ARENA))) { @@ -1690,8 +1698,8 @@ Perl_realloc(void *mp, size_t nbytes) } else { hard_way: DEBUG_m(PerlIO_printf(Perl_debug_log, - "0x%lx: (%05lu) realloc %ld bytes the hard way\n", - (unsigned long)cp,(unsigned long)(PL_an++), + "0x%"UVxf": (%05lu) realloc %ld bytes the hard way\n", + PTR2UV(cp),(unsigned long)(PL_an++), (long)size)); if ((res = (char*)Perl_malloc(nbytes)) == NULL) return (NULL); @@ -1836,49 +1844,49 @@ Perl_dump_mstats(pTHX_ char *s) } MALLOC_UNLOCK; if (s) - PerlIO_printf(PerlIO_stderr(), + PerlIO_printf(Perl_error_log, "Memory allocation statistics %s (buckets %ld(%ld)..%ld(%ld)\n", s, (long)BUCKET_SIZE_REAL(MIN_BUCKET), (long)BUCKET_SIZE(MIN_BUCKET), (long)BUCKET_SIZE_REAL(topbucket), (long)BUCKET_SIZE(topbucket)); - PerlIO_printf(PerlIO_stderr(), "%8d free:", totfree); + PerlIO_printf(Perl_error_log, "%8d free:", totfree); for (i = MIN_EVEN_REPORT; i <= topbucket; i += BUCKETS_PER_POW2) { - PerlIO_printf(PerlIO_stderr(), + PerlIO_printf(Perl_error_log, ((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2) ? " %5d" : ((i < 12*BUCKETS_PER_POW2) ? " %3d" : " %d")), nfree[i]); } #ifdef BUCKETS_ROOT2 - PerlIO_printf(PerlIO_stderr(), "\n\t "); + PerlIO_printf(Perl_error_log, "\n\t "); for (i = MIN_BUCKET + 1; i <= topbucket_odd; i += BUCKETS_PER_POW2) { - PerlIO_printf(PerlIO_stderr(), + PerlIO_printf(Perl_error_log, ((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2) ? " %5d" : ((i < 12*BUCKETS_PER_POW2) ? " %3d" : " %d")), nfree[i]); } #endif - PerlIO_printf(PerlIO_stderr(), "\n%8d used:", total - totfree); + PerlIO_printf(Perl_error_log, "\n%8d used:", total - totfree); for (i = MIN_EVEN_REPORT; i <= topbucket; i += BUCKETS_PER_POW2) { - PerlIO_printf(PerlIO_stderr(), + PerlIO_printf(Perl_error_log, ((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2) ? " %5d" : ((i < 12*BUCKETS_PER_POW2) ? " %3d" : " %d")), nmalloc[i] - nfree[i]); } #ifdef BUCKETS_ROOT2 - PerlIO_printf(PerlIO_stderr(), "\n\t "); + PerlIO_printf(Perl_error_log, "\n\t "); for (i = MIN_BUCKET + 1; i <= topbucket_odd; i += BUCKETS_PER_POW2) { - PerlIO_printf(PerlIO_stderr(), + PerlIO_printf(Perl_error_log, ((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2) ? " %5d" : ((i < 12*BUCKETS_PER_POW2) ? " %3d" : " %d")), nmalloc[i] - nfree[i]); } #endif - PerlIO_printf(PerlIO_stderr(), "\nTotal sbrk(): %d/%d:%d. Odd ends: pad+heads+chain+tail: %d+%d+%d+%d.\n", + PerlIO_printf(Perl_error_log, "\nTotal sbrk(): %d/%d:%d. Odd ends: pad+heads+chain+tail: %d+%d+%d+%d.\n", goodsbrk + sbrk_slack, sbrks, sbrk_good, sbrk_slack, start_slack, total_chain, sbrked_remains); #endif /* DEBUGGING_MSTATS */ @@ -1962,8 +1970,8 @@ Perl_sbrk(int size) } } - DEBUG_m(PerlIO_printf(Perl_debug_log, "sbrk malloc size %ld (reqsize %ld), left size %ld, give addr 0x%lx\n", - size, reqsize, Perl_sbrk_oldsize, got)); + DEBUG_m(PerlIO_printf(Perl_debug_log, "sbrk malloc size %ld (reqsize %ld), left size %ld, give addr 0x%"UVxf"\n", + size, reqsize, Perl_sbrk_oldsize, PTR2UV(got))); return (void *)got; } diff --git a/mg.c b/mg.c index f50e4a0..fb2b8f1 100644 --- a/mg.c +++ b/mg.c @@ -48,7 +48,7 @@ S_save_magic(pTHX_ I32 mgs_ix, SV *sv) MGS* mgs; assert(SvMAGICAL(sv)); - SAVEDESTRUCTOR(restore_magic, (void*)mgs_ix); + SAVEDESTRUCTOR_X(restore_magic, (void*)mgs_ix); mgs = SSPTR(mgs_ix, MGS*); mgs->mgs_sv = sv; @@ -67,11 +67,11 @@ Perl_mg_magical(pTHX_ SV *sv) for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { MGVTBL* vtbl = mg->mg_virtual; if (vtbl) { - if ((vtbl->svt_get != NULL) && !(mg->mg_flags & MGf_GSKIP)) + if (vtbl->svt_get && !(mg->mg_flags & MGf_GSKIP)) SvGMAGICAL_on(sv); if (vtbl->svt_set) SvSMAGICAL_on(sv); - if (!(SvFLAGS(sv) & (SVs_GMG|SVs_SMG)) || (vtbl->svt_clear != NULL)) + if (!(SvFLAGS(sv) & (SVs_GMG|SVs_SMG)) || vtbl->svt_clear) SvRMAGICAL_on(sv); } } @@ -92,7 +92,7 @@ Perl_mg_get(pTHX_ SV *sv) mgp = &SvMAGIC(sv); while ((mg = *mgp) != 0) { MGVTBL* vtbl = mg->mg_virtual; - if (!(mg->mg_flags & MGf_GSKIP) && vtbl && (vtbl->svt_get != NULL)) { + if (!(mg->mg_flags & MGf_GSKIP) && vtbl && vtbl->svt_get) { CALL_FPTR(vtbl->svt_get)(aTHX_ sv, mg); /* Ignore this magic if it's been deleted */ if ((mg == (mgp_valid ? *mgp : SvMAGIC(sv))) && @@ -130,7 +130,7 @@ Perl_mg_set(pTHX_ SV *sv) mg->mg_flags &= ~MGf_GSKIP; /* setting requires another read */ (SSPTR(mgs_ix, MGS*))->mgs_flags = 0; } - if (vtbl && (vtbl->svt_set != NULL)) + if (vtbl && vtbl->svt_set) CALL_FPTR(vtbl->svt_set)(aTHX_ sv, mg); } @@ -147,7 +147,7 @@ Perl_mg_length(pTHX_ SV *sv) for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { MGVTBL* vtbl = mg->mg_virtual; - if (vtbl && (vtbl->svt_len != NULL)) { + if (vtbl && vtbl->svt_len) { I32 mgs_ix; mgs_ix = SSNEW(sizeof(MGS)); @@ -171,7 +171,7 @@ Perl_mg_size(pTHX_ SV *sv) for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { MGVTBL* vtbl = mg->mg_virtual; - if (vtbl && (vtbl->svt_len != NULL)) { + if (vtbl && vtbl->svt_len) { I32 mgs_ix; mgs_ix = SSNEW(sizeof(MGS)); @@ -209,7 +209,7 @@ Perl_mg_clear(pTHX_ SV *sv) MGVTBL* vtbl = mg->mg_virtual; /* omit GSKIP -- never set here */ - if (vtbl && (vtbl->svt_clear != NULL)) + if (vtbl && vtbl->svt_clear) CALL_FPTR(vtbl->svt_clear)(aTHX_ sv, mg); } @@ -252,7 +252,7 @@ Perl_mg_free(pTHX_ SV *sv) for (mg = SvMAGIC(sv); mg; mg = moremagic) { MGVTBL* vtbl = mg->mg_virtual; moremagic = mg->mg_moremagic; - if (vtbl && (vtbl->svt_free != NULL)) + if (vtbl && vtbl->svt_free) CALL_FPTR(vtbl->svt_free)(aTHX_ sv, mg); if (mg->mg_ptr && mg->mg_type != 'g') if (mg->mg_len >= 0) @@ -406,8 +406,19 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) case '\004': /* ^D */ sv_setiv(sv, (IV)(PL_debug & 32767)); +#if defined(YYDEBUG) && defined(DEBUGGING) + PL_yydebug = (PL_debug & 1); +#endif break; case '\005': /* ^E */ +#ifdef MACOS_TRADITIONAL + { + char msg[256]; + + sv_setnv(sv,(double)gLastMacOSErr); + sv_setpv(sv, gLastMacOSErr ? GetSysErrText(gLastMacOSErr, msg) : ""); + } +#else #ifdef VMS { # include @@ -453,6 +464,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) #endif #endif #endif +#endif SvNOK_on(sv); /* what a wonderful hack! */ break; case '\006': /* ^F */ @@ -638,7 +650,8 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) int saveerrno = errno; sv_setnv(sv, (NV)errno); #ifdef OS2 - if (errno == errno_isOS2) sv_setpv(sv, os2error(Perl_rc)); + if (errno == errno_isOS2 || errno == errno_isOS2_set) + sv_setpv(sv, os2error(Perl_rc)); else #endif sv_setpv(sv, errno ? Strerror(errno) : ""); @@ -655,26 +668,32 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) break; case '(': sv_setiv(sv, (IV)PL_gid); - Perl_sv_setpvf(aTHX_ sv, "%Vd", (IV)PL_gid); +#ifdef HAS_GETGROUPS + Perl_sv_setpvf(aTHX_ sv, "%"Gid_t_f, PL_gid); +#endif goto add_groups; case ')': sv_setiv(sv, (IV)PL_egid); - Perl_sv_setpvf(aTHX_ sv, "%Vd", (IV)PL_egid); +#ifdef HAS_GETGROUPS + Perl_sv_setpvf(aTHX_ sv, "%"Gid_t_f, PL_egid); +#endif add_groups: #ifdef HAS_GETGROUPS { Groups_t gary[NGROUPS]; i = getgroups(NGROUPS,gary); while (--i >= 0) - Perl_sv_catpvf(aTHX_ sv, " %Vd", (IV)gary[i]); + Perl_sv_catpvf(aTHX_ sv, " %"Gid_t_f, gary[i]); } #endif SvIOK_on(sv); /* what a wonderful hack! */ break; case '*': break; +#ifndef MACOS_TRADITIONAL case '0': break; +#endif #ifdef USE_THREADS case '@': sv_setsv(sv, thr->errsv); @@ -806,7 +825,10 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg) #if defined(VMS) Perl_die(aTHX_ "Can't make list assignment to %%ENV on this system"); #else -# ifdef WIN32 +# ifdef PERL_IMPLICIT_SYS + PerlEnv_clearenv(); +# else +# ifdef WIN32 char *envv = GetEnvironmentStrings(); char *cur = envv; STRLEN len; @@ -822,13 +844,13 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg) cur += len+1; } FreeEnvironmentStrings(envv); -# else -# ifdef CYGWIN +# else +# ifdef CYGWIN I32 i; for (i = 0; environ[i]; i++) - Safefree(environ[i]); -# else -# ifndef PERL_USE_SAFE_PUTENV + safesysfree(environ[i]); +# else +# ifndef PERL_USE_SAFE_PUTENV I32 i; if (environ == PL_origenviron) @@ -836,12 +858,13 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg) else for (i = 0; environ[i]; i++) safesysfree(environ[i]); -# endif /* PERL_USE_SAFE_PUTENV */ -# endif /* CYGWIN */ +# endif /* PERL_USE_SAFE_PUTENV */ +# endif /* CYGWIN */ environ[0] = Nullch; -# endif /* WIN32 */ +# endif /* WIN32 */ +# endif /* PERL_IMPLICIT_SYS */ #endif /* VMS */ return 0; } @@ -905,8 +928,6 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg) svp = &PL_diehook; else if (strEQ(s,"__WARN__")) svp = &PL_warnhook; - else if (strEQ(s,"__PARSE__")) - svp = &PL_parsehook; else Perl_croak(aTHX_ "No such hook: %s", s); i = 0; @@ -1127,7 +1148,7 @@ int Perl_magic_nextpack(pTHX_ SV *sv, MAGIC *mg, SV *key) { dSP; - char *meth = SvOK(key) ? "NEXTKEY" : "FIRSTKEY"; + const char *meth = SvOK(key) ? "NEXTKEY" : "FIRSTKEY"; ENTER; SAVETMPS; @@ -1168,7 +1189,7 @@ Perl_magic_setdbline(pTHX_ SV *sv, MAGIC *mg) i = SvTRUE(sv); svp = av_fetch(GvAV(gv), atoi(MgPV(mg,n_a)), FALSE); - if (svp && SvIOKp(*svp) && (o = (OP*)SvSTASH(*svp))) + if (svp && SvIOKp(*svp) && (o = INT2PTR(OP*,SvIVX(*svp)))) o->op_private = i; else if (ckWARN_d(WARN_INTERNAL)) Perl_warner(aTHX_ WARN_INTERNAL, "Can't break at that line\n"); @@ -1569,15 +1590,19 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) DEBUG_x(dump_all()); break; case '\005': /* ^E */ -#ifdef VMS - set_vaxc_errno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)); +#ifdef MACOS_TRADITIONAL + gLastMacOSErr = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); #else -# ifdef WIN32 - SetLastError( SvIV(sv) ); +# ifdef VMS + set_vaxc_errno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)); # else -# ifndef OS2 +# ifdef WIN32 + SetLastError( SvIV(sv) ); +# else +# ifndef OS2 /* will anyone ever use this? */ SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv), 4); +# endif # endif # endif #endif @@ -1641,12 +1666,12 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) PL_dowarn |= G_WARN_ONCE ; } } - } + } break; case '.': if (PL_localizing) { if (PL_localizing == 1) - save_sptr((SV**)&PL_last_in_gv); + SAVESPTR(PL_last_in_gv); } else if (SvOK(sv) && GvIO(PL_last_in_gv)) IoLINES(GvIOp(PL_last_in_gv)) = (long)SvIV(sv); @@ -1700,8 +1725,10 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) case '\\': if (PL_ors) Safefree(PL_ors); - if (SvOK(sv) || SvGMAGICAL(sv)) - PL_ors = savepv(SvPV(sv,PL_orslen)); + if (SvOK(sv) || SvGMAGICAL(sv)) { + s = SvPV(sv,PL_orslen); + PL_ors = savepvn(s,PL_orslen); + } else { PL_ors = Nullch; PL_orslen = 0; @@ -1872,6 +1899,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) case ':': PL_chopset = SvPV_force(sv,len); break; +#ifndef MACOS_TRADITIONAL case '0': if (!PL_origalen) { s = PL_origargv[0]; @@ -1929,6 +1957,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) PL_origargv[i] = Nullch; } break; +#endif #ifdef USE_THREADS case '@': sv_setsv(thr->errsv, sv); @@ -1943,8 +1972,9 @@ int Perl_magic_mutexfree(pTHX_ SV *sv, MAGIC *mg) { dTHR; - DEBUG_S(PerlIO_printf(PerlIO_stderr(), "0x%lx: magic_mutexfree 0x%lx\n", - (unsigned long)thr, (unsigned long)sv);) + DEBUG_S(PerlIO_printf(Perl_debug_log, + "0x%"UVxf": magic_mutexfree 0x%"UVxf"\n", + PTR2UV(thr), PTR2UV(sv));) if (MgOWNER(mg)) Perl_croak(aTHX_ "panic: magic_mutexfree"); MUTEX_DESTROY(MgMUTEXP(mg)); @@ -2006,7 +2036,7 @@ Perl_sighandler(int sig) if (flags & 1) { PL_savestack_ix += 5; /* Protect save in progress. */ o_save_i = PL_savestack_ix; - SAVEDESTRUCTOR(unwind_handler_stack, (void*)&flags); + SAVEDESTRUCTOR_X(unwind_handler_stack, (void*)&flags); } if (flags & 4) PL_markstack_ptr++; /* Protect mark. */ @@ -2068,7 +2098,6 @@ cleanup: #ifdef PERL_OBJECT -#define NO_XSLOCKS #include "XSUB.h" #endif @@ -2104,7 +2133,7 @@ restore_magic(pTHXo_ void *p) if (PL_savestack_ix == mgs->mgs_ss_ix) { I32 popval = SSPOPINT; - assert(popval == SAVEt_DESTRUCTOR); + assert(popval == SAVEt_DESTRUCTOR_X); PL_savestack_ix -= 2; popval = SSPOPINT; assert(popval == SAVEt_ALLOC); diff --git a/miniperlmain.c b/miniperlmain.c index f7b24f4..fb5cf1a 100644 --- a/miniperlmain.c +++ b/miniperlmain.c @@ -38,7 +38,7 @@ main(int argc, char **argv, char **env) #undef PERLVARIC #endif - PERL_SYS_INIT(&argc,&argv); + PERL_SYS_INIT3(&argc,&argv,&env); if (!PL_do_undump) { my_perl = perl_alloc(); diff --git a/mpeix/mpeixish.h b/mpeix/mpeixish.h index 2311171..b5e4fa4 100644 --- a/mpeix/mpeixish.h +++ b/mpeix/mpeixish.h @@ -97,7 +97,7 @@ #ifndef SIGILL # define SIGILL 6 /* blech */ #endif -#define ABORT() kill(getpid(),SIGABRT); +#define ABORT() kill(PerlProc_getpid(),SIGABRT); /* * fwrite1() should be a routine with the same calling sequence as fwrite(), diff --git a/myconfig.SH b/myconfig.SH index 83de2fa..dc76e73 100644 --- a/myconfig.SH +++ b/myconfig.SH @@ -33,8 +33,9 @@ Summary of my $package (revision $baserev version $PERL_VERSION subversion $PERL uname='$myuname' config_args='$config_args' hint=$hint, useposix=$useposix, d_sigaction=$d_sigaction - usethreads=$usethreads useperlio=$useperlio d_sfio=$d_sfio - use64bits=$use64bits usemultiplicity=$usemultiplicity + usethreads=$usethreads use5005threads=$use5005threads useithreads=$useithreads + usesocks=$usesocks useperlio=$useperlio d_sfio=$d_sfio + use64bits=$use64bits uselargefiles=$uselargefiles usemultiplicity=$usemultiplicity Compiler: cc='$cc', optimize='$optimize', gccversion=$gccversion cppflags='$cppflags' diff --git a/objXSUB.h b/objXSUB.h index 7a8e0aa..035367d 100644 --- a/objXSUB.h +++ b/objXSUB.h @@ -34,6 +34,10 @@ #define PL_LIO (*Perl_ILIO_ptr(aTHXo)) #undef PL_Mem #define PL_Mem (*Perl_IMem_ptr(aTHXo)) +#undef PL_MemParse +#define PL_MemParse (*Perl_IMemParse_ptr(aTHXo)) +#undef PL_MemShared +#define PL_MemShared (*Perl_IMemShared_ptr(aTHXo)) #undef PL_Proc #define PL_Proc (*Perl_IProc_ptr(aTHXo)) #undef PL_Sock @@ -42,14 +46,12 @@ #define PL_StdIO (*Perl_IStdIO_ptr(aTHXo)) #undef PL_amagic_generation #define PL_amagic_generation (*Perl_Iamagic_generation_ptr(aTHXo)) -#undef PL_ampergv -#define PL_ampergv (*Perl_Iampergv_ptr(aTHXo)) #undef PL_an #define PL_an (*Perl_Ian_ptr(aTHXo)) -#undef PL_archpat_auto -#define PL_archpat_auto (*Perl_Iarchpat_auto_ptr(aTHXo)) #undef PL_argvgv #define PL_argvgv (*Perl_Iargvgv_ptr(aTHXo)) +#undef PL_argvout_stack +#define PL_argvout_stack (*Perl_Iargvout_stack_ptr(aTHXo)) #undef PL_argvoutgv #define PL_argvoutgv (*Perl_Iargvoutgv_ptr(aTHXo)) #undef PL_basetime @@ -62,8 +64,6 @@ #define PL_bufend (*Perl_Ibufend_ptr(aTHXo)) #undef PL_bufptr #define PL_bufptr (*Perl_Ibufptr_ptr(aTHXo)) -#undef PL_cddir -#define PL_cddir (*Perl_Icddir_ptr(aTHXo)) #undef PL_collation_ix #define PL_collation_ix (*Perl_Icollation_ix_ptr(aTHXo)) #undef PL_collation_name @@ -106,10 +106,6 @@ #define PL_curthr (*Perl_Icurthr_ptr(aTHXo)) #undef PL_dbargs #define PL_dbargs (*Perl_Idbargs_ptr(aTHXo)) -#undef PL_debdelim -#define PL_debdelim (*Perl_Idebdelim_ptr(aTHXo)) -#undef PL_debname -#define PL_debname (*Perl_Idebname_ptr(aTHXo)) #undef PL_debstash #define PL_debstash (*Perl_Idebstash_ptr(aTHXo)) #undef PL_debug @@ -118,10 +114,6 @@ #define PL_defgv (*Perl_Idefgv_ptr(aTHXo)) #undef PL_diehook #define PL_diehook (*Perl_Idiehook_ptr(aTHXo)) -#undef PL_dlevel -#define PL_dlevel (*Perl_Idlevel_ptr(aTHXo)) -#undef PL_dlmax -#define PL_dlmax (*Perl_Idlmax_ptr(aTHXo)) #undef PL_doextract #define PL_doextract (*Perl_Idoextract_ptr(aTHXo)) #undef PL_doswitches @@ -154,6 +146,8 @@ #define PL_eval_start (*Perl_Ieval_start_ptr(aTHXo)) #undef PL_evalseq #define PL_evalseq (*Perl_Ievalseq_ptr(aTHXo)) +#undef PL_exit_flags +#define PL_exit_flags (*Perl_Iexit_flags_ptr(aTHXo)) #undef PL_exitlist #define PL_exitlist (*Perl_Iexitlist_ptr(aTHXo)) #undef PL_exitlistlen @@ -164,8 +158,6 @@ #define PL_fdpid (*Perl_Ifdpid_ptr(aTHXo)) #undef PL_filemode #define PL_filemode (*Perl_Ifilemode_ptr(aTHXo)) -#undef PL_filter_debug -#define PL_filter_debug (*Perl_Ifilter_debug_ptr(aTHXo)) #undef PL_forkprocess #define PL_forkprocess (*Perl_Iforkprocess_ptr(aTHXo)) #undef PL_formfeed @@ -218,16 +210,10 @@ #define PL_last_uni (*Perl_Ilast_uni_ptr(aTHXo)) #undef PL_lastfd #define PL_lastfd (*Perl_Ilastfd_ptr(aTHXo)) -#undef PL_lastsize -#define PL_lastsize (*Perl_Ilastsize_ptr(aTHXo)) -#undef PL_lastspbase -#define PL_lastspbase (*Perl_Ilastspbase_ptr(aTHXo)) #undef PL_laststatval #define PL_laststatval (*Perl_Ilaststatval_ptr(aTHXo)) #undef PL_laststype #define PL_laststype (*Perl_Ilaststype_ptr(aTHXo)) -#undef PL_leftgv -#define PL_leftgv (*Perl_Ileftgv_ptr(aTHXo)) #undef PL_lex_brackets #define PL_lex_brackets (*Perl_Ilex_brackets_ptr(aTHXo)) #undef PL_lex_brackstack @@ -242,8 +228,6 @@ #define PL_lex_dojoin (*Perl_Ilex_dojoin_ptr(aTHXo)) #undef PL_lex_expect #define PL_lex_expect (*Perl_Ilex_expect_ptr(aTHXo)) -#undef PL_lex_fakebrack -#define PL_lex_fakebrack (*Perl_Ilex_fakebrack_ptr(aTHXo)) #undef PL_lex_formbrack #define PL_lex_formbrack (*Perl_Ilex_formbrack_ptr(aTHXo)) #undef PL_lex_inpat @@ -274,8 +258,6 @@ #define PL_main_root (*Perl_Imain_root_ptr(aTHXo)) #undef PL_main_start #define PL_main_start (*Perl_Imain_start_ptr(aTHXo)) -#undef PL_malloc_mutex -#define PL_malloc_mutex (*Perl_Imalloc_mutex_ptr(aTHXo)) #undef PL_max_intro_pending #define PL_max_intro_pending (*Perl_Imax_intro_pending_ptr(aTHXo)) #undef PL_maxo @@ -310,8 +292,6 @@ #define PL_multi_start (*Perl_Imulti_start_ptr(aTHXo)) #undef PL_multiline #define PL_multiline (*Perl_Imultiline_ptr(aTHXo)) -#undef PL_mystrk -#define PL_mystrk (*Perl_Imystrk_ptr(aTHXo)) #undef PL_nexttoke #define PL_nexttoke (*Perl_Inexttoke_ptr(aTHXo)) #undef PL_nexttype @@ -340,8 +320,6 @@ #define PL_ofmt (*Perl_Iofmt_ptr(aTHXo)) #undef PL_oldbufptr #define PL_oldbufptr (*Perl_Ioldbufptr_ptr(aTHXo)) -#undef PL_oldlastpm -#define PL_oldlastpm (*Perl_Ioldlastpm_ptr(aTHXo)) #undef PL_oldname #define PL_oldname (*Perl_Ioldname_ptr(aTHXo)) #undef PL_oldoldbufptr @@ -372,8 +350,6 @@ #define PL_padix (*Perl_Ipadix_ptr(aTHXo)) #undef PL_padix_floor #define PL_padix_floor (*Perl_Ipadix_floor_ptr(aTHXo)) -#undef PL_parsehook -#define PL_parsehook (*Perl_Iparsehook_ptr(aTHXo)) #undef PL_patchlevel #define PL_patchlevel (*Perl_Ipatchlevel_ptr(aTHXo)) #undef PL_pending_ident @@ -392,10 +368,14 @@ #define PL_preprocess (*Perl_Ipreprocess_ptr(aTHXo)) #undef PL_profiledata #define PL_profiledata (*Perl_Iprofiledata_ptr(aTHXo)) +#undef PL_psig_name +#define PL_psig_name (*Perl_Ipsig_name_ptr(aTHXo)) +#undef PL_psig_ptr +#define PL_psig_ptr (*Perl_Ipsig_ptr_ptr(aTHXo)) +#undef PL_ptr_table +#define PL_ptr_table (*Perl_Iptr_table_ptr(aTHXo)) #undef PL_replgv #define PL_replgv (*Perl_Ireplgv_ptr(aTHXo)) -#undef PL_rightgv -#define PL_rightgv (*Perl_Irightgv_ptr(aTHXo)) #undef PL_rsfp #define PL_rsfp (*Perl_Irsfp_ptr(aTHXo)) #undef PL_rsfp_filters @@ -404,14 +384,8 @@ #define PL_runops (*Perl_Irunops_ptr(aTHXo)) #undef PL_sawampersand #define PL_sawampersand (*Perl_Isawampersand_ptr(aTHXo)) -#undef PL_sawstudy -#define PL_sawstudy (*Perl_Isawstudy_ptr(aTHXo)) -#undef PL_sawvec -#define PL_sawvec (*Perl_Isawvec_ptr(aTHXo)) #undef PL_sh_path #define PL_sh_path (*Perl_Ish_path_ptr(aTHXo)) -#undef PL_siggv -#define PL_siggv (*Perl_Isiggv_ptr(aTHXo)) #undef PL_sighandlerp #define PL_sighandlerp (*Perl_Isighandlerp_ptr(aTHXo)) #undef PL_splitstr @@ -422,10 +396,12 @@ #define PL_statusvalue (*Perl_Istatusvalue_ptr(aTHXo)) #undef PL_statusvalue_vms #define PL_statusvalue_vms (*Perl_Istatusvalue_vms_ptr(aTHXo)) +#undef PL_stderrgv +#define PL_stderrgv (*Perl_Istderrgv_ptr(aTHXo)) #undef PL_stdingv #define PL_stdingv (*Perl_Istdingv_ptr(aTHXo)) -#undef PL_strchop -#define PL_strchop (*Perl_Istrchop_ptr(aTHXo)) +#undef PL_stopav +#define PL_stopav (*Perl_Istopav_ptr(aTHXo)) #undef PL_strtab #define PL_strtab (*Perl_Istrtab_ptr(aTHXo)) #undef PL_strtab_mutex @@ -460,8 +436,6 @@ #define PL_sys_intern (*Perl_Isys_intern_ptr(aTHXo)) #undef PL_tainting #define PL_tainting (*Perl_Itainting_ptr(aTHXo)) -#undef PL_thisexpr -#define PL_thisexpr (*Perl_Ithisexpr_ptr(aTHXo)) #undef PL_thr_key #define PL_thr_key (*Perl_Ithr_key_ptr(aTHXo)) #undef PL_threadnum @@ -830,6 +804,8 @@ #define PL_do_undump (*Perl_Gdo_undump_ptr(NULL)) #undef PL_hexdigit #define PL_hexdigit (*Perl_Ghexdigit_ptr(NULL)) +#undef PL_malloc_mutex +#define PL_malloc_mutex (*Perl_Gmalloc_mutex_ptr(NULL)) #undef PL_patleave #define PL_patleave (*Perl_Gpatleave_ptr(NULL)) @@ -839,7 +815,21 @@ /* XXX soon to be eliminated, only a few things in PERLCORE need these now */ +#if defined(PERL_IMPLICIT_SYS) +#else +#endif +#if defined(USE_ITHREADS) +# if defined(PERL_IMPLICIT_SYS) +# endif +#endif +#if defined(MYMALLOC) +#endif +#if defined(PERL_OBJECT) +#ifndef __BORLANDC__ +#endif +#endif #if defined(PERL_OBJECT) +#else #endif #undef Perl_amagic_call #define Perl_amagic_call pPerl->Perl_amagic_call @@ -861,6 +851,10 @@ #define Perl_apply pPerl->Perl_apply #undef apply #define apply Perl_apply +#undef Perl_avhv_delete_ent +#define Perl_avhv_delete_ent pPerl->Perl_avhv_delete_ent +#undef avhv_delete_ent +#define avhv_delete_ent Perl_avhv_delete_ent #undef Perl_avhv_exists_ent #define Perl_avhv_exists_ent pPerl->Perl_avhv_exists_ent #undef avhv_exists_ent @@ -885,6 +879,14 @@ #define Perl_av_clear pPerl->Perl_av_clear #undef av_clear #define av_clear Perl_av_clear +#undef Perl_av_delete +#define Perl_av_delete pPerl->Perl_av_delete +#undef av_delete +#define av_delete Perl_av_delete +#undef Perl_av_exists +#define Perl_av_exists pPerl->Perl_av_exists +#undef av_exists +#define av_exists Perl_av_exists #undef Perl_av_extend #define Perl_av_extend pPerl->Perl_av_extend #undef av_extend @@ -1127,10 +1129,6 @@ #define Perl_vdeb pPerl->Perl_vdeb #undef vdeb #define vdeb Perl_vdeb -#undef Perl_deb_growlevel -#define Perl_deb_growlevel pPerl->Perl_deb_growlevel -#undef deb_growlevel -#define deb_growlevel Perl_deb_growlevel #undef Perl_debprofdump #define Perl_debprofdump pPerl->Perl_debprofdump #undef debprofdump @@ -2017,12 +2015,6 @@ #define Perl_magicname pPerl->Perl_magicname #undef magicname #define magicname Perl_magicname -#if defined(MYMALLOC) -#undef Perl_malloced_size -#define Perl_malloced_size pPerl->Perl_malloced_size -#undef malloced_size -#define malloced_size Perl_malloced_size -#endif #undef Perl_markstack_grow #define Perl_markstack_grow pPerl->Perl_markstack_grow #undef markstack_grow @@ -2297,6 +2289,10 @@ #define Perl_newLISTOP pPerl->Perl_newLISTOP #undef newLISTOP #define newLISTOP Perl_newLISTOP +#undef Perl_newPADOP +#define Perl_newPADOP pPerl->Perl_newPADOP +#undef newPADOP +#define newPADOP Perl_newPADOP #undef Perl_newPMOP #define Perl_newPMOP pPerl->Perl_newPMOP #undef newPMOP @@ -2434,36 +2430,23 @@ #undef peep #define peep Perl_peep #if defined(PERL_OBJECT) -#undef perl_construct -#define perl_construct pPerl->perl_construct -#undef perl_destruct -#define perl_destruct pPerl->perl_destruct -#undef perl_free -#define perl_free pPerl->perl_free -#undef perl_run -#define perl_run pPerl->perl_run -#undef perl_parse -#define perl_parse pPerl->perl_parse -#else -#undef perl_alloc -#define perl_alloc pPerl->perl_alloc -#undef perl_construct -#define perl_construct pPerl->perl_construct -#undef perl_destruct -#define perl_destruct pPerl->perl_destruct -#undef perl_free -#define perl_free pPerl->perl_free -#undef perl_run -#define perl_run pPerl->perl_run -#undef perl_parse -#define perl_parse pPerl->perl_parse +#undef Perl_construct +#define Perl_construct pPerl->Perl_construct +#undef Perl_destruct +#define Perl_destruct pPerl->Perl_destruct +#undef Perl_free +#define Perl_free pPerl->Perl_free +#undef Perl_run +#define Perl_run pPerl->Perl_run +#undef Perl_parse +#define Perl_parse pPerl->Perl_parse +#endif #if defined(USE_THREADS) #undef Perl_new_struct_thread #define Perl_new_struct_thread pPerl->Perl_new_struct_thread #undef new_struct_thread #define new_struct_thread Perl_new_struct_thread #endif -#endif #undef Perl_call_atexit #define Perl_call_atexit pPerl->Perl_call_atexit #undef call_atexit @@ -2706,6 +2689,10 @@ #define Perl_save_destructor pPerl->Perl_save_destructor #undef save_destructor #define save_destructor Perl_save_destructor +#undef Perl_save_destructor_x +#define Perl_save_destructor_x pPerl->Perl_save_destructor_x +#undef save_destructor_x +#define save_destructor_x Perl_save_destructor_x #undef Perl_save_freesv #define Perl_save_freesv pPerl->Perl_save_freesv #undef save_freesv @@ -2750,6 +2737,10 @@ #define Perl_save_I32 pPerl->Perl_save_I32 #undef save_I32 #define save_I32 Perl_save_I32 +#undef Perl_save_I8 +#define Perl_save_I8 pPerl->Perl_save_I8 +#undef save_I8 +#define save_I8 Perl_save_I8 #undef Perl_save_int #define Perl_save_int pPerl->Perl_save_int #undef save_int @@ -2786,6 +2777,10 @@ #define Perl_save_pptr pPerl->Perl_save_pptr #undef save_pptr #define save_pptr Perl_save_pptr +#undef Perl_save_vptr +#define Perl_save_vptr pPerl->Perl_save_vptr +#undef save_vptr +#define save_vptr Perl_save_vptr #undef Perl_save_re_context #define Perl_save_re_context pPerl->Perl_save_re_context #undef save_re_context @@ -2908,6 +2903,14 @@ #define Perl_sv_2pv pPerl->Perl_sv_2pv #undef sv_2pv #define sv_2pv Perl_sv_2pv +#undef Perl_sv_2pvutf8 +#define Perl_sv_2pvutf8 pPerl->Perl_sv_2pvutf8 +#undef sv_2pvutf8 +#define sv_2pvutf8 Perl_sv_2pvutf8 +#undef Perl_sv_2pvbyte +#define Perl_sv_2pvbyte pPerl->Perl_sv_2pvbyte +#undef sv_2pvbyte +#define sv_2pvbyte Perl_sv_2pvbyte #undef Perl_sv_2uv #define Perl_sv_2uv pPerl->Perl_sv_2uv #undef sv_2uv @@ -2928,6 +2931,14 @@ #define Perl_sv_pvn pPerl->Perl_sv_pvn #undef sv_pvn #define sv_pvn Perl_sv_pvn +#undef Perl_sv_pvutf8n +#define Perl_sv_pvutf8n pPerl->Perl_sv_pvutf8n +#undef sv_pvutf8n +#define sv_pvutf8n Perl_sv_pvutf8n +#undef Perl_sv_pvbyten +#define Perl_sv_pvbyten pPerl->Perl_sv_pvbyten +#undef sv_pvbyten +#define sv_pvbyten Perl_sv_pvbyten #undef Perl_sv_true #define Perl_sv_true pPerl->Perl_sv_true #undef sv_true @@ -3086,6 +3097,14 @@ #define Perl_sv_pvn_force pPerl->Perl_sv_pvn_force #undef sv_pvn_force #define sv_pvn_force Perl_sv_pvn_force +#undef Perl_sv_pvutf8n_force +#define Perl_sv_pvutf8n_force pPerl->Perl_sv_pvutf8n_force +#undef sv_pvutf8n_force +#define sv_pvutf8n_force Perl_sv_pvutf8n_force +#undef Perl_sv_pvbyten_force +#define Perl_sv_pvbyten_force pPerl->Perl_sv_pvbyten_force +#undef sv_pvbyten_force +#define sv_pvbyten_force Perl_sv_pvbyten_force #undef Perl_sv_reftype #define Perl_sv_reftype pPerl->Perl_sv_reftype #undef sv_reftype @@ -3278,6 +3297,10 @@ #define Perl_wait4pid pPerl->Perl_wait4pid #undef wait4pid #define wait4pid Perl_wait4pid +#undef Perl_report_uninit +#define Perl_report_uninit pPerl->Perl_report_uninit +#undef report_uninit +#define report_uninit Perl_report_uninit #undef Perl_warn #define Perl_warn pPerl->Perl_warn #undef warn @@ -3330,22 +3353,6 @@ #define Perl_dump_mstats pPerl->Perl_dump_mstats #undef dump_mstats #define dump_mstats Perl_dump_mstats -#undef Perl_malloc -#define Perl_malloc pPerl->Perl_malloc -#undef malloc -#define malloc Perl_malloc -#undef Perl_calloc -#define Perl_calloc pPerl->Perl_calloc -#undef calloc -#define calloc Perl_calloc -#undef Perl_realloc -#define Perl_realloc pPerl->Perl_realloc -#undef realloc -#define realloc Perl_realloc -#undef Perl_mfree -#define Perl_mfree pPerl->Perl_mfree -#undef mfree -#define mfree Perl_mfree #endif #undef Perl_safesysmalloc #define Perl_safesysmalloc pPerl->Perl_safesysmalloc @@ -3519,10 +3526,26 @@ #define Perl_sv_2pv_nolen pPerl->Perl_sv_2pv_nolen #undef sv_2pv_nolen #define sv_2pv_nolen Perl_sv_2pv_nolen +#undef Perl_sv_2pvutf8_nolen +#define Perl_sv_2pvutf8_nolen pPerl->Perl_sv_2pvutf8_nolen +#undef sv_2pvutf8_nolen +#define sv_2pvutf8_nolen Perl_sv_2pvutf8_nolen +#undef Perl_sv_2pvbyte_nolen +#define Perl_sv_2pvbyte_nolen pPerl->Perl_sv_2pvbyte_nolen +#undef sv_2pvbyte_nolen +#define sv_2pvbyte_nolen Perl_sv_2pvbyte_nolen #undef Perl_sv_pv #define Perl_sv_pv pPerl->Perl_sv_pv #undef sv_pv #define sv_pv Perl_sv_pv +#undef Perl_sv_pvutf8 +#define Perl_sv_pvutf8 pPerl->Perl_sv_pvutf8 +#undef sv_pvutf8 +#define sv_pvutf8 Perl_sv_pvutf8 +#undef Perl_sv_pvbyte +#define Perl_sv_pvbyte pPerl->Perl_sv_pvbyte +#undef sv_pvbyte +#define sv_pvbyte Perl_sv_pvbyte #undef Perl_sv_force_normal #define Perl_sv_force_normal pPerl->Perl_sv_force_normal #undef sv_force_normal @@ -3559,7 +3582,76 @@ #define Perl_boot_core_xsutils pPerl->Perl_boot_core_xsutils #undef boot_core_xsutils #define boot_core_xsutils Perl_boot_core_xsutils +#if defined(USE_ITHREADS) +#undef Perl_cx_dup +#define Perl_cx_dup pPerl->Perl_cx_dup +#undef cx_dup +#define cx_dup Perl_cx_dup +#undef Perl_si_dup +#define Perl_si_dup pPerl->Perl_si_dup +#undef si_dup +#define si_dup Perl_si_dup +#undef Perl_ss_dup +#define Perl_ss_dup pPerl->Perl_ss_dup +#undef ss_dup +#define ss_dup Perl_ss_dup +#undef Perl_any_dup +#define Perl_any_dup pPerl->Perl_any_dup +#undef any_dup +#define any_dup Perl_any_dup +#undef Perl_he_dup +#define Perl_he_dup pPerl->Perl_he_dup +#undef he_dup +#define he_dup Perl_he_dup +#undef Perl_re_dup +#define Perl_re_dup pPerl->Perl_re_dup +#undef re_dup +#define re_dup Perl_re_dup +#undef Perl_fp_dup +#define Perl_fp_dup pPerl->Perl_fp_dup +#undef fp_dup +#define fp_dup Perl_fp_dup +#undef Perl_dirp_dup +#define Perl_dirp_dup pPerl->Perl_dirp_dup +#undef dirp_dup +#define dirp_dup Perl_dirp_dup +#undef Perl_gp_dup +#define Perl_gp_dup pPerl->Perl_gp_dup +#undef gp_dup +#define gp_dup Perl_gp_dup +#undef Perl_mg_dup +#define Perl_mg_dup pPerl->Perl_mg_dup +#undef mg_dup +#define mg_dup Perl_mg_dup +#undef Perl_sv_dup +#define Perl_sv_dup pPerl->Perl_sv_dup +#undef sv_dup +#define sv_dup Perl_sv_dup +#if defined(HAVE_INTERP_INTERN) +#undef Perl_sys_intern_dup +#define Perl_sys_intern_dup pPerl->Perl_sys_intern_dup +#undef sys_intern_dup +#define sys_intern_dup Perl_sys_intern_dup +#endif +#undef Perl_ptr_table_new +#define Perl_ptr_table_new pPerl->Perl_ptr_table_new +#undef ptr_table_new +#define ptr_table_new Perl_ptr_table_new +#undef Perl_ptr_table_fetch +#define Perl_ptr_table_fetch pPerl->Perl_ptr_table_fetch +#undef ptr_table_fetch +#define ptr_table_fetch Perl_ptr_table_fetch +#undef Perl_ptr_table_store +#define Perl_ptr_table_store pPerl->Perl_ptr_table_store +#undef ptr_table_store +#define ptr_table_store Perl_ptr_table_store +#undef Perl_ptr_table_split +#define Perl_ptr_table_split pPerl->Perl_ptr_table_split +#undef ptr_table_split +#define ptr_table_split Perl_ptr_table_split +#endif #if defined(PERL_OBJECT) +#else #endif #if defined(PERL_IN_AV_C) || defined(PERL_DECL_PROT) #endif @@ -3609,7 +3701,7 @@ #if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT) # if defined(CRIPPLED_CC) # endif -# if defined(WIN32) +# if defined(PERL_CR_FILTER) # endif #endif #if defined(PERL_IN_UNIVERSAL_C) || defined(PERL_DECL_PROT) @@ -3618,6 +3710,8 @@ # if defined(LEAKTEST) # endif #endif +#if defined(PERL_OBJECT) +#endif #undef Perl_ck_anoncode #define Perl_ck_anoncode pPerl->Perl_ck_anoncode #undef ck_anoncode diff --git a/op.c b/op.c index 8f8e796..4baf03b 100644 --- a/op.c +++ b/op.c @@ -21,7 +21,20 @@ #include "keywords.h" /* #define PL_OP_SLAB_ALLOC */ - + +/* XXXXXX testing */ +#ifdef USE_ITHREADS +# define OP_REFCNT_LOCK NOOP +# define OP_REFCNT_UNLOCK NOOP +# define OpREFCNT_set(o,n) ((o)->op_targ = (n)) +# define OpREFCNT_dec(o) (--(o)->op_targ) +#else +# define OP_REFCNT_LOCK NOOP +# define OP_REFCNT_UNLOCK NOOP +# define OpREFCNT_set(o,n) NOOP +# define OpREFCNT_dec(o) 0 +#endif + #ifdef PL_OP_SLAB_ALLOC #define SLAB_SIZE 8192 static char *PL_OpPtr = NULL; @@ -99,7 +112,7 @@ S_no_bareword_allowed(pTHX_ OP *o) { qerror(Perl_mess(aTHX_ "Bareword \"%s\" not allowed while \"strict subs\" in use", - SvPV_nolen(cSVOPo->op_sv))); + SvPV_nolen(cSVOPo_sv))); } /* "register" allocation */ @@ -146,11 +159,15 @@ Perl_pad_allocmy(pTHX_ char *name) && (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0) && strEQ(name, SvPVX(sv))) { - Perl_warner(aTHX_ WARN_UNSAFE, + if (PL_in_my != KEY_our + || GvSTASH(sv) == (PL_curstash ? PL_curstash : PL_defstash)) + { + Perl_warner(aTHX_ WARN_UNSAFE, "\"%s\" variable %s masks earlier declaration in same %s", (PL_in_my == KEY_our ? "our" : "my"), name, (SvIVX(sv) == PAD_MAX ? "scope" : "statement")); + } break; } } @@ -168,8 +185,11 @@ Perl_pad_allocmy(pTHX_ char *name) SvSTASH(sv) = (HV*)SvREFCNT_inc(PL_in_my_stash); PL_sv_objcount++; } - if (PL_in_my == KEY_our) + if (PL_in_my == KEY_our) { + (void)SvUPGRADE(sv, SVt_PVGV); + GvSTASH(sv) = (HV*)SvREFCNT_inc(PL_curstash ? PL_curstash : PL_defstash); SvFLAGS(sv) |= SVpad_OUR; + } av_store(PL_comppad_name, off, sv); SvNVX(sv) = (NV)PAD_MAX; SvIVX(sv) = 0; /* Not yet introduced--see newSTATEOP */ @@ -237,8 +257,11 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv, SvNVX(namesv) = (NV)PL_curcop->cop_seq; SvIVX(namesv) = PAD_MAX; /* A ref, intro immediately */ SvFAKE_on(namesv); /* A ref, not a real var */ - if (SvFLAGS(sv) & SVpad_OUR)/* An "our" variable */ + if (SvFLAGS(sv) & SVpad_OUR) { /* An "our" variable */ SvFLAGS(namesv) |= SVpad_OUR; + (void)SvUPGRADE(namesv, SVt_PVGV); + GvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*)GvSTASH(sv)); + } if (SvOBJECT(sv)) { /* A typed var */ SvOBJECT_on(namesv); (void)SvUPGRADE(namesv, SVt_PVMG); @@ -313,6 +336,7 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv, return 0; } break; + case CXt_FORMAT: case CXt_SUB: if (!saweval) return 0; @@ -442,7 +466,7 @@ Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype) (sv = names[PL_padix]) && sv != &PL_sv_undef) continue; sv = *av_fetch(PL_comppad, PL_padix, TRUE); - if (!(SvFLAGS(sv) & (SVs_PADTMP|SVs_PADMY))) + if (!(SvFLAGS(sv) & (SVs_PADTMP|SVs_PADMY)) && !IS_PADGV(sv)) break; } retval = PL_padix; @@ -450,12 +474,14 @@ Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype) SvFLAGS(sv) |= tmptype; PL_curpad = AvARRAY(PL_comppad); #ifdef USE_THREADS - DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx alloc %ld for %s\n", - (unsigned long) thr, (unsigned long) PL_curpad, + DEBUG_X(PerlIO_printf(Perl_debug_log, + "0x%"UVxf" Pad 0x%"UVxf" alloc %ld for %s\n", + PTR2UV(thr), PTR2UV(PL_curpad), (long) retval, PL_op_name[optype])); #else - DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx alloc %ld for %s\n", - (unsigned long) PL_curpad, + DEBUG_X(PerlIO_printf(Perl_debug_log, + "Pad 0x%"UVxf" alloc %ld for %s\n", + PTR2UV(PL_curpad), (long) retval, PL_op_name[optype])); #endif /* USE_THREADS */ return (PADOFFSET)retval; @@ -466,13 +492,14 @@ Perl_pad_sv(pTHX_ PADOFFSET po) { dTHR; #ifdef USE_THREADS - DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx sv %d\n", - (unsigned long) thr, (unsigned long) PL_curpad, po)); + DEBUG_X(PerlIO_printf(Perl_debug_log, + "0x%"UVxf" Pad 0x%"UVxf" sv %"IVdf"\n", + PTR2UV(thr), PTR2UV(PL_curpad), (IV)po)); #else if (!po) Perl_croak(aTHX_ "panic: pad_sv po"); - DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx sv %d\n", - (unsigned long) PL_curpad, po)); + DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" sv %"IVdf"\n", + PTR2UV(PL_curpad), (IV)po)); #endif /* USE_THREADS */ return PL_curpad[po]; /* eventually we'll turn this into a macro */ } @@ -488,14 +515,19 @@ Perl_pad_free(pTHX_ PADOFFSET po) if (!po) Perl_croak(aTHX_ "panic: pad_free po"); #ifdef USE_THREADS - DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx free %d\n", - (unsigned long) thr, (unsigned long) PL_curpad, po)); + DEBUG_X(PerlIO_printf(Perl_debug_log, + "0x%"UVxf" Pad 0x%"UVxf" free %"IVdf"\n", + PTR2UV(thr), PTR2UV(PL_curpad), (IV)po)); #else - DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx free %d\n", - (unsigned long) PL_curpad, po)); + DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" free %"IVdf"\n", + PTR2UV(PL_curpad), (IV)po)); #endif /* USE_THREADS */ - if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef) + if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef) { SvPADTMP_off(PL_curpad[po]); +#ifdef USE_ITHREADS + SvREADONLY_off(PL_curpad[po]); /* could be a freed constant */ +#endif + } if ((I32)po < PL_padix) PL_padix = po - 1; } @@ -509,11 +541,12 @@ Perl_pad_swipe(pTHX_ PADOFFSET po) if (!po) Perl_croak(aTHX_ "panic: pad_swipe po"); #ifdef USE_THREADS - DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx swipe %d\n", - (unsigned long) thr, (unsigned long) PL_curpad, po)); + DEBUG_X(PerlIO_printf(Perl_debug_log, + "0x%"UVxf" Pad 0x%"UVxf" swipe %"IVdf"\n", + PTR2UV(thr), PTR2UV(PL_curpad), (IV)po)); #else - DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx swipe %d\n", - (unsigned long) PL_curpad, po)); + DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" swipe %"IVdf"\n", + PTR2UV(PL_curpad), (IV)po)); #endif /* USE_THREADS */ SvPADTMP_off(PL_curpad[po]); PL_curpad[po] = NEWSV(1107,0); @@ -538,11 +571,12 @@ Perl_pad_reset(pTHX) if (AvARRAY(PL_comppad) != PL_curpad) Perl_croak(aTHX_ "panic: pad_reset curpad"); #ifdef USE_THREADS - DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx reset\n", - (unsigned long) thr, (unsigned long) PL_curpad)); + DEBUG_X(PerlIO_printf(Perl_debug_log, + "0x%"UVxf" Pad 0x%"UVxf" reset\n", + PTR2UV(thr), PTR2UV(PL_curpad))); #else - DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx reset\n", - (unsigned long) PL_curpad)); + DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" reset\n", + PTR2UV(PL_curpad))); #endif /* USE_THREADS */ if (!PL_tainting) { /* Can't mix tainted and non-tainted temporaries. */ for (po = AvMAX(PL_comppad); po > PL_padix_floor; po--) { @@ -614,7 +648,7 @@ Perl_find_threadsv(pTHX_ const char *name) default: sv_magic(sv, 0, 0, name, 1); } - DEBUG_S(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(Perl_error_log, "find_threadsv: new SV %p for $%s%c\n", sv, (*name < 32) ? "^" : "", (*name < 32) ? toCTRL(*name) : *name)); @@ -634,6 +668,26 @@ Perl_op_free(pTHX_ OP *o) if (!o || o->op_seq == (U16)-1) return; + if (o->op_private & OPpREFCOUNTED) { + switch (o->op_type) { + case OP_LEAVESUB: + case OP_LEAVESUBLV: + case OP_LEAVEEVAL: + case OP_LEAVE: + case OP_SCOPE: + case OP_LEAVEWRITE: + OP_REFCNT_LOCK; + if (OpREFCNT_dec(o)) { + OP_REFCNT_UNLOCK; + return; + } + OP_REFCNT_UNLOCK; + break; + default: + break; + } + } + if (o->op_flags & OPf_KIDS) { for (kid = cUNOPo->op_first; kid; kid = nextkid) { nextkid = kid->op_sibling; /* Get before next freeing kid */ @@ -685,8 +739,21 @@ S_op_clear(pTHX_ OP *o) case OP_GVSV: case OP_GV: case OP_AELEMFAST: - SvREFCNT_dec(cGVOPo->op_gv); - cGVOPo->op_gv = Nullgv; +#ifdef USE_ITHREADS + if (cPADOPo->op_padix > 0) { + if (PL_curpad) { + GV *gv = cGVOPo_gv; + pad_swipe(cPADOPo->op_padix); + /* No GvIN_PAD_off(gv) here, because other references may still + * exist on the pad */ + SvREFCNT_dec(gv); + } + cPADOPo->op_padix = 0; + } +#else + SvREFCNT_dec(cSVOPo->op_sv); + cSVOPo->op_sv = Nullsv; +#endif break; case OP_CONST: SvREFCNT_dec(cSVOPo->op_sv); @@ -711,25 +778,48 @@ S_op_clear(pTHX_ OP *o) break; case OP_SUBST: op_free(cPMOPo->op_pmreplroot); - cPMOPo->op_pmreplroot = Nullop; - /* FALL THROUGH */ + goto clear_pmop; case OP_PUSHRE: +#ifdef USE_ITHREADS + if ((PADOFFSET)cPMOPo->op_pmreplroot) { + if (PL_curpad) { + GV *gv = (GV*)PL_curpad[(PADOFFSET)cPMOPo->op_pmreplroot]; + pad_swipe((PADOFFSET)cPMOPo->op_pmreplroot); + /* No GvIN_PAD_off(gv) here, because other references may still + * exist on the pad */ + SvREFCNT_dec(gv); + } + } +#else + SvREFCNT_dec((SV*)cPMOPo->op_pmreplroot); +#endif + /* FALL THROUGH */ case OP_MATCH: case OP_QR: +clear_pmop: + cPMOPo->op_pmreplroot = Nullop; ReREFCNT_dec(cPMOPo->op_pmregexp); cPMOPo->op_pmregexp = (REGEXP*)NULL; break; } - if (o->op_targ > 0) + if (o->op_targ > 0) { pad_free(o->op_targ); + o->op_targ = 0; + } } STATIC void S_cop_free(pTHX_ COP* cop) { Safefree(cop->cop_label); - SvREFCNT_dec(cop->cop_filegv); +#ifdef USE_ITHREADS + Safefree(CopFILE(cop)); /* XXXXX share in a pvtable? */ + Safefree(CopSTASHPV(cop)); /* XXXXX share in a pvtable? */ +#else + /* NOTE: COP.cop_stash is not refcounted */ + SvREFCNT_dec(CopFILEGV(cop)); +#endif if (! specialWARN(cop->cop_warnings)) SvREFCNT_dec(cop->cop_warnings); } @@ -790,12 +880,12 @@ S_scalarboolean(pTHX_ OP *o) if (o->op_type == OP_SASSIGN && cBINOPo->op_first->op_type == OP_CONST) { dTHR; if (ckWARN(WARN_SYNTAX)) { - line_t oldline = PL_curcop->cop_line; + line_t oldline = CopLINE(PL_curcop); if (PL_copline != NOLINE) - PL_curcop->cop_line = PL_copline; + CopLINE_set(PL_curcop, PL_copline); Perl_warner(aTHX_ WARN_SYNTAX, "Found = in conditional, should be =="); - PL_curcop->cop_line = oldline; + CopLINE_set(PL_curcop, oldline); } } return scalar(o); @@ -809,12 +899,10 @@ Perl_scalar(pTHX_ OP *o) /* assumes no premature commitment */ if (!o || (o->op_flags & OPf_WANT) || PL_error_count || o->op_type == OP_RETURN) + { return o; + } - if ((o->op_private & OPpTARGET_MY) - && (PL_opargs[o->op_type] & OA_TARGLEX)) /* OPp share the meaning */ - return scalar(o); /* As if inside SASSIGN */ - o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_SCALAR; switch (o->op_type) { @@ -895,11 +983,15 @@ Perl_scalarvoid(pTHX_ OP *o) want = o->op_flags & OPf_WANT; if ((want && want != OPf_WANT_SCALAR) || PL_error_count || o->op_type == OP_RETURN) + { return o; + } if ((o->op_private & OPpTARGET_MY) - && (PL_opargs[o->op_type] & OA_TARGLEX)) /* OPp share the meaning */ + && (PL_opargs[o->op_type] & OA_TARGLEX))/* OPp share the meaning */ + { return scalar(o); /* As if inside SASSIGN */ + } o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_VOID; @@ -992,13 +1084,13 @@ Perl_scalarvoid(pTHX_ OP *o) case OP_RV2SV: case OP_RV2AV: case OP_RV2HV: - if (!(o->op_private & OPpLVAL_INTRO) && + if (!(o->op_private & (OPpLVAL_INTRO|OPpOUR_INTRO)) && (!o->op_sibling || o->op_sibling->op_type != OP_READLINE)) useless = "a variable"; break; case OP_CONST: - sv = cSVOPo->op_sv; + sv = cSVOPo_sv; if (cSVOPo->op_private & OPpCONST_STRICT) no_bareword_allowed(o); else { @@ -1097,11 +1189,15 @@ Perl_list(pTHX_ OP *o) /* assumes no premature commitment */ if (!o || (o->op_flags & OPf_WANT) || PL_error_count || o->op_type == OP_RETURN) + { return o; + } if ((o->op_private & OPpTARGET_MY) - && (PL_opargs[o->op_type] & OA_TARGLEX)) /* OPp share the meaning */ + && (PL_opargs[o->op_type] & OA_TARGLEX))/* OPp share the meaning */ + { return o; /* As if inside SASSIGN */ + } o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_LIST; @@ -1211,8 +1307,10 @@ Perl_mod(pTHX_ OP *o, I32 type) return o; if ((o->op_private & OPpTARGET_MY) - && (PL_opargs[o->op_type] & OA_TARGLEX)) /* OPp share the meaning */ + && (PL_opargs[o->op_type] & OA_TARGLEX))/* OPp share the meaning */ + { return o; + } switch (o->op_type) { case OP_UNDEF: @@ -1222,7 +1320,7 @@ Perl_mod(pTHX_ OP *o, I32 type) if (!(o->op_private & (OPpCONST_ARYBASE))) goto nomod; if (PL_eval_start && PL_eval_start->op_type == OP_CONST) { - PL_compiling.cop_arybase = (I32)SvIV(((SVOP*)PL_eval_start)->op_sv); + PL_compiling.cop_arybase = (I32)SvIV(cSVOPx(PL_eval_start)->op_sv); PL_eval_start = 0; } else if (!type) { @@ -1249,7 +1347,7 @@ Perl_mod(pTHX_ OP *o, I32 type) } else { /* lvalue subroutine call */ o->op_private |= OPpLVAL_INTRO; - if (type == OP_GREPSTART || type == OP_ENTERSUB) { + if (type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN) { /* Backward compatibility mode: */ o->op_private |= OPpENTERSUB_INARGS; break; @@ -1325,7 +1423,7 @@ Perl_mod(pTHX_ OP *o, I32 type) break; } - cv = GvCV(kGVOP->op_gv); + cv = GvCV(kGVOP_gv); if (!cv) goto restore_2cv; if (CvLVALUE(cv)) @@ -1742,6 +1840,7 @@ S_my_kid(pTHX_ OP *o, OP *attrs) } else if (type == OP_RV2SV || /* "our" declaration */ type == OP_RV2AV || type == OP_RV2HV) { /* XXX does this let anything illegal in? */ + o->op_private |= OPpOUR_INTRO; return o; } else if (type != OP_PADSV && type != OP_PADAV && @@ -1810,9 +1909,9 @@ Perl_bind_match(pTHX_ I32 type, OP *left, OP *right) char *desc = PL_op_desc[(right->op_type == OP_SUBST || right->op_type == OP_TRANS) ? right->op_type : OP_MATCH]; - char *sample = ((left->op_type == OP_RV2AV || - left->op_type == OP_PADAV) - ? "@array" : "%hash"); + const char *sample = ((left->op_type == OP_RV2AV || + left->op_type == OP_PADAV) + ? "@array" : "%hash"); Perl_warner(aTHX_ WARN_UNSAFE, "Applying %s to %s will act on scalar(%s)", desc, sample, sample); @@ -1861,10 +1960,8 @@ Perl_scope(pTHX_ OP *o) o->op_type = OP_SCOPE; o->op_ppaddr = PL_ppaddr[OP_SCOPE]; kid = ((LISTOP*)o)->op_first; - if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE){ - kid->op_type = OP_SETSTATE; - kid->op_ppaddr = PL_ppaddr[OP_SETSTATE]; - } + if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) + null(kid); } else o = newLISTOP(OP_SCOPE, 0, o, Nullop); @@ -1904,7 +2001,7 @@ Perl_block_start(pTHX_ int full) PL_pad_reset_pending = FALSE; SAVEHINTS(); PL_hints &= ~HINT_BLOCK_SCOPE; - SAVEPPTR(PL_compiling.cop_warnings); + SAVESPTR(PL_compiling.cop_warnings); if (! specialWARN(PL_compiling.cop_warnings)) { PL_compiling.cop_warnings = newSVsv(PL_compiling.cop_warnings) ; SAVEFREESV(PL_compiling.cop_warnings) ; @@ -1953,6 +2050,8 @@ Perl_newPROG(pTHX_ OP *o) ((PL_in_eval & EVAL_KEEPERR) ? OPf_SPECIAL : 0), o); PL_eval_start = linklist(PL_eval_root); + PL_eval_root->op_private |= OPpREFCOUNTED; + OpREFCNT_set(PL_eval_root, 1); PL_eval_root->op_next = 0; peep(PL_eval_start); } @@ -1962,6 +2061,8 @@ Perl_newPROG(pTHX_ OP *o) PL_main_root = scope(sawparens(scalarvoid(o))); PL_curcop = &PL_compiling; PL_main_start = LINKLIST(PL_main_root); + PL_main_root->op_private |= OPpREFCOUNTED; + OpREFCNT_set(PL_main_root, 1); PL_main_root->op_next = 0; peep(PL_main_start); PL_compcv = 0; @@ -1972,7 +2073,7 @@ Perl_newPROG(pTHX_ OP *o) if (cv) { dSP; PUSHMARK(SP); - XPUSHs((SV*)PL_compiling.cop_filegv); + XPUSHs((SV*)CopFILEGV(&PL_compiling)); PUTBACK; call_sv((SV*)cv, G_DISCARD); } @@ -2114,8 +2215,12 @@ Perl_fold_constants(pTHX_ register OP *o) return o; if (!(PL_hints & HINT_INTEGER)) { - if (type == OP_DIVIDE || !(o->op_flags & OPf_KIDS)) + if (type == OP_MODULO + || type == OP_DIVIDE + || !(o->op_flags & OPf_KIDS)) + { return o; + } for (curop = ((UNOP*)o)->op_first; curop; curop = curop->op_sibling) { if (curop->op_type == OP_CONST) { @@ -2146,6 +2251,7 @@ Perl_gen_constant_list(pTHX_ register OP *o) PL_op = curop = LINKLIST(o); o->op_next = 0; + peep(curop); pp_pushmark(); CALLRUNOPS(aTHX); PL_op = curop; @@ -2752,8 +2858,8 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl) OP *curop; if (pm->op_pmflags & PMf_EVAL) { curop = 0; - if (PL_curcop->cop_line < PL_multi_end) - PL_curcop->cop_line = PL_multi_end; + if (CopLINE(PL_curcop) < PL_multi_end) + CopLINE_set(PL_curcop, PL_multi_end); } #ifdef USE_THREADS else if (repl->op_type == OP_THREADSV @@ -2777,7 +2883,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl) } #else if (curop->op_type == OP_GV) { - GV *gv = ((GVOP*)curop)->op_gv; + GV *gv = cGVOPx_gv(curop); repl_has_vars = 1; if (strchr("&`'123456789+", *GvENAME(gv))) break; @@ -2858,21 +2964,35 @@ Perl_newSVOP(pTHX_ I32 type, I32 flags, SV *sv) } OP * +Perl_newPADOP(pTHX_ I32 type, I32 flags, SV *sv) +{ + PADOP *padop; + NewOp(1101, padop, 1, PADOP); + padop->op_type = type; + padop->op_ppaddr = PL_ppaddr[type]; + padop->op_padix = pad_alloc(type, SVs_PADTMP); + SvREFCNT_dec(PL_curpad[padop->op_padix]); + PL_curpad[padop->op_padix] = sv; + SvPADTMP_on(sv); + padop->op_next = (OP*)padop; + padop->op_flags = flags; + if (PL_opargs[type] & OA_RETSCALAR) + scalar((OP*)padop); + if (PL_opargs[type] & OA_TARGET) + padop->op_targ = pad_alloc(type, SVs_PADTMP); + return CHECKOP(type, padop); +} + +OP * Perl_newGVOP(pTHX_ I32 type, I32 flags, GV *gv) { dTHR; - GVOP *gvop; - NewOp(1101, gvop, 1, GVOP); - gvop->op_type = type; - gvop->op_ppaddr = PL_ppaddr[type]; - gvop->op_gv = (GV*)SvREFCNT_inc(gv); - gvop->op_next = (OP*)gvop; - gvop->op_flags = flags; - if (PL_opargs[type] & OA_RETSCALAR) - scalar((OP*)gvop); - if (PL_opargs[type] & OA_TARGET) - gvop->op_targ = pad_alloc(type, SVs_PADTMP); - return CHECKOP(type, gvop); +#ifdef USE_ITHREADS + GvIN_PAD_on(gv); + return newPADOP(type, flags, SvREFCNT_inc(gv)); +#else + return newSVOP(type, flags, SvREFCNT_inc(gv)); +#endif } OP * @@ -3001,6 +3121,7 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg) newSTATEOP(0, Nullch, veop)), newSTATEOP(0, Nullch, imop) )); + PL_hints |= HINT_BLOCK_SCOPE; PL_copline = NOLINE; PL_expect = XSTATE; } @@ -3110,7 +3231,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right) for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) { if (PL_opargs[curop->op_type] & OA_DANGEROUS) { if (curop->op_type == OP_GV) { - GV *gv = ((GVOP*)curop)->op_gv; + GV *gv = cGVOPx_gv(curop); if (gv == PL_defgv || SvCUR(gv) == PL_generation) break; SvCUR(gv) = PL_generation; @@ -3162,7 +3283,13 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right) { tmpop = ((UNOP*)left)->op_first; if (tmpop->op_type == OP_GV && !pm->op_pmreplroot) { - pm->op_pmreplroot = (OP*)((GVOP*)tmpop)->op_gv; +#ifdef USE_ITHREADS + pm->op_pmreplroot = (OP*)cPADOPx(tmpop)->op_padix; + cPADOPx(tmpop)->op_padix = 0; /* steal it */ +#else + pm->op_pmreplroot = (OP*)cSVOPx(tmpop)->op_sv; + cSVOPx(tmpop)->op_sv = Nullsv; /* steal it */ +#endif pm->op_pmflags |= PMf_ONCE; tmpop = cUNOPo->op_first; /* to list (nulled) */ tmpop = ((UNOP*)tmpop)->op_first; /* to pushmark */ @@ -3215,7 +3342,7 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o) register COP *cop; NewOp(1101, cop, 1, COP); - if (PERLDB_LINE && PL_curcop->cop_line && PL_curstash != PL_debstash) { + if (PERLDB_LINE && CopLINE(PL_curcop) && PL_curstash != PL_debstash) { cop->op_type = OP_DBSTATE; cop->op_ppaddr = PL_ppaddr[ OP_DBSTATE ]; } @@ -3244,20 +3371,23 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o) if (PL_copline == NOLINE) - cop->cop_line = PL_curcop->cop_line; + CopLINE_set(cop, CopLINE(PL_curcop)); else { - cop->cop_line = PL_copline; + CopLINE_set(cop, PL_copline); PL_copline = NOLINE; } - cop->cop_filegv = (GV*)SvREFCNT_inc(PL_curcop->cop_filegv); - cop->cop_stash = PL_curstash; +#ifdef USE_ITHREADS + CopFILE_set(cop, CopFILE(PL_curcop)); /* XXXXX share in a pvtable? */ +#else + CopFILEGV_set(cop, (GV*)SvREFCNT_inc(CopFILEGV(PL_curcop))); +#endif + CopSTASH_set(cop, PL_curstash); if (PERLDB_LINE && PL_curstash != PL_debstash) { - SV **svp = av_fetch(GvAV(PL_curcop->cop_filegv),(I32)cop->cop_line, FALSE); + SV **svp = av_fetch(CopFILEAV(PL_curcop), (I32)CopLINE(cop), FALSE); if (svp && *svp != &PL_sv_undef && !SvIOK(*svp)) { (void)SvIOK_on(*svp); - SvIVX(*svp) = 1; - SvSTASH(*svp) = (HV*)cop; + SvIVX(*svp) = PTR2IV(cop); } } @@ -3352,25 +3482,31 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp) if (k2 && k2->op_type == OP_READLINE && (k2->op_flags & OPf_STACKED) && ((k1->op_flags & OPf_WANT) == OPf_WANT_SCALAR)) + { warnop = k2->op_type; + } break; case OP_SASSIGN: if (k1->op_type == OP_READDIR || k1->op_type == OP_GLOB + || (k1->op_type == OP_NULL && k1->op_targ == OP_GLOB) || k1->op_type == OP_EACH) - warnop = k1->op_type; + { + warnop = ((k1->op_type == OP_NULL) + ? k1->op_targ : k1->op_type); + } break; } if (warnop) { - line_t oldline = PL_curcop->cop_line; - PL_curcop->cop_line = PL_copline; + line_t oldline = CopLINE(PL_curcop); + CopLINE_set(PL_curcop, PL_copline); Perl_warner(aTHX_ WARN_UNSAFE, "Value of %s%s can be \"0\"; test with defined()", PL_op_desc[warnop], ((warnop == OP_READLINE || warnop == OP_GLOB) ? " construct" : "() operator")); - PL_curcop->cop_line = oldline; + CopLINE_set(PL_curcop, oldline); } } @@ -3531,6 +3667,7 @@ Perl_newLOOPOP(pTHX_ I32 flags, I32 debuggable, OP *expr, OP *block) case OP_SASSIGN: if (k1->op_type == OP_READDIR || k1->op_type == OP_GLOB + || (k1->op_type == OP_NULL && k1->op_targ == OP_NULL) || k1->op_type == OP_EACH) expr = newUNOP(OP_DEFINED, 0, expr); break; @@ -3584,6 +3721,7 @@ Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP * case OP_SASSIGN: if (k1->op_type == OP_READDIR || k1->op_type == OP_GLOB + || (k1->op_type == OP_NULL && k1->op_targ == OP_GLOB) || k1->op_type == OP_EACH) expr = newUNOP(OP_DEFINED, 0, expr); break; @@ -3664,11 +3802,13 @@ Perl_newFOROP(pTHX_ I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *blo } else if (sv->op_type == OP_PADSV) { /* private variable */ padoff = sv->op_targ; + sv->op_targ = 0; op_free(sv); sv = Nullop; } else if (sv->op_type == OP_THREADSV) { /* per-thread variable */ padoff = sv->op_targ; + sv->op_targ = 0; iterflags |= OPf_SPECIAL; op_free(sv); sv = Nullop; @@ -3786,7 +3926,7 @@ Perl_cv_undef(pTHX_ CV *cv) #endif /* USE_THREADS */ ENTER; - SAVESPTR(PL_curpad); + SAVEVPTR(PL_curpad); PL_curpad = 0; if (!CvCLONED(cv)) @@ -3823,10 +3963,10 @@ Perl_cv_undef(pTHX_ CV *cv) } } -#ifdef DEBUG_CLOSURES STATIC void -cv_dump(CV *cv) +S_cv_dump(pTHX_ CV *cv) { +#ifdef DEBUGGING CV *outside = CvOUTSIDE(cv); AV* padlist = CvPADLIST(cv); AV* pad_name; @@ -3835,13 +3975,14 @@ cv_dump(CV *cv) SV** ppad; I32 ix; - PerlIO_printf(Perl_debug_log, "\tCV=0x%lx (%s), OUTSIDE=0x%lx (%s)\n", - cv, + PerlIO_printf(Perl_debug_log, + "\tCV=0x%"UVxf" (%s), OUTSIDE=0x%"UVxf" (%s)\n", + PTR2UV(cv), (CvANON(cv) ? "ANON" : (cv == PL_main_cv) ? "MAIN" : CvUNIQUE(cv) ? "UNIQUE" : CvGV(cv) ? GvNAME(CvGV(cv)) : "UNDEFINED"), - outside, + PTR2UV(outside), (!outside ? "null" : CvANON(outside) ? "ANON" : (outside == PL_main_cv) ? "MAIN" @@ -3858,15 +3999,16 @@ cv_dump(CV *cv) for (ix = 1; ix <= AvFILLp(pad_name); ix++) { if (SvPOK(pname[ix])) - PerlIO_printf(Perl_debug_log, "\t%4d. 0x%lx (%s\"%s\" %ld-%ld)\n", - ix, ppad[ix], + PerlIO_printf(Perl_debug_log, + "\t%4d. 0x%"UVxf" (%s\"%s\" %"IVdf"-%"IVdf")\n", + ix, PTR2UV(ppad[ix]), SvFAKE(pname[ix]) ? "FAKE " : "", SvPVX(pname[ix]), - (long)I_32(SvNVX(pname[ix])), - (long)SvIVX(pname[ix])); + (IV)I_32(SvNVX(pname[ix])), + SvIVX(pname[ix])); } +#endif /* DEBUGGING */ } -#endif /* DEBUG_CLOSURES */ STATIC CV * S_cv_clone2(pTHX_ CV *proto, CV *outside) @@ -3887,7 +4029,7 @@ S_cv_clone2(pTHX_ CV *proto, CV *outside) assert(!CvUNIQUE(proto)); ENTER; - SAVESPTR(PL_curpad); + SAVEVPTR(PL_curpad); SAVESPTR(PL_comppad); SAVESPTR(PL_comppad_name); SAVESPTR(PL_compcv); @@ -3903,7 +4045,7 @@ S_cv_clone2(pTHX_ CV *proto, CV *outside) MUTEX_INIT(CvMUTEXP(cv)); CvOWNER(cv) = 0; #endif /* USE_THREADS */ - CvFILEGV(cv) = CvFILEGV(proto); + CvFILE(cv) = CvFILE(proto); CvGV(cv) = (GV*)SvREFCNT_inc(CvGV(proto)); CvSTASH(cv) = CvSTASH(proto); CvROOT(cv) = CvROOT(proto); @@ -3962,6 +4104,9 @@ S_cv_clone2(pTHX_ CV *proto, CV *outside) PL_curpad[ix] = sv; } } + else if (IS_PADGV(ppad[ix]) || IS_PADCONST(ppad[ix])) { + PL_curpad[ix] = SvREFCNT_inc(ppad[ix]); + } else { SV* sv = NEWSV(0,0); SvPADTMP_on(sv); @@ -4004,9 +4149,9 @@ CV * Perl_cv_clone(pTHX_ CV *proto) { CV *cv; - MUTEX_LOCK(&PL_cred_mutex); /* XXX create separate mutex */ + LOCK_CRED_MUTEX; /* XXX create separate mutex */ cv = cv_clone2(proto, CvOUTSIDE(proto)); - MUTEX_UNLOCK(&PL_cred_mutex); /* XXX create separate mutex */ + UNLOCK_CRED_MUTEX; /* XXX create separate mutex */ return cv; } @@ -4065,9 +4210,9 @@ Perl_op_const_sv(pTHX_ OP *o, CV *cv) break; if (sv) return Nullsv; - if (type == OP_CONST) + if (type == OP_CONST && cSVOPo->op_sv) sv = cSVOPo->op_sv; - else if (type == OP_PADSV && cv) { + else if ((type == OP_PADSV || type == OP_CONST) && cv) { AV* padav = (AV*)(AvARRAY(CvPADLIST(cv))[1]); sv = padav ? AvARRAY(padav)[o->op_targ] : Nullsv; if (!sv || (!SvREADONLY(sv) && SvREFCNT(sv) > 1)) @@ -4166,12 +4311,12 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) && HvNAME(GvSTASH(CvGV(cv))) && strEQ(HvNAME(GvSTASH(CvGV(cv))), "autouse"))) { - line_t oldline = PL_curcop->cop_line; - PL_curcop->cop_line = PL_copline; + line_t oldline = CopLINE(PL_curcop); + CopLINE_set(PL_curcop, PL_copline); Perl_warner(aTHX_ WARN_REDEFINE, const_sv ? "Constant subroutine %s redefined" : "Subroutine %s redefined", name); - PL_curcop->cop_line = oldline; + CopLINE_set(PL_curcop, oldline); } SvREFCNT_dec(cv); cv = Nullcv; @@ -4229,7 +4374,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) } } CvGV(cv) = (GV*)SvREFCNT_inc(gv); - CvFILEGV(cv) = PL_curcop->cop_filegv; + CvFILE(cv) = CopFILE(PL_curcop); CvSTASH(cv) = PL_curstash; #ifdef USE_THREADS CvOWNER(cv) = 0; @@ -4271,12 +4416,25 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) if (AvFILLp(PL_comppad_name) < AvFILLp(PL_comppad)) av_store(PL_comppad_name, AvFILLp(PL_comppad), Nullsv); + if (CvLVALUE(cv)) { + CvROOT(cv) = newUNOP(OP_LEAVESUBLV, 0, scalarseq(block)); + } + else { + CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block)); + } + CvROOT(cv)->op_private |= OPpREFCOUNTED; + OpREFCNT_set(CvROOT(cv), 1); + CvSTART(cv) = LINKLIST(CvROOT(cv)); + CvROOT(cv)->op_next = 0; + peep(CvSTART(cv)); + + /* now that optimizer has done its work, adjust pad values */ if (CvCLONE(cv)) { SV **namep = AvARRAY(PL_comppad_name); for (ix = AvFILLp(PL_comppad); ix > 0; ix--) { SV *namesv; - if (SvIMMORTAL(PL_curpad[ix])) + if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix])) continue; /* * The only things that a clonable function needs in its @@ -4300,23 +4458,13 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) AvFLAGS(av) = AVf_REIFY; for (ix = AvFILLp(PL_comppad); ix > 0; ix--) { - if (SvIMMORTAL(PL_curpad[ix])) + if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix])) continue; if (!SvPADMY(PL_curpad[ix])) SvPADTMP_on(PL_curpad[ix]); } } - if(CvLVALUE(cv)) { - CvROOT(cv) = newUNOP(OP_LEAVESUBLV, 0, scalarseq(block)); - } - else { - CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block)); - } - CvSTART(cv) = LINKLIST(CvROOT(cv)); - CvROOT(cv)->op_next = 0; - peep(CvSTART(cv)); - if (name) { char *s; @@ -4327,9 +4475,9 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) CV *cv; HV *hv; - Perl_sv_setpvf(aTHX_ sv, "%_:%ld-%ld", - GvSV(PL_curcop->cop_filegv), - (long)PL_subline, (long)PL_curcop->cop_line); + Perl_sv_setpvf(aTHX_ sv, "%s:%ld-%ld", + CopFILE(PL_curcop), + (long)PL_subline, (long)CopLINE(PL_curcop)); gv_efullname3(tmpstr, gv, Nullch); hv_store(GvHV(PL_DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0); hv = GvHVn(db_postponed); @@ -4347,18 +4495,22 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) s++; else s = name; + + if (*s != 'B' && *s != 'E' && *s != 'S' && *s != 'I') + goto done; + if (strEQ(s, "BEGIN")) { I32 oldscope = PL_scopestack_ix; ENTER; - SAVESPTR(PL_compiling.cop_filegv); - SAVEI16(PL_compiling.cop_line); + SAVECOPFILE(&PL_compiling); + SAVECOPLINE(&PL_compiling); save_svref(&PL_rs); sv_setsv(PL_rs, PL_nrs); if (!PL_beginav) PL_beginav = newAV(); DEBUG_x( dump_sub(gv) ); - av_push(PL_beginav, (SV *)cv); + av_push(PL_beginav, SvREFCNT_inc(cv)); GvCV(gv) = 0; call_list(oldscope, PL_beginav); @@ -4369,13 +4521,23 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block) else if (strEQ(s, "END") && !PL_error_count) { if (!PL_endav) PL_endav = newAV(); + DEBUG_x( dump_sub(gv) ); av_unshift(PL_endav, 1); - av_store(PL_endav, 0, (SV *)cv); + av_store(PL_endav, 0, SvREFCNT_inc(cv)); + GvCV(gv) = 0; + } + else if (strEQ(s, "STOP") && !PL_error_count) { + if (!PL_stopav) + PL_stopav = newAV(); + DEBUG_x( dump_sub(gv) ); + av_unshift(PL_stopav, 1); + av_store(PL_stopav, 0, SvREFCNT_inc(cv)); GvCV(gv) = 0; } else if (strEQ(s, "INIT") && !PL_error_count) { if (!PL_initav) PL_initav = newAV(); + DEBUG_x( dump_sub(gv) ); av_push(PL_initav, SvREFCNT_inc(cv)); GvCV(gv) = 0; } @@ -4392,15 +4554,24 @@ void Perl_newCONSTSUB(pTHX_ HV *stash, char *name, SV *sv) { dTHR; - U32 oldhints = PL_hints; - HV *old_cop_stash = PL_curcop->cop_stash; - HV *old_curstash = PL_curstash; - line_t oldline = PL_curcop->cop_line; - PL_curcop->cop_line = PL_copline; + ENTER; + SAVECOPLINE(PL_curcop); + SAVEHINTS(); + + CopLINE_set(PL_curcop, PL_copline); PL_hints &= ~HINT_BLOCK_SCOPE; - if(stash) - PL_curstash = PL_curcop->cop_stash = stash; + + if (stash) { + SAVESPTR(PL_curstash); + SAVECOPSTASH(PL_curcop); + PL_curstash = stash; +#ifdef USE_ITHREADS + CopSTASHPV(PL_curcop) = stash ? HvNAME(stash) : Nullch; +#else + CopSTASH(PL_curcop) = stash; +#endif + } newATTRSUB( start_subparse(FALSE, 0), @@ -4410,10 +4581,7 @@ Perl_newCONSTSUB(pTHX_ HV *stash, char *name, SV *sv) newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv)) ); - PL_hints = oldhints; - PL_curcop->cop_stash = old_cop_stash; - PL_curstash = old_curstash; - PL_curcop->cop_line = oldline; + LEAVE; } CV * @@ -4434,11 +4602,11 @@ Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename) if (ckWARN(WARN_REDEFINE) && !(CvGV(cv) && GvSTASH(CvGV(cv)) && HvNAME(GvSTASH(CvGV(cv))) && strEQ(HvNAME(GvSTASH(CvGV(cv))), "autouse"))) { - line_t oldline = PL_curcop->cop_line; + line_t oldline = CopLINE(PL_curcop); if (PL_copline != NOLINE) - PL_curcop->cop_line = PL_copline; + CopLINE_set(PL_curcop, PL_copline); Perl_warner(aTHX_ WARN_REDEFINE, "Subroutine %s redefined",name); - PL_curcop->cop_line = oldline; + CopLINE_set(PL_curcop, oldline); } SvREFCNT_dec(cv); cv = 0; @@ -4462,7 +4630,9 @@ Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename) MUTEX_INIT(CvMUTEXP(cv)); CvOWNER(cv) = 0; #endif /* USE_THREADS */ - CvFILEGV(cv) = gv_fetchfile(filename); + (void)gv_fetchfile(filename); + CvFILE(cv) = filename; /* NOTE: not copied, as it is expected to be + an external constant string */ CvXSUB(cv) = subaddr; if (name) { @@ -4471,29 +4641,41 @@ Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename) s++; else s = name; + + if (*s != 'B' && *s != 'E' && *s != 'S' && *s != 'I') + goto done; + if (strEQ(s, "BEGIN")) { if (!PL_beginav) PL_beginav = newAV(); - av_push(PL_beginav, (SV *)cv); + av_push(PL_beginav, SvREFCNT_inc(cv)); GvCV(gv) = 0; } else if (strEQ(s, "END")) { if (!PL_endav) PL_endav = newAV(); av_unshift(PL_endav, 1); - av_store(PL_endav, 0, (SV *)cv); + av_store(PL_endav, 0, SvREFCNT_inc(cv)); + GvCV(gv) = 0; + } + else if (strEQ(s, "STOP")) { + if (!PL_stopav) + PL_stopav = newAV(); + av_unshift(PL_stopav, 1); + av_store(PL_stopav, 0, SvREFCNT_inc(cv)); GvCV(gv) = 0; } else if (strEQ(s, "INIT")) { if (!PL_initav) PL_initav = newAV(); - av_push(PL_initav, (SV *)cv); + av_push(PL_initav, SvREFCNT_inc(cv)); GvCV(gv) = 0; } } else CvANON_on(cv); +done: return cv; } @@ -4515,18 +4697,18 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block) GvMULTI_on(gv); if (cv = GvFORM(gv)) { if (ckWARN(WARN_REDEFINE)) { - line_t oldline = PL_curcop->cop_line; + line_t oldline = CopLINE(PL_curcop); - PL_curcop->cop_line = PL_copline; + CopLINE_set(PL_curcop, PL_copline); Perl_warner(aTHX_ WARN_REDEFINE, "Format %s redefined",name); - PL_curcop->cop_line = oldline; + CopLINE_set(PL_curcop, oldline); } SvREFCNT_dec(cv); } cv = PL_compcv; GvFORM(gv) = cv; CvGV(cv) = (GV*)SvREFCNT_inc(gv); - CvFILEGV(cv) = PL_curcop->cop_filegv; + CvFILE(cv) = CopFILE(PL_curcop); for (ix = AvFILLp(PL_comppad); ix > 0; ix--) { if (!SvPADMY(PL_curpad[ix]) && !SvIMMORTAL(PL_curpad[ix])) @@ -4534,6 +4716,8 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block) } CvROOT(cv) = newUNOP(OP_LEAVEWRITE, 0, scalarseq(block)); + CvROOT(cv)->op_private |= OPpREFCOUNTED; + OpREFCNT_set(CvROOT(cv), 1); CvSTART(cv) = LINKLIST(CvROOT(cv)); CvROOT(cv)->op_next = 0; peep(CvSTART(cv)); @@ -4748,11 +4932,22 @@ Perl_ck_delete(pTHX_ OP *o) o->op_private = 0; if (o->op_flags & OPf_KIDS) { OP *kid = cUNOPo->op_first; - if (kid->op_type == OP_HSLICE) + switch (kid->op_type) { + case OP_ASLICE: + o->op_flags |= OPf_SPECIAL; + /* FALL THROUGH */ + case OP_HSLICE: o->op_private |= OPpSLICE; - else if (kid->op_type != OP_HELEM) - Perl_croak(aTHX_ "%s argument is not a HASH element or slice", + break; + case OP_AELEM: + o->op_flags |= OPf_SPECIAL; + /* FALL THROUGH */ + case OP_HELEM: + break; + default: + Perl_croak(aTHX_ "%s argument is not a HASH or ARRAY element or slice", PL_op_desc[o->op_type]); + } null(kid); } return o; @@ -4838,8 +5033,11 @@ Perl_ck_exists(pTHX_ OP *o) o = ck_fun(o); if (o->op_flags & OPf_KIDS) { OP *kid = cUNOPo->op_first; - if (kid->op_type != OP_HELEM) - Perl_croak(aTHX_ "%s argument is not a HASH element", PL_op_desc[o->op_type]); + if (kid->op_type == OP_AELEM) + o->op_flags |= OPf_SPECIAL; + else if (kid->op_type != OP_HELEM) + Perl_croak(aTHX_ "%s argument is not a HASH or ARRAY element", + PL_op_desc[o->op_type]); null(kid); } return o; @@ -4951,7 +5149,14 @@ Perl_ck_rvconst(pTHX_ register OP *o) if (gv) { kid->op_type = OP_GV; SvREFCNT_dec(kid->op_sv); +#ifdef USE_ITHREADS + /* XXX hack: dependence on sizeof(PADOP) <= sizeof(SVOP) */ + kPADOP->op_padix = pad_alloc(OP_GV, SVs_PADTMP); + GvIN_PAD_on(gv); + PL_curpad[kPADOP->op_padix] = SvREFCNT_inc(gv); +#else kid->op_sv = SvREFCNT_inc(gv); +#endif kid->op_ppaddr = PL_ppaddr[OP_GV]; } } @@ -4964,10 +5169,10 @@ Perl_ck_ftst(pTHX_ OP *o) dTHR; I32 type = o->op_type; - if (o->op_flags & OPf_REF) - return o; - - if (o->op_flags & OPf_KIDS && cUNOPo->op_first->op_type != OP_STUB) { + if (o->op_flags & OPf_REF) { + /* nothing */ + } + else if (o->op_flags & OPf_KIDS && cUNOPo->op_first->op_type != OP_STUB) { SVOP *kid = (SVOP*)cUNOPo->op_first; if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) { @@ -4975,17 +5180,24 @@ Perl_ck_ftst(pTHX_ OP *o) OP *newop = newGVOP(type, OPf_REF, gv_fetchpv(SvPVx(kid->op_sv, n_a), TRUE, SVt_PVIO)); op_free(o); - return newop; + o = newop; } } else { op_free(o); if (type == OP_FTTTY) - return newGVOP(type, OPf_REF, gv_fetchpv("main::STDIN", TRUE, + o = newGVOP(type, OPf_REF, gv_fetchpv("main::STDIN", TRUE, SVt_PVIO)); else - return newUNOP(type, 0, newDEFSVOP()); + o = newUNOP(type, 0, newDEFSVOP()); + } +#ifdef USE_LOCALE + if (type == OP_FTTEXT || type == OP_FTBINARY) { + o->op_private = 0; + if (PL_hints & HINT_LOCALE) + o->op_private |= OPpLOCALE; } +#endif return o; } @@ -5048,17 +5260,10 @@ Perl_ck_fun(pTHX_ OP *o) char *name = SvPVx(((SVOP*)kid)->op_sv, n_a); OP *newop = newAVREF(newGVOP(OP_GV, 0, gv_fetchpv(name, TRUE, SVt_PVAV) )); -#ifdef IV_IS_QUAD if (ckWARN(WARN_SYNTAX)) Perl_warner(aTHX_ WARN_SYNTAX, - "Array @%s missing the @ in argument %" PERL_PRId64 " of %s()", + "Array @%s missing the @ in argument %"IVdf" of %s()", name, (IV)numargs, PL_op_desc[type]); -#else - if (ckWARN(WARN_SYNTAX)) - Perl_warner(aTHX_ WARN_SYNTAX, - "Array @%s missing the @ in argument %ld of %s()", - name, (long)numargs, PL_op_desc[type]); -#endif op_free(kid); kid = newop; kid->op_sibling = sibl; @@ -5075,17 +5280,10 @@ Perl_ck_fun(pTHX_ OP *o) char *name = SvPVx(((SVOP*)kid)->op_sv, n_a); OP *newop = newHVREF(newGVOP(OP_GV, 0, gv_fetchpv(name, TRUE, SVt_PVHV) )); -#ifdef IV_IS_QUAD if (ckWARN(WARN_SYNTAX)) Perl_warner(aTHX_ WARN_SYNTAX, - "Hash %%%s missing the %% in argument %" PERL_PRId64 " of %s()", + "Hash %%%s missing the %% in argument %"IVdf" of %s()", name, (IV)numargs, PL_op_desc[type]); -#else - if (ckWARN(WARN_SYNTAX)) - Perl_warner(aTHX_ WARN_SYNTAX, - "Hash %%%s missing the %% in argument %ld of %s()", - name, (long)numargs, PL_op_desc[type]); -#endif op_free(kid); kid = newop; kid->op_sibling = sibl; @@ -5124,26 +5322,46 @@ Perl_ck_fun(pTHX_ OP *o) else { I32 flags = OPf_SPECIAL; I32 priv = 0; + PADOFFSET targ = 0; + /* is this op a FH constructor? */ if (is_handle_constructor(o,numargs)) { - flags = 0; - /* Set a flag to tell rv2gv to vivify + char *name = Nullch; + STRLEN len; + + flags = 0; + /* Set a flag to tell rv2gv to vivify * need to "prove" flag does not mean something * else already - NI-S 1999/05/07 - */ - priv = OPpDEREF; -#if 0 - /* Helps with open($array[$n],...) - but is too simplistic - need to do selectively - */ - mod(kid,type); -#endif + */ + priv = OPpDEREF; + if (kid->op_type == OP_PADSV) { + SV **namep = av_fetch(PL_comppad_name, + kid->op_targ, 4); + if (namep && *namep) + name = SvPV(*namep, len); + } + else if (kid->op_type == OP_RV2SV + && kUNOP->op_first->op_type == OP_GV) + { + GV *gv = cGVOPx_gv(kUNOP->op_first); + name = GvNAME(gv); + len = GvNAMELEN(gv); + } + if (name) { + SV *namesv; + targ = pad_alloc(OP_RV2GV, SVs_PADTMP); + namesv = PL_curpad[targ]; + SvUPGRADE(namesv, SVt_PV); + if (*name != '$') + sv_setpvn(namesv, "$", 1); + sv_catpvn(namesv, name, len); + } } kid->op_sibling = 0; kid = newUNOP(OP_RV2GV, flags, scalar(kid)); - if (priv) { - kid->op_private |= priv; - } + kid->op_targ = targ; + kid->op_private |= priv; } kid->op_sibling = sibl; *tokid = kid; @@ -5188,6 +5406,19 @@ Perl_ck_glob(pTHX_ OP *o) if (!((gv = gv_fetchpv("glob", FALSE, SVt_PVCV)) && GvIMPORTED_CV(gv))) gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV); +#if !defined(PERL_EXTERNAL_GLOB) + /* XXX this can be tightened up and made more failsafe. */ + if (!gv) { + OP *modname = newSVOP(OP_CONST, 0, newSVpvn("File::Glob", 10)); + modname->op_private |= OPpCONST_BARE; + ENTER; + utilize(1, start_subparse(FALSE, 0), Nullop, modname, + newSVOP(OP_CONST, 0, newSVpvn(":globally", 9))); + gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV); + LEAVE; + } +#endif /* PERL_EXTERNAL_GLOB */ + if (gv && GvIMPORTED_CV(gv)) { append_elem(OP_GLOB, o, newSVOP(OP_CONST, 0, newSViv(PL_glob_index++))); @@ -5392,32 +5623,8 @@ Perl_ck_sassign(pTHX_ OP *o) if (kkid && kkid->op_type == OP_PADSV && !(kkid->op_private & OPpLVAL_INTRO)) { - /* Concat has problems if target is equal to right arg. */ - if (kid->op_type == OP_CONCAT) { - if (kLISTOP->op_first->op_sibling->op_type == OP_PADSV - && kLISTOP->op_first->op_sibling->op_targ == kkid->op_targ) - return o; - } - else if (kid->op_type == OP_JOIN) { - /* do_join has problems if the arguments coincide with target. - In fact the second argument *can* safely coincide, - but ignore=pessimize this rare occasion. */ - OP *arg = kLISTOP->op_first->op_sibling; /* Skip PUSHMARK */ - - while (arg) { - if (arg->op_type == OP_PADSV - && arg->op_targ == kkid->op_targ) - return o; - arg = arg->op_sibling; - } - } - else if (kid->op_type == OP_QUOTEMETA) { - /* quotemeta has problems if the argument coincides with target. */ - if (kLISTOP->op_first->op_type == OP_PADSV - && kLISTOP->op_first->op_targ == kkid->op_targ) - return o; - } kid->op_targ = kkid->op_targ; + kkid->op_targ = 0; /* Now we do not need PADSV and SASSIGN. */ kid->op_sibling = o->op_sibling; /* NULL */ cLISTOPo->op_first = NULL; @@ -5626,6 +5833,7 @@ S_simplify_sort(pTHX_ OP *o) register OP *kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */ OP *k; int reversed; + GV *gv; if (!(o->op_flags & OPf_STACKED)) return; GvMULTI_on(gv_fetchpv("a", TRUE, SVt_PV)); @@ -5649,11 +5857,12 @@ S_simplify_sort(pTHX_ OP *o) if (kUNOP->op_first->op_type != OP_GV) return; kid = kUNOP->op_first; /* get past rv2sv */ - if (GvSTASH(kGVOP->op_gv) != PL_curstash) + gv = kGVOP_gv; + if (GvSTASH(gv) != PL_curstash) return; - if (strEQ(GvNAME(kGVOP->op_gv), "a")) + if (strEQ(GvNAME(gv), "a")) reversed = 0; - else if(strEQ(GvNAME(kGVOP->op_gv), "b")) + else if(strEQ(GvNAME(gv), "b")) reversed = 1; else return; @@ -5664,10 +5873,11 @@ S_simplify_sort(pTHX_ OP *o) if (kUNOP->op_first->op_type != OP_GV) return; kid = kUNOP->op_first; /* get past rv2sv */ - if (GvSTASH(kGVOP->op_gv) != PL_curstash + gv = kGVOP_gv; + if (GvSTASH(gv) != PL_curstash || ( reversed - ? strNE(GvNAME(kGVOP->op_gv), "a") - : strNE(GvNAME(kGVOP->op_gv), "b"))) + ? strNE(GvNAME(gv), "a") + : strNE(GvNAME(gv), "b"))) return; o->op_flags &= ~(OPf_STACKED | OPf_SPECIAL); if (reversed) @@ -5773,11 +5983,12 @@ Perl_ck_subr(pTHX_ OP *o) null(cvop); /* disable rv2cv */ tmpop = (SVOP*)((UNOP*)cvop)->op_first; if (tmpop->op_type == OP_GV && !(o->op_private & OPpENTERSUB_AMPER)) { - cv = GvCVu(tmpop->op_sv); + GV *gv = cGVOPx_gv(tmpop); + cv = GvCVu(gv); if (!cv) tmpop->op_private |= OPpEARLY_CV; else if (SvPOK(cv)) { - namegv = CvANON(cv) ? (GV*)tmpop->op_sv : CvGV(cv); + namegv = CvANON(cv) ? gv : CvGV(cv); proto = SvPV((SV*)cv, n_a); } } @@ -5840,7 +6051,7 @@ Perl_ck_subr(pTHX_ OP *o) (gvop = ((UNOP*)gvop)->op_first) && gvop->op_type == OP_GV) { - GV *gv = (GV*)((SVOP*)gvop)->op_sv; + GV *gv = cGVOPx_gv(gvop); OP *sibling = o2->op_sibling; SV *n = newSVpvn("",0); op_free(o2); @@ -5958,7 +6169,7 @@ Perl_peep(pTHX_ register OP *o) return; ENTER; SAVEOP(); - SAVESPTR(PL_curcop); + SAVEVPTR(PL_curcop); for (; o; o = o->op_next) { if (o->op_seq) break; @@ -5977,32 +6188,34 @@ Perl_peep(pTHX_ register OP *o) case OP_CONST: if (cSVOPo->op_private & OPpCONST_STRICT) no_bareword_allowed(o); +#ifdef USE_ITHREADS + /* Relocate sv to the pad for thread safety. + * Despite being a "constant", the SV is written to, + * for reference counts, sv_upgrade() etc. */ + if (cSVOP->op_sv) { + PADOFFSET ix = pad_alloc(OP_CONST, SVs_PADTMP); + SvREFCNT_dec(PL_curpad[ix]); + SvPADTMP_on(cSVOPo->op_sv); + PL_curpad[ix] = cSVOPo->op_sv; + cSVOPo->op_sv = Nullsv; + o->op_targ = ix; + } +#endif /* FALL THROUGH */ case OP_UC: case OP_UCFIRST: case OP_LC: case OP_LCFIRST: - if ( o->op_next && o->op_next->op_type == OP_STRINGIFY - && !(o->op_next->op_private & OPpTARGET_MY) ) - null(o->op_next); - o->op_seq = PL_op_seqmax++; - break; case OP_CONCAT: case OP_JOIN: case OP_QUOTEMETA: if (o->op_next && o->op_next->op_type == OP_STRINGIFY) { if (o->op_next->op_private & OPpTARGET_MY) { - if ((o->op_flags & OPf_STACKED) /* chained concats */ - || (o->op_type == OP_CONCAT - /* Concat has problems if target is equal to right arg. */ - && (((LISTOP*)o)->op_first->op_sibling->op_type - == OP_PADSV) - && (((LISTOP*)o)->op_first->op_sibling->op_targ - == o->op_next->op_targ))) { + if (o->op_flags & OPf_STACKED) /* chained concats */ goto ignore_optimization; - } else { o->op_targ = o->op_next->op_targ; + o->op_next->op_targ = 0; o->op_private |= OPpTARGET_MY; } } @@ -6058,6 +6271,7 @@ Perl_peep(pTHX_ register OP *o) <= 255 && i >= 0) { + GV *gv; null(o->op_next); null(pop->op_next); null(pop); @@ -6066,11 +6280,12 @@ Perl_peep(pTHX_ register OP *o) o->op_type = OP_AELEMFAST; o->op_ppaddr = PL_ppaddr[OP_AELEMFAST]; o->op_private = (U8)i; - GvAVn(((GVOP*)o)->op_gv); + gv = cGVOPo_gv; + GvAVn(gv); } } else if ((o->op_private & OPpEARLY_CV) && ckWARN(WARN_UNSAFE)) { - GV *gv = cGVOPo->op_gv; + GV *gv = cGVOPo_gv; if (SvTYPE(gv) == SVt_PVGV && GvCV(gv) && SvPVX(GvCV(gv))) { /* XXX could check prototype here instead of just carping */ SV *sv = sv_newmortal(); @@ -6120,12 +6335,12 @@ Perl_peep(pTHX_ register OP *o) o->op_next->op_sibling->op_type != OP_EXIT && o->op_next->op_sibling->op_type != OP_WARN && o->op_next->op_sibling->op_type != OP_DIE) { - line_t oldline = PL_curcop->cop_line; + line_t oldline = CopLINE(PL_curcop); - PL_curcop->cop_line = ((COP*)o->op_next)->cop_line; + CopLINE_set(PL_curcop, CopLINE((COP*)o->op_next)); Perl_warner(aTHX_ WARN_SYNTAX, "Statement unlikely to be reached"); Perl_warner(aTHX_ WARN_SYNTAX, "(Maybe you meant system() when you said exec()?)\n"); - PL_curcop->cop_line = oldline; + CopLINE_set(PL_curcop, oldline); } } break; @@ -6151,11 +6366,11 @@ Perl_peep(pTHX_ register OP *o) fields = (GV**)hv_fetch(SvSTASH(lexname), "FIELDS", 6, FALSE); if (!fields || !GvHV(*fields)) break; - svp = &((SVOP*)((BINOP*)o)->op_last)->op_sv; + svp = cSVOPx_svp(((BINOP*)o)->op_last); key = SvPV(*svp, keylen); indsvp = hv_fetch(GvHV(*fields), key, keylen, FALSE); if (!indsvp) { - Perl_croak(aTHX_ "No such field \"%s\" in variable %s of type %s", + Perl_croak(aTHX_ "No such pseudo-hash field \"%s\" in variable %s of type %s", key, SvPV(lexname, n_a), HvNAME(SvSTASH(lexname))); } ind = SvIV(*indsvp); @@ -6173,13 +6388,15 @@ Perl_peep(pTHX_ register OP *o) case OP_RV2AV: case OP_RV2HV: if (!(o->op_flags & OPf_WANT) - || o->op_flags & OPf_WANT == OPf_WANT_LIST) + || (o->op_flags & OPf_WANT) == OPf_WANT_LIST) + { last_composite = o; + } o->op_seq = PL_op_seqmax++; break; case OP_RETURN: - if (o->op_next->op_type != OP_LEAVESUBLV) { + if (o->op_next && o->op_next->op_type != OP_LEAVESUBLV) { o->op_seq = PL_op_seqmax++; break; } diff --git a/op.h b/op.h index c6938c9..c69d897 100644 --- a/op.h +++ b/op.h @@ -94,6 +94,9 @@ typedef U32 PADOFFSET; /* Private for lvalues */ #define OPpLVAL_INTRO 128 /* Lvalue must be localized or lvalue sub */ +/* Private for OP_LEAVE, OP_LEAVESUB, OP_LEAVESUBLV and OP_LEAVEWRITE */ +#define OPpREFCOUNTED 64 /* op_targ carries a refcount */ + /* Private for OP_AASSIGN */ #define OPpASSIGN_COMMON 64 /* Left & right have syms in common. */ @@ -133,7 +136,9 @@ typedef U32 PADOFFSET; #define OPpEARLY_CV 32 /* foo() called before sub foo was parsed */ /* OP_?ELEM only */ #define OPpLVAL_DEFER 16 /* Defer creation of array/hash elem */ - /* for OP_RV2?V, lower bits carry hints */ + /* OP_RV2?V only */ +#define OPpOUR_INTRO 16 /* Defer creation of array/hash elem */ + /* for OP_RV2?V, lower bits carry hints (currently only HINT_STRICT_REFS) */ /* Private for OPs with TARGLEX */ /* (lower bits may carry MAXARG) */ @@ -155,7 +160,8 @@ typedef U32 PADOFFSET; /* Private for OP_DELETE */ #define OPpSLICE 64 /* Operating on a list of keys */ -/* Private for OP_SORT, OP_PRTF, OP_SPRINTF, string cmp'n, and case changers */ +/* Private for OP_SORT, OP_PRTF, OP_SPRINTF, OP_FTTEXT, OP_FTBINARY, */ +/* string comparisons, and case changers. */ #define OPpLOCALE 64 /* Use locale */ /* Private for OP_SORT */ @@ -235,9 +241,9 @@ struct svop { SV * op_sv; }; -struct gvop { +struct padop { BASEOP - GV * op_gv; + PADOFFSET op_padix; }; struct pvop { @@ -255,39 +261,73 @@ struct loop { OP * op_lastop; }; -#define cUNOP ((UNOP*)PL_op) -#define cBINOP ((BINOP*)PL_op) -#define cLISTOP ((LISTOP*)PL_op) -#define cLOGOP ((LOGOP*)PL_op) -#define cPMOP ((PMOP*)PL_op) -#define cSVOP ((SVOP*)PL_op) -#define cGVOP ((GVOP*)PL_op) -#define cPVOP ((PVOP*)PL_op) -#define cCOP ((COP*)PL_op) -#define cLOOP ((LOOP*)PL_op) - -#define cUNOPo ((UNOP*)o) -#define cBINOPo ((BINOP*)o) -#define cLISTOPo ((LISTOP*)o) -#define cLOGOPo ((LOGOP*)o) -#define cPMOPo ((PMOP*)o) -#define cSVOPo ((SVOP*)o) -#define cGVOPo ((GVOP*)o) -#define cPVOPo ((PVOP*)o) -#define cCVOPo ((CVOP*)o) -#define cCOPo ((COP*)o) -#define cLOOPo ((LOOP*)o) - -#define kUNOP ((UNOP*)kid) -#define kBINOP ((BINOP*)kid) -#define kLISTOP ((LISTOP*)kid) -#define kLOGOP ((LOGOP*)kid) -#define kPMOP ((PMOP*)kid) -#define kSVOP ((SVOP*)kid) -#define kGVOP ((GVOP*)kid) -#define kPVOP ((PVOP*)kid) -#define kCOP ((COP*)kid) -#define kLOOP ((LOOP*)kid) +#define cUNOPx(o) ((UNOP*)o) +#define cBINOPx(o) ((BINOP*)o) +#define cLISTOPx(o) ((LISTOP*)o) +#define cLOGOPx(o) ((LOGOP*)o) +#define cPMOPx(o) ((PMOP*)o) +#define cSVOPx(o) ((SVOP*)o) +#define cPADOPx(o) ((PADOP*)o) +#define cPVOPx(o) ((PVOP*)o) +#define cCOPx(o) ((COP*)o) +#define cLOOPx(o) ((LOOP*)o) + +#define cUNOP cUNOPx(PL_op) +#define cBINOP cBINOPx(PL_op) +#define cLISTOP cLISTOPx(PL_op) +#define cLOGOP cLOGOPx(PL_op) +#define cPMOP cPMOPx(PL_op) +#define cSVOP cSVOPx(PL_op) +#define cPADOP cPADOPx(PL_op) +#define cPVOP cPVOPx(PL_op) +#define cCOP cCOPx(PL_op) +#define cLOOP cLOOPx(PL_op) + +#define cUNOPo cUNOPx(o) +#define cBINOPo cBINOPx(o) +#define cLISTOPo cLISTOPx(o) +#define cLOGOPo cLOGOPx(o) +#define cPMOPo cPMOPx(o) +#define cSVOPo cSVOPx(o) +#define cPADOPo cPADOPx(o) +#define cPVOPo cPVOPx(o) +#define cCOPo cCOPx(o) +#define cLOOPo cLOOPx(o) + +#define kUNOP cUNOPx(kid) +#define kBINOP cBINOPx(kid) +#define kLISTOP cLISTOPx(kid) +#define kLOGOP cLOGOPx(kid) +#define kPMOP cPMOPx(kid) +#define kSVOP cSVOPx(kid) +#define kPADOP cPADOPx(kid) +#define kPVOP cPVOPx(kid) +#define kCOP cCOPx(kid) +#define kLOOP cLOOPx(kid) + + +#ifdef USE_ITHREADS +# define cGVOPx_gv(o) ((GV*)PL_curpad[cPADOPx(o)->op_padix]) +# define IS_PADGV(v) (v && SvTYPE(v) == SVt_PVGV && GvIN_PAD(v)) +# define IS_PADCONST(v) (v && SvREADONLY(v)) +# define cSVOPx_sv(v) (cSVOPx(v)->op_sv \ + ? cSVOPx(v)->op_sv : PL_curpad[(v)->op_targ]) +# define cSVOPx_svp(v) (cSVOPx(v)->op_sv \ + ? &cSVOPx(v)->op_sv : &PL_curpad[(v)->op_targ]) +#else +# define cGVOPx_gv(o) ((GV*)cSVOPx(o)->op_sv) +# define IS_PADGV(v) FALSE +# define IS_PADCONST(v) FALSE +# define cSVOPx_sv(v) (cSVOPx(v)->op_sv) +# define cSVOPx_svp(v) (&cSVOPx(v)->op_sv) +#endif + +#define cGVOP_gv cGVOPx_gv(PL_op) +#define cGVOPo_gv cGVOPx_gv(o) +#define kGVOP_gv cGVOPx_gv(kid) +#define cSVOP_sv cSVOPx_sv(PL_op) +#define cSVOPo_sv cSVOPx_sv(o) +#define kSVOP_sv cSVOPx_sv(kid) #define Nullop Null(OP*) @@ -314,7 +354,7 @@ struct loop { #define OA_LISTOP (4 << OCSHIFT) #define OA_PMOP (5 << OCSHIFT) #define OA_SVOP (6 << OCSHIFT) -#define OA_GVOP (7 << OCSHIFT) +#define OA_PADOP (7 << OCSHIFT) #define OA_PVOP_OR_SVOP (8 << OCSHIFT) #define OA_LOOP (9 << OCSHIFT) #define OA_COP (10 << OCSHIFT) diff --git a/opcode.h b/opcode.h index ae4011f..9d9cd52 100644 --- a/opcode.h +++ b/opcode.h @@ -388,9 +388,9 @@ EXT char *PL_op_desc[] = { "private value", "push regexp", "ref-to-glob cast", - "scalar deref", + "scalar dereference", "array length", - "subroutine deref", + "subroutine dereference", "anonymous subroutine", "subroutine prototype", "reference constructor", @@ -736,357 +736,357 @@ START_EXTERN_C EXT OP * (CPERLscope(*PL_ppaddr)[])(pTHX); #else EXT OP * (CPERLscope(*PL_ppaddr)[])(pTHX) = { - Perl_pp_null, - Perl_pp_stub, - Perl_pp_scalar, - Perl_pp_pushmark, - Perl_pp_wantarray, - Perl_pp_const, - Perl_pp_gvsv, - Perl_pp_gv, - Perl_pp_gelem, - Perl_pp_padsv, - Perl_pp_padav, - Perl_pp_padhv, - Perl_pp_padany, - Perl_pp_pushre, - Perl_pp_rv2gv, - Perl_pp_rv2sv, - Perl_pp_av2arylen, - Perl_pp_rv2cv, - Perl_pp_anoncode, - Perl_pp_prototype, - Perl_pp_refgen, - Perl_pp_srefgen, - Perl_pp_ref, - Perl_pp_bless, - Perl_pp_backtick, - Perl_pp_glob, - Perl_pp_readline, - Perl_pp_rcatline, - Perl_pp_regcmaybe, - Perl_pp_regcreset, - Perl_pp_regcomp, - Perl_pp_match, - Perl_pp_qr, - Perl_pp_subst, - Perl_pp_substcont, - Perl_pp_trans, - Perl_pp_sassign, - Perl_pp_aassign, - Perl_pp_chop, - Perl_pp_schop, - Perl_pp_chomp, - Perl_pp_schomp, - Perl_pp_defined, - Perl_pp_undef, - Perl_pp_study, - Perl_pp_pos, - Perl_pp_preinc, - Perl_pp_i_preinc, - Perl_pp_predec, - Perl_pp_i_predec, - Perl_pp_postinc, - Perl_pp_i_postinc, - Perl_pp_postdec, - Perl_pp_i_postdec, - Perl_pp_pow, - Perl_pp_multiply, - Perl_pp_i_multiply, - Perl_pp_divide, - Perl_pp_i_divide, - Perl_pp_modulo, - Perl_pp_i_modulo, - Perl_pp_repeat, - Perl_pp_add, - Perl_pp_i_add, - Perl_pp_subtract, - Perl_pp_i_subtract, - Perl_pp_concat, - Perl_pp_stringify, - Perl_pp_left_shift, - Perl_pp_right_shift, - Perl_pp_lt, - Perl_pp_i_lt, - Perl_pp_gt, - Perl_pp_i_gt, - Perl_pp_le, - Perl_pp_i_le, - Perl_pp_ge, - Perl_pp_i_ge, - Perl_pp_eq, - Perl_pp_i_eq, - Perl_pp_ne, - Perl_pp_i_ne, - Perl_pp_ncmp, - Perl_pp_i_ncmp, - Perl_pp_slt, - Perl_pp_sgt, - Perl_pp_sle, - Perl_pp_sge, - Perl_pp_seq, - Perl_pp_sne, - Perl_pp_scmp, - Perl_pp_bit_and, - Perl_pp_bit_xor, - Perl_pp_bit_or, - Perl_pp_negate, - Perl_pp_i_negate, - Perl_pp_not, - Perl_pp_complement, - Perl_pp_atan2, - Perl_pp_sin, - Perl_pp_cos, - Perl_pp_rand, - Perl_pp_srand, - Perl_pp_exp, - Perl_pp_log, - Perl_pp_sqrt, - Perl_pp_int, - Perl_pp_hex, - Perl_pp_oct, - Perl_pp_abs, - Perl_pp_length, - Perl_pp_substr, - Perl_pp_vec, - Perl_pp_index, - Perl_pp_rindex, - Perl_pp_sprintf, - Perl_pp_formline, - Perl_pp_ord, - Perl_pp_chr, - Perl_pp_crypt, - Perl_pp_ucfirst, - Perl_pp_lcfirst, - Perl_pp_uc, - Perl_pp_lc, - Perl_pp_quotemeta, - Perl_pp_rv2av, - Perl_pp_aelemfast, - Perl_pp_aelem, - Perl_pp_aslice, - Perl_pp_each, - Perl_pp_values, - Perl_pp_keys, - Perl_pp_delete, - Perl_pp_exists, - Perl_pp_rv2hv, - Perl_pp_helem, - Perl_pp_hslice, - Perl_pp_unpack, - Perl_pp_pack, - Perl_pp_split, - Perl_pp_join, - Perl_pp_list, - Perl_pp_lslice, - Perl_pp_anonlist, - Perl_pp_anonhash, - Perl_pp_splice, - Perl_pp_push, - Perl_pp_pop, - Perl_pp_shift, - Perl_pp_unshift, - Perl_pp_sort, - Perl_pp_reverse, - Perl_pp_grepstart, - Perl_pp_grepwhile, - Perl_pp_mapstart, - Perl_pp_mapwhile, - Perl_pp_range, - Perl_pp_flip, - Perl_pp_flop, - Perl_pp_and, - Perl_pp_or, - Perl_pp_xor, - Perl_pp_cond_expr, - Perl_pp_andassign, - Perl_pp_orassign, - Perl_pp_method, - Perl_pp_entersub, - Perl_pp_leavesub, - Perl_pp_leavesublv, - Perl_pp_caller, - Perl_pp_warn, - Perl_pp_die, - Perl_pp_reset, - Perl_pp_lineseq, - Perl_pp_nextstate, - Perl_pp_dbstate, - Perl_pp_unstack, - Perl_pp_enter, - Perl_pp_leave, - Perl_pp_scope, - Perl_pp_enteriter, - Perl_pp_iter, - Perl_pp_enterloop, - Perl_pp_leaveloop, - Perl_pp_return, - Perl_pp_last, - Perl_pp_next, - Perl_pp_redo, - Perl_pp_dump, - Perl_pp_goto, - Perl_pp_exit, - Perl_pp_open, - Perl_pp_close, - Perl_pp_pipe_op, - Perl_pp_fileno, - Perl_pp_umask, - Perl_pp_binmode, - Perl_pp_tie, - Perl_pp_untie, - Perl_pp_tied, - Perl_pp_dbmopen, - Perl_pp_dbmclose, - Perl_pp_sselect, - Perl_pp_select, - Perl_pp_getc, - Perl_pp_read, - Perl_pp_enterwrite, - Perl_pp_leavewrite, - Perl_pp_prtf, - Perl_pp_print, - Perl_pp_sysopen, - Perl_pp_sysseek, - Perl_pp_sysread, - Perl_pp_syswrite, - Perl_pp_send, - Perl_pp_recv, - Perl_pp_eof, - Perl_pp_tell, - Perl_pp_seek, - Perl_pp_truncate, - Perl_pp_fcntl, - Perl_pp_ioctl, - Perl_pp_flock, - Perl_pp_socket, - Perl_pp_sockpair, - Perl_pp_bind, - Perl_pp_connect, - Perl_pp_listen, - Perl_pp_accept, - Perl_pp_shutdown, - Perl_pp_gsockopt, - Perl_pp_ssockopt, - Perl_pp_getsockname, - Perl_pp_getpeername, - Perl_pp_lstat, - Perl_pp_stat, - Perl_pp_ftrread, - Perl_pp_ftrwrite, - Perl_pp_ftrexec, - Perl_pp_fteread, - Perl_pp_ftewrite, - Perl_pp_fteexec, - Perl_pp_ftis, - Perl_pp_fteowned, - Perl_pp_ftrowned, - Perl_pp_ftzero, - Perl_pp_ftsize, - Perl_pp_ftmtime, - Perl_pp_ftatime, - Perl_pp_ftctime, - Perl_pp_ftsock, - Perl_pp_ftchr, - Perl_pp_ftblk, - Perl_pp_ftfile, - Perl_pp_ftdir, - Perl_pp_ftpipe, - Perl_pp_ftlink, - Perl_pp_ftsuid, - Perl_pp_ftsgid, - Perl_pp_ftsvtx, - Perl_pp_fttty, - Perl_pp_fttext, - Perl_pp_ftbinary, - Perl_pp_chdir, - Perl_pp_chown, - Perl_pp_chroot, - Perl_pp_unlink, - Perl_pp_chmod, - Perl_pp_utime, - Perl_pp_rename, - Perl_pp_link, - Perl_pp_symlink, - Perl_pp_readlink, - Perl_pp_mkdir, - Perl_pp_rmdir, - Perl_pp_open_dir, - Perl_pp_readdir, - Perl_pp_telldir, - Perl_pp_seekdir, - Perl_pp_rewinddir, - Perl_pp_closedir, - Perl_pp_fork, - Perl_pp_wait, - Perl_pp_waitpid, - Perl_pp_system, - Perl_pp_exec, - Perl_pp_kill, - Perl_pp_getppid, - Perl_pp_getpgrp, - Perl_pp_setpgrp, - Perl_pp_getpriority, - Perl_pp_setpriority, - Perl_pp_time, - Perl_pp_tms, - Perl_pp_localtime, - Perl_pp_gmtime, - Perl_pp_alarm, - Perl_pp_sleep, - Perl_pp_shmget, - Perl_pp_shmctl, - Perl_pp_shmread, - Perl_pp_shmwrite, - Perl_pp_msgget, - Perl_pp_msgctl, - Perl_pp_msgsnd, - Perl_pp_msgrcv, - Perl_pp_semget, - Perl_pp_semctl, - Perl_pp_semop, - Perl_pp_require, - Perl_pp_dofile, - Perl_pp_entereval, - Perl_pp_leaveeval, - Perl_pp_entertry, - Perl_pp_leavetry, - Perl_pp_ghbyname, - Perl_pp_ghbyaddr, - Perl_pp_ghostent, - Perl_pp_gnbyname, - Perl_pp_gnbyaddr, - Perl_pp_gnetent, - Perl_pp_gpbyname, - Perl_pp_gpbynumber, - Perl_pp_gprotoent, - Perl_pp_gsbyname, - Perl_pp_gsbyport, - Perl_pp_gservent, - Perl_pp_shostent, - Perl_pp_snetent, - Perl_pp_sprotoent, - Perl_pp_sservent, - Perl_pp_ehostent, - Perl_pp_enetent, - Perl_pp_eprotoent, - Perl_pp_eservent, - Perl_pp_gpwnam, - Perl_pp_gpwuid, - Perl_pp_gpwent, - Perl_pp_spwent, - Perl_pp_epwent, - Perl_pp_ggrnam, - Perl_pp_ggrgid, - Perl_pp_ggrent, - Perl_pp_sgrent, - Perl_pp_egrent, - Perl_pp_getlogin, - Perl_pp_syscall, - Perl_pp_lock, - Perl_pp_threadsv, - Perl_pp_setstate, - Perl_pp_method_named, + MEMBER_TO_FPTR(Perl_pp_null), + MEMBER_TO_FPTR(Perl_pp_stub), + MEMBER_TO_FPTR(Perl_pp_scalar), + MEMBER_TO_FPTR(Perl_pp_pushmark), + MEMBER_TO_FPTR(Perl_pp_wantarray), + MEMBER_TO_FPTR(Perl_pp_const), + MEMBER_TO_FPTR(Perl_pp_gvsv), + MEMBER_TO_FPTR(Perl_pp_gv), + MEMBER_TO_FPTR(Perl_pp_gelem), + MEMBER_TO_FPTR(Perl_pp_padsv), + MEMBER_TO_FPTR(Perl_pp_padav), + MEMBER_TO_FPTR(Perl_pp_padhv), + MEMBER_TO_FPTR(Perl_pp_padany), + MEMBER_TO_FPTR(Perl_pp_pushre), + MEMBER_TO_FPTR(Perl_pp_rv2gv), + MEMBER_TO_FPTR(Perl_pp_rv2sv), + MEMBER_TO_FPTR(Perl_pp_av2arylen), + MEMBER_TO_FPTR(Perl_pp_rv2cv), + MEMBER_TO_FPTR(Perl_pp_anoncode), + MEMBER_TO_FPTR(Perl_pp_prototype), + MEMBER_TO_FPTR(Perl_pp_refgen), + MEMBER_TO_FPTR(Perl_pp_srefgen), + MEMBER_TO_FPTR(Perl_pp_ref), + MEMBER_TO_FPTR(Perl_pp_bless), + MEMBER_TO_FPTR(Perl_pp_backtick), + MEMBER_TO_FPTR(Perl_pp_glob), + MEMBER_TO_FPTR(Perl_pp_readline), + MEMBER_TO_FPTR(Perl_pp_rcatline), + MEMBER_TO_FPTR(Perl_pp_regcmaybe), + MEMBER_TO_FPTR(Perl_pp_regcreset), + MEMBER_TO_FPTR(Perl_pp_regcomp), + MEMBER_TO_FPTR(Perl_pp_match), + MEMBER_TO_FPTR(Perl_pp_qr), + MEMBER_TO_FPTR(Perl_pp_subst), + MEMBER_TO_FPTR(Perl_pp_substcont), + MEMBER_TO_FPTR(Perl_pp_trans), + MEMBER_TO_FPTR(Perl_pp_sassign), + MEMBER_TO_FPTR(Perl_pp_aassign), + MEMBER_TO_FPTR(Perl_pp_chop), + MEMBER_TO_FPTR(Perl_pp_schop), + MEMBER_TO_FPTR(Perl_pp_chomp), + MEMBER_TO_FPTR(Perl_pp_schomp), + MEMBER_TO_FPTR(Perl_pp_defined), + MEMBER_TO_FPTR(Perl_pp_undef), + MEMBER_TO_FPTR(Perl_pp_study), + MEMBER_TO_FPTR(Perl_pp_pos), + MEMBER_TO_FPTR(Perl_pp_preinc), + MEMBER_TO_FPTR(Perl_pp_i_preinc), + MEMBER_TO_FPTR(Perl_pp_predec), + MEMBER_TO_FPTR(Perl_pp_i_predec), + MEMBER_TO_FPTR(Perl_pp_postinc), + MEMBER_TO_FPTR(Perl_pp_i_postinc), + MEMBER_TO_FPTR(Perl_pp_postdec), + MEMBER_TO_FPTR(Perl_pp_i_postdec), + MEMBER_TO_FPTR(Perl_pp_pow), + MEMBER_TO_FPTR(Perl_pp_multiply), + MEMBER_TO_FPTR(Perl_pp_i_multiply), + MEMBER_TO_FPTR(Perl_pp_divide), + MEMBER_TO_FPTR(Perl_pp_i_divide), + MEMBER_TO_FPTR(Perl_pp_modulo), + MEMBER_TO_FPTR(Perl_pp_i_modulo), + MEMBER_TO_FPTR(Perl_pp_repeat), + MEMBER_TO_FPTR(Perl_pp_add), + MEMBER_TO_FPTR(Perl_pp_i_add), + MEMBER_TO_FPTR(Perl_pp_subtract), + MEMBER_TO_FPTR(Perl_pp_i_subtract), + MEMBER_TO_FPTR(Perl_pp_concat), + MEMBER_TO_FPTR(Perl_pp_stringify), + MEMBER_TO_FPTR(Perl_pp_left_shift), + MEMBER_TO_FPTR(Perl_pp_right_shift), + MEMBER_TO_FPTR(Perl_pp_lt), + MEMBER_TO_FPTR(Perl_pp_i_lt), + MEMBER_TO_FPTR(Perl_pp_gt), + MEMBER_TO_FPTR(Perl_pp_i_gt), + MEMBER_TO_FPTR(Perl_pp_le), + MEMBER_TO_FPTR(Perl_pp_i_le), + MEMBER_TO_FPTR(Perl_pp_ge), + MEMBER_TO_FPTR(Perl_pp_i_ge), + MEMBER_TO_FPTR(Perl_pp_eq), + MEMBER_TO_FPTR(Perl_pp_i_eq), + MEMBER_TO_FPTR(Perl_pp_ne), + MEMBER_TO_FPTR(Perl_pp_i_ne), + MEMBER_TO_FPTR(Perl_pp_ncmp), + MEMBER_TO_FPTR(Perl_pp_i_ncmp), + MEMBER_TO_FPTR(Perl_pp_slt), + MEMBER_TO_FPTR(Perl_pp_sgt), + MEMBER_TO_FPTR(Perl_pp_sle), + MEMBER_TO_FPTR(Perl_pp_sge), + MEMBER_TO_FPTR(Perl_pp_seq), + MEMBER_TO_FPTR(Perl_pp_sne), + MEMBER_TO_FPTR(Perl_pp_scmp), + MEMBER_TO_FPTR(Perl_pp_bit_and), + MEMBER_TO_FPTR(Perl_pp_bit_xor), + MEMBER_TO_FPTR(Perl_pp_bit_or), + MEMBER_TO_FPTR(Perl_pp_negate), + MEMBER_TO_FPTR(Perl_pp_i_negate), + MEMBER_TO_FPTR(Perl_pp_not), + MEMBER_TO_FPTR(Perl_pp_complement), + MEMBER_TO_FPTR(Perl_pp_atan2), + MEMBER_TO_FPTR(Perl_pp_sin), + MEMBER_TO_FPTR(Perl_pp_cos), + MEMBER_TO_FPTR(Perl_pp_rand), + MEMBER_TO_FPTR(Perl_pp_srand), + MEMBER_TO_FPTR(Perl_pp_exp), + MEMBER_TO_FPTR(Perl_pp_log), + MEMBER_TO_FPTR(Perl_pp_sqrt), + MEMBER_TO_FPTR(Perl_pp_int), + MEMBER_TO_FPTR(Perl_pp_hex), + MEMBER_TO_FPTR(Perl_pp_oct), + MEMBER_TO_FPTR(Perl_pp_abs), + MEMBER_TO_FPTR(Perl_pp_length), + MEMBER_TO_FPTR(Perl_pp_substr), + MEMBER_TO_FPTR(Perl_pp_vec), + MEMBER_TO_FPTR(Perl_pp_index), + MEMBER_TO_FPTR(Perl_pp_rindex), + MEMBER_TO_FPTR(Perl_pp_sprintf), + MEMBER_TO_FPTR(Perl_pp_formline), + MEMBER_TO_FPTR(Perl_pp_ord), + MEMBER_TO_FPTR(Perl_pp_chr), + MEMBER_TO_FPTR(Perl_pp_crypt), + MEMBER_TO_FPTR(Perl_pp_ucfirst), + MEMBER_TO_FPTR(Perl_pp_lcfirst), + MEMBER_TO_FPTR(Perl_pp_uc), + MEMBER_TO_FPTR(Perl_pp_lc), + MEMBER_TO_FPTR(Perl_pp_quotemeta), + MEMBER_TO_FPTR(Perl_pp_rv2av), + MEMBER_TO_FPTR(Perl_pp_aelemfast), + MEMBER_TO_FPTR(Perl_pp_aelem), + MEMBER_TO_FPTR(Perl_pp_aslice), + MEMBER_TO_FPTR(Perl_pp_each), + MEMBER_TO_FPTR(Perl_pp_values), + MEMBER_TO_FPTR(Perl_pp_keys), + MEMBER_TO_FPTR(Perl_pp_delete), + MEMBER_TO_FPTR(Perl_pp_exists), + MEMBER_TO_FPTR(Perl_pp_rv2hv), + MEMBER_TO_FPTR(Perl_pp_helem), + MEMBER_TO_FPTR(Perl_pp_hslice), + MEMBER_TO_FPTR(Perl_pp_unpack), + MEMBER_TO_FPTR(Perl_pp_pack), + MEMBER_TO_FPTR(Perl_pp_split), + MEMBER_TO_FPTR(Perl_pp_join), + MEMBER_TO_FPTR(Perl_pp_list), + MEMBER_TO_FPTR(Perl_pp_lslice), + MEMBER_TO_FPTR(Perl_pp_anonlist), + MEMBER_TO_FPTR(Perl_pp_anonhash), + MEMBER_TO_FPTR(Perl_pp_splice), + MEMBER_TO_FPTR(Perl_pp_push), + MEMBER_TO_FPTR(Perl_pp_pop), + MEMBER_TO_FPTR(Perl_pp_shift), + MEMBER_TO_FPTR(Perl_pp_unshift), + MEMBER_TO_FPTR(Perl_pp_sort), + MEMBER_TO_FPTR(Perl_pp_reverse), + MEMBER_TO_FPTR(Perl_pp_grepstart), + MEMBER_TO_FPTR(Perl_pp_grepwhile), + MEMBER_TO_FPTR(Perl_pp_mapstart), + MEMBER_TO_FPTR(Perl_pp_mapwhile), + MEMBER_TO_FPTR(Perl_pp_range), + MEMBER_TO_FPTR(Perl_pp_flip), + MEMBER_TO_FPTR(Perl_pp_flop), + MEMBER_TO_FPTR(Perl_pp_and), + MEMBER_TO_FPTR(Perl_pp_or), + MEMBER_TO_FPTR(Perl_pp_xor), + MEMBER_TO_FPTR(Perl_pp_cond_expr), + MEMBER_TO_FPTR(Perl_pp_andassign), + MEMBER_TO_FPTR(Perl_pp_orassign), + MEMBER_TO_FPTR(Perl_pp_method), + MEMBER_TO_FPTR(Perl_pp_entersub), + MEMBER_TO_FPTR(Perl_pp_leavesub), + MEMBER_TO_FPTR(Perl_pp_leavesublv), + MEMBER_TO_FPTR(Perl_pp_caller), + MEMBER_TO_FPTR(Perl_pp_warn), + MEMBER_TO_FPTR(Perl_pp_die), + MEMBER_TO_FPTR(Perl_pp_reset), + MEMBER_TO_FPTR(Perl_pp_lineseq), + MEMBER_TO_FPTR(Perl_pp_nextstate), + MEMBER_TO_FPTR(Perl_pp_dbstate), + MEMBER_TO_FPTR(Perl_pp_unstack), + MEMBER_TO_FPTR(Perl_pp_enter), + MEMBER_TO_FPTR(Perl_pp_leave), + MEMBER_TO_FPTR(Perl_pp_scope), + MEMBER_TO_FPTR(Perl_pp_enteriter), + MEMBER_TO_FPTR(Perl_pp_iter), + MEMBER_TO_FPTR(Perl_pp_enterloop), + MEMBER_TO_FPTR(Perl_pp_leaveloop), + MEMBER_TO_FPTR(Perl_pp_return), + MEMBER_TO_FPTR(Perl_pp_last), + MEMBER_TO_FPTR(Perl_pp_next), + MEMBER_TO_FPTR(Perl_pp_redo), + MEMBER_TO_FPTR(Perl_pp_dump), + MEMBER_TO_FPTR(Perl_pp_goto), + MEMBER_TO_FPTR(Perl_pp_exit), + MEMBER_TO_FPTR(Perl_pp_open), + MEMBER_TO_FPTR(Perl_pp_close), + MEMBER_TO_FPTR(Perl_pp_pipe_op), + MEMBER_TO_FPTR(Perl_pp_fileno), + MEMBER_TO_FPTR(Perl_pp_umask), + MEMBER_TO_FPTR(Perl_pp_binmode), + MEMBER_TO_FPTR(Perl_pp_tie), + MEMBER_TO_FPTR(Perl_pp_untie), + MEMBER_TO_FPTR(Perl_pp_tied), + MEMBER_TO_FPTR(Perl_pp_dbmopen), + MEMBER_TO_FPTR(Perl_pp_dbmclose), + MEMBER_TO_FPTR(Perl_pp_sselect), + MEMBER_TO_FPTR(Perl_pp_select), + MEMBER_TO_FPTR(Perl_pp_getc), + MEMBER_TO_FPTR(Perl_pp_read), + MEMBER_TO_FPTR(Perl_pp_enterwrite), + MEMBER_TO_FPTR(Perl_pp_leavewrite), + MEMBER_TO_FPTR(Perl_pp_prtf), + MEMBER_TO_FPTR(Perl_pp_print), + MEMBER_TO_FPTR(Perl_pp_sysopen), + MEMBER_TO_FPTR(Perl_pp_sysseek), + MEMBER_TO_FPTR(Perl_pp_sysread), + MEMBER_TO_FPTR(Perl_pp_syswrite), + MEMBER_TO_FPTR(Perl_pp_send), + MEMBER_TO_FPTR(Perl_pp_recv), + MEMBER_TO_FPTR(Perl_pp_eof), + MEMBER_TO_FPTR(Perl_pp_tell), + MEMBER_TO_FPTR(Perl_pp_seek), + MEMBER_TO_FPTR(Perl_pp_truncate), + MEMBER_TO_FPTR(Perl_pp_fcntl), + MEMBER_TO_FPTR(Perl_pp_ioctl), + MEMBER_TO_FPTR(Perl_pp_flock), + MEMBER_TO_FPTR(Perl_pp_socket), + MEMBER_TO_FPTR(Perl_pp_sockpair), + MEMBER_TO_FPTR(Perl_pp_bind), + MEMBER_TO_FPTR(Perl_pp_connect), + MEMBER_TO_FPTR(Perl_pp_listen), + MEMBER_TO_FPTR(Perl_pp_accept), + MEMBER_TO_FPTR(Perl_pp_shutdown), + MEMBER_TO_FPTR(Perl_pp_gsockopt), + MEMBER_TO_FPTR(Perl_pp_ssockopt), + MEMBER_TO_FPTR(Perl_pp_getsockname), + MEMBER_TO_FPTR(Perl_pp_getpeername), + MEMBER_TO_FPTR(Perl_pp_lstat), + MEMBER_TO_FPTR(Perl_pp_stat), + MEMBER_TO_FPTR(Perl_pp_ftrread), + MEMBER_TO_FPTR(Perl_pp_ftrwrite), + MEMBER_TO_FPTR(Perl_pp_ftrexec), + MEMBER_TO_FPTR(Perl_pp_fteread), + MEMBER_TO_FPTR(Perl_pp_ftewrite), + MEMBER_TO_FPTR(Perl_pp_fteexec), + MEMBER_TO_FPTR(Perl_pp_ftis), + MEMBER_TO_FPTR(Perl_pp_fteowned), + MEMBER_TO_FPTR(Perl_pp_ftrowned), + MEMBER_TO_FPTR(Perl_pp_ftzero), + MEMBER_TO_FPTR(Perl_pp_ftsize), + MEMBER_TO_FPTR(Perl_pp_ftmtime), + MEMBER_TO_FPTR(Perl_pp_ftatime), + MEMBER_TO_FPTR(Perl_pp_ftctime), + MEMBER_TO_FPTR(Perl_pp_ftsock), + MEMBER_TO_FPTR(Perl_pp_ftchr), + MEMBER_TO_FPTR(Perl_pp_ftblk), + MEMBER_TO_FPTR(Perl_pp_ftfile), + MEMBER_TO_FPTR(Perl_pp_ftdir), + MEMBER_TO_FPTR(Perl_pp_ftpipe), + MEMBER_TO_FPTR(Perl_pp_ftlink), + MEMBER_TO_FPTR(Perl_pp_ftsuid), + MEMBER_TO_FPTR(Perl_pp_ftsgid), + MEMBER_TO_FPTR(Perl_pp_ftsvtx), + MEMBER_TO_FPTR(Perl_pp_fttty), + MEMBER_TO_FPTR(Perl_pp_fttext), + MEMBER_TO_FPTR(Perl_pp_ftbinary), + MEMBER_TO_FPTR(Perl_pp_chdir), + MEMBER_TO_FPTR(Perl_pp_chown), + MEMBER_TO_FPTR(Perl_pp_chroot), + MEMBER_TO_FPTR(Perl_pp_unlink), + MEMBER_TO_FPTR(Perl_pp_chmod), + MEMBER_TO_FPTR(Perl_pp_utime), + MEMBER_TO_FPTR(Perl_pp_rename), + MEMBER_TO_FPTR(Perl_pp_link), + MEMBER_TO_FPTR(Perl_pp_symlink), + MEMBER_TO_FPTR(Perl_pp_readlink), + MEMBER_TO_FPTR(Perl_pp_mkdir), + MEMBER_TO_FPTR(Perl_pp_rmdir), + MEMBER_TO_FPTR(Perl_pp_open_dir), + MEMBER_TO_FPTR(Perl_pp_readdir), + MEMBER_TO_FPTR(Perl_pp_telldir), + MEMBER_TO_FPTR(Perl_pp_seekdir), + MEMBER_TO_FPTR(Perl_pp_rewinddir), + MEMBER_TO_FPTR(Perl_pp_closedir), + MEMBER_TO_FPTR(Perl_pp_fork), + MEMBER_TO_FPTR(Perl_pp_wait), + MEMBER_TO_FPTR(Perl_pp_waitpid), + MEMBER_TO_FPTR(Perl_pp_system), + MEMBER_TO_FPTR(Perl_pp_exec), + MEMBER_TO_FPTR(Perl_pp_kill), + MEMBER_TO_FPTR(Perl_pp_getppid), + MEMBER_TO_FPTR(Perl_pp_getpgrp), + MEMBER_TO_FPTR(Perl_pp_setpgrp), + MEMBER_TO_FPTR(Perl_pp_getpriority), + MEMBER_TO_FPTR(Perl_pp_setpriority), + MEMBER_TO_FPTR(Perl_pp_time), + MEMBER_TO_FPTR(Perl_pp_tms), + MEMBER_TO_FPTR(Perl_pp_localtime), + MEMBER_TO_FPTR(Perl_pp_gmtime), + MEMBER_TO_FPTR(Perl_pp_alarm), + MEMBER_TO_FPTR(Perl_pp_sleep), + MEMBER_TO_FPTR(Perl_pp_shmget), + MEMBER_TO_FPTR(Perl_pp_shmctl), + MEMBER_TO_FPTR(Perl_pp_shmread), + MEMBER_TO_FPTR(Perl_pp_shmwrite), + MEMBER_TO_FPTR(Perl_pp_msgget), + MEMBER_TO_FPTR(Perl_pp_msgctl), + MEMBER_TO_FPTR(Perl_pp_msgsnd), + MEMBER_TO_FPTR(Perl_pp_msgrcv), + MEMBER_TO_FPTR(Perl_pp_semget), + MEMBER_TO_FPTR(Perl_pp_semctl), + MEMBER_TO_FPTR(Perl_pp_semop), + MEMBER_TO_FPTR(Perl_pp_require), + MEMBER_TO_FPTR(Perl_pp_dofile), + MEMBER_TO_FPTR(Perl_pp_entereval), + MEMBER_TO_FPTR(Perl_pp_leaveeval), + MEMBER_TO_FPTR(Perl_pp_entertry), + MEMBER_TO_FPTR(Perl_pp_leavetry), + MEMBER_TO_FPTR(Perl_pp_ghbyname), + MEMBER_TO_FPTR(Perl_pp_ghbyaddr), + MEMBER_TO_FPTR(Perl_pp_ghostent), + MEMBER_TO_FPTR(Perl_pp_gnbyname), + MEMBER_TO_FPTR(Perl_pp_gnbyaddr), + MEMBER_TO_FPTR(Perl_pp_gnetent), + MEMBER_TO_FPTR(Perl_pp_gpbyname), + MEMBER_TO_FPTR(Perl_pp_gpbynumber), + MEMBER_TO_FPTR(Perl_pp_gprotoent), + MEMBER_TO_FPTR(Perl_pp_gsbyname), + MEMBER_TO_FPTR(Perl_pp_gsbyport), + MEMBER_TO_FPTR(Perl_pp_gservent), + MEMBER_TO_FPTR(Perl_pp_shostent), + MEMBER_TO_FPTR(Perl_pp_snetent), + MEMBER_TO_FPTR(Perl_pp_sprotoent), + MEMBER_TO_FPTR(Perl_pp_sservent), + MEMBER_TO_FPTR(Perl_pp_ehostent), + MEMBER_TO_FPTR(Perl_pp_enetent), + MEMBER_TO_FPTR(Perl_pp_eprotoent), + MEMBER_TO_FPTR(Perl_pp_eservent), + MEMBER_TO_FPTR(Perl_pp_gpwnam), + MEMBER_TO_FPTR(Perl_pp_gpwuid), + MEMBER_TO_FPTR(Perl_pp_gpwent), + MEMBER_TO_FPTR(Perl_pp_spwent), + MEMBER_TO_FPTR(Perl_pp_epwent), + MEMBER_TO_FPTR(Perl_pp_ggrnam), + MEMBER_TO_FPTR(Perl_pp_ggrgid), + MEMBER_TO_FPTR(Perl_pp_ggrent), + MEMBER_TO_FPTR(Perl_pp_sgrent), + MEMBER_TO_FPTR(Perl_pp_egrent), + MEMBER_TO_FPTR(Perl_pp_getlogin), + MEMBER_TO_FPTR(Perl_pp_syscall), + MEMBER_TO_FPTR(Perl_pp_lock), + MEMBER_TO_FPTR(Perl_pp_threadsv), + MEMBER_TO_FPTR(Perl_pp_setstate), + MEMBER_TO_FPTR(Perl_pp_method_named), }; #endif @@ -1094,357 +1094,357 @@ EXT OP * (CPERLscope(*PL_ppaddr)[])(pTHX) = { EXT OP * (CPERLscope(*PL_check)[]) (pTHX_ OP *op); #else EXT OP * (CPERLscope(*PL_check)[]) (pTHX_ OP *op) = { - Perl_ck_null, /* null */ - Perl_ck_null, /* stub */ - Perl_ck_fun, /* scalar */ - Perl_ck_null, /* pushmark */ - Perl_ck_null, /* wantarray */ - Perl_ck_svconst,/* const */ - Perl_ck_null, /* gvsv */ - Perl_ck_null, /* gv */ - Perl_ck_null, /* gelem */ - Perl_ck_null, /* padsv */ - Perl_ck_null, /* padav */ - Perl_ck_null, /* padhv */ - Perl_ck_null, /* padany */ - Perl_ck_null, /* pushre */ - Perl_ck_rvconst,/* rv2gv */ - Perl_ck_rvconst,/* rv2sv */ - Perl_ck_null, /* av2arylen */ - Perl_ck_rvconst,/* rv2cv */ - Perl_ck_anoncode,/* anoncode */ - Perl_ck_null, /* prototype */ - Perl_ck_spair, /* refgen */ - Perl_ck_null, /* srefgen */ - Perl_ck_fun, /* ref */ - Perl_ck_fun, /* bless */ - Perl_ck_null, /* backtick */ - Perl_ck_glob, /* glob */ - Perl_ck_null, /* readline */ - Perl_ck_null, /* rcatline */ - Perl_ck_fun, /* regcmaybe */ - Perl_ck_fun, /* regcreset */ - Perl_ck_null, /* regcomp */ - Perl_ck_match, /* match */ - Perl_ck_match, /* qr */ - Perl_ck_null, /* subst */ - Perl_ck_null, /* substcont */ - Perl_ck_null, /* trans */ - Perl_ck_sassign,/* sassign */ - Perl_ck_null, /* aassign */ - Perl_ck_spair, /* chop */ - Perl_ck_null, /* schop */ - Perl_ck_spair, /* chomp */ - Perl_ck_null, /* schomp */ - Perl_ck_defined,/* defined */ - Perl_ck_lfun, /* undef */ - Perl_ck_fun, /* study */ - Perl_ck_lfun, /* pos */ - Perl_ck_lfun, /* preinc */ - Perl_ck_lfun, /* i_preinc */ - Perl_ck_lfun, /* predec */ - Perl_ck_lfun, /* i_predec */ - Perl_ck_lfun, /* postinc */ - Perl_ck_lfun, /* i_postinc */ - Perl_ck_lfun, /* postdec */ - Perl_ck_lfun, /* i_postdec */ - Perl_ck_null, /* pow */ - Perl_ck_null, /* multiply */ - Perl_ck_null, /* i_multiply */ - Perl_ck_null, /* divide */ - Perl_ck_null, /* i_divide */ - Perl_ck_null, /* modulo */ - Perl_ck_null, /* i_modulo */ - Perl_ck_repeat, /* repeat */ - Perl_ck_null, /* add */ - Perl_ck_null, /* i_add */ - Perl_ck_null, /* subtract */ - Perl_ck_null, /* i_subtract */ - Perl_ck_concat, /* concat */ - Perl_ck_fun, /* stringify */ - Perl_ck_bitop, /* left_shift */ - Perl_ck_bitop, /* right_shift */ - Perl_ck_null, /* lt */ - Perl_ck_null, /* i_lt */ - Perl_ck_null, /* gt */ - Perl_ck_null, /* i_gt */ - Perl_ck_null, /* le */ - Perl_ck_null, /* i_le */ - Perl_ck_null, /* ge */ - Perl_ck_null, /* i_ge */ - Perl_ck_null, /* eq */ - Perl_ck_null, /* i_eq */ - Perl_ck_null, /* ne */ - Perl_ck_null, /* i_ne */ - Perl_ck_null, /* ncmp */ - Perl_ck_null, /* i_ncmp */ - Perl_ck_scmp, /* slt */ - Perl_ck_scmp, /* sgt */ - Perl_ck_scmp, /* sle */ - Perl_ck_scmp, /* sge */ - Perl_ck_null, /* seq */ - Perl_ck_null, /* sne */ - Perl_ck_scmp, /* scmp */ - Perl_ck_bitop, /* bit_and */ - Perl_ck_bitop, /* bit_xor */ - Perl_ck_bitop, /* bit_or */ - Perl_ck_null, /* negate */ - Perl_ck_null, /* i_negate */ - Perl_ck_null, /* not */ - Perl_ck_bitop, /* complement */ - Perl_ck_fun, /* atan2 */ - Perl_ck_fun, /* sin */ - Perl_ck_fun, /* cos */ - Perl_ck_fun, /* rand */ - Perl_ck_fun, /* srand */ - Perl_ck_fun, /* exp */ - Perl_ck_fun, /* log */ - Perl_ck_fun, /* sqrt */ - Perl_ck_fun, /* int */ - Perl_ck_fun, /* hex */ - Perl_ck_fun, /* oct */ - Perl_ck_fun, /* abs */ - Perl_ck_lengthconst,/* length */ - Perl_ck_fun, /* substr */ - Perl_ck_fun, /* vec */ - Perl_ck_index, /* index */ - Perl_ck_index, /* rindex */ - Perl_ck_fun_locale,/* sprintf */ - Perl_ck_fun, /* formline */ - Perl_ck_fun, /* ord */ - Perl_ck_fun, /* chr */ - Perl_ck_fun, /* crypt */ - Perl_ck_fun_locale,/* ucfirst */ - Perl_ck_fun_locale,/* lcfirst */ - Perl_ck_fun_locale,/* uc */ - Perl_ck_fun_locale,/* lc */ - Perl_ck_fun, /* quotemeta */ - Perl_ck_rvconst,/* rv2av */ - Perl_ck_null, /* aelemfast */ - Perl_ck_null, /* aelem */ - Perl_ck_null, /* aslice */ - Perl_ck_fun, /* each */ - Perl_ck_fun, /* values */ - Perl_ck_fun, /* keys */ - Perl_ck_delete, /* delete */ - Perl_ck_exists, /* exists */ - Perl_ck_rvconst,/* rv2hv */ - Perl_ck_null, /* helem */ - Perl_ck_null, /* hslice */ - Perl_ck_fun, /* unpack */ - Perl_ck_fun, /* pack */ - Perl_ck_split, /* split */ - Perl_ck_join, /* join */ - Perl_ck_null, /* list */ - Perl_ck_null, /* lslice */ - Perl_ck_fun, /* anonlist */ - Perl_ck_fun, /* anonhash */ - Perl_ck_fun, /* splice */ - Perl_ck_fun, /* push */ - Perl_ck_shift, /* pop */ - Perl_ck_shift, /* shift */ - Perl_ck_fun, /* unshift */ - Perl_ck_sort, /* sort */ - Perl_ck_fun, /* reverse */ - Perl_ck_grep, /* grepstart */ - Perl_ck_null, /* grepwhile */ - Perl_ck_grep, /* mapstart */ - Perl_ck_null, /* mapwhile */ - Perl_ck_null, /* range */ - Perl_ck_null, /* flip */ - Perl_ck_null, /* flop */ - Perl_ck_null, /* and */ - Perl_ck_null, /* or */ - Perl_ck_null, /* xor */ - Perl_ck_null, /* cond_expr */ - Perl_ck_null, /* andassign */ - Perl_ck_null, /* orassign */ - Perl_ck_method, /* method */ - Perl_ck_subr, /* entersub */ - Perl_ck_null, /* leavesub */ - Perl_ck_null, /* leavesublv */ - Perl_ck_fun, /* caller */ - Perl_ck_fun, /* warn */ - Perl_ck_fun, /* die */ - Perl_ck_fun, /* reset */ - Perl_ck_null, /* lineseq */ - Perl_ck_null, /* nextstate */ - Perl_ck_null, /* dbstate */ - Perl_ck_null, /* unstack */ - Perl_ck_null, /* enter */ - Perl_ck_null, /* leave */ - Perl_ck_null, /* scope */ - Perl_ck_null, /* enteriter */ - Perl_ck_null, /* iter */ - Perl_ck_null, /* enterloop */ - Perl_ck_null, /* leaveloop */ - Perl_ck_null, /* return */ - Perl_ck_null, /* last */ - Perl_ck_null, /* next */ - Perl_ck_null, /* redo */ - Perl_ck_null, /* dump */ - Perl_ck_null, /* goto */ - Perl_ck_fun, /* exit */ - Perl_ck_fun, /* open */ - Perl_ck_fun, /* close */ - Perl_ck_fun, /* pipe_op */ - Perl_ck_fun, /* fileno */ - Perl_ck_fun, /* umask */ - Perl_ck_fun, /* binmode */ - Perl_ck_fun, /* tie */ - Perl_ck_fun, /* untie */ - Perl_ck_fun, /* tied */ - Perl_ck_fun, /* dbmopen */ - Perl_ck_fun, /* dbmclose */ - Perl_ck_select, /* sselect */ - Perl_ck_select, /* select */ - Perl_ck_eof, /* getc */ - Perl_ck_fun, /* read */ - Perl_ck_fun, /* enterwrite */ - Perl_ck_null, /* leavewrite */ - Perl_ck_listiob,/* prtf */ - Perl_ck_listiob,/* print */ - Perl_ck_fun, /* sysopen */ - Perl_ck_fun, /* sysseek */ - Perl_ck_fun, /* sysread */ - Perl_ck_fun, /* syswrite */ - Perl_ck_fun, /* send */ - Perl_ck_fun, /* recv */ - Perl_ck_eof, /* eof */ - Perl_ck_fun, /* tell */ - Perl_ck_fun, /* seek */ - Perl_ck_trunc, /* truncate */ - Perl_ck_fun, /* fcntl */ - Perl_ck_fun, /* ioctl */ - Perl_ck_fun, /* flock */ - Perl_ck_fun, /* socket */ - Perl_ck_fun, /* sockpair */ - Perl_ck_fun, /* bind */ - Perl_ck_fun, /* connect */ - Perl_ck_fun, /* listen */ - Perl_ck_fun, /* accept */ - Perl_ck_fun, /* shutdown */ - Perl_ck_fun, /* gsockopt */ - Perl_ck_fun, /* ssockopt */ - Perl_ck_fun, /* getsockname */ - Perl_ck_fun, /* getpeername */ - Perl_ck_ftst, /* lstat */ - Perl_ck_ftst, /* stat */ - Perl_ck_ftst, /* ftrread */ - Perl_ck_ftst, /* ftrwrite */ - Perl_ck_ftst, /* ftrexec */ - Perl_ck_ftst, /* fteread */ - Perl_ck_ftst, /* ftewrite */ - Perl_ck_ftst, /* fteexec */ - Perl_ck_ftst, /* ftis */ - Perl_ck_ftst, /* fteowned */ - Perl_ck_ftst, /* ftrowned */ - Perl_ck_ftst, /* ftzero */ - Perl_ck_ftst, /* ftsize */ - Perl_ck_ftst, /* ftmtime */ - Perl_ck_ftst, /* ftatime */ - Perl_ck_ftst, /* ftctime */ - Perl_ck_ftst, /* ftsock */ - Perl_ck_ftst, /* ftchr */ - Perl_ck_ftst, /* ftblk */ - Perl_ck_ftst, /* ftfile */ - Perl_ck_ftst, /* ftdir */ - Perl_ck_ftst, /* ftpipe */ - Perl_ck_ftst, /* ftlink */ - Perl_ck_ftst, /* ftsuid */ - Perl_ck_ftst, /* ftsgid */ - Perl_ck_ftst, /* ftsvtx */ - Perl_ck_ftst, /* fttty */ - Perl_ck_ftst, /* fttext */ - Perl_ck_ftst, /* ftbinary */ - Perl_ck_fun, /* chdir */ - Perl_ck_fun, /* chown */ - Perl_ck_fun, /* chroot */ - Perl_ck_fun, /* unlink */ - Perl_ck_fun, /* chmod */ - Perl_ck_fun, /* utime */ - Perl_ck_fun, /* rename */ - Perl_ck_fun, /* link */ - Perl_ck_fun, /* symlink */ - Perl_ck_fun, /* readlink */ - Perl_ck_fun, /* mkdir */ - Perl_ck_fun, /* rmdir */ - Perl_ck_fun, /* open_dir */ - Perl_ck_fun, /* readdir */ - Perl_ck_fun, /* telldir */ - Perl_ck_fun, /* seekdir */ - Perl_ck_fun, /* rewinddir */ - Perl_ck_fun, /* closedir */ - Perl_ck_null, /* fork */ - Perl_ck_null, /* wait */ - Perl_ck_fun, /* waitpid */ - Perl_ck_exec, /* system */ - Perl_ck_exec, /* exec */ - Perl_ck_fun, /* kill */ - Perl_ck_null, /* getppid */ - Perl_ck_fun, /* getpgrp */ - Perl_ck_fun, /* setpgrp */ - Perl_ck_fun, /* getpriority */ - Perl_ck_fun, /* setpriority */ - Perl_ck_null, /* time */ - Perl_ck_null, /* tms */ - Perl_ck_fun, /* localtime */ - Perl_ck_fun, /* gmtime */ - Perl_ck_fun, /* alarm */ - Perl_ck_fun, /* sleep */ - Perl_ck_fun, /* shmget */ - Perl_ck_fun, /* shmctl */ - Perl_ck_fun, /* shmread */ - Perl_ck_fun, /* shmwrite */ - Perl_ck_fun, /* msgget */ - Perl_ck_fun, /* msgctl */ - Perl_ck_fun, /* msgsnd */ - Perl_ck_fun, /* msgrcv */ - Perl_ck_fun, /* semget */ - Perl_ck_fun, /* semctl */ - Perl_ck_fun, /* semop */ - Perl_ck_require,/* require */ - Perl_ck_fun, /* dofile */ - Perl_ck_eval, /* entereval */ - Perl_ck_null, /* leaveeval */ - Perl_ck_null, /* entertry */ - Perl_ck_null, /* leavetry */ - Perl_ck_fun, /* ghbyname */ - Perl_ck_fun, /* ghbyaddr */ - Perl_ck_null, /* ghostent */ - Perl_ck_fun, /* gnbyname */ - Perl_ck_fun, /* gnbyaddr */ - Perl_ck_null, /* gnetent */ - Perl_ck_fun, /* gpbyname */ - Perl_ck_fun, /* gpbynumber */ - Perl_ck_null, /* gprotoent */ - Perl_ck_fun, /* gsbyname */ - Perl_ck_fun, /* gsbyport */ - Perl_ck_null, /* gservent */ - Perl_ck_fun, /* shostent */ - Perl_ck_fun, /* snetent */ - Perl_ck_fun, /* sprotoent */ - Perl_ck_fun, /* sservent */ - Perl_ck_null, /* ehostent */ - Perl_ck_null, /* enetent */ - Perl_ck_null, /* eprotoent */ - Perl_ck_null, /* eservent */ - Perl_ck_fun, /* gpwnam */ - Perl_ck_fun, /* gpwuid */ - Perl_ck_null, /* gpwent */ - Perl_ck_null, /* spwent */ - Perl_ck_null, /* epwent */ - Perl_ck_fun, /* ggrnam */ - Perl_ck_fun, /* ggrgid */ - Perl_ck_null, /* ggrent */ - Perl_ck_null, /* sgrent */ - Perl_ck_null, /* egrent */ - Perl_ck_null, /* getlogin */ - Perl_ck_fun, /* syscall */ - Perl_ck_rfun, /* lock */ - Perl_ck_null, /* threadsv */ - Perl_ck_null, /* setstate */ - Perl_ck_null, /* method_named */ + MEMBER_TO_FPTR(Perl_ck_null), /* null */ + MEMBER_TO_FPTR(Perl_ck_null), /* stub */ + MEMBER_TO_FPTR(Perl_ck_fun), /* scalar */ + MEMBER_TO_FPTR(Perl_ck_null), /* pushmark */ + MEMBER_TO_FPTR(Perl_ck_null), /* wantarray */ + MEMBER_TO_FPTR(Perl_ck_svconst), /* const */ + MEMBER_TO_FPTR(Perl_ck_null), /* gvsv */ + MEMBER_TO_FPTR(Perl_ck_null), /* gv */ + MEMBER_TO_FPTR(Perl_ck_null), /* gelem */ + MEMBER_TO_FPTR(Perl_ck_null), /* padsv */ + MEMBER_TO_FPTR(Perl_ck_null), /* padav */ + MEMBER_TO_FPTR(Perl_ck_null), /* padhv */ + MEMBER_TO_FPTR(Perl_ck_null), /* padany */ + MEMBER_TO_FPTR(Perl_ck_null), /* pushre */ + MEMBER_TO_FPTR(Perl_ck_rvconst), /* rv2gv */ + MEMBER_TO_FPTR(Perl_ck_rvconst), /* rv2sv */ + MEMBER_TO_FPTR(Perl_ck_null), /* av2arylen */ + MEMBER_TO_FPTR(Perl_ck_rvconst), /* rv2cv */ + MEMBER_TO_FPTR(Perl_ck_anoncode), /* anoncode */ + MEMBER_TO_FPTR(Perl_ck_null), /* prototype */ + MEMBER_TO_FPTR(Perl_ck_spair), /* refgen */ + MEMBER_TO_FPTR(Perl_ck_null), /* srefgen */ + MEMBER_TO_FPTR(Perl_ck_fun), /* ref */ + MEMBER_TO_FPTR(Perl_ck_fun), /* bless */ + MEMBER_TO_FPTR(Perl_ck_null), /* backtick */ + MEMBER_TO_FPTR(Perl_ck_glob), /* glob */ + MEMBER_TO_FPTR(Perl_ck_null), /* readline */ + MEMBER_TO_FPTR(Perl_ck_null), /* rcatline */ + MEMBER_TO_FPTR(Perl_ck_fun), /* regcmaybe */ + MEMBER_TO_FPTR(Perl_ck_fun), /* regcreset */ + MEMBER_TO_FPTR(Perl_ck_null), /* regcomp */ + MEMBER_TO_FPTR(Perl_ck_match), /* match */ + MEMBER_TO_FPTR(Perl_ck_match), /* qr */ + MEMBER_TO_FPTR(Perl_ck_null), /* subst */ + MEMBER_TO_FPTR(Perl_ck_null), /* substcont */ + MEMBER_TO_FPTR(Perl_ck_null), /* trans */ + MEMBER_TO_FPTR(Perl_ck_sassign), /* sassign */ + MEMBER_TO_FPTR(Perl_ck_null), /* aassign */ + MEMBER_TO_FPTR(Perl_ck_spair), /* chop */ + MEMBER_TO_FPTR(Perl_ck_null), /* schop */ + MEMBER_TO_FPTR(Perl_ck_spair), /* chomp */ + MEMBER_TO_FPTR(Perl_ck_null), /* schomp */ + MEMBER_TO_FPTR(Perl_ck_defined), /* defined */ + MEMBER_TO_FPTR(Perl_ck_lfun), /* undef */ + MEMBER_TO_FPTR(Perl_ck_fun), /* study */ + MEMBER_TO_FPTR(Perl_ck_lfun), /* pos */ + MEMBER_TO_FPTR(Perl_ck_lfun), /* preinc */ + MEMBER_TO_FPTR(Perl_ck_lfun), /* i_preinc */ + MEMBER_TO_FPTR(Perl_ck_lfun), /* predec */ + MEMBER_TO_FPTR(Perl_ck_lfun), /* i_predec */ + MEMBER_TO_FPTR(Perl_ck_lfun), /* postinc */ + MEMBER_TO_FPTR(Perl_ck_lfun), /* i_postinc */ + MEMBER_TO_FPTR(Perl_ck_lfun), /* postdec */ + MEMBER_TO_FPTR(Perl_ck_lfun), /* i_postdec */ + MEMBER_TO_FPTR(Perl_ck_null), /* pow */ + MEMBER_TO_FPTR(Perl_ck_null), /* multiply */ + MEMBER_TO_FPTR(Perl_ck_null), /* i_multiply */ + MEMBER_TO_FPTR(Perl_ck_null), /* divide */ + MEMBER_TO_FPTR(Perl_ck_null), /* i_divide */ + MEMBER_TO_FPTR(Perl_ck_null), /* modulo */ + MEMBER_TO_FPTR(Perl_ck_null), /* i_modulo */ + MEMBER_TO_FPTR(Perl_ck_repeat), /* repeat */ + MEMBER_TO_FPTR(Perl_ck_null), /* add */ + MEMBER_TO_FPTR(Perl_ck_null), /* i_add */ + MEMBER_TO_FPTR(Perl_ck_null), /* subtract */ + MEMBER_TO_FPTR(Perl_ck_null), /* i_subtract */ + MEMBER_TO_FPTR(Perl_ck_concat), /* concat */ + MEMBER_TO_FPTR(Perl_ck_fun), /* stringify */ + MEMBER_TO_FPTR(Perl_ck_bitop), /* left_shift */ + MEMBER_TO_FPTR(Perl_ck_bitop), /* right_shift */ + MEMBER_TO_FPTR(Perl_ck_null), /* lt */ + MEMBER_TO_FPTR(Perl_ck_null), /* i_lt */ + MEMBER_TO_FPTR(Perl_ck_null), /* gt */ + MEMBER_TO_FPTR(Perl_ck_null), /* i_gt */ + MEMBER_TO_FPTR(Perl_ck_null), /* le */ + MEMBER_TO_FPTR(Perl_ck_null), /* i_le */ + MEMBER_TO_FPTR(Perl_ck_null), /* ge */ + MEMBER_TO_FPTR(Perl_ck_null), /* i_ge */ + MEMBER_TO_FPTR(Perl_ck_null), /* eq */ + MEMBER_TO_FPTR(Perl_ck_null), /* i_eq */ + MEMBER_TO_FPTR(Perl_ck_null), /* ne */ + MEMBER_TO_FPTR(Perl_ck_null), /* i_ne */ + MEMBER_TO_FPTR(Perl_ck_null), /* ncmp */ + MEMBER_TO_FPTR(Perl_ck_null), /* i_ncmp */ + MEMBER_TO_FPTR(Perl_ck_scmp), /* slt */ + MEMBER_TO_FPTR(Perl_ck_scmp), /* sgt */ + MEMBER_TO_FPTR(Perl_ck_scmp), /* sle */ + MEMBER_TO_FPTR(Perl_ck_scmp), /* sge */ + MEMBER_TO_FPTR(Perl_ck_null), /* seq */ + MEMBER_TO_FPTR(Perl_ck_null), /* sne */ + MEMBER_TO_FPTR(Perl_ck_scmp), /* scmp */ + MEMBER_TO_FPTR(Perl_ck_bitop), /* bit_and */ + MEMBER_TO_FPTR(Perl_ck_bitop), /* bit_xor */ + MEMBER_TO_FPTR(Perl_ck_bitop), /* bit_or */ + MEMBER_TO_FPTR(Perl_ck_null), /* negate */ + MEMBER_TO_FPTR(Perl_ck_null), /* i_negate */ + MEMBER_TO_FPTR(Perl_ck_null), /* not */ + MEMBER_TO_FPTR(Perl_ck_bitop), /* complement */ + MEMBER_TO_FPTR(Perl_ck_fun), /* atan2 */ + MEMBER_TO_FPTR(Perl_ck_fun), /* sin */ + MEMBER_TO_FPTR(Perl_ck_fun), /* cos */ + MEMBER_TO_FPTR(Perl_ck_fun), /* rand */ + MEMBER_TO_FPTR(Perl_ck_fun), /* srand */ + MEMBER_TO_FPTR(Perl_ck_fun), /* exp */ + MEMBER_TO_FPTR(Perl_ck_fun), /* log */ + MEMBER_TO_FPTR(Perl_ck_fun), /* sqrt */ + MEMBER_TO_FPTR(Perl_ck_fun), /* int */ + MEMBER_TO_FPTR(Perl_ck_fun), /* hex */ + MEMBER_TO_FPTR(Perl_ck_fun), /* oct */ + MEMBER_TO_FPTR(Perl_ck_fun), /* abs */ + MEMBER_TO_FPTR(Perl_ck_lengthconst), /* length */ + MEMBER_TO_FPTR(Perl_ck_fun), /* substr */ + MEMBER_TO_FPTR(Perl_ck_fun), /* vec */ + MEMBER_TO_FPTR(Perl_ck_index), /* index */ + MEMBER_TO_FPTR(Perl_ck_index), /* rindex */ + MEMBER_TO_FPTR(Perl_ck_fun_locale), /* sprintf */ + MEMBER_TO_FPTR(Perl_ck_fun), /* formline */ + MEMBER_TO_FPTR(Perl_ck_fun), /* ord */ + MEMBER_TO_FPTR(Perl_ck_fun), /* chr */ + MEMBER_TO_FPTR(Perl_ck_fun), /* crypt */ + MEMBER_TO_FPTR(Perl_ck_fun_locale), /* ucfirst */ + MEMBER_TO_FPTR(Perl_ck_fun_locale), /* lcfirst */ + MEMBER_TO_FPTR(Perl_ck_fun_locale), /* uc */ + MEMBER_TO_FPTR(Perl_ck_fun_locale), /* lc */ + MEMBER_TO_FPTR(Perl_ck_fun), /* quotemeta */ + MEMBER_TO_FPTR(Perl_ck_rvconst), /* rv2av */ + MEMBER_TO_FPTR(Perl_ck_null), /* aelemfast */ + MEMBER_TO_FPTR(Perl_ck_null), /* aelem */ + MEMBER_TO_FPTR(Perl_ck_null), /* aslice */ + MEMBER_TO_FPTR(Perl_ck_fun), /* each */ + MEMBER_TO_FPTR(Perl_ck_fun), /* values */ + MEMBER_TO_FPTR(Perl_ck_fun), /* keys */ + MEMBER_TO_FPTR(Perl_ck_delete), /* delete */ + MEMBER_TO_FPTR(Perl_ck_exists), /* exists */ + MEMBER_TO_FPTR(Perl_ck_rvconst), /* rv2hv */ + MEMBER_TO_FPTR(Perl_ck_null), /* helem */ + MEMBER_TO_FPTR(Perl_ck_null), /* hslice */ + MEMBER_TO_FPTR(Perl_ck_fun), /* unpack */ + MEMBER_TO_FPTR(Perl_ck_fun), /* pack */ + MEMBER_TO_FPTR(Perl_ck_split), /* split */ + MEMBER_TO_FPTR(Perl_ck_join), /* join */ + MEMBER_TO_FPTR(Perl_ck_null), /* list */ + MEMBER_TO_FPTR(Perl_ck_null), /* lslice */ + MEMBER_TO_FPTR(Perl_ck_fun), /* anonlist */ + MEMBER_TO_FPTR(Perl_ck_fun), /* anonhash */ + MEMBER_TO_FPTR(Perl_ck_fun), /* splice */ + MEMBER_TO_FPTR(Perl_ck_fun), /* push */ + MEMBER_TO_FPTR(Perl_ck_shift), /* pop */ + MEMBER_TO_FPTR(Perl_ck_shift), /* shift */ + MEMBER_TO_FPTR(Perl_ck_fun), /* unshift */ + MEMBER_TO_FPTR(Perl_ck_sort), /* sort */ + MEMBER_TO_FPTR(Perl_ck_fun), /* reverse */ + MEMBER_TO_FPTR(Perl_ck_grep), /* grepstart */ + MEMBER_TO_FPTR(Perl_ck_null), /* grepwhile */ + MEMBER_TO_FPTR(Perl_ck_grep), /* mapstart */ + MEMBER_TO_FPTR(Perl_ck_null), /* mapwhile */ + MEMBER_TO_FPTR(Perl_ck_null), /* range */ + MEMBER_TO_FPTR(Perl_ck_null), /* flip */ + MEMBER_TO_FPTR(Perl_ck_null), /* flop */ + MEMBER_TO_FPTR(Perl_ck_null), /* and */ + MEMBER_TO_FPTR(Perl_ck_null), /* or */ + MEMBER_TO_FPTR(Perl_ck_null), /* xor */ + MEMBER_TO_FPTR(Perl_ck_null), /* cond_expr */ + MEMBER_TO_FPTR(Perl_ck_null), /* andassign */ + MEMBER_TO_FPTR(Perl_ck_null), /* orassign */ + MEMBER_TO_FPTR(Perl_ck_method), /* method */ + MEMBER_TO_FPTR(Perl_ck_subr), /* entersub */ + MEMBER_TO_FPTR(Perl_ck_null), /* leavesub */ + MEMBER_TO_FPTR(Perl_ck_null), /* leavesublv */ + MEMBER_TO_FPTR(Perl_ck_fun), /* caller */ + MEMBER_TO_FPTR(Perl_ck_fun), /* warn */ + MEMBER_TO_FPTR(Perl_ck_fun), /* die */ + MEMBER_TO_FPTR(Perl_ck_fun), /* reset */ + MEMBER_TO_FPTR(Perl_ck_null), /* lineseq */ + MEMBER_TO_FPTR(Perl_ck_null), /* nextstate */ + MEMBER_TO_FPTR(Perl_ck_null), /* dbstate */ + MEMBER_TO_FPTR(Perl_ck_null), /* unstack */ + MEMBER_TO_FPTR(Perl_ck_null), /* enter */ + MEMBER_TO_FPTR(Perl_ck_null), /* leave */ + MEMBER_TO_FPTR(Perl_ck_null), /* scope */ + MEMBER_TO_FPTR(Perl_ck_null), /* enteriter */ + MEMBER_TO_FPTR(Perl_ck_null), /* iter */ + MEMBER_TO_FPTR(Perl_ck_null), /* enterloop */ + MEMBER_TO_FPTR(Perl_ck_null), /* leaveloop */ + MEMBER_TO_FPTR(Perl_ck_null), /* return */ + MEMBER_TO_FPTR(Perl_ck_null), /* last */ + MEMBER_TO_FPTR(Perl_ck_null), /* next */ + MEMBER_TO_FPTR(Perl_ck_null), /* redo */ + MEMBER_TO_FPTR(Perl_ck_null), /* dump */ + MEMBER_TO_FPTR(Perl_ck_null), /* goto */ + MEMBER_TO_FPTR(Perl_ck_fun), /* exit */ + MEMBER_TO_FPTR(Perl_ck_fun), /* open */ + MEMBER_TO_FPTR(Perl_ck_fun), /* close */ + MEMBER_TO_FPTR(Perl_ck_fun), /* pipe_op */ + MEMBER_TO_FPTR(Perl_ck_fun), /* fileno */ + MEMBER_TO_FPTR(Perl_ck_fun), /* umask */ + MEMBER_TO_FPTR(Perl_ck_fun), /* binmode */ + MEMBER_TO_FPTR(Perl_ck_fun), /* tie */ + MEMBER_TO_FPTR(Perl_ck_fun), /* untie */ + MEMBER_TO_FPTR(Perl_ck_fun), /* tied */ + MEMBER_TO_FPTR(Perl_ck_fun), /* dbmopen */ + MEMBER_TO_FPTR(Perl_ck_fun), /* dbmclose */ + MEMBER_TO_FPTR(Perl_ck_select), /* sselect */ + MEMBER_TO_FPTR(Perl_ck_select), /* select */ + MEMBER_TO_FPTR(Perl_ck_eof), /* getc */ + MEMBER_TO_FPTR(Perl_ck_fun), /* read */ + MEMBER_TO_FPTR(Perl_ck_fun), /* enterwrite */ + MEMBER_TO_FPTR(Perl_ck_null), /* leavewrite */ + MEMBER_TO_FPTR(Perl_ck_listiob), /* prtf */ + MEMBER_TO_FPTR(Perl_ck_listiob), /* print */ + MEMBER_TO_FPTR(Perl_ck_fun), /* sysopen */ + MEMBER_TO_FPTR(Perl_ck_fun), /* sysseek */ + MEMBER_TO_FPTR(Perl_ck_fun), /* sysread */ + MEMBER_TO_FPTR(Perl_ck_fun), /* syswrite */ + MEMBER_TO_FPTR(Perl_ck_fun), /* send */ + MEMBER_TO_FPTR(Perl_ck_fun), /* recv */ + MEMBER_TO_FPTR(Perl_ck_eof), /* eof */ + MEMBER_TO_FPTR(Perl_ck_fun), /* tell */ + MEMBER_TO_FPTR(Perl_ck_fun), /* seek */ + MEMBER_TO_FPTR(Perl_ck_trunc), /* truncate */ + MEMBER_TO_FPTR(Perl_ck_fun), /* fcntl */ + MEMBER_TO_FPTR(Perl_ck_fun), /* ioctl */ + MEMBER_TO_FPTR(Perl_ck_fun), /* flock */ + MEMBER_TO_FPTR(Perl_ck_fun), /* socket */ + MEMBER_TO_FPTR(Perl_ck_fun), /* sockpair */ + MEMBER_TO_FPTR(Perl_ck_fun), /* bind */ + MEMBER_TO_FPTR(Perl_ck_fun), /* connect */ + MEMBER_TO_FPTR(Perl_ck_fun), /* listen */ + MEMBER_TO_FPTR(Perl_ck_fun), /* accept */ + MEMBER_TO_FPTR(Perl_ck_fun), /* shutdown */ + MEMBER_TO_FPTR(Perl_ck_fun), /* gsockopt */ + MEMBER_TO_FPTR(Perl_ck_fun), /* ssockopt */ + MEMBER_TO_FPTR(Perl_ck_fun), /* getsockname */ + MEMBER_TO_FPTR(Perl_ck_fun), /* getpeername */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* lstat */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* stat */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftrread */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftrwrite */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftrexec */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* fteread */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftewrite */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* fteexec */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftis */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* fteowned */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftrowned */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftzero */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftsize */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftmtime */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftatime */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftctime */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftsock */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftchr */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftblk */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftfile */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftdir */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftpipe */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftlink */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftsuid */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftsgid */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftsvtx */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* fttty */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* fttext */ + MEMBER_TO_FPTR(Perl_ck_ftst), /* ftbinary */ + MEMBER_TO_FPTR(Perl_ck_fun), /* chdir */ + MEMBER_TO_FPTR(Perl_ck_fun), /* chown */ + MEMBER_TO_FPTR(Perl_ck_fun), /* chroot */ + MEMBER_TO_FPTR(Perl_ck_fun), /* unlink */ + MEMBER_TO_FPTR(Perl_ck_fun), /* chmod */ + MEMBER_TO_FPTR(Perl_ck_fun), /* utime */ + MEMBER_TO_FPTR(Perl_ck_fun), /* rename */ + MEMBER_TO_FPTR(Perl_ck_fun), /* link */ + MEMBER_TO_FPTR(Perl_ck_fun), /* symlink */ + MEMBER_TO_FPTR(Perl_ck_fun), /* readlink */ + MEMBER_TO_FPTR(Perl_ck_fun), /* mkdir */ + MEMBER_TO_FPTR(Perl_ck_fun), /* rmdir */ + MEMBER_TO_FPTR(Perl_ck_fun), /* open_dir */ + MEMBER_TO_FPTR(Perl_ck_fun), /* readdir */ + MEMBER_TO_FPTR(Perl_ck_fun), /* telldir */ + MEMBER_TO_FPTR(Perl_ck_fun), /* seekdir */ + MEMBER_TO_FPTR(Perl_ck_fun), /* rewinddir */ + MEMBER_TO_FPTR(Perl_ck_fun), /* closedir */ + MEMBER_TO_FPTR(Perl_ck_null), /* fork */ + MEMBER_TO_FPTR(Perl_ck_null), /* wait */ + MEMBER_TO_FPTR(Perl_ck_fun), /* waitpid */ + MEMBER_TO_FPTR(Perl_ck_exec), /* system */ + MEMBER_TO_FPTR(Perl_ck_exec), /* exec */ + MEMBER_TO_FPTR(Perl_ck_fun), /* kill */ + MEMBER_TO_FPTR(Perl_ck_null), /* getppid */ + MEMBER_TO_FPTR(Perl_ck_fun), /* getpgrp */ + MEMBER_TO_FPTR(Perl_ck_fun), /* setpgrp */ + MEMBER_TO_FPTR(Perl_ck_fun), /* getpriority */ + MEMBER_TO_FPTR(Perl_ck_fun), /* setpriority */ + MEMBER_TO_FPTR(Perl_ck_null), /* time */ + MEMBER_TO_FPTR(Perl_ck_null), /* tms */ + MEMBER_TO_FPTR(Perl_ck_fun), /* localtime */ + MEMBER_TO_FPTR(Perl_ck_fun), /* gmtime */ + MEMBER_TO_FPTR(Perl_ck_fun), /* alarm */ + MEMBER_TO_FPTR(Perl_ck_fun), /* sleep */ + MEMBER_TO_FPTR(Perl_ck_fun), /* shmget */ + MEMBER_TO_FPTR(Perl_ck_fun), /* shmctl */ + MEMBER_TO_FPTR(Perl_ck_fun), /* shmread */ + MEMBER_TO_FPTR(Perl_ck_fun), /* shmwrite */ + MEMBER_TO_FPTR(Perl_ck_fun), /* msgget */ + MEMBER_TO_FPTR(Perl_ck_fun), /* msgctl */ + MEMBER_TO_FPTR(Perl_ck_fun), /* msgsnd */ + MEMBER_TO_FPTR(Perl_ck_fun), /* msgrcv */ + MEMBER_TO_FPTR(Perl_ck_fun), /* semget */ + MEMBER_TO_FPTR(Perl_ck_fun), /* semctl */ + MEMBER_TO_FPTR(Perl_ck_fun), /* semop */ + MEMBER_TO_FPTR(Perl_ck_require), /* require */ + MEMBER_TO_FPTR(Perl_ck_fun), /* dofile */ + MEMBER_TO_FPTR(Perl_ck_eval), /* entereval */ + MEMBER_TO_FPTR(Perl_ck_null), /* leaveeval */ + MEMBER_TO_FPTR(Perl_ck_null), /* entertry */ + MEMBER_TO_FPTR(Perl_ck_null), /* leavetry */ + MEMBER_TO_FPTR(Perl_ck_fun), /* ghbyname */ + MEMBER_TO_FPTR(Perl_ck_fun), /* ghbyaddr */ + MEMBER_TO_FPTR(Perl_ck_null), /* ghostent */ + MEMBER_TO_FPTR(Perl_ck_fun), /* gnbyname */ + MEMBER_TO_FPTR(Perl_ck_fun), /* gnbyaddr */ + MEMBER_TO_FPTR(Perl_ck_null), /* gnetent */ + MEMBER_TO_FPTR(Perl_ck_fun), /* gpbyname */ + MEMBER_TO_FPTR(Perl_ck_fun), /* gpbynumber */ + MEMBER_TO_FPTR(Perl_ck_null), /* gprotoent */ + MEMBER_TO_FPTR(Perl_ck_fun), /* gsbyname */ + MEMBER_TO_FPTR(Perl_ck_fun), /* gsbyport */ + MEMBER_TO_FPTR(Perl_ck_null), /* gservent */ + MEMBER_TO_FPTR(Perl_ck_fun), /* shostent */ + MEMBER_TO_FPTR(Perl_ck_fun), /* snetent */ + MEMBER_TO_FPTR(Perl_ck_fun), /* sprotoent */ + MEMBER_TO_FPTR(Perl_ck_fun), /* sservent */ + MEMBER_TO_FPTR(Perl_ck_null), /* ehostent */ + MEMBER_TO_FPTR(Perl_ck_null), /* enetent */ + MEMBER_TO_FPTR(Perl_ck_null), /* eprotoent */ + MEMBER_TO_FPTR(Perl_ck_null), /* eservent */ + MEMBER_TO_FPTR(Perl_ck_fun), /* gpwnam */ + MEMBER_TO_FPTR(Perl_ck_fun), /* gpwuid */ + MEMBER_TO_FPTR(Perl_ck_null), /* gpwent */ + MEMBER_TO_FPTR(Perl_ck_null), /* spwent */ + MEMBER_TO_FPTR(Perl_ck_null), /* epwent */ + MEMBER_TO_FPTR(Perl_ck_fun), /* ggrnam */ + MEMBER_TO_FPTR(Perl_ck_fun), /* ggrgid */ + MEMBER_TO_FPTR(Perl_ck_null), /* ggrent */ + MEMBER_TO_FPTR(Perl_ck_null), /* sgrent */ + MEMBER_TO_FPTR(Perl_ck_null), /* egrent */ + MEMBER_TO_FPTR(Perl_ck_null), /* getlogin */ + MEMBER_TO_FPTR(Perl_ck_fun), /* syscall */ + MEMBER_TO_FPTR(Perl_ck_rfun), /* lock */ + MEMBER_TO_FPTR(Perl_ck_null), /* threadsv */ + MEMBER_TO_FPTR(Perl_ck_null), /* setstate */ + MEMBER_TO_FPTR(Perl_ck_null), /* method_named */ }; #endif @@ -1458,8 +1458,8 @@ EXT U32 PL_opargs[] = { 0x00000004, /* pushmark */ 0x00000014, /* wantarray */ 0x00000c04, /* const */ - 0x00000e44, /* gvsv */ - 0x00000e44, /* gv */ + 0x00000c44, /* gvsv */ + 0x00000c44, /* gv */ 0x00022440, /* gelem */ 0x00000044, /* padsv */ 0x00000040, /* padav */ @@ -1490,8 +1490,8 @@ EXT U32 PL_opargs[] = { 0x00003014, /* trans */ 0x00000004, /* sassign */ 0x00044408, /* aassign */ - 0x0000570d, /* chop */ - 0x0001378c, /* schop */ + 0x0000560d, /* chop */ + 0x0001368c, /* schop */ 0x0000570d, /* chomp */ 0x0001378c, /* schomp */ 0x00013694, /* defined */ @@ -1502,9 +1502,9 @@ EXT U32 PL_opargs[] = { 0x00002254, /* i_preinc */ 0x00002264, /* predec */ 0x00002254, /* i_predec */ - 0x0000236c, /* postinc */ + 0x0000226c, /* postinc */ 0x0000235c, /* i_postinc */ - 0x0000236c, /* postdec */ + 0x0000226c, /* postdec */ 0x0000235c, /* i_postdec */ 0x0002250e, /* pow */ 0x0002252e, /* multiply */ @@ -1543,13 +1543,13 @@ EXT U32 PL_opargs[] = { 0x00022416, /* seq */ 0x00022416, /* sne */ 0x0002241e, /* scmp */ - 0x0002250e, /* bit_and */ - 0x0002250e, /* bit_xor */ - 0x0002250e, /* bit_or */ - 0x0000232e, /* negate */ + 0x0002240e, /* bit_and */ + 0x0002240e, /* bit_xor */ + 0x0002240e, /* bit_or */ + 0x0000222e, /* negate */ 0x0000231e, /* i_negate */ 0x00002216, /* not */ - 0x0000230e, /* complement */ + 0x0000220e, /* complement */ 0x0002290e, /* atan2 */ 0x0001378e, /* sin */ 0x0001378e, /* cos */ @@ -1567,7 +1567,7 @@ EXT U32 PL_opargs[] = { 0x0022281c, /* vec */ 0x0122291c, /* index */ 0x0122291c, /* rindex */ - 0x0004290f, /* sprintf */ + 0x0004280f, /* sprintf */ 0x00042805, /* formline */ 0x0001379e, /* ord */ 0x0001378e, /* chr */ @@ -1576,9 +1576,9 @@ EXT U32 PL_opargs[] = { 0x0001368e, /* lcfirst */ 0x0001368e, /* uc */ 0x0001368e, /* lc */ - 0x0001378e, /* quotemeta */ + 0x0001368e, /* quotemeta */ 0x00000248, /* rv2av */ - 0x00026e04, /* aelemfast */ + 0x00026c04, /* aelemfast */ 0x00026404, /* aelem */ 0x00046801, /* aslice */ 0x00009600, /* each */ @@ -1592,7 +1592,7 @@ EXT U32 PL_opargs[] = { 0x00022800, /* unpack */ 0x0004280d, /* pack */ 0x00222808, /* split */ - 0x0004290d, /* join */ + 0x0004280d, /* join */ 0x00004801, /* list */ 0x00448400, /* lslice */ 0x00004805, /* anonlist */ diff --git a/opcode.pl b/opcode.pl index 3f4d7c5..0dfb9e7 100755 --- a/opcode.pl +++ b/opcode.pl @@ -129,7 +129,7 @@ EXT OP * (CPERLscope(*PL_ppaddr)[])(pTHX) = { END for (@ops) { - print "\tPerl_pp_$_,\n"; + print "\tMEMBER_TO_FPTR(Perl_pp_$_),\n"; } print < kaboom. + # pp.c pos substr each not OK (RETPUSHUNDEF) # substr vec also not OK due to LV to target (are they???) # ref not OK (RETPUSHNO) # trans not OK (dTARG; TARG = sv_newmortal();) # ucfirst etc not OK: TMP arg processed inplace +# quotemeta not OK (unsafe when TARG == arg) # each repeat not OK too due to array context # pack split - unknown whether they are safe +# sprintf: is calling do_sprintf(TARG,...) which can act on TARG +# before other args are processed. + +# Suspicious wrt "additional mode of failure" (and only it): +# schop, chop, postinc/dec, bit_and etc, negate, complement. + +# Also suspicious: 4-arg substr, sprintf, uc/lc (POK_only), reverse, pack. + +# substr/vec: doing TAINT_off()??? # pp_hot.c # readline - unknown whether it is safe # match subst not OK (dTARG) # grepwhile not OK (not always setting) +# join not OK (unsafe when TARG == arg) + +# Suspicious wrt "additional mode of failure": concat (dealt with +# in ck_sassign()), join (same). # pp_ctl.c # mapwhile flip caller not OK (not always setting) @@ -315,6 +333,8 @@ sub tab { # sselect shm* sem* msg* syscall - unknown whether they are safe # gmtime not OK (list context) +# Suspicious wrt "additional mode of failure": warn, die, select. + __END__ # New ops always go at the very end @@ -332,8 +352,8 @@ wantarray wantarray ck_null is0 const constant item ck_svconst s$ -gvsv scalar variable ck_null ds* -gv glob value ck_null ds* +gvsv scalar variable ck_null ds$ +gv glob value ck_null ds$ gelem glob elem ck_null d2 S S padsv private variable ck_null ds0 padav private array ck_null d0 @@ -345,9 +365,9 @@ pushre push regexp ck_null d/ # References and stuff. rv2gv ref-to-glob cast ck_rvconst ds1 -rv2sv scalar deref ck_rvconst ds1 +rv2sv scalar dereference ck_rvconst ds1 av2arylen array length ck_null is1 -rv2cv subroutine deref ck_rvconst d1 +rv2cv subroutine dereference ck_rvconst d1 anoncode anonymous subroutine ck_anoncode $ prototype subroutine prototype ck_null s% S refgen reference constructor ck_spair m1 L @@ -380,8 +400,8 @@ trans transliteration (tr///) ck_null is" S sassign scalar assignment ck_sassign s0 aassign list assignment ck_null t2 L L -chop chop ck_spair mTs% L -schop scalar chop ck_null sTu% S? +chop chop ck_spair mts% L +schop scalar chop ck_null stu% S? chomp chomp ck_spair mTs% L schomp scalar chomp ck_null sTu% S? defined defined operator ck_defined isu% S? @@ -393,9 +413,9 @@ preinc preincrement (++) ck_lfun dIs1 S i_preinc integer preincrement (++) ck_lfun dis1 S predec predecrement (--) ck_lfun dIs1 S i_predec integer predecrement (--) ck_lfun dis1 S -postinc postincrement (++) ck_lfun dIsT1 S +postinc postincrement (++) ck_lfun dIst1 S i_postinc integer postincrement (++) ck_lfun disT1 S -postdec postdecrement (--) ck_lfun dIsT1 S +postdec postdecrement (--) ck_lfun dIst1 S i_postdec integer postdecrement (--) ck_lfun disT1 S # Ordinary operators. @@ -443,14 +463,14 @@ seq string eq ck_null ifs2 S S sne string ne ck_null ifs2 S S scmp string comparison (cmp) ck_scmp ifst2 S S -bit_and bitwise and (&) ck_bitop fsT2 S S -bit_xor bitwise xor (^) ck_bitop fsT2 S S -bit_or bitwise or (|) ck_bitop fsT2 S S +bit_and bitwise and (&) ck_bitop fst2 S S +bit_xor bitwise xor (^) ck_bitop fst2 S S +bit_or bitwise or (|) ck_bitop fst2 S S -negate negation (-) ck_null IfsT1 S +negate negation (-) ck_null Ifst1 S i_negate integer negation (-) ck_null ifsT1 S not not ck_null ifs1 S -complement 1's complement (~) ck_bitop fsT1 S +complement 1's complement (~) ck_bitop fst1 S # High falutin' math. @@ -479,7 +499,7 @@ vec vec ck_fun ist@ S S S index index ck_index isT@ S S S? rindex rindex ck_index isT@ S S S? -sprintf sprintf ck_fun_locale mfsT@ S L +sprintf sprintf ck_fun_locale mfst@ S L formline formline ck_fun ms@ S L ord ord ck_fun ifsTu% S? chr chr ck_fun fsTu% S? @@ -488,12 +508,12 @@ ucfirst ucfirst ck_fun_locale fstu% S? lcfirst lcfirst ck_fun_locale fstu% S? uc uc ck_fun_locale fstu% S? lc lc ck_fun_locale fstu% S? -quotemeta quotemeta ck_fun fsTu% S? +quotemeta quotemeta ck_fun fstu% S? # Arrays. rv2av array dereference ck_rvconst dt1 -aelemfast constant array element ck_null s* A S +aelemfast constant array element ck_null s$ A S aelem array element ck_null s2 A S aslice array slice ck_null m@ A L @@ -513,7 +533,7 @@ hslice hash slice ck_null m@ H L unpack unpack ck_fun @ S S pack pack ck_fun mst@ S L split split ck_split t@ S S S -join join ck_join msT@ S L +join join ck_join mst@ S L # List operators. @@ -717,6 +737,10 @@ setpriority setpriority ck_fun isT@ S S S # Time calls. +# NOTE: MacOS patches the 'i' of time() away later when the interpreter +# is created because in MacOS time() is already returning times > 2**31-1, +# that is, non-integers. + time time ck_null isT0 tms times ck_null 0 localtime localtime ck_fun t% S? diff --git a/os2/Changes b/os2/Changes index 910ec46..e56b708 100644 --- a/os2/Changes +++ b/os2/Changes @@ -296,3 +296,29 @@ after 5.005_54: If the only shell-metachars of a command are ' 2>&1' at the end of a command, it is executed without calling the external shell. + +after 5.005_57: + Make UDP sockets return correct caller address (OS2 API bug); + Enable TCPIPV4 defines (works with Warp 3 IAK too?!); + Force Unix-domain sockets to start with "/socket", convert + '/' to '\' in the calls; + Make C to treat $cmd as in C; + Autopatch Configure; + Find name and location of g[nu]patch.exe; + Autocopy perl????.dll to t/ when testing; + +after 5.005_62: + Extract a lightweight DLL access module OS2::DLL from OS2::REXX + which would not load REXX runtime system; + Allow compile with os2.h which loads os2tk.h instead of os2emx.h; + Put the version of EMX CRTL into -D define; + Use _setsyserror() to store last error of OS/2 API for $^E; + New macro PERL_SYS_INIT3(argvp, argcp, envp); + Make Dynaloader return info on the failing module after failed dl_open(); + OS2::REXX test were done for interactive testing (were writing + "ok" to stderr); + system() and friends return -1 on failure (was 0xFF00); + Put the full name of executable into $^X + (alas, uppercased - but with /); + t/io/fs.t was failing on HPFS386; + Remove extra ';' from defines for MQ operations. diff --git a/os2/Makefile.SHs b/os2/Makefile.SHs index f7f8402..005d7a9 100644 --- a/os2/Makefile.SHs +++ b/os2/Makefile.SHs @@ -20,7 +20,7 @@ PERL_FULLVERSION = $perl_fullversion OPTIMIZE = $optimize AOUT_OPTIMIZE = \$(OPTIMIZE) -AOUT_CCCMD = \$(CC) $aout_ccflags \$(AOUT_OPTIMIZE) +AOUT_CCCMD = \$(CC) -DPERL_CORE $aout_ccflags \$(AOUT_OPTIMIZE) AOUT_AR = $aout_ar AOUT_OBJ_EXT = $aout_obj_ext AOUT_LIB_EXT = $aout_lib_ext @@ -96,9 +96,12 @@ perl.linkexp: perl.exports perl.map os2/os2.sym # We link miniperl statically, since .DLL depends on $(DYNALOADER) -miniperl.map miniperl: $(obj) perl$(OBJ_EXT) miniperlmain$(OBJ_EXT) - $(CC) $(LARGE) $(CLDFLAGS) -o miniperl miniperlmain$(OBJ_EXT) perl$(OBJ_EXT) $(obj) $(libs) -Zmap -Zlinker /map - @./miniperl -w -Ilib -MExporter -e 0 || $(MAKE) minitest +opmini$(OBJ_EXT) : op.c + $(CCCMD) $(PLDLFLAGS) -DPERL_EXTERNAL_GLOB -o opmini$(OBJ_EXT) op.c + +miniperl.map miniperl: $(obj) perl$(OBJ_EXT) miniperlmain$(OBJ_EXT) opmini$(OBJ_EXT) + $(CC) $(LARGE) $(CLDFLAGS) -o miniperl miniperlmain$(OBJ_EXT) perl$(OBJ_EXT) `echo $(obj)|sed -e 's/\bop\./opmini./g'` $(libs) -Zmap -Zlinker /map/PM:VIO + @./miniperl -w -Ilib -MExporter -e '' || $(MAKE) minitest depend: os2ish.h dlfcn.h os2thread.h os2.c @@ -162,6 +165,9 @@ $(AOUT_LIBPERL) : $(aout_obj) perl$(AOUT_OBJ_EXT) .c$(AOUT_OBJ_EXT): $(AOUT_CCCMD) $(PLDLFLAGS) -c $*.c +opmini$(AOUT_OBJ_EXT): op.c + $(AOUT_CCCMD) $(PLDLFLAGS) -DPERL_EXTERNAL_GLOB -o opmini$(AOUT_OBJ_EXT) -c op.c + perlmain(AOUT_OBJ_EXT): perlmain.c $(AOUT_CCCMD_DLL) $(PLDLFLAGS) -c perlmain.c @@ -169,8 +175,8 @@ aout_perlmain.c: miniperlmain.c config.sh makefile $(static_ext_autoinit) sh writemain $(DYNALOADER) $(aout_static_lib) > tmp sh mv-if-diff tmp aout_perlmain.c -miniperl_: $& miniperlmain$(AOUT_OBJ_EXT) $(AOUT_LIBPERL) - $(CC) $(LARGE) $(AOUT_CLDFLAGS) $(CCDLFLAGS) -o miniperl_ miniperlmain$(AOUT_OBJ_EXT) $(AOUT_LIBPERL) $(libs) +miniperl_: $& miniperlmain$(AOUT_OBJ_EXT) $(AOUT_LIBPERL) opmini$(AOUT_OBJ_EXT) + $(CC) $(LARGE) $(AOUT_CLDFLAGS) $(CCDLFLAGS) -o miniperl_ miniperlmain$(AOUT_OBJ_EXT) opmini$(AOUT_OBJ_EXT) $(AOUT_LIBPERL) $(libs) perl_: $& aout_perlmain$(AOUT_OBJ_EXT) $(AOUT_LIBPERL) $(AOUT_DYNALOADER) $(aout_static_ext) ext.libs $(CC) $(LARGE) $(AOUT_CLDFLAGS) $(CCDLFLAGS) -o perl_ aout_perlmain$(AOUT_OBJ_EXT) $(AOUT_DYNALOADER) $(aout_static_ext) $(AOUT_LIBPERL) `cat ext.libs` $(libs) diff --git a/os2/OS2/REXX/Changes b/os2/OS2/REXX/Changes index 46b38ef..7c19710 100644 --- a/os2/OS2/REXX/Changes +++ b/os2/OS2/REXX/Changes @@ -2,3 +2,6 @@ After fixpak17 a lot of other places have mismatched lengths returned in the REXXPool interface. Also drop does not work on stems any more. +0.22: + A subsystem module OS2::DLL extracted which does not link + with REXX runtime library. diff --git a/os2/OS2/REXX/DLL/Changes b/os2/OS2/REXX/DLL/Changes new file mode 100644 index 0000000..874f7fa --- /dev/null +++ b/os2/OS2/REXX/DLL/Changes @@ -0,0 +1,2 @@ +0.01: + Split out of OS2::REXX diff --git a/os2/OS2/REXX/DLL/DLL.pm b/os2/OS2/REXX/DLL/DLL.pm new file mode 100644 index 0000000..7e54371 --- /dev/null +++ b/os2/OS2/REXX/DLL/DLL.pm @@ -0,0 +1,136 @@ +package OS2::DLL; + +use Carp; +use DynaLoader; + +@ISA = qw(DynaLoader); + +sub AUTOLOAD { + $AUTOLOAD =~ /^OS2::DLL::.+::(.+)$/ + or confess("Undefined subroutine &$AUTOLOAD called"); + return undef if $1 eq "DESTROY"; + $_[0]->find($1) + or confess("Can't find entry '$1' to DLL '$_[0]->{File}': $^E"); + goto &$AUTOLOAD; +} + +@libs = split(/;/, $ENV{'PERL5REXX'} || $ENV{'PERLREXX'} || $ENV{'LIBPATH'} || $ENV{'PATH'}); +%dlls = (); + +# Preloaded methods go here. Autoload methods go after __END__, and are +# processed by the autosplit program. + +# Cannot autoload, the autoloader is used for the REXX functions. + +sub load +{ + confess 'Usage: load OS2::DLL []' unless $#_ >= 1; + my ($class, $file, @where) = (@_, @libs); + return $dlls{$file} if $dlls{$file}; + my $handle; + foreach (@where) { + $handle = DynaLoader::dl_load_file("$_/$file.dll"); + last if $handle; + } + $handle = DynaLoader::dl_load_file($file) unless $handle; + return undef unless $handle; + my $packs = $INC{'OS2/REXX.pm'} ? 'OS2::DLL OS2::REXX' : 'OS2::DLL'; + eval < $handle, File => $file, Queue => 'SESSION' }, + "OS2::DLL::$file"; +} + +sub find +{ + my $self = shift; + my $file = $self->{File}; + my $handle = $self->{Handle}; + my $prefix = exists($self->{Prefix}) ? $self->{Prefix} : ""; + my $queue = $self->{Queue}; + foreach (@_) { + my $name = "OS2::DLL::${file}::$_"; + next if defined(&$name); + my $addr = DynaLoader::dl_find_symbol($handle, uc $prefix.$_) + || DynaLoader::dl_find_symbol($handle, $prefix.$_) + or return 0; + eval < module if you need the variable pool. + +=head1 SYNOPSIS + + use OS2::DLL; + $emx_dll = OS2::DLL->load('emx'); + $emx_version = $emx_dll->emx_revision(); + +=head1 DESCRIPTION + +=head2 Load REXX DLL + + $dll = load OS2::DLL NAME [, WHERE]; + +NAME is DLL name, without path and extension. + +Directories are searched WHERE first (list of dirs), then environment +paths PERL5REXX, PERLREXX, PATH or, as last resort, OS/2-ish search +is performed in default DLL path (without adding paths and extensions). + +The DLL is not unloaded when the variable dies. + +Returns DLL object reference, or undef on failure. + +=head2 Check for functions (optional): + + BOOL = $dll->find(NAME [, NAME [, ...]]); + +Returns true if all functions are available. + +=head2 Call external REXX function: + + $dll->function(arguments); + +Returns the return string if the return code is 0, else undef. +Dies with error message if the function is not available. + +=head1 ENVIRONMENT + +If C is set, emits debugging output. Looks for DLLs +in C, C, C. + +=head1 AUTHOR + +Extracted by Ilya Zakharevich ilya@math.ohio-state.edu from L +written by Andreas Kaiser ak@ananke.s.bawue.de. + +=cut diff --git a/os2/OS2/REXX/DLL/DLL.xs b/os2/OS2/REXX/DLL/DLL.xs new file mode 100644 index 0000000..c8e7c58 --- /dev/null +++ b/os2/OS2/REXX/DLL/DLL.xs @@ -0,0 +1,72 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#define INCL_BASE +#define INCL_REXXSAA +#include + +static RXSTRING * strs; +static int nstrs; +static char * trace; + +static void +needstrs(int n) +{ + if (n > nstrs) { + if (strs) + free(strs); + nstrs = 2 * n; + strs = malloc(nstrs * sizeof(RXSTRING)); + } +} + +MODULE = OS2::DLL PACKAGE = OS2::DLL + +BOOT: + needstrs(8); + trace = getenv("PERL_REXX_DEBUG"); + +SV * +_call(name, address, queue="SESSION", ...) + char * name + void * address + char * queue + CODE: + { + ULONG rc; + int argc, i; + RXSTRING result; + UCHAR resbuf[256]; + RexxFunctionHandler *fcn = address; + argc = items-3; + needstrs(argc); + if (trace) + fprintf(stderr, "REXXCALL::_call name: '%s' args:", name); + for (i = 0; i < argc; ++i) { + STRLEN len; + char *ptr = SvPV(ST(3+i), len); + MAKERXSTRING(strs[i], ptr, len); + if (trace) + fprintf(stderr, " '%.*s'", len, ptr); + } + if (!*queue) + queue = "SESSION"; + if (trace) + fprintf(stderr, "\n"); + MAKERXSTRING(result, resbuf, sizeof resbuf); + rc = fcn(name, argc, strs, queue, &result); + if (trace) + fprintf(stderr, " rc=%X, result='%.*s'\n", rc, + result.strlength, result.strptr); + ST(0) = sv_newmortal(); + if (rc == 0) { + if (result.strptr) + sv_setpvn(ST(0), result.strptr, result.strlength); + else + sv_setpvn(ST(0), "", 0); + } + if (result.strptr && result.strptr != resbuf) + DosFreeMem(result.strptr); + } + diff --git a/os2/OS2/REXX/DLL/MANIFEST b/os2/OS2/REXX/DLL/MANIFEST new file mode 100644 index 0000000..d7ad9b6 --- /dev/null +++ b/os2/OS2/REXX/DLL/MANIFEST @@ -0,0 +1,5 @@ +Changes +MANIFEST +Makefile.PL +DLL.pm +DLL.xs diff --git a/os2/OS2/REXX/DLL/Makefile.PL b/os2/OS2/REXX/DLL/Makefile.PL new file mode 100644 index 0000000..fe2403d --- /dev/null +++ b/os2/OS2/REXX/DLL/Makefile.PL @@ -0,0 +1,9 @@ +use ExtUtils::MakeMaker; + +WriteMakefile( + NAME => 'OS2::DLL', + VERSION => '0.01', + MAN3PODS => ' ', # Pods will be built by installman. + XSPROTOARG => '-noprototypes', + PERL_MALLOC_OK => 1, +); diff --git a/os2/OS2/REXX/Makefile.PL b/os2/OS2/REXX/Makefile.PL index 5eda5a3..6648b2c 100644 --- a/os2/OS2/REXX/Makefile.PL +++ b/os2/OS2/REXX/Makefile.PL @@ -2,7 +2,7 @@ use ExtUtils::MakeMaker; WriteMakefile( NAME => 'OS2::REXX', - VERSION => '0.21', + VERSION => '0.22', MAN3PODS => ' ', # Pods will be built by installman. XSPROTOARG => '-noprototypes', PERL_MALLOC_OK => 1, diff --git a/os2/OS2/REXX/REXX.pm b/os2/OS2/REXX/REXX.pm index 4580ede..144dd37 100644 --- a/os2/OS2/REXX/REXX.pm +++ b/os2/OS2/REXX/REXX.pm @@ -3,6 +3,8 @@ package OS2::REXX; use Carp; require Exporter; require DynaLoader; +require OS2::DLL; + @ISA = qw(Exporter DynaLoader); # Items to export into callers namespace by default # (move infrequently used names to @EXPORT_OK below) @@ -10,66 +12,18 @@ require DynaLoader; # Other items we are prepared to export if requested @EXPORT_OK = qw(drop); -sub AUTOLOAD { - $AUTOLOAD =~ /^OS2::REXX::.+::(.+)$/ - or confess("Undefined subroutine &$AUTOLOAD called"); - return undef if $1 eq "DESTROY"; - $_[0]->find($1) - or confess("Can't find entry '$1' to DLL '$_[0]->{File}'"); - goto &$AUTOLOAD; -} +# We cannot just put OS2::DLL in @ISA, since some scripts would use +# function interface, not method interface... -@libs = split(/;/, $ENV{'PERL5REXX'} || $ENV{'PERLREXX'} || $ENV{'LIBPATH'} || $ENV{'PATH'}); -%dlls = (); +*_call = \&OS2::DLL::_call; +*load = \&OS2::DLL::load; +*find = \&OS2::DLL::find; bootstrap OS2::REXX; # Preloaded methods go here. Autoload methods go after __END__, and are # processed by the autosplit program. -# Cannot autoload, the autoloader is used for the REXX functions. - -sub load -{ - confess 'Usage: load OS2::REXX []' unless $#_ >= 1; - my ($class, $file, @where) = (@_, @libs); - return $dlls{$file} if $dlls{$file}; - my $handle; - foreach (@where) { - $handle = DynaLoader::dl_load_file("$_/$file.dll"); - last if $handle; - } - $handle = DynaLoader::dl_load_file($file) unless $handle; - return undef unless $handle; - eval "package OS2::REXX::$file; \@ISA = ('OS2::REXX');" - . "sub AUTOLOAD {" - . " \$OS2::REXX::AUTOLOAD = \$AUTOLOAD;" - . " goto &OS2::REXX::AUTOLOAD;" - . "} 1;" or die "eval package $@"; - return $dlls{$file} = bless {Handle => $handle, File => $file, Queue => 'SESSION' }, "OS2::REXX::$file"; -} - -sub find -{ - my $self = shift; - my $file = $self->{File}; - my $handle = $self->{Handle}; - my $prefix = exists($self->{Prefix}) ? $self->{Prefix} : ""; - my $queue = $self->{Queue}; - foreach (@_) { - my $name = "OS2::REXX::${file}::$_"; - next if defined(&$name); - my $addr = DynaLoader::dl_find_symbol($handle, uc $prefix.$_) - || DynaLoader::dl_find_symbol($handle, $prefix.$_) - or return 0; - eval "package OS2::REXX::$file; sub $_". - "{ shift; OS2::REXX::_call('$_', $addr, '$queue', \@_); }". - "1;" - or die "eval sub"; - } - return 1; -} - sub prefix { my $self = shift; @@ -381,9 +335,18 @@ which access REXX queues or REXX variables in signal handlers. See C for examples. +=head1 ENVIRONMENT + +If C is set, prints trace info on calls to REXX runtime +environment. + =head1 AUTHOR Andreas Kaiser ak@ananke.s.bawue.de, with additions by Ilya Zakharevich ilya@math.ohio-state.edu. +=head1 SEE ALSO + +L. + =cut diff --git a/os2/OS2/REXX/REXX.xs b/os2/OS2/REXX/REXX.xs index 9f23714..8a8e5f2 100644 --- a/os2/OS2/REXX/REXX.xs +++ b/os2/OS2/REXX/REXX.xs @@ -236,49 +236,6 @@ constant(name,arg) char * name int arg -SV * -_call(name, address, queue="SESSION", ...) - char * name - void * address - char * queue - CODE: - { - ULONG rc; - int argc, i; - RXSTRING result; - UCHAR resbuf[256]; - RexxFunctionHandler *fcn = address; - argc = items-3; - needstrs(argc); - if (trace) - fprintf(stderr, "REXXCALL::_call name: '%s' args:", name); - for (i = 0; i < argc; ++i) { - STRLEN len; - char *ptr = SvPV(ST(3+i), len); - MAKERXSTRING(strs[i], ptr, len); - if (trace) - fprintf(stderr, " '%.*s'", len, ptr); - } - if (!*queue) - queue = "SESSION"; - if (trace) - fprintf(stderr, "\n"); - MAKERXSTRING(result, resbuf, sizeof resbuf); - rc = fcn(name, argc, strs, queue, &result); - if (trace) - fprintf(stderr, " rc=%X, result='%.*s'\n", rc, - result.strlength, result.strptr); - ST(0) = sv_newmortal(); - if (rc == 0) { - if (result.strptr) - sv_setpvn(ST(0), result.strptr, result.strlength); - else - sv_setpvn(ST(0), "", 0); - } - if (result.strptr && result.strptr != resbuf) - DosFreeMem(result.strptr); - } - int _set(name,value,...) char * name diff --git a/os2/OS2/REXX/t/rx_dllld.t b/os2/OS2/REXX/t/rx_dllld.t index 9d81bf3..15362d7 100644 --- a/os2/OS2/REXX/t/rx_dllld.t +++ b/os2/OS2/REXX/t/rx_dllld.t @@ -16,7 +16,7 @@ foreach $dir (split(';', $path)) { $found = "$dir/YDBAUTIL.DLL"; last; } -$found or die "1..0\n#Cannot find YDBAUTIL.DLL\n"; +$found or print "1..0 # skipped: cannot find YDBAUTIL.DLL\n" and exit; print "1..5\n"; diff --git a/os2/OS2/REXX/t/rx_emxrv.t b/os2/OS2/REXX/t/rx_emxrv.t new file mode 100644 index 0000000..d51e1b0 --- /dev/null +++ b/os2/OS2/REXX/t/rx_emxrv.t @@ -0,0 +1,24 @@ +BEGIN { + chdir 't' if -d 't/lib'; + @INC = '../lib' if -d 'lib'; + require Config; import Config; + if (-d 'lib' and $Config{'extensions'} !~ /\bOS2(::|\/)REXX\b/) { + print "1..0\n"; + exit 0; + } +} + +print "1..5\n"; + +require OS2::DLL; +print "ok 1\n"; +$emx_dll = OS2::DLL->load('emx'); +print "ok 2\n"; +$emx_version = $emx_dll->emx_revision(); +print "ok 3\n"; +$emx_version >= 40 or print "not "; # We cannot work with old EMXs +print "ok 4\n"; + +$reason = ''; +$emx_version >= 99 and $reason = ' # skipped: version of EMX 100 or more'; # Be safe +print "ok 5$reason\n"; diff --git a/os2/OS2/REXX/t/rx_objcall.t b/os2/OS2/REXX/t/rx_objcall.t index cb3c52a..8bdf905 100644 --- a/os2/OS2/REXX/t/rx_objcall.t +++ b/os2/OS2/REXX/t/rx_objcall.t @@ -13,7 +13,8 @@ use OS2::REXX; # # DLL # -$ydba = load OS2::REXX "ydbautil" or die "1..0\n# load\n"; +$ydba = load OS2::REXX "ydbautil" + or print "1..0 # skipped: cannot find YDBAUTIL.DLL\n" and exit; print "1..5\n", "ok 1\n"; # diff --git a/os2/OS2/REXX/t/rx_tievar.t b/os2/OS2/REXX/t/rx_tievar.t index 77f90c2..5f43f4e 100644 --- a/os2/OS2/REXX/t/rx_tievar.t +++ b/os2/OS2/REXX/t/rx_tievar.t @@ -13,7 +13,8 @@ use OS2::REXX; # # DLL # -load OS2::REXX "ydbautil" or die "1..0\n# load\n"; +load OS2::REXX "ydbautil" + or print "1..0 # skipped: cannot find YDBAUTIL.DLL\n" and exit; print "1..19\n"; diff --git a/os2/OS2/REXX/t/rx_tieydb.t b/os2/OS2/REXX/t/rx_tieydb.t index 30a2daf..1653a20 100644 --- a/os2/OS2/REXX/t/rx_tieydb.t +++ b/os2/OS2/REXX/t/rx_tieydb.t @@ -9,7 +9,9 @@ BEGIN { } use OS2::REXX; -$rx = load OS2::REXX "ydbautil" or die "1..0\n# load\n"; # from RXU17.ZIP +$rx = load OS2::REXX "ydbautil" # from RXU17.ZIP + or print "1..0 # skipped: cannot find YDBAUTIL.DLL\n" and exit; + print "1..7\n", "ok 1\n"; $rx->prefix("Rx"); # implicit function prefix diff --git a/os2/OS2/REXX/t/rx_vrexx.t b/os2/OS2/REXX/t/rx_vrexx.t index 04ca663..b0621f4 100644 --- a/os2/OS2/REXX/t/rx_vrexx.t +++ b/os2/OS2/REXX/t/rx_vrexx.t @@ -18,7 +18,7 @@ foreach $dir (split(';', $path)) { print "# found at `$found'\n"; last; } -$found or die "1..0\n#Cannot find $name.DLL\n"; +$found or print "1..0 # skipped: cannot find $name.DLL\n" and exit; print "1..10\n"; diff --git a/os2/POSIX.mkfifo b/os2/POSIX.mkfifo deleted file mode 100644 index f460bc6..0000000 --- a/os2/POSIX.mkfifo +++ /dev/null @@ -1,16 +0,0 @@ -diff -cr ..\perl5os2.patch\perl5.001m.andy/ext/POSIX/POSIX.xs ./ext/POSIX/POSIX.xs -*** ../perl5os2.patch/perl5.001m.andy/ext/POSIX/POSIX.xs Tue May 23 11:54:26 1995 ---- ./ext/POSIX/POSIX.xs Thu Sep 28 00:00:16 1995 -*************** -*** 81,86 **** ---- 81,90 ---- - /* Possibly needed prototypes */ - char *cuserid (char *); - -+ #ifndef HAS_MKFIFO -+ #define mkfifo(a,b) not_here("mkfifo") -+ #endif -+ - #ifndef HAS_CUSERID - #define cuserid(a) (char *) not_here("cuserid") - #endif diff --git a/os2/dl_os2.c b/os2/dl_os2.c index 19f36f6..4a9688c 100644 --- a/os2/dl_os2.c +++ b/os2/dl_os2.c @@ -4,15 +4,16 @@ #include static ULONG retcode; +static char fail[300]; void * dlopen(char *path, int mode) { HMODULE handle; char tmp[260], *beg, *dot; - char fail[300]; ULONG rc; + fail[0] = 0; if ((rc = DosLoadModule(fail, sizeof fail, path, &handle)) == 0) return (void *)handle; @@ -42,6 +43,7 @@ dlsym(void *handle, char *symbol) ULONG rc, type; PFN addr; + fail[0] = 0; rc = DosQueryProcAddr((HMODULE)handle, 0, symbol, &addr); if (rc == 0) { rc = DosQueryProcType((HMODULE)handle, 0, symbol, &type); @@ -56,15 +58,31 @@ dlsym(void *handle, char *symbol) char * dlerror(void) { - static char buf[300]; + static char buf[700]; ULONG len; if (retcode == 0) return NULL; - if (DosGetMessage(NULL, 0, buf, sizeof buf - 1, retcode, "OSO001.MSG", &len)) - sprintf(buf, "OS/2 system error code %d", retcode); - else + if (DosGetMessage(NULL, 0, buf, sizeof buf - 1, retcode, + "OSO001.MSG", &len)) { + if (fail[0]) + sprintf(buf, +"OS/2 system error code %d, possible problematic module: '%s'", + retcode, fail); + else + sprintf(buf, "OS/2 system error code %d", retcode); + } else { buf[len] = '\0'; + if (len && buf[len - 1] == '\n') + buf[--len] = 0; + if (len && buf[len - 1] == '\r') + buf[--len] = 0; + if (len && buf[len - 1] == '.') + buf[--len] = 0; + if (fail[0] && len < 300) + sprintf(buf + len, ", possible problematic module: '%s'", + fail); + } retcode = 0; return buf; } diff --git a/os2/os2.c b/os2/os2.c index 7c23200..8a17ae7 100644 --- a/os2/os2.c +++ b/os2/os2.c @@ -3,6 +3,10 @@ #define INCL_DOSFILEMGR #define INCL_DOSMEMMGR #define INCL_DOSERRORS +/* These 3 are needed for compile if os2.h includes os2tk.h, not os2emx.h */ +#define INCL_DOSPROCESS +#define SPU_DISABLESUPPRESSION 0 +#define SPU_ENABLESUPPRESSION 1 #include #include @@ -802,7 +806,7 @@ U32 addflag; PL_Argv[0], Strerror(errno)); if (rc < 0 && (execf != EXECF_SPAWN_NOWAIT) && ((trueflag & 0xFF) == P_WAIT)) - rc = 255 << 8; /* Emulate the fork(). */ + rc = -1; finish: if (new_stderr != -1) { /* How can we use error codes? */ @@ -907,7 +911,8 @@ do_spawn3(char *cmd, int execf, int flag) Perl_warner(aTHX_ WARN_EXEC, "Can't %s \"%s\": %s", (execf == EXECF_SPAWN ? "spawn" : "exec"), shell, Strerror(errno)); - if (rc < 0) rc = 255 << 8; /* Emulate the fork(). */ + if (rc < 0) + rc = -1; } if (news) Safefree(news); @@ -1356,18 +1361,37 @@ os2error(int rc) return NULL; if (DosGetMessage(NULL, 0, buf, sizeof buf - 1, rc, "OSO001.MSG", &len)) sprintf(buf, "OS/2 system error code %d=0x%x", rc, rc); - else + else { buf[len] = '\0'; - if (len > 0 && buf[len - 1] == '\n') - buf[len - 1] = '\0'; - if (len > 1 && buf[len - 2] == '\r') - buf[len - 2] = '\0'; - if (len > 2 && buf[len - 3] == '.') - buf[len - 3] = '\0'; + if (len && buf[len - 1] == '\n') + buf[--len] = 0; + if (len && buf[len - 1] == '\r') + buf[--len] = 0; + if (len && buf[len - 1] == '.') + buf[--len] = 0; + } return buf; } char * +os2_execname(void) +{ + char buf[300], *p; + + if (_execname(buf, sizeof buf) != 0) + return PL_origargv[0]; + p = buf; + while (*p) { + if (*p == '\\') + *p = '/'; + p++; + } + p = savepv(buf); + SAVEFREEPV(p); + return p; +} + +char * perllib_mangle(char *s, unsigned int l) { static char *newp, *oldp; @@ -2067,7 +2091,7 @@ Perl_OS2_init(char **env) settmppath(); OS2_Perl_data.xs_init = &Xs_OS2_init; _uflags (_UF_SBRK_MODEL, _UF_SBRK_ARBITRARY); - if (environ == NULL) { + if (environ == NULL && env) { environ = env; } if ( (shell = getenv("PERL_SH_DRIVE")) ) { diff --git a/os2/os2ish.h b/os2/os2ish.h index 6993dfc..f254b5c 100644 --- a/os2/os2ish.h +++ b/os2/os2ish.h @@ -64,7 +64,7 @@ #ifndef SIGILL # define SIGILL 6 /* blech */ #endif -#define ABORT() kill(getpid(),SIGABRT); +#define ABORT() kill(PerlProc_getpid(),SIGABRT); #define BIT_BUCKET "/dev/nul" /* Will this work? */ @@ -183,16 +183,26 @@ void Perl_OS2_init(char **); /* XXX This code hideously puts env inside: */ -#ifdef __EMX__ +#ifdef PERL_CORE +# define PERL_SYS_INIT3(argcp, argvp, envp) STMT_START { \ + _response(argcp, argvp); \ + _wildcard(argcp, argvp); \ + Perl_OS2_init(*envp); } STMT_END # define PERL_SYS_INIT(argcp, argvp) STMT_START { \ _response(argcp, argvp); \ _wildcard(argcp, argvp); \ - Perl_OS2_init(env); } STMT_END -#else /* Compiling embedded Perl with non-EMX compiler */ + Perl_OS2_init(NULL); } STMT_END +#else /* Compiling embedded Perl or Perl extension */ +# define PERL_SYS_INIT3(argcp, argvp, envp) STMT_START { \ + Perl_OS2_init(*envp); } STMT_END # define PERL_SYS_INIT(argcp, argvp) STMT_START { \ - Perl_OS2_init(env); } STMT_END + Perl_OS2_init(NULL); } STMT_END +#endif + +#ifndef __EMX__ # define PERL_CALLCONV _System #endif + #define PERL_SYS_TERM() MALLOC_TERM /* #define PERL_SYS_TERM() STMT_START { \ @@ -221,7 +231,6 @@ void *sys_alloc(int size); # define PerlIO FILE #endif -#define TMPPATH tmppath #define TMPPATH1 "plXXXXXX" extern char *tmppath; PerlIO *my_syspopen(char *cmd, char *mode); @@ -318,6 +327,7 @@ extern OS2_Perl_data_t OS2_Perl_data; #define Perl_rc (OS2_Perl_data.rc) #define Perl_severity (OS2_Perl_data.severity) #define errno_isOS2 12345678 +#define errno_isOS2_set 12345679 #define OS2_Perl_flags (OS2_Perl_data.flags) #define Perl_HAB_set_f 1 #define Perl_HAB_set (OS2_Perl_flags & Perl_HAB_set_f) @@ -339,6 +349,7 @@ void Perl_Deregister_MQ(int serve); int Perl_Serve_Messages(int force); /* Cannot prototype with I32 at this point. */ int Perl_Process_Messages(int force, long *cntp); +char *os2_execname(void); struct _QMSG; struct PMWIN_entries_t { @@ -356,23 +367,29 @@ struct PMWIN_entries_t { extern struct PMWIN_entries_t PMWIN_entries; void init_PMWIN_entries(void); -#define perl_hmq_GET(serve) Perl_Register_MQ(serve); -#define perl_hmq_UNSET(serve) Perl_Deregister_MQ(serve); +#define perl_hmq_GET(serve) Perl_Register_MQ(serve) +#define perl_hmq_UNSET(serve) Perl_Deregister_MQ(serve) #define OS2_XS_init() (*OS2_Perl_data.xs_init)() + +#if _EMX_CRT_REV_ >= 60 +# define os2_setsyserrno(rc) (Perl_rc = rc, errno = errno_isOS2_set, \ + _setsyserrno(rc)) +#else +# define os2_setsyserrno(rc) (Perl_rc = rc, errno = errno_isOS2) +#endif + /* The expressions below return true on error. */ /* INCL_DOSERRORS needed. rc should be declared outside. */ #define CheckOSError(expr) (!(rc = (expr)) ? 0 : (FillOSError(rc), 1)) /* INCL_WINERRORS needed. */ #define SaveWinError(expr) ((expr) ? : (FillWinError, 0)) #define CheckWinError(expr) ((expr) ? 0: (FillWinError, 1)) -#define FillOSError(rc) (Perl_rc = rc, \ - errno = errno_isOS2, \ +#define FillOSError(rc) (os2_setsyserrno(rc), \ Perl_severity = SEVERITY_ERROR) -#define FillWinError (Perl_rc = WinGetLastError(Perl_hab), \ - errno = errno_isOS2, \ - Perl_severity = ERRORIDSEV(Perl_rc), \ - Perl_rc = ERRORIDERROR(Perl_rc)) +#define FillWinError (Perl_severity = ERRORIDSEV(Perl_rc), \ + Perl_rc = ERRORIDERROR(Perl_rc)), \ + os2_setsyserrno(Perl_rc) #define STATIC_FILE_LENGTH 127 @@ -392,7 +409,7 @@ char *os2error(int rc); #define QSS_FILE 8 /* Buggy until fixpack18 */ #define QSS_SHARED 16 -#ifdef _OS2EMX_H +#ifdef _OS2_H APIRET APIENTRY Dos32QuerySysState(ULONG func,ULONG arg1,ULONG pid, ULONG _res_,PVOID buf,ULONG bufsz); @@ -550,5 +567,5 @@ typedef struct { PQTOPLEVEL get_sysinfo(ULONG pid, ULONG flags); -#endif /* _OS2EMX_H */ +#endif /* _OS2_H */ diff --git a/patchlevel.h b/patchlevel.h index 02a9689..9670081 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -5,7 +5,25 @@ #define PERL_REVISION 5 /* age */ #define PERL_VERSION 5 /* epoch */ -#define PERL_SUBVERSION 61 /* generation */ +#define PERL_SUBVERSION 640 /* generation */ + +/* The following numbers describe the earliest compatible version of + Perl ("compatibility" here being defined as sufficient binary/API + compatibility to run XS code built with the older version). + Normally this should not change across maintenance releases. + + This is used by Configure et al to figure out + PERL_INC_VERSION_LIST, which lists version libraries + to include in @INC. See INSTALL for how this works. +*/ +#define PERL_API_REVISION 5 /* Adjust manually as needed. */ +#define PERL_API_VERSION 5 /* Adjust manually as needed. */ +#define PERL_API_SUBVERSION 640 /* Adjust manually as needed. */ +/* + XXX Note: The selection of non-default Configure options, such + as -Duselonglong may invalidate these settings. Currently, Configure + does not adequately test for this. A.D. Jan 13, 2000 +*/ #define __PATCHLEVEL_H_INCLUDED__ #endif diff --git a/perl.c b/perl.c index c7cbe7e..1b9dac2 100644 --- a/perl.c +++ b/perl.c @@ -47,14 +47,43 @@ static I32 read_e_script(pTHXo_ int idx, SV *buf_sv, int maxlen); #endif #ifdef PERL_OBJECT -CPerlObj* perl_alloc(IPerlMem* ipM, IPerlEnv* ipE, IPerlStdIO* ipStd, - IPerlLIO* ipLIO, IPerlDir* ipD, IPerlSock* ipS, IPerlProc* ipP) +#define perl_construct Perl_construct +#define perl_parse Perl_parse +#define perl_run Perl_run +#define perl_destruct Perl_destruct +#define perl_free Perl_free +#endif + +#ifdef PERL_IMPLICIT_SYS +PerlInterpreter * +perl_alloc_using(struct IPerlMem* ipM, struct IPerlMem* ipMS, + struct IPerlMem* ipMP, struct IPerlEnv* ipE, + struct IPerlStdIO* ipStd, struct IPerlLIO* ipLIO, + struct IPerlDir* ipD, struct IPerlSock* ipS, + struct IPerlProc* ipP) { - CPerlObj* pPerl = new(ipM) CPerlObj(ipM, ipE, ipStd, ipLIO, ipD, ipS, ipP); - if(pPerl != NULL) - pPerl->Init(); + PerlInterpreter *my_perl; +#ifdef PERL_OBJECT + my_perl = (PerlInterpreter*)new(ipM) CPerlObj(ipM, ipMS, ipMP, ipE, ipStd, + ipLIO, ipD, ipS, ipP); + PERL_SET_INTERP(my_perl); +#else + /* New() needs interpreter, so call malloc() instead */ + my_perl = (PerlInterpreter*)(*ipM->pMalloc)(ipM, sizeof(PerlInterpreter)); + PERL_SET_INTERP(my_perl); + Zero(my_perl, 1, PerlInterpreter); + PL_Mem = ipM; + PL_MemShared = ipMS; + PL_MemParse = ipMP; + PL_Env = ipE; + PL_StdIO = ipStd; + PL_LIO = ipLIO; + PL_Dir = ipD; + PL_Sock = ipS; + PL_Proc = ipP; +#endif - return pPerl; + return my_perl; } #else PerlInterpreter * @@ -65,9 +94,10 @@ perl_alloc(void) /* New() needs interpreter, so call malloc() instead */ my_perl = (PerlInterpreter*)PerlMem_malloc(sizeof(PerlInterpreter)); PERL_SET_INTERP(my_perl); + Zero(my_perl, 1, PerlInterpreter); return my_perl; } -#endif /* PERL_OBJECT */ +#endif /* PERL_IMPLICIT_SYS */ void perl_construct(pTHXx) @@ -75,15 +105,11 @@ perl_construct(pTHXx) #ifdef USE_THREADS int i; #ifndef FAKE_THREADS - struct perl_thread *thr; + struct perl_thread *thr = NULL; #endif /* FAKE_THREADS */ #endif /* USE_THREADS */ #ifdef MULTIPLICITY - Zero(my_perl, 1, PerlInterpreter); -#endif - -#ifdef MULTIPLICITY init_interp(); PL_perl_destruct_level = 1; #else @@ -93,9 +119,8 @@ perl_construct(pTHXx) /* Init the real globals (and main thread)? */ if (!PL_linestr) { -#ifdef USE_THREADS - INIT_THREADS; +#ifdef USE_THREADS #ifdef ALLOC_THREAD_KEY ALLOC_THREAD_KEY; #else @@ -177,14 +202,30 @@ perl_construct(pTHXx) init_i18nl10n(1); SET_NUMERIC_STANDARD(); + + { + U8 *s; + PL_patchlevel = NEWSV(0,4); + SvUPGRADE(PL_patchlevel, SVt_PVNV); + if (PERL_REVISION > 127 || PERL_VERSION > 127 || PERL_SUBVERSION > 127) + SvGROW(PL_patchlevel,24); + s = (U8*)SvPVX(PL_patchlevel); + s = uv_to_utf8(s, (UV)PERL_REVISION); + s = uv_to_utf8(s, (UV)PERL_VERSION); + s = uv_to_utf8(s, (UV)PERL_SUBVERSION); + *s = '\0'; + SvCUR_set(PL_patchlevel, s - (U8*)SvPVX(PL_patchlevel)); + SvPOK_on(PL_patchlevel); + SvNVX(PL_patchlevel) = (NV)PERL_REVISION + + ((NV)PERL_VERSION / (NV)1000) #if defined(PERL_SUBVERSION) && PERL_SUBVERSION > 0 - sprintf(PL_patchlevel, "%7.5f", (double) PERL_REVISION - + ((double) PERL_VERSION / (double) 1000) - + ((double) PERL_SUBVERSION / (double) 100000)); -#else - sprintf(PL_patchlevel, "%5.3f", (double) PERL_REVISION + - ((double) PERL_VERSION / (double) 1000)); + + ((NV)PERL_SUBVERSION / (NV)1000000) #endif + ; + SvNOK_on(PL_patchlevel); /* dual valued */ + SvUTF8_on(PL_patchlevel); + SvREADONLY_on(PL_patchlevel); + } #if defined(LOCAL_PATCH_COUNT) PL_localpatches = local_patches; /* For possible -v */ @@ -195,11 +236,6 @@ perl_construct(pTHXx) PL_fdpid = newAV(); /* for remembering popen pids by fd */ PL_modglobal = newHV(); /* pointers to per-interpreter module globals */ - DEBUG( { - New(51,PL_debname,128,char); - New(52,PL_debdelim,128,char); - } ) - ENTER; } @@ -215,12 +251,15 @@ perl_destruct(pTHXx) dTHX; #endif /* USE_THREADS */ + /* wait for all pseudo-forked children to finish */ + PERL_WAIT_FOR_CHILDREN; + #ifdef USE_THREADS #ifndef FAKE_THREADS /* Pass 1 on any remaining threads: detach joinables, join zombies */ retry_cleanup: MUTEX_LOCK(&PL_threads_mutex); - DEBUG_S(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(Perl_debug_log, "perl_destruct: waiting for %d threads...\n", PL_nthreads - 1)); for (t = thr->next; t != thr; t = t->next) { @@ -228,7 +267,7 @@ perl_destruct(pTHXx) switch (ThrSTATE(t)) { AV *av; case THRf_ZOMBIE: - DEBUG_S(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(Perl_debug_log, "perl_destruct: joining zombie %p\n", t)); ThrSETSTATE(t, THRf_DEAD); MUTEX_UNLOCK(&t->mutex); @@ -242,11 +281,11 @@ perl_destruct(pTHXx) MUTEX_UNLOCK(&PL_threads_mutex); JOIN(t, &av); SvREFCNT_dec((SV*)av); - DEBUG_S(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(Perl_debug_log, "perl_destruct: joined zombie %p OK\n", t)); goto retry_cleanup; case THRf_R_JOINABLE: - DEBUG_S(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(Perl_debug_log, "perl_destruct: detaching thread %p\n", t)); ThrSETSTATE(t, THRf_R_DETACHED); /* @@ -260,7 +299,7 @@ perl_destruct(pTHXx) MUTEX_UNLOCK(&t->mutex); goto retry_cleanup; default: - DEBUG_S(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(Perl_debug_log, "perl_destruct: ignoring %p (state %u)\n", t, ThrSTATE(t))); MUTEX_UNLOCK(&t->mutex); @@ -272,14 +311,14 @@ perl_destruct(pTHXx) /* Pass 2 on remaining threads: wait for the thread count to drop to one */ while (PL_nthreads > 1) { - DEBUG_S(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(Perl_debug_log, "perl_destruct: final wait for %d threads\n", PL_nthreads - 1)); COND_WAIT(&PL_nthreads_cond, &PL_threads_mutex); } /* At this point, we're the last thread */ MUTEX_UNLOCK(&PL_threads_mutex); - DEBUG_S(PerlIO_printf(PerlIO_stderr(), "perl_destruct: armageddon has arrived\n")); + DEBUG_S(PerlIO_printf(Perl_debug_log, "perl_destruct: armageddon has arrived\n")); MUTEX_DESTROY(&PL_threads_mutex); COND_DESTROY(&PL_nthreads_cond); #endif /* !defined(FAKE_THREADS) */ @@ -328,8 +367,6 @@ perl_destruct(pTHXx) PL_warnhook = Nullsv; SvREFCNT_dec(PL_diehook); PL_diehook = Nullsv; - SvREFCNT_dec(PL_parsehook); - PL_parsehook = Nullsv; /* call exit list functions */ while (PL_exitlistlen-- > 0) @@ -367,12 +404,11 @@ perl_destruct(pTHXx) PL_dowarn = G_WARN_OFF; PL_doextract = FALSE; PL_sawampersand = FALSE; /* must save all match strings */ - PL_sawstudy = FALSE; /* do fbm_instr on all strings */ - PL_sawvec = FALSE; PL_unsafe = FALSE; Safefree(PL_inplace); PL_inplace = Nullch; + SvREFCNT_dec(PL_patchlevel); if (PL_e_script) { SvREFCNT_dec(PL_e_script); @@ -417,31 +453,96 @@ perl_destruct(pTHXx) /* startup and shutdown function lists */ SvREFCNT_dec(PL_beginav); SvREFCNT_dec(PL_endav); + SvREFCNT_dec(PL_stopav); SvREFCNT_dec(PL_initav); PL_beginav = Nullav; PL_endav = Nullav; + PL_stopav = Nullav; PL_initav = Nullav; /* shortcuts just get cleared */ PL_envgv = Nullgv; - PL_siggv = Nullgv; PL_incgv = Nullgv; PL_hintgv = Nullgv; PL_errgv = Nullgv; PL_argvgv = Nullgv; PL_argvoutgv = Nullgv; PL_stdingv = Nullgv; + PL_stderrgv = Nullgv; PL_last_in_gv = Nullgv; PL_replgv = Nullgv; + PL_debstash = Nullhv; /* reset so print() ends up where we expect */ setdefout(Nullgv); + SvREFCNT_dec(PL_argvout_stack); + PL_argvout_stack = Nullav; + + SvREFCNT_dec(PL_fdpid); + PL_fdpid = Nullav; + SvREFCNT_dec(PL_modglobal); + PL_modglobal = Nullhv; + SvREFCNT_dec(PL_preambleav); + PL_preambleav = Nullav; + SvREFCNT_dec(PL_subname); + PL_subname = Nullsv; + SvREFCNT_dec(PL_linestr); + PL_linestr = Nullsv; + SvREFCNT_dec(PL_pidstatus); + PL_pidstatus = Nullhv; + SvREFCNT_dec(PL_toptarget); + PL_toptarget = Nullsv; + SvREFCNT_dec(PL_bodytarget); + PL_bodytarget = Nullsv; + PL_formtarget = Nullsv; + + /* clear utf8 character classes */ + SvREFCNT_dec(PL_utf8_alnum); + SvREFCNT_dec(PL_utf8_alnumc); + SvREFCNT_dec(PL_utf8_ascii); + SvREFCNT_dec(PL_utf8_alpha); + SvREFCNT_dec(PL_utf8_space); + SvREFCNT_dec(PL_utf8_cntrl); + SvREFCNT_dec(PL_utf8_graph); + SvREFCNT_dec(PL_utf8_digit); + SvREFCNT_dec(PL_utf8_upper); + SvREFCNT_dec(PL_utf8_lower); + SvREFCNT_dec(PL_utf8_print); + SvREFCNT_dec(PL_utf8_punct); + SvREFCNT_dec(PL_utf8_xdigit); + SvREFCNT_dec(PL_utf8_mark); + SvREFCNT_dec(PL_utf8_toupper); + SvREFCNT_dec(PL_utf8_tolower); + PL_utf8_alnum = Nullsv; + PL_utf8_alnumc = Nullsv; + PL_utf8_ascii = Nullsv; + PL_utf8_alpha = Nullsv; + PL_utf8_space = Nullsv; + PL_utf8_cntrl = Nullsv; + PL_utf8_graph = Nullsv; + PL_utf8_digit = Nullsv; + PL_utf8_upper = Nullsv; + PL_utf8_lower = Nullsv; + PL_utf8_print = Nullsv; + PL_utf8_punct = Nullsv; + PL_utf8_xdigit = Nullsv; + PL_utf8_mark = Nullsv; + PL_utf8_toupper = Nullsv; + PL_utf8_totitle = Nullsv; + PL_utf8_tolower = Nullsv; + + if (!specialWARN(PL_compiling.cop_warnings)) + SvREFCNT_dec(PL_compiling.cop_warnings); + PL_compiling.cop_warnings = Nullsv; + /* Prepare to destruct main symbol table. */ hv = PL_defstash; PL_defstash = 0; SvREFCNT_dec(hv); + SvREFCNT_dec(PL_curstname); + PL_curstname = Nullsv; /* clear queued errors */ SvREFCNT_dec(PL_errors); @@ -512,10 +613,7 @@ perl_destruct(pTHXx) sv_free_arenas(); /* No SVs have survived, need to clean out */ - PL_linestr = NULL; - PL_pidstatus = Nullhv; Safefree(PL_origfilename); - Safefree(PL_archpat_auto); Safefree(PL_reg_start_tmp); if (PL_reg_curpm) Safefree(PL_reg_curpm); @@ -591,6 +689,7 @@ perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env) dTHR; I32 oldscope; int ret; + dJMPENV; #ifdef USE_THREADS dTHX; #endif @@ -639,9 +738,12 @@ setuid perl scripts securely.\n"); oldscope = PL_scopestack_ix; PL_dowarn = G_WARN_OFF; - CALLPROTECT(aTHX_ &ret, MEMBER_TO_FPTR(S_parse_body), env, xsinit); + CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_parse_body), + env, xsinit); switch (ret) { case 0: + if (PL_stopav) + call_list(oldscope, PL_stopav); return 0; case 1: STATUS_ALL_FAILURE; @@ -652,11 +754,11 @@ setuid perl scripts securely.\n"); LEAVE; FREETMPS; PL_curstash = PL_defstash; - if (PL_endav) - call_list(oldscope, PL_endav); + if (PL_stopav) + call_list(oldscope, PL_stopav); return STATUS_NATIVE_EXPORT; case 3: - PerlIO_printf(PerlIO_stderr(), "panic: top_env\n"); + PerlIO_printf(Perl_error_log, "panic: top_env\n"); return 1; } return 0; @@ -676,6 +778,7 @@ S_parse_body(pTHX_ va_list args) AV* comppadlist; register SV *sv; register char *s; + char *cddir = Nullch; XSINIT_t xsinit = va_arg(args, XSINIT_t); @@ -752,18 +855,18 @@ S_parse_body(pTHX_ va_list args) if (!*++s && (s=argv[1]) != Nullch) { argc--,argv++; } - while (s && isSPACE(*s)) - ++s; if (s && *s) { - char *e, *p; - for (e = s; *e && !isSPACE(*e); e++) ; - p = savepvn(s, e-s); + char *p; + STRLEN len = strlen(s); + p = savepvn(s, len); incpush(p, TRUE); - sv_catpv(sv,"-I"); - sv_catpv(sv,p); - sv_catpv(sv," "); + sv_catpvn(sv, "-I", 2); + sv_catpvn(sv, p, len); + sv_catpvn(sv, " ", 1); Safefree(p); - } /* XXX else croak? */ + } + else + Perl_croak(aTHX_ "No directory specified for -I"); break; case 'P': forbid_setid("-P"); @@ -786,7 +889,6 @@ S_parse_body(pTHX_ va_list args) #else sv_catpv(PL_Sv,"print \"\\nCharacteristics of this binary (from libperl): \\n\","); #endif -#if defined(DEBUGGING) || defined(MULTIPLICITY) sv_catpv(PL_Sv,"\" Compile-time options:"); # ifdef DEBUGGING sv_catpv(PL_Sv," DEBUGGING"); @@ -794,8 +896,35 @@ S_parse_body(pTHX_ va_list args) # ifdef MULTIPLICITY sv_catpv(PL_Sv," MULTIPLICITY"); # endif +# ifdef USE_THREADS + sv_catpv(PL_Sv," USE_THREADS"); +# endif +# ifdef USE_ITHREADS + sv_catpv(PL_Sv," USE_ITHREADS"); +# endif +# ifdef USE_64_BITS + sv_catpv(PL_Sv," USE_64_BITS"); +# endif +# ifdef USE_LONG_DOUBLE + sv_catpv(PL_Sv," USE_LONG_DOUBLE"); +# endif +# ifdef USE_LARGE_FILES + sv_catpv(PL_Sv," USE_LARGE_FILES"); +# endif +# ifdef USE_SOCKS + sv_catpv(PL_Sv," USE_SOCKS"); +# endif +# ifdef PERL_OBJECT + sv_catpv(PL_Sv," PERL_OBJECT"); +# endif +# ifdef PERL_IMPLICIT_CONTEXT + sv_catpv(PL_Sv," PERL_IMPLICIT_CONTEXT"); +# endif +# ifdef PERL_IMPLICIT_SYS + sv_catpv(PL_Sv," PERL_IMPLICIT_SYS"); +# endif sv_catpv(PL_Sv,"\\n\","); -#endif + #if defined(LOCAL_PATCH_COUNT) if (LOCAL_PATCH_COUNT > 0) { int i; @@ -833,7 +962,7 @@ print \" \\@INC:\\n @INC\\n\";"); PL_doextract = TRUE; s++; if (*s) - PL_cddir = savepv(s); + cddir = s; break; case 0: break; @@ -863,7 +992,8 @@ print \" \\@INC:\\n @INC\\n\";"); #ifndef SECURE_INTERNAL_GETENV !PL_tainting && #endif - (s = PerlEnv_getenv("PERL5OPT"))) { + (s = PerlEnv_getenv("PERL5OPT"))) + { while (isSPACE(*s)) s++; if (*s == '-' && *(s+1) == 'T') @@ -906,8 +1036,27 @@ print \" \\@INC:\\n @INC\\n\";"); validate_suid(validarg, scriptname,fdscript); - if (PL_doextract) +#if defined(SIGCHLD) || defined(SIGCLD) + { +#ifndef SIGCHLD +# define SIGCHLD SIGCLD +#endif + Sighandler_t sigstate = rsignal_state(SIGCHLD); + if (sigstate == SIG_IGN) { + if (ckWARN(WARN_SIGNAL)) + Perl_warner(aTHX_ WARN_SIGNAL, + "Can't ignore signal CHLD, forcing to default"); + (void)rsignal(SIGCHLD, (Sighandler_t)SIG_DFL); + } + } +#endif + + if (PL_doextract) { find_beginning(); + if (cddir && PerlDir_chdir(cddir) < 0) + Perl_croak(aTHX_ "Can't chdir to %s",cddir); + + } PL_main_cv = PL_compcv = (CV*)NEWSV(1104,0); sv_upgrade((SV *)PL_compcv, SVt_PVCV); @@ -969,7 +1118,7 @@ print \" \\@INC:\\n @INC\\n\";"); PL_origfilename); } } - PL_curcop->cop_line = 0; + CopLINE_set(PL_curcop, 0); PL_curstash = PL_defstash; PL_preprocess = FALSE; if (PL_e_script) { @@ -984,8 +1133,11 @@ print \" \\@INC:\\n @INC\\n\";"); if (PL_do_undump) my_unexec(); - if (isWARN_ONCE) + if (isWARN_ONCE) { + SAVECOPFILE(PL_curcop); + SAVECOPLINE(PL_curcop); gv_check(PL_defstash); + } LEAVE; FREETMPS; @@ -1006,6 +1158,7 @@ perl_run(pTHXx) dTHR; I32 oldscope; int ret; + dJMPENV; #ifdef USE_THREADS dTHX; #endif @@ -1013,7 +1166,7 @@ perl_run(pTHXx) oldscope = PL_scopestack_ix; redo_body: - CALLPROTECT(aTHX_ &ret, MEMBER_TO_FPTR(S_run_body), oldscope); + CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_run_body), oldscope); switch (ret) { case 1: cxstack_ix = -1; /* start context stack again */ @@ -1024,7 +1177,7 @@ perl_run(pTHXx) LEAVE; FREETMPS; PL_curstash = PL_defstash; - if (PL_endav) + if (PL_endav && !PL_minus_c) call_list(oldscope, PL_endav); #ifdef MYMALLOC if (PerlEnv_getenv("PERL_DEBUG_MSTATS")) @@ -1036,7 +1189,7 @@ perl_run(pTHXx) POPSTACK_TO(PL_mainstack); goto redo_body; } - PerlIO_printf(PerlIO_stderr(), "panic: restartop\n"); + PerlIO_printf(Perl_error_log, "panic: restartop\n"); FREETMPS; return 1; } @@ -1057,11 +1210,11 @@ S_run_body(pTHX_ va_list args) if (!PL_restartop) { DEBUG_x(dump_all()); DEBUG(PerlIO_printf(Perl_debug_log, "\nEXECUTING...\n\n")); - DEBUG_S(PerlIO_printf(Perl_debug_log, "main thread is 0x%lx\n", - (unsigned long) thr)); + DEBUG_S(PerlIO_printf(Perl_debug_log, "main thread is 0x%"UVxf"\n", + PTR2UV(thr))); if (PL_minus_c) { - PerlIO_printf(PerlIO_stderr(), "%s syntax OK\n", PL_origfilename); + PerlIO_printf(Perl_error_log, "%s syntax OK\n", PL_origfilename); my_exit(0); } if (PERLDB_SINGLE && PL_DBsingle) @@ -1207,6 +1360,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags) bool oldcatch = CATCH_GET; int ret; OP* oldop = PL_op; + dJMPENV; if (flags & G_DISCARD) { ENTER; @@ -1238,16 +1392,10 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags) PL_op->op_private |= OPpENTERSUB_DB; if (!(flags & G_EVAL)) { - /* G_NOCATCH is a hack for perl_vdie using this path to call - a __DIE__ handler */ - if (!(flags & G_NOCATCH)) { - CATCH_SET(TRUE); - } + CATCH_SET(TRUE); call_xbody((OP*)&myop, FALSE); retval = PL_stack_sp - (PL_stack_base + oldmark); - if (!(flags & G_NOCATCH)) { - CATCH_SET(FALSE); - } + CATCH_SET(oldcatch); } else { cLOGOP->op_other = PL_op; @@ -1274,7 +1422,8 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags) PL_markstack_ptr++; redo_body: - CALLPROTECT(aTHX_ &ret, MEMBER_TO_FPTR(S_call_body), (OP*)&myop, FALSE); + CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_call_body), + (OP*)&myop, FALSE); switch (ret) { case 0: retval = PL_stack_sp - (PL_stack_base + oldmark); @@ -1288,7 +1437,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags) /* my_exit() was called */ PL_curstash = PL_defstash; FREETMPS; - if (PL_statusvalue) + if (PL_statusvalue && !(PL_exit_flags & PERL_EXIT_EXPECTED)) Perl_croak(aTHX_ "Callback called exit"); my_exit_jump(); /* NOTREACHED */ @@ -1372,6 +1521,7 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags) I32 oldscope; int ret; OP* oldop = PL_op; + dJMPENV; if (flags & G_DISCARD) { ENTER; @@ -1396,7 +1546,8 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags) myop.op_flags |= OPf_SPECIAL; redo_body: - CALLPROTECT(aTHX_ &ret, MEMBER_TO_FPTR(S_call_body), (OP*)&myop, TRUE); + CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_call_body), + (OP*)&myop, TRUE); switch (ret) { case 0: retval = PL_stack_sp - (PL_stack_base + oldmark); @@ -1410,7 +1561,7 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags) /* my_exit() was called */ PL_curstash = PL_defstash; FREETMPS; - if (PL_statusvalue) + if (PL_statusvalue && !(PL_exit_flags & PERL_EXIT_EXPECTED)) Perl_croak(aTHX_ "Callback called exit"); my_exit_jump(); /* NOTREACHED */ @@ -1541,7 +1692,7 @@ Perl_moreswitches(pTHX_ char *s) case '0': { dTHR; - rschar = scan_oct(s, 4, &numlen); + rschar = (U32)scan_oct(s, 4, &numlen); SvREFCNT_dec(PL_nrs); if (rschar & ~((U8)~0)) PL_nrs = &PL_sv_undef; @@ -1626,14 +1777,23 @@ Perl_moreswitches(pTHX_ char *s) ++s; if (*s) { char *e, *p; - for (e = s; *e && !isSPACE(*e); e++) ; - p = savepvn(s, e-s); - incpush(p, TRUE); - Safefree(p); - s = e; + p = s; + /* ignore trailing spaces (possibly followed by other switches) */ + do { + for (e = p; *e && !isSPACE(*e); e++) ; + p = e; + while (isSPACE(*p)) + p++; + } while (*p && *p != '-'); + e = savepvn(s, e-s); + incpush(e, TRUE); + Safefree(e); + s = p; + if (*s == '-') + s++; } else - Perl_croak(aTHX_ "No space allowed after -I"); + Perl_croak(aTHX_ "No directory specified for -I"); return s; case 'l': PL_minus_l = TRUE; @@ -1643,7 +1803,7 @@ Perl_moreswitches(pTHX_ char *s) if (isDIGIT(*s)) { PL_ors = savepv("\n"); PL_orslen = 1; - *PL_ors = scan_oct(s, 3 + (*s == '0'), &numlen); + *PL_ors = (char)scan_oct(s, 3 + (*s == '0'), &numlen); s += numlen; } else { @@ -1686,7 +1846,7 @@ Perl_moreswitches(pTHX_ char *s) sv_catpv(sv, "})"); } s += strlen(s); - if (PL_preambleav == NULL) + if (!PL_preambleav) PL_preambleav = newAV(); av_push(PL_preambleav, sv); } @@ -1720,17 +1880,12 @@ Perl_moreswitches(pTHX_ char *s) s++; return s; case 'v': -#if defined(PERL_SUBVERSION) && PERL_SUBVERSION > 0 - printf("\nThis is perl, version %d.%03d_%02d built for %s", - PERL_REVISION, PERL_VERSION, PERL_SUBVERSION, ARCHNAME); -#else - printf("\nThis is perl, version %s built for %s", - PL_patchlevel, ARCHNAME); -#endif + printf("\nThis is perl, v%"UVuf".%"UVuf".%"UVuf" built for %s", + (UV)PERL_REVISION, (UV)PERL_VERSION, (UV)PERL_SUBVERSION, ARCHNAME); #if defined(LOCAL_PATCH_COUNT) if (LOCAL_PATCH_COUNT > 0) printf("\n(with %d registered patch%s, see perl -V for more detail)", - LOCAL_PATCH_COUNT, (LOCAL_PATCH_COUNT!=1) ? "es" : ""); + (int)LOCAL_PATCH_COUNT, (LOCAL_PATCH_COUNT!=1) ? "es" : ""); #endif printf("\n\nCopyright 1987-1999, Larry Wall\n"); @@ -1866,7 +2021,6 @@ S_init_interp(pTHX) PL_curcop = &PL_compiling;\ PL_curcopdb = NULL; \ PL_dbargs = 0; \ - PL_dlmax = 128; \ PL_dumpindent = 4; \ PL_laststatval = -1; \ PL_laststype = OP_STAT; \ @@ -1876,7 +2030,6 @@ S_init_interp(pTHX) PL_tmps_floor = -1; \ PL_tmps_ix = -1; \ PL_op_mask = NULL; \ - PL_dlmax = 128; \ PL_laststatval = -1; \ PL_laststype = OP_STAT; \ PL_mess_sv = Nullsv; \ @@ -1971,7 +2124,7 @@ S_init_main_stash(pTHX) sv_grow(ERRSV, 240); /* Preallocate - for immediate signals. */ sv_setpvn(ERRSV, "", 0); PL_curstash = PL_defstash; - PL_compiling.cop_stash = PL_defstash; + CopSTASH_set(&PL_compiling, PL_defstash); PL_debstash = GvHV(gv_fetchpv("DB::", GV_ADDMULTI, SVt_PVHV)); PL_globalstash = GvHV(gv_fetchpv("CORE::GLOBAL::", GV_ADDMULTI, SVt_PVHV)); /* We must init $/ before switches are processed. */ @@ -2006,7 +2159,7 @@ S_open_script(pTHX_ char *scriptname, bool dosearch, SV *sv, int *fdscript) } } - PL_curcop->cop_filegv = gv_fetchfile(PL_origfilename); + CopFILE_set(PL_curcop, PL_origfilename); if (strEQ(PL_origfilename,"-")) scriptname = ""; if (*fdscript >= 0) { @@ -2025,7 +2178,7 @@ S_open_script(pTHX_ char *scriptname, bool dosearch, SV *sv, int *fdscript) Perl_sv_catpvf(aTHX_ cpp, "%s/", BIN_EXP); sv_catpv(cpp, cpp_cfg); - sv_catpv(sv,"-I"); + sv_catpvn(sv, "-I", 2); sv_catpv(sv,PRIVLIB_EXP); #ifdef MSDOS @@ -2120,17 +2273,19 @@ sed %s -e \"/^[^#]/b\" \ #ifdef DOSUID #ifndef IAMSUID /* in case script is not readable before setuid */ if (PL_euid && - PerlLIO_stat(SvPVX(GvSV(PL_curcop->cop_filegv)),&PL_statbuf) >= 0 && + PerlLIO_stat(CopFILE(PL_curcop),&PL_statbuf) >= 0 && PL_statbuf.st_mode & (S_ISUID|S_ISGID)) { /* try again */ - PerlProc_execv(Perl_form(aTHX_ "%s/sperl%s", BIN_EXP, PL_patchlevel), PL_origargv); + PerlProc_execv(Perl_form(aTHX_ "%s/sperl"PERL_FS_VER_FMT, BIN_EXP, + (int)PERL_REVISION, (int)PERL_VERSION, + (int)PERL_SUBVERSION), PL_origargv); Perl_croak(aTHX_ "Can't do setuid\n"); } #endif #endif Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n", - SvPVX(GvSV(PL_curcop->cop_filegv)), Strerror(errno)); + CopFILE(PL_curcop), Strerror(errno)); } } @@ -2145,13 +2300,15 @@ sed %s -e \"/^[^#]/b\" \ STATIC int S_fd_on_nosuid_fs(pTHX_ int fd) { - int on_nosuid = 0; - int check_okay = 0; + int check_okay = 0; /* able to do all the required sys/libcalls */ + int on_nosuid = 0; /* the fd is on a nosuid fs */ /* - * Preferred order: fstatvfs(), fstatfs(), getmntent(). + * Preferred order: fstatvfs(), fstatfs(), ustat()+getmnt(), getmntent(). * fstatvfs() is UNIX98. - * fstatfs() is BSD. - * getmntent() is O(number-of-mounted-filesystems) and can hang. + * fstatfs() is 4.3 BSD. + * ustat()+getmnt() is pre-4.3 BSD. + * getmntent() is O(number-of-mounted-filesystems) and can hang on + * an irrelevant filesystem while trying to reach the right one. */ # ifdef HAS_FSTATVFS @@ -2159,24 +2316,45 @@ S_fd_on_nosuid_fs(pTHX_ int fd) check_okay = fstatvfs(fd, &stfs) == 0; on_nosuid = check_okay && (stfs.f_flag & ST_NOSUID); # else -# if defined(HAS_FSTATFS) && defined(HAS_STRUCT_STATFS_FLAGS) +# ifdef PERL_MOUNT_NOSUID +# if defined(HAS_FSTATFS) && \ + defined(HAS_STRUCT_STATFS) && \ + defined(HAS_STRUCT_STATFS_F_FLAGS) struct statfs stfs; check_okay = fstatfs(fd, &stfs) == 0; -# undef PERL_MOUNT_NOSUID -# if !defined(PERL_MOUNT_NOSUID) && defined(MNT_NOSUID) -# define PERL_MOUNT_NOSUID MNT_NOSUID -# endif -# if !defined(PERL_MOUNT_NOSUID) && defined(MS_NOSUID) -# define PERL_MOUNT_NOSUID MS_NOSUID -# endif -# if !defined(PERL_MOUNT_NOSUID) && defined(M_NOSUID) -# define PERL_MOUNT_NOSUID M_NOSUID -# endif -# ifdef PERL_MOUNT_NOSUID on_nosuid = check_okay && (stfs.f_flags & PERL_MOUNT_NOSUID); -# endif +# else +# if defined(HAS_FSTAT) && \ + defined(HAS_USTAT) && \ + defined(HAS_GETMNT) && \ + defined(HAS_STRUCT_FS_DATA) && \ + defined(NOSTAT_ONE) + struct stat fdst; + if (fstat(fd, &fdst) == 0) { + struct ustat us; + if (ustat(fdst.st_dev, &us) == 0) { + struct fs_data fsd; + /* NOSTAT_ONE here because we're not examining fields which + * vary between that case and STAT_ONE. */ + if (getmnt((int*)0, &fsd, (int)0, NOSTAT_ONE, us.f_fname) == 0) { + size_t cmplen = sizeof(us.f_fname); + if (sizeof(fsd.fd_req.path) < cmplen) + cmplen = sizeof(fsd.fd_req.path); + if (strnEQ(fsd.fd_req.path, us.f_fname, cmplen) && + fdst.st_dev == fsd.fd_req.dev) { + check_okay = 1; + on_nosuid = fsd.fd_req.flags & PERL_MOUNT_NOSUID; + } + } + } + } + } +# endif /* fstat+ustat+getmnt */ +# endif /* fstatfs */ # else -# if defined(HAS_GETMNTENT) && defined(HAS_HASMNTOPT) && defined(MNTOPT_NOSUID) +# if defined(HAS_GETMNTENT) && \ + defined(HAS_HASMNTOPT) && \ + defined(MNTOPT_NOSUID) FILE *mtab = fopen("/etc/mtab", "r"); struct mntent *entry; struct stat stb, fsb; @@ -2196,11 +2374,12 @@ S_fd_on_nosuid_fs(pTHX_ int fd) } if (mtab) fclose(mtab); -# endif /* mntent */ -# endif /* statfs */ +# endif /* getmntent+hasmntopt */ +# endif /* PERL_MOUNT_NOSUID: fstatfs or fstat+ustat+statfs */ # endif /* statvfs */ + if (!check_okay) - Perl_croak(aTHX_ "Can't check filesystem of script \"%s\"", PL_origfilename); + Perl_croak(aTHX_ "Can't check filesystem of script \"%s\" for nosuid", PL_origfilename); return on_nosuid; } #endif /* IAMSUID */ @@ -2250,7 +2429,7 @@ S_validate_suid(pTHX_ char *validarg, char *scriptname, int fdscript) * But I don't think it's too important. The manual lies when * it says access() is useful in setuid programs. */ - if (PerlLIO_access(SvPVX(GvSV(PL_curcop->cop_filegv)),1)) /*double check*/ + if (PerlLIO_access(CopFILE(PL_curcop),1)) /*double check*/ Perl_croak(aTHX_ "Permission denied"); #else /* If we can swap euid and uid, then we can determine access rights @@ -2271,7 +2450,7 @@ S_validate_suid(pTHX_ char *validarg, char *scriptname, int fdscript) #endif || PerlProc_getuid() != PL_euid || PerlProc_geteuid() != PL_uid) Perl_croak(aTHX_ "Can't swap uid and euid"); /* really paranoid */ - if (PerlLIO_stat(SvPVX(GvSV(PL_curcop->cop_filegv)),&tmpstatbuf) < 0) + if (PerlLIO_stat(CopFILE(PL_curcop),&tmpstatbuf) < 0) Perl_croak(aTHX_ "Permission denied"); /* testing full pathname here */ #if defined(IAMSUID) && !defined(NO_NOSUID_CHECK) if (fd_on_nosuid_fs(PerlIO_fileno(PL_rsfp))) @@ -2282,12 +2461,12 @@ S_validate_suid(pTHX_ char *validarg, char *scriptname, int fdscript) (void)PerlIO_close(PL_rsfp); if (PL_rsfp = PerlProc_popen("/bin/mail root","w")) { /* heh, heh */ PerlIO_printf(PL_rsfp, -"User %ld tried to run dev %ld ino %ld in place of dev %ld ino %ld!\n\ -(Filename of set-id script was %s, uid %ld gid %ld.)\n\nSincerely,\nperl\n", - (long)PL_uid,(long)tmpstatbuf.st_dev, (long)tmpstatbuf.st_ino, +"User %"Uid_t_f" tried to run dev %ld ino %ld in place of dev %ld ino %ld!\n\ +(Filename of set-id script was %s, uid %"Uid_t_f" gid %"Gid_t_f".)\n\nSincerely,\nperl\n", + PL_uid,(long)tmpstatbuf.st_dev, (long)tmpstatbuf.st_ino, (long)PL_statbuf.st_dev, (long)PL_statbuf.st_ino, - SvPVX(GvSV(PL_curcop->cop_filegv)), - (long)PL_statbuf.st_uid, (long)PL_statbuf.st_gid); + CopFILE(PL_curcop), + PL_statbuf.st_uid, PL_statbuf.st_gid); (void)PerlProc_pclose(PL_rsfp); } Perl_croak(aTHX_ "Permission denied\n"); @@ -2313,7 +2492,7 @@ S_validate_suid(pTHX_ char *validarg, char *scriptname, int fdscript) if (PL_statbuf.st_mode & S_IWOTH) Perl_croak(aTHX_ "Setuid/gid script is writable by world"); PL_doswitches = FALSE; /* -s is insecure in suid */ - PL_curcop->cop_line++; + CopLINE_inc(PL_curcop); if (sv_gets(PL_linestr, PL_rsfp, 0) == Nullch || strnNE(SvPV(PL_linestr,n_a),"#!",2) ) /* required even on Sys V */ Perl_croak(aTHX_ "No #! line"); @@ -2347,7 +2526,9 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n"); (void)PerlIO_close(PL_rsfp); #ifndef IAMSUID /* try again */ - PerlProc_execv(Perl_form(aTHX_ "%s/sperl%s", BIN_EXP, PL_patchlevel), PL_origargv); + PerlProc_execv(Perl_form(aTHX_ "%s/sperl"PERL_FS_VER_FMT, BIN_EXP, + (int)PERL_REVISION, (int)PERL_VERSION, + (int)PERL_SUBVERSION), PL_origargv); #endif Perl_croak(aTHX_ "Can't do setuid\n"); } @@ -2429,7 +2610,9 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n"); #if defined(HAS_FCNTL) && defined(F_SETFD) fcntl(PerlIO_fileno(PL_rsfp),F_SETFD,0); /* ensure no close-on-exec */ #endif - PerlProc_execv(Perl_form(aTHX_ "%s/perl%s", BIN_EXP, PL_patchlevel), PL_origargv);/* try again */ + PerlProc_execv(Perl_form(aTHX_ "%s/perl"PERL_FS_VER_FMT, BIN_EXP, + (int)PERL_REVISION, (int)PERL_VERSION, + (int)PERL_SUBVERSION), PL_origargv);/* try again */ Perl_croak(aTHX_ "Can't do setuid\n"); #endif /* IAMSUID */ #else /* !DOSUID */ @@ -2473,8 +2656,6 @@ S_find_beginning(pTHX) /*SUPPRESS 530*/ while (s = moreswitches(s)) ; } - if (PL_cddir && PerlDir_chdir(PL_cddir) < 0) - Perl_croak(aTHX_ "Can't chdir to %s",PL_cddir); } } } @@ -2554,7 +2735,7 @@ Perl_init_stacks(pTHX) PL_markstack_ptr = PL_markstack; PL_markstack_max = PL_markstack + REASONABLE(32); - SET_MARKBASE; + SET_MARK_OFFSET; New(54,PL_scopestack,REASONABLE(32),I32); PL_scopestack_ix = 0; @@ -2589,10 +2770,6 @@ S_nuke_stacks(pTHX) Safefree(PL_scopestack); Safefree(PL_savestack); Safefree(PL_retstack); - DEBUG( { - Safefree(PL_debname); - Safefree(PL_debdelim); - } ) } #ifndef PERL_OBJECT @@ -2638,9 +2815,9 @@ S_init_predump_symbols(pTHX) GvMULTI_on(tmpgv); GvIOp(tmpgv) = (IO*)SvREFCNT_inc(io); - othergv = gv_fetchpv("STDERR",TRUE, SVt_PVIO); - GvMULTI_on(othergv); - io = GvIOp(othergv); + PL_stderrgv = gv_fetchpv("STDERR",TRUE, SVt_PVIO); + GvMULTI_on(PL_stderrgv); + io = GvIOp(PL_stderrgv); IoOFP(io) = IoIFP(io) = PerlIO_stderr(); tmpgv = gv_fetchpv("stderr",TRUE, SVt_PV); GvMULTI_on(tmpgv); @@ -2665,7 +2842,7 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register for (; argc > 0 && **argv == '-'; argc--,argv++) { if (!argv[0][1]) break; - if (argv[0][1] == '-') { + if (argv[0][1] == '-' && !argv[0][2]) { argc--,argv++; break; } @@ -2691,7 +2868,11 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register magicname("0", "0", 1); } if (tmpgv = gv_fetchpv("\030",TRUE, SVt_PV)) +#ifdef OS2 + sv_setpv(GvSV(tmpgv), os2_execname()); +#else sv_setpv(GvSV(tmpgv),PL_origargv[0]); +#endif if (PL_argvgv = gv_fetchpv("ARGV",TRUE, SVt_PVAV)) { GvMULTI_on(PL_argvgv); (void)gv_AVadd(PL_argvgv); @@ -2737,7 +2918,7 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register } TAINT_NOT; if (tmpgv = gv_fetchpv("$",TRUE, SVt_PV)) - sv_setiv(GvSV(tmpgv), (IV)getpid()); + sv_setiv(GvSV(tmpgv), (IV)PerlProc_getpid()); } STATIC void @@ -2828,17 +3009,6 @@ S_incpush(pTHX_ char *p, int addsubdirs) if (addsubdirs) { subdir = sv_newmortal(); - if (!PL_archpat_auto) { - STRLEN len = (sizeof(ARCHNAME) + strlen(PL_patchlevel) - + sizeof("//auto")); - New(55, PL_archpat_auto, len, char); - sprintf(PL_archpat_auto, "/%s/%s/auto", ARCHNAME, PL_patchlevel); -#ifdef VMS - for (len = sizeof(ARCHNAME) + 2; - PL_archpat_auto[len] != '\0' && PL_archpat_auto[len] != '/'; len++) - if (PL_archpat_auto[len] == '.') PL_archpat_auto[len] = '_'; -#endif - } } /* Break at all separators */ @@ -2879,21 +3049,21 @@ S_incpush(pTHX_ char *p, int addsubdirs) sv_usepvn(libdir,unix,len); } else - PerlIO_printf(PerlIO_stderr(), + PerlIO_printf(Perl_error_log, "Failed to unixify @INC element \"%s\"\n", SvPV(libdir,len)); #endif /* .../archname/version if -d .../archname/version/auto */ - sv_setsv(subdir, libdir); - sv_catpv(subdir, PL_archpat_auto); + Perl_sv_setpvf(aTHX_ subdir, "%_/%s/"PERL_FS_VER_FMT"/auto", libdir, + ARCHNAME, (int)PERL_REVISION, + (int)PERL_VERSION, (int)PERL_SUBVERSION); if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode)) av_push(GvAVn(PL_incgv), newSVpvn(SvPVX(subdir), SvCUR(subdir) - sizeof "auto")); /* .../archname if -d .../archname/auto */ - sv_insert(subdir, SvCUR(libdir) + sizeof(ARCHNAME), - strlen(PL_patchlevel) + 1, "", 0); + Perl_sv_setpvf(aTHX_ subdir, "%_/%s/auto", libdir, ARCHNAME); if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 && S_ISDIR(tmpstatbuf.st_mode)) av_push(GvAVn(PL_incgv), @@ -2921,7 +3091,6 @@ S_init_main_thread(pTHX) thr->threadsv = newAV(); /* thr->threadsvp is set when find_threadsv is called */ thr->specific = newAV(); - thr->errhv = newHV(); thr->flags = THRf_R_JOINABLE; MUTEX_INIT(&thr->mutex); /* Handcraft thrsv similarly to mess_sv */ @@ -2987,29 +3156,36 @@ void Perl_call_list(pTHX_ I32 oldscope, AV *paramList) { dTHR; - SV *atsv = ERRSV; - line_t oldline = PL_curcop->cop_line; + SV *atsv; + line_t oldline = CopLINE(PL_curcop); CV *cv; STRLEN len; int ret; + dJMPENV; while (AvFILL(paramList) >= 0) { cv = (CV*)av_shift(paramList); SAVEFREESV(cv); - CALLPROTECT(aTHX_ &ret, MEMBER_TO_FPTR(S_call_list_body), cv); + CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_call_list_body), cv); switch (ret) { case 0: + atsv = ERRSV; (void)SvPV(atsv, len); if (len) { + STRLEN n_a; PL_curcop = &PL_compiling; - PL_curcop->cop_line = oldline; + CopLINE_set(PL_curcop, oldline); if (paramList == PL_beginav) sv_catpv(atsv, "BEGIN failed--compilation aborted"); else - sv_catpv(atsv, "END failed--cleanup aborted"); + Perl_sv_catpvf(aTHX_ atsv, + "%s failed--call queue aborted", + paramList == PL_stopav ? "STOP" + : paramList == PL_initav ? "INIT" + : "END"); while (PL_scopestack_ix > oldscope) LEAVE; - Perl_croak(aTHX_ "%s", SvPVX(atsv)); + Perl_croak(aTHX_ "%s", SvPVx(atsv, n_a)); } break; case 1: @@ -3021,25 +3197,26 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList) LEAVE; FREETMPS; PL_curstash = PL_defstash; - if (PL_endav) - call_list(oldscope, PL_endav); PL_curcop = &PL_compiling; - PL_curcop->cop_line = oldline; - if (PL_statusvalue) { + CopLINE_set(PL_curcop, oldline); + if (PL_statusvalue && !(PL_exit_flags & PERL_EXIT_EXPECTED)) { if (paramList == PL_beginav) Perl_croak(aTHX_ "BEGIN failed--compilation aborted"); else - Perl_croak(aTHX_ "END failed--cleanup aborted"); + Perl_croak(aTHX_ "%s failed--call queue aborted", + paramList == PL_stopav ? "STOP" + : paramList == PL_initav ? "INIT" + : "END"); } my_exit_jump(); /* NOTREACHED */ case 3: if (PL_restartop) { PL_curcop = &PL_compiling; - PL_curcop->cop_line = oldline; + CopLINE_set(PL_curcop, oldline); JMPENV_JUMP(3); } - PerlIO_printf(PerlIO_stderr(), "panic: restartop\n"); + PerlIO_printf(Perl_error_log, "panic: restartop\n"); FREETMPS; break; } @@ -3132,7 +3309,6 @@ S_my_exit_jump(pTHX) } #ifdef PERL_OBJECT -#define NO_XSLOCKS #include "XSUB.h" #endif @@ -3151,5 +3327,3 @@ read_e_script(pTHXo_ int idx, SV *buf_sv, int maxlen) sv_chop(PL_e_script, nl); return 1; } - - diff --git a/perl.h b/perl.h index 48765ee..30130fd 100644 --- a/perl.h +++ b/perl.h @@ -23,6 +23,17 @@ #define VOIDUSED 1 #include "config.h" +#if defined(USE_ITHREADS) && defined(USE_5005THREADS) +# include "error: USE_ITHREADS and USE_5005THREADS are incompatible" +#endif + +/* XXX This next guard can disappear if the sources are revised + to use USE_5005THREADS throughout. -- A.D 1/6/2000 +*/ +#if defined(USE_ITHREADS) && defined(USE_THREADS) +# include "error: USE_ITHREADS and USE_THREADS are incompatible" +#endif + /* See L for detailed notes on * PERL_IMPLICIT_CONTEXT and PERL_IMPLICIT_SYS */ @@ -30,22 +41,19 @@ # ifndef PERL_IMPLICIT_CONTEXT # define PERL_IMPLICIT_CONTEXT # endif -# ifndef PERL_IMPLICIT_SYS -/*# define PERL_IMPLICIT_SYS*/ /* XXX not done yet */ -# endif #endif #if defined(MULTIPLICITY) # ifndef PERL_IMPLICIT_CONTEXT # define PERL_IMPLICIT_CONTEXT # endif -# ifndef PERL_IMPLICIT_SYS -/*# define PERL_IMPLICIT_SYS*/ /* XXX not done yet */ -# endif #endif #ifdef PERL_CAPI # undef PERL_OBJECT +# ifndef MULTIPLICITY +# define MULTIPLICITY +# endif # ifndef PERL_IMPLICIT_CONTEXT # define PERL_IMPLICIT_CONTEXT # endif @@ -63,6 +71,10 @@ # endif #endif +#if defined(USE_ITHREADS) && !defined(MULTIPLICITY) && !defined(PERL_OBJECT) +# include "error: USE_ITHREADS must be built with MULTIPLICITY" +#endif + #ifdef PERL_OBJECT /* PERL_OBJECT explained - DickH and DougL @ ActiveState.com @@ -86,8 +98,8 @@ the perl interpreter. | Perl Host | +-----------+ ^ - | - v + | + v +-----------+ +-----------+ | Perl Core |<->| Extension | +-----------+ +-----------+ ... @@ -142,7 +154,7 @@ class CPerlObj; #define STATIC #define CPERLscope(x) CPerlObj::x -#define CALL_FPTR(fptr) (this->*fptr) +#define CALL_FPTR(fptr) (aTHXo->*fptr) #define pTHXo CPerlObj *pPerl #define pTHXo_ pTHXo, @@ -389,7 +401,8 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); /* HP-UX 10.X CMA (Common Multithreaded Architecure) insists that pthread.h must be included before all other header files. */ -#if defined(USE_THREADS) && defined(PTHREAD_H_FIRST) && defined(I_PTHREAD) +#if (defined(USE_THREADS) || defined(USE_ITHREADS)) \ + && defined(PTHREAD_H_FIRST) && defined(I_PTHREAD) # include #endif @@ -466,7 +479,7 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); # include #endif -#if !defined(PERL_FOR_X2P) && !defined(PERL_OBJECT) +#if !defined(PERL_FOR_X2P) && !defined(WIN32) # include "embed.h" #endif @@ -684,16 +697,16 @@ Free_t Perl_mfree (Malloc_t where); #ifdef USE_THREADS # define ERRSV (thr->errsv) -# define ERRHV (thr->errhv) # define DEFSV THREADSV(0) # define SAVE_DEFSV save_threadsv(0) #else # define ERRSV GvSV(PL_errgv) -# define ERRHV GvHV(PL_errgv) # define DEFSV GvSV(PL_defgv) # define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv)) #endif /* USE_THREADS */ +#define ERRHV GvHV(PL_errgv) /* XXX unused, here for compatibility */ + #ifndef errno extern int errno; /* ANSI allows errno to be an lvalue expr. * For example in multithreaded environments @@ -887,114 +900,17 @@ Free_t Perl_mfree (Malloc_t where); #undef UV #endif -#ifdef I_INTTYPES -#include -#endif - /* The IV type is supposed to be long enough to hold any integral value or a pointer. --Andy Dougherty August 1996 */ -/* We should be able to get Quad_t in most systems: - all of int64_t, long long, long, int, will work. - - Beware of LP32 systems (ILP32, ILP32LL64). Such systems have been - used to sizeof(long) == sizeof(foo*). This is a bad assumption - because then IV/UV have been 32 bits, too. Which, in turn means - that even if the system has quads (e.g. long long), IV cannot be a - quad. Introducing a 64-bit IV (because of long long existing) - will introduce binary incompatibility. - - Summary: a long long system needs to add -DUSE_LONG_LONG to $ccflags - to get quads -- and if its pointers are still 32 bits, this will break - binary compatibility. Casting an IV (a long long) to a pointer will - truncate half of the IV away. Most systems can just use - Configure -Duse64bits to get the -DUSE_LONG_LONG added either by - their hints files, or directly by Configure if they are using gcc. - - --jhi September 1999 */ - -#if INTSIZE == 4 && LONGSIZE == 4 && PTRSIZE == 4 -# define PERL_ILP32 -# if defined(HAS_LONG_LONG) && LONGLONGSIZE == 8 -# define PERL_ILP32LL64 -# endif -#endif - -#if LONGSIZE == 8 && PTRSIZE == 8 -# define PERL_LP64 -# if INTSIZE == 8 -# define PERL_ILP64 -# endif -#endif - -#ifndef Quad_t -# if LONGSIZE == 8 -# define Quad_t long -# define Uquad_t unsigned long -# define PERL_QUAD_IS_LONG -# endif -#endif - -#ifndef Quad_t -# if INTSIZE == 8 -# define Quad_t int -# define Uquad_t unsigned int -# define PERL_QUAD_IS_INT -# endif -#endif - -#ifndef Quad_t -# ifdef USE_LONG_LONG /* See above note about LP32. --jhi */ -# if defined(HAS_LONG_LONG) && LONGLONGSIZE == 8 -# define Quad_t long long -# define Uquad_t unsigned long long -# define PERL_QUAD_IS_LONG_LONG -# endif -# endif -#endif - -#ifndef Quad_t -# ifdef HAS_INT64_T -# define Quad_t int64_t -# define Uquad_t uint64_t -# define PERL_QUAD_IS_INT64_T -# endif -#endif - -#ifdef Quad_t -# define HAS_QUAD -# ifndef Uquad_t - /* Note that if your Quad_t is a typedef (not a #define) you *MUST* - * have defined by now Uquad_t yourself because 'unsigned type' - * is illegal. */ -# define Uquad_t unsigned Quad_t -# endif -#endif +typedef IVTYPE IV; +typedef UVTYPE UV; #if defined(USE_64_BITS) && defined(HAS_QUAD) -# ifdef PERL_QUAD_IS_LONG /* LP64 */ - typedef long IV; - typedef unsigned long UV; -# else -# ifdef PERL_QUAD_IS_INT /* ILP64 */ - typedef int IV; - typedef unsigned int UV; -# else -# ifdef PERL_QUAD_IS_LONG_LONG /* LL64 */ - typedef long long IV; - typedef unsigned long long UV; -# else -# ifdef PERL_QUAD_IS_INT64_T /* C9X */ - typedef int64_t IV; - typedef uint64_t UV; -# endif -# endif -# endif -# endif -# if defined(PERL_QUAD_IS_INT64_T) && defined(INT64_MAX) +# if QUADKIND == QUAD_IS_INT64_T && defined(INT64_MAX) # define IV_MAX INT64_MAX # define IV_MIN INT64_MIN # define UV_MAX UINT64_MAX @@ -1008,14 +924,10 @@ Free_t Perl_mfree (Malloc_t where); # define UV_MAX PERL_UQUAD_MAX # define UV_MIN PERL_UQUAD_MIN # endif -# define IVSIZE 8 -# define UVSIZE 8 # define IV_IS_QUAD # define UV_IS_QUAD #else - typedef long IV; - typedef unsigned long UV; -# if defined(INT32_MAX) && LONGSIZE == 4 +# if defined(INT32_MAX) && IVSIZE == 4 # define IV_MAX INT32_MAX # define IV_MIN INT32_MIN # ifndef UINT32_MAX_BROKEN /* e.g. HP-UX with gcc messes this up */ @@ -1033,16 +945,19 @@ Free_t Perl_mfree (Malloc_t where); # define UV_MAX PERL_ULONG_MAX # define UV_MIN PERL_ULONG_MIN # endif -# if LONGSIZE == 8 +# if IVSIZE == 8 # define IV_IS_QUAD # define UV_IS_QUAD +# ifndef HAS_QUAD +# define HAS_QUAD +# endif # else # undef IV_IS_QUAD # undef UV_IS_QUAD +# undef HAS_QUAD # endif -# define UVSIZE LONGSIZE -# define IVSIZE LONGSIZE #endif + #define IV_DIG (BIT_DIGITS(IVSIZE * 8)) #define UV_DIG (BIT_DIGITS(UVSIZE * 8)) @@ -1073,9 +988,7 @@ Free_t Perl_mfree (Malloc_t where); #define PTR2NV(p) NUM2PTR(NV,p) #ifdef USE_LONG_DOUBLE -# if defined(HAS_LONG_DOUBLE) && (LONG_DOUBLESIZE > DOUBLESIZE) -# define LDoub_t long double -# else +# if !(defined(HAS_LONG_DOUBLE) && (LONG_DOUBLESIZE > DOUBLESIZE)) # undef USE_LONG_DOUBLE /* Ouch! */ # endif #endif @@ -1119,46 +1032,49 @@ Free_t Perl_mfree (Malloc_t where); default value for printing floating point numbers in Gconvert. (see config.h) */ -#ifdef I_LIMITS -#include -#endif -#ifdef I_FLOAT -#include -#endif -#ifndef HAS_LDBL_DIG -#if LONG_DOUBLESIZE == 10 -#define LDBL_DIG 18 /* assume IEEE */ -#else -#if LONG_DOUBLESIZE == 16 -#define LDBL_DIG 33 /* assume IEEE */ -#else -#if LONG_DOUBLESIZE == DOUBLESIZE -#define LDBL_DIG DBL_DIG /* bummer */ -#endif -#endif -#endif -#endif +# ifdef I_LIMITS +# include +# endif +# ifdef I_FLOAT +# include +# endif +# ifndef HAS_LDBL_DIG +# if LONG_DOUBLESIZE == 10 +# define LDBL_DIG 18 /* assume IEEE */ +# else +# if LONG_DOUBLESIZE == 12 +# define LDBL_DIG 18 /* gcc? */ +# else +# if LONG_DOUBLESIZE == 16 +# define LDBL_DIG 33 /* assume IEEE */ +# else +# if LONG_DOUBLESIZE == DOUBLESIZE +# define LDBL_DIG DBL_DIG /* bummer */ +# endif +# endif +# endif +# endif +# endif #endif +typedef NVTYPE NV; + #ifdef USE_LONG_DOUBLE -# define HAS_LDOUB - typedef LDoub_t NV; -# define NVSIZE LONG_DOUBLESIZE # define NV_DIG LDBL_DIG -# define Perl_modf modfl -# define Perl_frexp frexpl -# define Perl_cos cosl -# define Perl_sin sinl -# define Perl_sqrt sqrtl -# define Perl_exp expl -# define Perl_log logl -# define Perl_atan2 atan2l -# define Perl_pow powl -# define Perl_floor floorl -# define Perl_fmod fmodl +# ifdef HAS_SQRTL +# define Perl_modf modfl +# define Perl_frexp frexpl +# define Perl_cos cosl +# define Perl_sin sinl +# define Perl_sqrt sqrtl +# define Perl_exp expl +# define Perl_log logl +# define Perl_atan2 atan2l +# define Perl_pow powl +# define Perl_floor floorl +# define Perl_fmod fmodl +# endif #else - typedef double NV; -# define NVSIZE DOUBLESIZE # define NV_DIG DBL_DIG # define Perl_modf modf # define Perl_frexp frexp @@ -1173,10 +1089,16 @@ Free_t Perl_mfree (Malloc_t where); # define Perl_fmod fmod #endif -#if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && defined(HAS_ATOLF) -# define Perl_atof atolf -#else -# define Perl_atof atof +#if !defined(Perl_atof) && defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) +# if !defined(Perl_atof) && defined(HAS_STRTOLD) +# define Perl_atof(s) strtold(s, (char**)NULL) +# endif +# if !defined(Perl_atof) && defined(HAS_ATOLF) +# define Perl_atof atolf +# endif +#endif +#if !defined(Perl_atof) +# define Perl_atof atof /* we assume atof being available anywhere */ #endif /* Previously these definitions used hardcoded figures. @@ -1348,7 +1270,7 @@ Free_t Perl_mfree (Malloc_t where); # endif #endif -#ifdef HAS_QUAD +#ifdef UV_IS_QUAD # ifdef UQUAD_MAX # define PERL_UQUAD_MAX ((UV)UQUAD_MAX) @@ -1382,15 +1304,11 @@ typedef struct listop LISTOP; typedef struct logop LOGOP; typedef struct pmop PMOP; typedef struct svop SVOP; -typedef struct gvop GVOP; +typedef struct padop PADOP; typedef struct pvop PVOP; typedef struct loop LOOP; -typedef struct Outrec Outrec; typedef struct interpreter PerlInterpreter; -#ifndef __BORLANDC__ -typedef struct ff FF; /* XXX not defined anywhere, should go? */ -#endif typedef struct sv SV; typedef struct av AV; typedef struct hv HV; @@ -1419,30 +1337,38 @@ typedef struct xpvfm XPVFM; typedef struct xpvio XPVIO; typedef struct mgvtbl MGVTBL; typedef union any ANY; +typedef struct ptr_tbl_ent PTR_TBL_ENT_t; +typedef struct ptr_tbl PTR_TBL_t; #include "handy.h" -#if defined(USE_LARGE_FILES) -# define USE_64_BIT_RAWIO /* Explicit */ -# define USE_64_BIT_STDIO +#ifndef NO_LARGE_FILES +# define USE_LARGE_FILES /* If available. */ #endif -#if LSEEKSIZE == 8 && !defined(USE_64_BIT_RAWIO) -# define USE_64_BIT_RAWIO /* Implicit */ +#if defined(USE_LARGE_FILES) && !defined(NO_64_BIT_RAWIO) +# define USE_64_BIT_RAWIO /* explicit */ +# if LSEEKSIZE == 8 && !defined(USE_64_BIT_RAWIO) +# define USE_64_BIT_RAWIO /* implicit */ +# endif #endif -/* Do we need FSEEKSIZE? */ +/* Notice the use of HAS_FSEEKO: now we are obligated to always use + * fseeko/ftello if possible. Don't go #defining ftell to ftello yourself, + * however, because operating systems like to do that themself. */ +#ifndef FSEEKSIZE +# ifdef HAS_FSEEKO +# define FSEEKSIZE LSEEKSIZE +# else +# define FSEEKSIZE LONGSIZE +# endif +#endif -/* I couldn't find any -Ddefine or -flags in IRIX 6.5 that would - * have done the necessary symbol renaming using cpp. --jhi */ -#ifdef __sgi -#define USE_FOPEN64 -#define USE_FSEEK64 -#define USE_FTELL64 -#define USE_FSETPOS64 -#define USE_FGETPOS64 -#define USE_TMPFILE64 -#define USE_FREOPEN64 +#if defined(USE_LARGE_FILES) && !defined(NO_64_BIT_STDIO) +# define USE_64_BIT_STDIO /* explicit */ +# if FSEEKSIZE == 8 && !defined(USE_64_BIT_STDIO) +# define USE_64_BIT_STDIO /* implicit */ +# endif #endif #ifdef USE_64_BIT_RAWIO @@ -1460,9 +1386,10 @@ typedef union any ANY; # endif # if defined(USE_LSEEK64) # define lseek lseek64 -# endif -# if defined(USE_LLSEEK) -# define lseek llseek +# else +# if defined(USE_LLSEEK) +# define lseek llseek +# endif # endif # if defined(USE_STAT64) # define stat stat64 @@ -1502,10 +1429,10 @@ typedef union any ANY; # define fopen fopen64 # endif # if defined(USE_FSEEK64) -# define fseek fseek64 +# define fseek fseek64 /* don't do fseeko here, see perlio.c */ # endif # if defined(USE_FTELL64) -# define ftell ftell64 +# define ftell ftell64 /* don't do ftello here, see perlio.c */ # endif # if defined(USE_FSETPOS64) # define fsetpos fsetpos64 @@ -1551,7 +1478,11 @@ typedef union any ANY; # if defined(EPOC) # include "epocish.h" # else -# include "unixish.h" +# if defined(MACOS_TRADITIONAL) +# include "macos/macish.h" +# else +# include "unixish.h" +# endif # endif # endif # endif @@ -1559,6 +1490,10 @@ typedef union any ANY; # endif #endif +#ifndef PERL_SYS_INIT3 +# define PERL_SYS_INIT3(argvp,argcp,envp) PERL_SYS_INIT(argvp,argcp) +#endif + #ifndef MAXPATHLEN # ifdef PATH_MAX # ifdef _POSIX_PATH_MAX @@ -1588,11 +1523,12 @@ typedef union any ANY; * May make sense to have threads after "*ish.h" anyway */ -#ifdef USE_THREADS +#if defined(USE_THREADS) || defined(USE_ITHREADS) +# if defined(USE_THREADS) /* pending resolution of licensing issues, we avoid the erstwhile * atomic.h everywhere */ # define EMULATE_ATOMIC_REFCOUNTS - +# endif # ifdef FAKE_THREADS # include "fakethr.h" # else @@ -1623,10 +1559,10 @@ typedef pthread_key_t perl_key; # endif /* OS2 */ # endif /* WIN32 */ # endif /* FAKE_THREADS */ -#endif /* USE_THREADS */ +#endif /* USE_THREADS || USE_ITHREADS */ #ifdef WIN32 -#include "win32.h" +# include "win32.h" #endif #ifdef VMS @@ -1678,13 +1614,21 @@ typedef pthread_key_t perl_key; # define STATUS_ALL_FAILURE (PL_statusvalue = 1) #endif +/* flags in PL_exit_flags for nature of exit() */ +#define PERL_EXIT_EXPECTED 0x01 + #ifndef MEMBER_TO_FPTR -#define MEMBER_TO_FPTR(name) name +# define MEMBER_TO_FPTR(name) name +#endif + +/* format to use for version numbers in file/directory names */ +/* XXX move to Configure? */ +#ifndef PERL_FS_VER_FMT +# define PERL_FS_VER_FMT "%d.%d.%d" #endif /* This defines a way to flush all output buffers. This may be a * performance issue, so we allow people to disable it. - * XXX the default needs a Configure test, as it may not work everywhere. */ #ifndef PERL_FLUSHALL_FOR_CHILD # if defined(FFLUSH_NULL) || defined(USE_SFIO) @@ -1698,6 +1642,10 @@ typedef pthread_key_t perl_key; # endif #endif +#ifndef PERL_WAIT_FOR_CHILDREN +# define PERL_WAIT_FOR_CHILDREN NOOP +#endif + /* the traditional thread-unsafe notion of "current interpreter". * XXX todo: a thread-safe version that fetches it from TLS (akin to THR) * needs to be defined elsewhere (conditional on pthread_getspecific() @@ -1766,7 +1714,8 @@ union any { I32 any_i32; IV any_iv; long any_long; - void (*any_dptr) (pTHXo_ void*); + void (*any_dptr) (void*); + void (*any_dxptr) (pTHXo_ void*); }; #endif @@ -1827,9 +1776,22 @@ struct _sublex_info { typedef struct magic_state MGS; /* struct magic_state defined in mg.c */ struct scan_data_t; /* Used in S_* functions in regcomp.c */ +struct regnode_charclass_class; /* Used in S_* functions in regcomp.c */ typedef I32 CHECKPOINT; +struct ptr_tbl_ent { + struct ptr_tbl_ent* next; + void* oldval; + void* newval; +}; + +struct ptr_tbl { + struct ptr_tbl_ent** tbl_ary; + UV tbl_max; + UV tbl_items; +}; + #if defined(iAPX286) || defined(M_I286) || defined(I80286) # define I286 #endif @@ -1912,45 +1874,15 @@ typedef I32 CHECKPOINT; #define NV_WITHIN_IV(nv) (I_V(nv) >= IV_MIN && I_V(nv) <= IV_MAX) #define NV_WITHIN_UV(nv) ((nv)>=0.0 && U_V(nv) >= UV_MIN && U_V(nv) <= UV_MAX) -/* Believe. */ -#define IV_FITS_IN_NV -/* Doubt. */ -#if defined(USE_LONG_DOUBLE) && \ - defined(LDBL_MANT_DIG) && IV_DIG >= LDBL_MANT_DIG -# undef IV_FITS_IN_NV -#else -# if defined(DBL_MANT_DIG) && IV_DIG >= DBL_MANT_DIG -# undef IV_FITS_IN_NV -# else -# if IV_DIG >= NV_DIG -# undef IV_FITS_IN_NV -# else -# if IVSIZE >= NVSIZE -# undef IV_FITS_IN_NV -# endif -# endif -# endif -#endif - /* Used with UV/IV arguments: */ /* XXXX: need to speed it up */ #define CLUMP_2UV(iv) ((iv) < 0 ? 0 : (UV)(iv)) #define CLUMP_2IV(uv) ((uv) > (UV)IV_MAX ? IV_MAX : (IV)(uv)) -struct Outrec { - I32 o_lines; - char *o_str; - U32 o_len; -}; - #ifndef MAXSYSFD # define MAXSYSFD 2 #endif -#ifndef TMPPATH -# define TMPPATH "/tmp/perl-eXXXXXX" -#endif - #ifndef __cplusplus Uid_t getuid (void); Uid_t geteuid (void); @@ -1959,7 +1891,14 @@ Gid_t getegid (void); #endif #ifndef Perl_debug_log -#define Perl_debug_log PerlIO_stderr() +# define Perl_debug_log PerlIO_stderr() +#endif + +#ifndef Perl_error_log +# define Perl_error_log (PL_stderrgv \ + && IoOFP(GvIOp(PL_stderrgv)) \ + ? IoOFP(GvIOp(PL_stderrgv)) \ + : PerlIO_stderr()) #endif #ifdef DEBUGGING @@ -2077,9 +2016,9 @@ END_EXTERN_C # if defined(NeXT) || defined(__NeXT__) /* or whatever catches all NeXTs */ char *crypt (); /* Maybe more hosts will need the unprototyped version */ # else -# if !defined(WIN32) || !defined(HAVE_DES_FCRYPT) +# if !defined(WIN32) char *crypt (const char*, const char*); -# endif /* !WIN32 && !HAVE_CRYPT_SOURCE */ +# endif /* !WIN32 */ # endif /* !NeXT && !__NeXT__ */ # ifndef DONT_DECLARE_STD # ifndef getenv @@ -2112,7 +2051,7 @@ I32 unlnk (char*); # endif #endif -typedef Signal_t (*Sighandler_t) (int); +/* Sighandler_t defined in iperlsys.h */ #ifdef HAS_SIGACTION typedef struct sigaction Sigsave_t; @@ -2193,7 +2132,7 @@ START_EXTERN_C /* handy constants */ EXTCONST char PL_warn_uninit[] - INIT("Use of uninitialized value"); + INIT("Use of uninitialized value%s%s"); EXTCONST char PL_warn_nosemi[] INIT("Semicolon seems to be missing"); EXTCONST char PL_warn_reserved[] @@ -2232,13 +2171,9 @@ EXTCONST char PL_uuemap[65] #ifdef DOINIT EXT char *PL_sig_name[] = { SIG_NAME }; EXT int PL_sig_num[] = { SIG_NUM }; -EXT SV * PL_psig_ptr[sizeof(PL_sig_num)/sizeof(*PL_sig_num)]; -EXT SV * PL_psig_name[sizeof(PL_sig_num)/sizeof(*PL_sig_num)]; #else EXT char *PL_sig_name[]; EXT int PL_sig_num[]; -EXT SV * PL_psig_ptr[]; -EXT SV * PL_psig_name[]; #endif /* fast case folding tables */ @@ -2513,7 +2448,7 @@ enum { /* pass one of these to get_vtbl */ #define HINT_STRICT_REFS 0x00000002 /* #define HINT_notused4 0x00000004 */ #define HINT_UTF8 0x00000008 -/* #define HINT_notused10 0x00000010 */ +#define HINT_BYTE 0x00000010 /* Note: 20,40,80 used for NATIVE_HINTS */ #define HINT_BLOCK_SCOPE 0x00000100 @@ -2555,6 +2490,7 @@ typedef void (CPERLscope(*regfree_t)) (pTHX_ struct regexp* r); int Perl_yylex(pTHX_ YYSTYPE *lvalp, int *lcharp); #endif +typedef void (*DESTRUCTORFUNC_NOCONTEXT_t) (void*); typedef void (*DESTRUCTORFUNC_t) (pTHXo_ void*); typedef void (*SVFUNC_t) (pTHXo_ SV*); typedef I32 (*SVCOMPARE_t) (pTHXo_ SV*, SV*); @@ -2574,44 +2510,25 @@ typedef struct exitlistentry { void *ptr; } PerlExitListEntry; -#ifdef PERL_OBJECT -#undef perl_alloc -#define perl_alloc Perl_alloc -CPerlObj* Perl_alloc (IPerlMem*, IPerlEnv*, IPerlStdIO*, IPerlLIO*, IPerlDir*, IPerlSock*, IPerlProc*); - -#undef EXT -#define EXT -#undef EXTCONST -#define EXTCONST -#undef INIT -#define INIT(x) - -class CPerlObj { -public: - CPerlObj(IPerlMem*, IPerlEnv*, IPerlStdIO*, IPerlLIO*, IPerlDir*, IPerlSock*, IPerlProc*); - void Init(void); - void* operator new(size_t nSize, IPerlMem *pvtbl); - static void operator delete(void* pPerl, IPerlMem *pvtbl); -#endif /* PERL_OBJECT */ - #ifdef PERL_GLOBAL_STRUCT struct perl_vars { -#include "perlvars.h" +# include "perlvars.h" }; -#ifdef PERL_CORE +# ifdef PERL_CORE EXT struct perl_vars PL_Vars; EXT struct perl_vars *PL_VarsPtr INIT(&PL_Vars); -#else /* PERL_CORE */ -#if !defined(__GNUC__) || !defined(WIN32) +# else /* PERL_CORE */ +# if !defined(__GNUC__) || !defined(WIN32) EXT -#endif /* WIN32 */ +# endif /* WIN32 */ struct perl_vars *PL_VarsPtr; -#define PL_Vars (*((PL_VarsPtr) ? PL_VarsPtr : (PL_VarsPtr = Perl_GetVars()))) -#endif /* PERL_CORE */ +# define PL_Vars (*((PL_VarsPtr) \ + ? PL_VarsPtr : (PL_VarsPtr = Perl_GetVars(aTHX)))) +# endif /* PERL_CORE */ #endif /* PERL_GLOBAL_STRUCT */ -#ifdef MULTIPLICITY +#if defined(MULTIPLICITY) || defined(PERL_OBJECT) /* If we have multiple interpreters define a struct holding variables which must be per-interpreter If we don't have threads anything that would have @@ -2619,17 +2536,22 @@ struct perl_vars *PL_VarsPtr; */ struct interpreter { -#ifndef USE_THREADS -# include "thrdvar.h" -#endif -#include "intrpvar.h" +# ifndef USE_THREADS +# include "thrdvar.h" +# endif +# include "intrpvar.h" +/* + * The following is a buffer where new variables must + * be defined to maintain binary compatibility with PERL_OBJECT + */ +PERLVARA(object_compatibility,30, char) }; #else struct interpreter { char broiled; }; -#endif +#endif /* MULTIPLICITY || PERL_OBJECT */ #ifdef USE_THREADS /* If we have threads define a struct with all the variables @@ -2660,13 +2582,6 @@ typedef void *Thread; # define PERL_CALLCONV #endif -#ifdef PERL_OBJECT -# define VIRTUAL virtual PERL_CALLCONV -#else -# define VIRTUAL PERL_CALLCONV -/*START_EXTERN_C*/ -#endif - #ifndef NEXT30_NO_ATTRIBUTE # ifndef HASATTRIBUTE /* disable GNU-cc attribute checking? */ # ifdef __attribute__ /* Avoid possible redefinition errors */ @@ -2677,27 +2592,18 @@ typedef void *Thread; #endif #ifdef PERL_OBJECT -#define PERL_DECL_PROT -#define perl_alloc Perl_alloc +# define PERL_DECL_PROT #endif -#include "proto.h" - #undef PERL_CKDEF #undef PERL_PPDEF #define PERL_CKDEF(s) OP *s (pTHX_ OP *o); #define PERL_PPDEF(s) OP *s (pTHX); -#ifdef PERL_OBJECT -public: -#endif -#include "pp_proto.h" +#include "proto.h" #ifdef PERL_OBJECT -VIRTUAL int CPerlObj::do_aspawn (void *vreally, void **vmark, void **vsp); -#undef PERL_DECL_PROT -#else -/*END_EXTERN_C*/ +# undef PERL_DECL_PROT #endif #ifndef PERL_OBJECT @@ -2721,29 +2627,17 @@ VIRTUAL int CPerlObj::do_aspawn (void *vreally, void **vmark, void **vsp); #define PERLVARI(var,type,init) EXT type PL_##var INIT(init); #define PERLVARIC(var,type,init) EXTCONST type PL_##var INIT(init); -#ifndef MULTIPLICITY - +#if !defined(MULTIPLICITY) && !defined(PERL_OBJECT) +START_EXTERN_C # include "intrpvar.h" # ifndef USE_THREADS # include "thrdvar.h" # endif - +END_EXTERN_C #endif #ifdef PERL_OBJECT -/* - * The following is a buffer where new variables must - * be defined to maintain binary compatibility with PERL_OBJECT - * for 5.005 - */ -PERLVARA(object_compatibility,30, char) -}; - - # include "embed.h" -# if defined(WIN32) && !defined(WIN32IO_IS_STDIO) -# define errno CPerlObj::ErrorNo() -# endif # ifdef DOINIT # include "INTERN.h" @@ -2754,6 +2648,10 @@ PERLVARA(object_compatibility,30, char) /* this has structure inits, so it cannot be included before here */ # include "opcode.h" +#else +# if defined(WIN32) +# include "embed.h" +# endif #endif /* PERL_OBJECT */ #ifndef PERL_GLOBAL_STRUCT @@ -2773,85 +2671,85 @@ START_EXTERN_C #ifdef DOINIT -EXT MGVTBL PL_vtbl_sv = {Perl_magic_get, - Perl_magic_set, - Perl_magic_len, +EXT MGVTBL PL_vtbl_sv = {MEMBER_TO_FPTR(Perl_magic_get), + MEMBER_TO_FPTR(Perl_magic_set), + MEMBER_TO_FPTR(Perl_magic_len), 0, 0}; -EXT MGVTBL PL_vtbl_env = {0, Perl_magic_set_all_env, - 0, Perl_magic_clear_all_env, +EXT MGVTBL PL_vtbl_env = {0, MEMBER_TO_FPTR(Perl_magic_set_all_env), + 0, MEMBER_TO_FPTR(Perl_magic_clear_all_env), 0}; -EXT MGVTBL PL_vtbl_envelem = {0, Perl_magic_setenv, - 0, Perl_magic_clearenv, +EXT MGVTBL PL_vtbl_envelem = {0, MEMBER_TO_FPTR(Perl_magic_setenv), + 0, MEMBER_TO_FPTR(Perl_magic_clearenv), 0}; EXT MGVTBL PL_vtbl_sig = {0, 0, 0, 0, 0}; -EXT MGVTBL PL_vtbl_sigelem = {Perl_magic_getsig, - Perl_magic_setsig, - 0, Perl_magic_clearsig, +EXT MGVTBL PL_vtbl_sigelem = {MEMBER_TO_FPTR(Perl_magic_getsig), + MEMBER_TO_FPTR(Perl_magic_setsig), + 0, MEMBER_TO_FPTR(Perl_magic_clearsig), 0}; -EXT MGVTBL PL_vtbl_pack = {0, 0, Perl_magic_sizepack, Perl_magic_wipepack, +EXT MGVTBL PL_vtbl_pack = {0, 0, MEMBER_TO_FPTR(Perl_magic_sizepack), MEMBER_TO_FPTR(Perl_magic_wipepack), 0}; -EXT MGVTBL PL_vtbl_packelem = {Perl_magic_getpack, - Perl_magic_setpack, - 0, Perl_magic_clearpack, +EXT MGVTBL PL_vtbl_packelem = {MEMBER_TO_FPTR(Perl_magic_getpack), + MEMBER_TO_FPTR(Perl_magic_setpack), + 0, MEMBER_TO_FPTR(Perl_magic_clearpack), 0}; -EXT MGVTBL PL_vtbl_dbline = {0, Perl_magic_setdbline, +EXT MGVTBL PL_vtbl_dbline = {0, MEMBER_TO_FPTR(Perl_magic_setdbline), 0, 0, 0}; -EXT MGVTBL PL_vtbl_isa = {0, Perl_magic_setisa, - 0, Perl_magic_setisa, +EXT MGVTBL PL_vtbl_isa = {0, MEMBER_TO_FPTR(Perl_magic_setisa), + 0, MEMBER_TO_FPTR(Perl_magic_setisa), 0}; -EXT MGVTBL PL_vtbl_isaelem = {0, Perl_magic_setisa, +EXT MGVTBL PL_vtbl_isaelem = {0, MEMBER_TO_FPTR(Perl_magic_setisa), 0, 0, 0}; -EXT MGVTBL PL_vtbl_arylen = {Perl_magic_getarylen, - Perl_magic_setarylen, +EXT MGVTBL PL_vtbl_arylen = {MEMBER_TO_FPTR(Perl_magic_getarylen), + MEMBER_TO_FPTR(Perl_magic_setarylen), 0, 0, 0}; -EXT MGVTBL PL_vtbl_glob = {Perl_magic_getglob, - Perl_magic_setglob, +EXT MGVTBL PL_vtbl_glob = {MEMBER_TO_FPTR(Perl_magic_getglob), + MEMBER_TO_FPTR(Perl_magic_setglob), 0, 0, 0}; -EXT MGVTBL PL_vtbl_mglob = {0, Perl_magic_setmglob, +EXT MGVTBL PL_vtbl_mglob = {0, MEMBER_TO_FPTR(Perl_magic_setmglob), 0, 0, 0}; -EXT MGVTBL PL_vtbl_nkeys = {Perl_magic_getnkeys, - Perl_magic_setnkeys, +EXT MGVTBL PL_vtbl_nkeys = {MEMBER_TO_FPTR(Perl_magic_getnkeys), + MEMBER_TO_FPTR(Perl_magic_setnkeys), 0, 0, 0}; -EXT MGVTBL PL_vtbl_taint = {Perl_magic_gettaint,Perl_magic_settaint, +EXT MGVTBL PL_vtbl_taint = {MEMBER_TO_FPTR(Perl_magic_gettaint),MEMBER_TO_FPTR(Perl_magic_settaint), 0, 0, 0}; -EXT MGVTBL PL_vtbl_substr = {Perl_magic_getsubstr, Perl_magic_setsubstr, +EXT MGVTBL PL_vtbl_substr = {MEMBER_TO_FPTR(Perl_magic_getsubstr), MEMBER_TO_FPTR(Perl_magic_setsubstr), 0, 0, 0}; -EXT MGVTBL PL_vtbl_vec = {Perl_magic_getvec, - Perl_magic_setvec, +EXT MGVTBL PL_vtbl_vec = {MEMBER_TO_FPTR(Perl_magic_getvec), + MEMBER_TO_FPTR(Perl_magic_setvec), 0, 0, 0}; -EXT MGVTBL PL_vtbl_pos = {Perl_magic_getpos, - Perl_magic_setpos, +EXT MGVTBL PL_vtbl_pos = {MEMBER_TO_FPTR(Perl_magic_getpos), + MEMBER_TO_FPTR(Perl_magic_setpos), 0, 0, 0}; -EXT MGVTBL PL_vtbl_bm = {0, Perl_magic_setbm, +EXT MGVTBL PL_vtbl_bm = {0, MEMBER_TO_FPTR(Perl_magic_setbm), 0, 0, 0}; -EXT MGVTBL PL_vtbl_fm = {0, Perl_magic_setfm, +EXT MGVTBL PL_vtbl_fm = {0, MEMBER_TO_FPTR(Perl_magic_setfm), 0, 0, 0}; -EXT MGVTBL PL_vtbl_uvar = {Perl_magic_getuvar, - Perl_magic_setuvar, +EXT MGVTBL PL_vtbl_uvar = {MEMBER_TO_FPTR(Perl_magic_getuvar), + MEMBER_TO_FPTR(Perl_magic_setuvar), 0, 0, 0}; #ifdef USE_THREADS -EXT MGVTBL PL_vtbl_mutex = {0, 0, 0, 0, Perl_magic_mutexfree}; +EXT MGVTBL PL_vtbl_mutex = {0, 0, 0, 0, MEMBER_TO_FPTR(Perl_magic_mutexfree)}; #endif /* USE_THREADS */ -EXT MGVTBL PL_vtbl_defelem = {Perl_magic_getdefelem,Perl_magic_setdefelem, +EXT MGVTBL PL_vtbl_defelem = {MEMBER_TO_FPTR(Perl_magic_getdefelem),MEMBER_TO_FPTR(Perl_magic_setdefelem), 0, 0, 0}; -EXT MGVTBL PL_vtbl_regexp = {0,0,0,0, Perl_magic_freeregexp}; -EXT MGVTBL PL_vtbl_regdata = {0, 0, Perl_magic_regdata_cnt, 0, 0}; -EXT MGVTBL PL_vtbl_regdatum = {Perl_magic_regdatum_get, 0, 0, 0, 0}; +EXT MGVTBL PL_vtbl_regexp = {0,0,0,0, MEMBER_TO_FPTR(Perl_magic_freeregexp)}; +EXT MGVTBL PL_vtbl_regdata = {0, 0, MEMBER_TO_FPTR(Perl_magic_regdata_cnt), 0, 0}; +EXT MGVTBL PL_vtbl_regdatum = {MEMBER_TO_FPTR(Perl_magic_regdatum_get), 0, 0, 0, 0}; #ifdef USE_LOCALE_COLLATE EXT MGVTBL PL_vtbl_collxfrm = {0, - Perl_magic_setcollxfrm, + MEMBER_TO_FPTR(Perl_magic_setcollxfrm), 0, 0, 0}; #endif -EXT MGVTBL PL_vtbl_amagic = {0, Perl_magic_setamagic, - 0, 0, Perl_magic_setamagic}; -EXT MGVTBL PL_vtbl_amagicelem = {0, Perl_magic_setamagic, - 0, 0, Perl_magic_setamagic}; +EXT MGVTBL PL_vtbl_amagic = {0, MEMBER_TO_FPTR(Perl_magic_setamagic), + 0, 0, MEMBER_TO_FPTR(Perl_magic_setamagic)}; +EXT MGVTBL PL_vtbl_amagicelem = {0, MEMBER_TO_FPTR(Perl_magic_setamagic), + 0, 0, MEMBER_TO_FPTR(Perl_magic_setamagic)}; EXT MGVTBL PL_vtbl_backref = {0, 0, - 0, 0, Perl_magic_killbackrefs}; + 0, 0, MEMBER_TO_FPTR(Perl_magic_killbackrefs)}; #else /* !DOINIT */ @@ -3087,16 +2985,29 @@ typedef struct am_table_short AMTS; #endif /* !USE_LOCALE_NUMERIC */ -#if defined(USE_LONG_LONG) && defined(HAS_LONG_LONG) && defined(HAS_ATOLL) -#define Atol atoll -#else -#define Atol atol +#if !defined(Atol) && defined(USE_LONG_LONG) && defined(HAS_LONG_LONG) +# if !defined(Atol) && defined(HAS_STRTOLL) +# define Atol(s) strtoll(s, (char**)NULL, 10) +# endif +# if !defined(Atol) && defined(HAS_ATOLL) +# define Atol atoll +# endif +#endif +/* is there atoq() anywhere? */ +#if !defined(Atol) +# define Atol atol /* we assume atol being available anywhere */ #endif -#if defined(USE_LONG_LONG) && defined(HAS_LONG_LONG) && defined(HAS_STRTOULL) -#define Strtoul strtoull -#else -#define Strtoul strtoul +#if !defined(Strtoul) && defined(USE_LONG_LONG) && defined(HAS_LONG_LONG) \ + && defined(HAS_STRTOULL) +# define Strtoul strtoull +#endif +/* is there atouq() anywhere? */ +#if !defined(Strtoul) && defined(USE_64_BITS) && defined(HAS_STRTOUQ) +# define Strtoul strtouq +#endif +#if !defined(Strtoul) +# define Strtoul strtoul /* we assume strtoul being available anywhere */ #endif #if !defined(PERLIO_IS_STDIO) && defined(HASATTRIBUTE) @@ -3104,6 +3015,7 @@ typedef struct am_table_short AMTS; * Now we have __attribute__ out of the way * Remap printf */ +#undef printf #define printf PerlIO_stdoutf #endif @@ -3112,6 +3024,34 @@ typedef struct am_table_short AMTS; #endif /* + * Some operating systems are stingy with stack allocation, + * so perl may have to guard against stack overflow. + */ +#ifndef PERL_STACK_OVERFLOW_CHECK +#define PERL_STACK_OVERFLOW_CHECK() NOOP +#endif + +/* + * Some nonpreemptive operating systems find it convenient to + * check for asynchronous conditions after each op execution. + * Keep this check simple, or it may slow down execution + * massively. + */ +#ifndef PERL_ASYNC_CHECK +#define PERL_ASYNC_CHECK() NOOP +#endif + +/* + * On some operating systems, a memory allocation may succeed, + * but put the process too close to the system's comfort limit. + * In this case, PERL_ALLOC_CHECK frees the pointer and sets + * it to NULL. + */ +#ifndef PERL_ALLOC_CHECK +#define PERL_ALLOC_CHECK(p) NOOP +#endif + +/* * nice_chunk and nice_chunk size need to be set * and queried under the protection of sv_mutex */ @@ -3132,12 +3072,21 @@ typedef struct am_table_short AMTS; # include # ifndef HAS_UNION_SEMUN /* Provide the union semun. */ union semun { - int val; - struct semid_ds *buf; - unsigned short *array; + int val; + struct semid_ds *buf; + unsigned short *array; }; # endif # ifdef USE_SEMCTL_SEMUN +# ifdef IRIX32_SEMUN_BROKEN_BY_GCC + union gccbug_semun { + int val; + struct semid_ds *buf; + unsigned short *array; + char __dummy[5]; + }; +# define semun gccbug_semun +# endif # define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun) # else # ifdef USE_SEMCTL_SEMID_DS @@ -3146,20 +3095,6 @@ typedef struct am_table_short AMTS; # endif #endif -/* Mention - - INSTALL_USR_BIN_PERL - - I_SYS_MMAN - HAS_MMAP - HAS_MUNMAP - HAS_MPROTECT - HAS_MSYNC - HAS_MADVISE - Mmap_t - - here so that Configure picks them up. */ - #ifdef IAMSUID #ifdef I_SYS_STATVFS @@ -3171,6 +3106,34 @@ typedef struct am_table_short AMTS; #ifdef I_MNTENT # include /* for getmntent() */ #endif +#ifdef I_SYS_STATFS +# include /* for some statfs() */ +#endif +#ifdef I_SYS_VFS +# ifdef __sgi +# define sv IRIX_sv /* kludge: IRIX has an sv of its own */ +# endif +# include /* for some statfs() */ +# ifdef __sgi +# undef IRIX_sv +# endif +#endif +#ifdef I_USTAT +# include /* for ustat() */ +#endif + +#if !defined(PERL_MOUNT_NOSUID) && defined(MOUNT_NOSUID) +# define PERL_MOUNT_NOSUID MOUNT_NOSUID +#endif +#if !defined(PERL_MOUNT_NOSUID) && defined(MNT_NOSUID) +# define PERL_MOUNT_NOSUID MNT_NOSUID +#endif +#if !defined(PERL_MOUNT_NOSUID) && defined(MS_NOSUID) +# define PERL_MOUNT_NOSUID MS_NOSUID +#endif +#if !defined(PERL_MOUNT_NOSUID) && defined(M_NOSUID) +# define PERL_MOUNT_NOSUID M_NOSUID +#endif #endif /* IAMSUID */ diff --git a/perlio.c b/perlio.c index 4c22d3b..2ad8b4e 100644 --- a/perlio.c +++ b/perlio.c @@ -7,7 +7,6 @@ * */ -#if !defined(PERL_IMPLICIT_SYS) #define VOIDUSED 1 #include "config.h" @@ -26,6 +25,8 @@ #define PERL_IN_PERLIO_C #include "perl.h" +#if !defined(PERL_IMPLICIT_SYS) + #ifdef PERLIO_IS_STDIO void @@ -553,11 +554,9 @@ PerlIO_vsprintf(char *s, int n, const char *fmt, va_list ap) { if (strlen(s) >= (STRLEN)n) { - PerlIO_puts(PerlIO_stderr(),"panic: sprintf overflow - memory corrupted!\n"); - { - dTHX; - my_exit(1); - } + dTHX; + PerlIO_puts(Perl_error_log,"panic: sprintf overflow - memory corrupted!\n"); + my_exit(1); } } return val; diff --git a/perlsdio.h b/perlsdio.h index 71a9e75..7afda68 100644 --- a/perlsdio.h +++ b/perlsdio.h @@ -85,11 +85,7 @@ #ifdef HAS_SETLINEBUF #define PerlIO_setlinebuf(f) setlinebuf(f); #else -# ifdef CYGWIN -# define PerlIO_setlinebuf(f) -# else -# define PerlIO_setlinebuf(f) setvbuf(f, Nullch, _IOLBF, 0); -# endif +#define PerlIO_setlinebuf(f) setvbuf(f, Nullch, _IOLBF, 0); #endif /* Now our interface to Configure's FILE_xxx macros */ diff --git a/perlvars.h b/perlvars.h index 664164d..55769d5 100644 --- a/perlvars.h +++ b/perlvars.h @@ -30,3 +30,7 @@ PERLVARIC(Gpatleave, char *, "\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}") /* XXX does anyone even use this? */ PERLVARI(Gdo_undump, bool, FALSE) /* -u or dump seen? */ + +#if defined(MYMALLOC) && (defined(USE_THREADS) || defined(USE_ITHREADS)) +PERLVAR(Gmalloc_mutex, perl_mutex) /* Mutex for malloc */ +#endif diff --git a/perly.c b/perly.c index e1458d8..2e47b11 100644 --- a/perly.c +++ b/perly.c @@ -1387,7 +1387,7 @@ yyparse() struct ysv *ysave; New(73, ysave, 1, struct ysv); - SAVEDESTRUCTOR(yydestruct, ysave); + SAVEDESTRUCTOR_X(yydestruct, ysave); ysave->oldyydebug = yydebug; ysave->oldyynerrs = yynerrs; ysave->oldyyerrflag = yyerrflag; @@ -1662,7 +1662,7 @@ case 21: break; case 22: #line 203 "perly.y" -{ yyval.opval = scope(yyvsp[0].opval); } +{ (yyvsp[0].opval)->op_flags |= OPf_PARENS; yyval.opval = scope(yyvsp[0].opval); } break; case 23: #line 205 "perly.y" @@ -1826,7 +1826,7 @@ case 59: #line 338 "perly.y" { STRLEN n_a; char *name = SvPV(((SVOP*)yyvsp[0].opval)->op_sv,n_a); if (strEQ(name, "BEGIN") || strEQ(name, "END") - || strEQ(name, "INIT")) + || strEQ(name, "STOP") || strEQ(name, "INIT")) CvSPECIAL_on(PL_compcv); yyval.opval = yyvsp[0].opval; } break; @@ -2481,7 +2481,6 @@ yyaccept: } #ifdef PERL_OBJECT -#define NO_XSLOCKS #include "XSUB.h" #endif diff --git a/perly.y b/perly.y index ddc0efc..b238276 100644 --- a/perly.y +++ b/perly.y @@ -200,7 +200,7 @@ sideff : error else : /* NULL */ { $$ = Nullop; } | ELSE mblock - { $$ = scope($2); } + { ($2)->op_flags |= OPf_PARENS; $$ = scope($2); } | ELSIF '(' mexpr ')' mblock else { PL_copline = $1; $$ = newCONDOP(0, $3, scope($5), $6); @@ -337,7 +337,7 @@ startformsub: /* NULL */ /* start a format subroutine scope */ subname : WORD { STRLEN n_a; char *name = SvPV(((SVOP*)$1)->op_sv,n_a); if (strEQ(name, "BEGIN") || strEQ(name, "END") - || strEQ(name, "INIT")) + || strEQ(name, "STOP") || strEQ(name, "INIT")) CvSPECIAL_on(PL_compcv); $$ = $1; } ; diff --git a/perly_c.diff b/perly_c.diff index 7ade2f3..0b73880 100644 --- a/perly_c.diff +++ b/perly_c.diff @@ -28,7 +28,7 @@ + struct ysv *ysave; + New(73, ysave, 1, struct ysv); -+ SAVEDESTRUCTOR(yydestruct, ysave); ++ SAVEDESTRUCTOR_X(yydestruct, ysave); + ysave->oldyydebug = yydebug; + ysave->oldyynerrs = yynerrs; + ysave->oldyyerrflag = yyerrflag; @@ -134,7 +134,7 @@ yyaccept: ! return (0); } ---- 2524,2570 ---- +--- 2524,2569 ---- #endif if (yyssp >= yyss + yystacksize - 1) { @@ -164,7 +164,6 @@ ! } ! ! #ifdef PERL_OBJECT -! #define NO_XSLOCKS ! #include "XSUB.h" ! #endif ! diff --git a/plan9/plan9ish.h b/plan9/plan9ish.h index 06a30fe..bac6a92 100644 --- a/plan9/plan9ish.h +++ b/plan9/plan9ish.h @@ -103,7 +103,7 @@ #ifndef SIGILL # define SIGILL 6 /* blech */ #endif -#define ABORT() kill(getpid(),SIGABRT); +#define ABORT() kill(PerlProc_getpid(),SIGABRT); #define BIT_BUCKET "/dev/null" #define PERL_SYS_INIT(c,v) MALLOC_INIT diff --git a/pod/Makefile b/pod/Makefile index 8a96236..3aadd9e 100644 --- a/pod/Makefile +++ b/pod/Makefile @@ -31,6 +31,7 @@ POD = \ perlmod.pod \ perlmodlib.pod \ perlmodinstall.pod \ + perlfork.pod \ perlform.pod \ perllocale.pod \ perlref.pod \ @@ -61,6 +62,7 @@ POD = \ perlcall.pod \ perlcompile.pod \ perltodo.pod \ + perlhack.pod \ perlhist.pod \ perlfaq.pod \ perlfaq1.pod \ @@ -91,6 +93,7 @@ MAN = \ perlmod.man \ perlmodlib.man \ perlmodinstall.man \ + perlfork.man \ perlform.man \ perllocale.man \ perlref.man \ @@ -121,6 +124,7 @@ MAN = \ perlcall.man \ perlcompile.man \ perltodo.man \ + perlhack.man \ perlhist.man \ perlfaq.man \ perlfaq1.man \ @@ -151,6 +155,7 @@ HTML = \ perlmod.html \ perlmodlib.html \ perlmodinstall.html \ + perlfork.html \ perlform.html \ perllocale.html \ perlref.html \ @@ -181,6 +186,7 @@ HTML = \ perlcall.html \ perlcompile.html \ perltodo.html \ + perlhack.html \ perlhist.html \ perlfaq.html \ perlfaq1.html \ @@ -211,6 +217,7 @@ TEX = \ perlmod.tex \ perlmodlib.tex \ perlmodinstall.tex \ + perlfork.tex \ perlform.tex \ perllocale.tex \ perlref.tex \ @@ -241,6 +248,7 @@ TEX = \ perlcall.tex \ perlcompile.tex \ perltodo.tex \ + perlhack.tex \ perlhist.tex \ perlfaq.tex \ perlfaq1.tex \ diff --git a/pod/Win32.pod b/pod/Win32.pod index dfc78bd..08043e8 100644 --- a/pod/Win32.pod +++ b/pod/Win32.pod @@ -32,12 +32,13 @@ only available in the ActivePerl binary distribution. =item Win32::CopyFile(FROM, TO, OVERWRITE) -The Win32::CopyFile() function copies an existing file to a new file. All -file information like creation time and file attributes will be copied to -the new file. However it will B copy the security information. If the -destination file already exists it will only be overwritten when the -OVERWRITE parameter is true. But even this will not overwrite a read-only -file; you have to unlink() it first yourself. +[CORE] The Win32::CopyFile() function copies an existing file to a new +file. All file information like creation time and file attributes will +be copied to the new file. However it will B copy the security +information. If the destination file already exists it will only be +overwritten when the OVERWRITE parameter is true. But even this will +not overwrite a read-only file; you have to unlink() it first +yourself. =item Win32::DomainName() @@ -207,7 +208,7 @@ the SID type. =item Win32::LookupAccountSID(SYSTEM, SID, ACCOUNT, DOMAIN, SIDTYPE) -[EXT] ]Looks up SID on SYSTEM and returns the account name, domain name, +[EXT] Looks up SID on SYSTEM and returns the account name, domain name, and the SID type. =item Win32::MsgBox(MESSAGE [, FLAGS [, TITLE]]) diff --git a/pod/buildtoc b/pod/buildtoc index 1a9a24b..41cb76d 100644 --- a/pod/buildtoc +++ b/pod/buildtoc @@ -8,7 +8,7 @@ sub output ($); perl perlfaq perlfaq1 perlfaq2 perlfaq3 perlfaq4 perlfaq5 perlfaq6 perlfaq7 perlfaq8 perlfaq9 perldelta perldata perlsyn perlop perlre perlrun perlfunc perlvar perlsub - perlmod perlmodlib perlmodinstall perlform perllocale + perlmod perlmodlib perlmodinstall perlfork perlform perllocale perlref perlreftut perldsc perllol perltoot perltootc perlobj perltie perlbot perlipc perldbmfilter perldebug diff --git a/pod/perl.pod b/pod/perl.pod index abf3a7b..9b5db82 100644 --- a/pod/perl.pod +++ b/pod/perl.pod @@ -47,6 +47,7 @@ sections: perltie Perl objects hidden behind simple variables perlbot Perl OO tricks and examples perlipc Perl interprocess communication + perlfork Perl fork() information perlthrtut Perl threads tutorial perldbmfilter Perl DBM Filters @@ -69,6 +70,7 @@ sections: perlcall Perl calling conventions from C perltodo Perl things to do + perlhack Perl hackers guide perlhist Perl history records (If you're intending to read these straight through for the first time, @@ -295,7 +297,7 @@ Perl developers, please write to perl-thanks@perl.org . s2p sed to perl translator http://www.perl.com/ the Perl Home Page - http://www.perl.com/CPAN the Comphrehensive Perl Archive + http://www.perl.com/CPAN the Comprehensive Perl Archive =head1 DIAGNOSTICS diff --git a/pod/perl5005delta.pod b/pod/perl5005delta.pod index 3766681..3353821 100644 --- a/pod/perl5005delta.pod +++ b/pod/perl5005delta.pod @@ -978,7 +978,7 @@ The F and F files for copyright information. =head1 HISTORY -Written by Gurusamy Sarathy >, with many contributions +Written by Gurusamy Sarathy >, with many contributions from The Perl Porters. Send omissions or corrections to >. diff --git a/pod/perlcall.pod b/pod/perlcall.pod index 35c0f05..e691e75 100644 --- a/pod/perlcall.pod +++ b/pod/perlcall.pod @@ -1948,7 +1948,7 @@ L, L, L =head1 AUTHOR -Paul Marquess > +Paul Marquess Special thanks to the following people who assisted in the creation of the document. diff --git a/pod/perldata.pod b/pod/perldata.pod index 067c6d9..0b83214 100644 --- a/pod/perldata.pod +++ b/pod/perldata.pod @@ -648,8 +648,12 @@ You couldn't just loop through C to do this because that function produces a new list which is a copy of the values, so changing them doesn't change the original. -As a special rule, if a list slice would produce a list consisting -entirely of undefined values, the null list is produced instead. +A slice of an empty list is still an empty list. Thus: + + @a = ()[1,0]; # @a has no elements + @b = (@a)[0,1]; # @b has no elements + @b = (1,undef)[1,0,1]; # @b has three elements + This makes it easy to write loops that terminate when a null list is returned: diff --git a/pod/perldelta.pod b/pod/perldelta.pod index e3a37dc..9c040ed 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -1,6 +1,6 @@ =head1 NAME -perldelta - what's new for perl v5.6 (as of v5.005_61) +perldelta - what's new for perl v5.6 (as of v5.005_64) =head1 DESCRIPTION @@ -15,7 +15,141 @@ This document describes differences between the 5.005 release and this one. =head2 Perl Source Incompatibilities -TODO +Beware that any new warnings that have been added or old ones +that have been enhanced are B considered incompatible changes. + +Since all new warnings must be explicitly requested via the C<-w> +switch or the C pragma, it is ultimately the programmer's +responsibility to ensure that warnings are enabled judiciously. + +=over 4 + +=item STOP is a new keyword + +In addition to C, C, C, C and C, +subroutines named C are now special. These are queued up during +compilation and behave similar to END blocks, except they are called at +the end of compilation rather than at the end of execution. They cannot +be called directly. + +=item Treatment of list slices of undef has changed + +When taking a slice of a literal list (as opposed to a slice of +an array or hash), Perl used to return an empty list if the +result happened to be composed of all undef values. + +The new behavior is to produce an empty list if (and only if) +the original list was empty. Consider the following example: + + @a = (1,undef,undef,2)[2,1,2]; + +The old behavior would have resulted in @a having no elements. +The new behavior ensures it has three undefined elements. + +Note in particular that the behavior of slices of the following +cases remains unchanged: + + @a = ()[1,2]; + @a = (getpwent)[7,0]; + @a = (anything_returning_empty_list())[2,1,2]; + @a = @b[2,1,2]; + @a = @c{'a','b','c'}; + +See L. + +=item Possibly changed pseudo-random number generator + +In 5.005_0x and earlier, perl's rand() function used the C library +rand(3) function. As of 5.005_52, Configure tests for drand48(), +random(), and rand() (in that order) and picks the first one it finds. +Perl programs that depend on reproducing a specific set of pseudo-random +numbers will now likely produce different output. You can use +C to obtain the old behavior. + +=item Hashing function for hash keys has changed + +Perl hashes are not order preserving. The apparently random order +encountered when iterating on the contents of a hash is determined +by the hashing algorithm used. To improve the distribution of lower +bits in the hashed value, the algorithm has changed slightly as of +5.005_52. When iterating over hashes, this may yield a random order +that is B from that of previous versions. + +=item C fails on read only values + +Using the C operator on a readonly value (such as $1) has +the same effect as assigning C to the readonly value--it +throws an exception. + +=item Close-on-exec bit may be set on pipe() handles + +On systems that support a close-on-exec flag on filehandles, the +flag will be set for any handles created by pipe(), if that is +warranted by the value of $^F that may be in effect. Earlier +versions neglected to set the flag for handles created with +pipe(). See L and L. + +=item Writing C<"$$1"> to mean C<"${$}1"> is unsupported + +Perl 5.004 deprecated the interpretation of C<$$1> and +similar within interpolated strings to mean C<$$ . "1">, +but still allowed it. + +In Perl 5.6 and later, C<"$$1"> always means C<"${$1}">. + +=item delete(), values() and C<\(%h)> operate on aliases to values, not copies + +delete(), each(), values() and hashes in a list context return the actual +values in the hash, instead of copies (as they used to in earlier +versions). Typical idioms for using these constructs copy the +returned values, but this can make a significant difference when +creating references to the returned values. + +Keys in the hash are still returned as copies when iterating on +a hash. + +=item vec(EXPR,OFFSET,BITS) enforces powers-of-two BITS + +vec() generates a run-time error if the BITS argument is not +a valid power-of-two integer. + +=item Text of some diagnostic output has changed + +Most references to internal Perl operations in diagnostics +have been changed to be more descriptive. This may be an +issue for programs that may incorrectly rely on the exact +text of diagnostics for proper functioning. + +=item C<%@> has been removed + +The undocumented special variable C<%@> that used to accumulate +"background" errors (such as those that happen in DESTROY()) +has been removed, because it could potentially result in memory +leaks. + +=item Parenthesized not() behaves like a list operator + +The C operator now falls under the "if it looks like a function, +it behaves like a function" rule. + +As a result, the parenthesized form can be used with C and C. +The following construct used to be a syntax error before, but it works +as expected now: + + grep not($_), @things; + +On the other hand, using C with a literal list slice may not +work. The following previously allowed construct: + + print not (1,2,3)[0]; + +needs to be written with additional parentheses now: + + print not((1,2,3)[0]); + +The behavior remains unaffected when C is not followed by parentheses. + +=back =head2 C Source Incompatibilities @@ -34,6 +168,10 @@ specified via MakeMaker: =item C +PERL_IMPLICIT_CONTEXT is automatically enabled whenever Perl is built +with one of -Dusethreads, -Dusemultiplicity, or both. It is not +intended to be enabled by users at this time. + This new build option provides a set of macros for all API functions such that an implicit interpreter/thread context argument is passed to every API function. As a result of this, something like C @@ -50,9 +188,6 @@ Note that the above issue is not relevant to the default build of Perl, whose interfaces continue to match those of prior versions (but subject to the other options described here). -PERL_IMPLICIT_CONTEXT is automatically enabled whenever Perl is built -with one of -Dusethreads, -Dusemultiplicity, or both. - See L for detailed information on the ramifications of building Perl using this option. @@ -78,14 +213,6 @@ the default. Note that these functions do B constitute Perl's memory allocation API. See L for further information about that. -=item C and C Issues - -The C global is now thread local, so a C declaration is needed -in the scope in which the global appears. XSUBs should handle this automatically, -but if you have used C in support functions, you either need to -change the C to a local variable (which is recommended), or put in -a C. - =back =head2 Compatible C Source API Changes @@ -106,6 +233,11 @@ the old names are still supported when F is explicitly included (as required before), so there is no source incompatibility from the change. +=item Support for C++ exceptions + +change#3386, also needs perlguts documentation +[TODO - Chip Salzenberg ] + =back =head2 Binary Incompatibilities @@ -116,20 +248,166 @@ release or its maintenance versions. The usethreads or usemultiplicity builds are B binary compatible with the corresponding builds in 5.005. +=head1 Installation and Configuration Improvements + +=head2 New Configure flags + +The following new flags may be enabled on the Configure command line +by running Configure with C<-Dflag>. + + usemultiplicity + + uselongdouble + usemorebits + uselargefiles + +=head2 -Dusethreads and -Duse64bits now more daring + +The Configure options enabling the use of threads and the use of +64-bitness are now more daring in the sense that they no more have +an explicit list of operating systems of known threads/64-bit +capabilities. In other words: if your operating system has the +necessary APIs, you should be able just to go ahead and use them. +See also L<"64-bit support">. + +=head2 Long Doubles + +Some platforms have "long doubles", floating point numbers of even +larger range than ordinary "doubles". To enable using long doubles for +Perl's scalars, use -Duselongdouble. + +=head2 -Dusemorebits + +You can enable both -Duse64bits and -Dlongdouble by -Dusemorebits. +See also L<"64-bit support">. + +=head2 -Duselargefiles + +Some platforms support large files, files larger than two gigabytes. +See L<"Large file support"> for more information. + +=head2 installusrbinperl + +You can use "Configure -Uinstallusrbinperl" which causes installperl +to skip installing perl also as /usr/bin/perl. This is useful if you +prefer not to modify /usr/bin for some reason or another but harmful +because many scripts assume to find Perl in /usr/bin/perl. + +=head2 SOCKS support + +You can use "Configure -Dusesocks" which causes Perl to probe +for the SOCKS (v5, not v4) proxy protocol library, +http://www.socks.nec.com/ + +=head2 C<-A> flag + +You can "post-edit" the Configure variables using the Configure C<-A> +flag. The editing happens immediately after the platform specific +hints files have been processed but before the actual configuration +process starts. Run C to find out the full C<-A> syntax. + +=head2 Enhanced Installation Directories + +The installation structure has been enriched to improve the support for +maintaining multiple versions of perl, to provide locations for +vendor-supplied modules and scripts, and to ease maintenance of +locally-added modules and scripts. See the section on Installation +Directories in the INSTALL file for complete details. For most users +building and installing from source, the defaults should be fine. + =head1 Core Changes =head2 Unicode and UTF-8 support Perl can optionally use UTF-8 as its internal representation for character -strings. The C pragma enables this support in the current lexical +strings. The C pragma enables this support in the current lexical scope. See L for more information. +=head2 Interpreter threads + +WARNING: This is an experimental feature in a pre-alpha state. Use +at your own risk. + +Perl 5.005_63 introduces the beginnings of support for running multiple +interpreters concurrently in different threads. In conjunction with +the perl_clone() API call, which can be used to selectively duplicate +the state of any given interpreter, it is possible to compile a +piece of code once in an interpreter, clone that interpreter +one or more times, and run all the resulting interpreters in distinct +threads. + +On Windows, this feature is used to emulate fork() at the interpreter +level. See L. + +This feature is still in evolution. It is eventually meant to be used +to selectively clone a subroutine and data reachable from that +subroutine in a separate interpreter and run the cloned subroutine +in a separate thread. Since there is no shared data between the +interpreters, little or no locking will be needed (unless parts of +the symbol table are explicitly shared). This is obviously intended +to be an easy-to-use replacement for the existing threads support. + +Support for cloning interpreters must currently be manually enabled +by defining the cpp macro USE_ITHREADS on non-Windows platforms. +(See win32/Makefile for how to enable it on Windows.) The resulting +perl executable will be functionally identical to one that was built +without USE_ITHREADS, but the perl_clone() API call will only be +available in the former. + +USE_ITHREADS enables Perl source code changes that provide a clear +separation between the op tree and the data it operates with. The +former is considered immutable, and can therefore be shared between +an interpreter and all of its clones, while the latter is considered +local to each interpreter, and is therefore copied for each clone. + +Note that building Perl with the -Dusemultiplicity Configure option +is adequate if you wish to run multiple B interpreters +concurrently in different threads. USE_ITHREADS only needs to be +enabled if you wish to obtain access to perl_clone() and cloned +interpreters. + +[XXX TODO - the Compiler backends may be broken when USE_ITHREADS is +enabled.] + =head2 Lexically scoped warning categories You can now control the granularity of warnings emitted by perl at a finer level using the C pragma. See L and L for details. +=head2 Lvalue subroutines + +WARNING: This is an experimental feature. + +change#4081 +[TODO - Ilya Zakharevich , +Tuomas Lukka )] + +=head2 "our" declarations + +An "our" declaration introduces a value that can be best understood +as a lexically scoped symbolic alias to a global variable in the +current package. This is mostly useful as an alternative to the +C pragma, but also provides the opportunity to introduce +typing and other attributes for such variables. See L. + +=head2 Weak references + +WARNING: This is an experimental feature. + +change#3385, also need perlguts documentation + +[TODO - Tuomas Lukka ] + +=head2 File globbing implemented internally + +WARNING: This is currently an experimental feature. Interfaces and +implementation are likely to change. + +Perl now uses the File::Glob implementation of the glob() operator +automatically. This avoids using an external csh process and the +problems associated with it. + =head2 Binary numbers supported Binary numbers are now supported as literals, in s?printf formats, and @@ -138,9 +416,61 @@ C: $answer = 0b101010; printf "The answer is: %b\n", oct("0b101010"); +=head2 Some arrows may be omitted in calls through references + +Perl now allows the arrow to be omitted in many constructs +involving subroutine calls through references. For example, +C<$foo[10]->('foo')> may now be written C<$foo[10]('foo')>. +This is rather similar to how the arrow may be omitted from +C<$foo[10]->{'foo'}>. Note however, that the arrow is still +required for C('bar')>. + +=head2 exists() and delete() are supported on array elements + +The exists() and delete() builtins now work on simple arrays as well. +The behavior is similar to that on hash elements. + +exists() can be used to check whether an array element has been +initialized without autovivifying it. If the array is tied, the +EXISTS() method in the corresponding tied package will be invoked. + +delete() may be used to remove an element from the array and return +it. The array element at that position returns to its unintialized +state, so that testing for the same element with exists() will return +false. If the element happens to be the one at the end, the size of +the array also shrinks by one. If the array is tied, the DELETE() method +in the corresponding tied package will be invoked. + +See L and L for examples. + =head2 syswrite() ease-of-use -The length argument of C is now optional. +The length argument of C has become optional. + +=head2 Filehandles can be autovivified + +Similar to how constructs such as C<$x->[0]> autovivify a reference, +open() now autovivifies a filehandle if the first argument is an +uninitialized variable. This allows the constructs C and +C to be used to create filehandles that will +conveniently be closed automatically when the scope ends, provided there +are no other references to them. This largely eliminates the need for +typeglobs when opening filehandles that must be passed around, as in the +following example: + + sub myopen { + open my $fh, "@_" + or die "Can't open '@_': $!"; + return $fh; + } + + { + my $f = myopen("; + # $f implicitly closed here + } + +[TODO - this idiom needs more pod penetration] =head2 64-bit support @@ -150,20 +480,34 @@ use "quads" (64-integers) as follows: =over 4 -=item constants (decimal, hexadecimal, octal, binary) in the code +=item * + +constants (decimal, hexadecimal, octal, binary) in the code + +=item * + +arguments to oct() and hex() + +=item * + +arguments to print(), printf() and sprintf() (flag prefixes ll, L, q) + +=item * + +printed as such -=item arguments to oct() and hex() +=item * + +pack() and unpack() "q" and "Q" formats -=item arguments to print(), printf() and sprintf() (flag prefixes ll, L, q) +=item * -=item printed as such +in basic arithmetics: + - * / % -=item pack() and unpack() "q" and "Q" formats +=item * -=item in basic arithmetics: + - * / % +vec() (but see the below note about bit arithmetics) -=item vec() (but see the below note about bit arithmetics) - =back Note that unless you have the case (a) you will have to configure @@ -204,7 +548,7 @@ command before running Perl. The BSD::Resource extension (not included with the standard Perl distribution) may also be of use, it offers the getrlimit/setrlimit interface that can be used to adjust process resource usage limits, including the maximum filesize limit. - + =head2 Long doubles In some systems you may be able to use long doubles to enhance the @@ -217,6 +561,16 @@ this support (if it is available). You can Configure -Dusemorebits to turn on both the 64-bit support and the long double support. +=head2 Enhanced support for sort() subroutines + +Perl subroutines with a prototype of C<($$)> and XSUBs in general can +now be used as sort subroutines. In either case, the two elements to +be compared are passed as normal parameters in @_. See L. + +For unprototyped sort subroutines, the historical behavior of passing +the elements to be compared as the global variables $a and $b remains +unchanged. + =head2 Better syntax checks on parenthesized unary operators Expressions such as: @@ -270,9 +624,15 @@ native shorts, ints, and longs. See L. =head2 pack() and unpack() support counted strings -The template character '#' can be used to specify a counted string +The template character '/' can be used to specify a counted string type to be packed or unpacked. See L. +=head2 Comments in pack() templates + +The '#' character in a template introduces a comment up to +end of the line. This facilitates documentation of pack() +templates. + =head2 $^X variables may now have names longer than one character Formerly, $^X was synonymous with ${"\cX"}, but $^XY was a syntax @@ -311,6 +671,55 @@ That can now be accomplished with a declaration syntax, like this: F and F have been updated to keep the attributes with the stubs they provide. See L. +=head2 Regular expression improvements + +change#2827,2373,2372,2365,1813,1800,4112,4158,4215,4301 +[TODO - Ilya Zakharevich ] + +=head2 Overloading improvements + +change#2150 +[TODO - Ilya Zakharevich ] + +=head2 open() with more than two arguments + +[TODO - Ilya Zakharevich ] + +=head2 Support for interpolating named characters + +change#4052 +[TODO - Ilya Zakharevich ] + +=head2 Experimental support for user-hooks in @INC + +[TODO - Ken Fox ] + +=head2 C and C may be overridden + +C and C operations may be overridden locally +by importing subroutines of the same name into the current package +(or globally by importing them into the CORE::GLOBAL:: namespace). +Overriding C will also affect C, provided the override +is visible at compile-time. +See L. + +=head2 New variable $^C reflects C<-c> switch + +C<$^C> has a boolean value that reflects whether perl is being run +in compile-only mode (i.e. via the C<-c> switch). Since +BEGIN blocks are executed under such conditions, this variable +enables perl code to determine whether actions that make sense +only during normal running are warranted. See L. + +=head2 Optional Y2K warnings + +If Perl is built with the cpp macro C defined, +it emits optional warnings when concatenating the number 19 +with another number. + +This behavior must be specifically enabled when running Configure. +See L and L. + =head1 Significant bug fixes =head2 EHANDLEE on empty files @@ -345,6 +754,21 @@ Parsing of here documents used to be flawed when they appeared as the replacement expression in C. This has been fixed. +=head2 All compilation errors are true errors + +Some "errors" encountered at compile time were by neccessity +generated as warnings followed by eventual termination of the +program. This enabled more such errors to be reported in a +single run, rather than causing a hard stop at the first error +that was encountered. + +The mechanism for reporting such errors has been reimplemented +to queue compile-time errors and report them at the end of the +compilation as true errors rather than as warnings. This fixes +cases where error messages leaked through in the form of warnings +when code was compiled at run time using C, and +also allows such errors to be reliably trapped using __DIE__ hooks. + =head2 Automatic flushing of output buffers fork(), exec(), system(), qx//, and pipe open()s now flush buffers @@ -360,15 +784,199 @@ are compile time errors. Attempting to read from filehandles that were opened only for writing will now produce warnings (just as writing to read-only filehandles does). -=head2 Buffered data discarded from input filehandle when dup'ed. +=head2 Where possible, buffered data discarded from duped input filehandle + +C&OLD")> now attempts to discard any data that +was previously read and buffered in C before duping the handle. +On platforms where doing this is allowed, the next read operation +on C will return the same data as the corresponding operation +on C. Formerly, it would have returned the data from the start +of the following disk block instead. + +=head2 eof() has the same old magic as <> + +C would return true if no attempt to read from CE> had +yet been made. C has been changed to have a little magic of its +own, it now opens the CE> files. + +=head2 system(), backticks and pipe open now reflect exec() failure + +On Unix and similar platforms, system(), qx() and open(FOO, "cmd |") +etc., are implemented via fork() and exec(). When the underlying +exec() fails, earlier versions did not report the error properly, +since the exec() happened to be in a different process. + +The child process now communicates with the parent about the +error in launching the external command, which allows these +constructs to return with their usual error value and set $!. + +=head2 Implicitly closed filehandles are safer + +Sometimes implicitly closed filehandles (as when they are localized, +and Perl automatically closes them on exiting the scope) could +inadvertently set $? or $!. This has been corrected. + +=head2 C<(\$)> prototype and C<$foo{a}> + +An scalar reference prototype now correctly allows a hash or +array element in that slot. + +=head2 Pseudo-hashes work better + +Dereferencing some types of reference values in a pseudo-hash, +such as C<$ph->{foo}[1]>, was accidentally disallowed. This has +been corrected. + +When applied to a pseudo-hash element, exists() now reports whether +the specified value exists, not merely if the key is valid. + +delete() now works on pseudo-hashes. When given a pseudo-hash element +or slice it deletes the values corresponding to the keys (but not the keys +themselves). See L. + +=head2 C and AUTOLOAD + +The C construct works correctly when C<&sub> happens +to be autoloaded. + +=head2 C<-bareword> allowed under C + +The autoquoting of barewords preceded by C<-> did not work +in prior versions when the C pragma was enabled. +This has been fixed. + +=head2 Boolean assignment operators are legal lvalues + +Constructs such as C<($a ||= 2) += 1> are now allowed. + +=head2 C allowed + +sort() did not accept a subroutine reference as the comparison +function in earlier versions. This is now permitted. + +=head2 Failures in DESTROY() + +When code in a destructor threw an exception, it went unnoticed +in earlier versions of Perl, unless someone happened to be +looking in $@ just after the point the destructor happened to +run. Such failures are now visible as warnings when warnings are +enabled. + +=head2 Locale bugs fixed + +printf() and sprintf() previously reset the numeric locale +back to the default "C" locale. This has been fixed. + +Numbers formatted according to the local numeric locale +(such as using a decimal comma instead of a decimal dot) caused +"isn't numeric" warnings, even while the operations accessing +those numbers produced correct results. The warnings are gone. + +=head2 Memory leaks + +The C construct could sometimes leak +memory. This has been fixed. + +Operations that aren't filehandle constructors used to leak memory +when used on invalid filehandles. This has been fixed. + +Constructs that modified C<@_> could fail to deallocate values +in C<@_> and thus leak memory. This has been corrected. + +=head2 Spurious subroutine stubs after failed subroutine calls + +Perl could sometimes create empty subroutine stubs when a +subroutine was not found in the package. Such cases stopped +later method lookups from progressing into base packages. +This has been corrected. + +=head2 Consistent numeric conversions + +change#3378,3318 +[TODO - Ilya Zakharevich ] + +=head2 Taint failures under C<-U> + +When running in unsafe mode, taint violations could sometimes +cause silent failures. This has been fixed. + +=head2 END blocks and the C<-c> switch + +Prior versions used to run BEGIN B END blocks when Perl was +run in compile-only mode. Since this is typically not the expected +behavior, END blocks are not executed anymore when the C<-c> switch +is used. + +See L for how to run things when the compile phase ends. + +=head2 Potential to leak DATA filehandles -C&OLD")> now discards any data that was previously -read and buffered in C. The next read operation on C will -return the same data as the corresponding operation on C. -Formerly, it would have returned the data from the start of the -following disk block instead. +Using the C<__DATA__> token creates an implicit filehandle to +the file that contains the token. It is the program's +responsibility to close it when it is done reading from it. -=head1 Supported Platforms +This caveat is now better explained in the documentation. +See L. + +=head2 Diagnostics follow STDERR + +Diagnostic output now goes to whichever file the C handle +is pointing at, instead of always going to the underlying C runtime +library's C. + +=head2 Other fixes for better diagnostics + +Line numbers are no longer suppressed (under most likely circumstances) +during the global destruction phase. + +Diagnostics emitted from code running in threads other than the main +thread are now accompanied by the thread ID. + +Embedded null characters in diagnostics now actually show up. They +used to truncate the message in prior versions. + +$foo::a and $foo::b are now exempt from "possible typo" warnings only +if sort() is encountered in package foo. + +Unrecognized alphabetic escapes encountered when parsing quote +constructs now generate a warning, since they may take on new +semantics in later versions of Perl. + +=head1 Performance enhancements + +=head2 Simple sort() using { $a <=> $b } and the like are optimized + +Many common sort() operations using a simple inlined block are now +optimized for faster performance. + +=head2 Optimized assignments to lexical variables + +Certain operations in the RHS of assignment statements have been +optimized to directly set the lexical variable on the LHS, +eliminating redundant copying overheads. + +=head2 Method lookups optimized + +[TODO - Chip Salzenberg ] + +=head2 Faster mechanism to invoke XSUBs + +change#4044,4125 +[TODO - Ilya Zakharevich ] + +=head2 Perl_malloc() improvements + +change#4237 +[TODO - Ilya Zakharevich ] + +=head2 Faster subroutine calls + +Minor changes in how subroutine calls are handled internally +provide marginal improvements in performance. + +=head1 Platform specific changes + +=head2 Additional supported platforms =over 4 @@ -399,6 +1007,73 @@ EPOC is is now supported (on Psion 5). =back +=head2 DOS + +=over 4 + +=item * + +Perl now works with djgpp 2.02 (and 2.03 alpha). + +=item * + +Environment variable names are not converted to uppercase any more. + +=item * + +Wrong exit code from backticks now fixed. + +=item * + +This port is still using its own builtin globbing. + +=back + +=head2 OS/2 + +[TODO - Ilya Zakharevich ] + +=head2 VMS + +[TODO - Charles Bailey ] + +=head2 Win32 + +Site library searches failed to look for ".../site/5.XXX/lib" +if ".../site/5.XXXYY/lib" wasn't found. This has been corrected. + +When given a pathname that consists only of a drivename, such +as C, opendir() and stat() now use the current working +directory for the drive rather than the drive root. + +The builtin XSUB functions in the Win32:: namespace are +documented. See L. + +$^X now contains the full path name of the running executable. + +A Win32::GetLongPathName() function is provided to complement +Win32::GetFullPathName() and Win32::GetShortPathName(). See L. + +POSIX::uname() is supported. + +system(1,...) now returns true process IDs rather than process +handles. kill() accepts any real process id, rather than strictly +return values from system(1,...). + +The C module is supported. + +Rudimentary support for building under command.com in Windows 95 +has been added. + +Scripts are read in binary mode by default to allow ByteLoader (and +the filter mechanism in general) to work properly. For compatibility, +the DATA filehandle will be set to text mode if a carriage return is +detected at the end of the line containing the __END__ or __DATA__ +token; if not, the DATA filehandle will be left open in binary mode. +Earlier versions always opened the DATA filehandle in text mode. + +[TODO - GSAR] + =head1 New tests =over 4 @@ -453,48 +1128,114 @@ While used internally by Perl as a pragma, this module also provides a way to fetch subroutine and variable attributes. See L. -=item ByteLoader - -The ByteLoader is a dedication extension to generate and run -Perl bytecode. See L. - =item B The Perl Compiler suite has been extensively reworked for this release. -=item Devel::DProf +[TODO - Vishal Bhatia , +Nick Ing-Simmons ] -Devel::DProf, a Perl source code profiler has been added. +=item ByteLoader -=item Dumpvalue +The ByteLoader is a dedicated extension to generate and run +Perl bytecode. See L. -Added Dumpvalue module provides screen dumps of Perl data. +=item constant + +References can now be used. + +The new version also allows a leading underscore in constant names, but +disallows a double leading underscore (as in "__LINE__"). Some other names +are disallowed or warned against, including BEGIN, END, etc. Some names +which were forced into main:: used to fail silently in some cases; now they're +fatal (outside of main::) and an optional warning (inside of main::). +The ability to detect whether a constant had been set with a given name has +been added. + +See L. + +=item charnames + +change#4052 +[TODO - Ilya Zakharevich ] + +=item Data::Dumper + +A C setting can be specified to avoid venturing +too deeply into deep data structures. See L. + +Dumping C objects works correctly. + +=item DB + +C is an experimental module that exposes a clean abstraction +to Perl's debugging API. + +=item DB_File + +DB_File can now be built with Berkeley DB versions 1, 2 or 3. +See C. + +=item Devel::DProf + +Devel::DProf, a Perl source code profiler has been added. See +L and L. + +=item Dumpvalue + +The Dumpvalue module provides screen dumps of Perl data. =item Benchmark +Overall, Benchmark results exhibit lower average error and better timing +accuracy. + You can now run tests for I seconds instead of guessing the right number of tests to run: e.g. timethese(-5, ...) will run each code for at least 5 CPU seconds. Zero as the "number of repetitions" means "for at least 3 CPU seconds". The output format has also changed. For example: -use Benchmark;$x=3;timethese(-5,{a=>sub{$x*$x},b=>sub{$x**2}}) + use Benchmark;$x=3;timethese(-5,{a=>sub{$x*$x},b=>sub{$x**2}}) will now output something like this: -Benchmark: running a, b, each for at least 5 CPU seconds... - a: 5 wallclock secs ( 5.77 usr + 0.00 sys = 5.77 CPU) @ 200551.91/s (n=1156516) - b: 4 wallclock secs ( 5.00 usr + 0.02 sys = 5.02 CPU) @ 159605.18/s (n=800686) + Benchmark: running a, b, each for at least 5 CPU seconds... + a: 5 wallclock secs ( 5.77 usr + 0.00 sys = 5.77 CPU) @ 200551.91/s (n=1156516) + b: 4 wallclock secs ( 5.00 usr + 0.02 sys = 5.02 CPU) @ 159605.18/s (n=800686) New features: "each for at least N CPU seconds...", "wallclock secs", and the "@ operations/CPU second (n=operations)". +timethese() now returns a reference to a hash of Benchmark objects containing +the test results, keyed on the names of the tests. + +timethis() now returns the iterations field in the Benchmark result object +instead of 0. + +timethese(), timethis(), and the new cmpthese() (see below) can also take +a format specifier of 'none' to suppress output. + +A new function countit() is just like timeit() except that it takes a +TIME instead of a COUNT. + +A new function cmpthese() prints a chart comparing the results of each test +returned from a timethese() call. For each possible pair of tests, the +percentage speed difference (iters/sec or seconds/iter) is shown. + +For other details, see L. + =item Devel::Peek The Devel::Peek module provides access to the internal representation of Perl variables and data. It is a data debugging tool for the XS programmer. +=item ExtUtils::MakeMaker + +change#4135, also needs docs in module pod +[TODO - Ilya Zakharevich ] + =item Fcntl More Fcntl constants added: F_SETLK64, F_SETLKW64, O_LARGEFILE for @@ -503,6 +1244,33 @@ working, though, so no need to get overly excited), Free/Net/OpenBSD locking behaviour flags F_FLOCK, F_POSIX, Linux F_SHLCK, and O_ACCMODE: the mask of O_RDONLY, O_WRONLY, and O_RDWR. +=item File::Compare + +A compare_text() function has been added, which allows custom +comparison functions. See L. + +=item File::Find + +File::Find now works correctly when the wanted() function is either +autoloaded or is a symbolic reference. + +A bug that caused File::Find to lose track of the working directory +when pruning top-level directories has been fixed. + +File::Find now also supports several other options to control its +behavior. It can follow symbolic links if the C option is +specified. Enabling the C option will make File::Find skip +changing the current directory when walking directories. The C +flag can be useful when running with taint checks enabled. + +See L. + +=item File::Glob + +This extension implements BSD-style file globbing. By default, +it will also be used for the internal implementation of the glob() +operator. See L. + =item File::Spec New methods have been added to the File::Spec module: devnull() returns @@ -524,9 +1292,92 @@ instead of $fullname = File::Spec->catfile($dir1, $dir2, $file); +=item Getopt::Long + +Getopt::Long licensing has changed to allow the Perl Artistic License +as well as the GPL. It used to be GPL only, which got in the way of +non-GPL applications that wanted to use Getopt::Long. + +Getopt::Long encourages the use of Pod::Usage to produce help +messages. For example: + + use Getopt::Long; + use Pod::Usage; + my $man = 0; + my $help = 0; + GetOptions('help|?' => \$help, man => \$man) or pod2usage(2); + pod2usage(1) if $help; + pod2usage(-exitstatus => 0, -verbose => 2) if $man; + + __END__ + + =head1 NAME + + sample - Using GetOpt::Long and Pod::Usage + + =head1 SYNOPSIS + + sample [options] [file ...] + + Options: + -help brief help message + -man full documentation + + =head1 OPTIONS + + =over 8 + + =item B<-help> + + Print a brief help message and exits. + + =item B<-man> + + Prints the manual page and exits. + + =back + + =head1 DESCRIPTION + + B will read the given input file(s) and do someting + useful with the contents thereof. + + =cut + +See L for details. + +A bug that prevented the non-option call-back EE from being +specified as the first argument has been fixed. + +To specify the characters E and E as option starters, use +EE. Note, however, that changing option starters is strongly +deprecated. + +=item IO + +write() and syswrite() will now accept a single-argument +form of the call, for consistency with Perl's syswrite(). + +You can now create a TCP-based IO::Socket::INET without forcing +a connect attempt. This allows you to configure its options +(like making it non-blocking) and then call connect() manually. + +A bug that prevented the IO::Socket::protocol() accessor +from ever returning the correct value has been corrected. + +=item JPL + +Java Perl Lingo is now distributed with Perl. See jpl/README +for more information. + +=item lib + +C now weeds out any trailing duplicate entries. +C removes all named entries. + =item Math::BigInt -The logical operations CE>, CE>, C<&>, C<|>, +The bitwise operations CE>, CE>, C<&>, C<|>, and C<~> are now supported on bigints. =item Math::Complex @@ -539,6 +1390,14 @@ act as mutators (accessor $z->Re(), mutator $z->Re(3)). A little bit of radial trigonometry (cylindrical and spherical), radial coordinate conversions, and the great circle distance were added. +=item Pod::Parser + +[TODO - Brad Appleton ] + +=item Pod::Text and Pod::Man + +[TODO - Russ Allbery ] + =item SDBM_File An EXISTS method has been added to this module (and sdbm_exists() has @@ -546,13 +1405,15 @@ been added to the underlying sdbm library), so one can now call exists on an SDBM_File tied hash and get the correct result, rather than a runtime error. +A bug that may have caused data loss when more than one disk block +happens to be read from the database in a single FETCH() has been +fixed. + =item Time::Local The timelocal() and timegm() functions used to silently return bogus -results when the date exceeded the machine's integer range. They -now consistently croak() if the date falls in an unsupported range-- -but on the other hand they now accept "out-of-limits" day-of-month -to make "Julian date" conversions easier. +results when the date fell outside the machine's integer range. They +now consistently croak() if the date falls in an unsupported range. =item Win32 @@ -574,7 +1435,7 @@ to the Win32::GetLastError() function. The new Win32::GetFullPathName(FILENAME) returns the full absolute pathname for FILENAME in scalar context. In list context it returns a two-element list containing the fully qualified directory name and -the filename. +the filename. See L. =item DBM Filters @@ -595,7 +1456,7 @@ See L for further information. =head2 Pragmata -C is now obsolescent, and is only provided for +C is now obsolete, and is only provided for backward-compatibility. It's been replaced by the C syntax. See L and L. @@ -606,22 +1467,50 @@ from the caller's context. C is currently the only supported attribute. Lexical warnings pragma, C, to control optional warnings. +See L. -C to control the behaviour of filetests (C<-r> C<-w> ...). -Currently only one subpragma implemented, "use filetest 'access';", -that enables the use of access(2) or equivalent to check -permissions instead of using stat(2) as usual. This matters -in filesystems where there are ACLs (access control lists): the -stat(2) might lie, but access(2) knows better. +C to control the behaviour of filetests (C<-r> C<-w> +...). Currently only one subpragma implemented, "use filetest +'access';", that uses access(2) or equivalent to check permissions +instead of using stat(2) as usual. This matters in filesystems +where there are ACLs (access control lists): the stat(2) might lie, +but access(2) knows better. =head1 Utility Changes -Todo. +=head2 h2ph + +[TODO - Kurt Starsinic ] + +=head2 perlcc + +C now supports the C and Bytecode backends. By default, +it generates output from the simple C backend rather than the +optimized C backend. + +Support for non-Unix platforms has been improved. + +=head2 h2xs + +change#4232 +[TODO - Ilya Zakharevich ] =head1 Documentation Changes =over 4 +=item perlcompile.pod + +An introduction to using the Perl Compiler suite. + +=item perlfilter.pod + +An introduction to writing Perl source filters. + +=item perlhack.pod + +Some guidelines for hacking the Perl source code. + =item perlopentut.pod A tutorial on using open() effectively. @@ -636,13 +1525,73 @@ A tutorial on managing class data for object modules. =back -=head1 New Diagnostics +=head1 New or Changed Diagnostics + +=over 4 =item "my sub" not yet implemented (F) Lexically scoped subroutines are not yet implemented. Don't try that yet. +=item '!' allowed only after types %s + +(F) The '!' is allowed in pack() and unpack() only after certain types. +See L. + +=item / cannot take a count + +(F) You had an unpack template indicating a counted-length string, +but you have also specified an explicit size for the string. +See L. + +=item / must be followed by a, A or Z + +(F) You had an unpack template indicating a counted-length string, +which must be followed by one of the letters a, A or Z +to indicate what sort of string is to be unpacked. +See L. + +=item / must be followed by a*, A* or Z* + +(F) You had a pack template indicating a counted-length string, +Currently the only things that can have their length counted are a*, A* or Z*. +See L. + +=item / must follow a numeric type + +(F) You had an unpack template that contained a '#', +but this did not follow some numeric unpack specification. +See L. + +=item /%s/: Unrecognized escape \\%c passed through + +(W) You used a backslash-character combination which is not recognized +by Perl. This combination appears in an interpolated variable or a +C<'>-delimited regular expression. The character was understood literally. + +=item /%s/: Unrecognized escape \\%c in character class passed through + +(W) You used a backslash-character combination which is not recognized +by Perl inside character classes. The character was understood literally. + +=item /%s/ should probably be written as "%s" + +(W) You have used a pattern where Perl expected to find a string, +as in the first argument to C. Perl will treat the true +or false result of matching the pattern against $_ as the string, +which is probably not what you had in mind. + +=item %s() called too early to check prototype + +(W) You've called a function that has a prototype before the parser saw a +definition or declaration for it, and Perl could not check that the call +conforms to the prototype. You need to either add an early prototype +declaration for the subroutine in question, or move the subroutine +definition ahead of the call to get proper prototype checking. Alternatively, +if you are certain that you're calling the function correctly, you may put +an ampersand before the name to avoid the warning. See L. + =item %s package attribute may clash with future reserved word: %s (W) A lowercase attribute name was used that had a package-specific handler. @@ -650,20 +1599,215 @@ That name might have a meaning to Perl itself some day, even though it doesn't yet. Perhaps you should use a mixed-case attribute name, instead. See L. -=item /%s/: Unrecognized escape \\%c passed through +=item (in cleanup) %s -(W) You used a backslash-character combination which is not recognized -by Perl. This combination appears in an interpolated variable or a -C<'>-delimited regular expression. +(W) This prefix usually indicates that a DESTROY() method raised +the indicated exception. Since destructors are usually called by +the system at arbitrary points during execution, and often a vast +number of times, the warning is issued only once for any number +of failures that would otherwise result in the same message being +repeated. + +Failure of user callbacks dispatched using the C flag +could also result in this warning. See L. + +=item <> should be quotes + +(F) You wrote CfileE> when you should have written +C. + +=item Attempt to join self + +(F) You tried to join a thread from within itself, which is an +impossible task. You may be joining the wrong thread, or you may +need to move the join() to some other thread. + +=item Bad evalled substitution pattern + +(F) You've used the /e switch to evaluate the replacement for a +substitution, but perl found a syntax error in the code to evaluate, +most likely an unexpected right brace '}'. + +=item Bad realloc() ignored + +(S) An internal routine called realloc() on something that had never been +malloc()ed in the first place. Mandatory, but can be disabled by +setting environment variable C to 1. + +=item Binary number > 0b11111111111111111111111111111111 non-portable + +(W) The binary number you specified is larger than 2**32-1 +(4294967295) and therefore non-portable between systems. See +L for more on portability concerns. + +=item Bit vector size > 32 non-portable + +(W) Using bit vector sizes larger than 32 is non-portable. + +=item Buffer overflow in prime_env_iter: %s + +(W) A warning peculiar to VMS. While Perl was preparing to iterate over +%ENV, it encountered a logical name or symbol definition which was too long, +so it was truncated to the string shown. + +=item Can't check filesystem of script "%s" + +(P) For some reason you can't check the filesystem of the script for nosuid. + +=item Can't ignore signal CHLD, forcing to default + +(W) Perl has detected that it is being run with the SIGCHLD signal +(sometimes known as SIGCLD) disabled. Since disabling this signal +will interfere with proper determination of exit status of child +processes, Perl has reset the signal to its default value. +This situation typically indicates that the parent program under +which Perl may be running (e.g. cron) is being very careless. + +=item Can't modify non-lvalue subroutine call + +(F) Subroutines meant to be used in lvalue context should be declared as +such, see L. + +=item Can't read CRTL environ + +(S) A warning peculiar to VMS. Perl tried to read an element of %ENV +from the CRTL's internal environment array and discovered the array was +missing. You need to figure out where your CRTL misplaced its environ +or define F (see L) so that environ is not searched. + +=item Can't remove %s: %s, skipping file + +(S) You requested an inplace edit without creating a backup file. Perl +was unable to remove the original file to replace it with the modified +file. The file was left unmodified. + +=item Can't return %s from lvalue subroutine + +(F) Perl detected an attempt to return illegal lvalues (such +as temporary or readonly values) from a subroutine used as an lvalue. +This is not allowed. + +=item Can't weaken a nonreference + +(F) You attempted to weaken something that was not a reference. Only +references can be weakened. + +=item Character class [:%s:] unknown + +(F) The class in the character class [: :] syntax is unknown. +See L. + +=item Character class syntax [%s] belongs inside character classes + +(W) The character class constructs [: :], [= =], and [. .] go +I character classes, the [] are part of the construct, +for example: /[012[:alpha:]345]/. Note that [= =] and [. .] +are not currently implemented; they are simply placeholders for +future extensions. + +=item Constant is not %s reference + +(F) A constant value (perhaps declared using the C pragma) +is being dereferenced, but it amounts to the wrong type of reference. The +message indicates the type of reference that was expected. This usually +indicates a syntax error in dereferencing the constant value. +See L and L. + +=item constant(%s): %%^H is not localized + +(F) When setting compile-time-lexicalized hash %^H one should set the +corresponding bit of $^H as well. + +=item constant(%s): %s + +(F) Compile-time-substitutions (such as overloaded constants and +character names) were not correctly set up. + +=item defined(@array) is deprecated + +(D) defined() is not usually useful on arrays because it checks for an +undefined I value. If you want to see if the array is empty, +just use C for example. + +=item defined(%hash) is deprecated + +(D) defined() is not usually useful on hashes because it checks for an +undefined I value. If you want to see if the hash is empty, +just use C for example. + +=item Did not produce a valid header + +See Server error. + +=item Document contains no data + +See Server error. + +=item entering effective %s failed + +(F) While under the C pragma, switching the real and +effective uids or gids failed. + +=item false [] range "%s" in regexp + +(W) A character class range must start and end at a literal character, not +another character class like C<\d> or C<[:alpha:]>. The "-" in your false +range is interpreted as a literal "-". Consider quoting the "-", "\-". +See L. =item Filehandle %s opened only for output (W) You tried to read from a filehandle opened only for writing. If you -intended it to be a read-write filehandle, you needed to open it with +intended it to be a read/write filehandle, you needed to open it with "+E" or "+E" or "+EE" instead of with "E" or nothing. If you intended only to read from the file, use "E". See L. +=item Hexadecimal number > 0xffffffff non-portable + +(W) The hexadecimal number you specified is larger than 2**32-1 +(4294967295) and therefore non-portable between systems. See +L for more on portability concerns. + +=item Ill-formed CRTL environ value "%s" + +(W) A warning peculiar to VMS. Perl tried to read the CRTL's internal +environ array, and encountered an element without the C<=> delimiter +used to spearate keys from values. The element is ignored. + +=item Ill-formed message in prime_env_iter: |%s| + +(W) A warning peculiar to VMS. Perl tried to read a logical name +or CLI symbol definition when preparing to iterate over %ENV, and +didn't see the expected delimiter between key and value, so the +line was ignored. + +=item Illegal binary digit %s + +(F) You used a digit other than 0 or 1 in a binary number. + +=item Illegal binary digit %s ignored + +(W) You may have tried to use a digit other than 0 or 1 in a binary number. +Interpretation of the binary number stopped before the offending digit. + +=item Illegal number of bits in vec + +(F) The number of bits in vec() (the third argument) must be a power of +two from 1 to 32 (or 64, if your platform supports that). + +=item Integer overflow in %s number + +(W) The hexadecimal, octal or binary number you have specified either +as a literal or as an argument to hex() or oct() is too big for your +architecture, and has been converted to a floating point number. On a +32-bit architecture the largest hexadecimal, octal or binary number +representable without overflow is 0xFFFFFFFF, 037777777777, or +0b11111111111111111111111111111111 respectively. Note that Perl +transparently promotes all numbers to a floating point representation +internally--subject to loss of precision errors in subsequent +operations. + =item Invalid %s attribute: %s The indicated attribute for a subroutine or variable was not recognized @@ -674,6 +1818,10 @@ by Perl or by a user-supplied handler. See L. The indicated attributes for a subroutine or variable were not recognized by Perl or by a user-supplied handler. See L. +=item invalid [] range "%s" in regexp + +The offending range is now explicitly displayed. + =item Invalid separator character %s in attribute list (F) Something other than a comma or whitespace was seen between the @@ -681,6 +1829,33 @@ elements of an attribute list. If the previous attribute had a parenthesised parameter list, perhaps that list was terminated too soon. See L. +=item Invalid separator character %s in subroutine attribute list + +(F) Something other than a comma or whitespace was seen between the +elements of a subroutine attribute list. If the previous attribute +had a parenthesised parameter list, perhaps that list was terminated +too soon. + +=item leaving effective %s failed + +(F) While under the C pragma, switching the real and +effective uids or gids failed. + +=item Lvalue subs returning %s not implemented yet + +(F) Due to limitations in the current implementation, array and hash +values cannot be returned in subroutines used in lvalue context. +See L. + +=item Method %s not permitted + +See Server error. + +=item Missing %sbrace%s on \N{} + +(F) Wrong syntax of character name literal C<\N{charname}> within +double-quotish context. + =item Missing command in piped open (W) You used the C or C @@ -691,10 +1866,111 @@ construction, but the command was missing or blank. (F) The reserved syntax for lexically scoped subroutines requires that they have a name with which they can be found. +=item no UTC offset information; assuming local time is UTC + +(S) A warning peculiar to VMS. Perl was unable to find the local +timezone offset, so it's assuming that local system time is equivalent +to UTC. If it's not, define the logical name F +to translate to the number of seconds which need to be added to UTC to +get local time. + +=item Octal number > 037777777777 non-portable + +(W) The octal number you specified is larger than 2**32-1 (4294967295) +and therefore non-portable between systems. See L for more +on portability concerns. + +See also L for writing portable code. + +=item panic: del_backref + +(P) Failed an internal consistency check while trying to reset a weak +reference. + +=item panic: kid popen errno read + +(F) forked child returned an incomprehensible message about its errno. + +=item panic: magic_killbackrefs + +(P) Failed an internal consistency check while trying to reset all weak +references to an object. + +=item Possible Y2K bug: %s + +(W) You are concatenating the number 19 with another number, which +could be a potential Year 2000 problem. + +=item Premature end of script headers + +See Server error. + +=item Repeat count in pack overflows + +(F) You can't specify a repeat count so large that it overflows +your signed integers. See L. + +=item Repeat count in unpack overflows + +(F) You can't specify a repeat count so large that it overflows +your signed integers. See L. + +=item realloc() of freed memory ignored + +(S) An internal routine called realloc() on something that had already +been freed. + +=item Reference is already weak + +(W) You have attempted to weaken a reference that is already weak. +Doing so has no effect. + +=item setpgrp can't take arguments + +(F) Your system has the setpgrp() from BSD 4.2, which takes no arguments, +unlike POSIX setpgid(), which takes a process ID and process group ID. + +=item Strange *+?{} on zero-length expression + +(W) You applied a regular expression quantifier in a place where it +makes no sense, such as on a zero-width assertion. +Try putting the quantifier inside the assertion instead. For example, +the way to match "abc" provided that it is followed by three +repetitions of "xyz" is C, not C. + +=item switching effective %s is not implemented + +(F) While under the C pragma, we cannot switch the +real and effective uids or gids. + +=item This Perl can't reset CRTL environ elements (%s) + +=item This Perl can't set CRTL environ elements (%s=%s) + +(W) Warnings peculiar to VMS. You tried to change or delete an element +of the CRTL's internal environ array, but your copy of Perl wasn't +built with a CRTL that contained the setenv() function. You'll need to +rebuild Perl with a CRTL that does, or redefine F (see +L) so that the environ array isn't the target of the change to +%ENV which produced the warning. + +=item Unknown open() mode '%s' + +(F) The second argument of 3-argument open() is not among the list +of valid modes: C>, C>, CE>, C<+L>, +C<+L>, C<+EE>, C<-|>, C<|->. + +=item Unknown process %x sent message to prime_env_iter: %s + +(P) An error peculiar to VMS. Perl was reading values for %ENV before +iterating over it, and someone else stuck a message in the stream of +data Perl expected. Someone's very confused, or perhaps trying to +subvert Perl's population of %ENV for nefarious purposes. + =item Unrecognized escape \\%c passed through (W) You used a backslash-character combination which is not recognized -by Perl. +by Perl. The character was understood literally. =item Unterminated attribute parameter in attribute list @@ -710,30 +1986,6 @@ of an attribute, and it wasn't a semicolon or the start of a block. Perhaps you terminated the parameter list of the previous attribute too soon. See L. -=item defined(@array) is deprecated - -(D) defined() is not usually useful on arrays because it checks for an -undefined I value. If you want to see if the array is empty, -just use C for example. - -=item defined(%hash) is deprecated - -(D) defined() is not usually useful on hashes because it checks for an -undefined I value. If you want to see if the hash is empty, -just use C for example. - -=item Invalid separator character %s in subroutine attribute list - -(F) Something other than a comma or whitespace was seen between the -elements of a subroutine attribute list. If the previous attribute -had a parenthesised parameter list, perhaps that list was terminated -too soon. - -=item Possible Y2K bug: %s - -(W) You are concatenating the number 19 with another number, which -could be a potential Year 2000 problem. - =item Unterminated attribute parameter in subroutine attribute list (F) The lexer saw an opening (left) parenthesis character while parsing a @@ -748,41 +2000,67 @@ of a subroutine attribute, and it wasn't a semicolon or the start of a block. Perhaps you terminated the parameter list of the previous attribute too soon. -=item /%s/ should probably be written as "%s" +=item Value of CLI symbol "%s" too long -(W) You have used a pattern where Perl expected to find a string, -like in the first argument to C. Perl will treat the true -or false result of matching the pattern against $_ as the string, -which is probably not what you had in mind. +(W) A warning peculiar to VMS. Perl tried to read the value of an %ENV +element from a CLI symbol table, and found a resultant string longer +than 1024 characters. The return value has been truncated to 1024 +characters. + +=item Version number must be a constant number + +(P) The attempt to translate a C statement into +its equivalent C block found an internal inconsistency with +the version number. + +=back =head1 Obsolete Diagnostics -Todo. +=over 4 -=head1 Configuration Changes +=item Character class syntax [: :] is reserved for future extensions -=head2 installusrbinperl +(W) Within regular expression character classes ([]) the syntax beginning +with "[:" and ending with ":]" is reserved for future extensions. +If you need to represent those character sequences inside a regular +expression character class, just quote the square brackets with the +backslash: "\[:" and ":\]". -You can use "Configure -Uinstallusrbinperl" which causes installperl -to skip installing perl also as /usr/bin/perl. This is useful if you -prefer not to modify /usr/bin for some reason or another but harmful -because many scripts assume to find Perl in /usr/bin/perl. +=item Ill-formed logical name |%s| in prime_env_iter -=head2 SOCKS support +(W) A warning peculiar to VMS. A logical name was encountered when preparing +to iterate over %ENV which violates the syntactic rules governing logical +names. Because it cannot be translated normally, it is skipped, and will not +appear in %ENV. This may be a benign occurrence, as some software packages +might directly modify logical name tables and introduce nonstandard names, +or it may indicate that a logical name table has been corrupted. -You can use "Configure -Dusesocks" which causes Perl to probe -for the SOCKS proxy protocol library, http://www.socks.nec.com/ +=item regexp too big -=head2 -A flag +(F) The current implementation of regular expressions uses shorts as +address offsets within a string. Unfortunately this means that if +the regular expression compiles to longer than 32767, it'll blow up. +Usually when you want a regular expression this big, there is a better +way to do it with multiple statements. See L. -You can "post-edit" the Configure variables using the Configure -A -flag. The editing happens immediately after the platform specific -hints files have been processed but before the actual configuration -process starts. Run Configure -h to find out the full -A syntax. +=item Use of "$$" to mean "${$}" is deprecated + +(D) Perl versions before 5.004 misinterpreted any type marker followed +by "$" and a digit. For example, "$$0" was incorrectly taken to mean +"${$}0" instead of "${$0}". This bug is (mostly) fixed in Perl 5.004. + +However, the developers of Perl 5.004 could not fix this bug completely, +because at least two widely-used modules depend on the old meaning of +"$$0" in a string. So Perl 5.004 still interprets "$$" in the +old (broken) way inside strings; but it generates this message as a +warning. And in Perl 5.005, this special treatment will cease. + +=back =head1 BUGS -If you find what you think is a bug, you might check the headers of +If you find what you think is a bug, you might check the articles recently posted to the comp.lang.perl.misc newsgroup. There may also be information at http://www.perl.com/perl/, the Perl Home Page. @@ -805,8 +2083,8 @@ The F and F files for copyright information. =head1 HISTORY -Written by Gurusamy Sarathy >, with many contributions -from The Perl Porters. +Written by Gurusamy Sarathy >, with many +contributions from The Perl Porters. Send omissions or corrections to >. diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 454bfc5..f82cd25 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -80,7 +80,7 @@ See L. =item / must be followed by a*, A* or Z* -(F) You had an pack template indicating a counted-length string, +(F) You had a pack template indicating a counted-length string, Currently the only things that can have their length counted are a*, A* or Z*. See L. @@ -110,12 +110,17 @@ your signed integers. See L. (W) You used a backslash-character combination which is not recognized by Perl. This combination appears in an interpolated variable or a -C<'>-delimited regular expression. +C<'>-delimited regular expression. The character was understood literally. + +=item /%s/: Unrecognized escape \\%c in character class passed through + +(W) You used a backslash-character combination which is not recognized +by Perl inside character classes. The character was understood literally. =item /%s/ should probably be written as "%s" (W) You have used a pattern where Perl expected to find a string, -like in the first argument to C. Perl will treat the true +as in the first argument to C. Perl will treat the true or false result of matching the pattern against $_ as the string, which is probably not what you had in mind. @@ -135,23 +140,23 @@ definition ahead of the call to get proper prototype checking. Alternatively, if you are certain that you're calling the function correctly, you may put an ampersand before the name to avoid the warning. See L. -=item %s argument is not a HASH element +=item %s argument is not a HASH or ARRAY element -(F) The argument to exists() must be a hash element, such as +(F) The argument to exists() must be a hash or array element, such as: $foo{$bar} - $ref->[12]->{"susie"} + $ref->[12]->["susie"] -=item %s argument is not a HASH element or slice +=item %s argument is not a HASH or ARRAY element or slice -(F) The argument to delete() must be either a hash element, such as +(F) The argument to delete() must be either a hash or array element, such as: $foo{$bar} - $ref->[12]->{"susie"} + $ref->[12]->["susie"] -or a hash slice, such as +or a hash or array slice, such as: - @foo{$bar, $baz, $xyzzy} + @foo[$bar, $baz, $xyzzy] @{$ref->[12]}{"susie", "queue"} =item %s did not return a true value @@ -275,7 +280,7 @@ the string being unpacked. See L. (F) You wrote CfileE> when you should have written C. -=item accept() on closed fd +=item accept() on closed socket (W) You tried to do an accept on a closed socket. Did you forget to check the return value of your socket() call? See L. @@ -513,7 +518,7 @@ likely depends on its correct operation, Perl just gave up. (4294967295) and therefore non-portable between systems. See L for more on portability concerns. -=item bind() on closed fd +=item bind() on closed socket (W) You tried to do a bind on a closed socket. Did you forget to check the return value of your socket() call? See L. @@ -537,7 +542,7 @@ so it was truncated to the string shown. (F) A subroutine invoked from an external package via perl_call_sv() exited by calling exit. -=item Can't "goto" outside a block +=item Can't "goto" out of a pseudo block (F) A "goto" statement was executed to jump out of what might look like a block, except that it isn't a proper block. This usually @@ -549,22 +554,24 @@ is a no-no. See L. (F) A "goto" statement was executed to jump into the middle of a foreach loop. You can't get there from here. See L. -=item Can't "last" outside a block +=item Can't "last" outside a loop block (F) A "last" statement was executed to break out of the current block, except that there's this itty bitty problem called there isn't a current block. Note that an "if" or "else" block doesn't count as a -"loopish" block, as doesn't a block given to sort(). You can usually double -the curlies to get the same effect though, because the inner curlies -will be considered a block that loops once. See L. +"loopish" block, as doesn't a block given to sort(), map() or grep(). +You can usually double the curlies to get the same effect though, +because the inner curlies will be considered a block that loops once. +See L. -=item Can't "next" outside a block +=item Can't "next" outside a loop block (F) A "next" statement was executed to reiterate the current block, but there isn't a current block. Note that an "if" or "else" block doesn't -count as a "loopish" block, as doesn't a block given to sort(). You can -usually double the curlies to get the same effect though, because the inner -curlies will be considered a block that loops once. See L. +count as a "loopish" block, as doesn't a block given to sort(), map() +or grep(). You can usually double the curlies to get the same effect +though, because the inner curlies will be considered a block that +loops once. See L. =item Can't read CRTL environ @@ -573,13 +580,14 @@ from the CRTL's internal environment array and discovered the array was missing. You need to figure out where your CRTL misplaced its environ or define F (see L) so that environ is not searched. -=item Can't "redo" outside a block +=item Can't "redo" outside a loop block (F) A "redo" statement was executed to restart the current block, but there isn't a current block. Note that an "if" or "else" block doesn't -count as a "loopish" block, as doesn't a block given to sort(). You can -usually double the curlies to get the same effect though, because the inner -curlies will be considered a block that loops once. See L. +count as a "loopish" block, as doesn't a block given to sort(), map() +or grep(). You can usually double the curlies to get the same effect +though, because the inner curlies will be considered a block that +loops once. See L. =item Can't bless non-reference value @@ -631,7 +639,7 @@ Something like this will reproduce the error: (F) You called C, but C is not a directory that you can chdir to, possibly because it doesn't exist. -=item Can't check filesystem of script "%s" +=item Can't check filesystem of script "%s" for nosuid (P) For some reason you can't check the filesystem of the script for nosuid. @@ -821,6 +829,15 @@ L. (F) The "goto subroutine" call can't be used to jump out of an eval "string". (You can use it to jump out of an eval {BLOCK}, but you probably don't want to.) +=item Can't ignore signal CHLD, forcing to default + +(W) Perl has detected that it is being run with the SIGCHLD signal +(sometimes known as SIGCLD) disabled. Since disabling this signal +will interfere with proper determination of exit status of child +processes, Perl has reset the signal to its default value. +This situation typically indicates that the parent program under +which Perl may be running (e.g. cron) is being very careless. + =item Can't localize through a reference (F) You said something like C, which Perl can't currently @@ -881,8 +898,8 @@ change it, such as with an auto-increment. =item Can't modify non-lvalue subroutine call -(F) Subroutines used in lvalue context should be marked as such, see -L. +(F) Subroutines meant to be used in lvalue context should be declared as +such, see L. =item Can't modify nonexistent substring @@ -1051,7 +1068,7 @@ most likely an unexpected right brace '}'. reference of the type needed. You can use the ref() function to test the type of the reference, if need be. -=item Can't use \1 to mean $1 in expression +=item Can't use \%c to mean $%c in expression (W) In an ordinary expression, backslash is a unary operator that creates a reference to its argument. The use of backslash to indicate a backreference @@ -1059,7 +1076,7 @@ to a matched substring is valid only as part of a regular expression pattern. Trying to do this in ordinary Perl code produces a value that prints out looking like SCALAR(0xdecaf). Use the $1 form instead. -=item Can't use bareword ("%s") as %s ref while \"strict refs\" in use +=item Can't use bareword ("%s") as %s ref while "strict refs" in use (F) Only hard references are allowed by "strict refs". Symbolic references are disallowed. See L. @@ -1113,13 +1130,15 @@ package. If method name is C, this is an internal error. =item Character class [:%s:] unknown (F) The class in the character class [: :] syntax is unknown. +See L. =item Character class syntax [%s] belongs inside character classes (W) The character class constructs [: :], [= =], and [. .] go I character classes, the [] are part of the construct, -for example: /[012[:alpha:]345]/. Note that the last two constructs -are not currently implemented, they are placeholders for future extensions. +for example: /[012[:alpha:]345]/. Note that [= =] and [. .] +are not currently implemented; they are simply placeholders for +future extensions. =item Character class syntax [. .] is reserved for future extensions @@ -1168,7 +1187,7 @@ than in the regular expression engine; or rewriting the regular expression so that it is simpler or backtracks less. (See L for information on I.) -=item connect() on closed fd +=item connect() on closed socket (W) You tried to do a connect on a closed socket. Did you forget to check the return value of your socket() call? See L. @@ -1300,10 +1319,11 @@ ugly. Your code will be interpreted as an attempt to call a method named "elseif" for the class returned by the following block. This is unlikely to be what you want. -=item END failed--cleanup aborted +=item %s failed--call queue aborted -(F) An untrapped exception was raised while executing an END subroutine. -The interpreter is immediately exited. +(F) An untrapped exception was raised while executing a STOP, INIT, or +END subroutine. Processing of the remainder of the queue of such +routines has been prematurely ended. =item entering effective %s failed @@ -1378,6 +1398,13 @@ the effect of blessing the reference into the package main. This is usually not what you want. Consider providing a default target package, e.g. bless($ref, $p || 'MyPackage'); +=item false [] range "%s" in regexp + +(W) A character class range must start and end at a literal character, not +another character class like C<\d> or C<[:alpha:]>. The "-" in your false +range is interpreted as a literal "-". Consider quoting the "-", "\-". +See L. + =item Fatal VMS error at %s, line %d (P) An error peculiar to VMS. Something untoward happened in a VMS system @@ -1407,7 +1434,7 @@ L. =item Filehandle %s opened only for output (W) You tried to read from a filehandle opened only for writing. If you -intended it to be a read-write filehandle, you needed to open it with +intended it to be a read/write filehandle, you needed to open it with "+E" or "+E" or "+EE" instead of with "E" or nothing. If you intended only to read from the file, use "E". See L. @@ -1462,7 +1489,7 @@ when you meant because if it did, it'd feel morally obligated to return every hostname on the Internet. -=item get{sock,peer}name() on closed fd +=item get%sname() on closed socket (W) You tried to get a socket or peer socket name on a closed socket. Did you forget to check the return value of your socket() call? @@ -1558,7 +1585,7 @@ don't take to this kindly. =item Illegal binary digit %s -(F) You used a digit other than 0 and 1 in a binary number. +(F) You used a digit other than 0 or 1 in a binary number. =item Illegal octal digit %s @@ -1627,7 +1654,7 @@ known value, using trustworthy data. See L. =item Integer overflow in %s number (W) The hexadecimal, octal or binary number you have specified either -as a literal in your code or as a scalar is too big for your +as a literal or as an argument to hex() or oct() is too big for your architecture, and has been converted to a floating point number. On a 32-bit architecture the largest hexadecimal, octal or binary number representable without overflow is 0xFFFFFFFF, 037777777777, or @@ -1678,11 +1705,10 @@ by Perl or by a user-supplied handler. See L. The indicated attributes for a subroutine or variable were not recognized by Perl or by a user-supplied handler. See L. -=item invalid [] range in regexp +=item invalid [] range "%s" in regexp (F) The range specified in a character class had a minimum character -greater than the maximum character, or the range didn't start/end with -a literal character. See L. +greater than the maximum character. See L. =item Invalid conversion in %s: "%s" @@ -1740,7 +1766,7 @@ L. (F) While under the C pragma, switching the real and effective uids or gids failed. -=item listen() on closed fd +=item listen() on closed socket (W) You tried to do a listen on a closed socket. Did you forget to check the return value of your socket() call? See L. @@ -1878,6 +1904,11 @@ See L. (F) A setuid script can't be specified by the user. +=item No %s specified for -%c + +(F) The indicated command line switch needs a mandatory argument, but +you haven't specified one. + =item No comma allowed after %s (F) A list operator that has a filehandle or "indirect object" is not @@ -1962,18 +1993,18 @@ your system. (F) Configure didn't find anything resembling the setreuid() call for your system. -=item No space allowed after B<-I> +=item No space allowed after -%c -(F) The argument to B<-I> must follow the B<-I> immediately with no -intervening space. +(F) The argument to the indicated command line switch must follow immediately +after the switch, without intervening spaces. -=item No such array field +=item No such pseudo-hash field "%s" (F) You tried to access an array as a hash, but the field name used is not defined. The hash at index 0 should map all valid field names to array indices for that to work. -=item No such field "%s" in variable %s of type %s +=item No such pseudo-hash field "%s" in variable %s of type %s (F) You tried to access a field of a typed variable where the type does not know about the field name. The field names are looked up in @@ -2141,6 +2172,12 @@ to use an operator, but this is highly likely to be incorrect. For example, if you say "*foo *foo" it will be interpreted as if you said "*foo * 'foo'". +=item Out of memory! + +(X) The malloc() function returned 0, indicating there was insufficient +remaining memory (or virtual memory) to satisfy the request. Perl +has no option but to exit immediately. + =item Out of memory for yacc stack (F) The yacc parser wanted to grow its stack so it could continue parsing, @@ -2333,6 +2370,10 @@ was string. (P) The lexer got into a bad state while processing a case modifier. +=item panic: %s + +(P) An internal error. + =item Parentheses missing around "%s" list (W) You said something like @@ -2363,7 +2404,7 @@ perspective, it's probably not what you intended. =item POSIX getpgrp can't take an argument -(F) Your C compiler uses POSIX getpgrp(), which takes no argument, unlike +(F) Your system has POSIX getpgrp(), which takes no argument, unlike the BSD version, which takes a pid. =item Possible Y2K bug: %s @@ -2442,12 +2483,12 @@ instead of "||". See Server error. -=item print on closed filehandle %s +=item print() on closed filehandle %s (W) The filehandle you're printing on got itself closed sometime before now. Check your logic flow. -=item printf on closed filehandle %s +=item printf() on closed filehandle %s (W) The filehandle you're writing to got itself closed sometime before now. Check your logic flow. @@ -2472,7 +2513,7 @@ are outside the range which can be represented by integers internally. One possible workaround is to force Perl to use magical string increment by prepending "0" to your numbers. -=item Read on closed filehandle %s +=item readline() on closed filehandle %s (W) The filehandle you're reading from got itself closed sometime before now. Check your logic flow. @@ -2613,9 +2654,9 @@ that had previously been marked as free. (W) A nearby syntax error was probably caused by a missing semicolon, or possibly some other missing operator, such as a comma. -=item Send on closed socket +=item send() on closed socket -(W) The filehandle you're sending to got itself closed sometime before now. +(W) The socket you're sending to got itself closed sometime before now. Check your logic flow. =item Sequence (? incomplete @@ -2676,6 +2717,11 @@ think so. the seteuid() system call (or equivalent), or at least Configure didn't think so. +=item setpgrp can't take arguments + +(F) Your system has the setpgrp() from BSD 4.2, which takes no arguments, +unlike POSIX setpgid(), which takes a process ID and process group ID. + =item setrgid() not implemented (F) You tried to assign to C<$(>, and your operating system doesn't support @@ -2697,7 +2743,7 @@ because the world might have written on it already. (F) You don't have System V shared memory IPC on your system. -=item shutdown() on closed fd +=item shutdown() on closed socket (W) You tried to do a shutdown on a closed socket. Seems a bit superfluous. @@ -2835,7 +2881,7 @@ into Perl yourself. machine. In some machines the functionality can exist but be unconfigured. Consult your system support. -=item Syswrite on closed filehandle +=item syswrite() on closed filehandle (W) The filehandle you're writing to got itself closed sometime before now. Check your logic flow. @@ -2889,7 +2935,7 @@ will deny it. if the last stat that wrote to the stat buffer already went past the symlink to get to the real file. Use an actual filename instead. -=item This Perl can't reset CRTL eviron elements (%s) +=item This Perl can't reset CRTL environ elements (%s) =item This Perl can't set CRTL environ elements (%s=%s) @@ -3056,9 +3102,9 @@ representative, who probably put it there in the first place. =item Unknown open() mode '%s' -(F) The second argument of 3-arguments open is not one from the list -of C>, C>, CE>, C<+L>, C<+L>, -C<+EE>, C<-|>, C<|-> of possible open() modes. +(F) The second argument of 3-argument open() is not among the list +of valid modes: C>, C>, CE>, C<+L>, +C<+L>, C<+EE>, C<-|>, C<|->. =item Unknown process %x sent message to prime_env_iter: %s @@ -3228,7 +3274,7 @@ e.g. C<&our()>, or C. because there's a better way to do it, and also because the old way has bad side effects. -=item Use of uninitialized value +=item Use of uninitialized value%s (W) An undefined value was used as if it were already defined. It was interpreted as a "" or a 0, but maybe it was a mistake. To suppress this @@ -3403,7 +3449,7 @@ but in actual fact, you got So put in parentheses to say what you really mean. -=item Write on closed filehandle %s +=item write() on closed filehandle %s (W) The filehandle you're writing to got itself closed sometime before now. Check your logic flow. @@ -3446,11 +3492,11 @@ already have a subroutine of that name declared, which means that Perl 5 will try to call the subroutine when the assignment is executed, which is probably not what you want. (If it IS what you want, put an & in front.) -=item [gs]etsockopt() on closed fd +=item %cetsockopt() on closed fd (W) You tried to get or set a socket option on a closed socket. Did you forget to check the return value of your socket() call? -See L. +See L and L. =item \1 better written as $1 diff --git a/pod/perlfaq2.pod b/pod/perlfaq2.pod index d5bbb56..80b150d 100644 --- a/pod/perlfaq2.pod +++ b/pod/perlfaq2.pod @@ -1,6 +1,6 @@ =head1 NAME -perlfaq2 - Obtaining and Learning about Perl ($Revision: 1.31 $, $Date: 1999/04/14 03:46:19 $) +perlfaq2 - Obtaining and Learning about Perl ($Revision: 1.32 $, $Date: 1999/10/14 18:46:09 $) =head1 DESCRIPTION @@ -344,10 +344,10 @@ following list is I the complete list of CPAN mirrors. Most of the major modules (Tk, CGI, libwww-perl) have their own mailing lists. Consult the documentation that came with the module for -subscription information. The Perl Institute attempts to maintain a +subscription information. Perl Mongers attempts to maintain a list of mailing lists at: - http://www.perl.org/maillist.html + http://www.perl.org/support/online_support.html#mail =head2 Archives of comp.lang.perl.misc @@ -436,7 +436,7 @@ bugs. Read the perlbug(1) man page (perl5.004 or later) for more information. -=head2 What is perl.com? +=head2 What is perl.com? Perl Mongers? pm.org? perl.org? The perl.com domain is owned by Tom Christiansen, who created it as a public service long before perl.org came about. Despite the name, it's a @@ -451,6 +451,24 @@ Other starting points include http://conference.perl.com/ http://reference.perl.com/ +Perl Mongers is an advocacy organization for the Perl language. For +details, see the Perl Mongers web site at http://www.perlmongers.org/. + +Perl Mongers uses the pm.org domain for services related to Perl user +groups. See the Perl user group web site at http://www.pm.org/ for more +information about joining, starting, or requesting services for a Perl +user group. + +Perl Mongers also maintains the perl.org domain to provide general +support services to the Perl community, including the hosting of mailing +lists, web sites, and other services. The web site +http://www.perl.org/ is a general advocacy site for the Perl language, +and there are many other sub-domains for special topics, such as + + http://history.perl.org/ + http://bugs.perl.org/ + http://www.news.perl.org/ + =head1 AUTHOR AND COPYRIGHT Copyright (c) 1997-1999 Tom Christiansen and Nathan Torkington. diff --git a/pod/perlfaq3.pod b/pod/perlfaq3.pod index 26f7a69..18c436b 100644 --- a/pod/perlfaq3.pod +++ b/pod/perlfaq3.pod @@ -483,7 +483,7 @@ The Win95/NT installation, when using the ActiveState port of Perl, will modify the Registry to associate the C<.pl> extension with the perl interpreter. If you install another port, perhaps even building your own Win95/NT Perl from the standard sources by using a Windows port -of gcc (e.g., with cygwin32 or mingw32), then you'll have to modify +of gcc (e.g., with cygwin or mingw32), then you'll have to modify the Registry yourself. In addition to associating C<.pl> with the interpreter, NT people can use: C to let them run the program C merely by typing C. diff --git a/pod/perlfaq4.pod b/pod/perlfaq4.pod index 63e093f..838f753 100644 --- a/pod/perlfaq4.pod +++ b/pod/perlfaq4.pod @@ -1746,7 +1746,7 @@ if you just want to say, ``Is this a float?'' } } - sub is_numeric { defined &getnum } + sub is_numeric { defined getnum($_[0]) } Or you could check out http://www.perl.com/CPAN/modules/by-module/String/String-Scanf-1.1.tar.gz diff --git a/pod/perlfaq8.pod b/pod/perlfaq8.pod index 26efa3f..f8dda0d 100644 --- a/pod/perlfaq8.pod +++ b/pod/perlfaq8.pod @@ -935,7 +935,7 @@ the current process group of your controlling terminal as follows: =head2 How do I timeout a slow event? Use the alarm() function, probably in conjunction with a signal -handler, as documented L and chapter 6 of the +handler, as documented in L and chapter 6 of the Camel. You may instead use the more flexible Sys::AlarmCall module available from CPAN. diff --git a/pod/perlfaq9.pod b/pod/perlfaq9.pod index 3da9bc1..7fc0cdc 100644 --- a/pod/perlfaq9.pod +++ b/pod/perlfaq9.pod @@ -77,7 +77,9 @@ stamp prepended. =head2 How do I remove HTML from a string? The most correct way (albeit not the fastest) is to use HTML::Parser -from CPAN (part of the HTML-Tree package on CPAN). +from CPAN (part of the HTML-Tree package on CPAN). Another correct +way is to use HTML::FormatText which not only removes HTML but also +attempts to do a little simple formatting of the resulting plain text. Many folks attempt a simple-minded regular expression approach, like C.*?E//g>, but that fails in many cases because the tags diff --git a/pod/perlfilter.pod b/pod/perlfilter.pod new file mode 100644 index 0000000..a2eb1d8 --- /dev/null +++ b/pod/perlfilter.pod @@ -0,0 +1,571 @@ +=head1 NAME + +perlfilter - Source Filters + + +=head1 DESCRIPTION + +This article is about a little-known feature of Perl called +I. Source filters alter the program text of a module +before Perl sees it, much as a C preprocessor alters the source text of +a C program before the compiler sees it. This article tells you more +about what source filters are, how they work, and how to write your +own. + +The original purpose of source filters was to let you encrypt your +program source to prevent casual piracy. This isn't all they can do, as +you'll soon learn. But first, the basics. + +=head1 CONCEPTS + +Before the Perl interpreter can execute a Perl script, it must first +read it from a file into memory for parsing and compilation. (Even +scripts specified on the command line with the C<-e> option are stored in +a temporary file for the parser to process.) If that script itself +includes other scripts with a C or C statement, then each +of those scripts will have to be read from their respective files as +well. + +Now think of each logical connection between the Perl parser and an +individual file as a I. A source stream is created when +the Perl parser opens a file, it continues to exist as the source code +is read into memory, and it is destroyed when Perl is finished parsing +the file. If the parser encounters a C or C statement in +a source stream, a new and distinct stream is created just for that +file. + +The diagram below represents a single source stream, with the flow of +source from a Perl script file on the left into the Perl parser on the +right. This is how Perl normally operates. + + file -------> parser + +There are two important points to remember: + +=over 5 + +=item 1. + +Although there can be any number of source streams in existence at any +given time, only one will be active. + +=item 2. + +Every source stream is associated with only one file. + +=back + +A source filter is a special kind of Perl module that intercepts and +modifies a source stream before it reaches the parser. A source filter +changes our diagram like this: + + file ----> filter ----> parser + +If that doesn't make much sense, consider the analogy of a command +pipeline. Say you have a shell script stored in the compressed file +I. The simple pipeline command below runs the script without +needing to create a temporary file to hold the uncompressed file. + + gunzip -c trial.gz | sh + +In this case, the data flow from the pipeline can be represented as follows: + + trial.gz ----> gunzip ----> sh + +With source filters, you can store the text of your script compressed and use a source filter to uncompress it for Perl's parser: + + compressed gunzip + Perl program ---> source filter ---> parser + +=head1 USING FILTERS + +So how do you use a source filter in a Perl script? Above, I said that +a source filter is just a special kind of module. Like all Perl +modules, a source filter is invoked with a use statement. + +Say you want to pass your Perl source through the C preprocessor before +execution. You could use the existing C<-P> command line option to do +this, but as it happens, the source filters distribution comes with a C +preprocessor filter module called Filter::cpp. Let's use that instead. + +Below is an example program, C, which makes use of this filter. +Line numbers have been added to allow specific lines to be referenced +easily. + + 1: use Filter::cpp ; + 2: #define TRUE 1 + 3: $a = TRUE ; + 4: print "a = $a\n" ; + +When you execute this script, Perl creates a source stream for the +file. Before the parser processes any of the lines from the file, the +source stream looks like this: + + cpp_test ---------> parser + +Line 1, C, includes and installs the C filter +module. All source filters work this way. The use statement is compiled +and executed at compile time, before any more of the file is read, and +it attaches the cpp filter to the source stream behind the scenes. Now +the data flow looks like this: + + cpp_test ----> cpp filter ----> parser + +As the parser reads the second and subsequent lines from the source +stream, it feeds those lines through the C source filter before +processing them. The C filter simply passes each line through the +real C preprocessor. The output from the C preprocessor is then +inserted back into the source stream by the filter. + + .-> cpp --. + | | + | | + | <-' + cpp_test ----> cpp filter ----> parser + +The parser then sees the following code: + + use Filter::cpp ; + $a = 1 ; + print "a = $a\n" ; + +Let's consider what happens when the filtered code includes another +module with use: + + 1: use Filter::cpp ; + 2: #define TRUE 1 + 3: use Fred ; + 4: $a = TRUE ; + 5: print "a = $a\n" ; + +The C filter does not apply to the text of the Fred module, only +to the text of the file that used it (C). Although the use +statement on line 3 will pass through the cpp filter, the module that +gets included (C) will not. The source streams look like this +after line 3 has been parsed and before line 4 is parsed: + + cpp_test ---> cpp filter ---> parser (INACTIVE) + + Fred.pm ----> parser + +As you can see, a new stream has been created for reading the source +from C. This stream will remain active until all of C +has been parsed. The source stream for C will still exist, +but is inactive. Once the parser has finished reading Fred.pm, the +source stream associated with it will be destroyed. The source stream +for C then becomes active again and the parser reads line 4 +and subsequent lines from C. + +You can use more than one source filter on a single file. Similarly, +you can reuse the same filter in as many files as you like. + +For example, if you have a uuencoded and compressed source file, it is +possible to stack a uudecode filter and an uncompression filter like +this: + + use Filter::uudecode ; use Filter::uncompress ; + M'XL(".H7/;1I;_>_I3=&E=%:F*I"T?22Q/ + M6]9* + ... + +Once the first line has been processed, the flow will look like this: + + file ---> uudecode ---> uncompress ---> parser + filter filter + +Data flows through filters in the same order they appear in the source +file. The uudecode filter appeared before the uncompress filter, so the +source file will be uudecoded before it's uncompressed. + +=head1 WRITING A SOURCE FILTER + +There are three ways to write your own source filter. You can write it +in C, use an external program as a filter, or write the filter in Perl. +I won't cover the first two in any great detail, so I'll get them out +of the way first. Writing the filter in Perl is most convenient, so +I'll devote the most space to it. + +=head1 WRITING A SOURCE FILTER IN C + +The first of the three available techniques is to write the filter +completely in C. The external module you create interfaces directly +with the source filter hooks provided by Perl. + +The advantage of this technique is that you have complete control over +the implementation of your filter. The big disadvantage is the +increased complexity required to write the filter - not only do you +need to understand the source filter hooks, but you also need a +reasonable knowledge of Perl guts. One of the few times it is worth +going to this trouble is when writing a source scrambler. The +C filter (which unscrambles the source before Perl parses it) +included with the source filter distribution is an example of a C +source filter (see Decryption Filters, below). + + +=over 5 + +=item B + +All decryption filters work on the principle of "security through +obscurity." Regardless of how well you write a decryption filter and +how strong your encryption algorithm, anyone determined enough can +retrieve the original source code. The reason is quite simple - once +the decryption filter has decrypted the source back to its original +form, fragments of it will be stored in the computer's memory as Perl +parses it. The source might only be in memory for a short period of +time, but anyone possessing a debugger, skill, and lots of patience can +eventually reconstruct your program. + +That said, there are a number of steps that can be taken to make life +difficult for the potential cracker. The most important: Write your +decryption filter in C and statically link the decryption module into +the Perl binary. For further tips to make life difficult for the +potential cracker, see the file I in the source filters +module. + +=back + +=head1 CREATING A SOURCE FILTER AS A SEPARATE EXECUTABLE + +An alternative to writing the filter in C is to create a separate +executable in the language of your choice. The separate executable +reads from standard input, does whatever processing is necessary, and +writes the filtered data to standard output. C is an +example of a source filter implemented as a separate executable - the +executable is the C preprocessor bundled with your C compiler. + +The source filter distribution includes two modules that simplify this +task: C and C. Both allow you to run any +external executable. Both use a coprocess to control the flow of data +into and out of the external executable. (For details on coprocesses, +see Stephens, W.R. "Advanced Programming in the UNIX Environment." +Addison-Wesley, ISBN 0-210-56317-7, pages 441-445.) The difference +between them is that C spawns the external command +directly, while C spawns a shell to execute the external +command. (Unix uses the Bourne shell; NT uses the cmd shell.) Spawning +a shell allows you to make use of the shell metacharacters and +redirection facilities. + +Here is an example script that uses C: + + use Filter::sh 'tr XYZ PQR' ; + $a = 1 ; + print "XYZ a = $a\n" ; + +The output you'll get when the script is executed: + + PQR a = 1 + +Writing a source filter as a separate executable works fine, but a +small performance penalty is incurred. For example, if you execute the +small example above, a separate subprocess will be created to run the +Unix C command. Each use of the filter requires its own subprocess. +If creating subprocesses is expensive on your system, you might want to +consider one of the other options for creating source filters. + +=head1 WRITING A SOURCE FILTER IN PERL + +The easiest and most portable option available for creating your own +source filter is to write it completely in Perl. To distinguish this +from the previous two techniques, I'll call it a Perl source filter. + +To help understand how to write a Perl source filter we need an example +to study. Here is a complete source filter that performs rot13 +decoding. (Rot13 is a very simple encryption scheme used in Usenet +postings to hide the contents of offensive posts. It moves every letter +forward thirteen places, so that A becomes N, B becomes O, and Z +becomes M.) + + + package Rot13 ; + + use Filter::Util::Call ; + + sub import { + my ($type) = @_ ; + my ($ref) = [] ; + filter_add(bless $ref) ; + } + + sub filter { + my ($self) = @_ ; + my ($status) ; + + tr/n-za-mN-ZA-M/a-zA-Z/ + if ($status = filter_read()) > 0 ; + $status ; + } + + 1; + +All Perl source filters are implemented as Perl classes and have the +same basic structure as the example above. + +First, we include the C module, which exports a +number of functions into your filter's namespace. The filter shown +above uses two of these functions, C and +C. + +Next, we create the filter object and associate it with the source +stream by defining the C function. If you know Perl well +enough, you know that C is called automatically every time a +module is included with a use statement. This makes C the ideal +place to both create and install a filter object. + +In the example filter, the object (C<$ref>) is blessed just like any +other Perl object. Our example uses an anonymous array, but this isn't +a requirement. Because this example doesn't need to store any context +information, we could have used a scalar or hash reference just as +well. The next section demonstrates context data. + +The association between the filter object and the source stream is made +with the C function. This takes a filter object as a +parameter (C<$ref> in this case) and installs it in the source stream. + +Finally, there is the code that actually does the filtering. For this +type of Perl source filter, all the filtering is done in a method +called C. (It is also possible to write a Perl source filter +using a closure. See the C manual page for more +details.) It's called every time the Perl parser needs another line of +source to process. The C method, in turn, reads lines from +the source stream using the C function. + +If a line was available from the source stream, C +returns a status value greater than zero and appends the line to C<$_>. +A status value of zero indicates end-of-file, less than zero means an +error. The filter function itself is expected to return its status in +the same way, and put the filtered line it wants written to the source +stream in C<$_>. The use of C<$_> accounts for the brevity of most Perl +source filters. + +In order to make use of the rot13 filter we need some way of encoding +the source file in rot13 format. The script below, C, does +just that. + + die "usage mkrot13 filename\n" unless @ARGV ; + my $in = $ARGV[0] ; + my $out = "$in.tmp" ; + open(IN, "<$in") or die "Cannot open file $in: $!\n"; + open(OUT, ">$out") or die "Cannot open file $out: $!\n"; + + print OUT "use Rot13;\n" ; + while () { + tr/a-zA-Z/n-za-mN-ZA-M/ ; + print OUT ; + } + + close IN; + close OUT; + unlink $in; + rename $out, $in; + +If we encrypt this with C: + + print " hello fred \n" ; + +the result will be this: + + use Rot13; + cevag "uryyb serq\a" ; + +Running it produces this output: + + hello fred + +=head1 USING CONTEXT: THE DEBUG FILTER + +The rot13 example was a trivial example. Here's another demonstration +that shows off a few more features. + +Say you wanted to include a lot of debugging code in your Perl script +during development, but you didn't want it available in the released +product. Source filters offer a solution. In order to keep the example +simple, let's say you wanted the debugging output to be controlled by +an environment variable, C. Debugging code is enabled if the +variable exists, otherwise it is disabled. + +Two special marker lines will bracket debugging code, like this: + + ## DEBUG_BEGIN + if ($year > 1999) { + warn "Debug: millennium bug in year $year\n" ; + } + ## DEBUG_END + +When the C environment variable exists, the filter ensures that +Perl parses only the code between the C and C +markers. That means that when C does exist, the code above +should be passed through the filter unchanged. The marker lines can +also be passed through as-is, because the Perl parser will see them as +comment lines. When C isn't set, we need a way to disable the +debug code. A simple way to achieve that is to convert the lines +between the two markers into comments: + + ## DEBUG_BEGIN + #if ($year > 1999) { + # warn "Debug: millennium bug in year $year\n" ; + #} + ## DEBUG_END + +Here is the complete Debug filter: + + package Debug; + + use strict; + use Filter::Util::Call ; + + use constant TRUE => 1 ; + use constant FALSE => 0 ; + + sub import { + my ($type) = @_ ; + my (%context) = ( + Enabled => defined $ENV{DEBUG}, + InTraceBlock => FALSE, + Filename => (caller)[1], + LineNo => 0, + LastBegin => 0, + ) ; + filter_add(bless \%context) ; + } + + sub Die { + my ($self) = shift ; + my ($message) = shift ; + my ($line_no) = shift || $self->{LastBegin} ; + die "$message at $self->{Filename} line $line_no.\n" + } + + sub filter { + my ($self) = @_ ; + my ($status) ; + $status = filter_read() ; + ++ $self->{LineNo} ; + + # deal with EOF/error first + if ($status <= 0) { + $self->Die("DEBUG_BEGIN has no DEBUG_END") + if $self->{InTraceBlock} ; + return $status ; + } + + if ($self->{InTraceBlock}) { + if (/^\s*##\s*DEBUG_BEGIN/ ) { + $self->Die("Nested DEBUG_BEGIN", $self->{LineNo}) + } elsif (/^\s*##\s*DEBUG_END/) { + $self->{InTraceBlock} = FALSE ; + } + + # comment out the debug lines when the filter is disabled + s/^/#/ if ! $self->{Enabled} ; + } elsif ( /^\s*##\s*DEBUG_BEGIN/ ) { + $self->{InTraceBlock} = TRUE ; + $self->{LastBegin} = $self->{LineNo} ; + } elsif ( /^\s*##\s*DEBUG_END/ ) { + $self->Die("DEBUG_END has no DEBUG_BEGIN", $self->{LineNo}); + } + return $status ; + } + + 1 ; + +The big difference between this filter and the previous example is the +use of context data in the filter object. The filter object is based on +a hash reference, and is used to keep various pieces of context +information between calls to the filter function. All but two of the +hash fields are used for error reporting. The first of those two, +Enabled, is used by the filter to determine whether the debugging code +should be given to the Perl parser. The second, InTraceBlock, is true +when the filter has encountered a C line, but has not yet +encountered the following C line. + +If you ignore all the error checking that most of the code does, the +essence of the filter is as follows: + + sub filter { + my ($self) = @_ ; + my ($status) ; + $status = filter_read() ; + + # deal with EOF/error first + return $status if $status <= 0 ; + if ($self->{InTraceBlock}) { + if (/^\s*##\s*DEBUG_END/) { + $self->{InTraceBlock} = FALSE + } + + # comment out debug lines when the filter is disabled + s/^/#/ if ! $self->{Enabled} ; + } elsif ( /^\s*##\s*DEBUG_BEGIN/ ) { + $self->{InTraceBlock} = TRUE ; + } + return $status ; + } + +Be warned: just as the C-preprocessor doesn't know C, the Debug filter +doesn't know Perl. It can be fooled quite easily: + + print < environment variable can then be used to control which +blocks get included. + +Once you can identify individual blocks, try allowing them to be +nested. That isn't difficult either. + +Here is a interesting idea that doesn't involve the Debug filter. +Currently Perl subroutines have fairly limited support for formal +parameter lists. You can specify the number of parameters and their +type, but you still have to manually take them out of the C<@_> array +yourself. Write a source filter that allows you to have a named +parameter list. Such a filter would turn this: + + sub MySub ($first, $second, @rest) { ... } + +into this: + + sub MySub($$@) { + my ($first) = shift ; + my ($second) = shift ; + my (@rest) = @_ ; + ... + } + +Finally, if you feel like a real challenge, have a go at writing a +full-blown Perl macro preprocessor as a source filter. Borrow the +useful features from the C preprocessor and any other macro processors +you know. The tricky bit will be choosing how much knowledge of Perl's +syntax you want your filter to have. + +=head1 REQUIREMENTS + +The Source Filters distribution is available on CPAN, in + + CPAN/modules/by-module/Filter + +=head1 AUTHOR + +Paul Marquess EPaul.Marquess@btinternet.comE + +=head1 Copyrights + +This article originally appeared in The Perl Journal #11, and is +copyright 1998 The Perl Journal. It appears courtesy of Jon Orwant and +The Perl Journal. This document may be distributed under the same terms +as Perl itself. diff --git a/pod/perlfork.pod b/pod/perlfork.pod new file mode 100644 index 0000000..533dcfa --- /dev/null +++ b/pod/perlfork.pod @@ -0,0 +1,232 @@ +=head1 NAME + +perlfork - Perl's fork() emulation + +=head1 SYNOPSIS + +Perl provides a fork() keyword that corresponds to the Unix system call +of the same name. On most Unix-like platforms where the fork() system +call is available, Perl's fork() simply calls it. + +On some platforms such as Windows where the fork() system call is not +available, Perl can be built to emulate fork() at the interpreter level. +While the emulation is designed to be as compatible as possible with the +real fork() at the the level of the Perl program, there are certain +important differences that stem from the fact that all the pseudo child +"processes" created this way live in the same real process as far as the +operating system is concerned. + +This document provides a general overview of the capabilities and +limitations of the fork() emulation. Note that the issues discussed here +are not applicable to platforms where a real fork() is available and Perl +has been configured to use it. + +=head1 DESCRIPTION + +The fork() emulation is implemented at the level of the Perl interpreter. +What this means in general is that running fork() will actually clone the +running interpreter and all its state, and run the cloned interpreter in +a separate thread, beginning execution in the new thread just after the +point where the fork() was called in the parent. We will refer to the +thread that implements this child "process" as the pseudo-process. + +To the Perl program that called fork(), all this is designed to be +transparent. The parent returns from the fork() with a pseudo-process +ID that can be subsequently used in any process manipulation functions; +the child returns from the fork() with a value of C<0> to signify that +it is the child pseudo-process. + +=head2 Behavior of other Perl features in forked pseudo-processes + +Most Perl features behave in a natural way within pseudo-processes. + +=over 8 + +=item $$ or $PROCESS_ID + +This special variable is correctly set to the pseudo-process ID. +It can be used to identify pseudo-processes within a particular +session. Note that this value is subject to recycling if any +pseudo-processes are launched after others have been wait()-ed on. + +=item %ENV + +Each pseudo-process maintains its own virtual enviroment. Modifications +to %ENV affect the virtual environment, and are only visible within that +pseudo-process, and in any processes (or pseudo-processes) launched from +it. + +=item chdir() and all other builtins that accept filenames + +Each pseudo-process maintains its own virtual idea of the current directory. +Modifications to the current directory using chdir() are only visible within +that pseudo-process, and in any processes (or pseudo-processes) launched from +it. All file and directory accesses from the pseudo-process will correctly +map the virtual working directory to the real working directory appropriately. + +=item wait() and waitpid() + +wait() and waitpid() can be passed a pseudo-process ID returned by fork(). +These calls will properly wait for the termination of the pseudo-process +and return its status. + +=item kill() + +kill() can be used to terminate a pseudo-process by passing it the ID returned +by fork(). This should not be used except under dire circumstances, because +the operating system may not guarantee integrity of the process resources +when a running thread is terminated. Note that using kill() on a +pseudo-process() may typically cause memory leaks, because the thread that +implements the pseudo-process does not get a chance to clean up its resources. + +=item exec() + +Calling exec() within a pseudo-process actually spawns the requested +executable in a separate process and waits for it to complete before +exiting with the same exit status as that process. This means that the +process ID reported within the running executable will be different from +what the earlier Perl fork() might have returned. Similarly, any process +manipulation functions applied to the ID returned by fork() will affect the +waiting pseudo-process that called exec(), not the real process it is +waiting for after the exec(). + +=item exit() + +exit() always exits just the executing pseudo-process, after automatically +wait()-ing for any outstanding child pseudo-processes. Note that this means +that the process as a whole will not exit unless all running pseudo-processes +have exited. + +=item Open handles to files, directories and network sockets + +All open handles are dup()-ed in pseudo-processes, so that closing +any handles in one process does not affect the others. See below for +some limitations. + +=back + +=head2 Resource limits + +In the eyes of the operating system, pseudo-processes created via the fork() +emulation are simply threads in the same process. This means that any +process-level limits imposed by the operating system apply to all +pseudo-processes taken together. This includes any limits imposed by the +operating system on the number of open file, directory and socket handles, +limits on disk space usage, limits on memory size, limits on CPU utilization +etc. + +=head2 Killing the parent process + +If the parent process is killed (either using Perl's kill() builtin, or +using some external means) all the pseudo-processes are killed as well, +and the whole process exits. + +=head2 Lifetime of the parent process and pseudo-processes + +During the normal course of events, the parent process and every +pseudo-process started by it will wait for their respective pseudo-children +to complete before they exit. This means that the parent and every +pseudo-child created by it that is also a pseudo-parent will only exit +after their pseudo-children have exited. + +A way to mark a pseudo-processes as running detached from their parent (so +that the parent would not have to wait() for them if it doesn't want to) +will be provided in future. + +=head2 CAVEATS AND LIMITATIONS + +=over 8 + +=item BEGIN blocks + +The fork() emulation will not work entirely correctly when called from +within a BEGIN block. The forked copy will run the contents of the +BEGIN block, but will not continue parsing the source stream after the +BEGIN block. For example, consider the following code: + + BEGIN { + fork and exit; # fork child and exit the parent + print "inner\n"; + } + print "outer\n"; + +This will print: + + inner + +rather than the expected: + + inner + outer + +This limitation arises from fundamental technical difficulties in +cloning and restarting the stacks used by the Perl parser in the +middle of a parse. + +=item Open filehandles + +Any filehandles open at the time of the fork() will be dup()-ed. Thus, +the files can be closed independently in the parent and child, but beware +that the dup()-ed handles will still share the same seek pointer. Changing +the seek position in the parent will change it in the child and vice-versa. +One can avoid this by opening files that need distinct seek pointers +separately in the child. + +=item Global state maintained by XSUBs + +External subroutines (XSUBs) that maintain their own global state may +not work correctly. Such XSUBs will either need to maintain locks to +protect simultaneous access to global data from different pseudo-processes, +or maintain all their state on the Perl symbol table, which is copied +naturally when fork() is called. A callback mechanism that provides +extensions an opportunity to clone their state will be provided in the +near future. + +=item Interpreter embedded in larger application + +The fork() emulation may not behave as expected when it is executed in an +application which embeds a Perl interpreter and calls Perl APIs that can +evaluate bits of Perl code. This stems from the fact that the emulation +only has knowledge about the Perl interpreter's own data structures and +knows nothing about the containing application's state. For example, any +state carried on the application's own call stack is out of reach. + +=item Thread-safety of extensions + +Since the fork() emulation runs code in multiple threads, extensions +calling into non-thread-safe libraries may not work reliably when +calling fork(). As Perl's threading support gradually becomes more +widely adopted even on platforms with a native fork(), such extensions +are expected to be fixed for thread-safety. + +=back + +=head1 BUGS + +=over 8 + +=item * + +Having pseudo-process IDs be negative integers breaks down for the integer +C<-1> because the wait() and waitpid() functions treat this number as +being special. The tacit assumption in the current implementation is that +the system never allocates a thread ID of C<1> for user threads. A better +representation for pseudo-process IDs will be implemented in future. + +=item * + +This document may be incomplete in some respects. + +=head1 AUTHOR + +Support for concurrent interpreters and the fork() emulation was implemented +by ActiveState, with funding from Microsoft Corporation. + +This document is authored and maintained by Gurusamy Sarathy +Egsar@activestate.comE. + +=head1 SEE ALSO + +L, L + +=cut diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index 82c0521..d730b43 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -515,12 +515,12 @@ to go back before the current one. ($package, $filename, $line, $subroutine, $hasargs, $wantarray, $evaltext, $is_require, $hints) = caller($i); -Here $subroutine may be C<"(eval)"> if the frame is not a subroutine +Here $subroutine may be C<(eval)> if the frame is not a subroutine call, but an C. In such a case additional elements $evaltext and C<$is_require> are set: C<$is_require> is true if the frame is created by a C or C statement, $evaltext contains the text of the C statement. In particular, for a C statement, -$filename is C<"(eval)">, but $evaltext is undefined. (Note also that +$filename is C<(eval)>, but $evaltext is undefined. (Note also that each C statement creates a C frame inside an C) frame. C<$hints> contains pragmatic hints that the caller was compiled with. It currently only reflects the hint corresponding to @@ -669,7 +669,7 @@ If NUMBER is omitted, uses C<$_>. This function works like the system call by the same name: it makes the named directory the new root directory for all further pathnames that -begin with a C<"/"> by your process and all its children. (It doesn't +begin with a C by your process and all its children. (It doesn't change your current working directory, which is unaffected.) For security reasons, this call is restricted to the superuser. If FILENAME is omitted, does a C to C<$_>. @@ -925,35 +925,55 @@ See also L, L, L. =item delete EXPR -Deletes the specified key(s) and their associated values from a hash. -For each key, returns the deleted value associated with that key, or -the undefined value if there was no such key. Deleting from C<$ENV{}> -modifies the environment. Deleting from a hash tied to a DBM file -deletes the entry from the DBM file. (But deleting from a Cd hash -doesn't necessarily return anything.) +Given an expression that specifies a hash element, array element, hash slice, +or array slice, deletes the specified element(s) from the hash or array. +If the array elements happen to be at the end of the array, the size +of the array will shrink by that number of elements. -The following deletes all the values of a hash: +Returns each element so deleted or the undefined value if there was no such +element. Deleting from C<$ENV{}> modifies the environment. Deleting from +a hash tied to a DBM file deletes the entry from the DBM file. Deleting +from a Cd hash or array may not necessarily return anything. + +Deleting an array element effectively returns that position of the array +to its initial, uninitialized state. Subsequently testing for the same +element with exists() will return false. See L. + +The following (inefficiently) deletes all the values of %HASH and @ARRAY: foreach $key (keys %HASH) { delete $HASH{$key}; } -And so does this: + foreach $index (0 .. $#ARRAY) { + delete $ARRAY[$index]; + } + +And so do these: - delete @HASH{keys %HASH} + delete @HASH{keys %HASH}; + + delete @ARRAY[0 .. $#ARRAY]; But both of these are slower than just assigning the empty list -or undefining it: +or undefining %HASH or @ARRAY: + + %HASH = (); # completely empty %HASH + undef %HASH; # forget %HASH ever existed - %hash = (); # completely empty %hash - undef %hash; # forget %hash every existed + @ARRAY = (); # completely empty @ARRAY + undef @ARRAY; # forget @ARRAY ever existed Note that the EXPR can be arbitrarily complicated as long as the final -operation is a hash element lookup or hash slice: +operation is a hash element, array element, hash slice, or array slice +lookup: delete $ref->[$x][$y]{$key}; delete @{$ref->[$x][$y]}{$key1, $key2, @morekeys}; + delete $ref->[$x][$y][$index]; + delete @{$ref->[$x][$y]}[$index1, $index2, @moreindices]; + =item die LIST Outside an C, prints the value of LIST to C and @@ -1172,13 +1192,17 @@ interactive context.) Do not read from a terminal file (or call C on it) after end-of-file is reached. File types such as terminals may lose the end-of-file condition if you do. -An C without an argument uses the last file read as argument. -Using C with empty parentheses is very different. It indicates -the pseudo file formed of the files listed on the command line, -i.e., C is reasonable to use inside a CE)> -loop to detect the end of only the last file. Use C or -C without the parentheses to test I file in a while -(EE) loop. Examples: +An C without an argument uses the last file read. Using C +with empty parentheses is very different. It refers to the pseudo file +formed from the files listed on the command line and accessed via the +CE> operator. Since CE> isn't explicitly opened, +as a normal filehandle is, an C before CE> has been +used will cause C<@ARGV> to be examined to determine if input is +available. + +In a CE)> loop, C or C can be used to +detect the end of each file, C will only detect the end of the +last file. Examples: # reset line numbering on each input file while (<>) { @@ -1199,8 +1223,8 @@ C without the parentheses to test I file in a while } Practical hint: you almost never need to use C in Perl, because the -input operators return false values when they run out of data, or if there -was an error. +input operators typically return C when they run out of data, or if +there was an error. =item eval EXPR @@ -1382,27 +1406,36 @@ any C methods in your objects. =item exists EXPR -Returns true if the specified hash key exists in its hash, even -if the corresponding value is undefined. +Given an expression that specifies a hash element or array element, +returns true if the specified element in the hash or array has ever +been initialized, even if the corresponding value is undefined. The +element is not autovivified if it doesn't exist. - print "Exists\n" if exists $array{$key}; - print "Defined\n" if defined $array{$key}; - print "True\n" if $array{$key}; + print "Exists\n" if exists $hash{$key}; + print "Defined\n" if defined $hash{$key}; + print "True\n" if $hash{$key}; -A hash element can be true only if it's defined, and defined if + print "Exists\n" if exists $array[$index]; + print "Defined\n" if defined $array[$index]; + print "True\n" if $array[$index]; + +A hash or array element can be true only if it's defined, and defined if it exists, but the reverse doesn't necessarily hold true. Note that the EXPR can be arbitrarily complicated as long as the final -operation is a hash key lookup: +operation is a hash or array key lookup: if (exists $ref->{A}->{B}->{$key}) { } if (exists $hash{A}{B}{$key}) { } -Although the last element will not spring into existence just because -its existence was tested, intervening ones will. Thus C<$ref-E{"A"}> -and C<$ref-E{"A"}-E{"B"}> will spring into existence due to the -existence test for a $key element. This happens anywhere the arrow -operator is used, including even + if (exists $ref->{A}->{B}->[$ix]) { } + if (exists $hash{A}{B}[$ix]) { } + +Although the deepest nested array or hash will not spring into existence +just because its existence was tested, any intervening ones will. +Thus C<$ref-E{"A"}> and C<$ref-E{"A"}-E{"B"}> will spring +into existence due to the existence test for the $key element above. +This happens anywhere the arrow operator is used, including even: undef $ref; if (exists $ref->{"Some key"}) { } @@ -1412,6 +1445,9 @@ This surprising autovivification in what does not at first--or even second--glance appear to be an lvalue context may be fixed in a future release. +See L for specifics on how exists() acts when +used on a pseudo-hash. + =item exit EXPR Evaluates EXPR and exits immediately with that value. Example: @@ -1459,8 +1495,8 @@ For example: or die "can't fcntl F_GETFL: $!"; You don't have to check for C on the return from C. -Like C, it maps a C<0> return from the system call into C<"0 -but true"> in Perl. This string is true in boolean context and C<0> +Like C, it maps a C<0> return from the system call into +C<"0 but true"> in Perl. This string is true in boolean context and C<0> in numeric context. It is also exempt from the normal B<-w> warnings on improper numeric conversions. @@ -1881,6 +1917,14 @@ I simply the last two digits of the year. If you assume it is, then you create non-Y2K-compliant programs--and you wouldn't want to do that, would you? +The proper way to get a complete 4-digit year is simply: + + $year += 1900; + +And to get the last two digits of the year (e.g., '01' in 2001) do: + + $year = sprintf("%02d", $year % 100); + If EXPR is omitted, does C. In scalar context, returns the ctime(3) value: @@ -1926,13 +1970,20 @@ necessarily recommended if you're optimizing for maintainability: goto ("FOO", "BAR", "GLARCH")[$i]; -The C form is highly magical, and substitutes a call to the -named subroutine for the currently running subroutine. This is used by -C subroutines that wish to load another subroutine and then -pretend that the other subroutine had been called in the first place -(except that any modifications to C<@_> in the current subroutine are -propagated to the other subroutine.) After the C, not even C -will be able to tell that this routine was called first. +The C form is quite different from the other forms of C. +In fact, it isn't a goto in the normal sense at all, and doesn't have +the stigma associated with other gotos. Instead, it +substitutes a call to the named subroutine for the currently running +subroutine. This is used by C subroutines that wish to load +another subroutine and then pretend that the other subroutine had been +called in the first place (except that any modifications to C<@_> +in the current subroutine are propagated to the other subroutine.) +After the C, not even C will be able to tell that this +routine was called first. + +NAME needn't be the name of a subroutine; it can be a scalar variable +containing a code reference, or a block which evaluates to a code +reference. =item grep BLOCK LIST @@ -1975,7 +2026,7 @@ L.) If EXPR is omitted, uses C<$_>. print hex 'aF'; # same Hex strings may only represent integers. Strings that would cause -integer overflow trigger a mandatory error message. +integer overflow trigger a warning. =item import @@ -2115,17 +2166,21 @@ as trying has no effect). See also C, C and C. -=item kill LIST +=item kill SIGNAL, LIST -Sends a signal to a list of processes. The first element of -the list must be the signal to send. Returns the number of +Sends a signal to a list of processes. Returns the number of processes successfully signaled (which is not necessarily the same as the number actually killed). $cnt = kill 1, $child1, $child2; kill 9, @goners; -Unlike in the shell, in Perl if the I is negative, it kills +If SIGNAL is zero, no signal is sent to the process. This is a +useful way to check that the process is alive and hasn't changed +its UID. See L for notes on the portability of this +construct. + +Unlike in the shell, if SIGNAL is negative, it kills process groups instead of processes. (On System V, a negative I number will also kill process groups, but that's not portable.) That means you usually want to use positive not negative signals. You may also @@ -2149,6 +2204,10 @@ C cannot be used to exit a block which returns a value such as C, C or C, and should not be used to exit a grep() or map() operation. +Note that a block by itself is semantically identical to a loop +that executes once. Thus C can be used to effect an early +exit out of such a block. + See also L for an illustration of how C, C, and C work. @@ -2221,6 +2280,14 @@ and I simply the last two digits of the year. If you assume it is, then you create non-Y2K-compliant programs--and you wouldn't want to do that, would you? +The proper way to get a complete 4-digit year is simply: + + $year += 1900; + +And to get the last two digits of the year (e.g., '01' in 2001) do: + + $year = sprintf("%02d", $year % 100); + If EXPR is omitted, uses the current time (C). In scalar context, returns the ctime(3) value: @@ -2338,8 +2405,8 @@ Calls the System V IPC function msgctl(2). You'll probably have to say first to get the correct constant definitions. If CMD is C, then ARG must be a variable which will hold the returned C -structure. Returns like C: the undefined value for error, C<"0 but -true"> for zero, or the actual return value otherwise. See also +structure. Returns like C: the undefined value for error, +C<"0 but true"> for zero, or the actual return value otherwise. See also C and C documentation. =item msgget KEY,FLAGS @@ -2394,6 +2461,9 @@ C cannot be used to exit a block which returns a value such as C, C or C, and should not be used to exit a grep() or map() operation. +Note that a block by itself is semantically identical to a loop +that executes once. Thus C will exit such a block early. + See also L for an illustration of how C, C, and C work. @@ -2588,6 +2658,12 @@ parsimonious of file descriptors. For example: open(FILEHANDLE, "<&=$fd") +Note that this feature depends on the fdopen() C library function. +On many UNIX systems, fdopen() is known to fail when file descriptors +exceed a certain value, typically 255. If you need more file +descriptors than that, consider rebuilding Perl to use the C +library. + If you open a pipe on the command C<'-'>, i.e., either C<'|-'> or C<'-|'> with 2-arguments (or 1-argument) form of open(), then there is an implicit fork done, and the return value of open is the pid @@ -2712,10 +2788,43 @@ declared global variable without qualifying it with a package name. (But only within the lexical scope of the C declaration. In this it differs from "use vars", which is package scoped.) +An C declaration declares a global variable that will be visible +across its entire lexical scope, even across package boundaries. The +package in which the variable is entered is determined at the point +of the declaration, not at the point of use. This means the following +behavior holds: + + package Foo; + our $bar; # declares $Foo::bar for rest of lexical scope + $bar = 20; + + package Bar; + print $bar; # prints 20 + +Multiple C declarations in the same lexical scope are allowed +if they are in different packages. If they happened to be in the same +package, Perl will emit warnings if you have asked for them. + + use warnings; + package Foo; + our $bar; # declares $Foo::bar for rest of lexical scope + $bar = 20; + + package Bar; + our $bar = 30; # declares $Bar::bar for rest of lexical scope + print $bar; # prints 30 + + our $bar; # emits warning + =item pack TEMPLATE,LIST -Takes a list of values and packs it into a binary structure, -returning the string containing the structure. The TEMPLATE is a +Takes a LIST of values and converts it into a string using the rules +given by the TEMPLATE. The resulting string is the concatenation of +the converted values. Typically, each converted value looks +like its machine-level representation. For example, on 32-bit machines +a converted integer may be represented by a sequence of 4 bytes. + +The TEMPLATE is a sequence of characters that give the order and type of values, as follows: @@ -2723,8 +2832,8 @@ follows: A An ascii string, will be space padded. Z A null terminated (asciz) string, will be null padded. - b A bit string (ascending bit order, like vec()). - B A bit string (descending bit order). + b A bit string (ascending bit order inside each byte, like vec()). + B A bit string (descending bit order inside each byte). h A hex string (low nybble first). H A hex string (high nybble first). @@ -2750,10 +2859,10 @@ follows: what a local C compiler calls 'long'. If you want native-length longs, use the '!' suffix.) - n A short in "network" (big-endian) order. - N A long in "network" (big-endian) order. - v A short in "VAX" (little-endian) order. - V A long in "VAX" (little-endian) order. + n An unsigned short in "network" (big-endian) order. + N An unsigned long in "network" (big-endian) order. + v An unsigned short in "VAX" (little-endian) order. + V An unsigned long in "VAX" (little-endian) order. (These 'shorts' and 'longs' are _exactly_ 16 bits and _exactly_ 32 bits, respectively.) @@ -2789,47 +2898,105 @@ The following rules apply: =item * Each letter may optionally be followed by a number giving a repeat -count. With all types except C<"a">, C<"A">, C<"Z">, C<"b">, C<"B">, C<"h">, -C<"H">, and C<"P"> the pack function will gobble up that many values from +count. With all types except C, C, C, C, C, C, +C, and C

the pack function will gobble up that many values from the LIST. A C<*> for the repeat count means to use however many items are -left. +left, except for C<@>, C, C, where it is equivalent +to C<0>, and C, where it is equivalent to 1 (or 45, what is the +same). + +When used with C, C<*> results in the addition of a trailing null +byte (so the packed result will be one longer than the byte C +of the item). + +The repeat count for C is interpreted as the maximal number of bytes +to encode per line of output, with 0 and 1 replaced by 45. =item * -The C<"a">, C<"A">, and C<"Z"> types gobble just one value, but pack it as a +The C, C, and C types gobble just one value, but pack it as a string of length count, padding with nulls or spaces as necessary. When -unpacking, C<"A"> strips trailing spaces and nulls, C<"Z"> strips everything -after the first null, and C<"a"> returns data verbatim. +unpacking, C strips trailing spaces and nulls, C strips everything +after the first null, and C returns data verbatim. When packing, +C, and C are equivalent. + +If the value-to-pack is too long, it is truncated. If too long and an +explicit count is provided, C packs only C<$count-1> bytes, followed +by a null byte. Thus C always packs a trailing null byte under +all circumstances. =item * -Likewise, the C<"b"> and C<"B"> fields pack a string that many bits long. +Likewise, the C and C fields pack a string that many bits long. +Each byte of the input field of pack() generates 1 bit of the result. +Each result bit is based on the least-significant bit of the corresponding +input byte, i.e., on C. In particular, bytes C<"0"> and +C<"1"> generate bits 0 and 1, as do bytes C<"\0"> and C<"\1">. + +Starting from the beginning of the input string of pack(), each 8-tuple +of bytes is converted to 1 byte of output. With format C +the first byte of the 8-tuple determines the least-significant bit of a +byte, and with format C it determines the most-significant bit of +a byte. + +If the length of the input string is not exactly divisible by 8, the +remainder is packed as if the input string were padded by null bytes +at the end. Similarly, during unpack()ing the "extra" bits are ignored. + +If the input string of pack() is longer than needed, extra bytes are ignored. +A C<*> for the repeat count of pack() means to use all the bytes of +the input field. On unpack()ing the bits are converted to a string +of C<"0">s and C<"1">s. =item * -The C<"h"> and C<"H"> fields pack a string that many nybbles (4-bit groups, +The C and C fields pack a string that many nybbles (4-bit groups, representable as hexadecimal digits, 0-9a-f) long. +Each byte of the input field of pack() generates 4 bits of the result. +For non-alphabetical bytes the result is based on the 4 least-significant +bits of the input byte, i.e., on C. In particular, +bytes C<"0"> and C<"1"> generate nybbles 0 and 1, as do bytes +C<"\0"> and C<"\1">. For bytes C<"a".."f"> and C<"A".."F"> the result +is compatible with the usual hexadecimal digits, so that C<"a"> and +C<"A"> both generate the nybble C<0xa==10>. The result for bytes +C<"g".."z"> and C<"G".."Z"> is not well-defined. + +Starting from the beginning of the input string of pack(), each pair +of bytes is converted to 1 byte of output. With format C the +first byte of the pair determines the least-significant nybble of the +output byte, and with format C it determines the most-significant +nybble. + +If the length of the input string is not even, it behaves as if padded +by a null byte at the end. Similarly, during unpack()ing the "extra" +nybbles are ignored. + +If the input string of pack() is longer than needed, extra bytes are ignored. +A C<*> for the repeat count of pack() means to use all the bytes of +the input field. On unpack()ing the bits are converted to a string +of hexadecimal digits. + =item * -The C<"p"> type packs a pointer to a null-terminated string. You are +The C

type packs a pointer to a null-terminated string. You are responsible for ensuring the string is not a temporary value (which can potentially get deallocated before you get around to using the packed result). -The C<"P"> type packs a pointer to a structure of the size indicated by the -length. A NULL pointer is created if the corresponding value for C<"p"> or -C<"P"> is C. +The C

type packs a pointer to a structure of the size indicated by the +length. A NULL pointer is created if the corresponding value for C

or +C

is C, similarly for unpack(). =item * -The C<"/"> character allows packing and unpacking of strings where the -packed structure contains a byte count followed by the string itself. +The C template character allows packing and unpacking of strings where +the packed structure contains a byte count followed by the string itself. You write ICI. The I can be any C template letter, and describes how the length value is packed. The ones likely to be of most use are integer-packing ones like -C<"n"> (for Java strings), C<"w"> (for ASN.1 or SNMP) -and C<"N"> (for Sun XDR). +C (for Java strings), C (for ASN.1 or SNMP) +and C (for Sun XDR). The I must, at present, be C<"A*">, C<"a*"> or C<"Z*">. For C the length of the string is obtained from the I, @@ -2841,27 +3008,25 @@ but if you put in the '*' it will be ignored. The I is not returned explicitly from C. -Adding a count to the I letter -is unlikely to do anything useful, -unless that letter is C<"A">, C<"a"> or C<"Z">. -Packing with a I of C<"a"> or C<"Z"> -may introduce C<"\000"> characters, +Adding a count to the I letter is unlikely to do anything +useful, unless that letter is C, C or C. Packing with a +I of C or C may introduce C<"\000"> characters, which Perl does not regard as legal in numeric strings. =item * -The integer types C<"s">, C<"S">, C<"l">, and C<"L"> may be -immediately followed by a C<"!"> suffix to signify native shorts or -longs--as you can see from above for example a bare C<"l"> does mean +The integer types C, C, C, and C may be +immediately followed by a C suffix to signify native shorts or +longs--as you can see from above for example a bare C does mean exactly 32 bits, the native C (as seen by the local C compiler) may be larger. This is an issue mainly in 64-bit platforms. You can -see whether using C<"!"> makes any difference by +see whether using C makes any difference by print length(pack("s")), " ", length(pack("s!")), "\n"; print length(pack("l")), " ", length(pack("l!")), "\n"; -C<"i!"> and C<"I!"> also work but only because of completeness; -they are identical to C<"i"> and C<"I">. +C and C also work but only because of completeness; +they are identical to C and C. The actual sizes (in bytes) of native shorts, ints, longs, and long longs on the platform where Perl was built are also available via @@ -2878,7 +3043,7 @@ not support long longs.) =item * -The integer formats C<"s">, C<"S">, C<"i">, C<"I">, C<"l">, and C<"L"> +The integer formats C, C, C, C, C, and C are inherently non-portable between processors and operating systems because they obey the native byteorder and endianness. For example a 4-byte integer 0x12345678 (305419896 decimal) be ordered natively @@ -2887,7 +3052,7 @@ because they obey the native byteorder and endianness. For example a 0x12 0x34 0x56 0x78 # little-endian 0x78 0x56 0x34 0x12 # big-endian -Basically, the Intel, Alpha, and VAX CPUs and little-endian, while +Basically, the Intel, Alpha, and VAX CPUs are little-endian, while everybody else, for example Motorola m68k/88k, PPC, Sparc, HP PA, Power, and Cray are big-endian. MIPS can be either: Digital used it in little-endian mode; SGI uses it in big-endian mode. @@ -2916,8 +3081,8 @@ via L: Byteorders C<'1234'> and C<'12345678'> are little-endian, C<'4321'> and C<'87654321'> are big-endian. -If you want portable packed integers use the formats C<"n">, C<"N">, -C<"v">, and C<"V">, their byte endianness and size is known. +If you want portable packed integers use the formats C, C, +C, and C, their byte endianness and size is known. See also L. =item * @@ -2947,6 +3112,12 @@ sequences of bytes. A comment in a TEMPLATE starts with C<#> and goes to the end of line. +=item * + +If TEMPLATE requires more arguments to pack() than actually given, pack() +assumes additional C<""> arguments. If TEMPLATE requires less arguments +to pack() than actually given, extra arguments are ignored. + =back Examples: @@ -3247,12 +3418,13 @@ operator is discussed in more detail in L. =item recv SOCKET,SCALAR,LENGTH,FLAGS Receives a message on a socket. Attempts to receive LENGTH bytes of -data into variable SCALAR from the specified SOCKET filehandle. -Actually does a C C, so that it can return the address of the -sender. Returns the undefined value if there's an error. SCALAR will -be grown or shrunk to the length actually read. Takes the same flags -as the system call of the same name. -See L for examples. +data into variable SCALAR from the specified SOCKET filehandle. SCALAR +will be grown or shrunk to the length actually read. Takes the same +flags as the system call of the same name. Returns the address of the +sender if SOCKET's protocol supports this; returns an empty string +otherwise. If there's an error, returns the undefined value. This call +is actually implemented in terms of recvfrom(2) system call. See +L for examples. =item redo LABEL @@ -3285,6 +3457,10 @@ C cannot be used to retry a block which returns a value such as C, C or C, and should not be used to exit a grep() or map() operation. +Note that a block by itself is semantically identical to a loop +that executes once. Thus C inside such a block will effectively +turn it into a looping construct. + See also L for an illustration of how C, C, and C work. @@ -3353,15 +3529,16 @@ subroutine: foreach $prefix (@INC) { $realfilename = "$prefix/$filename"; if (-f $realfilename) { + $INC{$filename} = $realfilename; $result = do $realfilename; last ITER; } } die "Can't find $filename in \@INC"; } + delete $INC{$filename} if $@ || !$result; die $@ if $@; die "$filename did not return true value" unless $result; - $INC{$filename} = $realfilename; return $result; } @@ -3683,9 +3860,10 @@ See L for examples. Sets the current process group for the specified PID, C<0> for the current process. Will produce a fatal error if used on a machine that doesn't -implement setpgrp(2). If the arguments are omitted, it defaults to -C<0,0>. Note that the POSIX version of C does not accept any -arguments, so only C is portable. See also C. +implement POSIX setpgid(2) or BSD setpgrp(2). If the arguments are omitted, +it defaults to C<0,0>. Note that the BSD 4.2 version of C does not +accept any arguments, so only C is portable. See also +C. =item setpriority WHICH,WHO,PRIORITY @@ -3708,7 +3886,9 @@ array by 1 and moving everything down. If there are no elements in the array, returns the undefined value. If ARRAY is omitted, shifts the C<@_> array within the lexical scope of subroutines and formats, and the C<@ARGV> array at file scopes or within the lexical scopes established by -the C, C, C, and C constructs. +the C, C, C, C, and C +constructs. + See also C, C, and C. C and C do the same thing to the left end of an array that C and C do to the right end. @@ -3836,12 +4016,16 @@ the name of (or a reference to) the actual subroutine to use. In place of a SUBNAME, you can provide a BLOCK as an anonymous, in-line sort subroutine. -In the interests of efficiency the normal calling code for subroutines is -bypassed, with the following effects: the subroutine may not be a -recursive subroutine, and the two elements to be compared are passed into -the subroutine not via C<@_> but as the package global variables $a and -$b (see example below). They are passed by reference, so don't -modify $a and $b. And don't try to declare them as lexicals either. +If the subroutine's prototype is C<($$)>, the elements to be compared +are passed by reference in C<@_>, as for a normal subroutine. If not, +the normal calling code for subroutines is bypassed in the interests of +efficiency, and the elements to be compared are passed into the subroutine +as the package global variables $a and $b (see example below). Note that +in the latter case, it is usually counter-productive to declare $a and +$b as lexicals. + +In either case, the subroutine may not be recursive. The values to be +compared are always passed by reference, so don't modify them. You also cannot exit out of the sort block or subroutine using any of the loop control operators described in L or with C. @@ -3921,6 +4105,14 @@ Examples: || $a->[2] cmp $b->[2] } map { [$_, /=(\d+)/, uc($_)] } @old; + + # using a prototype allows you to use any comparison subroutine + # as a sort subroutine (including other package's subroutines) + package other; + sub backwards ($$) { $_[1] cmp $_[0]; } # $a and $b are not set here + + package main; + @new = sort other::backwards @old; If you're using strict, you I declare $a and $b as lexicals. They are package globals. That means @@ -4136,13 +4328,6 @@ If C is in effect, the character used for the decimal point in formatted real numbers is affected by the LC_NUMERIC locale. See L. -To cope with broken systems that allow the standard locales to be -overridden by malicious users, the return value may be tainted -if any of the floating point formats are used and the conversion -yields something that doesn't look like a normal C-locale floating -point number. This happens regardless of whether C is -in effect or not. - If Perl understands "quads" (64-bit integers) (this requires either that the platform natively supports quads or that Perl has been specifically compiled to support quads), the characters @@ -4262,9 +4447,9 @@ meaning of the fields: 5 gid numeric group ID of file's owner 6 rdev the device identifier (special files only) 7 size total size of file, in bytes - 8 atime last access time since the epoch - 9 mtime last modify time since the epoch - 10 ctime inode change time (NOT creation time!) since the epoch + 8 atime last access time in seconds since the epoch + 9 mtime last modify time in seconds since the epoch + 10 ctime inode change time (NOT creation time!) in seconds since the epoch 11 blksize preferred block size for file system I/O 12 blocks actual number of blocks allocated @@ -4331,8 +4516,8 @@ before any line containing a certain pattern: print; } -In searching for C, only those locations in C<$_> that contain C<"f"> -will be looked at, because C<"f"> is rarer than C<"o">. In general, this is +In searching for C, only those locations in C<$_> that contain C +will be looked at, because C is rarer than C. In general, this is a big win except in pathological cases. The only question is whether it saves you more time than it took to build the linked list in the first place. @@ -4474,8 +4659,7 @@ For historical reasons, some values work on almost every system supported by perl: zero means read-only, one means write-only, and two means read/write. We know that these values do I work under OS/390 & VM/ESA Unix and on the Macintosh; you probably don't want to -se them in new code, use thhe constants discussed in the preceding -paragraph. +use them in new code. If the file named by FILENAME does not exist and the C call creates it (typically because MODE includes the C flag), then the value of @@ -4496,6 +4680,12 @@ that takes away the user's option to have a more permissive umask. Better to omit it. See the perlfunc(1) entry on C for more on this. +Note that C depends on the fdopen() C library function. +On many UNIX systems, fdopen() is known to fail when file descriptors +exceed a certain value, typically 255. If you need more file +descriptors than that, consider rebuilding Perl to use the C +library, or perhaps using the POSIX::open() function. + See L for a kinder, gentler explanation of opening files. =item sysread FILEHANDLE,SCALAR,LENGTH,OFFSET @@ -4853,8 +5043,14 @@ If LIST is omitted, uses C<$_>. =item unpack TEMPLATE,EXPR C does the reverse of C: it takes a string -representing a structure and expands it out into a list of values. +and expands it out into a list of values. (In scalar context, it returns merely the first value produced.) + +The string is broken into chunks described by the TEMPLATE. Each chunk +is converted separately to a value. Typically, either the string is a result +of C, or the bytes of the string represent a C structure of some +kind. + The TEMPLATE has the same format as in the C function. Here's a subroutine that does substring: @@ -4867,9 +5063,14 @@ and then there's sub ordinal { unpack("c",$_[0]); } # same as ord() -In addition, you may prefix a field with a %EnumberE to indicate that +In addition to fields allowed in pack(), you may prefix a field with +a %EnumberE to indicate that you want a EnumberE-bit checksum of the items instead of the items -themselves. Default is a 16-bit checksum. For example, the following +themselves. Default is a 16-bit checksum. Checksum is calculated by +summing numeric values of expanded values (for string fields the sum of +C is taken, for bit fields the sum of zeroes and ones). + +For example, the following computes the same number as the System V sum program: $checksum = do { @@ -4881,11 +5082,15 @@ The following efficiently counts the number of set bits in a bit vector: $setbits = unpack("%32b*", $selectmask); -The C<"p"> and C<"P"> formats should be used with care. Since Perl +The C

and C

formats should be used with care. Since Perl has no way of checking whether the value passed to C corresponds to a valid memory location, passing a pointer value that's not known to be valid is likely to have disastrous consequences. +If the repeat count of a field is larger than what the remainder of +the input string allows, repeat count is decreased. If the input string +is longer than one described by the TEMPLATE, the rest is ignored. + See L for more examples and notes. =item untie VARIABLE @@ -5014,11 +5219,26 @@ See also C, C, and C. =item vec EXPR,OFFSET,BITS -Treats the string in EXPR as a vector of unsigned integers, and -returns the value of the bit field specified by OFFSET. BITS -specifies the number of bits that are reserved for each entry in the -bit vector. This must be a power of two from 1 to 32 (or 64, if your -platform supports that). +Treats the string in EXPR as a bit vector made up of elements of +width BITS, and returns the value of the element specified by OFFSET +as an unsigned integer. BITS therefore specifies the number of bits +that are reserved for each element in the bit vector. This must +be a power of two from 1 to 32 (or 64, if your platform supports +that). + +If BITS is 8, "elements" coincide with bytes of the input string. + +If BITS is 16 or more, bytes of the input string are grouped into chunks +of size BITS/8, and each group is converted to a number as with +pack()/unpack() with big-endian formats C/C (and analoguously +for BITS==64). See L<"pack"> for details. + +If bits is 4 or less, the string is broken into bytes, then the bits +of each byte are broken into 8/BITS groups. Bits of a byte are +numbered in a little-endian-ish way, as in C<0x01>, C<0x02>, +C<0x04>, C<0x08>, C<0x10>, C<0x20>, C<0x40>, C<0x80>. For example, +breaking the single input byte C into two groups gives a list +C<(0x6, 0x3)>; breaking it into 4 groups gives C<(0x2, 0x1, 0x3, 0x0)>. C may also be assigned to, in which case parentheses are needed to give the expression the correct precedence as in @@ -5036,6 +5256,10 @@ in the same way on big-endian or little-endian machines. my $foo = ''; vec($foo, 0, 32) = 0x5065726C; # 'Perl' + + # $foo eq "Perl" eq "\x50\x65\x72\x6C", 32 bits + print vec($foo, 0, 8); # prints 80 == 0x50 == ord('P') + vec($foo, 2, 16) = 0x5065; # 'PerlPe' vec($foo, 3, 16) = 0x726C; # 'PerlPerl' vec($foo, 8, 8) = 0x50; # 'PerlPerlP' @@ -5055,6 +5279,171 @@ To transform a bit vector into a string or list of 0's and 1's, use these: If you know the exact length in bits, it can be used in place of the C<*>. +Here is an example to illustrate how the bits actually fall in place: + + #!/usr/bin/perl -wl + + print <<'EOT'; + 0 1 2 3 + unpack("V",$_) 01234567890123456789012345678901 + ------------------------------------------------------------------ + EOT + + for $w (0..3) { + $width = 2**$w; + for ($shift=0; $shift < $width; ++$shift) { + for ($off=0; $off < 32/$width; ++$off) { + $str = pack("B*", "0"x32); + $bits = (1<<$shift); + vec($str, $off, $width) = $bits; + $res = unpack("b*",$str); + $val = unpack("V", $str); + write; + } + } + } + + format STDOUT = + vec($_,@#,@#) = @<< == @######### @>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> + $off, $width, $bits, $val, $res + . + __END__ + +Regardless of the machine architecture on which it is run, the above +example should print the following table: + + 0 1 2 3 + unpack("V",$_) 01234567890123456789012345678901 + ------------------------------------------------------------------ + vec($_, 0, 1) = 1 == 1 10000000000000000000000000000000 + vec($_, 1, 1) = 1 == 2 01000000000000000000000000000000 + vec($_, 2, 1) = 1 == 4 00100000000000000000000000000000 + vec($_, 3, 1) = 1 == 8 00010000000000000000000000000000 + vec($_, 4, 1) = 1 == 16 00001000000000000000000000000000 + vec($_, 5, 1) = 1 == 32 00000100000000000000000000000000 + vec($_, 6, 1) = 1 == 64 00000010000000000000000000000000 + vec($_, 7, 1) = 1 == 128 00000001000000000000000000000000 + vec($_, 8, 1) = 1 == 256 00000000100000000000000000000000 + vec($_, 9, 1) = 1 == 512 00000000010000000000000000000000 + vec($_,10, 1) = 1 == 1024 00000000001000000000000000000000 + vec($_,11, 1) = 1 == 2048 00000000000100000000000000000000 + vec($_,12, 1) = 1 == 4096 00000000000010000000000000000000 + vec($_,13, 1) = 1 == 8192 00000000000001000000000000000000 + vec($_,14, 1) = 1 == 16384 00000000000000100000000000000000 + vec($_,15, 1) = 1 == 32768 00000000000000010000000000000000 + vec($_,16, 1) = 1 == 65536 00000000000000001000000000000000 + vec($_,17, 1) = 1 == 131072 00000000000000000100000000000000 + vec($_,18, 1) = 1 == 262144 00000000000000000010000000000000 + vec($_,19, 1) = 1 == 524288 00000000000000000001000000000000 + vec($_,20, 1) = 1 == 1048576 00000000000000000000100000000000 + vec($_,21, 1) = 1 == 2097152 00000000000000000000010000000000 + vec($_,22, 1) = 1 == 4194304 00000000000000000000001000000000 + vec($_,23, 1) = 1 == 8388608 00000000000000000000000100000000 + vec($_,24, 1) = 1 == 16777216 00000000000000000000000010000000 + vec($_,25, 1) = 1 == 33554432 00000000000000000000000001000000 + vec($_,26, 1) = 1 == 67108864 00000000000000000000000000100000 + vec($_,27, 1) = 1 == 134217728 00000000000000000000000000010000 + vec($_,28, 1) = 1 == 268435456 00000000000000000000000000001000 + vec($_,29, 1) = 1 == 536870912 00000000000000000000000000000100 + vec($_,30, 1) = 1 == 1073741824 00000000000000000000000000000010 + vec($_,31, 1) = 1 == 2147483648 00000000000000000000000000000001 + vec($_, 0, 2) = 1 == 1 10000000000000000000000000000000 + vec($_, 1, 2) = 1 == 4 00100000000000000000000000000000 + vec($_, 2, 2) = 1 == 16 00001000000000000000000000000000 + vec($_, 3, 2) = 1 == 64 00000010000000000000000000000000 + vec($_, 4, 2) = 1 == 256 00000000100000000000000000000000 + vec($_, 5, 2) = 1 == 1024 00000000001000000000000000000000 + vec($_, 6, 2) = 1 == 4096 00000000000010000000000000000000 + vec($_, 7, 2) = 1 == 16384 00000000000000100000000000000000 + vec($_, 8, 2) = 1 == 65536 00000000000000001000000000000000 + vec($_, 9, 2) = 1 == 262144 00000000000000000010000000000000 + vec($_,10, 2) = 1 == 1048576 00000000000000000000100000000000 + vec($_,11, 2) = 1 == 4194304 00000000000000000000001000000000 + vec($_,12, 2) = 1 == 16777216 00000000000000000000000010000000 + vec($_,13, 2) = 1 == 67108864 00000000000000000000000000100000 + vec($_,14, 2) = 1 == 268435456 00000000000000000000000000001000 + vec($_,15, 2) = 1 == 1073741824 00000000000000000000000000000010 + vec($_, 0, 2) = 2 == 2 01000000000000000000000000000000 + vec($_, 1, 2) = 2 == 8 00010000000000000000000000000000 + vec($_, 2, 2) = 2 == 32 00000100000000000000000000000000 + vec($_, 3, 2) = 2 == 128 00000001000000000000000000000000 + vec($_, 4, 2) = 2 == 512 00000000010000000000000000000000 + vec($_, 5, 2) = 2 == 2048 00000000000100000000000000000000 + vec($_, 6, 2) = 2 == 8192 00000000000001000000000000000000 + vec($_, 7, 2) = 2 == 32768 00000000000000010000000000000000 + vec($_, 8, 2) = 2 == 131072 00000000000000000100000000000000 + vec($_, 9, 2) = 2 == 524288 00000000000000000001000000000000 + vec($_,10, 2) = 2 == 2097152 00000000000000000000010000000000 + vec($_,11, 2) = 2 == 8388608 00000000000000000000000100000000 + vec($_,12, 2) = 2 == 33554432 00000000000000000000000001000000 + vec($_,13, 2) = 2 == 134217728 00000000000000000000000000010000 + vec($_,14, 2) = 2 == 536870912 00000000000000000000000000000100 + vec($_,15, 2) = 2 == 2147483648 00000000000000000000000000000001 + vec($_, 0, 4) = 1 == 1 10000000000000000000000000000000 + vec($_, 1, 4) = 1 == 16 00001000000000000000000000000000 + vec($_, 2, 4) = 1 == 256 00000000100000000000000000000000 + vec($_, 3, 4) = 1 == 4096 00000000000010000000000000000000 + vec($_, 4, 4) = 1 == 65536 00000000000000001000000000000000 + vec($_, 5, 4) = 1 == 1048576 00000000000000000000100000000000 + vec($_, 6, 4) = 1 == 16777216 00000000000000000000000010000000 + vec($_, 7, 4) = 1 == 268435456 00000000000000000000000000001000 + vec($_, 0, 4) = 2 == 2 01000000000000000000000000000000 + vec($_, 1, 4) = 2 == 32 00000100000000000000000000000000 + vec($_, 2, 4) = 2 == 512 00000000010000000000000000000000 + vec($_, 3, 4) = 2 == 8192 00000000000001000000000000000000 + vec($_, 4, 4) = 2 == 131072 00000000000000000100000000000000 + vec($_, 5, 4) = 2 == 2097152 00000000000000000000010000000000 + vec($_, 6, 4) = 2 == 33554432 00000000000000000000000001000000 + vec($_, 7, 4) = 2 == 536870912 00000000000000000000000000000100 + vec($_, 0, 4) = 4 == 4 00100000000000000000000000000000 + vec($_, 1, 4) = 4 == 64 00000010000000000000000000000000 + vec($_, 2, 4) = 4 == 1024 00000000001000000000000000000000 + vec($_, 3, 4) = 4 == 16384 00000000000000100000000000000000 + vec($_, 4, 4) = 4 == 262144 00000000000000000010000000000000 + vec($_, 5, 4) = 4 == 4194304 00000000000000000000001000000000 + vec($_, 6, 4) = 4 == 67108864 00000000000000000000000000100000 + vec($_, 7, 4) = 4 == 1073741824 00000000000000000000000000000010 + vec($_, 0, 4) = 8 == 8 00010000000000000000000000000000 + vec($_, 1, 4) = 8 == 128 00000001000000000000000000000000 + vec($_, 2, 4) = 8 == 2048 00000000000100000000000000000000 + vec($_, 3, 4) = 8 == 32768 00000000000000010000000000000000 + vec($_, 4, 4) = 8 == 524288 00000000000000000001000000000000 + vec($_, 5, 4) = 8 == 8388608 00000000000000000000000100000000 + vec($_, 6, 4) = 8 == 134217728 00000000000000000000000000010000 + vec($_, 7, 4) = 8 == 2147483648 00000000000000000000000000000001 + vec($_, 0, 8) = 1 == 1 10000000000000000000000000000000 + vec($_, 1, 8) = 1 == 256 00000000100000000000000000000000 + vec($_, 2, 8) = 1 == 65536 00000000000000001000000000000000 + vec($_, 3, 8) = 1 == 16777216 00000000000000000000000010000000 + vec($_, 0, 8) = 2 == 2 01000000000000000000000000000000 + vec($_, 1, 8) = 2 == 512 00000000010000000000000000000000 + vec($_, 2, 8) = 2 == 131072 00000000000000000100000000000000 + vec($_, 3, 8) = 2 == 33554432 00000000000000000000000001000000 + vec($_, 0, 8) = 4 == 4 00100000000000000000000000000000 + vec($_, 1, 8) = 4 == 1024 00000000001000000000000000000000 + vec($_, 2, 8) = 4 == 262144 00000000000000000010000000000000 + vec($_, 3, 8) = 4 == 67108864 00000000000000000000000000100000 + vec($_, 0, 8) = 8 == 8 00010000000000000000000000000000 + vec($_, 1, 8) = 8 == 2048 00000000000100000000000000000000 + vec($_, 2, 8) = 8 == 524288 00000000000000000001000000000000 + vec($_, 3, 8) = 8 == 134217728 00000000000000000000000000010000 + vec($_, 0, 8) = 16 == 16 00001000000000000000000000000000 + vec($_, 1, 8) = 16 == 4096 00000000000010000000000000000000 + vec($_, 2, 8) = 16 == 1048576 00000000000000000000100000000000 + vec($_, 3, 8) = 16 == 268435456 00000000000000000000000000001000 + vec($_, 0, 8) = 32 == 32 00000100000000000000000000000000 + vec($_, 1, 8) = 32 == 8192 00000000000001000000000000000000 + vec($_, 2, 8) = 32 == 2097152 00000000000000000000010000000000 + vec($_, 3, 8) = 32 == 536870912 00000000000000000000000000000100 + vec($_, 0, 8) = 64 == 64 00000010000000000000000000000000 + vec($_, 1, 8) = 64 == 16384 00000000000000100000000000000000 + vec($_, 2, 8) = 64 == 4194304 00000000000000000000001000000000 + vec($_, 3, 8) = 64 == 1073741824 00000000000000000000000000000010 + vec($_, 0, 8) = 128 == 128 00000001000000000000000000000000 + vec($_, 1, 8) = 128 == 32768 00000000000000010000000000000000 + vec($_, 2, 8) = 128 == 8388608 00000000000000000000000100000000 + vec($_, 3, 8) = 128 == 2147483648 00000000000000000000000000000001 + =item wait Behaves like the wait(2) system call on your system: it waits for a child diff --git a/pod/perlguts.pod b/pod/perlguts.pod index af12297..a8d820e 100644 --- a/pod/perlguts.pod +++ b/pod/perlguts.pod @@ -107,9 +107,10 @@ Also remember that C doesn't allow you to safely say C. It might work with your compiler, but it won't work for everyone. Break this sort of statement up into separate assignments: + SV *s; STRLEN len; char * ptr; - ptr = SvPV(len); + ptr = SvPV(s, len); foo(ptr, len); If you want to know if the scalar value is TRUE, you can use: @@ -1098,10 +1099,15 @@ this: SAVEDELETE(PL_defstash, savepv(tmpbuf), strlen(tmpbuf)); -=item C +=item C At the end of I the function C is called with the -only argument (of type C) C

. +only argument C

. + +=item C + +At the end of I the function C is called with the +implicit context argument (if any), and C

. =item C @@ -2907,15 +2913,17 @@ Test two strings to see if they are different. Returns true or false. Test two strings to see if they are equal. The C parameter indicates the number of bytes to compare. Returns true or false. +(A wrapper for C). - int strnEQ( char *s1, char *s2 ) + int strnEQ( const char *s1, const char *s2, size_t len ) =item strnNE Test two strings to see if they are different. The C parameter indicates the number of bytes to compare. Returns true or false. +(A wrapper for C). - int strnNE( char *s1, char *s2, int len ) + int strnNE( const char *s1, const char *s2, size_t len ) =item sv_2mortal diff --git a/pod/perlhack.pod b/pod/perlhack.pod new file mode 100644 index 0000000..5ecdf2c --- /dev/null +++ b/pod/perlhack.pod @@ -0,0 +1,275 @@ +=head1 NAME + +perlhack - How to hack at the Perl internals + +=head1 DESCRIPTION + +This document attempts to explain how Perl development takes place, +and ends with some suggestions for people wanting to become bona fide +porters. + +The perl5-porters mailing list is where the Perl standard distribution +is maintained and developed. The list can get anywhere from 10 to 150 +messages a day, depending on the heatedness of the debate. Most days +there are two or three patches, extensions, features, or bugs being +discussed at a time. + +A searchable archive of the list is at: + + http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/ + +The list is also archived under the usenet group name +C at: + + http://www.deja.com/ + +List subscribers (the porters themselves) come in several flavours. +Some are quiet curious lurkers, who rarely pitch in and instead watch +the ongoing development to ensure they're forewarned of new changes or +features in Perl. Some are representatives of vendors, who are there +to make sure that Perl continues to compile and work on their +platforms. Some patch any reported bug that they know how to fix, +some are actively patching their pet area (threads, Win32, the regexp +engine), while others seem to do nothing but complain. In other +words, it's your usual mix of technical people. + +Over this group of porters presides Larry Wall. He has the final word +in what does and does not change in the Perl language. Various +releases of Perl are shepherded by a ``pumpking'', a porter +responsible for gathering patches, deciding on a patch-by-patch +feature-by-feature basis what will and will not go into the release. +For instance, Gurusamy Sarathy is the pumpking for the 5.6 release of +Perl. + +In addition, various people are pumpkings for different things. For +instance, Andy Dougherty and Jarkko Hietaniemi share the I +pumpkin, and Tom Christiansen is the documentation pumpking. + +Larry sees Perl development along the lines of the US government: +there's the Legislature (the porters), the Executive branch (the +pumpkings), and the Supreme Court (Larry). The legislature can +discuss and submit patches to the executive branch all they like, but +the executive branch is free to veto them. Rarely, the Supreme Court +will side with the executive branch over the legislature, or the +legislature over the executive branch. Mostly, however, the +legislature and the executive branch are supposed to get along and +work out their differences without impeachment or court cases. + +You might sometimes see reference to Rule 1 and Rule 2. Larry's power +as Supreme Court is expressed in The Rules: + +=over 4 + +=item 1 + +Larry is always by definition right about how Perl should behave. +This means he has final veto power on the core functionality. + +=item 2 + +Larry is allowed to change his mind about any matter at a later date, +regardless of whether he previously invoked Rule 1. + +=back + +Got that? Larry is always right, even when he was wrong. It's rare +to see either Rule exercised, but they are often alluded to. + +New features and extensions to the language are contentious, because +the criteria used by the pumpkings, Larry, and other porters to decide +which features should be implemented and incorporated are not codified +in a few small design goals as with some other languages. Instead, +the heuristics are flexible and often difficult to fathom. Here is +one person's list, roughly in decreasing order of importance, of +heuristics that new features have to be weighed against: + +=over 4 + +=item Does concept match the general goals of Perl? + +These haven't been written anywhere in stone, but one approximation +is: + + 1. Keep it fast, simple, and useful. + 2. Keep features/concepts as orthogonal as possible. + 3. No arbitrary limits (platforms, data sizes, cultures). + 4. Keep it open and exciting to use/patch/advocate Perl everywhere. + 5. Either assimilate new technologies, or build bridges to them. + +=item Where is the implementation? + +All the talk in the world is useless without an implementation. In +almost every case, the person or people who argue for a new feature +will be expected to be the ones who implement it. Porters capable +of coding new features have their own agendas, and are not available +to implement your (possibly good) idea. + +=item Backwards compatibility + +It's a cardinal sin to break existing Perl programs. New warnings are +contentious--some say that a program that emits warnings is not +broken, while others say it is. Adding keywords has the potential to +break programs, changing the meaning of existing token sequences or +functions might break programs. + +=item Could it be a module instead? + +Perl 5 has extension mechanisms, modules and XS, specifically to avoid +the need to keep changing the Perl interpreter. You can write modules +that export functions, you can give those functions prototypes so they +can be called like built-in functions, you can even write XS code to +mess with the runtime data structures of the Perl interpreter if you +want to implement really complicated things. If it can be done in a +module instead of in the core, it's highly unlikely to be added. + +=item Is the feature generic enough? + +Is this something that only the submitter wants added to the language, +or would it be broadly useful? Sometimes, instead of adding a feature +with a tight focus, the porters might decide to wait until someone +implements the more generalized feature. For instance, instead of +implementing a ``delayed evaluation'' feature, the porters are waiting +for a macro system that would permit delayed evaluation and much more. + +=item Does it potentially introduce new bugs? + +Radical rewrites of large chunks of the Perl interpreter have the +potential to introduce new bugs. The smaller and more localized the +change, the better. + +=item Does it preclude other desirable features? + +A patch is likely to be rejected if it closes off future avenues of +development. For instance, a patch that placed a true and final +interpretation on prototypes is likely to be rejected because there +are still options for the future of prototypes that haven't been +addressed. + +=item Is the implementation robust? + +Good patches (tight code, complete, correct) stand more chance of +going in. Sloppy or incorrect patches might be placed on the back +burner until the pumpking has time to fix, or might be discarded +altogether without further notice. + +=item Is the implementation generic enough to be portable? + +The worst patches make use of a system-specific features. It's highly +unlikely that nonportable additions to the Perl language will be +accepted. + +=item Is there enough documentation? + +Patches without documentation are probably ill-thought out or +incomplete. Nothing can be added without documentation, so submitting +a patch for the appropriate manpages as well as the source code is +always a good idea. If appropriate, patches should add to the test +suite as well. + +=item Is there another way to do it? + +Larry said ``Although the Perl Slogan is I, I hesitate to make 10 ways to do something''. This is a +tricky heuristic to navigate, though--one man's essential addition is +another man's pointless cruft. + +=item Does it create too much work? + +Work for the pumpking, work for Perl programmers, work for module +authors, ... Perl is supposed to be easy. + +=item Patches speak louder than words + +Working code is always preferred to pie-in-the-sky ideas. A patch to +add a feature stands a much higher chance of making it to the language +than does a random feature request, no matter how fervently argued the +request might be. This ties into ``Will it be useful?'', as the fact +that someone took the time to make the patch demonstrates a strong +desire for the feature. + +=back + +If you're on the list, you might hear the word ``core'' bandied +around. It refers to the standard distribution. ``Hacking on the +core'' means you're changing the C source code to the Perl +interpreter. ``A core module'' is one that ships with Perl. + +The source code to the Perl interpreter, in its different versions, is +kept in a repository managed by a revision control system (which is +currently the Perforce program, see http://perforce.com/). The +pumpkings and a few others have access to the repository to check in +changes. Periodically the pumpking for the development version of Perl +will release a new version, so the rest of the porters can see what's +changed. Plans are underway for a repository viewer, and for +anonymous CVS access to the latest versions. + +Always submit patches to I. This lets other +porters review your patch, which catches a surprising number of errors +in patches. Either use the diff program (available in source code +form from I), or use Johan Vromans' +I (available from I). Unified diffs +are preferred, but context diffs are accepted. Do not send RCS-style +diffs or diffs without context lines. More information is given in +the I file in the Perl source distribution. +Please patch against the latest B version (e.g., if +you're fixing a bug in the 5.005 track, patch against the latest +5.005_5x version). Only patches that survive the heat of the +development branch get applied to maintenance versions. + +Your patch should update the documentation and test suite. + +To report a bug in Perl, use the program I which comes with +Perl (if you can't get Perl to work, send mail to the address +I or I). Reporting bugs through +I feeds into the automated bug-tracking system, access to +which is provided through the web at I. It +often pays to check the archives of the perl5-porters mailing list to +see whether the bug you're reporting has been reported before, and if +so whether it was considered a bug. See above for the location of +the searchable archives. + +The CPAN testers (I) are a group of +volunteers who test CPAN modules on a variety of platforms. Perl Labs +(I) automatically tests Perl source releases on +platforms and gives feedback to the CPAN testers mailing list. Both +efforts welcome volunteers. + +To become an active and patching Perl porter, you'll need to learn how +Perl works on the inside. Chip Salzenberg, a pumpking, has written +articles on Perl internals for The Perl Journal +(I) which explain how various parts of the Perl +interpreter work. The C manpage explains the internal data +structures. And, of course, the C source code (sometimes sparsely +commented, sometimes commented well) is a great place to start (begin +with C and see where it goes from there). A lot of the style +of the Perl source is explained in the I file in +the source distribution. + +It is essential that you be comfortable using a good debugger +(e.g. gdb, dbx) before you can patch perl. Stepping through perl +as it executes a script is perhaps the best (if sometimes tedious) +way to gain a precise understanding of the overall architecture of +the language. + +If you build a version of the Perl interpreter with C<-DDEBUGGING>, +Perl's B<-D> commandline flag will cause copious debugging information +to be emitted (see the C manpage). If you build a version of +Perl with compiler debugging information (e.g. with the C compiler's +C<-g> option instead of C<-O>) then you can step through the execution +of the interpreter with your favourite C symbolic debugger, setting +breakpoints on particular functions. + +It's a good idea to read and lurk for a while before chipping in. +That way you'll get to see the dynamic of the conversations, learn the +personalities of the players, and hopefully be better prepared to make +a useful contribution when do you speak up. + +If after all this you still think you want to join the perl5-porters +mailing list, send mail to I. To +unsubscribe, send mail to I. + +=head1 AUTHOR + +This document was written by Nathan Torkington, and is maintained by +the perl5-porters mailing list. + diff --git a/pod/perlipc.pod b/pod/perlipc.pod index e687304..3034197 100644 --- a/pod/perlipc.pod +++ b/pod/perlipc.pod @@ -152,6 +152,10 @@ Here's an example: }; if ($@ and $@ !~ /alarm clock restart/) { die } +If the operation being timed out is system() or qx(), this technique +is liable to generate zombies. If this matters to you, you'll +need to do your own fork() and exec(), and kill the errant child process. + For more complex signal handling, you might see the standard POSIX module. Lamentably, this is almost entirely undocumented, but the F file from the Perl source distribution has some diff --git a/pod/perllexwarn.pod b/pod/perllexwarn.pod index 32fc210..6078aef 100644 --- a/pod/perllexwarn.pod +++ b/pod/perllexwarn.pod @@ -3,7 +3,7 @@ perllexwarn - Perl Lexical Warnings =head1 DESCRIPTION - + The C pragma is a replacement for both the command line flag B<-w> and the equivalent Perl variable, C<$^W>. @@ -160,7 +160,7 @@ introduction of lexically scoped warnings, or have code that uses both lexical warnings and C<$^W>, this section will describe how they interact. How Lexical Warnings interact with B<-w>/C<$^W>: - + =over 5 =item 1. diff --git a/pod/perllocale.pod b/pod/perllocale.pod index 510117f..475cc0d 100644 --- a/pod/perllocale.pod +++ b/pod/perllocale.pod @@ -641,11 +641,12 @@ case-mapping table is in effect. =item * -If the decimal point character in the C locale is -surreptitiously changed from a dot to a comma, C produces a string result of "123,456". Many people would -interpret this as one hundred and twenty-three thousand, four hundred -and fifty-six. +Some systems are broken in that they allow the "C" locale to be +overridden by users. If the decimal point character in the +C category of the "C" locale is surreptitiously changed +from a dot to a comma, C produces a +string result of "123,456". Many people would interpret this as +one hundred and twenty-three thousand, four hundred and fifty-six. =item * @@ -714,10 +715,6 @@ if modified as a result of a substitution based on a regular expression match involving C<\w>, C<\W>, C<\s>, or C<\S>; or of case-mapping with C<\l>, C<\L>,C<\u> or C<\U>. -=item B (sprintf()): - -Result is tainted if C is in effect. - =item B (printf() and write()): Success/failure result is never tainted. diff --git a/pod/perlmod.pod b/pod/perlmod.pod index fc81fdf..351ba73 100644 --- a/pod/perlmod.pod +++ b/pod/perlmod.pod @@ -212,9 +212,9 @@ This also has implications for the use of the SUPER:: qualifier =head2 Package Constructors and Destructors -Three special subroutines act as package -constructors and destructors. These are the C, C, and -C routines. The C is optional for these routines. +Four special subroutines act as package constructors and destructors. +These are the C, C, C, and C routines. The +C is optional for these routines. A C subroutine is executed as soon as possible, that is, the moment it is completely defined, even before the rest of the containing file @@ -225,24 +225,31 @@ files in time to be visible to the rest of the file. Once a C has run, it is immediately undefined and any code it used is returned to Perl's memory pool. This means you can't ever explicitly call a C. -Similar to C blocks, C blocks are run just before the -Perl runtime begins execution. For example, the code generators -documented in L make use of C blocks to initialize -and resolve pointers to XSUBs. - -An C subroutine is executed as late as possible, that is, when -the interpreter is being exited, even if it is exiting as a result of -a die() function. (But not if it's polymorphing into another program -via C, or being blown out of the water by a signal--you have to -trap that yourself (if you can).) You may have multiple C blocks -within a file--they will execute in reverse order of definition; that is: -last in, first out (LIFO). +An C subroutine is executed as late as possible, that is, after +perl has finished running the program and just before the interpreter +is being exited, even if it is exiting as a result of a die() function. +(But not if it's polymorphing into another program via C, or +being blown out of the water by a signal--you have to trap that yourself +(if you can).) You may have multiple C blocks within a file--they +will execute in reverse order of definition; that is: last in, first +out (LIFO). C blocks are not executed when you run perl with the +C<-c> switch. Inside an C subroutine, C<$?> contains the value that the program is going to pass to C. You can modify C<$?> to change the exit value of the program. Beware of changing C<$?> by accident (e.g. by running something via C). +Similar to C blocks, C blocks are run just before the +Perl runtime begins execution, in "first in, first out" (FIFO) order. +For example, the code generators documented in L make use of +C blocks to initialize and resolve pointers to XSUBs. + +Similar to C blocks, C blocks are run just after the +Perl compile phase ends and before the run time begins, in +LIFO order. C blocks are again useful in the Perl compiler +suite to save the compiled state of the program. + When you use the B<-n> and B<-p> switches to Perl, C and C work just as they do in B, as a degenerate case. As currently implemented (and subject to change, since its inconvenient at best), diff --git a/pod/perlmodlib.pod b/pod/perlmodlib.pod index 99d31bd..05570d9 100644 --- a/pod/perlmodlib.pod +++ b/pod/perlmodlib.pod @@ -48,15 +48,15 @@ The following pragmas are defined (and have their own documentation). =item attributes -set/get the attributes of a subroutine or variable +Get/set subroutine or variable attributes =item attrs -set/get attributes of a subroutine (obsolescent) +Set/get attributes of a subroutine (deprecated) =item autouse -postpone load of modules until a function is used +Postpone load of modules until a function is used =item base @@ -66,77 +66,81 @@ Establish IS-A relationship with base class at compile time Use MakeMaker's uninstalled version of a package +=item caller + +Inherit pragmatic attributes from caller's context + +=item charnames + +Define character names for C<\N{named}> string literal escape. + =item constant -declare constants +Declare constants =item diagnostics -Perl compiler pragma to force verbose warning diagnostics +Force verbose warning diagnostics =item fields -compile-time class fields +Declare a class's attribute fields at compile-time =item filetest -control the filetest permission operators +Control the filetest operators like C<-r>, C<-w> for AFS, etc. =item integer -compute arithmetic in integer instead of double +Compute arithmetic in integer instead of double =item less -perl pragma to request less of something from the compiler +Request less of something from the compiler (unimplemented) =item lib -manipulate @INC at compile time +Manipulate @INC at compile time =item locale -use and avoid POSIX locales for built-in operations +Use or avoid POSIX locales for built-in operations =item ops -restrict unsafe operations when compiling +Restrict unsafe operations when compiling =item overload -Package for overloading perl operations +Overload Perl operations =item re -alter regular expression behavior +Alter regular expression behavior =item sigtrap -enable simple signal handling +Enable simple signal handling =item strict -restrict unsafe constructs +Restrict unsafe constructs =item subs -predeclare sub names +Predeclare subroutine names =item utf8 -turn on UTF-8 and Unicode support +Turn on UTF-8 and Unicode support =item vars -predeclare global variable names +Predeclare global variable names (obsoleted by our()) =item warnings -control optional warnings - -=item vmsish - -control VMS-specific language features +Control optional warnings =back @@ -150,19 +154,19 @@ Exporter module. See their own documentation for details. =item AnyDBM_File -provide framework for multiple DBMs +Provide framework for multiple DBM libraries =item AutoLoader -load subroutines only on demand +Load subroutines only on demand =item AutoSplit -split a package for autoloading +Split a package for autoloading =item B -The Perl Compiler; See also L. +Guts of the Perl code generator (aka compiler) =item B::Asmdata @@ -194,7 +198,7 @@ Walk Perl syntax tree, printing debug info about ops =item B::Deparse -Perl compiler backend to produce perl code +Perl compiler backend to produce Perl code =item B::Disassembler @@ -202,7 +206,7 @@ Disassemble Perl bytecode =item B::Lint -Perl lint +Module to catch dubious constructs =item B::Showlex @@ -212,6 +216,8 @@ Show lexical variables used in functions or files Helper module for CC backend +B::Stash -- XXX NFI XXX + =item B::Terse Walk Perl syntax tree, printing terse info about ops @@ -222,11 +228,15 @@ Generates cross reference reports for Perl programs =item Benchmark -benchmark running times of code +Benchmark running times of code + +=item ByteLoader + +Load byte-compiled Perl code =item CGI -Simple Common Gateway Interface Class +Simple Common Gateway Interface class =item CGI::Apache @@ -244,6 +254,10 @@ Interface to Netscape Cookies CGI Interface for Fast CGI +=item CGI::Pretty + +Module to produce nicely formatted HTML code + =item CGI::Push Simple Interface to Server Push @@ -254,11 +268,11 @@ Try more than one constructors and return the first object available =item CPAN -query, download and build perl modules from CPAN sites +Query, download, and build Perl modules from CPAN sites =item CPAN::FirstTime -Utility for CPAN::Config file Initialization +Utility for CPAN::Config file initialization =item CPAN::Nox @@ -266,23 +280,27 @@ Wrapper around CPAN.pm without using any XS module =item Carp -warn of errors (from perspective of caller) +Act like warn/die from perspective of caller + +=item Carp::Heavy + +Carp guts =item Class::Struct -declare struct-like datatypes as Perl classes +Declare struct-like datatypes as Perl classes =item Config -access Perl configuration information +Access Perl configuration information =item Cwd -get pathname of current working directory +Get pathname of current working directory =item DB -programmatic interface to the Perl debugging API +Programmatic interface to the Perl debugging API (experimental) =item DB_File @@ -290,7 +308,11 @@ Perl5 access to Berkeley DB version 1.x =item Data::Dumper -stringified perl data structures, suitable for both printing and C +Serialize Perl data structures + +=item Devel::DProf + +A Perl execution profiler =item Devel::Peek @@ -298,15 +320,15 @@ A data debugging tool for the XS programmer =item Devel::SelfStubber -generate stubs for a SelfLoading module +Generate stubs for a SelfLoading module =item DirHandle -supply object methods for directory handles +Supply object methods for directory handles =item Dumpvalue -provides screen dump of Perl data. +Provide screen dump of Perl data =item DynaLoader @@ -314,31 +336,35 @@ Dynamically load C libraries into Perl code =item English -use nice English (or awk) names for ugly punctuation variables +Use English (or awk) names for ugly punctuation variables =item Env -perl module that imports environment variables +Access environment variables as regular ones =item Errno -System errno constants +Load the libc errno.h defines =item Exporter -Implements default import method for modules +Implement default import method for modules + +=item Exporter::Heavy + +Exporter guts =item ExtUtils::Command -utilities to replace common UNIX commands in Makefiles etc. +Utilities to replace common Unix commands in Makefiles etc. =item ExtUtils::Embed -Utilities for embedding Perl in C/C++ applications +Utilities for embedding Perl in C/C++ programs =item ExtUtils::Install -install files from here to there +Install files from here to there =item ExtUtils::Installed @@ -346,63 +372,69 @@ Inventory management of installed modules =item ExtUtils::Liblist -determine libraries to use and how to use them +Determine libraries to use and how to use them + +=item ExtUtils::MM_Cygwin + +Methods to override Unix behavior in ExtUtils::MakeMaker =item ExtUtils::MM_OS2 -methods to override UN*X behavior in ExtUtils::MakeMaker +Methods to override Unix behavior in ExtUtils::MakeMaker =item ExtUtils::MM_Unix -methods used by ExtUtils::MakeMaker +Methods used by ExtUtils::MakeMaker =item ExtUtils::MM_VMS -methods to override UN*X behavior in ExtUtils::MakeMaker +Methods to override Unix behavior in ExtUtils::MakeMaker =item ExtUtils::MM_Win32 -methods to override UN*X behavior in ExtUtils::MakeMaker +Methods to override Unix behavior in ExtUtils::MakeMaker =item ExtUtils::MakeMaker -create an extension Makefile +Create an extension Makefile =item ExtUtils::Manifest -utilities to write and check a MANIFEST file - -=item ExtUtils::Miniperl +Utilities to write and check a MANIFEST file -write the C code for perlmain.c +ExtUtils::Miniperl, writemain - Write the C code for perlmain.c =item ExtUtils::Mkbootstrap -make a bootstrap file for use by DynaLoader +Make a bootstrap file for use by DynaLoader =item ExtUtils::Mksymlists -write linker options files for dynamic extension +Write linker options files for dynamic extension =item ExtUtils::Packlist -manage .packlist files +Manage .packlist files =item ExtUtils::testlib -add blib/* directories to @INC +Add blib/* directories to @INC =item Fatal -replace functions with equivalents which succeed or die +Replace functions with equivalents which succeed or die =item Fcntl -load the C Fcntl.h defines +Load the libc fcntl.h defines =item File::Basename -split a pathname into pieces +Split a pathname into pieces + +=item File::CheckTree + +Run many filetest checks on a tree =item File::Compare @@ -414,23 +446,27 @@ Copy files or filehandles =item File::DosGlob -DOS like globbing and then some +DOS-like globbing and then some =item File::Find -traverse a file tree +Traverse a file tree + +=item File::Glob + +Perl extension for BSD filename globbing =item File::Path -create or remove a series of directories +Create or remove a series of directories =item File::Spec -portably perform operations on file names +Portably perform operations on file names =item File::Spec::Functions -portably perform operations on file names +Portably perform operations on file names =item File::Spec::Mac @@ -438,43 +474,43 @@ File::Spec for MacOS =item File::Spec::OS2 -methods for OS/2 file specs +Methods for OS/2 file specs =item File::Spec::Unix -methods used by File::Spec +Methods used by File::Spec =item File::Spec::VMS -methods for VMS file specs +Methods for VMS file specs =item File::Spec::Win32 -methods for Win32 file specs +Methods for Win32 file specs =item File::stat -by-name interface to Perl's built-in stat() functions +By-name interface to Perl's built-in stat() functions =item FileCache -keep more files open than the system permits +Keep more files open than the system permits =item FileHandle -supply object methods for filehandles +Supply object methods for filehandles =item FindBin -Locate directory of original perl script +Locate installation directory of running Perl program =item GDBM_File -Perl5 access to the gdbm library. +Access to the gdbm library =item Getopt::Long -extended processing of command line options +Extended processing of command line options =item Getopt::Std @@ -482,27 +518,27 @@ Process single-character switches with switch clustering =item I18N::Collate -compare 8-bit scalar data according to the current locale +Compare 8-bit scalar data according to current locale =item IO -load various IO modules +Front-end to load various IO modules =item IO::Dir -supply object methods for directory handles +Supply object methods for directory handles =item IO::File -supply object methods for filehandles +Supply object methods for filehandles =item IO::Handle -supply object methods for I/O handles +Supply object methods for I/O handles =item IO::Pipe -supply object methods for pipes +Supply object methods for pipes =item IO::Poll @@ -510,7 +546,7 @@ Object interface to system poll call =item IO::Seekable -supply seek based methods for I/O objects +Supply seek based methods for I/O objects =item IO::Select @@ -534,11 +570,11 @@ SysV Msg IPC object class =item IPC::Open2 -open a process for both reading and writing +Open a process for both reading and writing =item IPC::Open3 -open a process for reading, writing, and error handling +Open a process for reading, writing, and error handling =item IPC::Semaphore @@ -558,35 +594,31 @@ Arbitrary size integer math package =item Math::Complex -complex numbers and associated mathematical functions +Complex numbers and associated mathematical functions =item Math::Trig -trigonometric functions - -=item NDBM_File - -Tied access to ndbm files +Trigonometric functions =item Net::Ping -check a remote host for reachability +Check a remote host for reachability =item Net::hostent -by-name interface to Perl's built-in gethost*() functions +By-name interface to Perl's built-in gethost*() functions =item Net::netent -by-name interface to Perl's built-in getnet*() functions +By-name interface to Perl's built-in getnet*() functions =item Net::protoent -by-name interface to Perl's built-in getproto*() functions +By-name interface to Perl's built-in getproto*() functions =item Net::servent -by-name interface to Perl's built-in getserv*() functions +By-name interface to Perl's built-in getserv*() functions =item O @@ -594,19 +626,47 @@ Generic interface to Perl Compiler backends =item Opcode -Disable named opcodes when compiling perl code +Disable named opcodes when compiling Perl code =item POSIX Perl interface to IEEE Std 1003.1 +=item Pod::Checker + +Check pod documents for syntax errors + =item Pod::Html -module to convert pod files to HTML +Module to convert pod files to HTML + +=item Pod::InputObjects + +Manage POD objects + +=item Pod::Man + +Convert POD data to formatted *roff input + +=item Pod::Parser + +Base class for creating POD filters and translators + +=item Pod::Select + +Extract selected sections of POD from input =item Pod::Text -convert POD data to formatted ASCII text +Convert POD data to formatted ASCII text + +=item Pod::Text::Color + +Convert POD data to formatted color ASCII text + +=item Pod::Usage + +Print a usage message from embedded pod documentation =item SDBM_File @@ -618,27 +678,27 @@ Compile and execute code in restricted compartments =item Search::Dict -search for key in dictionary file +Search for key in dictionary file =item SelectSaver -save and restore selected file handle +Save and restore selected file handle =item SelfLoader -load functions only on demand +Load functions only on demand =item Shell -run shell commands transparently within perl +Run shell commands transparently within Perl =item Socket -load the C socket.h defines and structure manipulators +Load the libc socket.h defines and structure manipulators =item Symbol -manipulate Perl symbols and their names +Manipulate Perl symbols and their names =item Sys::Hostname @@ -646,85 +706,65 @@ Try every conceivable way to get hostname =item Sys::Syslog -Perl interface to the UNIX syslog(3) calls +Interface to the libc syslog(3) calls =item Term::Cap -Perl termcap interface +Termcap interface =item Term::Complete -Perl word completion module +Word completion module =item Term::ReadLine -Perl interface to various C packages. +Interface to various `readline' packages. =item Test -provides a simple framework for writing test scripts +Provides a simple framework for writing test scripts =item Test::Harness -run perl standard test scripts with statistics +Run Perl standard test scripts with statistics =item Text::Abbrev -create an abbreviation table from a list +Create an abbreviation table from a list =item Text::ParseWords -parse text into an array of tokens or array of arrays +Parse text into a list of tokens or array of arrays =item Text::Soundex -Implementation of the Soundex Algorithm as Described by Knuth +Implementation of the Soundex Algorithm as described by Knuth -=item Text::Tabs -- expand and unexpand tabs per the unix expand(1) and unexpand(1) +Text::Tabs -- expand and unexpand tabs per expand(1) and unexpand(1) =item Text::Wrap -line wrapping to form simple paragraphs - -=item Thread - -multithreading - -=item Thread::Queue - -thread-safe queues - -=item Thread::Semaphore - -thread-safe semaphores - -=item Thread::Signal - -Start a thread which runs signal handlers reliably - -=item Thread::Specific - -thread-specific keys +Line wrapping to form simple paragraphs =item Tie::Array -base class for tied arrays +Base class for tied arrays =item Tie::Handle -base class definitions for tied handles +Base class definitions for tied handles -=item Tie::Hash, Tie::StdHash +=item Tie::Hash -base class definitions for tied hashes +Base class definitions for tied hashes =item Tie::RefHash -use references as hash keys +Use references as hash keys -=item Tie::Scalar, Tie::StdScalar +=item Tie::Scalar -base class definitions for tied scalars +Base class definitions for tied scalars =item Tie::SubstrHash @@ -732,31 +772,31 @@ Fixed-table-size, fixed-key-length hashing =item Time::Local -efficiently compute time from local and GMT time +Efficiently compute time from local and GMT time =item Time::gmtime -by-name interface to Perl's built-in gmtime() function +By-name interface to Perl's built-in gmtime() function =item Time::localtime -by-name interface to Perl's built-in localtime() function +By-name interface to Perl's built-in localtime() function =item Time::tm -internal object used by Time::gmtime and Time::localtime +Internal object used by Time::gmtime and Time::localtime =item UNIVERSAL -base class for ALL classes (blessed references) +Base class for ALL classes (blessed references) =item User::grent -by-name interface to Perl's built-in getgr*() functions +By-name interface to Perl's built-in getgr*() functions =item User::pwent -by-name interface to Perl's built-in getpw*() functions +By-name interface to Perl's built-in getpw*() functions =back @@ -875,56 +915,64 @@ You should try to choose one close to you: =item Africa - South Africa ftp://ftp.is.co.za/programming/perl/CPAN/ + South Africa ftp://ftp.is.co.za/programming/perl/CPAN/ + ftp://ftp.saix.net/pub/CPAN/ + ftp://ftp.sun.ac.za/CPAN/ ftp://ftpza.co.za/pub/mirrors/cpan/ =item Asia - China ftp://freesoft.cei.gov.cn/pub/languages/perl/CPAN/ - Hong Kong ftp://ftp.hkstar.com/pub/CPAN/ - Israel ftp://bioinfo.weizmann.ac.il/pub/software/perl/CPAN/ - Japan ftp://ftp.dti.ad.jp/pub/lang/CPAN/ + China ftp://freesoft.cei.gov.cn/pub/languages/perl/CPAN/ + Hong Kong ftp://ftp.hkstar.com/pub/CPAN/ + ftp://ftp.pacific.net.hk/pub/mirror/CPAN/ + Indonesia ftp://malone.piksi.itb.ac.id/pub/CPAN/ + Israel ftp://bioinfo.weizmann.ac.il/pub/software/perl/CPAN/ + Japan ftp://ftp.dti.ad.jp/pub/lang/CPAN/ ftp://ftp.jaist.ac.jp/pub/lang/perl/CPAN/ ftp://ftp.lab.kdd.co.jp/lang/perl/CPAN/ ftp://ftp.meisei-u.ac.jp/pub/CPAN/ ftp://ftp.ring.gr.jp/pub/lang/perl/CPAN/ ftp://mirror.nucba.ac.jp/mirror/Perl/ - Singapore ftp://ftp.nus.edu.sg/pub/unix/perl/CPAN/ - South Korea ftp://ftp.bora.net/pub/CPAN/ + Singapore ftp://ftp.nus.edu.sg/pub/unix/perl/CPAN/ + South Korea ftp://ftp.bora.net/pub/CPAN/ + ftp://ftp.kornet.net/pub/CPAN/ ftp://ftp.nuri.net/pub/CPAN/ - Taiwan ftp://ftp.wownet.net/pub2/PERL/ + Taiwan ftp://coda.nctu.edu.tw/computer-languages/perl/CPAN/ + ftp://ftp.ee.ncku.edu.tw/pub3/perl/CPAN/ + ftp://ftp.wownet.net/pub2/PERL/ ftp://ftp1.sinica.edu.tw/pub1/perl/CPAN/ - Thailand ftp://ftp.cs.riubon.ac.th/pub/mirrors/CPAN/ + Thailand ftp://ftp.cs.riubon.ac.th/pub/mirrors/CPAN/ ftp://ftp.nectec.or.th/pub/mirrors/CPAN/ =item Australasia - Australia ftp://cpan.topend.com.au/pub/CPAN/ + Australia ftp://cpan.topend.com.au/pub/CPAN/ ftp://ftp.labyrinth.net.au/pub/perl/CPAN/ ftp://ftp.sage-au.org.au/pub/compilers/perl/CPAN/ ftp://mirror.aarnet.edu.au/pub/perl/CPAN/ - New Zealand ftp://ftp.auckland.ac.nz/pub/perl/CPAN/ + New Zealand ftp://ftp.auckland.ac.nz/pub/perl/CPAN/ ftp://sunsite.net.nz/pub/languages/perl/CPAN/ -Central America +=item Central America - Costa Rica ftp://ftp.ucr.ac.cr/pub/Unix/CPAN/ + Costa Rica ftp://ftp.ucr.ac.cr/pub/Unix/CPAN/ =item Europe - Austria ftp://ftp.tuwien.ac.at/pub/languages/perl/CPAN/ - Belgium ftp://ftp.kulnet.kuleuven.ac.be/pub/mirror/CPAN/ - Bulgaria ftp://ftp.ntrl.net/pub/mirrors/CPAN/ - Croatia ftp://ftp.linux.hr/pub/CPAN/ - Czech Republic ftp://ftp.fi.muni.cz/pub/perl/ + Austria ftp://ftp.tuwien.ac.at/pub/languages/perl/CPAN/ + Belgium ftp://ftp.kulnet.kuleuven.ac.be/pub/mirror/CPAN/ + Bulgaria ftp://ftp.ntrl.net/pub/mirrors/CPAN/ + Croatia ftp://ftp.linux.hr/pub/CPAN/ + Czech Republic ftp://ftp.fi.muni.cz/pub/perl/ ftp://sunsite.mff.cuni.cz/Languages/Perl/CPAN/ - Denmark ftp://sunsite.auc.dk/pub/languages/perl/CPAN/ - Estonia ftp://ftp.ut.ee/pub/languages/perl/CPAN/ - Finland ftp://ftp.funet.fi/pub/languages/perl/CPAN/ - France ftp://ftp.lip6.fr/pub/perl/CPAN/ + Denmark ftp://sunsite.auc.dk/pub/languages/perl/CPAN/ + Estonia ftp://ftp.ut.ee/pub/languages/perl/CPAN/ + Finland ftp://ftp.funet.fi/pub/languages/perl/CPAN/ + France ftp://ftp.lip6.fr/pub/perl/CPAN/ ftp://ftp.oleane.net/pub/mirrors/CPAN/ ftp://ftp.pasteur.fr/pub/computing/CPAN/ - Germany ftp://ftp.archive.de.uu.net/pub/CPAN/ + ftp://ftp.uvsq.fr/pub/perl/CPAN/ + Germany ftp://ftp.archive.de.uu.net/pub/CPAN/ ftp://ftp.gmd.de/packages/CPAN/ ftp://ftp.gwdg.de/pub/languages/perl/CPAN/ ftp://ftp.leo.org/pub/comp/programming/languages/script/perl/CPAN/ @@ -932,74 +980,87 @@ Central America ftp://ftp.rz.ruhr-uni-bochum.de/pub/CPAN/ ftp://ftp.uni-erlangen.de/pub/source/CPAN/ ftp://ftp.uni-hamburg.de/pub/soft/lang/perl/CPAN/ - Greece ftp://ftp.ntua.gr/pub/lang/perl/ - Hungary ftp://ftp.kfki.hu/pub/packages/perl/CPAN/ - Ireland ftp://sunsite.compapp.dcu.ie/pub/perl/ - Italy ftp://cis.uniRoma2.it/CPAN/ + Greece ftp://ftp.ntua.gr/pub/lang/perl/ + Hungary ftp://ftp.kfki.hu/pub/packages/perl/CPAN/ + Iceland ftp://ftp.gm.is/pub/CPAN/ + Ireland ftp://cpan.indigo.ie/pub/CPAN/ + ftp://sunsite.compapp.dcu.ie/pub/perl/ + Italy ftp://cis.uniRoma2.it/CPAN/ ftp://ftp.flashnet.it/pub/CPAN/ ftp://ftp.unina.it/pub/Other/CPAN/ ftp://ftp.unipi.it/pub/mirror/perl/CPAN/ - Netherlands ftp://ftp.cs.uu.nl/mirror/CPAN/ + Netherlands ftp://ftp.cs.uu.nl/mirror/CPAN/ ftp://ftp.EU.net/packages/cpan/ ftp://ftp.nluug.nl/pub/languages/perl/CPAN/ - Norway ftp://ftp.uit.no/pub/languages/perl/cpan/ + Norway ftp://ftp.uit.no/pub/languages/perl/cpan/ ftp://sunsite.uio.no/pub/languages/perl/CPAN/ - Poland ftp://ftp.man.szczecin.pl/pub/perl/CPAN/ + Poland ftp://ftp.man.szczecin.pl/pub/perl/CPAN/ ftp://ftp.man.torun.pl/pub/doc/CPAN/ ftp://ftp.pk.edu.pl/pub/lang/perl/CPAN/ ftp://sunsite.icm.edu.pl/pub/CPAN/ - Portugal ftp://ftp.ci.uminho.pt/pub/mirrors/cpan/ + Portugal ftp://ftp.ci.uminho.pt/pub/mirrors/cpan/ ftp://ftp.ist.utl.pt/pub/CPAN/ ftp://ftp.ua.pt/pub/CPAN/ - Romania ftp://ftp.dntis.ro/pub/mirrors/perl-cpan/ + Romania ftp://ftp.dntis.ro/pub/mirrors/perl-cpan/ ftp://ftp.dnttm.ro/pub/CPAN/ Russia ftp://ftp.chg.ru/pub/lang/perl/CPAN/ ftp://ftp.sai.msu.su/pub/lang/perl/CPAN/ - Slovakia ftp://ftp.entry.sk/pub/languages/perl/CPAN/ - Slovenia ftp://ftp.arnes.si/software/perl/CPAN/ - Spain ftp://ftp.etse.urv.es/pub/perl/ + Slovakia ftp://ftp.entry.sk/pub/languages/perl/CPAN/ + Slovenia ftp://ftp.arnes.si/software/perl/CPAN/ + Spain ftp://ftp.etse.urv.es/pub/perl/ ftp://ftp.rediris.es/mirror/CPAN/ - Sweden ftp://ftp.sunet.se/pub/lang/perl/CPAN/ - Switzerland ftp://sunsite.cnlab-switch.ch/mirror/CPAN/ - Turkey ftp://sunsite.bilkent.edu.tr/pub/languages/CPAN/ - United Kingdom ftp://ftp.demon.co.uk/pub/mirrors/perl/CPAN/ + Sweden ftp://ftp.sunet.se/pub/lang/perl/CPAN/ + Switzerland ftp://sunsite.cnlab-switch.ch/mirror/CPAN/ + Turkey ftp://sunsite.bilkent.edu.tr/pub/languages/CPAN/ + United Kingdom ftp://ftp.demon.co.uk/pub/mirrors/perl/CPAN/ ftp://ftp.flirble.org/pub/languages/perl/CPAN/ + ftp://ftp.mirror.ac.uk/sites/ftp.funet.fi/pub/languages/perl/CPAN/ ftp://ftp.plig.org/pub/CPAN/ ftp://sunsite.doc.ic.ac.uk/packages/CPAN/ - ftp://unix.hensa.ac.uk/mirrors/perl-CPAN/ =item North America - Alberta ftp://sunsite.ualberta.ca/pub/Mirror/CPAN/ + Alberta ftp://sunsite.ualberta.ca/pub/Mirror/CPAN/ + California ftp://cpan.nas.nasa.gov/pub/perl/CPAN/ + ftp://cpan.valueclick.com/CPAN/ + ftp://ftp.cdrom.com/pub/perl/CPAN/ + ftp://ftp.digital.com/pub/plan/perl/CPAN/ California ftp://cpan.nas.nasa.gov/pub/perl/CPAN/ + ftp://cpan.valueclick.com/CPAN/ ftp://ftp.cdrom.com/pub/perl/CPAN/ ftp://ftp.digital.com/pub/plan/perl/CPAN/ - Colorado ftp://ftp.cs.colorado.edu/pub/perl/CPAN/ - Florida ftp://ftp.cise.ufl.edu/pub/perl/CPAN/ - Illinois ftp://uiarchive.uiuc.edu/pub/lang/perl/CPAN/ - Indiana ftp://csociety-ftp.ecn.purdue.edu/pub/CPAN/ + Colorado ftp://ftp.cs.colorado.edu/pub/perl/CPAN/ + Florida ftp://ftp.cise.ufl.edu/pub/perl/CPAN/ + Illinois ftp://uiarchive.uiuc.edu/pub/lang/perl/CPAN/ + Indiana ftp://csociety-ftp.ecn.purdue.edu/pub/CPAN/ ftp://ftp.uwsg.indiana.edu/pub/perl/CPAN/ - Manitoba ftp://theory.uwinnipeg.ca/pub/CPAN/ - Massachusetts ftp://ftp.ccs.neu.edu/net/mirrors/ftp.funet.fi/pub/languages/perl/CPAN/ + Kentucky ftp://ftp.uky.edu/CPAN/ + Manitoba ftp://theoryx5.uwinnipeg.ca/pub/CPAN/ + Massachusetts ftp://ftp.ccs.neu.edu/net/mirrors/ftp.funet.fi/pub/languages/perl/CPAN/ ftp://ftp.iguide.com/pub/mirrors/packages/perl/CPAN/ Mexico ftp://ftp.msg.com.mx/pub/CPAN/ Minnesota ftp://ftp.midearthbbs.com/CPAN/ - New York ftp://ftp.rge.com/pub/languages/perl/ - North Carolina ftp://ftp.duke.edu/pub/perl/ - Oklahoma ftp://ftp.ou.edu/mirrors/CPAN/ + New York ftp://ftp.deao.net/pub/CPAN/ + ftp://ftp.rge.com/pub/languages/perl/ + ftp://ftp.tpj.com/pub/CPAN/ + Nova Scotia ftp://cpan.chebucto.ns.ca/pub/CPAN/ + North Carolina ftp://ftp.duke.edu/pub/perl/ + Oklahoma ftp://ftp.ou.edu/mirrors/CPAN/ Ontario ftp://ftp.crc.ca/pub/packages/lang/perl/CPAN/ - Oregon ftp://ftp.orst.edu/pub/packages/CPAN/ - Pennsylvania ftp://ftp.epix.net/pub/languages/perl/ - Texas ftp://ftp.sedl.org/pub/mirrors/CPAN/ - Utah ftp://mirror.xmission.com/CPAN/ - Virginia ftp://ftp.perl.org/pub/perl/CPAN/ + Oregon ftp://ftp.orst.edu/pub/packages/CPAN/ + Pennsylvania ftp://ftp.epix.net/pub/languages/perl/ + Tennessee ftp://ftp.sunsite.utk.edu/pub/CPAN/ + Texas ftp://ftp.sedl.org/pub/mirrors/CPAN/ + Utah ftp://mirror.xmission.com/CPAN/ + Virginia ftp://ftp.perl.org/pub/perl/CPAN/ ftp://ruff.cs.jmu.edu/pub/CPAN/ Washington ftp://ftp-mirror.internap.com/pub/CPAN/ ftp://ftp.spu.edu/pub/CPAN/ =item South America - Brazil ftp://cpan.if.usp.br/pub/mirror/CPAN/ + Brazil ftp://cpan.if.usp.br/pub/mirror/CPAN/ + ftp://ftp.matrix.com.br/pub/perl/ Chile ftp://sunsite.dcc.uchile.cl/pub/Lang/perl/CPAN/ =back diff --git a/pod/perlop.pod b/pod/perlop.pod index 14ca6b5..547ee53 100644 --- a/pod/perlop.pod +++ b/pod/perlop.pod @@ -173,7 +173,7 @@ $_. The return value indicates the success of the operation. (If the right argument is an expression rather than a search pattern, substitution, or transliteration, it is interpreted as a search pattern at run time. This can be is less efficient than an explicit search, because the -pattern must be compiled every time the expression is evaluated. +pattern must be compiled every time the expression is evaluated). Binary "!~" is just like "=~" except the return value is negated in the logical sense. @@ -195,10 +195,11 @@ to the modulus operator as implemented by your C compiler. This operator is not as well defined for negative operands, but it will execute faster. -Binary "x" is the repetition operator. In scalar context, it -returns a string consisting of the left operand repeated the number of -times specified by the right operand. In list context, if the left -operand is a list in parentheses, it repeats the list. +Binary "x" is the repetition operator. In scalar context or if the left +operand is not enclosed in parentheses, it returns a string consisting +of the left operand repeated the number of times specified by the right +operand. In list context, if the left operand is enclosed in +parentheses, it repeats the list. print '-' x 80; # print row of dashes @@ -510,10 +511,10 @@ The following are recognized: Although these are grouped by family, they all have the precedence of assignment. -Unlike in C, the assignment operator produces a valid lvalue. Modifying -an assignment is equivalent to doing the assignment and then modifying -the variable that was assigned to. This is useful for modifying -a copy of something, like this: +Unlike in C, the scalar assignment operator produces a valid lvalue. +Modifying an assignment is equivalent to doing the assignment and +then modifying the variable that was assigned to. This is useful +for modifying a copy of something, like this: ($tmp = $global) =~ tr [A-Z] [a-z]; @@ -526,6 +527,11 @@ is equivalent to $a += 2; $a *= 3; +Similarly, a list assignment in list context produces the list of +lvalues assigned to, and a list assignment in scalar context returns +the number of elements produced by the expression on the right hand +side of the assignment. + =head2 Comma Operator Binary "," is the comma operator. In scalar context it evaluates @@ -957,7 +963,7 @@ notably if the result of qr() is used standalone: my @compiled = map qr/$_/i, @$patterns; grep { my $success = 0; - foreach my $pat @compiled { + foreach my $pat (@compiled) { $success = 1, last if /$pat/; } $success; @@ -1068,9 +1074,9 @@ this expression: qw(foo bar baz) -is exactly equivalent to the list: +is semantically equivalent to the list: - ('foo', 'bar', 'baz') + 'foo', 'bar', 'baz' Some frequently seen examples: diff --git a/pod/perlopentut.pod b/pod/perlopentut.pod index ae622a6..5d2be30 100644 --- a/pod/perlopentut.pod +++ b/pod/perlopentut.pod @@ -84,7 +84,7 @@ C function. But in the shell, you just use a different redirection character. That's also the case for Perl. The C call remains the same--just its argument differs. -If the leading character is a pipe symbol, C starts up a new command and open a write-only filehandle leading into that command. This lets you write into that handle and have what you write show up on that command's standard input. For example: @@ -123,9 +123,9 @@ special way. If you open minus for reading, it really means to access the standard input. If you open minus for writing, it really means to access the standard output. -If minus can be used as the default input or default output? What happens +If minus can be used as the default input or default output, what happens if you open a pipe into or out of minus? What's the default command it -would run? The same script as you're current running! This is actually +would run? The same script as you're currently running! This is actually a stealth C hidden inside an C call. See L for details. diff --git a/pod/perlport.pod b/pod/perlport.pod index 6b532f3..21f144c 100644 --- a/pod/perlport.pod +++ b/pod/perlport.pod @@ -925,10 +925,10 @@ the message body to majordomo@list.stratagy.com. Recent versions of Perl have been ported to platforms such as OS/400 on AS/400 minicomputers as well as OS/390, VM/ESA, and BS2000 for S/390 Mainframes. Such computers use EBCDIC character sets internally (usually -Character Code Set ID 00819 for OS/400 and 1047 for S/390 systems). -On the mainframe perl currently works under the "Unix system services -for OS/390" (formerly known as OpenEdition), VM/ESA OpenEdition, or -the BS200 POSIX system (BS2000 is supported in perl 5.006 and greater). +Character Code Set ID 0037 for OS/400 and either 1047 or POSIX-BC for S/390 +systems). On the mainframe perl currently works under the "Unix system +services for OS/390" (formerly known as OpenEdition), VM/ESA OpenEdition, or +the BS200 POSIX-BC system (BS2000 is supported in perl 5.6 and greater). As of R2.5 of USS for OS/390 and Version 2.3 of VM/ESA these Unix sub-systems do not support the C<#!> shebang trick for script invocation. @@ -1452,13 +1452,13 @@ in the Winsock API does. (Win32) Available only for socket handles. (S) -=item kill LIST +=item kill SIGNAL, LIST Not implemented, hence not useful for taint checking. (S, S) -Available only for process handles returned by the C -method of spawning a process. (Win32) +Unlike Unix platforms, C will actually terminate +the process. (Win32) =item link OLDFILE,NEWFILE @@ -1663,6 +1663,10 @@ Not useful. (S) =over 4 +=item v1.45, 20 December 1999 + +Small changes from 5.005_63 distribution, more changes to EBCDIC info. + =item v1.44, 19 July 1999 A bunch of updates from Peter Prymmer for C<$^O> values, @@ -1756,9 +1760,10 @@ Chris Nandor Epudge@pobox.comE, Matthias Neeracher Eneeri@iis.ee.ethz.chE, Gary Ng E71564.1743@CompuServe.COME, Tom Phoenix Erootbeer@teleport.comE, +AndrE Pirard EA.Pirard@ulg.ac.beE, Peter Prymmer Epvhp@forte.comE, Hugo van der Sanden Ehv@crypt0.demon.co.ukE, -Gurusamy Sarathy Egsar@umich.eduE, +Gurusamy Sarathy Egsar@activestate.comE, Paul J. Schinder Eschinder@pobox.comE, Michael G Schwern Eschwern@pobox.comE, Dan Sugalski Esugalskd@ous.eduE, @@ -1769,4 +1774,4 @@ Epudge@pobox.comE. =head1 VERSION -Version 1.44, last modified 22 July 1999 +Version 1.45, last modified 20 December 1999 diff --git a/pod/perlre.pod b/pod/perlre.pod index 4bc042d..70ec00c 100644 --- a/pod/perlre.pod +++ b/pod/perlre.pod @@ -121,7 +121,7 @@ to integral values less than a preset limit defined when perl is built. This is usually 32766 on the most common platforms. The actual limit can be seen in the error message generated by code such as this: - $_ **= $_ , / {$_} / for 2 .. 42; + $_ **= $_ , / {$_} / for 2 .. 42; By default, a quantified subpattern is "greedy", that is, it will match as many times as possible (given a particular starting location) while still @@ -185,12 +185,13 @@ Use C<\w+> to match a string of Perl-identifier characters (which isn't the same as matching an English word). If C is in effect, the list of alphabetic characters generated by C<\w> is taken from the current locale. See L. You may use C<\w>, C<\W>, C<\s>, C<\S>, -C<\d>, and C<\D> within character classes (though not as either end of -a range). See L for details about C<\pP>, C<\PP>, and C<\X>. +C<\d>, and C<\D> within character classes, but if you try to use them +as endpoints of a range, that's not a range, the "-" is understood literally. +See L for details about C<\pP>, C<\PP>, and C<\X>. The POSIX character class syntax - [:class:] + [:class:] is also available. The available classes and their backslash equivalents (if available) are as follows: @@ -213,7 +214,7 @@ For example use C<[:upper:]> to match all the uppercase characters. Note that the C<[]> are part of the C<[::]> construct, not part of the whole character class. For example: - [01[:alpha:]%] + [01[:alpha:]%] matches one, zero, any alphabetic character, and the percentage sign. @@ -246,29 +247,27 @@ The assumedly non-obviously named classes are: =item cntrl - Any control character. Usually characters that don't produce - output as such but instead control the terminal somehow: - for example newline and backspace are control characters. - All characters with ord() less than 32 are most often control - classified as characters. +Any control character. Usually characters that don't produce output as +such but instead control the terminal somehow: for example newline and +backspace are control characters. All characters with ord() less than +32 are most often control classified as characters. =item graph - Any alphanumeric or punctuation character. +Any alphanumeric or punctuation character. =item print - Any alphanumeric or punctuation character or space. +Any alphanumeric or punctuation character or space. =item punct - Any punctuation character. +Any punctuation character. =item xdigit - Any hexadecimal digit. Though this may feel silly - (/0-9a-f/i would work just fine) it is included - for completeness. +Any hexadecimal digit. Though this may feel silly (/0-9a-f/i would +work just fine) it is included for completeness. =item @@ -717,6 +716,11 @@ themselves. =head2 Backtracking +NOTE: This section presents an abstract approximation of regular +expression behavior. For a more rigorous (and complicated) view of +the rules involved in selecting a match among possible alternatives, +see L. + A fundamental feature of regular expression matching involves the notion called I, which is currently used (when needed) by all regular expression quantifiers, namely C<*>, C<*?>, C<+>, @@ -930,11 +934,16 @@ in C<[]>, which will match any one character from the list. If the first character after the "[" is "^", the class matches any character not in the list. Within a list, the "-" character specifies a range, so that C represents all characters between "a" and "z", -inclusive. If you want "-" itself to be a member of a class, put it -at the start or end of the list, or escape it with a backslash. (The +inclusive. If you want either "-" or "]" itself to be a member of a +class, put it at the start of the list (possibly after a "^"), or +escape it with a backslash. "-" is also taken literally when it is +at the end of the list, just before the closing "]". (The following all specify the same class of three characters: C<[-az]>, C<[az-]>, and C<[a\-z]>. All are different from C<[a-z]>, which specifies a class containing twenty-six characters.) +Also, if you try to use the character classes C<\w>, C<\W>, C<\s>, +C<\S>, C<\d>, or C<\D> as endpoints of a range, that's not a range, +the "-" is understood literally. Note also that the whole range idea is rather unportable between character sets--and even within character sets they may cause results @@ -1085,6 +1094,107 @@ the matched string, and is reset by each assignment to pos(). Zero-length matches at the end of the previous match are ignored during C. +=head2 Combining pieces together + +Each of the elementary pieces of regular expressions which were described +before (such as C or C<\Z>) could match at most one substring +at the given position of the input string. However, in a typical regular +expression these elementary pieces are combined into more complicated +patterns using combining operators C, C, C etc +(in these examples C and C are regular subexpressions). + +Such combinations can include alternatives, leading to a problem of choice: +if we match a regular expression C against C<"abc">, will it match +substring C<"a"> or C<"ab">? One way to describe which substring is +actually matched is the concept of backtracking (see L<"Backtracking">). +However, this description is too low-level and makes you think +in terms of a particular implementation. + +Another description starts with notions of "better"/"worse". All the +substrings which may be matched by the given regular expression can be +sorted from the "best" match to the "worst" match, and it is the "best" +match which is chosen. This substitutes the question of "what is chosen?" +by the question of "which matches are better, and which are worse?". + +Again, for elementary pieces there is no such question, since at most +one match at a given position is possible. This section describes the +notion of better/worse for combining operators. In the description +below C and C are regular subexpressions. + +=over + +=item C + +Consider two possible matches, C and C, C and C are +substrings which can be matched by C, C and C are substrings +which can be matched by C. + +If C is better match for C than C, C is a better +match than C. + +If C and C coincide: C is a better match than C if +C is better match for C than C. + +=item C + +When C can match, it is a better match than when only C can match. + +Ordering of two matches for C is the same as for C. Similar for +two matches for C. + +=item C + +Matches as C (repeated as many times as necessary). + +=item C + +Matches as C. + +=item C + +Matches as C. + +=item C, C, C + +Same as C, C, C respectively. + +=item C, C, C + +Same as C, C, C respectively. + +=item C<(?ES)> + +Matches the best match for C and only that. + +=item C<(?=S)>, C<(?<=S)> + +Only the best match for C is considered. (This is important only if +C has capturing parentheses, and backreferences are used somewhere +else in the whole regular expression.) + +=item C<(?!S)>, C<(? + +For this grouping operator there is no need to describe the ordering, since +only whether or not C can match is important. + +=item C<(?p{ EXPR })> + +The ordering is the same as for the regular expression which is +the result of EXPR. + +=item C<(?(condition)yes-pattern|no-pattern)> + +Recall that which of C or C actually matches is +already determined. The ordering of the matches is the same as for the +chosen subexpression. + +=back + +The above recipes describe the ordering of matches I. +One more rule is needed to understand how a match is determined for the +whole regular expression: a match at an earlier position is always better +than a match at a later position. + =head2 Creating custom RE engines Overloaded constants (see L) provide a simple way to extend diff --git a/pod/perlref.pod b/pod/perlref.pod index 5958a72..f738399 100644 --- a/pod/perlref.pod +++ b/pod/perlref.pod @@ -558,11 +558,40 @@ to array indices. Here is an example: print "$k => $v\n"; } -Perl will raise an exception if you try to delete keys from a pseudo-hash -or try to access nonexistent fields. For better performance, Perl can also +Perl will raise an exception if you try to access nonexistent fields. +For better performance, Perl can also do the translation from field names to array indices at compile time for typed object references. See L. +There are two ways to check for the existence of a key in a +pseudo-hash. The first is to use exists(). This checks to see if the +given field has ever been set. It acts this way to match the behavior +of a regular hash. For instance: + + $phash = [{foo =>1, bar => 2, pants => 3}, 'FOO']; + $phash->{pants} = undef; + + print exists $phash->{foo}; # true, 'foo' was set in the declaration + print exists $phash->{bar}; # false, 'bar' has not been used. + print exists $phash->{pants}; # true, your 'pants' have been touched + +The second is to use exists() on the hash reference sitting in the +first array element. This checks to see if the given key is a valid +field in the pseudo-hash. + + print exists $phash->[0]{bar}; # true, 'bar' is a valid field + print exists $phash->[0]{shoes};# false, 'shoes' can't be used + +delete() on a pseudo-hash element only deletes the value corresponding +to the key, not the key itself. To delete the key, you'll have to +explicitly delete it from the first hash element. + + print delete $phash->{foo}; # prints $phash->[1], "FOO" + print exists $phash->{foo}; # false + print exists $phash->[0]{foo}; # true, key still exists + print delete $phash->[0]{foo}; # now key is gone + print $phash->{foo}; # runtime exception + =head2 Function Templates As explained above, a closure is an anonymous function with access to the diff --git a/pod/perlrun.pod b/pod/perlrun.pod index 0c3fcad..5eb3b82 100644 --- a/pod/perlrun.pod +++ b/pod/perlrun.pod @@ -268,9 +268,10 @@ An alternate delimiter may be specified using B<-F>. =item B<-c> causes Perl to check the syntax of the program and then exit without -executing it. Actually, it I execute C, C, and C blocks, -because these are considered as occurring outside the execution of -your program. C blocks, however, will be skipped. +executing it. Actually, it I execute C, C, and +C blocks, because these are considered as occurring outside the +execution of your program. C and C blocks, however, will +be skipped. =item B<-d> @@ -741,10 +742,13 @@ used. A colon-separated list of directories in which to look for Perl library files before looking in the standard library and the current -directory. If PERL5LIB is not defined, PERLLIB is used. When running -taint checks (because the program was running setuid or setgid, or the -B<-T> switch was used), neither variable is used. The program should -instead say +directory. Any architecture-specific directories under the specified +locations are automatically included if they exist. If PERL5LIB is not +defined, PERLLIB is used. + +When running taint checks (either because the program was running setuid +or setgid, or the B<-T> switch was used), neither variable is used. +The program should instead say: use lib "/my/directory"; diff --git a/pod/perlsub.pod b/pod/perlsub.pod index 4abdc39..416763f 100644 --- a/pod/perlsub.pod +++ b/pod/perlsub.pod @@ -207,9 +207,8 @@ core, as are modules whose names are in all lower case. A function in all capitals is a loosely-held convention meaning it will be called indirectly by the run-time system itself, usually due to a triggered event. Functions that do special, pre-defined -things include C, C, C, and C--plus -all functions mentioned in L. The 5.005 release adds -C to this list. +things include C, C, C, C, C, and +C--plus all functions mentioned in L. =head2 Private Variables via my() @@ -455,7 +454,7 @@ starts to run: } See L about the -special triggered functions, C and C. +special triggered functions, C, C, C and C. If declared at the outermost scope (the file scope), then lexicals work somewhat like C's file statics. They are available to all diff --git a/pod/perlsyn.pod b/pod/perlsyn.pod index 0dd842d..1f3ae50 100644 --- a/pod/perlsyn.pod +++ b/pod/perlsyn.pod @@ -163,6 +163,8 @@ If the LABEL is omitted, the loop control statement refers to the innermost enclosing loop. This may include dynamically looking back your call-stack at run time to find the LABEL. Such desperate behavior triggers a warning if you use the B<-w> flag. +Unlike a C statement, a C statement never implicitly +localises any variables. If there is a C BLOCK, it is always executed just before the conditional is about to be evaluated again, just like the third part of a diff --git a/pod/perltie.pod b/pod/perltie.pod index 5611174..58e9c43 100644 --- a/pod/perltie.pod +++ b/pod/perltie.pod @@ -185,10 +185,12 @@ methods: TIEARRAY, FETCH, STORE, FETCHSIZE, STORESIZE and perhaps DESTROY. FETCHSIZE and STORESIZE are used to provide C<$#array> and equivalent C access. -The methods POP, PUSH, SHIFT, UNSHIFT, SPLICE are required if the perl -operator with the corresponding (but lowercase) name is to operate on the -tied array. The B class can be used as a base class to implement -these in terms of the basic five methods above. +The methods POP, PUSH, SHIFT, UNSHIFT, SPLICE, DELETE, and EXISTS are +required if the perl operator with the corresponding (but lowercase) name +is to operate on the tied array. The B class can be used as a +base class to implement the first five of these in terms of the basic +methods above. The default implementations of DELETE and EXISTS in +B simply C. In addition EXTEND will be called when perl would have pre-extended allocation in a real array. diff --git a/pod/perltoc.pod b/pod/perltoc.pod index 5842f18..dee5951 100644 --- a/pod/perltoc.pod +++ b/pod/perltoc.pod @@ -362,7 +362,7 @@ What does CPAN/src/... mean? =item Where can I get information on Perl? -=item What are the Perl newsgroups on USENET? Where do I post questions? +=item What are the Perl newsgroups on Usenet? Where do I post questions? =item Where should I post source code? @@ -377,7 +377,7 @@ References, Tutorials =item Perl on the Net: FTP and WWW Access -=item What mailing lists are there for perl? +=item What mailing lists are there for Perl? =item Archives of comp.lang.perl.misc @@ -446,9 +446,9 @@ References, Tutorials =item How can I get C<#!perl> to work on [MS-DOS,NT,...]? -=item Can I write useful perl programs on the command line? +=item Can I write useful Perl programs on the command line? -=item Why don't perl one-liners work on my DOS/Mac/VMS system? +=item Why don't Perl one-liners work on my DOS/Mac/VMS system? =item Where can I learn about CGI or Web programming in Perl? @@ -515,7 +515,7 @@ Trig functions? =item How do I find yesterday's date? -=item Does Perl have a year 2000 problem? Is Perl Y2K compliant? +=item Does Perl have a Year 2000 problem? Is Perl Y2K compliant? =back @@ -1089,7 +1089,7 @@ CGI script to do bad things? =item AUTHOR AND COPYRIGHT -=head2 perldelta - what's new for perl5.006 (as of 5.005_56) +=head2 perldelta - what's new for perl v5.6 (as of v5.005_62) =item DESCRIPTION @@ -1099,18 +1099,51 @@ CGI script to do bad things? =item Perl Source Incompatibilities +Treatment of list slices of undef has changed, Possibly changed +pseudo-random number generator, Hashing function for hash keys has changed, +C fails on read only values, Close-on-exec bit may be set on pipe() +handles, Writing C<"$$1"> to mean C<"${$}1"> is unsupported, values(%h) and +C<\(%h)> operate on aliases to values, not copies, vec(EXPR,OFFSET,BITS) +enforces powers-of-two BITS, Text of some diagnostic output has changed, +C<%@> has been removed + =item C Source Incompatibilities -C, C, C and C Issues +C, C, C, C +and C Issues =item Compatible C Source API Changes -C is now C +C is now C, Support for C++ exceptions =item Binary Incompatibilities =back +=item Installation and Configuration Improvements + +=over + +=item New Configure flags + +=item -Dusethreads and -Duse64bits now more daring + +=item Long Doubles + +=item -Dusemorebits + +=item -Duselargefiles + +=item installusrbinperl + +=item SOCKS support + +=item C<-A> flag + +=item New Installation Scheme + +=back + =item Core Changes =over @@ -1119,22 +1152,60 @@ C is now C =item Lexically scoped warning categories +=item Lvalue subroutines + +=item "our" declarations + +=item Weak references + =item Binary numbers supported +=item Some arrows may be omitted in calls through references + =item syswrite() ease-of-use +=item Filehandles can be autovivified + =item 64-bit support +=item Large file support + +=item "more bits" + =item Better syntax checks on parenthesized unary operators +=item POSIX character class syntax [: :] supported + =item Improved C operator =item pack() format 'Z' supported =item pack() format modifier '!' supported +=item pack() and unpack() support counted strings + +=item Comments in pack() templates + =item $^X variables may now have names longer than one character +=item C implicit in subroutine attributes + +=item Regular expression improvements + +=item Overloading improvements + +=item open() with more than two arguments + +=item Support for interpolating named characters + +=item Experimental support for user-hooks in @INC + +=item C and C may be overridden + +=item New variable $^C reflects C<-c> switch + +=item Optional Y2K warnings + =back =item Significant bug fixes @@ -1145,11 +1216,85 @@ C is now C =item C improvements +=item All compilation errors are true errors + =item Automatic flushing of output buffers +=item Better diagnostics on meaningless filehandle operations + +=item Where possible, buffered data discarded from duped input filehandle + +=item system(), backticks and pipe open now reflect exec() failure + +=item Implicitly closed filehandles are safer + +=item C<(\$)> prototype and C<$foo{a}> + +=item Pseudo-hashes work better + +=item C and AUTOLOAD + +=item C<-bareword> allowed under C + +=item Boolean assignment operators are legal lvalues + +=item C allowed + +=item Failures in DESTROY() + +=item Locale bugs fixed + +=item Memory leaks + +=item Spurious subroutine stubs after failed subroutine calls + +=item Consistent numeric conversions + +=item Taint failures under C<-U> + +=item END blocks and the C<-c> switch + +=item Potential to leak DATA filehandles + +=item Diagnostics follow STDERR + +=item Other fixes for better diagnostics + =back -=item Supported Platforms +=item Performance enhancements + +=over + +=item Simple sort() using { $a <=> $b } and the like are optimized + +=item Optimized assignments to lexical variables + +=item Method lookups optimized + +=item Faster mechanism to invoke XSUBs + +=item Perl_malloc() improvements + +=item Faster subroutine calls + +=back + +=item Platform specific changes + +=over + +=item Additional supported platforms + +=item DOS + +=item OS/2 + +=item VMS + +=item Win32 + +=back =item New tests @@ -1159,9 +1304,12 @@ C is now C =item Modules -Dumpvalue, Benchmark, Devel::Peek, Fcntl, File::Spec, -File::Spec::Functions, Math::BigInt, Math::Complex, Math::Trig, SDBM_File, -Time::Local, Win32, DBM Filters +attributes, B, ByteLoader, B, constant, charnames, Data::Dumper, DB, +DB_File, Devel::DProf, Dumpvalue, Benchmark, Devel::Peek, +ExtUtils::MakeMaker, Fcntl, File::Compare, File::Find, File::Spec, +File::Spec::Functions, Getopt::Long, IO, JPL, Math::BigInt, Math::Complex, +Math::Trig, Pod::Parser, Pod::Text and Pod::Man, SDBM_File, Time::Local, +Win32, DBM Filters =item Pragmata @@ -1169,20 +1317,67 @@ Time::Local, Win32, DBM Filters =item Utility Changes +=over + +=item h2ph + +=item perlcc + +=item h2xs + +=back + =item Documentation Changes -perlopentut.pod, perlreftut.pod, perltootc.pod +perlopentut.pod, perlreftut.pod, perltootc.pod, perlcompile.pod =item New Diagnostics -/%s/: Unrecognized escape \\%c passed through, Unrecognized escape \\%c -passed through, Missing command in piped open, defined(@array) is -deprecated (and not really meaningful), defined(%hash) is deprecated (and -not really meaningful) +"my sub" not yet implemented, '!' allowed only after types %s, / cannot +take a count, / must be followed by a, A or Z, / must be followed by a*, A* +or Z*, / must follow a numeric type, Repeat count in pack overflows, Repeat +count in unpack overflows, /%s/: Unrecognized escape \\%c passed through, +/%s/ should probably be written as "%s", %s() called too early to check +prototype, %s package attribute may clash with future reserved word: %s, + (in cleanup) %s, <> should be quotes, Attempt to join self, Bad +evalled substitution pattern, Bad realloc() ignored, Binary number > +0b11111111111111111111111111111111 non-portable, Bit vector size > 32 +non-portable, Buffer overflow in prime_env_iter: %s, Can't check filesystem +of script "%s", Can't modify non-lvalue subroutine call, Can't read CRTL +environ, Can't remove %s: %s, skipping file, Can't return %s from lvalue +subroutine, Can't weaken a nonreference, Character class [:%s:] unknown, +Character class syntax [%s] belongs inside character classes, Constant is +not %s reference, constant(%s): %%^H is not localized, constant(%s): %s, +defined(@array) is deprecated, defined(%hash) is deprecated, Did not +produce a valid header, Document contains no data, entering effective %s +failed, Filehandle %s opened only for output, Hexadecimal number > +0xffffffff non-portable, Ill-formed CRTL environ value "%s", Ill-formed +message in prime_env_iter: |%s|, Illegal binary digit %s, Illegal binary +digit %s ignored, Illegal number of bits in vec, Integer overflow in %s +number, Invalid %s attribute: %s, Invalid %s attributes: %s, Invalid +separator character %s in attribute list, Invalid separator character %s in +subroutine attribute list, leaving effective %s failed, Lvalue subs +returning %s not implemented yet, Method %s not permitted, Missing +%sbrace%s on \N{}, Missing command in piped open, Missing name in "my sub", +no UTC offset information; assuming local time is UTC, Octal number > +037777777777 non-portable, panic: del_backref, panic: kid popen errno read, +panic: magic_killbackrefs, Possible Y2K bug: %s, Premature end of script +headers, realloc() of freed memory ignored, Reference is already weak, +setpgrp can't take arguments, Strange *+?{} on zero-length expression, +switching effective %s is not implemented, This Perl can't reset CRTL +eviron elements (%s), This Perl can't set CRTL environ elements (%s=%s), +Unknown open() mode '%s', Unknown process %x sent message to +prime_env_iter: %s, Unrecognized escape \\%c passed through, Unterminated +attribute parameter in attribute list, Unterminated attribute list, +Unterminated attribute parameter in subroutine attribute list, Unterminated +subroutine attribute list, Value of CLI symbol "%s" too long, Version +number must be a constant number =item Obsolete Diagnostics -=item Configuration Changes +Character class syntax [: :] is reserved for future extensions, Ill-formed +logical name |%s| in prime_env_iter, regexp too big, Use of "$$" to +mean "${$}" is deprecated =item BUGS @@ -1343,6 +1538,8 @@ i, m, s, x =item Regular Expressions +cntrl, graph, print, punct, xdigit, + =item Extended Patterns C<(?#text)>, C<(?imsx-imsx)>, C<(?:pattern)>, C<(?imsx-imsx:pattern)>, @@ -1387,7 +1584,8 @@ B<-D>I, B<-e> I, B<-F>I, B<-h>, B<-i>[I], B<-I>I, B<-l>[I], B<-m>[B<->]I, B<-M>[B<->]I, B<-M>[B<->]I<'module ...'>, B<-[mM]>[B<->]I, B<-n>, B<-p>, B<-P>, B<-s>, B<-S>, -B<-T>, B<-u>, B<-U>, B<-v>, B<-V>, B<-V:>I, B<-w>, B<-x> I +B<-T>, B<-u>, B<-U>, B<-v>, B<-V>, B<-V:>I, B<-w>, B<-W>, B<-X>, +B<-x> I =back @@ -1449,12 +1647,13 @@ LABEL, last, lc EXPR, lc, lcfirst EXPR, lcfirst, length EXPR, length, link OLDFILE,NEWFILE, listen SOCKET,QUEUESIZE, local EXPR, localtime EXPR, lock, log EXPR, log, lstat FILEHANDLE, lstat EXPR, lstat, m//, map BLOCK LIST, map EXPR,LIST, mkdir FILENAME,MASK, msgctl ID,CMD,ARG, msgget KEY,FLAGS, -msgsnd ID,MSG,FLAGS, msgrcv ID,VAR,SIZE,TYPE,FLAGS, my EXPR, next LABEL, -next, no Module LIST, oct EXPR, oct, open FILEHANDLE,EXPR, open FILEHANDLE, -opendir DIRHANDLE,EXPR, ord EXPR, ord, pack TEMPLATE,LIST, package, package -NAMESPACE, pipe READHANDLE,WRITEHANDLE, pop ARRAY, pop, pos SCALAR, pos, -print FILEHANDLE LIST, print LIST, print, printf FILEHANDLE FORMAT, LIST, -printf FORMAT, LIST, prototype FUNCTION, push ARRAY,LIST, q/STRING/, +msgsnd ID,MSG,FLAGS, msgrcv ID,VAR,SIZE,TYPE,FLAGS, my EXPR, my EXPR : +ATTRIBUTES, next LABEL, next, no Module LIST, oct EXPR, oct, open +FILEHANDLE,MODE,EXPR, open FILEHANDLE,EXPR, open FILEHANDLE, opendir +DIRHANDLE,EXPR, ord EXPR, ord, our EXPR, pack TEMPLATE,LIST, package, +package NAMESPACE, pipe READHANDLE,WRITEHANDLE, pop ARRAY, pop, pos SCALAR, +pos, print FILEHANDLE LIST, print LIST, print, printf FILEHANDLE FORMAT, +LIST, printf FORMAT, LIST, prototype FUNCTION, push ARRAY,LIST, q/STRING/, qq/STRING/, qr/STRING/, qx/STRING/, qw/STRING/, quotemeta EXPR, quotemeta, rand EXPR, rand, read FILEHANDLE,SCALAR,LENGTH,OFFSET, read FILEHANDLE,SCALAR,LENGTH, readdir DIRHANDLE, readline EXPR, readlink EXPR, @@ -1475,20 +1674,20 @@ sort LIST, splice ARRAY,OFFSET,LENGTH,LIST, splice ARRAY,OFFSET,LENGTH, splice ARRAY,OFFSET, split /PATTERN/,EXPR,LIMIT, split /PATTERN/,EXPR, split /PATTERN/, split, sprintf FORMAT, LIST, sqrt EXPR, sqrt, srand EXPR, srand, stat FILEHANDLE, stat EXPR, stat, study SCALAR, study, sub BLOCK, -sub NAME, sub NAME BLOCK, substr EXPR,OFFSET,LEN,REPLACEMENT, substr -EXPR,OFFSET,LEN, substr EXPR,OFFSET, symlink OLDFILE,NEWFILE, syscall LIST, -sysopen FILEHANDLE,FILENAME,MODE, sysopen FILEHANDLE,FILENAME,MODE,PERMS, -sysread FILEHANDLE,SCALAR,LENGTH,OFFSET, sysread FILEHANDLE,SCALAR,LENGTH, -sysseek FILEHANDLE,POSITION,WHENCE, system LIST, system PROGRAM LIST, -syswrite FILEHANDLE,SCALAR,LENGTH,OFFSET, syswrite -FILEHANDLE,SCALAR,LENGTH, syswrite FILEHANDLE,SCALAR, tell FILEHANDLE, -tell, telldir DIRHANDLE, tie VARIABLE,CLASSNAME,LIST, tied VARIABLE, time, -times, tr///, truncate FILEHANDLE,LENGTH, truncate EXPR,LENGTH, uc EXPR, -uc, ucfirst EXPR, ucfirst, umask EXPR, umask, undef EXPR, undef, unlink -LIST, unlink, unpack TEMPLATE,EXPR, untie VARIABLE, unshift ARRAY,LIST, use -Module LIST, use Module, use Module VERSION LIST, use VERSION, utime LIST, -values HASH, vec EXPR,OFFSET,BITS, wait, waitpid PID,FLAGS, wantarray, warn -LIST, write FILEHANDLE, write EXPR, write, y/// +sub NAME, sub NAME BLOCK, substr EXPR,OFFSET,LENGTH,REPLACEMENT, substr +EXPR,OFFSET,LENGTH, substr EXPR,OFFSET, symlink OLDFILE,NEWFILE, syscall +LIST, sysopen FILEHANDLE,FILENAME,MODE, sysopen +FILEHANDLE,FILENAME,MODE,PERMS, sysread FILEHANDLE,SCALAR,LENGTH,OFFSET, +sysread FILEHANDLE,SCALAR,LENGTH, sysseek FILEHANDLE,POSITION,WHENCE, +system LIST, system PROGRAM LIST, syswrite FILEHANDLE,SCALAR,LENGTH,OFFSET, +syswrite FILEHANDLE,SCALAR,LENGTH, syswrite FILEHANDLE,SCALAR, tell +FILEHANDLE, tell, telldir DIRHANDLE, tie VARIABLE,CLASSNAME,LIST, tied +VARIABLE, time, times, tr///, truncate FILEHANDLE,LENGTH, truncate +EXPR,LENGTH, uc EXPR, uc, ucfirst EXPR, ucfirst, umask EXPR, umask, undef +EXPR, undef, unlink LIST, unlink, unpack TEMPLATE,EXPR, untie VARIABLE, +unshift ARRAY,LIST, use Module LIST, use Module, use Module VERSION LIST, +use VERSION, utime LIST, values HASH, vec EXPR,OFFSET,BITS, wait, waitpid +PID,FLAGS, wantarray, warn LIST, write FILEHANDLE, write EXPR, write, y/// =back @@ -1520,8 +1719,8 @@ $EFFECTIVE_USER_ID, $EUID, $>, $REAL_GROUP_ID, $GID, $(, $EFFECTIVE_GROUP_ID, $EGID, $), $PROGRAM_NAME, $0, $[, $PERL_VERSION, $], $COMPILING, $^C, $DEBUGGING, $^D, $SYSTEM_FD_MAX, $^F, $^H, $INPLACE_EDIT, $^I, $^M, $OSNAME, $^O, $PERLDB, $^P, 0x01, 0x02, 0x04, 0x08, 0x10, 0x20, -$^R, $^S, $BASETIME, $^T, $WARNING, $^W, $EXECUTABLE_NAME, $^X, $ARGV, -@ARGV, @INC, @_, %INC, %ENV, $ENV{expr}, %SIG, $SIG{expr} +$^R, $^S, $BASETIME, $^T, $WARNING, $^W, ${^Warnings}, $EXECUTABLE_NAME, +$^X, $ARGV, @ARGV, @INC, @_, %INC, %ENV, $ENV{expr}, %SIG, $SIG{expr} =item Error Indicators @@ -1545,6 +1744,8 @@ $^R, $^S, $BASETIME, $^T, $WARNING, $^W, $EXECUTABLE_NAME, $^X, $ARGV, =item Temporary Values via local() +=item Lvalue subroutines + =item Passing Symbol Table Entries (typeglobs) =item When to Still Use local() @@ -1563,6 +1764,8 @@ You want to temporarily change just one element of an array or hash =item Autoloading +=item Subroutine Attributes + =back =item SEE ALSO @@ -1597,9 +1800,9 @@ You want to temporarily change just one element of an array or hash =item Pragmatic Modules -attrs, autouse, base, blib, constant, diagnostics, fields, filetest, -integer, less, lib, locale, ops, overload, re, sigtrap, strict, subs, utf8, -vars, vmsish, warnings +attributes, attrs, autouse, base, blib, constant, diagnostics, fields, +filetest, integer, less, lib, locale, ops, overload, re, sigtrap, strict, +subs, utf8, vars, warnings, vmsish =item Standard Modules @@ -2582,7 +2785,10 @@ environment for DOS, OS/2, etc. C,C or C, Build instructions for Win32, -L, The ActiveState Pages, C +L, The ActiveState Pages, C, The +Cygwin environment for Win32; +L,C, The U/WIN +environment for Win32,C =item S @@ -2592,8 +2798,8 @@ C =item VMS -L, vmsperl list, C, vmsperl on the web, -C +L, L, vmsperl list, C, vmsperl +on the web, C =item VOS @@ -2602,15 +2808,19 @@ C =item EBCDIC Platforms -perl-mvs list, AS/400 Perl information at -C +L, L, L, perl-mvs list, AS/400 +Perl information at Cas well as on CPAN in +the F directory =item Acorn RISC OS =item Other perls -Atari, Guido Flohr's page C, HP 300 -MPE/iX C, Novell Netware +Amiga, L, Atari, L and Guido Flohr's web +pageC, Be OS, L, HP 300 +MPE/iX, L and Mark Bixby's web +pageC, Novell Netware, Plan 9, +L =back @@ -2649,10 +2859,11 @@ wait, waitpid PID,FLAGS =item CHANGES -v1.43, 24 May 1999, v1.42, 22 May 1999, v1.41, 19 May 1999, v1.40, 11 April -1999, v1.39, 11 February 1999, v1.38, 31 December 1998, v1.37, 19 December -1998, v1.36, 9 September 1998, v1.35, 13 August 1998, v1.33, 06 August -1998, v1.32, 05 August 1998, v1.30, 03 August 1998, v1.23, 10 July 1998 +v1.44, 19 July 1999, v1.43, 24 May 1999, v1.42, 22 May 1999, v1.41, 19 May +1999, v1.40, 11 April 1999, v1.39, 11 February 1999, v1.38, 31 December +1998, v1.37, 19 December 1998, v1.36, 9 September 1998, v1.35, 13 August +1998, v1.33, 06 August 1998, v1.32, 05 August 1998, v1.30, 03 August 1998, +v1.23, 10 July 1998 =item AUTHORS / CONTRIBUTORS @@ -2852,54 +3063,82 @@ B, B =item AUTHOR -=head2 perlxstut, perlXStut - Tutorial for XSUBs +=head2 perlxstut, perlXStut - Tutorial for writing XSUBs =item DESCRIPTION +=item SPECIAL NOTES + =over -=item VERSION CAVEAT +=item make + +=item Version caveat + +=item Dynamic Loading versus Static Loading + +=back + +=item TUTORIAL -=item DYNAMIC VERSUS STATIC +=over =item EXAMPLE 1 =item EXAMPLE 2 -=item WHAT HAS GONE ON? +=item What has gone on? -=item WRITING GOOD TEST SCRIPTS +=item Writing good test scripts =item EXAMPLE 3 -=item WHAT'S NEW HERE? +=item What's new here? -=item INPUT AND OUTPUT PARAMETERS +=item Input and Output Parameters -=item THE XSUBPP COMPILER +=item The XSUBPP Program -=item THE TYPEMAP FILE +=item The TYPEMAP file -=item WARNING +=item Warning about Output Arguments =item EXAMPLE 4 -=item WHAT HAS HAPPENED HERE? +=item What has happened here? -=item SPECIFYING ARGUMENTS TO XSUBPP +=item More about XSUBPP -=item THE ARGUMENT STACK +=item The Argument Stack -=item EXTENDING YOUR EXTENSION +=item Extending your Extension -=item DOCUMENTING YOUR EXTENSION +=item Documenting your Extension -=item INSTALLING YOUR EXTENSION +=item Installing your Extension -=item SEE ALSO +=item EXAMPLE 5 + +=item New Things in this Example + +=item EXAMPLE 6 (Coming Soon) + +=item EXAMPLE 7 (Coming Soon) + +=item EXAMPLE 8 (Coming Soon) + +=item EXAMPLE 9 (Coming Soon) + +=item Troubleshooting these Examples + +=back + +=item See also =item Author +=over + =item Last Changed =back @@ -2953,11 +3192,12 @@ B, B C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, -C, C, -C, C, C +*key, I32 length)>, C, C, C, +C, C, C, C, C, C, C, +C =back @@ -2999,6 +3239,18 @@ save_hptr(HV **hptr)> =back +=item The Perl Internal API + +=over + +=item Background and PERL_IMPLICIT_CONTEXT + +=item How do I use all this in extensions? + +=item Future Plans and PERL_IMPLICIT_SYS + +=back + =item API LISTING av_clear, av_extend, av_fetch, AvFILL, av_len, av_make, av_pop, av_push, @@ -3040,13 +3292,11 @@ SvSetSV, SvSetSV_nosteal, sv_setsv, sv_setsv_mg, sv_setuv, sv_setuv_mg, SvSTASH, SvTAINT, SvTAINTED, SvTAINTED_off, SvTAINTED_on, SVt_IV, SVt_PV, SVt_PVAV, SVt_PVCV, SVt_PVHV, SVt_PVMG, SVt_NV, SvTRUE, SvTYPE, svtype, PL_sv_undef, sv_unref, SvUPGRADE, sv_upgrade, sv_usepvn, sv_usepvn_mg, -sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale), -sv_vsetpvfn(sv, pat, patlen, args, svargs, svmax, used_locale), SvUV, -SvUVX, PL_sv_yes, THIS, toLOWER, toUPPER, warn, XPUSHi, XPUSHn, XPUSHp, -XPUSHs, XPUSHu, XS, XSRETURN, XSRETURN_EMPTY, XSRETURN_IV, XSRETURN_NO, -XSRETURN_NV, XSRETURN_PV, XSRETURN_UNDEF, XSRETURN_YES, XST_mIV, XST_mNV, -XST_mNO, XST_mPV, XST_mUNDEF, XST_mYES, XS_VERSION, XS_VERSION_BOOTCHECK, -Zero +sv_vcatpvfn, sv_vsetpvfn, SvUV, SvUVX, PL_sv_yes, THIS, toLOWER, toUPPER, +warn, XPUSHi, XPUSHn, XPUSHp, XPUSHs, XPUSHu, XS, XSRETURN, XSRETURN_EMPTY, +XSRETURN_IV, XSRETURN_NO, XSRETURN_NV, XSRETURN_PV, XSRETURN_UNDEF, +XSRETURN_YES, XST_mIV, XST_mNV, XST_mNO, XST_mPV, XST_mUNDEF, XST_mYES, +XS_VERSION, XS_VERSION_BOOTCHECK, Zero =item AUTHORS @@ -3132,6 +3382,46 @@ callback =item DATE +=head2 perlcompile - Introduction to the Perl Compiler-Translator + +=item DESCRIPTION + +=over + +=item Layout + +B::Bytecode, B::C, B::CC, B::Lint, B::Deparse, B::Xref + +=back + +=item Using The Back Ends + +=over + +=item The Cross Referencing Back End (B::Xref) + +i, &, s, r + +=item The Decompiling Back End + +=item The Lint Back End (B::Lint) + +=item The Simple C Back End + +=item The Bytecode Back End + +=item The Optimized C Back End + +B, O, B::Asmdata, B::Assembler, B::Bblock, B::Bytecode, B::C, B::CC, +B::Debug, B::Deparse, B::Disassembler, B::Lint, B::Showlex, B::Stackobj, +B::Stash, B::Terse, B::Xref + +=back + +=item KNOWN PROBLEMS + +=item AUTHOR + =head2 perlhist - the Perl history records =item DESCRIPTION @@ -3160,7 +3450,7 @@ callback =head1 PRAGMA DOCUMENTATION -=head2 attrs - set/get attributes of a subroutine +=head2 attrs - set/get attributes of a subroutine (deprecated) =item SYNOPSIS @@ -3174,7 +3464,35 @@ method, locked =item DESCRIPTION -=head2 attrs - set/get attributes of a subroutine +=head2 attributes - get/set subroutine or variable attributes + +=item SYNOPSIS + +=item DESCRIPTION + +=over + +=item Built-in Attributes + +locked, method + +=item Available Subroutines + +get, reftype + +=item Package-specific Attribute Handling + +FETCH_I_ATTRIBUTES, MODIFY_I_ATTRIBUTES + +=item Syntax of Attribute Lists + +=back + +=item EXAMPLES + +=item SEE ALSO + +=head2 attrs - set/get attributes of a subroutine (deprecated) =item SYNOPSIS @@ -3222,6 +3540,17 @@ method, locked encoding +=head2 charnames - define character names for C<\N{named}> string literal +escape. + +=item SYNOPSIS + +=item DESCRIPTION + +=item CUSTOM TRANSLATORS + +=item BUGS + =head2 constant - Perl pragma to declare constants =item SYNOPSIS @@ -3309,11 +3638,11 @@ double =over -=item ADDING DIRECTORIES TO @INC +=item Adding directories to @INC -=item DELETING DIRECTORIES FROM @INC +=item Deleting directories from @INC -=item RESTORING ORIGINAL @INC +=item Restoring original @INC =back @@ -3494,8 +3823,6 @@ C, C, C =item DESCRIPTION -C - =head1 MODULE DOCUMENTATION =head2 AnyDBM_File - provide framework for multiple DBMs @@ -3629,7 +3956,7 @@ FILL, MAX, KEYS, RITER, NAME, PMROOT, ARRAY =item B::OP METHODS -next, sibling, ppaddr, desc, targ, type, seq, flags, private +next, sibling, name, ppaddr, desc, targ, type, seq, flags, private =item B::UNOP METHOD @@ -3790,7 +4117,22 @@ B<-ffreetmps-each-bblock>, B<-ffreetmps-each-loop>, B<-fomit-taint>, B<-On> =item OPTIONS -B<-l>, B<-p>, B<-q>, B<-u>I, B<-s>I, B +B<-l>, B<-p>, B<-q>, B<-u>I, B<-s>I, B, BI, +B, BIB<.> + +=item USING B::Deparse AS A MODULE + +=over + +=item Synopsis + +=item Description + +=item new + +=item coderef2text + +=back =item BUGS @@ -3891,17 +4233,19 @@ C<-oFILENAME>, C<-r>, C<-D[tO]> =item Methods -new, debug +new, debug, iters =item Standard Exports timeit(COUNT, CODE), timethis ( COUNT, CODE, [ TITLE, [ STYLE ]] ), -timethese ( COUNT, CODEHASHREF, [ STYLE ] ), timediff ( T1, T2 ), timesum ( -T1, T2 ), timestr ( TIMEDIFF, [ STYLE, [ FORMAT ] ] ) +timethese ( COUNT, CODEHASHREF, [ STYLE ] ), timediff ( T1, T2 ), timestr ( +TIMEDIFF, [ STYLE, [ FORMAT ] ] ) =item Optional Exports -clearcache ( COUNT ), clearallcache ( ), disablecache ( ), enablecache ( ) +clearcache ( COUNT ), clearallcache ( ), cmpthese ( COUT, CODEHASHREF, [ +STYLE ] ), cmpthese ( RESULTSHASHREF ), countit(TIME, CODE), disablecache ( +), enablecache ( ), timesum ( T1, T2 ) =back @@ -4269,6 +4613,24 @@ B, B, B, B, B =item SEE ALSO +=head2 CGI::Pretty - module to produce nicely formatted HTML code + +=item SYNOPSIS + +=item DESCRIPTION + +=over + +=item Tags that won't be formatted + +=back + +=item BUGS + +=item AUTHOR + +=item SEE ALSO + =head2 CGI::Push - Simple Interface to Server Push =item SYNOPSIS @@ -4408,6 +4770,12 @@ module =item BUGS +=head2 Carp::Heavy - Carp guts + +=item SYNOPIS + +=item DESCRIPTION + =head2 Class::Struct - declare struct-like datatypes as Perl classes =item SYNOPSIS @@ -4460,7 +4828,8 @@ C, C, C, C, C, C =item b -C, C, C, C, C, C, C +C, C, C, C, C, C, +C, C =item c @@ -4473,65 +4842,64 @@ C, C =item d -C, C, C, C, C, -C, C, C, C, C, -C, C, C, C, C, -C, C, C, C, C, -C, C, C, C, C, -C, C, C, C, -C, C, C, C, C, -C, C, C, C, C, -C, C, C, C, C, -C, C, C, C, C, -C, C, C, C, C, -C, C, C, C, C, -C, C, C, C, C, -C, C, C, C, C, -C, C, C, C, C, -C, C, C, C, -C, C, C, C, -C, C, C, C, -C, C, C, C, -C, C, C, C, C, -C, C, C, C, -C, C, C, C, +C, C, C, C, C, +C, C, C, C, C, +C, C, C, C, C, +C, C, C, C, C, +C, C, C, C, C, +C, C, C, C, C, +C, C, C, C, C, +C, C, C, C, C, +C, C, C, C, C, +C, C, C, C, C, +C, C, C, C, C, +C, C, C, C, C, +C, C, C, C, C, +C, C, C, C, +C, C, C, C, +C, C, C, C, +C, C, C, C, +C, C, C, C, +C, C, C, C, +C, C, C, C, C, C, C, C, C, -C, C, C, C, C, -C, C, C, C, C, -C, C, C, C, C, -C, C, C, C, C, -C, C, C, C, C, -C, C, C, C, C, C, -C, C, C, C, C, -C, C, C, C, C, -C, C, C, C, C, -C, C, C, C, -C, C, C, -C, C, C, C, C, -C, C, C, C, C, -C, C, C, C, C, -C, C, C, C, C, -C, C, C, C, C, -C, C, C, C, C, -C, C, C, C, C, +C, C, C, C, C, +C, C, C, C, C, +C, C, C, C, C, +C, C, C, C, C, +C, C, C, C, C, +C, C, C, C, C, +C, C, C, C, +C, C, C, C, C, +C, C, C, C, C, +C, C, C, +C, C, C, C, C, +C, C, C, C, C, +C, C, C, C, C, +C, C, C, C, C, +C, C, C, C, +C, C, C, C, C, +C, C, C, C, C, +C, C, C, C, C, +C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, -C, C, C, C, C, -C, C, C, C, C, -C, C, C, C, C, +C, C, C, C, C, +C, C, C, C, C, +C, C, C, C, C, C, C, C, C, -C, C, C, C, -C, C, C, C, C, -C, C, C, C, C, +C, C, C, C, +C, C, C, C, C, +C, C, C, C, C, C, C, C, C, C, -C, C, C, C, C, -C, C, C, C, C, -C, C, C, C, C, -C, C, C, C, C, +C, C, C, C, +C, C, C, C, C, +C, C, C, C, C, +C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, @@ -4563,17 +4931,19 @@ C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, -C, C, C, C, C, -C, C, C, C, C, -C, C, C, C, C, -C, C, C, C, C, -C, C, C, C, C, -C, C, C, C, C, -C, C, C, C, C, C, -C, C, C, C, -C, C, C, C, C, -C, C, C, C, -C, C, C +C, C, C, C, C, +C, C, C, C, C, +C, C, C, C, C, +C, C, C, C, C, +C, C, C, C, +C, C, C, C, C, +C, C, C, C, C, +C, C, C, C, C, C, +C, C, C, C, +C, C, C, C, +C, C, C, C, +C, C, C, +C, C, C =item k @@ -4581,11 +4951,11 @@ C, C =item l -C, C, C, C, C, C, C, -C, C, C, C, C, C, -C, C, C, C, C, C, -C, C, C, C, C, C, -C +C, C, C, C, C, C, +C, C, C, C, C, C, +C, C, C, C, C, C, C, +C, C, C, C, C, C, +C, C =item m @@ -4613,8 +4983,8 @@ C, C, C C, C, C, C, C, C, C, C, C, C, C, C, -C, C, C, C, C, C, -C, C +C, C, C, C, C, C, +C, C, C =item r @@ -4627,12 +4997,15 @@ C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, C, -C, C, C, C, C, -C, C, C, C, C, C, C, -C, C, C, C, C, C, -C, C, C, C, C, -C, C, C, C, -C, C, C, C +C, C, C, C, C, +C, C, C, C, C, C, +C, C, C, C, C, C, +C, C, C, C, C, +C, C, C, C, C, C, +C, C, C, C, C, C, +C, C, C, C, C, +C, C, C, C, C, +C =item t @@ -4641,17 +5014,20 @@ C, C, C, C =item u -C, C, C, C, C, C, +C, C, C, C, C, C, +C, C, C, C, C, C, C, C, C, -C, C, C, C, C, C +C, C, C, C, C, +C, C, C =item v +C, C, C, C, C, C, C =item x -C +C, C =item z @@ -4710,7 +5086,7 @@ B, B, B =over -=item Using DB_File with Berkeley DB version 2 +=item Using DB_File with Berkeley DB version 2 or 3 =item Interface to Berkeley DB @@ -4772,6 +5148,21 @@ $X-Eput($key, $value [, $flags]) ;>, B<$status = $X-Edel($key [, $flags]) ;>, B<$status = $X-Efd ;>, B<$status = $X-Eseq($key, $value, $flags) ;>, B<$status = $X-Esync([$flags]) ;> +=item DBM FILTERS + +B, B, B, +B + +=over + +=item The Filter + +=item An Example -- the NULL termination problem. + +=item Another Example -- Key is a C int. + +=back + =item HINTS AND TIPS =over @@ -4798,6 +5189,8 @@ $value, $flags) ;>, B<$status = $X-Esync([$flags]) ;> =back +=item REFERENCES + =item HISTORY =item BUGS @@ -4843,7 +5236,8 @@ $Data::Dumper::Freezer I $I->Freezer(I<[NEWVAL]>), $Data::Dumper::Toaster I $I->Toaster(I<[NEWVAL]>), $Data::Dumper::Deepcopy I $I->Deepcopy(I<[NEWVAL]>), $Data::Dumper::Quotekeys I $I->Quotekeys(I<[NEWVAL]>), -$Data::Dumper::Bless I $I->Bless(I<[NEWVAL]>) +$Data::Dumper::Bless I $I->Bless(I<[NEWVAL]>), +$Data::Dumper::Maxdepth I $I->Maxdepth(I<[NEWVAL]>) =item Exports @@ -4861,6 +5255,22 @@ Dumper =item SEE ALSO +=head2 Devel::DProf - a Perl code profiler + +=item SYNOPSIS + +=item DESCRIPTION + +=item PROFILE FORMAT + +=item AUTOLOAD + +=item ENVIRONMENT + +=item BUGS + +=item SEE ALSO + =head2 Devel::Peek - A data debugging tool for the XS programmer =item SYNOPSIS @@ -4913,7 +5323,7 @@ Dumper =head2 Dumpvalue - provides screen dump of Perl data. -=item SYNOPSYS +=item SYNOPSIS =item DESCRIPTION @@ -4980,6 +5390,8 @@ variables =over +=item How to Export + =item Selecting What To Export =item Specialised Import Lists @@ -4994,6 +5406,12 @@ variables =back +=head2 Exporter::Heavy - Exporter guts + +=item SYNOPIS + +=item DESCRIPTION + =head2 ExtUtils::Command - utilities to replace common UNIX commands in Makefiles etc. @@ -5123,14 +5541,14 @@ extliblist, file_name_is_absolute, find_perl =item Methods to actually produce chunks of text for the Makefile -fixin, force (o), guess_name, has_link_code, init_dirscan, init_main, -init_others, install (o), installbin (o), libscan (o), linkext (o), lsdir, -macro (o), makeaperl (o), makefile (o), manifypods (o), maybe_command, -maybe_command_in_dirs, needs_linking (o), nicetext, parse_version, -parse_abstract, pasthru (o), path, perl_script, perldepend (o), ppd, -perm_rw (o), perm_rwx (o), pm_to_blib, post_constants (o), post_initialize -(o), postamble (o), prefixify, processPL (o), realclean (o), -replace_manpage_separator, static (o), static_lib (o), staticmake (o), +fixin, force (o), guess_name, has_link_code, htmlifypods (o), init_dirscan, +init_main, init_others, install (o), installbin (o), libscan (o), linkext +(o), lsdir, macro (o), makeaperl (o), makefile (o), manifypods (o), +maybe_command, maybe_command_in_dirs, needs_linking (o), nicetext, +parse_version, parse_abstract, pasthru (o), path, perl_script, perldepend +(o), ppd, perm_rw (o), perm_rwx (o), pm_to_blib, post_constants (o), +post_initialize (o), postamble (o), prefixify, processPL (o), realclean +(o), replace_manpage_separator, static (o), static_lib (o), staticmake (o), subdir_x (o), subdirs (o), test (o), test_via_harness (o), test_via_script (o), tool_autosplit (o), tools_other (o), tool_xsubpp (o), top_targets (o), writedoc, xs_c (o), xs_cpp (o), xs_o (o), perl_archive, export_list @@ -5150,8 +5568,7 @@ ExtUtils::MakeMaker =item Methods always loaded -eliminate_macros, fixpath, catdir, catfile, wraplist, curdir (override), -rootdir (override), updir (override) +wraplist, rootdir (override) =item SelfLoaded methods @@ -5182,8 +5599,8 @@ ExtUtils::MakeMaker catfile, constants (o), static_lib (o), dynamic_bs (o), dynamic_lib (o), canonpath, perl_script, pm_to_blib, test_via_harness (o), tool_autosplit -(override), tools_other (o), xs_o (o), top_targets (o), manifypods (o), -dist_ci (o), dist_core (o), pasthru (o) +(override), tools_other (o), xs_o (o), top_targets (o), htmlifypods (o), +manifypods (o), dist_ci (o), dist_core (o), pasthru (o) =head2 ExtUtils::MakeMaker - create an extension Makefile @@ -5217,15 +5634,17 @@ dist_ci (o), dist_core (o), pasthru (o) AUTHOR, ABSTRACT, ABSTRACT_FROM, BINARY_LOCATION, C, CAPI, CCFLAGS, CONFIG, CONFIGURE, DEFINE, DIR, DISTNAME, DL_FUNCS, DL_VARS, EXCLUDE_EXT, -EXE_FILES, FIRST_MAKEFILE, FULLPERL, FUNCLIST, H, IMPORTS, INC, -INCLUDE_EXT, INSTALLARCHLIB, INSTALLBIN, INSTALLDIRS, INSTALLMAN1DIR, -INSTALLMAN3DIR, INSTALLPRIVLIB, INSTALLSCRIPT, INSTALLSITEARCH, -INSTALLSITELIB, INST_ARCHLIB, INST_BIN, INST_EXE, INST_LIB, INST_MAN1DIR, -INST_MAN3DIR, INST_SCRIPT, LDFROM, LIB, LIBPERL_A, LIBS, LINKTYPE, -MAKEAPERL, MAKEFILE, MAN1PODS, MAN3PODS, MAP_TARGET, MYEXTLIB, NAME, -NEEDS_LINKING, NOECHO, NORECURS, NO_VC, OBJECT, OPTIMIZE, PERL, PERLMAINCC, -PERL_ARCHLIB, PERL_LIB, PERL_SRC, PERM_RW, PERM_RWX, PL_FILES, PM, -PMLIBDIRS, POLLUTE, PPM_INSTALL_EXEC, PPM_INSTALL_SCRIPT, PREFIX, +EXE_FILES, FIRST_MAKEFILE, FULLPERL, FUNCLIST, H, HTMLLIBPODS, +HTMLSCRIPTPODS, IMPORTS, INC, INCLUDE_EXT, INSTALLARCHLIB, INSTALLBIN, +INSTALLDIRS, INSTALLHTMLPRIVLIBDIR, INSTALLHTMLSCRIPTDIR, +INSTALLHTMLSITELIBDIR, INSTALLMAN1DIR, INSTALLMAN3DIR, INSTALLPRIVLIB, +INSTALLSCRIPT, INSTALLSITEARCH, INSTALLSITELIB, INST_ARCHLIB, INST_BIN, +INST_EXE, INST_LIB, INST_HTMLLIBDIR, INST_HTMLSCRIPTDIR, INST_MAN1DIR, +INST_MAN3DIR, INST_SCRIPT, PERL_MALLOC_OK, LDFROM, LIB, LIBPERL_A, LIBS, +LINKTYPE, MAKEAPERL, MAKEFILE, MAN1PODS, MAN3PODS, MAP_TARGET, MYEXTLIB, +NAME, NEEDS_LINKING, NOECHO, NORECURS, NO_VC, OBJECT, OPTIMIZE, PERL, +PERLMAINCC, PERL_ARCHLIB, PERL_LIB, PERL_SRC, PERM_RW, PERM_RWX, PL_FILES, +PM, PMLIBDIRS, POLLUTE, PPM_INSTALL_EXEC, PPM_INSTALL_SCRIPT, PREFIX, PREREQ_PM, SKIP, TYPEMAPS, VERSION, VERSION_FROM, XS, XSOPT, XSPROTOARG, XS_VERSION @@ -5485,6 +5904,8 @@ catpath, abs2rel, rel2abs =item DESCRIPTION +eliminate_macros, fixpath + =over =item Methods always loaded @@ -5763,8 +6184,8 @@ new ( [ARGS] ) =item METHODS -accept([PKG]), timeout([VAL]), sockopt(OPT [, VAL]), sockdomain, socktype, -protocol, connected +accept([PKG]), socketpair(DOMAIN, TYPE, PROTOCOL), timeout([VAL]), +sockopt(OPT [, VAL]), sockdomain, socktype, protocol, connected =item SEE ALSO @@ -5961,8 +6382,8 @@ new ( [ARGS] ) =item METHODS -accept([PKG]), timeout([VAL]), sockopt(OPT [, VAL]), sockdomain, socktype, -protocol, connected +accept([PKG]), socketpair(DOMAIN, TYPE, PROTOCOL), timeout([VAL]), +sockopt(OPT [, VAL]), sockdomain, socktype, protocol, connected =item SEE ALSO @@ -6535,10 +6956,13 @@ Constants, Macros =item ARGUMENTS help, htmldir, htmlroot, infile, outfile, podroot, podpath, libpods, -netscape, nonetscape, index, noindex, recurse, norecurse, title, verbose +netscape, nonetscape, index, noindex, recurse, norecurse, title, css, +verbose, quiet =item EXAMPLE +=item ENVIRONMENT + =item AUTHOR =item BUGS @@ -6649,6 +7073,28 @@ B =item AUTHOR +=head2 Pod::Man - Convert POD data to formatted *roff input + +=item SYNOPSIS + +=item DESCRIPTION + +center, date, fixed, fixedbold, fixeditalic, fixedbolditalic, release, +section + +=item DIAGNOSTICS + +roff font should be 1 or 2 chars, not `%s', Invalid link %s, Unknown escape +EE%sE, Unknown sequence %s, Unmatched =back + +=item BUGS + +=item NOTES + +=item SEE ALSO + +=item AUTHOR + =head2 Pod::Parser - base class for creating POD filters and translators =item SYNOPSIS @@ -6661,6 +7107,10 @@ B =item QUICK OVERVIEW +=item PARSING OPTIONS + +B<-want_nonPODs> (default: unset), B<-process_cut_cmd> (default: unset) + =item RECOMMENDED SUBROUTINE/METHOD OVERRIDES =item B @@ -6699,7 +7149,8 @@ C<$text>, C<$line_num>, C<$pod_para> =item B -B<-expand_seq> =E I|I, B<-expand_ptree> =E +B<-expand_seq> =E I|I, B<-expand_text> =E +I|I, B<-expand_ptree> =E I|I =item B @@ -6712,8 +7163,12 @@ I|I =item ACCESSOR METHODS +=item B + =item B +=item B + =item B =item B @@ -6732,20 +7187,7 @@ I|I =item B<_pop_input_stream()> -=item SEE ALSO - -=item AUTHOR - -=head2 Pod::PlainText, pod2plaintext - function to convert POD data to -formatted ASCII text - -=item SYNOPSIS - -=item REQUIRES - -=item EXPORTS - -=item DESCRIPTION +=item TREE-BASED PARSING =item SEE ALSO @@ -6802,15 +7244,49 @@ B<-output>, B<-sections>, B<-ranges> =item AUTHOR -=head2 Pod::Text - convert POD data to formatted ASCII text +=head2 Pod::Text - Convert POD data to formatted ASCII text =item SYNOPSIS =item DESCRIPTION +alt, indent, loose, sentence, width + +=item DIAGNOSTICS + +Bizarre space in item, Can't open %s for reading: %s, Unknown escape: %s, +Unknown sequence: %s, Unmatched =back + +=item RESTRICTIONS + +=item NOTES + +=item SEE ALSO + =item AUTHOR -=item TODO +=head2 Pod::Text::Color - Convert POD data to formatted color ASCII text + +=item SYNOPSIS + +=item DESCRIPTION + +=item BUGS + +=item SEE ALSO + +=item AUTHOR + +=head2 Pod::Text::Termcap, Pod::Text::Color - Convert POD data to ASCII +text with format escapes + +=item SYNOPSIS + +=item DESCRIPTION + +=item SEE ALSO + +=item AUTHOR =head2 Pod::Usage, pod2usage() - print a usage message from embedded pod documentation diff --git a/pod/perltodo.pod b/pod/perltodo.pod index 4b2ed48..7836acf 100644 --- a/pod/perltodo.pod +++ b/pod/perltodo.pod @@ -824,7 +824,8 @@ Workarounds to help Win32 dynamic loading. =head2 END blocks -END blocks need saving in compiled output. +END blocks need saving in compiled output, now that STOP blocks +are available. =head2 _AUTOLOAD diff --git a/pod/perltrap.pod b/pod/perltrap.pod index 50987cb..f278fa0 100644 --- a/pod/perltrap.pod +++ b/pod/perltrap.pod @@ -585,24 +585,6 @@ number of elements in the resulting list. # perl4 prints: second new # perl5 prints: 3 -=item * Discontinuance - -In Perl 4 (and versions of Perl 5 before 5.004), C<'\r'> characters in -Perl code were silently allowed, although they could cause (mysterious!) -failures in certain constructs, particularly here documents. Now, -C<'\r'> characters cause an immediate fatal error. (Note: In this -example, the notation B<\015> represents the incorrect line -ending. Depending upon your text viewer, it will look different.) - - print "foo";\015 - print "bar"; - - # perl4 prints: foobar - # perl5.003 prints: foobar - # perl5.004 dies: Illegal character \015 (carriage return) - -See L for full details. - =item * Deprecation Some error messages will be different. @@ -715,6 +697,30 @@ Logical tests now return an null, instead of 0 Also see L<"General Regular Expression Traps using s///, etc."> for another example of this new feature... +=item * Bitwise string ops + +When bitwise operators which can operate upon either numbers or +strings (C<& | ^ ~>) are given only strings as arguments, perl4 would +treat the operands as bitstrings so long as the program contained a call +to the C function. perl5 treats the string operands as bitstrings. +(See L for more details.) + + $fred = "10"; + $barney = "12"; + $betty = $fred & $barney; + print "$betty\n"; + # Uncomment the next line to change perl4's behavior + # ($dummy) = vec("dummy", 0, 0); + + # Perl4 prints: + 8 + + # Perl5 prints: + 10 + + # If vec() is used anywhere in the program, both print: + 10 + =back =head2 General data type traps diff --git a/pod/perlvar.pod b/pod/perlvar.pod index d38bc49..5e70531 100644 --- a/pod/perlvar.pod +++ b/pod/perlvar.pod @@ -270,7 +270,7 @@ set, you'll get the record back in pieces. On VMS, record reads are done with the equivalent of C, so it's best not to mix record and non-record reads on the same file. (This is unlikely to be a problem, because any file you'd -want to read in record mode is probably usable in line mode.) +want to read in record mode is probably unusable in line mode.) Non-VMS systems do normal I/O, so it's safe to mix record and non-record reads of a file. diff --git a/pod/perlxs.pod b/pod/perlxs.pod index ee582e0..a2755b8 100644 --- a/pod/perlxs.pod +++ b/pod/perlxs.pod @@ -6,27 +6,72 @@ perlxs - XS language reference manual =head2 Introduction -XS is a language used to create an extension interface -between Perl and some C library which one wishes to use with -Perl. The XS interface is combined with the library to -create a new library which can be linked to Perl. An B -is a function in the XS language and is the core component -of the Perl application interface. - -The XS compiler is called B. This compiler will embed -the constructs necessary to let an XSUB, which is really a C -function in disguise, manipulate Perl values and creates the -glue necessary to let Perl access the XSUB. The compiler +XS is an interface description file format used to create an extension +interface between Perl and C code (or a C library) which one wishes +to use with Perl. The XS interface is combined with the library to +create a new library which can then be either dynamically loaded +or statically linked into perl. The XS interface description is +written in the XS language and is the core component of the Perl +extension interface. + +An B forms the basic unit of the XS interface. After compilation +by the B compiler, each XSUB amounts to a C function definition +which will provide the glue between Perl calling conventions and C +calling conventions. + +The glue code pulls the arguments from the Perl stack, converts these +Perl values to the formats expected by a C function, call this C function, +transfers the return values of the C function back to Perl. +Return values here may be a conventional C return value or any C +function arguments that may serve as output parameters. These return +values may be passed back to Perl either by putting them on the +Perl stack, or by modifying the arguments supplied from the Perl side. + +The above is a somewhat simplified view of what really happens. Since +Perl allows more flexible calling conventions than C, XSUBs may do much +more in practice, such as checking input parameters for validity, +throwing exceptions (or returning undef/empty list) if the return value +from the C function indicates failure, calling different C functions +based on numbers and types of the arguments, providing an object-oriented +interface, etc. + +Of course, one could write such glue code directly in C. However, this +would be a tedious task, especially if one needs to write glue for +multiple C functions, and/or one is not familiar enough with the Perl +stack discipline and other such arcana. XS comes to the rescue here: +instead of writing this glue C code in long-hand, one can write +a more concise short-hand I of what should be done by +the glue, and let the XS compiler B handle the rest. + +The XS language allows one to describe the mapping between how the C +routine is used, and how the corresponding Perl routine is used. It +also allows creation of Perl routines which are directly translated to +C code and which are not related to a pre-existing C function. In cases +when the C interface coincides with the Perl interface, the XSUB +declaration is almost identical to a declaration of a C function (in K&R +style). In such circumstances, there is another tool called C +that is able to translate an entire C header file into a corresponding +XS file that will provide glue to the functions/macros described in +the header file. + +The XS compiler is called B. This compiler creates +the constructs necessary to let an XSUB manipulate Perl values, and +creates the glue necessary to let Perl call the XSUB. The compiler uses B to determine how to map C function parameters -and variables to Perl values. The default typemap handles -many common C types. A supplement typemap must be created -to handle special structures and types for the library being -linked. +and output values to Perl values and back. The default typemap +(which comes with Perl) handles many common C types. A supplementary +typemap may also be needed to handle any special structures and types +for the library being linked. + +A file in XS format starts with a C language section which goes until the +first C> directive. Other XS directives and XSUB definitions +may follow this line. The "language" used in this part of the file +is usually referred to as the XS language. See L for a tutorial on the whole extension creation process. -Note: For many extensions, Dave Beazley's SWIG system provides a -significantly more convenient mechanism for creating the XS glue +Note: For some extensions, Dave Beazley's SWIG system may provide a +significantly more convenient mechanism for creating the extension glue code. See L for more information. @@ -76,7 +121,7 @@ expanded later in this document. rpcb_gettime(host,timep) char *host time_t &timep - OUTPUT: + OUTPUT: timep Any extension to Perl, including those containing XSUBs, @@ -110,6 +155,10 @@ function. =head2 The Anatomy of an XSUB +The simplest XSUBs consist of 3 parts: a description of the return +value, the name of the XSUB routine and the names of its arguments, +and a description of types or formats of the arguments. + The following XSUB allows a Perl program to access a C library function called sin(). The XSUB will imitate the C function which takes a single argument and returns a single value. @@ -118,14 +167,24 @@ argument and returns a single value. sin(x) double x -When using C pointers the indirection operator C<*> should be considered -part of the type and the address operator C<&> should be considered part of -the variable, as is demonstrated in the rpcb_gettime() function above. See -the section on typemaps for more about handling qualifiers and unary +When using parameters with C pointer types, as in + + double string_to_double(char *s); + +there may be two ways to describe this argument to B: + + char * s + char &s + +Both these XS declarations correspond to the C C type, but they have +different semantics. It is convenient to think that the indirection operator +C<*> should be considered as a part of the type and the address operator C<&> +should be considered part of the variable. See L<"The Typemap"> and +L<"The & Unary Operator"> for more info about handling qualifiers and unary operators in C types. The function name and the return type must be placed on -separate lines. +separate lines and should be flush left-adjusted. INCORRECT CORRECT @@ -135,7 +194,7 @@ separate lines. The function body may be indented or left-adjusted. The following example shows a function with its body left-adjusted. Most examples in this -document will indent the body. +document will indent the body for better readability. CORRECT @@ -143,13 +202,23 @@ document will indent the body. sin(x) double x +More complicated XSUBs may contain many other sections. Each section of +an XSUB starts with the corresponding keyword, such as INIT: or CLEANUP:. +However, the first two lines of an XSUB always contain the same data: +descriptions of the return type and the names of the function and its +parameters. Whatever immediately follows these is considered to be +an INPUT: section unless explicitly marked with another keyword. +(See L.) + +An XSUB section continues until another section-start keyword is found. + =head2 The Argument Stack -The argument stack is used to store the values which are +The Perl argument stack is used to store the values which are sent as parameters to the XSUB and to store the XSUB's -return value. In reality all Perl functions keep their -values on this stack at the same time, each limited to its -own range of positions on the stack. In this document the +return value(s). In reality all Perl functions (including non-XSUB +ones) keep their values on this stack all the same time, each limited +to its own range of positions on the stack. In this document the first position on that stack which belongs to the active function will be referred to as position 0 for that function. @@ -163,17 +232,19 @@ typemaps. In more complex cases the programmer must supply the code. =head2 The RETVAL Variable -The RETVAL variable is a magic variable which always matches -the return type of the C library function. The B compiler will -supply this variable in each XSUB and by default will use it to hold the -return value of the C library function being called. In simple cases the -value of RETVAL will be placed in ST(0) of the argument stack where it can -be received by Perl as the return value of the XSUB. +The RETVAL variable is a special C variable that is declared automatically +for you. The C type of RETVAL matches the return type of the C library +function. The B compiler will declare this variable in each XSUB +with non-C return type. By default the generated C function +will use RETVAL to hold the return value of the C library function being +called. In simple cases the value of RETVAL will be placed in ST(0) of +the argument stack where it can be received by Perl as the return value +of the XSUB. If the XSUB has a return type of C then the compiler will -not supply a RETVAL variable for that function. When using -the PPCODE: directive the RETVAL variable is not needed, unless used -explicitly. +not declare a RETVAL variable for that function. When using +a PPCODE: section no manipulation of the RETVAL variable is required, the +section may use direct stack manipulation to place output values on the stack. If PPCODE: directive is not used, C return value should be used only for subroutines which do not return a value, I CODE: @@ -248,8 +319,9 @@ keyword. The OUTPUT: keyword indicates that certain function parameters should be updated (new values made visible to Perl) when the XSUB terminates or that certain values should be returned to the calling Perl function. For -simple functions, such as the sin() function above, the RETVAL variable is -automatically designated as an output value. In more complex functions +simple functions which have no CODE: or PPCODE: section, +such as the sin() function above, the RETVAL variable is +automatically designated as an output value. For more complex functions the B compiler will need help to determine which variables are output variables. @@ -268,7 +340,7 @@ be seen by Perl. rpcb_gettime(host,timep) char *host time_t &timep - OUTPUT: + OUTPUT: timep The OUTPUT: keyword will also allow an output parameter to @@ -279,7 +351,7 @@ typemap. rpcb_gettime(host,timep) char *host time_t &timep - OUTPUT: + OUTPUT: timep sv_setnv(ST(1), (double)timep); B emits an automatic C for all parameters in the @@ -297,8 +369,8 @@ about 'set' magic. This keyword is used in more complicated XSUBs which require special handling for the C function. The RETVAL variable is -available but will not be returned unless it is specified -under the OUTPUT: keyword. +still declared, but it will not be returned unless it is specified +in the OUTPUT: section. The following XSUB is for a C function which requires special handling of its parameters. The Perl usage is given first. @@ -311,9 +383,9 @@ The XSUB follows. rpcb_gettime(host,timep) char *host time_t timep - CODE: + CODE: RETVAL = rpcb_gettime( host, &timep ); - OUTPUT: + OUTPUT: timep RETVAL @@ -327,11 +399,24 @@ above, this keyword does not affect the way the compiler handles RETVAL. rpcb_gettime(host,timep) char *host time_t &timep - INIT: + INIT: printf("# Host is %s\n", host ); - OUTPUT: + OUTPUT: timep +Another use for the INIT: section is to check for preconditions before +making a call to the C function: + + long long + lldiv(a,b) + long long a + long long b + INIT: + if (a == 0 && b == 0) + XSRETURN_UNDEF; + if (b == 0) + croak("lldiv: cannot divide by 0"); + =head2 The NO_INIT Keyword The NO_INIT keyword is used to indicate that a function @@ -351,17 +436,21 @@ not care about its initial contents. rpcb_gettime(host,timep) char *host time_t &timep = NO_INIT - OUTPUT: + OUTPUT: timep =head2 Initializing Function Parameters -Function parameters are normally initialized with their -values from the argument stack. The typemaps contain the -code segments which are used to transfer the Perl values to +C function parameters are normally initialized with their values from +the argument stack (which in turn contains the parameters that were +passed to the XSUB from Perl). The typemaps contain the +code segments which are used to translate the Perl values to the C parameters. The programmer, however, is allowed to override the typemaps and supply alternate (or additional) -initialization code. +initialization code. Initialization code starts with the first +C<=>, C<;> or C<+> on a line in the INPUT: section. The only +exception happens if this C<;> terminates the line, then this C<;> +is quietly ignored. The following code demonstrates how to supply initialization code for function parameters. The initialization code is eval'd within double @@ -374,7 +463,7 @@ and $type can be used as in typemaps. rpcb_gettime(host,timep) char *host = (char *)SvPV($arg,PL_na); time_t &timep = 0; - OUTPUT: + OUTPUT: timep This should not be used to supply default values for parameters. One @@ -382,27 +471,38 @@ would normally use this when a function parameter must be processed by another library function before it can be used. Default parameters are covered in the next section. -If the initialization begins with C<=>, then it is output on -the same line where the input variable is declared. If the -initialization begins with C<;> or C<+>, then it is output after -all of the input variables have been declared. The C<=> and C<;> -cases replace the initialization normally supplied from the typemap. -For the C<+> case, the initialization from the typemap will precede -the initialization code included after the C<+>. A global +If the initialization begins with C<=>, then it is output in +the declaration for the input variable, replacing the initialization +supplied by the typemap. If the initialization +begins with C<;> or C<+>, then it is performed after +all of the input variables have been declared. In the C<;> +case the initialization normally supplied by the typemap is not performed. +For the C<+> case, the declaration for the variable will include the +initialization from the typemap. A global variable, C<%v>, is available for the truly rare case where information from one initialization is needed in another initialization. +Here's a truly obscure example: + bool_t rpcb_gettime(host,timep) - time_t &timep ; /*\$v{time}=@{[$v{time}=$arg]}*/ - char *host + SvOK($v{time}) ? SvPV($arg,PL_na) : NULL; - OUTPUT: + time_t &timep ; /* \$v{timep}=@{[$v{timep}=$arg]} */ + char *host + SvOK($v{timep}) ? SvPV($arg,PL_na) : NULL; + OUTPUT: timep +The construct C<\$v{timep}=@{[$v{timep}=$arg]}> used in the above +example has a two-fold purpose: first, when this line is processed by +B, the Perl snippet C<$v{timep}=$arg> is evaluated. Second, +the text of the evaluated snippet is output into the generated C file +(inside a C comment)! During the processing of C line, +$arg will evaluate to C, and C<$v{timep}> will evaluate to +C. + =head2 Default Parameter Values -Default values can be specified for function parameters by +Default values for XSUB arguments can be specified by placing an assignment statement in the parameter list. The default value may be a number or a string. Defaults should always be used on the right-most parameters only. @@ -410,8 +510,8 @@ always be used on the right-most parameters only. To allow the XSUB for rpcb_gettime() to have a default host value the parameters to the XSUB could be rearranged. The XSUB will then call the real rpcb_gettime() function with -the parameters in the correct order. Perl will call this -XSUB with either of the following statements. +the parameters in the correct order. This XSUB can be called +from Perl with either of the following statements: $status = rpcb_gettime( $timep, $host ); @@ -425,20 +525,29 @@ the parameters in the correct order for that function. rpcb_gettime(timep,host="localhost") char *host time_t timep = NO_INIT - CODE: + CODE: RETVAL = rpcb_gettime( host, &timep ); - OUTPUT: + OUTPUT: timep RETVAL =head2 The PREINIT: Keyword -The PREINIT: keyword allows extra variables to be declared before the -typemaps are expanded. If a variable is declared in a CODE: block then that -variable will follow any typemap code. This may result in a C syntax -error. To force the variable to be declared before the typemap code, place -it into a PREINIT: block. The PREINIT: keyword may be used one or more -times within an XSUB. +The PREINIT: keyword allows extra variables to be declared immediately +before or after the declartions of the parameters from the INPUT: section +are emitted. + +If a variable is declared inside a CODE: section it will follow any typemap +code that is emitted for the input parameters. This may result in the +declaration ending up after C code, which is C syntax error. Similar +errors may happen with an explicit C<;>-type or C<+>-type initialization of +parameters is used (see L<"Initializing Function Parameters">). Declaring +these variables in an INIT: section will not help. + +In such cases, to force an additional variable to be declared together +with declarations of other variables, place the declaration into a +PREINIT: section. The PREINIT: keyword may be used one or more times +within an XSUB. The following examples are equivalent, but if the code is using complex typemaps then the first example is safer. @@ -446,23 +555,79 @@ typemaps then the first example is safer. bool_t rpcb_gettime(timep) time_t timep = NO_INIT - PREINIT: + PREINIT: char *host = "localhost"; - CODE: + CODE: RETVAL = rpcb_gettime( host, &timep ); - OUTPUT: + OUTPUT: timep RETVAL -A correct, but error-prone example. +For this particular case an INIT: keyword would generate the +same C code as the PREINIT: keyword. Another correct, but error-prone example: bool_t rpcb_gettime(timep) time_t timep = NO_INIT - CODE: + CODE: char *host = "localhost"; RETVAL = rpcb_gettime( host, &timep ); - OUTPUT: + OUTPUT: + timep + RETVAL + +Another way to declare C is to use a C block in the CODE: section: + + bool_t + rpcb_gettime(timep) + time_t timep = NO_INIT + CODE: + { + char *host = "localhost"; + RETVAL = rpcb_gettime( host, &timep ); + } + OUTPUT: + timep + RETVAL + +The ability to put additional declarations before the typemap entries are +processed is very handy in the cases when typemap conversions manipulate +some global state: + + MyObject + mutate(o) + PREINIT: + MyState st = global_state; + INPUT: + MyObject o; + CLEANUP: + reset_to(global_state, st); + +Here we suppose that conversion to C in the INPUT: section and from +MyObject when processing RETVAL will modify a global variable C. +After these conversions are performed, we restore the old value of +C (to avoid memory leaks, for example). + +There is another way to trade clarity for compactness: INPUT sections allow +declaration of C variables which do not appear in the parameter list of +a subroutine. Thus the above code for mutate() can be rewritten as + + MyObject + mutate(o) + MyState st = global_state; + MyObject o; + CLEANUP: + reset_to(global_state, st); + +and the code for rpcb_gettime() can be rewritten as + + bool_t + rpcb_gettime(timep) + time_t timep = NO_INIT + char *host = "localhost"; + C_ARGS: + host, &timep + OUTPUT: timep RETVAL @@ -472,8 +637,8 @@ The SCOPE: keyword allows scoping to be enabled for a particular XSUB. If enabled, the XSUB will invoke ENTER and LEAVE automatically. To support potentially complex type mappings, if a typemap entry used -by this XSUB contains a comment like C then scoping will -automatically be enabled for that XSUB. +by an XSUB contains a comment like C then scoping will +be automatically enabled for that XSUB. To enable scoping: @@ -497,14 +662,14 @@ evaluated late, after a PREINIT. bool_t rpcb_gettime(host,timep) char *host - PREINIT: + PREINIT: time_t tt; - INPUT: + INPUT: time_t timep - CODE: + CODE: RETVAL = rpcb_gettime( host, &tt ); timep = tt; - OUTPUT: + OUTPUT: timep RETVAL @@ -512,22 +677,43 @@ The next example shows each input parameter evaluated late. bool_t rpcb_gettime(host,timep) - PREINIT: + PREINIT: time_t tt; - INPUT: + INPUT: char *host - PREINIT: + PREINIT: char *h; - INPUT: + INPUT: time_t timep - CODE: + CODE: h = host; RETVAL = rpcb_gettime( h, &tt ); timep = tt; - OUTPUT: + OUTPUT: + timep + RETVAL + +Since INPUT sections allow declaration of C variables which do not appear +in the parameter list of a subroutine, this may be shortened to: + + bool_t + rpcb_gettime(host,timep) + time_t tt; + char *host; + char *h = host; + time_t timep; + CODE: + RETVAL = rpcb_gettime( h, &tt ); + timep = tt; + OUTPUT: timep RETVAL +(We used our knowledge that input conversion for C is a "simple" one, +thus C is initialized on the declaration line, and our assignment +C is not performed too early. Otherwise one would need to have the +assignment C in a CODE: or INIT: section.) + =head2 Variable-length Parameter Lists XSUBs can have variable-length parameter lists by specifying an ellipsis @@ -551,14 +737,14 @@ The XS code, with ellipsis, follows. bool_t rpcb_gettime(timep, ...) time_t timep = NO_INIT - PREINIT: + PREINIT: char *host = "localhost"; STRLEN n_a; - CODE: - if( items > 1 ) - host = (char *)SvPV(ST(1), n_a); - RETVAL = rpcb_gettime( host, &timep ); - OUTPUT: + CODE: + if( items > 1 ) + host = (char *)SvPV(ST(1), n_a); + RETVAL = rpcb_gettime( host, &timep ); + OUTPUT: timep RETVAL @@ -566,10 +752,10 @@ The XS code, with ellipsis, follows. The C_ARGS: keyword allows creating of XSUBS which have different calling sequence from Perl than from C, without a need to write -CODE: or CPPCODE: section. The contents of the C_ARGS: paragraph is +CODE: or PPCODE: section. The contents of the C_ARGS: paragraph is put as the argument to the called C function without any change. -For example, suppose that C function is declared as +For example, suppose that a C function is declared as symbolic nth_derivative(int n, symbolic function, int flags); @@ -585,7 +771,7 @@ To do this, declare the XSUB as nth_derivative(function, n) symbolic function int n - C_ARGS: + C_ARGS: n, function, default_flags =head2 The PPCODE: Keyword @@ -595,9 +781,29 @@ to tell the B compiler that the programmer is supplying the code to control the argument stack for the XSUBs return values. Occasionally one will want an XSUB to return a list of values rather than a single value. In these cases one must use PPCODE: and then explicitly push the list of -values on the stack. The PPCODE: and CODE: keywords are not used +values on the stack. The PPCODE: and CODE: keywords should not be used together within the same XSUB. +The actual difference between PPCODE: and CODE: sections is in the +initialization of C macro (which stands for the I Perl +stack pointer), and in the handling of data on the stack when returning +from an XSUB. In CODE: sections SP preserves the value which was on +entry to the XSUB: SP is on the function pointer (which follows the +last parameter). In PPCODE: sections SP is moved backward to the +beginning of the parameter list, which allows C macros +to place output values in the place Perl expects them to be when +the XSUB returns back to Perl. + +The generated trailer for a CODE: section ensures that the number of return +values Perl will see is either 0 or 1 (depending on the Cness of the +return value of the C function, and heuristics mentioned in +L<"The RETVAL Variable">). The trailer generated for a PPCODE: section +is based on the number of return values and on the number of times +C was updated by C<[X]PUSH*()> macros. + +Note that macros C, C and C work equally +well in CODE: sections and PPCODE: sections. + The following XSUB will call the C rpcb_gettime() function and will return its two output values, timep and status, to Perl as a single list. @@ -605,10 +811,10 @@ Perl as a single list. void rpcb_gettime(host) char *host - PREINIT: + PREINIT: time_t timep; bool_t status; - PPCODE: + PPCODE: status = rpcb_gettime( host, &timep ); EXTEND(SP, 2); PUSHs(sv_2mortal(newSViv(status))); @@ -659,10 +865,10 @@ the default return value. SV * rpcb_gettime(host) char * host - PREINIT: + PREINIT: time_t timep; bool_t x; - CODE: + CODE: ST(0) = sv_newmortal(); if( rpcb_gettime( host, &timep ) ) sv_setnv( ST(0), (double)timep); @@ -673,10 +879,10 @@ return value, should the need arise. SV * rpcb_gettime(host) char * host - PREINIT: + PREINIT: time_t timep; bool_t x; - CODE: + CODE: ST(0) = sv_newmortal(); if( rpcb_gettime( host, &timep ) ){ sv_setnv( ST(0), (double)timep); @@ -691,14 +897,14 @@ then not push return values on the stack. void rpcb_gettime(host) char *host - PREINIT: + PREINIT: time_t timep; - PPCODE: + PPCODE: if( rpcb_gettime( host, &timep ) ) PUSHs(sv_2mortal(newSViv(timep))); else{ - /* Nothing pushed on stack, so an empty */ - /* list is implicitly returned. */ + /* Nothing pushed on stack, so an empty + * list is implicitly returned. */ } Some people may be inclined to include an explicit C in the above @@ -707,6 +913,32 @@ situations C should be used, instead. This will ensure that the XSUB stack is properly adjusted. Consult L for other C macros. +Since C macros can be used with CODE blocks as well, one can +rewrite this example as: + + int + rpcb_gettime(host) + char *host + PREINIT: + time_t timep; + CODE: + RETVAL = rpcb_gettime( host, &timep ); + if (RETVAL == 0) + XSRETURN_UNDEF; + OUTPUT: + RETVAL + +In fact, one can put this check into a CLEANUP: section as well. Together +with PREINIT: simplifications, this leads to: + + int + rpcb_gettime(host) + char *host + time_t timep; + CLEANUP: + if (RETVAL == 0) + XSRETURN_UNDEF; + =head2 The REQUIRE: Keyword The REQUIRE: keyword is used to indicate the minimum version of the @@ -784,15 +1016,15 @@ prototypes. bool_t rpcb_gettime(timep, ...) time_t timep = NO_INIT - PROTOTYPE: $;$ - PREINIT: + PROTOTYPE: $;$ + PREINIT: char *host = "localhost"; STRLEN n_a; - CODE: + CODE: if( items > 1 ) host = (char *)SvPV(ST(1), n_a); RETVAL = rpcb_gettime( host, &timep ); - OUTPUT: + OUTPUT: timep RETVAL @@ -812,12 +1044,12 @@ C for this function. rpcb_gettime(host,timep) char *host time_t &timep - ALIAS: + ALIAS: FOO::gettime = 1 BAR::getit = 2 - INIT: + INIT: printf("# ix = %d\n", ix ); - OUTPUT: + OUTPUT: timep =head2 The INTERFACE: Keyword @@ -825,14 +1057,14 @@ C for this function. This keyword declares the current XSUB as a keeper of the given calling signature. If some text follows this keyword, it is considered as a list of functions which have this signature, and -should be attached to XSUBs. +should be attached to the current XSUB. -Say, if you have 4 functions multiply(), divide(), add(), subtract() all -having the signature +For example, if you have 4 C functions multiply(), divide(), add(), +subtract() all having the signature: symbolic f(symbolic, symbolic); -you code them all by using XSUB +you can make them all to use the same XSUB using this: symbolic interface_s_ss(arg1, arg2) @@ -842,16 +1074,21 @@ you code them all by using XSUB multiply divide add subtract -The advantage of this approach comparing to ALIAS: keyword is that one +(This is the complete XSUB code for 4 Perl functions!) Four generated +Perl function share names with corresponding C functions. + +The advantage of this approach comparing to ALIAS: keyword is that there +is no need to code a switch statement, each Perl function (which shares +the same XSUB) knows which C function it should call. Additionally, one can attach an extra function remainder() at runtime by using - + CV *mycv = newXSproto("Symbolic::remainder", XS_Symbolic_interface_s_ss, __FILE__, "$$"); XSINTERFACE_FUNC_SET(mycv, remainder); -(This example supposes that there was no INTERFACE_MACRO: section, -otherwise one needs to use something else instead of -C.) +say, from another XSUB. (This example supposes that there was no +INTERFACE_MACRO: section, otherwise one needs to use something else instead of +C, see the next section.) =head2 The INTERFACE_MACRO: Keyword @@ -882,10 +1119,10 @@ in C section, interface_s_ss(arg1, arg2) symbolic arg1 symbolic arg2 - INTERFACE_MACRO: + INTERFACE_MACRO: XSINTERFACE_FUNC_BYOFFSET XSINTERFACE_FUNC_BYOFFSET_set - INTERFACE: + INTERFACE: multiply divide add subtract @@ -903,7 +1140,7 @@ The file F contains our C function: rpcb_gettime(host,timep) char *host time_t &timep - OUTPUT: + OUTPUT: timep The XS module can use INCLUDE: to pull that file into it. @@ -936,22 +1173,22 @@ reversed, C<(time_t *timep, char *host)>. long rpcb_gettime(a,b) CASE: ix == 1 - ALIAS: + ALIAS: x_gettime = 1 - INPUT: + INPUT: # 'a' is timep, 'b' is host char *b time_t a = NO_INIT - CODE: + CODE: RETVAL = rpcb_gettime( b, &a ); - OUTPUT: + OUTPUT: a RETVAL CASE: # 'a' is host, 'b' is timep char *a time_t &b = NO_INIT - OUTPUT: + OUTPUT: b RETVAL @@ -964,12 +1201,15 @@ the different argument lists. =head2 The & Unary Operator -The & unary operator is used to tell the compiler that it should dereference -the object when it calls the C function. This is used when a CODE: block is -not used and the object is a not a pointer type (the object is an C or -C but not a C or C). +The C<&> unary operator in the INPUT: section is used to tell B +that it should convert a Perl value to/from C using the C type to the left +of C<&>, but provide a pointer to this value when the C function is called. + +This is useful to avoid a CODE: block for a C function which takes a parameter +by reference. Typically, the parameter should be not a pointer type (an +C or C but not a C or C). -The following XSUB will generate incorrect C code. The xsubpp compiler will +The following XSUB will generate incorrect C code. The B compiler will turn this into code which calls C with parameters C<(char *host, time_t timep)>, but the real C wants the C parameter to be of type C rather than C. @@ -978,10 +1218,10 @@ parameter to be of type C rather than C. rpcb_gettime(host,timep) char *host time_t timep - OUTPUT: + OUTPUT: timep -That problem is corrected by using the C<&> operator. The xsubpp compiler +That problem is corrected by using the C<&> operator. The B compiler will now turn this into code which calls C correctly with parameters C<(char *host, time_t *timep)>. It does this by carrying the C<&> through, so the function call looks like C. @@ -990,7 +1230,7 @@ C<&> through, so the function call looks like C. rpcb_gettime(host,timep) char *host time_t &timep - OUTPUT: + OUTPUT: timep =head2 Inserting Comments and C Preprocessor Directives @@ -1021,13 +1261,14 @@ and not #if ... version2 #endif -because otherwise xsubpp will believe that you made a duplicate +because otherwise B will believe that you made a duplicate definition of the function. Also, put a blank line before the #else/#endif so it will not be seen as part of the function body. =head2 Using XS With C++ -If a function is defined as a C++ method then it will assume +If an XSUB name contains C<::>, it is considered to be a C++ method. +The generated Perl function will assume that its first argument is an object pointer. The object pointer will be stored in a variable called THIS. The object should have been created by C++ with the new() function and should @@ -1035,7 +1276,8 @@ be blessed by Perl with the sv_setref_pv() macro. The blessing of the object by Perl can be handled by a typemap. An example typemap is shown at the end of this section. -If the method is defined as static it will call the C++ +If the return type of the XSUB includes C, the method is considered +to be a static method. It will call the C++ function using the class::method() syntax. If the method is not static the function will be called using the THIS-Emethod() syntax. @@ -1063,22 +1305,24 @@ not listed. color::set_blue( val ) int val -Both functions will expect an object as the first parameter. The xsubpp -compiler will call that object C and will use it to call the specified -method. So in the C++ code the blue() and set_blue() methods will be called -in the following manner. +Both Perl functions will expect an object as the first parameter. In the +generated C++ code the object is called C, and the method call will +be performed on this object. So in the C++ code the blue() and set_blue() +methods will be called as this: RETVAL = THIS->blue(); THIS->set_blue( val ); If the function's name is B then the C++ C function will be -called and C will be given as its parameter. +called and C will be given as its parameter. The generated C++ code for void color::DESTROY() -The C++ code will call C. +will look like this: + + color *THIS = ...; // Initialized as in typemap delete THIS; @@ -1090,9 +1334,9 @@ argument. color * color::new() -The C++ code will call C. +The generated C++ code will call C. - RETVAL = new color(); + RETVAL = new color(); The following is an example of a typemap that could be used for this C++ example. @@ -1118,30 +1362,59 @@ example. =head2 Interface Strategy When designing an interface between Perl and a C library a straight -translation from C to XS is often sufficient. The interface will often be +translation from C to XS (such as created by C) is often sufficient. +However, sometimes the interface will look very C-like and occasionally nonintuitive, especially when the C function -modifies one of its parameters. In cases where the programmer wishes to +modifies one of its parameters, or returns failure inband (as in "negative +return values mean failure"). In cases where the programmer wishes to create a more Perl-like interface the following strategy may help to identify the more critical parts of the interface. -Identify the C functions which modify their parameters. The XSUBs for -these functions may be able to return lists to Perl, or may be -candidates to return undef or an empty list in case of failure. +Identify the C functions with input/output or output parameters. The XSUBs for +these functions may be able to return lists to Perl. + +Identify the C functions which use some inband info as an indication +of failure. They may be +candidates to return undef or an empty list in case of failure. If the +failure may be detected without a call to the C function, you may want to use +an INIT: section to report the failure. For failures detectable after the C +function returns one may want to use a CLEANUP: section to process the +failure. In more complicated cases use CODE: or PPCODE: sections. + +If many functions use the same failure indication based on the return value, +you may want to create a special typedef to handle this situation. Put + + typedef int negative_is_failure; + +near the beginning of XS file, and create an OUTPUT typemap entry +for C which converts negative values to C, or +maybe croak()s. After this the return value of type C +will create more Perl-like interface. Identify which values are used by only the C and XSUB functions -themselves. If Perl does not need to access the contents of the value +themselves, say, when a parameter to a function should be a contents of a +global variable. If Perl does not need to access the contents of the value then it may not be necessary to provide a translation for that value from C to Perl. Identify the pointers in the C function parameter lists and return -values. Some pointers can be handled in XS with the & unary operator on -the variable name while others will require the use of the * operator on -the type name. In general it is easier to work with the & operator. +values. Some pointers may be used to implement input/output or +output parameters, they can be handled in XS with the C<&> unary operator, +and, possibly, using the NO_INIT keyword. +Some others will require handling of types like C, and one needs +to decide what a useful Perl translation will do in such a case. When +the semantic is clear, it is advisable to put the translation into a typemap +file. Identify the structures used by the C functions. In many cases it may be helpful to use the T_PTROBJ typemap for these structures so they can be manipulated by Perl as -blessed objects. +blessed objects. (This is handled automatically by C.) + +If the same C type is used in several different contexts which require +different translations, C several new types mapped to this C type, +and create separate F entries for these new types. Use these +types in declarations of return type and parameters to XSUBs. =head2 Perl Objects And C Structures @@ -1188,7 +1461,7 @@ trim the name to the word DESTROY as Perl will expect. void rpcb_DESTROY(netconf) Netconfig *netconf - CODE: + CODE: printf("Now in NetconfigPtr::DESTROY\n"); free( netconf ); @@ -1214,8 +1487,8 @@ getnetconfigent() XSUB and an object created by a normal Perl subroutine. The typemap is a collection of code fragments which are used by the B compiler to map C function parameters and values to Perl values. The typemap file may consist of three sections labeled C, C, and -C. Any unlabelled initial section is assumed to be a C -section if a name is not explicitly specified. The INPUT section tells +C. An unlabelled initial section is assumed to be a C +section. The INPUT section tells the compiler how to translate Perl values into variables of certain C types. The OUTPUT section tells the compiler how to translate the values from certain C types into values Perl can @@ -1239,8 +1512,8 @@ with the T_PTROBJ typemap. The typemap used by getnetconfigent() is shown here. Note that the C type is separated from the XS type with a tab and that the C unary operator C<*> is considered to be a part of the C type name. - TYPEMAP - Netconfig *T_PTROBJ + TYPEMAP + Netconfig *T_PTROBJ Here's a more complicated example: suppose that you wanted C to be blessed into the class C. One way to do @@ -1290,9 +1563,9 @@ File C: Interface to some ONC+ RPC bind library functions. SV * rpcb_gettime(host="localhost") char *host - PREINIT: + PREINIT: time_t timep; - CODE: + CODE: ST(0) = sv_newmortal(); if( rpcb_gettime( host, &timep ) ) sv_setnv( ST(0), (double)timep ); @@ -1306,7 +1579,7 @@ File C: Interface to some ONC+ RPC bind library functions. void rpcb_DESTROY(netconf) Netconfig *netconf - CODE: + CODE: printf("NetconfigPtr::DESTROY\n"); free( netconf ); @@ -1348,5 +1621,6 @@ This document covers features supported by C 1.935. =head1 AUTHOR -Dean Roehrich > -Jul 8, 1996 +Originally written by Dean Roehrich >. + +Maintained since 1996 by The Perl Porters >. diff --git a/pod/perlxstut.pod b/pod/perlxstut.pod index 632f417..35edd05 100644 --- a/pod/perlxstut.pod +++ b/pod/perlxstut.pod @@ -24,15 +24,37 @@ them. If you find something that was missed, please let me know. This tutorial assumes that the make program that Perl is configured to use is called C. Instead of running "make" in the examples that follow, you may have to substitute whatever make program Perl has been -configured to use. Running "perl -V:make" should tell you what it is. +configured to use. Running B should tell you what it is. =head2 Version caveat -This tutorial tries hard to keep up with the latest development versions -of Perl. This often means that it is sometimes in advance of the latest -released version of Perl, and that certain features described here might -not work on earlier versions. See the section on "Troubleshooting -these Examples" for more information. +When writing a Perl extension for general consumption, one should expect that +the extension will be used with versions of Perl different from the +version available on your machine. Since you are reading this document, +the version of Perl on your machine is probably 5.005 or later, but the users +of your extension may have more ancient versions. + +To understand what kinds of incompatibilities one may expect, and in the rare +case that the version of Perl on your machine is older than this document, +see the section on "Troubleshooting these Examples" for more information. + +If your extension uses some features of Perl which are not available on older +releases of Perl, your users would appreciate an early meaningful warning. +You would probably put this information into the F file, but nowadays +installation of extensions may be performed automatically, guided by F +module or other tools. + +In MakeMaker-based installations, F provides the earliest +opportunity to perform version checks. One can put something like this +in F for this purpose: + + eval { require 5.007 } + or die < should show you if this is the case). If Perl is configured to use PerlCRT, you have to make sure PerlCRT.lib is copied to the same location that msvcrt.lib lives in, so that the compiler can find it on its own. msvcrt.lib is usually @@ -400,21 +422,21 @@ which we passed in, so we listed it (and not RETVAL) in the OUTPUT: section. =head2 The XSUBPP Program -The xsubpp program takes the XS code in the .xs file and translates it into +The B program takes the XS code in the .xs file and translates it into C code, placing it in a file whose suffix is .c. The C code created makes heavy use of the C functions within Perl. =head2 The TYPEMAP file -The xsubpp program uses rules to convert from Perl's data types (scalar, +The B program uses rules to convert from Perl's data types (scalar, array, etc.) to C's data types (int, char, etc.). These rules are stored in the typemap file ($PERLLIB/ExtUtils/typemap). This file is split into three parts. The first section maps various C data types to a name, which corresponds somewhat with the various Perl types. The second section contains C code -which xsubpp uses to handle input parameters. The third section contains -C code which xsubpp uses to handle output parameters. +which B uses to handle input parameters. The third section contains +C code which B uses to handle output parameters. Let's take a look at a portion of the .c file created for our extension. The file name is Mytest.c: @@ -649,39 +671,174 @@ commands to build it. =back -=head2 More about XSUBPP +=head2 Anatomy of .xs file + +The .xs file of L<"EXAMPLE 4"> contained some new elements. To understand +the meaning of these elements, pay attention to the line which reads + + MODULE = Mytest2 PACKAGE = Mytest2 + +Anything before this line is plain C code which describes which headers +to include, and defines some convenience functions. No translations are +performed on this part, it goes into the generated output C file as is. + +Anything after this line is the description of XSUB functions. +These descriptions are translated by B into C code which +implements these functions using Perl calling conventions, and which +makes these functions visible from Perl interpreter. + +Pay a special attention to the function C. This name appears +twice in the generated .xs file: once in the first part, as a static C +function, the another time in the second part, when an XSUB interface to +this static C function is defined. + +This is quite typical for .xs files: usually the .xs file provides +an interface to an existing C function. Then this C function is defined +somewhere (either in an external library, or in the first part of .xs file), +and a Perl interface to this function (i.e. "Perl glue") is described in the +second part of .xs file. The situation in L<"EXAMPLE 1">, L<"EXAMPLE 2">, +and L<"EXAMPLE 3">, when all the work is done inside the "Perl glue", is +somewhat of an exception rather than the rule. + +=head2 Getting the fat out of XSUBs + +In L<"EXAMPLE 4"> the second part of .xs file contained the following +description of an XSUB: + + double + foo(a,b,c) + int a + long b + const char * c + OUTPUT: + RETVAL + +Note that in contrast with L<"EXAMPLE 1">, L<"EXAMPLE 2"> and L<"EXAMPLE 3">, +this description does not contain the actual I for what is done +is done during a call to Perl function foo(). To understand what is going +on here, one can add a CODE section to this XSUB: + + double + foo(a,b,c) + int a + long b + const char * c + CODE: + RETVAL = foo(a,b,c); + OUTPUT: + RETVAL + +However, these two XSUBs provide almost identical generated C code: B +compiler is smart enough to figure out the C section from the first +two lines of the description of XSUB. What about C section? In +fact, that is absolutely the same! The C section can be removed +as well, I section or C section> is not +specified: B can see that it needs to generate a function call +section, and will autogenerate the OUTPUT section too. Thus one can +shortcut the XSUB to become: + + double + foo(a,b,c) + int a + long b + const char * c + +Can we do the same with an XSUB + + int + is_even(input) + int input + CODE: + RETVAL = (input % 2 == 0); + OUTPUT: + RETVAL + +of L<"EXAMPLE 2">? To do this, one needs to define a C function C. As we saw in L, a proper place +for this definition is in the first part of .xs file. In fact a C function + + int + is_even(int arg) + { + return (arg % 2 == 0); + } + +is probably overkill for this. Something as simple as a C<#define> will +do too: + + #define is_even(arg) ((arg) % 2 == 0) + +After having this in the first part of .xs file, the "Perl glue" part becomes +as simple as + + int + is_even(input) + int input + +This technique of separation of the glue part from the workhorse part has +obvious tradeoffs: if you want to change a Perl interface, you need to +change two places in your code. However, it removes a lot of clutter, +and makes the workhorse part independent from idiosyncrasies of Perl calling +convention. (In fact, there is nothing Perl-specific in the above description, +a different version of B might have translated this to TCL glue or +Python glue as well.) + +=head2 More about XSUB arguments With the completion of Example 4, we now have an easy way to simulate some real-life libraries whose interfaces may not be the cleanest in the world. We shall now continue with a discussion of the arguments passed to the -xsubpp compiler. +B compiler. When you specify arguments to routines in the .xs file, you are really passing three pieces of information for each argument listed. The first piece is the order of that argument relative to the others (first, second, etc). The second is the type of argument, and consists of the type declaration of the argument (e.g., int, char*, etc). The third piece is -the exact way in which the argument should be used in the call to the -library function from this XSUB. This would mean whether or not to place -a "&" before the argument or not, meaning the argument expects to be -passed the address of the specified data type. +the calling convention for the argument in the call to the library function. + +While Perl passes arguments to functions by reference, +C passes arguments by value; to implement a C function which modifies data +of one of the "arguments", the actual argument of this C function would be +a pointer to the data. Thus two C functions with declarations + + int string_length(char *s); + int upper_case_char(char *cp); + +may have completely different semantics: the first one may inspect an array +of chars pointed by s, and the second one may immediately dereference C +and manipulate C<*cp> only (using the return value as, say, a success +indicator). From Perl one would use these functions in +a completely different manner. + +One conveys this info to B by replacing C<*> before the +argument by C<&>. C<&> means that the argument should be passed to a library +function by its address. The above two function may be XSUB-ified as + + int + string_length(s) + char * s + + int + upper_case_char(cp) + char &cp -There is a difference between the two arguments in this hypothetical function: +For example, consider: int foo(a,b) char &a char * b -The first argument to this function would be treated as a char and assigned +The first Perl argument to this function would be treated as a char and assigned to the variable a, and its address would be passed into the function foo. -The second argument would be treated as a string pointer and assigned to the +The second Perl argument would be treated as a string pointer and assigned to the variable b. The I of b would be passed into the function foo. The -actual call to the function foo that xsubpp generates would look like this: +actual call to the function foo that B generates would look like this: foo(&a, b); -Xsubpp will parse the following function argument lists identically: +B will parse the following function argument lists identically: char &a char&a @@ -706,7 +863,7 @@ on the argument stack. ST(0) is thus the first argument on the stack and therefore the first argument passed to the XSUB, ST(1) is the second argument, and so on. -When you list the arguments to the XSUB in the .xs file, that tells xsubpp +When you list the arguments to the XSUB in the .xs file, that tells B which argument corresponds to which of the argument stack (i.e., the first one listed is the first argument, and so on). You invite disaster if you do not list them in the same order as the function expects them. @@ -724,6 +881,23 @@ The code for the round() XSUB routine contains lines that look like this: The arg variable is initially set by taking the value from ST(0), then is stored back into ST(0) at the end of the routine. +XSUBs are also allowed to return lists, not just scalars. This must be +done by manipulating stack values ST(0), ST(1), etc, in a subtly +different way. See L for details. + +XSUBs are also allowed to avoid automatic conversion of Perl function arguments +to C function arguments. See L for details. Some people prefer +manual conversion by inspecting C even in the cases when automatic +conversion will do, arguing that this makes the logic of an XSUB call clearer. +Compare with L<"Getting the fat out of XSUBs"> for a similar tradeoff of +a complete separation of "Perl glue" and "workhorse" parts of an XSUB. + +While experts may argue about these idioms, a novice to Perl guts may +prefer a way which is as little Perl-guts-specific as possible, meaning +automatic conversion and automatic call generation, as in +L<"Getting the fat out of XSUBs">. This approach has the additional +benefit of protecting the XSUB writer from future changes to the Perl API. + =head2 Extending your Extension Sometimes you might want to provide some extra methods or subroutines @@ -781,7 +955,7 @@ Mytest.xs: void statfs(path) char * path - PREINIT: + INIT: int i; struct statfs buf; @@ -822,10 +996,12 @@ This example added quite a few new concepts. We'll take them one at a time. =item * -The PREINIT: directive contains code that will be placed immediately after -variable declaration and before the argument stack is decoded. Some compilers -cannot handle variable declarations at arbitrary locations inside a function, +The INIT: directive contains code that will be placed immediately after +the argument stack is decoded. C does not allow variable declarations at +arbitrary locations inside a function, so this is usually the best way to declare local variables needed by the XSUB. +(Alternatively, one could put the whole C section into braces, and +put these declarations on top.) =item * @@ -837,7 +1013,7 @@ this function, we need room on the stack to hold the 9 values which may be returned. We do this by using the PPCODE: directive, rather than the CODE: directive. -This tells xsubpp that we will be managing the return values that will be +This tells B that we will be managing the return values that will be put on the argument stack by ourselves. =item * @@ -846,7 +1022,8 @@ When we want to place values to be returned to the caller onto the stack, we use the series of macros that begin with "XPUSH". There are five different versions, for placing integers, unsigned integers, doubles, strings, and Perl scalars on the stack. In our example, we placed a -Perl scalar onto the stack. +Perl scalar onto the stack. (In fact this is the only macro which +can be used to return multiple values.) The XPUSH* macros will automatically extend the return stack to prevent it from being overrun. You push values onto the stack in the order you @@ -860,6 +1037,22 @@ program, the SV's that held the returned values can be deallocated. If they were not mortal, then they would continue to exist after the XSUB routine returned, but would not be accessible. This is a memory leak. +=item * + +If we were interested in performance, not in code compactness, in the success +branch we would not use C macros, but C macros, and would +pre-extend the stack before pushing the return values: + + EXTEND(SP, 9); + +The tradeoff is that one needs to calculate the number of return values +in advance (though overextending the stack will not typically hurt +anything but memory consumption). + +Similarly, in the failure branch we could use C I extending +the stack: the Perl function reference comes to an XSUB on the stack, thus +the stack is I large enough to take one return value. + =back =head2 EXAMPLE 6 (Coming Soon) @@ -930,4 +1123,4 @@ and Tim Bunce. =head2 Last Changed -1999/5/25 +1999/11/30 diff --git a/pod/pod2man.PL b/pod/pod2man.PL index 20610a8..4312e9f 100644 --- a/pod/pod2man.PL +++ b/pod/pod2man.PL @@ -9,7 +9,6 @@ use Cwd; # have to mention them as if they were shell variables, not # %Config entries. Thus you write # $startperl -# $man3ext # to ensure Configure will look for $Config{startperl}. # This forces PL files to create target in same directory as PL file. @@ -29,1206 +28,440 @@ print "Extracting $file (with variable substitutions)\n"; print OUT <<"!GROK!THIS!"; $Config{startperl} eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}' - if \$running_under_some_shell; - -\$DEF_PM_SECTION = '$Config{man3ext}' || '3'; + if \$running_under_some_shell; !GROK!THIS! # In the following, perl variables are not expanded during extraction. print OUT <<'!NO!SUBS!'; -=head1 NAME - -pod2man - translate embedded Perl pod directives into man pages - -=head1 SYNOPSIS - -B -[ B<--section=>I ] -[ B<--release=>I ] -[ B<--center=>I ] -[ B<--date=>I ] -[ B<--fixed=>I ] -[ B<--official> ] -[ B<--lax> ] -I - -=head1 DESCRIPTION - -B converts its input file containing embedded pod directives (see -L) into nroff source suitable for viewing with nroff(1) or -troff(1) using the man(7) macro set. - -Besides the obvious pod conversions, B also takes care of -func(), func(n), and simple variable references like $foo or @bar so -you don't have to use code escapes for them; complex expressions like -C<$fred{'stuff'}> will still need to be escaped, though. Other nagging -little roffish things that it catches include translating the minus in -something like foo-bar, making a long dash--like this--into a real em -dash, fixing up "paired quotes", putting a little space after the -parens in something like func(), making C++ and PI look right, making -double underbars have a little tiny space between them, making ALLCAPS -a teeny bit smaller in troff(1), and escaping backslashes so you don't -have to. - -=head1 OPTIONS - -=over 8 - -=item center - -Set the centered header to a specific string. The default is -"User Contributed Perl Documentation", unless the C<--official> flag is -given, in which case the default is "Perl Programmers Reference Guide". - -=item date - -Set the left-hand footer string to this value. By default, -the modification date of the input file will be used. - -=item fixed - -The fixed font to use for code refs. Defaults to CW. - -=item official - -Set the default header to indicate that this page is of -the standard release in case C<--center> is not given. - -=item release - -Set the centered footer. By default, this is the current -perl release. - -=item section - -Set the section for the C<.TH> macro. The standard conventions on -sections are to use 1 for user commands, 2 for system calls, 3 for -functions, 4 for devices, 5 for file formats, 6 for games, 7 for -miscellaneous information, and 8 for administrator commands. This works -best if you put your Perl man pages in a separate tree, like -F. By default, section 1 will be used -unless the file ends in F<.pm> in which case section 3 will be selected. - -=item lax - -Don't complain when required sections aren't present. - -=back - -=head1 Anatomy of a Proper Man Page - -For those not sure of the proper layout of a man page, here's -an example of the skeleton of a proper man page. Head of the -major headers should be setout as a C<=head1> directive, and -are historically written in the rather startling ALL UPPER CASE -format, although this is not mandatory. -Minor headers may be included using C<=head2>, and are -typically in mixed case. - -=over 10 - -=item NAME +# pod2man -- Convert POD data to formatted *roff input. +# +# Copyright 1999 by Russ Allbery +# +# This program is free software; you can redistribute it and/or modify it +# under the same terms as Perl itself. +# +# The driver script for Pod::Man. This script is expected to eventually +# replace pod2man in the standard Perl distribution. + +require 5.004; + +use Getopt::Long qw(GetOptions); +use Pod::Man (); +use Pod::Usage qw(pod2usage); + +use strict; +use vars; + +# Parse our options, trying to retain backwards compatibility with pod2man +# but allowing short forms as well. --lax is currently ignored. +my %options; +Getopt::Long::config ('bundling'); +GetOptions (\%options, 'section|s=s', 'release|r=s', 'center|c=s', + 'date|d=s', 'fixed=s', 'fixedbold=s', 'fixeditalic=s', + 'fixedbolditalic=s', 'official|o', 'lax|l', 'help|h') or exit 1; +pod2usage (0) if $options{help}; + +# Official sets --center, but don't override things explicitly set. +if ($options{official} && !defined $options{center}) { + $options{center} = 'Perl Programmers Reference Guide'; +} -Mandatory section; should be a comma-separated list of programs or -functions documented by this podpage, such as: +# Initialize and run the formatter. +my $parser = Pod::Man->new (%options); +$parser->parse_from_file (@ARGV); - foo, bar - programs to do something +__END__ -=item SYNOPSIS +=head1 NAME -A short usage summary for programs and functions, which -may someday be deemed mandatory. +pod2man - Convert POD data to formatted *roff input -=item DESCRIPTION +=head1 SYNOPSIS -Long drawn out discussion of the program. It's a good idea to break this -up into subsections using the C<=head2> directives, like +pod2txt [B<--section>=I] [B<--release>=I] +[B<--center>=I] [B<--date>=I] [B<--fixed>=I] +[B<--fixedbold>=I] [B<--fixeditalic>=I] +[B<--fixedbolditalic>=I] [B<--official>] [B<--lax>] [I +[I]] - =head2 A Sample Subection +pod2txt B<--help> - =head2 Yet Another Sample Subection +=head1 DESCRIPTION -=item OPTIONS +B is a front-end for Pod::Man, using it to generate *roff input +from POD source. The resulting *roff code is suitable for display on a +terminal using nroff(1), normally via man(1), or printing using troff(1). + +I is the file to read for POD source (the POD can be embedded in +code). If I isn't given, it defaults to STDIN. I, if given, +is the file to which to write the formatted output. If I isn't +given, the formatted output is written to STDOUT. + +B<--section>, B<--release>, B<--center>, B<--date>, and B<--official> can be +used to set the headers and footers to use; if not given, Pod::Man will +assume various defaults. See below or L for details. + +B assumes that your *roff formatters have a fixed-width font named +CW. If yours is called something else (like CR), use B<--fixed> to specify +it. This generally only matters for troff output for printing. Similarly, +you can set the fonts used for bold, italic, and bold italic fixed-width +output. + +Besides the obvious pod conversions, Pod::Man, and therefore pod2man also +takes care of formatting func(), func(n), and simple variable references +like $foo or @bar so you don't have to use code escapes for them; complex +expressions like C<$fred{'stuff'}> will still need to be escaped, though. +It also translates dashes that aren't used as hyphens into en dashes, makes +long dashes--like this--into proper em dashes, fixes "paired quotes," and +takes care of several other troff-specific tweaks. See L for +complete information. -Some people make this separate from the description. +=head1 OPTIONS -=item RETURN VALUE +=over 4 -What the program or function returns if successful. +=item B<-c> I, B<--center>=I -=item ERRORS +Sets the centered page header to I. The default is "User +Contributed Perl Documentation", but also see B<--official> below. -Exceptions, return codes, exit stati, and errno settings. +=item B<-d> I, B<--date>=I -=item EXAMPLES +Set the left-hand footer string to this value. By default, the modification +date of the input file will be used, or the current date if input comes from +STDIN. -Give some example uses of the program. +=item B<--fixed>=I -=item ENVIRONMENT +The fixed-width font to use for vertabim text and code. Defaults to CW. +Some systems may want CR instead. Only matters for troff(1) output. -Envariables this program might care about. +=item B<--fixedbold>=I -=item FILES +Bold version of the fixed-width font. Defaults to CB. Only matters for +troff(1) output. -All files used by the program. You should probably use the FEE -for these. +=item B<--fixeditalic>=I -=item SEE ALSO +Italic version of the fixed-width font (actually, something of a misnomer, +since most fixed-width fonts only have an oblique version, not an italic +version). Defaults to CI. Only matters for troff(1) output. -Other man pages to check out, like man(1), man(7), makewhatis(8), or catman(8). +=item B<--fixedbolditalic>=I -=item NOTES +Bold italic (probably actually oblique) version of the fixed-width font. +Pod::Man doesn't assume you have this, and defaults to CB. Some systems +(such as Solaris) have this font available as CX. Only matters for troff(1) +output. -Miscellaneous commentary. +=item B<-h>, B<--help> -=item CAVEATS +Print out usage information. -Things to take special care with; sometimes called WARNINGS. +=item B<-l>, B<--lax> -=item DIAGNOSTICS +Don't complain when required sections are missing. Not currently used, as +POD checking functionality is not yet implemented in Pod::Man. -All possible messages the program can print out--and -what they mean. +=item B<-o>, B<--official> -=item BUGS +Set the default header to indicate that this page is part of the standard +Perl release, if B<--center> is not also given. -Things that are broken or just don't work quite right. +=item B<-r>, B<--release> -=item RESTRICTIONS +Set the centered footer. By default, this is the version of Perl you run +B under. Note that some system an macro sets assume that the +centered footer will be a modification date and will prepend something like +"Last modified: "; if this is the case, you may want to set B<--release> to +the last modified date and B<--date> to the version number. -Bugs you don't plan to fix :-) +=item B<-s>, B<--section> -=item AUTHOR +Set the section for the C<.TH> macro. The standard section numbering +convention is to use 1 for user commands, 2 for system calls, 3 for +functions, 4 for devices, 5 for file formats, 6 for games, 7 for +miscellaneous information, and 8 for administrator commands. There is a lot +of variation here, however; some systems (like Solaris) use 4 for file +formats, 5 for miscellaneous information, and 7 for devices. Still others +use 1m instead of 8, or some mix of both. About the only section numbers +that are reliably consistent are 1, 2, and 3. -Who wrote it (or AUTHORS if multiple). +By default, section 1 will be used unless the file ends in .pm in which case +section 3 will be selected. -=item HISTORY +=back -Programs derived from other sources sometimes have this, or -you might keep a modification log here. +=head1 DIAGNOSTICS -=back +If B fails with errors, see L and L for +information about what those errors might mean. =head1 EXAMPLES pod2man program > program.1 - pod2man some_module.pm > /usr/perl/man/man3/some_module.3 + pod2man SomeModule.pm /usr/perl/man/man3/SomeModule.3 pod2man --section=7 note.pod > note.7 -=head1 DIAGNOSTICS +If you would like to print out a lot of man page continuously, you probably +want to set the C and D registers to set contiguous page numbering and +even/odd paging, at least on some versions of man(7). -The following diagnostics are generated by B. Items -marked "(W)" are non-fatal, whereas the "(F)" errors will cause -B to immediately exit with a non-zero status. + troff -man -rC1 -rD1 perl.1 perldata.1 perlsyn.1 ... -=over 4 +To get index entries on stderr, turn on the F register, as in: -=item bad option in paragraph %d of %s: ``%s'' should be [%s]<%s> + troff -man -rF1 perl.1 -(W) If you start include an option, you should set it off -as bold, italic, or code. +The indexing merely outputs messages via C<.tm> for each major page, +section, subsection, item, and any CE> directives. See +L for more details. -=item can't open %s: %s +=head1 BUGS -(F) The input file wasn't available for the given reason. +Lots of this documentation is duplicated from L. -=item Improper man page - no dash in NAME header in paragraph %d of %s +POD checking and the corresponding B<--lax> option don't work yet. -(W) The NAME header did not have an isolated dash in it. This is -considered important. +=head1 NOTES -=item Invalid man page - no NAME line in %s +For those not sure of the proper layout of a man page, here are some notes +on writing a proper man page. -(F) You did not include a NAME header, which is essential. +The name of the program being documented is conventionally written in bold +(using BEE) wherever it occurs, as are all program options. +Arguments should be written in italics (IEE). Functions are +traditionally written in italics; if you write a function as function(), +Pod::Man will take care of this for you. Literal code or commands should +be in CEE. References to other man pages should be in the form +C, and Pod::Man will automatically format those +appropriately. As an exception, it's traditional not to use this form when +referring to module documentation; use CModule::NameE> instead. -=item roff font should be 1 or 2 chars, not `%s' (F) +References to other programs or functions are normally in the form of man +page references so that cross-referencing tools can provide the user with +links and the like. It's possible to overdo this, though, so be careful not +to clutter your documentation with too much markup. -(F) The font specified with the C<--fixed> option was not -a one- or two-digit roff font. +The major headers should be set out using a C<=head1> directive, and are +historically written in the rather startling ALL UPPER CASE format, although +this is not mandatory. Minor headers may be included using C<=head2>, and +are typically in mixed case. -=item %s is missing required section: %s +The standard sections of a manual page are: -(W) Required sections include NAME, DESCRIPTION, and if you're -using a section starting with a 3, also a SYNOPSIS. Actually, -not having a NAME is a fatal. +=over 4 -=item Unknown escape: %s in %s +=item NAME -(W) An unknown HTML entity (probably for an 8-bit character) was given via -a CE> directive. Besides amp, lt, gt, and quot, recognized -entities are Aacute, aacute, Acirc, acirc, AElig, aelig, Agrave, agrave, -Aring, aring, Atilde, atilde, Auml, auml, Ccedil, ccedil, Eacute, eacute, -Ecirc, ecirc, Egrave, egrave, ETH, eth, Euml, euml, Iacute, iacute, Icirc, -icirc, Igrave, igrave, Iuml, iuml, Ntilde, ntilde, Oacute, oacute, Ocirc, -ocirc, Ograve, ograve, Oslash, oslash, Otilde, otilde, Ouml, ouml, szlig, -THORN, thorn, Uacute, uacute, Ucirc, ucirc, Ugrave, ugrave, Uuml, uuml, -Yacute, yacute, and yuml. +Mandatory section; should be a comma-separated list of programs or functions +documented by this podpage, such as: -=item Unmatched =back + foo, bar - programs to do something -(W) You have a C<=back> without a corresponding C<=over>. +Manual page indexers are often extremely picky about the format of this +section, so don't put anything in it except this line. A single dash, and +only a single dash, should separate the list of programs or functions from +the description. Functions should not be qualified with C<()> or the like. +The description should ideally fit on a single line, even if a man program +replaces the dash with a few tabs. -=item Unrecognized pod directive: %s +=item SYNOPSIS -(W) You specified a pod directive that isn't in the known list of -C<=head1>, C<=head2>, C<=item>, C<=over>, C<=back>, or C<=cut>. +A short usage summary for programs and functions. This section is mandatory +for section 3 pages. +=item DESCRIPTION -=back +Extended description and discussion of the program or functions, or the body +of the documentation for man pages that document something else. If +particularly long, it's a good idea to break this up into subsections +C<=head2> directives like: -=head1 NOTES + =head2 Normal Usage -If you would like to print out a lot of man page continuously, you -probably want to set the C and D registers to set contiguous page -numbering and even/odd paging, at least on some versions of man(7). -Settting the F register will get you some additional experimental -indexing: + =head2 Advanced Features - troff -man -rC1 -rD1 -rF1 perl.1 perldata.1 perlsyn.1 ... + =head2 Writing Configuration Files -The indexing merely outputs messages via C<.tm> for each -major page, section, subsection, item, and any CE> -directives. +or whatever is appropriate for your documentation. +=item OPTIONS -=head1 RESTRICTIONS +Detailed description of each of the command-line options taken by the +program. This should be separate from the description for the use of things +like L. This is normally presented as a list, with +each option as a separate C<=item>. The specific option string should be +enclosed in BEE. Any values that the option takes should be +enclosed in IEE. For example, the section for the option +B<--section>=I would be introduced with: -None at this time. + =item B<--section>=I -=head1 BUGS +Synonymous options (like both the short and long forms) are separated by a +comma and a space on the same C<=item> line, or optionally listed as their +own item with a reference to the canonical name. For example, since +B<--section> can also be written as B<-s>, the above would be: -The =over and =back directives don't really work right. They -take absolute positions instead of offsets, don't nest well, and -making people count is suboptimal in any event. + =item B<-s> I, B<--section>=I -=head1 AUTHORS +(Writing the short option first is arguably easier to read, since the long +option is long enough to draw the eye to it anyway and the short option can +otherwise get lost in visual noise.) -Original prototype by Larry Wall, but so massively hacked over by -Tom Christiansen such that Larry probably doesn't recognize it anymore. +=item RETURN VALUE -=cut +What the program or function returns, if successful. This section can be +omitted for programs whose precise exit codes aren't important, provided +they return 0 on success as is standard. It should always be present for +functions. -$/ = ""; -$cutting = 1; -@Indices = (); - -# We try first to get the version number from a local binary, in case we're -# running an installed version of Perl to produce documentation from an -# uninstalled newer version's pod files. -if ($^O ne 'plan9' and $^O ne 'dos' and $^O ne 'os2' and $^O ne 'MSWin32') { - my $perl = (-x './perl' && -f './perl' ) ? - './perl' : - ((-x '../perl' && -f '../perl') ? - '../perl' : - ''); - ($version,$patch) = `$perl -e 'print $]'` =~ /^(\d\.\d{3})(\d{2})?/ if $perl; -} -# No luck; we'll just go with the running Perl's version -($version,$patch) = $] =~ /^(.{5})(\d{2})?/ unless $version; -$DEF_RELEASE = "perl $version"; -$DEF_RELEASE .= ", patch $patch" if $patch; - - -sub makedate { - my $secs = shift; - my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($secs); - my $mname = (qw{Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec})[$mon]; - $year += 1900; - return "$mday/$mname/$year"; -} +=item ERRORS -use Getopt::Long; - -$DEF_SECTION = 1; -$DEF_CENTER = "User Contributed Perl Documentation"; -$STD_CENTER = "Perl Programmers Reference Guide"; -$DEF_FIXED = 'CW'; -$DEF_LAX = 0; - -sub usage { - warn "$0: @_\n" if @_; - die <, C<=item>, and C<=back>. For example: + =over 6 -$name = @ARGV ? $ARGV[0] : ""; -$Filename = $name; -if ($section =~ /^1/) { - require File::Basename; - $name = uc File::Basename::basename($name); -} -$name =~ s/\.(pod|p[lm])$//i; - -# Lose everything up to the first of -# */lib/*perl* standard or site_perl module -# */*perl*/lib from -D prefix=/opt/perl -# */*perl*/ random module hierarchy -# which works. -$name =~ s-//+-/-g; -if ($name =~ s-^.*?/lib/[^/]*perl[^/]*/--i - or $name =~ s-^.*?/[^/]*perl[^/]*/lib/--i - or $name =~ s-^.*?/[^/]*perl[^/]*/--i) { - # Lose ^site(_perl)?/. - $name =~ s-^site(_perl)?/--; - # Lose ^arch/. (XXX should we use Config? Just for archname?) - $name =~ s~^(.*-$^O|$^O-.*)/~~o; - # Lose ^version/. - $name =~ s-^\d+\.\d+/--; -} + =item HOME -# Translate Getopt/Long to Getopt::Long, etc. -$name =~ s(/)(::)g; - -if ($name ne 'something') { - FCHECK: { - open(F, "< $ARGV[0]") || die "can't open $ARGV[0]: $!"; - while () { - next unless /^=\b/; - if (/^=head1\s+NAME\s*$/) { # an /m would forgive mistakes - $_ = ; - unless (/\s*-+\s+/) { - $oops++; - warn "$0: Improper man page - no dash in NAME header in paragraph $. of $ARGV[0]\n" - } else { - my @n = split /\s+-+\s+/; - if (@n != 2) { - $oops++; - warn "$0: Improper man page - malformed NAME header in paragraph $. of $ARGV[0]\n" - } - else { - %namedesc = @n; - } - } - last FCHECK; - } - next if /^=cut\b/; # DB_File and Net::Ping have =cut before NAME - next if /^=pod\b/; # It is OK to have =pod before NAME - die "$0: Invalid man page - 1st pod line is not NAME in $ARGV[0]\n" unless $lax; - } - die "$0: Invalid man page - no documentation in $ARGV[0]\n" unless $lax; - } - close F; -} + Used to determine the user's home directory. F<.foorc> in this + directory is read for configuration details, if it exists. -print <<"END"; -.rn '' }` -''' \$RCSfile\$\$Revision\$\$Date\$ -''' -''' \$Log\$ -''' -.de Sh -.br -.if t .Sp -.ne 5 -.PP -\\fB\\\\\$1\\fR -.PP -.. -.de Sp -.if t .sp .5v -.if n .sp -.. -.de Ip -.br -.ie \\\\n(.\$>=3 .ne \\\\\$3 -.el .ne 3 -.IP "\\\\\$1" \\\\\$2 -.. -.de Vb -.ft $CFont -.nf -.ne \\\\\$1 -.. -.de Ve -.ft R - -.fi -.. -''' -''' -''' Set up \\*(-- to give an unbreakable dash; -''' string Tr holds user defined translation string. -''' Bell System Logo is used as a dummy character. -''' -.tr \\(*W-|\\(bv\\*(Tr -.ie n \\{\\ -.ds -- \\(*W- -.ds PI pi -.if (\\n(.H=4u)&(1m=24u) .ds -- \\(*W\\h'-12u'\\(*W\\h'-12u'-\\" diablo 10 pitch -.if (\\n(.H=4u)&(1m=20u) .ds -- \\(*W\\h'-12u'\\(*W\\h'-8u'-\\" diablo 12 pitch -.ds L" "" -.ds R" "" -''' \\*(M", \\*(S", \\*(N" and \\*(T" are the equivalent of -''' \\*(L" and \\*(R", except that they are used on ".xx" lines, -''' such as .IP and .SH, which do another additional levels of -''' double-quote interpretation -.ds M" """ -.ds S" """ -.ds N" """"" -.ds T" """"" -.ds L' ' -.ds R' ' -.ds M' ' -.ds S' ' -.ds N' ' -.ds T' ' -'br\\} -.el\\{\\ -.ds -- \\(em\\| -.tr \\*(Tr -.ds L" `` -.ds R" '' -.ds M" `` -.ds S" '' -.ds N" `` -.ds T" '' -.ds L' ` -.ds R' ' -.ds M' ` -.ds S' ' -.ds N' ` -.ds T' ' -.ds PI \\(*p -'br\\} -END - -print <<'END'; -.\" If the F register is turned on, we'll generate -.\" index entries out stderr for the following things: -.\" TH Title -.\" SH Header -.\" Sh Subsection -.\" Ip Item -.\" X<> Xref (embedded -.\" Of course, you have to process the output yourself -.\" in some meaninful fashion. -.if \nF \{ -.de IX -.tm Index:\\$1\t\\n%\t"\\$2" -.. -.nr % 0 -.rr F -.\} -END - -print <<"END"; -.TH $name $section "$date" "$RP" "$center" -.UC -END - -push(@Indices, qq{.IX Title "$name $section"}); - -while (($name, $desc) = each %namedesc) { - for ($name, $desc) { s/^\s+//; s/\s+$//; } - push(@Indices, qq(.IX Name "$name - $desc"\n)); -} + =back -print <<'END'; -.if n .hy 0 -.if n .na -.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p' -.de CQ \" put $1 in typewriter font -END -print ".ft $CFont\n"; -print <<'END'; -'if n "\c -'if t \\&\\$1\c -'if n \\&\\$1\c -'if n \&" -\\&\\$2 \\$3 \\$4 \\$5 \\$6 \\$7 -'.ft R -.. -.\" @(#)ms.acc 1.5 88/02/08 SMI; from UCB 4.2 -. \" AM - accent mark definitions -.bd B 3 -. \" fudge factors for nroff and troff -.if n \{\ -. ds #H 0 -. ds #V .8m -. ds #F .3m -. ds #[ \f1 -. ds #] \fP -.\} -.if t \{\ -. ds #H ((1u-(\\\\n(.fu%2u))*.13m) -. ds #V .6m -. ds #F 0 -. ds #[ \& -. ds #] \& -.\} -. \" simple accents for nroff and troff -.if n \{\ -. ds ' \& -. ds ` \& -. ds ^ \& -. ds , \& -. ds ~ ~ -. ds ? ? -. ds ! ! -. ds / -. ds q -.\} -.if t \{\ -. ds ' \\k:\h'-(\\n(.wu*8/10-\*(#H)'\'\h"|\\n:u" -. ds ` \\k:\h'-(\\n(.wu*8/10-\*(#H)'\`\h'|\\n:u' -. ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'^\h'|\\n:u' -. ds , \\k:\h'-(\\n(.wu*8/10)',\h'|\\n:u' -. ds ~ \\k:\h'-(\\n(.wu-\*(#H-.1m)'~\h'|\\n:u' -. ds ? \s-2c\h'-\w'c'u*7/10'\u\h'\*(#H'\zi\d\s+2\h'\w'c'u*8/10' -. ds ! \s-2\(or\s+2\h'-\w'\(or'u'\v'-.8m'.\v'.8m' -. ds / \\k:\h'-(\\n(.wu*8/10-\*(#H)'\z\(sl\h'|\\n:u' -. ds q o\h'-\w'o'u*8/10'\s-4\v'.4m'\z\(*i\v'-.4m'\s+4\h'\w'o'u*8/10' -.\} -. \" troff and (daisy-wheel) nroff accents -.ds : \\k:\h'-(\\n(.wu*8/10-\*(#H+.1m+\*(#F)'\v'-\*(#V'\z.\h'.2m+\*(#F'.\h'|\\n:u'\v'\*(#V' -.ds 8 \h'\*(#H'\(*b\h'-\*(#H' -.ds v \\k:\h'-(\\n(.wu*9/10-\*(#H)'\v'-\*(#V'\*(#[\s-4v\s0\v'\*(#V'\h'|\\n:u'\*(#] -.ds _ \\k:\h'-(\\n(.wu*9/10-\*(#H+(\*(#F*2/3))'\v'-.4m'\z\(hy\v'.4m'\h'|\\n:u' -.ds . \\k:\h'-(\\n(.wu*8/10)'\v'\*(#V*4/10'\z.\v'-\*(#V*4/10'\h'|\\n:u' -.ds 3 \*(#[\v'.2m'\s-2\&3\s0\v'-.2m'\*(#] -.ds o \\k:\h'-(\\n(.wu+\w'\(de'u-\*(#H)/2u'\v'-.3n'\*(#[\z\(de\v'.3n'\h'|\\n:u'\*(#] -.ds d- \h'\*(#H'\(pd\h'-\w'~'u'\v'-.25m'\f2\(hy\fP\v'.25m'\h'-\*(#H' -.ds D- D\\k:\h'-\w'D'u'\v'-.11m'\z\(hy\v'.11m'\h'|\\n:u' -.ds th \*(#[\v'.3m'\s+1I\s-1\v'-.3m'\h'-(\w'I'u*2/3)'\s-1o\s+1\*(#] -.ds Th \*(#[\s+2I\s-2\h'-\w'I'u*3/5'\v'-.3m'o\v'.3m'\*(#] -.ds ae a\h'-(\w'a'u*4/10)'e -.ds Ae A\h'-(\w'A'u*4/10)'E -.ds oe o\h'-(\w'o'u*4/10)'e -.ds Oe O\h'-(\w'O'u*4/10)'E -. \" corrections for vroff -.if v .ds ~ \\k:\h'-(\\n(.wu*9/10-\*(#H)'\s-2\u~\d\s+2\h'|\\n:u' -.if v .ds ^ \\k:\h'-(\\n(.wu*10/11-\*(#H)'\v'-.4m'^\v'.4m'\h'|\\n:u' -. \" for low resolution devices (crt and lpr) -.if \n(.H>23 .if \n(.V>19 \ -\{\ -. ds : e -. ds 8 ss -. ds v \h'-1'\o'\(aa\(ga' -. ds _ \h'-1'^ -. ds . \h'-1'. -. ds 3 3 -. ds o a -. ds d- d\h'-1'\(ga -. ds D- D\h'-1'\(hy -. ds th \o'bp' -. ds Th \o'LP' -. ds ae ae -. ds Ae AE -. ds oe oe -. ds Oe OE -.\} -.rm #[ #] #H #V #F C -END - -$indent = 0; - -$begun = ""; - -# Unrolling [^-=A-Z>]|[A-Z](?!<)|[-=](?![A-Z]<)[\x00-\xFF] gives: // MRE pp 165. -my $nonest = q{(?x) # Turn on /x mode. - (?: # Group - [^-=A-Z>]* # Anything that isn't a dash, equal sign or - # closing hook isn't special. Eat as much as - # we can. - (?: # Group. - (?: # Group. - [-=] # We want to recognize -> and =>. - (?![A-Z]<) # So, as long as it isn't followed by markup - [\x00-\xFF] # anything may follow - and = - | - [A-Z] # Capitals are fine too, - (?!<) # But not if they start markup. - ) # End of special sequences. - [^-=A-Z>]* # Followed by zero or more non-special chars. - )* # And we can repeat this as often as we can. - )}; # That's all folks. - -while (<>) { - if ($cutting) { - next unless /^=/; - $cutting = 0; - } - if ($begun) { - if (/^=end\s+$begun/) { - $begun = ""; - } - elsif ($begun =~ /^(roff|man)$/) { - print STDOUT $_; - } - next; - } - chomp; - - # Translate verbatim paragraph - - if (/^\s/) { - @lines = split(/\n/); - for (@lines) { - 1 while s - {^( [^\t]* ) \t ( \t* ) } - { $1 . ' ' x (8 - (length($1)%8) + 8 * (length($2))) }ex; - s/\\/\\e/g; - s/\A/\\&/s; - } - $lines = @lines; - makespace() unless $verbatim++; - print ".Vb $lines\n"; - print join("\n", @lines), "\n"; - print ".Ve\n"; - $needspace = 0; - next; - } - - $verbatim = 0; - - if (/^=for\s+(\S+)\s*/s) { - if ($1 eq "man" or $1 eq "roff") { - print STDOUT $',"\n\n"; - } else { - # ignore unknown for - } - next; - } - elsif (/^=begin\s+(\S+)\s*/s) { - $begun = $1; - if ($1 eq "man" or $1 eq "roff") { - print STDOUT $'."\n\n"; - } - next; - } - - # check for things that'll hosed our noremap scheme; affects $_ - init_noremap(); - - if (!/^=item/) { - - # trofficate backslashes; must do it before what happens below - s/\\/noremap('\\e')/ge; - - # protect leading periods and quotes against *roff - # mistaking them for directives - s/^(?:[A-Z]<)?[.']/\\&$&/gm; - - # first hide the escapes in case we need to - # intuit something and get it wrong due to fmting - - 1 while s/([A-Z]<$nonest>)/noremap($1)/ge; - - # func() is a reference to a perl function - s{ - \b - ( - [:\w]+ \(\) - ) - } {I<$1>}gx; - - # func(n) is a reference to a perl function or a man page - s{ - ([:\w]+) - ( - \( [^\051]+ \) - ) - } {I<$1>\\|$2}gx; - - # convert simple variable references - s/(\s+)([\$\@%&*][\w:]+)(?!\()/${1}C<$2>/g; - - if (m{ ( - [\-\w]+ - \( - [^\051]*? - [\@\$,] - [^\051]*? - \) - ) - }x && $` !~ /([LCI]<[^<>]*|-)$/ && !/^=\w/) - { - warn "$0: bad option in paragraph $. of $ARGV: ``$1'' should be [LCI]<$1>\n"; - $oops++; - } - - while (/(-[a-zA-Z])\b/g && $` !~ /[\w\-]$/) { - warn "$0: bad option in paragraph $. of $ARGV: ``$1'' should be [CB]<$1>\n"; - $oops++; - } - - # put it back so we get the <> processed again; - clear_noremap(0); # 0 means leave the E's - - } else { - # trofficate backslashes - s/\\/noremap('\\e')/ge; - - } - - # need to hide E<> first; they're processed in clear_noremap - s/(E<[^<>]+>)/noremap($1)/ge; - - - $maxnest = 10; - while ($maxnest-- && /[A-Z]/font($1) . $2 . font('R')/eg; - - # files and filelike refs in italics - s/F<($nonest)>/I<$1>/g; - - # no break -- usually we want C<> for this - s/S<($nonest)>/nobreak($1)/eg; - - # LREF: a la HREF L - s:L<([^|>]+)\|[^>]+>:$1:g; - - # LREF: a manpage(3f) - s:L<([a-zA-Z][^\s\/]+)(\([^\)]+\))?>:the I<$1>$2 manpage:g; - - # LREF: an =item on another manpage - s{ - L< - ([^/]+) - / - ( - [:\w]+ - (\(\))? - ) - > - } {the C<$2> entry in the I<$1> manpage}gx; - - # LREF: an =item on this manpage - s{ - ((?: - L< - / - ( - [:\w]+ - (\(\))? - ) - > - (,?\s+(and\s+)?)? - )+) - } { internal_lrefs($1) }gex; - - # LREF: a =head2 (head1?), maybe on a manpage, maybe right here - # the "func" can disambiguate - s{ - L< - (?: - ([a-zA-Z]\S+?) / - )? - "?(.*?)"? - > - }{ - do { - $1 # if no $1, assume it means on this page. - ? "the section on I<$2> in the I<$1> manpage" - : "the section on I<$2>" - } - }gesx; # s in case it goes over multiple lines, so . matches \n - - s/Z<>/\\&/g; - - # comes last because not subject to reprocessing - s/C<($nonest)>/noremap("${CFont_embed}${1}\\fR")/eg; - } - - if (s/^=//) { - $needspace = 0; # Assume this. - - s/\n/ /g; - - ($Cmd, $_) = split(' ', $_, 2); - - $dotlevel = 1; - if ($Cmd eq 'head1') { - $dotlevel = 1; - } - elsif ($Cmd eq 'head2') { - $dotlevel = 1; - } - elsif ($Cmd eq 'item') { - $dotlevel = 2; - } - - if (defined $_) { - &escapes($dotlevel); - s/"/""/g; - } - - clear_noremap(1); - - if ($Cmd eq 'cut') { - $cutting = 1; - } - elsif ($Cmd eq 'head1') { - s/\s+$//; - delete $wanna_see{$_} if exists $wanna_see{$_}; - print qq{.SH "$_"\n}; - push(@Indices, qq{.IX Header "$_"\n}); - } - elsif ($Cmd eq 'head2') { - print qq{.Sh "$_"\n}; - push(@Indices, qq{.IX Subsection "$_"\n}); - } - elsif ($Cmd eq 'over') { - push(@indent,$indent); - $indent += ($_ + 0) || 5; - } - elsif ($Cmd eq 'back') { - $indent = pop(@indent); - warn "$0: Unmatched =back in paragraph $. of $ARGV\n" unless defined $indent; - $needspace = 1; - } - elsif ($Cmd eq 'item') { - s/^\*( |$)/\\(bu$1/g; - # if you know how to get ":s please do - s/\\\*\(L"([^"]+?)\\\*\(R"/'$1'/g; - s/\\\*\(L"([^"]+?)""/'$1'/g; - s/[^"]""([^"]+?)""[^"]/'$1'/g; - # here do something about the $" in perlvar? - print STDOUT qq{.Ip "$_" $indent\n}; - push(@Indices, qq{.IX Item "$_"\n}); - } - elsif ($Cmd eq 'pod') { - # this is just a comment - } - else { - warn "$0: Unrecognized pod directive in paragraph $. of $ARGV: $Cmd\n"; - } - } - else { - if ($needspace) { - &makespace; - } - &escapes(0); - clear_noremap(1); - print $_, "\n"; - $needspace = 1; - } -} +Since environment variables are normally in all uppercase, no additional +special formatting is generally needed; they're glaring enough as it is. -print <<"END"; +=item FILES -.rn }` '' -END +All files used by the program or function, normally presented as a list, and +what it uses them for. File names should be enclosed in FEE. It's +particularly important to document files that will be potentially modified. -if (%wanna_see && !$lax) { - @missing = keys %wanna_see; - warn "$0: $Filename is missing required section" - . (@missing > 1 && "s") - . ": @missing\n"; - $oops++; -} +=item CAVEATS -foreach (@Indices) { print "$_\n"; } +Things to take special care with, sometimes called WARNINGS. -exit; -#exit ($oops != 0); +=item BUGS -######################################################################### +Things that are broken or just don't work quite right. -sub nobreak { - my $string = shift; - $string =~ s/ /\\ /g; - $string; -} +=item RESTRICTIONS -sub escapes { - my $indot = shift; - - s/X<(.*?)>/mkindex($1)/ge; - - # translate the minus in foo-bar into foo\-bar for roff - s/([^0-9a-z-])-([^-])/$1\\-$2/g; - - # make -- into the string version \*(-- (defined above) - s/\b--\b/\\*(--/g; - s/"--([^"])/"\\*(--$1/g; # should be a better way - s/([^"])--"/$1\\*(--"/g; - - # fix up quotes; this is somewhat tricky - my $dotmacroL = 'L'; - my $dotmacroR = 'R'; - if ( $indot == 1 ) { - $dotmacroL = 'M'; - $dotmacroR = 'S'; - } - elsif ( $indot >= 2 ) { - $dotmacroL = 'N'; - $dotmacroR = 'T'; - } - if (!/""/) { - s/(^|\s)(['"])/noremap("$1\\*($dotmacroL$2")/ge; - s/(['"])($|[\-\s,;\\!?.])/noremap("\\*($dotmacroR$1$2")/ge; - } - - #s/(?!")(?:.)--(?!")(?:.)/\\*(--/g; - #s/(?:(?!")(?:.)--(?:"))|(?:(?:")--(?!")(?:.))/\\*(--/g; - - - # make sure that func() keeps a bit a space tween the parens - ### s/\b\(\)/\\|()/g; - ### s/\b\(\)/(\\|)/g; - - # make C++ into \*C+, which is a squinched version (defined above) - s/\bC\+\+/\\*(C+/g; - - # make double underbars have a little tiny space between them - s/__/_\\|_/g; - - # PI goes to \*(PI (defined above) - s/\bPI\b/noremap('\\*(PI')/ge; - - # make all caps a teeny bit smaller, but don't muck with embedded code literals - my $hidCFont = font('C'); - if ($Cmd !~ /^head1/) { # SH already makes smaller - # /g isn't enough; 1 while or we'll be off - -# 1 while s{ -# (?!$hidCFont)(..|^.|^) -# \b -# ( -# [A-Z][\/A-Z+:\-\d_$.]+ -# ) -# (s?) -# \b -# } {$1\\s-1$2\\s0}gmox; - - 1 while s{ - (?!$hidCFont)(..|^.|^) - ( - \b[A-Z]{2,}[\/A-Z+:\-\d_\$]*\b - ) - } { - $1 . noremap( '\\s-1' . $2 . '\\s0' ) - }egmox; - - } -} +Bugs you don't plan to fix. :-) -# make troff just be normal, but make small nroff get quoted -# decided to just put the quotes in the text; sigh; -sub ccvt { - local($_,$prev) = @_; - noremap(qq{.CQ "$_" \n\\&}); -} +=item NOTES -sub makespace { - if ($indent) { - print ".Sp\n"; - } - else { - print ".PP\n"; - } -} +Miscellaneous commentary. -sub mkindex { - my ($entry) = @_; - my @entries = split m:\s*/\s*:, $entry; - push @Indices, ".IX Xref " . join ' ', map {qq("$_")} @entries; - return ''; -} +=item SEE ALSO -sub font { - local($font) = shift; - return '\\f' . noremap($font); -} +Other man pages to check out, like man(1), man(7), makewhatis(8), or +catman(8). Normally a simple list of man pages separated by commas, or a +paragraph giving the name of a reference work. Man page references, if they +use the standard C form, don't have to be enclosed in +LEE, but other things in this section probably should be when +appropriate. You may need to use the C...|...E> syntax to keep +B and B from being too verbose; see perlpod(1). -sub noremap { - local($thing_to_hide) = shift; - $thing_to_hide =~ tr/\000-\177/\200-\377/; - return $thing_to_hide; -} +If the package has a web site, include a URL here. -sub init_noremap { - # escape high bit characters in input stream - s/([\200-\377])/"E<".ord($1).">"/ge; -} +=item AUTHOR -sub clear_noremap { - my $ready_to_print = $_[0]; - - tr/\200-\377/\000-\177/; - - # trofficate backslashes - # s/(?!\\e)(?:..|^.|^)\\/\\e/g; - - # now for the E<>s, which have been hidden until now - # otherwise the interative \w<> processing would have - # been hosed by the E - s { - E< - ( - ( \d + ) - | ( [A-Za-z]+ ) - ) - > - } { - do { - defined $2 - ? chr($2) - : - exists $HTML_Escapes{$3} - ? do { $HTML_Escapes{$3} } - : do { - warn "$0: Unknown escape in paragraph $. of $ARGV: ``$&''\n"; - "E<$1>"; - } - } - }egx if $ready_to_print; -} +Who wrote it (use AUTHORS for multiple people). Including your current +e-mail address (or some e-mail address to which bug reports should be sent) +so that users have a way of contacting you is a good idea. Remember that +program documentation tends to roam the wild for far longer than you expect +and pick an e-mail address that's likely to last if possible. -sub internal_lrefs { - local($_) = shift; - local $trailing_and = s/and\s+$// ? "and " : ""; - - s{L]+)>}{$1}g; - my(@items) = split( /(?:,?\s+(?:and\s+)?)/ ); - my $retstr = "the "; - my $i; - for ($i = 0; $i <= $#items; $i++) { - $retstr .= "C<$items[$i]>"; - $retstr .= ", " if @items > 2 && $i != $#items; - $retstr .= " and " if $i+2 == @items; - } - - $retstr .= " entr" . ( @items > 1 ? "ies" : "y" ) - . " elsewhere in this document"; - # terminal space to avoid words running together (pattern used - # strips terminal spaces) - $retstr .= " " if length $trailing_and; - $retstr .= $trailing_and; - - return $retstr; +=item HISTORY -} +Programs derived from other sources sometimes have this, or you might keep a +modification log here. -BEGIN { -%HTML_Escapes = ( - 'amp' => '&', # ampersand - 'lt' => '<', # left chevron, less-than - 'gt' => '>', # right chevron, greater-than - 'quot' => '"', # double quote - - "Aacute" => "A\\*'", # capital A, acute accent - "aacute" => "a\\*'", # small a, acute accent - "Acirc" => "A\\*^", # capital A, circumflex accent - "acirc" => "a\\*^", # small a, circumflex accent - "AElig" => '\*(AE', # capital AE diphthong (ligature) - "aelig" => '\*(ae', # small ae diphthong (ligature) - "Agrave" => "A\\*`", # capital A, grave accent - "agrave" => "A\\*`", # small a, grave accent - "Aring" => 'A\\*o', # capital A, ring - "aring" => 'a\\*o', # small a, ring - "Atilde" => 'A\\*~', # capital A, tilde - "atilde" => 'a\\*~', # small a, tilde - "Auml" => 'A\\*:', # capital A, dieresis or umlaut mark - "auml" => 'a\\*:', # small a, dieresis or umlaut mark - "Ccedil" => 'C\\*,', # capital C, cedilla - "ccedil" => 'c\\*,', # small c, cedilla - "Eacute" => "E\\*'", # capital E, acute accent - "eacute" => "e\\*'", # small e, acute accent - "Ecirc" => "E\\*^", # capital E, circumflex accent - "ecirc" => "e\\*^", # small e, circumflex accent - "Egrave" => "E\\*`", # capital E, grave accent - "egrave" => "e\\*`", # small e, grave accent - "ETH" => '\\*(D-', # capital Eth, Icelandic - "eth" => '\\*(d-', # small eth, Icelandic - "Euml" => "E\\*:", # capital E, dieresis or umlaut mark - "euml" => "e\\*:", # small e, dieresis or umlaut mark - "Iacute" => "I\\*'", # capital I, acute accent - "iacute" => "i\\*'", # small i, acute accent - "Icirc" => "I\\*^", # capital I, circumflex accent - "icirc" => "i\\*^", # small i, circumflex accent - "Igrave" => "I\\*`", # capital I, grave accent - "igrave" => "i\\*`", # small i, grave accent - "Iuml" => "I\\*:", # capital I, dieresis or umlaut mark - "iuml" => "i\\*:", # small i, dieresis or umlaut mark - "Ntilde" => 'N\*~', # capital N, tilde - "ntilde" => 'n\*~', # small n, tilde - "Oacute" => "O\\*'", # capital O, acute accent - "oacute" => "o\\*'", # small o, acute accent - "Ocirc" => "O\\*^", # capital O, circumflex accent - "ocirc" => "o\\*^", # small o, circumflex accent - "Ograve" => "O\\*`", # capital O, grave accent - "ograve" => "o\\*`", # small o, grave accent - "Oslash" => "O\\*/", # capital O, slash - "oslash" => "o\\*/", # small o, slash - "Otilde" => "O\\*~", # capital O, tilde - "otilde" => "o\\*~", # small o, tilde - "Ouml" => "O\\*:", # capital O, dieresis or umlaut mark - "ouml" => "o\\*:", # small o, dieresis or umlaut mark - "szlig" => '\*8', # small sharp s, German (sz ligature) - "THORN" => '\\*(Th', # capital THORN, Icelandic - "thorn" => '\\*(th',, # small thorn, Icelandic - "Uacute" => "U\\*'", # capital U, acute accent - "uacute" => "u\\*'", # small u, acute accent - "Ucirc" => "U\\*^", # capital U, circumflex accent - "ucirc" => "u\\*^", # small u, circumflex accent - "Ugrave" => "U\\*`", # capital U, grave accent - "ugrave" => "u\\*`", # small u, grave accent - "Uuml" => "U\\*:", # capital U, dieresis or umlaut mark - "uuml" => "u\\*:", # small u, dieresis or umlaut mark - "Yacute" => "Y\\*'", # capital Y, acute accent - "yacute" => "y\\*'", # small y, acute accent - "yuml" => "y\\*:", # small y, dieresis or umlaut mark -); -} +=back + +In addition, some systems use CONFORMING TO to note conformance to relevant +standards and MT-LEVEL to note safeness for use in threaded programs or +signal handlers. These headings are primarily useful when documenting parts +of a C library. Documentation of object-oriented libraries or modules may +use CONSTRUCTORS and METHODS sections for detailed documentation of the +parts of the library and save the DESCRIPTION section for an overview; other +large modules may use FUNCTIONS for similar reasons. Some people use +OVERVIEW to summarize the description if it's quite long. Sometimes there's +an additional COPYRIGHT section at the bottom, for licensing terms. +AVAILABILITY is sometimes added, giving the canonical download site for the +software or a URL for updates. + +Section ordering varies, although NAME should I be the first section +(you'll break some man page systems otherwise), and NAME, SYNOPSIS, +DESCRIPTION, and OPTIONS generally always occur first and in that order if +present. In general, SEE ALSO, AUTHOR, and similar material should be left +for last. Some systems also move WARNINGS and NOTES to last. The order +given above should be reasonable for most purposes. + +Finally, as a general note, try not to use an excessive amount of markup. +As documented here and in L, you can safely leave Perl variables, +function names, man page references, and the like unadorned by markup and +the POD translators will figure it out for you. This makes it much easier +to later edit the documentation. Note that many existing translators +(including this one currently) will do the wrong thing with e-mail addresses +or URLs when wrapped in LEE, so don't do that. + +For additional information that may be more accurate for your specific +system, see either man(5) or man(7) depending on your system manual section +numbering conventions. + +=head1 SEE ALSO + +L, L, man(1), nroff(1), +troff(1), man(7) + +The man page documenting the an macro set may be man(5) instead of man(7) on +your system. + +=head1 AUTHOR + +Russ Allbery Erra@stanford.eduE, based I heavily on the +original B by Larry Wall and Tom Christiansen. Large portions of +this documentation, particularly the sections on the anatomy of a proper man +page, are taken from the B documentation by Tom. +=cut !NO!SUBS! close OUT or die "Can't close $file: $!"; diff --git a/pod/pod2text.PL b/pod/pod2text.PL index 92b26fe..79cf8b2 100644 --- a/pod/pod2text.PL +++ b/pod/pod2text.PL @@ -28,23 +28,22 @@ print "Extracting $file (with variable substitutions)\n"; print OUT <<"!GROK!THIS!"; $Config{startperl} eval 'exec $Config{perlpath} -S \$0 \${1+"\$@"}' - if \$running_under_some_shell; + if \$running_under_some_shell; !GROK!THIS! # In the following, perl variables are not expanded during extraction. print OUT <<'!NO!SUBS!'; -$ID = q$Id: pod2text,v 0.1 1999/06/13 02:42:18 eagle Exp $; - # pod2text -- Convert POD data to formatted ASCII text. -# Copyright 1999 by Russ Allbery +# +# Copyright 1999 by Russ Allbery # # This program is free software; you can redistribute it and/or modify it # under the same terms as Perl itself. # -# The driver script for Pod::Text, Pod::Text::Termcap, and -# Pod::Text::Color, invoked by perldoc -t among other things. +# The driver script for Pod::Text, Pod::Text::Termcap, and Pod::Text::Color, +# invoked by perldoc -t among other things. require 5.004; @@ -65,8 +64,8 @@ for (my $i = 0; $i < @ARGV; $i++) { } } -# Parse our options. Use the same names as Pod::Text for simplicity, -# and default to sentence boundaries turned off for compatibility. +# Parse our options. Use the same names as Pod::Text for simplicity, and +# default to sentence boundaries turned off for compatibility. my %options; $options{termcap} = -t STDOUT; $options{sentence} = 0; @@ -79,6 +78,8 @@ pod2usage (1) if $options{help}; my $formatter = 'Pod::Text'; if ($options{color}) { $formatter = 'Pod::Text::Color'; + eval { require Term::ANSIColor }; + if ($@) { die "-c (--color) requires Term::ANSIColor be installed\n" } require Pod::Text::Color; } elsif ($options{termcap}) { $formatter = 'Pod::Text::Termcap'; @@ -104,16 +105,19 @@ pod2text B<-h> =head1 DESCRIPTION -B is a front-end for Pod::Text and its subclasses. It uses -them to generate formatted ASCII text from POD source. It can optionally -use either termcap sequences or ANSI color escape sequences to format the -text. +B is a front-end for Pod::Text and its subclasses. It uses them +to generate formatted ASCII text from POD source. It can optionally use +either termcap sequences or ANSI color escape sequences to format the text. I is the file to read for POD source (the POD can be embedded in code). If I isn't given, it defaults to STDIN. I, if given, is the file to which to write the formatted output. If I isn't given, the formatted output is written to STDOUT. +B defaults to trying to use Pod::Text::Termcap if STDOUT is a tty. +To explicitly say not to attempt termcap escape sequences, use +B<--notermcap>. + =head1 OPTIONS =over 4 @@ -133,17 +137,20 @@ requires that Term::ANSIColor be installed on your system. Set the number of spaces to indent regular text, and the default indentation for C<=over> blocks. Defaults to 4 spaces if this option isn't given. +=item B<-h>, B<--help> + +Print out usage information and exit. + =item B<-l>, B<--loose> Print a blank line after a C<=head1> heading. Normally, no blank line is -printed after C<=head1>, although one is still printed after C<=head2>. -This is the default because it's the expected formatting for manual pages; -if you're formatting arbitrary text documents, using this option is -recommended. +printed after C<=head1>, although one is still printed after C<=head2>, +because this is the expected formatting for manual pages; if you're +formatting arbitrary text documents, using this option is recommended. =item B<-s>, B<--sentence> -Assume each sentence ends in two spaces and try to preserve that spacing. +Assume each sentence ends with two spaces and try to preserve that spacing. Without this option, all consecutive whitespace in non-verbatim paragraphs is compressed into a single space. @@ -154,8 +161,8 @@ sequences for the terminal from termcap, and use that information in formatting the output. Output will be wrapped at two columns less than the width of your terminal device. Using this option requires that your system have a termcap file somewhere where Term::Cap can find it. With this -option, the output of B will contain terminal control sequences for -your current terminal type. +option, the output of B will contain terminal control sequences +for your current terminal type. =item B<-w>, B<--width=>I, B<->I @@ -165,6 +172,28 @@ your terminal device. =back +=head1 DIAGNOSTICS + +If B fails with errors, see L and L for +information about what those errors might mean. Internally, it can also +produce the following diagnostics: + +=over 4 + +=item -c (--color) requires Term::ANSIColor be installed + +(F) B<-c> or B<--color> were given, but Term::ANSIColor could not be +loaded. + +=item Unknown option: %s + +(F) An unknown command line option was given. + +=back + +In addition, other L error messages may result +from invalid command-line options. + =head1 ENVIRONMENT =over 4 @@ -183,11 +212,6 @@ current terminal device. =back -=head1 DIAGNOSTICS - -If B fails with POD errors, see L and -L for information about what those errors might mean. - =head1 SEE ALSO L, L, diff --git a/pod/pod2usage.PL b/pod/pod2usage.PL index adf49bd..24e93fa 100644 --- a/pod/pod2usage.PL +++ b/pod/pod2usage.PL @@ -39,10 +39,7 @@ print OUT <<'!NO!SUBS!'; ############################################################################# # pod2usage -- command to print usage messages from embedded pod docs # -# Derived from Tom Christiansen's pod2text script. -# (with extensive modifications) -# -# Copyright (c) 1996 Bradford Appleton. All rights reserved. +# Copyright (c) 1996-1999 by Bradford Appleton. All rights reserved. # This file is part of "PodParser". PodParser is free software; # you can redistribute it and/or modify it under the same terms # as Perl itself. diff --git a/pod/podchecker.PL b/pod/podchecker.PL index 0d31763..f7a820d 100644 --- a/pod/podchecker.PL +++ b/pod/podchecker.PL @@ -38,17 +38,14 @@ print OUT <<'!NO!SUBS!'; ############################################################################# # podchecker -- command to invoke the podchecker function in Pod::Checker # -# Derived from Tom Christiansen's pod2text script. -# (with extensive modifications) -# -# Copyright (c) 1998 Bradford Appleton. All rights reserved. +# Copyright (c) 1998-1999 by Bradford Appleton. All rights reserved. # This file is part of "PodParser". PodParser is free software; # you can redistribute it and/or modify it under the same terms # as Perl itself. ############################################################################# use strict; -use diagnostics; +#use diagnostics; =head1 NAME @@ -56,7 +53,7 @@ podchecker - check the syntax of POD format documentation files =head1 SYNOPSIS -B [B<-help>] [B<-man>] [IS< >...] +B [B<-help>] [B<-man>] [B<-(no)warnings>] [IS< >...] =head1 OPTIONS AND ARGUMENTS @@ -70,6 +67,10 @@ Print a brief help message and exit. Print the manual page and exit. +=item B<-warnings> B<-nowarnings> + +Turn on/off printing of warnings. + =item I The pathname of a POD file to syntax-check (defaults to standard input). @@ -86,13 +87,30 @@ indicating the number of errors found. B invokes the B function exported by B Please see L for more details. +=head1 RETURN VALUE + +B returns a 0 (zero) exit status if all specified +POD files are ok. + +=head1 ERRORS + +B returns the exit status 1 if at least one of +the given POD files has syntax errors. + +The status 2 indicates that at least one of the specified +files does not contain I POD commands. + +Status 1 overrides status 2. If you want unambigouus +results, call B with one single argument only. + =head1 SEE ALSO L and L -=head1 AUTHOR +=head1 AUTHORS -Brad Appleton Ebradapp@enteract.comE +Brad Appleton Ebradapp@enteract.comE, +Marek Rouchal Emarek@saftsack.fs.uni-bayreuth.deE Based on code for B written by Tom Christiansen Etchrist@mox.perl.comE @@ -108,10 +126,11 @@ use Getopt::Long; my %options = ( "help" => 0, "man" => 0, + "warnings" => 1, ); ## Parse options -GetOptions(\%options, "help", "man") || pod2usage(2); +GetOptions(\%options, "help", "man", "warnings!") || pod2usage(2); pod2usage(1) if ($options{help}); pod2usage(-verbose => 2) if ($options{man}); @@ -119,11 +138,20 @@ pod2usage(-verbose => 2) if ($options{man}); pod2usage(2) if ((@ARGV == 0) && (-t STDIN)); ## Invoke podchecker() -if(@ARGV) { - for (@ARGV) { podchecker($_) }; -} else { - podchecker("<&STDIN"); +my $status = 0; +@ARGV = ("<&STDIN") unless(@ARGV); +for (@ARGV) { + my $s = podchecker($_, undef, '-warnings' => $options{warnings}); + if($s > 0) { + # errors occurred + $status = 1; + } + elsif($s < 0) { + # no pod found + $status = 2 unless($status); + } } +exit $status; !NO!SUBS! diff --git a/pod/podselect.PL b/pod/podselect.PL index a76f6a0..3fa4118 100644 --- a/pod/podselect.PL +++ b/pod/podselect.PL @@ -39,10 +39,7 @@ print OUT <<'!NO!SUBS!'; ############################################################################# # podselect -- command to invoke the podselect function in Pod::Select # -# Derived from Tom Christiansen's pod2text script. -# (with extensive modifications) -# -# Copyright (c) 1996 Bradford Appleton. All rights reserved. +# Copyright (c) 1996-1999 by Bradford Appleton. All rights reserved. # This file is part of "PodParser". PodParser is free software; # you can redistribute it and/or modify it under the same terms # as Perl itself. diff --git a/pod/roffitall b/pod/roffitall index bcf5864..7ddffe7 100644 --- a/pod/roffitall +++ b/pod/roffitall @@ -42,6 +42,7 @@ toroff=` $mandir/perlmod.1 \ $mandir/perlmodlib.1 \ $mandir/perlmodinstall.1 \ + $mandir/perlfork.1 \ $mandir/perlform.1 \ $mandir/perllocale.1 \ $mandir/perlref.1 \ @@ -70,6 +71,7 @@ toroff=` $mandir/perlcall.1 \ $mandir/perlcompile.1 \ $mandir/perltodo.1 \ + $mandir/perlhack.1 \ $mandir/perlhist.1 \ $mandir/perldelta.1 \ $mandir/perl5004delta.1 \ diff --git a/pp.c b/pp.c index 2948d3a..c387433 100644 --- a/pp.c +++ b/pp.c @@ -241,25 +241,30 @@ PP(pp_rv2gv) * NI-S 1999/05/07 */ if (PL_op->op_private & OPpDEREF) { - GV *gv = (GV *) newSV(0); - STRLEN len = 0; - char *name = ""; - if (cUNOP->op_first->op_type == OP_PADSV) { - SV *padname = *av_fetch(PL_comppad_name, cUNOP->op_first->op_targ, 4); - name = SvPV(padname,len); + char *name; + GV *gv; + if (cUNOP->op_targ) { + STRLEN len; + SV *namesv = PL_curpad[cUNOP->op_targ]; + name = SvPV(namesv, len); + gv = (GV*)NEWSV(0,0); + gv_init(gv, CopSTASH(PL_curcop), name, len, 0); + } + else { + name = CopSTASHPV(PL_curcop); + gv = newGVgen(name); } - gv_init(gv, PL_curcop->cop_stash, name, len, 0); sv_upgrade(sv, SVt_RV); - SvRV(sv) = (SV *) gv; + SvRV(sv) = (SV*)gv; SvROK_on(sv); SvSETMAGIC(sv); goto wasref; - } + } if (PL_op->op_flags & OPf_REF || PL_op->op_private & HINT_STRICT_REFS) DIE(aTHX_ PL_no_usym, "a symbol"); if (ckWARN(WARN_UNINITIALIZED)) - Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit); + report_uninit(); RETSETUNDEF; } sym = SvPV(sv, n_a); @@ -315,7 +320,7 @@ PP(pp_rv2sv) PL_op->op_private & HINT_STRICT_REFS) DIE(aTHX_ PL_no_usym, "a SCALAR"); if (ckWARN(WARN_UNINITIALIZED)) - Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit); + report_uninit(); RETSETUNDEF; } sym = SvPV(sv, n_a); @@ -575,7 +580,7 @@ PP(pp_bless) HV *stash; if (MAXARG == 1) - stash = PL_curcop->cop_stash; + stash = CopSTASH(PL_curcop); else { SV *ssv = POPs; STRLEN len; @@ -848,7 +853,7 @@ PP(pp_undef) Newz(602, gp, 1, GP); GvGP(sv) = gp_ref(gp); GvSV(sv) = NEWSV(72,0); - GvLINE(sv) = PL_curcop->cop_line; + GvLINE(sv) = CopLINE(PL_curcop); GvEGV(sv) = (GV*)sv; GvMULTI_on(sv); } @@ -1783,7 +1788,7 @@ S_seed(pTHX) u = (U32)SEED_C1 * when; # endif #endif - u += SEED_C3 * (U32)getpid(); + u += SEED_C3 * (U32)PerlProc_getpid(); u += SEED_C4 * (U32)PTR2UV(PL_stack_sp); #ifndef PLAN9 /* XXX Plan9 assembler chokes on this; fix needed */ u += SEED_C5 * (U32)PTR2UV(&when); @@ -2016,7 +2021,9 @@ PP(pp_substr) sv_pos_u2b(sv, &pos, &rem); tmps += pos; sv_setpvn(TARG, tmps, rem); - if (lvalue) { /* it's an lvalue! */ + if (repl) + sv_insert(sv, pos, rem, repl, repl_len); + else if (lvalue) { /* it's an lvalue! */ if (!SvGMAGICAL(sv)) { if (SvROK(sv)) { STRLEN n_a; @@ -2045,8 +2052,6 @@ PP(pp_substr) LvTARGOFF(TARG) = pos; LvTARGLEN(TARG) = rem; } - else if (repl) - sv_insert(sv, pos, rem, repl, repl_len); } SPAGAIN; PUSHs(TARG); /* avoid SvSETMAGIC here */ @@ -2256,7 +2261,7 @@ PP(pp_ucfirst) tend = uv_to_utf8(tmpbuf, uv); - if (!SvPADTMP(sv) || tend - tmpbuf != ulen) { + if (!SvPADTMP(sv) || tend - tmpbuf != ulen || SvREADONLY(sv)) { dTARGET; sv_setpvn(TARG, (char*)tmpbuf, tend - tmpbuf); sv_catpvn(TARG, (char*)(s + ulen), slen - ulen); @@ -2268,7 +2273,7 @@ PP(pp_ucfirst) } } else { - if (!SvPADTMP(sv)) { + if (!SvPADTMP(sv) || SvREADONLY(sv)) { dTARGET; sv_setsv(TARG, sv); sv = TARG; @@ -2313,7 +2318,7 @@ PP(pp_lcfirst) tend = uv_to_utf8(tmpbuf, uv); - if (!SvPADTMP(sv) || tend - tmpbuf != ulen) { + if (!SvPADTMP(sv) || tend - tmpbuf != ulen || SvREADONLY(sv)) { dTARGET; sv_setpvn(TARG, (char*)tmpbuf, tend - tmpbuf); sv_catpvn(TARG, (char*)(s + ulen), slen - ulen); @@ -2325,7 +2330,7 @@ PP(pp_lcfirst) } } else { - if (!SvPADTMP(sv)) { + if (!SvPADTMP(sv) || SvREADONLY(sv)) { dTARGET; sv_setsv(TARG, sv); sv = TARG; @@ -2392,7 +2397,7 @@ PP(pp_uc) } } else { - if (!SvPADTMP(sv)) { + if (!SvPADTMP(sv) || SvREADONLY(sv)) { dTARGET; sv_setsv(TARG, sv); sv = TARG; @@ -2463,7 +2468,7 @@ PP(pp_lc) } } else { - if (!SvPADTMP(sv)) { + if (!SvPADTMP(sv) || SvREADONLY(sv)) { dTARGET; sv_setsv(TARG, sv); sv = TARG; @@ -2642,13 +2647,28 @@ PP(pp_delete) U32 hvtype; hv = (HV*)POPs; hvtype = SvTYPE(hv); - while (++MARK <= SP) { - if (hvtype == SVt_PVHV) + if (hvtype == SVt_PVHV) { /* hash element */ + while (++MARK <= SP) { sv = hv_delete_ent(hv, *MARK, discard, 0); - else - DIE(aTHX_ "Not a HASH reference"); - *MARK = sv ? sv : &PL_sv_undef; + *MARK = sv ? sv : &PL_sv_undef; + } } + else if (hvtype == SVt_PVAV) { + if (PL_op->op_flags & OPf_SPECIAL) { /* array element */ + while (++MARK <= SP) { + sv = av_delete((AV*)hv, SvIV(*MARK), discard); + *MARK = sv ? sv : &PL_sv_undef; + } + } + else { /* pseudo-hash element */ + while (++MARK <= SP) { + sv = avhv_delete_ent((AV*)hv, *MARK, discard, 0); + *MARK = sv ? sv : &PL_sv_undef; + } + } + } + else + DIE(aTHX_ "Not a HASH reference"); if (discard) SP = ORIGMARK; else if (gimme == G_SCALAR) { @@ -2662,6 +2682,12 @@ PP(pp_delete) hv = (HV*)POPs; if (SvTYPE(hv) == SVt_PVHV) sv = hv_delete_ent(hv, keysv, discard, 0); + else if (SvTYPE(hv) == SVt_PVAV) { + if (PL_op->op_flags & OPf_SPECIAL) + sv = av_delete((AV*)hv, SvIV(keysv), discard); + else + sv = avhv_delete_ent((AV*)hv, keysv, discard, 0); + } else DIE(aTHX_ "Not a HASH reference"); if (!sv) @@ -2682,7 +2708,11 @@ PP(pp_exists) RETPUSHYES; } else if (SvTYPE(hv) == SVt_PVAV) { - if (avhv_exists_ent((AV*)hv, tmpsv, 0)) + if (PL_op->op_flags & OPf_SPECIAL) { /* array element */ + if (av_exists((AV*)hv, SvIV(tmpsv))) + RETPUSHYES; + } + else if (avhv_exists_ent((AV*)hv, tmpsv, 0)) /* pseudo-hash element */ RETPUSHYES; } else { @@ -3130,6 +3160,7 @@ PP(pp_reverse) *MARK++ = *SP; *SP-- = tmp; } + /* safe as long as stack cannot get extended in the above */ SP = oldsp; } else { @@ -3230,7 +3261,7 @@ PP(pp_unpack) { djSP; dPOPPOPssrl; - SV **oldsp = SP; + I32 start_sp_offset = SP - PL_stack_base; I32 gimme = GIMME_V; SV *sv; STRLEN llen; @@ -3243,6 +3274,7 @@ PP(pp_unpack) I32 datumtype; register I32 len; register I32 bits; + register char *str; /* These must not be in registers: */ I16 ashort; @@ -3264,6 +3296,7 @@ PP(pp_unpack) register U32 culong; NV cdouble; int commas = 0; + int star; #ifdef PERL_NATINT_PACK int natint; /* native integer */ int unatint; /* unsigned native integer */ @@ -3305,11 +3338,13 @@ PP(pp_unpack) else DIE(aTHX_ "'!' allowed only after types %s", natstr); } + star = 0; if (pat >= patend) len = 1; else if (*pat == '*') { len = strend - strbeg; /* long enough */ pat++; + star = 1; } else if (isDIGIT(*pat)) { len = *pat++ - '0'; @@ -3321,6 +3356,7 @@ PP(pp_unpack) } else len = (datumtype != '@'); + redo_switch: switch(datumtype) { default: DIE(aTHX_ "Invalid type in unpack: '%c'", (int)datumtype); @@ -3354,17 +3390,16 @@ PP(pp_unpack) s += len; break; case '/': - if (oldsp >= SP) + if (start_sp_offset >= SP - PL_stack_base) DIE(aTHX_ "/ must follow a numeric type"); - if (*pat != 'a' && *pat != 'A' && *pat != 'Z') - DIE(aTHX_ "/ must be followed by a, A or Z"); datumtype = *pat++; if (*pat == '*') pat++; /* ignore '*' for compatibility with pack */ if (isDIGIT(*pat)) DIE(aTHX_ "/ cannot take a count" ); len = POPi; - /* drop through */ + star = 0; + goto redo_switch; case 'A': case 'Z': case 'a': @@ -3395,7 +3430,7 @@ PP(pp_unpack) break; case 'B': case 'b': - if (pat[-1] == '*' || len > (strend - s) * 8) + if (star || len > (strend - s) * 8) len = (strend - s) * 8; if (checksum) { if (!PL_bitcount) { @@ -3435,8 +3470,7 @@ PP(pp_unpack) sv = NEWSV(35, len + 1); SvCUR_set(sv, len); SvPOK_on(sv); - aptr = pat; /* borrow register */ - pat = SvPVX(sv); + str = SvPVX(sv); if (datumtype == 'b') { aint = len; for (len = 0; len < aint; len++) { @@ -3444,7 +3478,7 @@ PP(pp_unpack) bits >>= 1; else bits = *s++; - *pat++ = '0' + (bits & 1); + *str++ = '0' + (bits & 1); } } else { @@ -3454,22 +3488,20 @@ PP(pp_unpack) bits <<= 1; else bits = *s++; - *pat++ = '0' + ((bits & 128) != 0); + *str++ = '0' + ((bits & 128) != 0); } } - *pat = '\0'; - pat = aptr; /* unborrow register */ + *str = '\0'; XPUSHs(sv_2mortal(sv)); break; case 'H': case 'h': - if (pat[-1] == '*' || len > (strend - s) * 2) + if (star || len > (strend - s) * 2) len = (strend - s) * 2; sv = NEWSV(35, len + 1); SvCUR_set(sv, len); SvPOK_on(sv); - aptr = pat; /* borrow register */ - pat = SvPVX(sv); + str = SvPVX(sv); if (datumtype == 'h') { aint = len; for (len = 0; len < aint; len++) { @@ -3477,7 +3509,7 @@ PP(pp_unpack) bits >>= 4; else bits = *s++; - *pat++ = PL_hexdigit[bits & 15]; + *str++ = PL_hexdigit[bits & 15]; } } else { @@ -3487,11 +3519,10 @@ PP(pp_unpack) bits <<= 4; else bits = *s++; - *pat++ = PL_hexdigit[(bits >> 4) & 15]; + *str++ = PL_hexdigit[(bits >> 4) & 15]; } } - *pat = '\0'; - pat = aptr; /* unborrow register */ + *str = '\0'; XPUSHs(sv_2mortal(sv)); break; case 'c': @@ -4195,7 +4226,7 @@ PP(pp_unpack) checksum = 0; } } - if (SP == oldsp && gimme == G_SCALAR) + if (SP - PL_stack_base == start_sp_offset && gimme == G_SCALAR) PUSHs(&PL_sv_undef); RETURN; } @@ -4427,10 +4458,16 @@ PP(pp_pack) case 'a': fromstr = NEXTFROM; aptr = SvPV(fromstr, fromlen); - if (pat[-1] == '*') + if (pat[-1] == '*') { len = fromlen; - if (fromlen > len) + if (datumtype == 'Z') + ++len; + } + if (fromlen >= len) { sv_catpvn(cat, aptr, len); + if (datumtype == 'Z') + *(SvEND(cat)-1) = '\0'; + } else { sv_catpvn(cat, aptr, fromlen); len -= fromlen; @@ -4453,15 +4490,14 @@ PP(pp_pack) case 'B': case 'b': { - char *savepat = pat; + register char *str; I32 saveitems; fromstr = NEXTFROM; saveitems = items; - aptr = SvPV(fromstr, fromlen); + str = SvPV(fromstr, fromlen); if (pat[-1] == '*') len = fromlen; - pat = aptr; aint = SvCUR(cat); SvCUR(cat) += (len+7)/8; SvGROW(cat, SvCUR(cat) + 1); @@ -4472,7 +4508,7 @@ PP(pp_pack) items = 0; if (datumtype == 'B') { for (len = 0; len++ < aint;) { - items |= *pat++ & 1; + items |= *str++ & 1; if (len & 7) items <<= 1; else { @@ -4483,7 +4519,7 @@ PP(pp_pack) } else { for (len = 0; len++ < aint;) { - if (*pat++ & 1) + if (*str++ & 1) items |= 128; if (len & 7) items >>= 1; @@ -4500,26 +4536,24 @@ PP(pp_pack) items >>= 7 - (aint & 7); *aptr++ = items & 0xff; } - pat = SvPVX(cat) + SvCUR(cat); - while (aptr <= pat) + str = SvPVX(cat) + SvCUR(cat); + while (aptr <= str) *aptr++ = '\0'; - pat = savepat; items = saveitems; } break; case 'H': case 'h': { - char *savepat = pat; + register char *str; I32 saveitems; fromstr = NEXTFROM; saveitems = items; - aptr = SvPV(fromstr, fromlen); + str = SvPV(fromstr, fromlen); if (pat[-1] == '*') len = fromlen; - pat = aptr; aint = SvCUR(cat); SvCUR(cat) += (len+1)/2; SvGROW(cat, SvCUR(cat) + 1); @@ -4530,10 +4564,10 @@ PP(pp_pack) items = 0; if (datumtype == 'H') { for (len = 0; len++ < aint;) { - if (isALPHA(*pat)) - items |= ((*pat++ & 15) + 9) & 15; + if (isALPHA(*str)) + items |= ((*str++ & 15) + 9) & 15; else - items |= *pat++ & 15; + items |= *str++ & 15; if (len & 1) items <<= 4; else { @@ -4544,10 +4578,10 @@ PP(pp_pack) } else { for (len = 0; len++ < aint;) { - if (isALPHA(*pat)) - items |= (((*pat++ & 15) + 9) & 15) << 4; + if (isALPHA(*str)) + items |= (((*str++ & 15) + 9) & 15) << 4; else - items |= (*pat++ & 15) << 4; + items |= (*str++ & 15) << 4; if (len & 1) items >>= 4; else { @@ -4558,11 +4592,10 @@ PP(pp_pack) } if (aint & 1) *aptr++ = items & 0xff; - pat = SvPVX(cat) + SvCUR(cat); - while (aptr <= pat) + str = SvPVX(cat) + SvCUR(cat); + while (aptr <= str) *aptr++ = '\0'; - pat = savepat; items = saveitems; } break; @@ -4828,7 +4861,7 @@ PP(pp_pack) sv_catpvn(cat, (char*)&aquad, sizeof(Quad_t)); } break; -#endif /* HAS_QUAD */ +#endif case 'P': len = 1; /* assume SV is correct length */ /* FALL THROUGH */ @@ -4844,9 +4877,13 @@ PP(pp_pack) * of pack() (and all copies of the result) are * gone. */ - if (ckWARN(WARN_UNSAFE) && (SvTEMP(fromstr) || SvPADTMP(fromstr))) + if (ckWARN(WARN_UNSAFE) && (SvTEMP(fromstr) + || (SvPADTMP(fromstr) + && !SvREADONLY(fromstr)))) + { Perl_warner(aTHX_ WARN_UNSAFE, "Attempt to pack pointer to temporary value"); + } if (SvPOK(fromstr) || SvNIOK(fromstr)) aptr = SvPV(fromstr,n_a); else @@ -4923,8 +4960,13 @@ PP(pp_split) TAINT_IF((pm->op_pmflags & PMf_LOCALE) && (pm->op_pmflags & (PMf_WHITE | PMf_SKIPWHITE))); - if (pm->op_pmreplroot) + if (pm->op_pmreplroot) { +#ifdef USE_ITHREADS + ary = GvAVn((GV*)PL_curpad[(PADOFFSET)pm->op_pmreplroot]); +#else ary = GvAVn((GV*)pm->op_pmreplroot); +#endif + } else if (gimme != G_ARRAY) #ifdef USE_THREADS ary = (AV*)PL_curpad[0]; @@ -5170,8 +5212,8 @@ Perl_unlock_condpair(pTHX_ void *svv) Perl_croak(aTHX_ "panic: unlock_condpair unlocking mutex that we don't own"); MgOWNER(mg) = 0; COND_SIGNAL(MgOWNERCONDP(mg)); - DEBUG_S(PerlIO_printf(PerlIO_stderr(), "0x%lx: unlock 0x%lx\n", - (unsigned long)thr, (unsigned long)svv);) + DEBUG_S(PerlIO_printf(Perl_debug_log, "0x%"UVxf": unlock 0x%"UVxf"\n", + PTR2UV(thr), PTR2UV(svv));) MUTEX_UNLOCK(MgMUTEXP(mg)); } #endif /* USE_THREADS */ @@ -5195,10 +5237,10 @@ PP(pp_lock) while (MgOWNER(mg)) COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg)); MgOWNER(mg) = thr; - DEBUG_S(PerlIO_printf(PerlIO_stderr(), "0x%lx: pp_lock lock 0x%lx\n", - (unsigned long)thr, (unsigned long)sv);) + DEBUG_S(PerlIO_printf(Perl_debug_log, "0x%"UVxf": pp_lock lock 0x%"UVxf"\n", + PTR2UV(thr), PTR2UV(sv));) MUTEX_UNLOCK(MgMUTEXP(mg)); - SAVEDESTRUCTOR(Perl_unlock_condpair, sv); + SAVEDESTRUCTOR_X(Perl_unlock_condpair, sv); } #endif /* USE_THREADS */ if (SvTYPE(retsv) == SVt_PVAV || SvTYPE(retsv) == SVt_PVHV diff --git a/pp_ctl.c b/pp_ctl.c index e849e33..34e18b5 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -27,6 +27,8 @@ #define DOCATCH(o) ((CATCH_GET == TRUE) ? docatch(o) : (o)) static I32 sortcv(pTHXo_ SV *a, SV *b); +static I32 sortcv_stacked(pTHXo_ SV *a, SV *b); +static I32 sortcv_xsub(pTHXo_ SV *a, SV *b); static I32 sv_ncmp(pTHXo_ SV *a, SV *b); static I32 sv_i_ncmp(pTHXo_ SV *a, SV *b); static I32 amagic_ncmp(pTHXo_ SV *a, SV *b); @@ -132,9 +134,13 @@ PP(pp_regcomp) else if (strEQ("\\s+", pm->op_pmregexp->precomp)) pm->op_pmflags |= PMf_WHITE; + /* XXX runtime compiled output needs to move to the pad */ if (pm->op_pmflags & PMf_KEEP) { pm->op_private &= ~OPpRUNTIME; /* no point compiling again */ +#if !defined(USE_ITHREADS) && !defined(USE_THREADS) + /* XXX can't change the optree at runtime either */ cLOGOP->op_first->op_next = PL_op->op_next; +#endif } RETURN; } @@ -330,9 +336,9 @@ PP(pp_formline) case FF_END: name = "END"; break; } if (arg >= 0) - PerlIO_printf(PerlIO_stderr(), "%-16s%ld\n", name, (long) arg); + PerlIO_printf(Perl_debug_log, "%-16s%ld\n", name, (long) arg); else - PerlIO_printf(PerlIO_stderr(), "%-16s\n", name); + PerlIO_printf(Perl_debug_log, "%-16s\n", name); } ) switch (*fpc++) { case FF_LINEMARK: @@ -686,7 +692,7 @@ PP(pp_grepstart) /* SAVE_DEFSV does *not* suffice here for USE_THREADS */ SAVESPTR(DEFSV); ENTER; /* enter inner scope */ - SAVESPTR(PL_curpm); + SAVEVPTR(PL_curpm); src = PL_stack_base[*PL_markstack_ptr]; SvTEMP_off(src); @@ -756,7 +762,7 @@ PP(pp_mapwhile) SV *src; ENTER; /* enter inner scope */ - SAVESPTR(PL_curpm); + SAVEVPTR(PL_curpm); src = PL_stack_base[PL_markstack_ptr[-1]]; SvTEMP_off(src); @@ -778,6 +784,8 @@ PP(pp_sort) I32 gimme = GIMME; OP* nextop = PL_op->op_next; I32 overloading = 0; + bool hasargs = FALSE; + I32 is_xsub = 0; if (gimme != G_ARRAY) { SP = MARK; @@ -785,44 +793,54 @@ PP(pp_sort) } ENTER; - SAVEPPTR(PL_sortcop); + SAVEVPTR(PL_sortcop); if (PL_op->op_flags & OPf_STACKED) { if (PL_op->op_flags & OPf_SPECIAL) { OP *kid = cLISTOP->op_first->op_sibling; /* pass pushmark */ kid = kUNOP->op_first; /* pass rv2gv */ kid = kUNOP->op_first; /* pass leave */ PL_sortcop = kid->op_next; - stash = PL_curcop->cop_stash; + stash = CopSTASH(PL_curcop); } else { cv = sv_2cv(*++MARK, &stash, &gv, 0); + if (cv && SvPOK(cv)) { + STRLEN n_a; + char *proto = SvPV((SV*)cv, n_a); + if (proto && strEQ(proto, "$$")) { + hasargs = TRUE; + } + } if (!(cv && CvROOT(cv))) { - if (gv) { + if (cv && CvXSUB(cv)) { + is_xsub = 1; + } + else if (gv) { SV *tmpstr = sv_newmortal(); gv_efullname3(tmpstr, gv, Nullch); - if (cv && CvXSUB(cv)) - DIE(aTHX_ "Xsub \"%s\" called in sort", SvPVX(tmpstr)); DIE(aTHX_ "Undefined sort subroutine \"%s\" called", SvPVX(tmpstr)); } - if (cv) { - if (CvXSUB(cv)) - DIE(aTHX_ "Xsub called in sort"); + else { DIE(aTHX_ "Undefined subroutine in sort"); } - DIE(aTHX_ "Not a CODE reference in sort"); } - PL_sortcop = CvSTART(cv); - SAVESPTR(CvROOT(cv)->op_ppaddr); - CvROOT(cv)->op_ppaddr = PL_ppaddr[OP_NULL]; - SAVESPTR(PL_curpad); - PL_curpad = AvARRAY((AV*)AvARRAY(CvPADLIST(cv))[1]); + if (is_xsub) + PL_sortcop = (OP*)cv; + else { + PL_sortcop = CvSTART(cv); + SAVEVPTR(CvROOT(cv)->op_ppaddr); + CvROOT(cv)->op_ppaddr = PL_ppaddr[OP_NULL]; + + SAVEVPTR(PL_curpad); + PL_curpad = AvARRAY((AV*)AvARRAY(CvPADLIST(cv))[1]); + } } } else { PL_sortcop = Nullop; - stash = PL_curcop->cop_stash; + stash = CopSTASH(PL_curcop); } up = myorigmark + 1; @@ -863,7 +881,6 @@ PP(pp_sort) PUSHBLOCK(cx, CXt_NULL, PL_stack_base); if (!(PL_op->op_flags & OPf_SPECIAL)) { - bool hasargs = FALSE; cx->cx_type = CXt_SUB; cx->blk_gimme = G_SCALAR; PUSHSUB(cx); @@ -871,7 +888,19 @@ PP(pp_sort) (void)SvREFCNT_inc(cv); /* in preparation for POPSUB */ } PL_sortcxix = cxstack_ix; - qsortsv((myorigmark+1), max, sortcv); + + if (hasargs && !is_xsub) { + /* This is mostly copied from pp_entersub */ + AV *av = (AV*)PL_curpad[0]; + +#ifndef USE_THREADS + cx->blk_sub.savearray = GvAV(PL_defgv); + GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av); +#endif /* USE_THREADS */ + cx->blk_sub.argarray = av; + } + qsortsv((myorigmark+1), max, + is_xsub ? sortcv_xsub : hasargs ? sortcv_stacked : sortcv); POPBLOCK(cx,PL_curpm); PL_stack_sp = newsp; @@ -968,7 +997,9 @@ PP(pp_flop) mg_get(right); if (SvNIOKp(left) || !SvPOKp(left) || - (looks_like_number(left) && *SvPVX(left) != '0') ) + SvNIOKp(right) || !SvPOKp(right) || + (looks_like_number(left) && *SvPVX(left) != '0' && + looks_like_number(right) && *SvPVX(right) != '0')) { if (SvNV(left) < IV_MIN || SvNV(right) > IV_MAX) DIE(aTHX_ "Range iterator outside integer range"); @@ -1040,6 +1071,11 @@ S_dopoptolabel(pTHX_ char *label) Perl_warner(aTHX_ WARN_UNSAFE, "Exiting subroutine via %s", PL_op_name[PL_op->op_type]); break; + case CXt_FORMAT: + if (ckWARN(WARN_UNSAFE)) + Perl_warner(aTHX_ WARN_UNSAFE, "Exiting format via %s", + PL_op_name[PL_op->op_type]); + break; case CXt_EVAL: if (ckWARN(WARN_UNSAFE)) Perl_warner(aTHX_ WARN_UNSAFE, "Exiting eval via %s", @@ -1115,6 +1151,7 @@ S_dopoptosub_at(pTHX_ PERL_CONTEXT *cxstk, I32 startingblock) continue; case CXt_EVAL: case CXt_SUB: + case CXt_FORMAT: DEBUG_l( Perl_deb(aTHX_ "(Found sub #%ld)\n", (long)i)); return i; } @@ -1160,6 +1197,11 @@ S_dopoptoloop(pTHX_ I32 startingblock) Perl_warner(aTHX_ WARN_UNSAFE, "Exiting subroutine via %s", PL_op_name[PL_op->op_type]); break; + case CXt_FORMAT: + if (ckWARN(WARN_UNSAFE)) + Perl_warner(aTHX_ WARN_UNSAFE, "Exiting format via %s", + PL_op_name[PL_op->op_type]); + break; case CXt_EVAL: if (ckWARN(WARN_UNSAFE)) Perl_warner(aTHX_ WARN_UNSAFE, "Exiting eval via %s", @@ -1187,6 +1229,7 @@ Perl_dounwind(pTHX_ I32 cxix) I32 optype; while (cxstack_ix > cxix) { + SV *sv; cx = &cxstack[cxstack_ix]; DEBUG_l(PerlIO_printf(Perl_debug_log, "Unwinding block %ld, type %s\n", (long) cxstack_ix, PL_block_type[CxTYPE(cx)])); @@ -1196,7 +1239,8 @@ Perl_dounwind(pTHX_ I32 cxix) POPSUBST(cx); continue; /* not break */ case CXt_SUB: - POPSUB(cx); + POPSUB(cx,sv); + LEAVESUB(sv); break; case CXt_EVAL: POPEVAL(cx); @@ -1206,6 +1250,9 @@ Perl_dounwind(pTHX_ I32 cxix) break; case CXt_NULL: break; + case CXt_FORMAT: + POPFORMAT(cx); + break; } cxstack_ix--; } @@ -1272,26 +1319,25 @@ Perl_die_where(pTHX_ char *message, STRLEN msglen) if (message) { if (PL_in_eval & EVAL_KEEPERR) { - SV **svp; - - svp = hv_fetch(ERRHV, message, msglen, TRUE); - if (svp) { - if (!SvIOK(*svp)) { - static char prefix[] = "\t(in cleanup) "; - SV *err = ERRSV; - sv_upgrade(*svp, SVt_IV); - (void)SvIOK_only(*svp); - if (!SvPOK(err)) - sv_setpv(err,""); - SvGROW(err, SvCUR(err)+sizeof(prefix)+msglen); - sv_catpvn(err, prefix, sizeof(prefix)-1); - sv_catpvn(err, message, msglen); - if (ckWARN(WARN_UNSAFE)) { - STRLEN start = SvCUR(err)-msglen-sizeof(prefix)+1; - Perl_warner(aTHX_ WARN_UNSAFE, SvPVX(err)+start); - } + static char prefix[] = "\t(in cleanup) "; + SV *err = ERRSV; + char *e = Nullch; + if (!SvPOK(err)) + sv_setpv(err,""); + else if (SvCUR(err) >= sizeof(prefix)+msglen-1) { + e = SvPV(err, n_a); + e += n_a - msglen; + if (*e != *message || strNE(e,message)) + e = Nullch; + } + if (!e) { + SvGROW(err, SvCUR(err)+sizeof(prefix)+msglen); + sv_catpvn(err, prefix, sizeof(prefix)-1); + sv_catpvn(err, message, msglen); + if (ckWARN(WARN_UNSAFE)) { + STRLEN start = SvCUR(err)-msglen-sizeof(prefix)+1; + Perl_warner(aTHX_ WARN_UNSAFE, SvPVX(err)+start); } - sv_inc(*svp); } } else @@ -1315,8 +1361,8 @@ Perl_die_where(pTHX_ char *message, STRLEN msglen) POPBLOCK(cx,PL_curpm); if (CxTYPE(cx) != CXt_EVAL) { - PerlIO_write(PerlIO_stderr(), "panic: die ", 11); - PerlIO_write(PerlIO_stderr(), message, msglen); + PerlIO_write(Perl_error_log, "panic: die ", 11); + PerlIO_write(Perl_error_log, message, msglen); my_exit(1); } POPEVAL(cx); @@ -1342,8 +1388,10 @@ Perl_die_where(pTHX_ char *message, STRLEN msglen) /* SFIO can really mess with your errno */ int e = errno; #endif - PerlIO_write(PerlIO_stderr(), message, msglen); - (void)PerlIO_flush(PerlIO_stderr()); + PerlIO *serr = Perl_error_log; + + PerlIO_write(serr, message, msglen); + (void)PerlIO_flush(serr); #ifdef USE_SFIO errno = e; #endif @@ -1389,7 +1437,7 @@ PP(pp_caller) PERL_SI *top_si = PL_curstackinfo; I32 dbcxix; I32 gimme; - HV *hv; + char *stashname; SV *sv; I32 count = 0; @@ -1417,7 +1465,7 @@ PP(pp_caller) } cx = &ccstack[cxix]; - if (CxTYPE(cx) == CXt_SUB) { + if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) { dbcxix = dopoptosub_at(ccstack, cxix - 1); /* We expect that ccstack[dbcxix] is CXt_SUB, anyway, the field below is defined for any cx. */ @@ -1425,29 +1473,28 @@ PP(pp_caller) cx = &ccstack[dbcxix]; } + stashname = CopSTASHPV(cx->blk_oldcop); if (GIMME != G_ARRAY) { - hv = cx->blk_oldcop->cop_stash; - if (!hv) + if (!stashname) PUSHs(&PL_sv_undef); else { dTARGET; - sv_setpv(TARG, HvNAME(hv)); + sv_setpv(TARG, stashname); PUSHs(TARG); } RETURN; } - hv = cx->blk_oldcop->cop_stash; - if (!hv) + if (!stashname) PUSHs(&PL_sv_undef); else - PUSHs(sv_2mortal(newSVpv(HvNAME(hv), 0))); - PUSHs(sv_2mortal(newSVpvn(SvPVX(GvSV(cx->blk_oldcop->cop_filegv)), - SvCUR(GvSV(cx->blk_oldcop->cop_filegv))))); - PUSHs(sv_2mortal(newSViv((I32)cx->blk_oldcop->cop_line))); + PUSHs(sv_2mortal(newSVpv(stashname, 0))); + PUSHs(sv_2mortal(newSVpv(CopFILE(cx->blk_oldcop), 0))); + PUSHs(sv_2mortal(newSViv((I32)CopLINE(cx->blk_oldcop)))); if (!MAXARG) RETURN; - if (CxTYPE(cx) == CXt_SUB) { /* So is ccstack[dbcxix]. */ + if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) { + /* So is ccstack[dbcxix]. */ sv = NEWSV(49, 0); gv_efullname3(sv, CvGV(ccstack[cxix].blk_sub.cv), Nullch); PUSHs(sv_2mortal(sv)); @@ -1478,7 +1525,7 @@ PP(pp_caller) PUSHs(&PL_sv_undef); } if (CxTYPE(cx) == CXt_SUB && cx->blk_sub.hasargs - && PL_curcop->cop_stash == PL_debstash) + && CopSTASH_eq(PL_curcop, PL_debstash)) { AV *ary = cx->blk_sub.argarray; int off = AvARRAY(ary) - AvALLOC(ary); @@ -1514,7 +1561,7 @@ PP(pp_reset) tmps = ""; else tmps = POPpx; - sv_reset(tmps, PL_curcop->cop_stash); + sv_reset(tmps, CopSTASH(PL_curcop)); PUSHs(&PL_sv_yes); RETURN; } @@ -1562,7 +1609,7 @@ PP(pp_dbstate) PUSHSUB(cx); CvDEPTH(cv)++; (void)SvREFCNT_inc(cv); - SAVESPTR(PL_curpad); + SAVEVPTR(PL_curpad); PL_curpad = AvARRAY((AV*)*av_fetch(CvPADLIST(cv),1,FALSE)); RETURNOP(CvSTART(cv)); } @@ -1581,6 +1628,10 @@ PP(pp_enteriter) register PERL_CONTEXT *cx; I32 gimme = GIMME_V; SV **svp; + U32 cxtype = CXt_LOOP; +#ifdef USE_ITHREADS + void *iterdata; +#endif ENTER; SAVETMPS; @@ -1597,23 +1648,39 @@ PP(pp_enteriter) if (PL_op->op_targ) { svp = &PL_curpad[PL_op->op_targ]; /* "my" variable */ SAVESPTR(*svp); +#ifdef USE_ITHREADS + iterdata = (void*)PL_op->op_targ; + cxtype |= CXp_PADVAR; +#endif } else { - svp = &GvSV((GV*)POPs); /* symbol table variable */ + GV *gv = (GV*)POPs; + svp = &GvSV(gv); /* symbol table variable */ SAVEGENERICSV(*svp); *svp = NEWSV(0,0); +#ifdef USE_ITHREADS + iterdata = (void*)gv; +#endif } ENTER; - PUSHBLOCK(cx, CXt_LOOP, SP); + PUSHBLOCK(cx, cxtype, SP); +#ifdef USE_ITHREADS + PUSHLOOP(cx, iterdata, MARK); +#else PUSHLOOP(cx, svp, MARK); +#endif if (PL_op->op_flags & OPf_STACKED) { cx->blk_loop.iterary = (AV*)SvREFCNT_inc(POPs); if (SvTYPE(cx->blk_loop.iterary) != SVt_PVAV) { dPOPss; if (SvNIOKp(sv) || !SvPOKp(sv) || - (looks_like_number(sv) && *SvPVX(sv) != '0')) { + SvNIOKp(cx->blk_loop.iterary) || !SvPOKp(cx->blk_loop.iterary) || + (looks_like_number(sv) && *SvPVX(sv) != '0' && + looks_like_number((SV*)cx->blk_loop.iterary) && + *SvPVX(cx->blk_loop.iterary) != '0')) + { if (SvNV(sv) < IV_MIN || SvNV((SV*)cx->blk_loop.iterary) >= IV_MAX) DIE(aTHX_ "Range iterator outside integer range"); @@ -1653,7 +1720,6 @@ PP(pp_leaveloop) { djSP; register PERL_CONTEXT *cx; - struct block_loop cxloop; I32 gimme; SV **newsp; PMOP *newpm; @@ -1661,7 +1727,7 @@ PP(pp_leaveloop) POPBLOCK(cx,newpm); mark = newsp; - POPLOOP1(cx); /* Delay POPLOOP2 until stack values are safe */ + newsp = PL_stack_base + cx->blk_loop.resetsp; TAINT_NOT; if (gimme == G_VOID) @@ -1681,7 +1747,7 @@ PP(pp_leaveloop) SP = newsp; PUTBACK; - POPLOOP2(); /* Stack values are safe: release loop vars ... */ + POPLOOP(cx); /* Stack values are safe: release loop vars ... */ PL_curpm = newpm; /* ... and pop $1 et al */ LEAVE; @@ -1695,15 +1761,17 @@ PP(pp_return) djSP; dMARK; I32 cxix; register PERL_CONTEXT *cx; - struct block_sub cxsub; bool popsub2 = FALSE; I32 gimme; SV **newsp; PMOP *newpm; I32 optype = 0; + SV *sv; if (PL_curstackinfo->si_type == PERLSI_SORT) { - if (cxstack_ix == PL_sortcxix || dopoptosub(cxstack_ix) <= PL_sortcxix) { + if (cxstack_ix == PL_sortcxix + || dopoptosub(cxstack_ix) <= PL_sortcxix) + { if (cxstack_ix > PL_sortcxix) dounwind(PL_sortcxix); AvARRAY(PL_curstack)[1] = *SP; @@ -1721,7 +1789,6 @@ PP(pp_return) POPBLOCK(cx,newpm); switch (CxTYPE(cx)) { case CXt_SUB: - POPSUB1(cx); /* Delay POPSUB2 until stack values are safe */ popsub2 = TRUE; break; case CXt_EVAL: @@ -1738,6 +1805,9 @@ PP(pp_return) DIE(aTHX_ "%s did not return a true value", name); } break; + case CXt_FORMAT: + POPFORMAT(cx); + break; default: DIE(aTHX_ "panic: return"); } @@ -1746,7 +1816,7 @@ PP(pp_return) if (gimme == G_SCALAR) { if (MARK < SP) { if (popsub2) { - if (cxsub.cv && CvDEPTH(cxsub.cv) > 1) { + if (cx->blk_sub.cv && CvDEPTH(cx->blk_sub.cv) > 1) { if (SvTEMP(TOPs)) { *++newsp = SvREFCNT_inc(*SP); FREETMPS; @@ -1773,11 +1843,14 @@ PP(pp_return) /* Stack values are safe: */ if (popsub2) { - POPSUB2(); /* release CV and @_ ... */ + POPSUB(cx,sv); /* release CV and @_ ... */ } + else + sv = Nullsv; PL_curpm = newpm; /* ... and pop $1 et al */ LEAVE; + LEAVESUB(sv); return pop_return(); } @@ -1786,20 +1859,19 @@ PP(pp_last) djSP; I32 cxix; register PERL_CONTEXT *cx; - struct block_loop cxloop; - struct block_sub cxsub; I32 pop2 = 0; I32 gimme; I32 optype; OP *nextop; SV **newsp; PMOP *newpm; - SV **mark = PL_stack_base + cxstack[cxstack_ix].blk_oldsp; + SV **mark; + SV *sv = Nullsv; if (PL_op->op_flags & OPf_SPECIAL) { cxix = dopoptoloop(cxstack_ix); if (cxix < 0) - DIE(aTHX_ "Can't \"last\" outside a block"); + DIE(aTHX_ "Can't \"last\" outside a loop block"); } else { cxix = dopoptolabel(cPVOP->op_pv); @@ -1810,14 +1882,14 @@ PP(pp_last) dounwind(cxix); POPBLOCK(cx,newpm); + mark = newsp; switch (CxTYPE(cx)) { case CXt_LOOP: - POPLOOP1(cx); /* Delay POPLOOP2 until stack values are safe */ pop2 = CXt_LOOP; - nextop = cxloop.last_op->op_next; + newsp = PL_stack_base + cx->blk_loop.resetsp; + nextop = cx->blk_loop.last_op->op_next; break; case CXt_SUB: - POPSUB1(cx); /* Delay POPSUB2 until stack values are safe */ pop2 = CXt_SUB; nextop = pop_return(); break; @@ -1825,6 +1897,10 @@ PP(pp_last) POPEVAL(cx); nextop = pop_return(); break; + case CXt_FORMAT: + POPFORMAT(cx); + nextop = pop_return(); + break; default: DIE(aTHX_ "panic: last"); } @@ -1850,16 +1926,17 @@ PP(pp_last) /* Stack values are safe: */ switch (pop2) { case CXt_LOOP: - POPLOOP2(); /* release loop vars ... */ + POPLOOP(cx); /* release loop vars ... */ LEAVE; break; case CXt_SUB: - POPSUB2(); /* release CV and @_ ... */ + POPSUB(cx,sv); /* release CV and @_ ... */ break; } PL_curpm = newpm; /* ... and pop $1 et al */ LEAVE; + LEAVESUB(sv); return nextop; } @@ -1872,7 +1949,7 @@ PP(pp_next) if (PL_op->op_flags & OPf_SPECIAL) { cxix = dopoptoloop(cxstack_ix); if (cxix < 0) - DIE(aTHX_ "Can't \"next\" outside a block"); + DIE(aTHX_ "Can't \"next\" outside a loop block"); } else { cxix = dopoptolabel(cPVOP->op_pv); @@ -1897,7 +1974,7 @@ PP(pp_redo) if (PL_op->op_flags & OPf_SPECIAL) { cxix = dopoptoloop(cxstack_ix); if (cxix < 0) - DIE(aTHX_ "Can't \"redo\" outside a block"); + DIE(aTHX_ "Can't \"redo\" outside a loop block"); } else { cxix = dopoptolabel(cPVOP->op_pv); @@ -2070,7 +2147,7 @@ PP(pp_goto) SP[1] = SP[0]; SP--; } - fp3 = (I32(*)(int,int,int)))CvXSUB(cv; + fp3 = (I32(*)(int,int,int))CvXSUB(cv); items = (*fp3)(CvXSUBANY(cv).any_i32, mark - PL_stack_base + 1, items); @@ -2114,9 +2191,10 @@ PP(pp_goto) AV *newpad = newAV(); SV **oldpad = AvARRAY(svp[CvDEPTH(cv)-1]); I32 ix = AvFILLp((AV*)svp[1]); + I32 names_fill = AvFILLp((AV*)svp[0]); svp = AvARRAY(svp[0]); for ( ;ix > 0; ix--) { - if (svp[ix] != &PL_sv_undef) { + if (names_fill >= ix && svp[ix] != &PL_sv_undef) { char *name = SvPVX(svp[ix]); if ((SvFLAGS(svp[ix]) & SVf_FAKE) || *name == '&') @@ -2135,6 +2213,9 @@ PP(pp_goto) SvPADMY_on(sv); } } + else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) { + av_store(newpad, ix, sv = SvREFCNT_inc(oldpad[ix])); + } else { av_store(newpad, ix, sv = NEWSV(0,0)); SvPADTMP_on(sv); @@ -2165,7 +2246,7 @@ PP(pp_goto) } } #endif /* USE_THREADS */ - SAVESPTR(PL_curpad); + SAVEVPTR(PL_curpad); PL_curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]); #ifndef USE_THREADS if (cx->blk_sub.hasargs) @@ -2270,8 +2351,9 @@ PP(pp_goto) break; } /* FALL THROUGH */ + case CXt_FORMAT: case CXt_NULL: - DIE(aTHX_ "Can't \"goto\" outside a block"); + DIE(aTHX_ "Can't \"goto\" out of a pseudo block"); default: if (ix) DIE(aTHX_ "panic: goto"); @@ -2347,6 +2429,7 @@ PP(pp_exit) anum = 0; #endif } + PL_exit_flags |= PERL_EXIT_EXPECTED; my_exit(anum); PUSHs(&PL_sv_undef); RETURN; @@ -2432,18 +2515,20 @@ S_docatch(pTHX_ OP *o) dTHR; int ret; OP *oldop = PL_op; + volatile PERL_SI *cursi = PL_curstackinfo; + dJMPENV; #ifdef DEBUGGING assert(CATCH_GET == TRUE); #endif PL_op = o; redo_body: - CALLPROTECT(aTHX_ &ret, MEMBER_TO_FPTR(S_docatch_body)); + CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_docatch_body)); switch (ret) { case 0: break; case 3: - if (PL_restartop) { + if (PL_restartop && cursi == PL_curstackinfo) { PL_op = PL_restartop; PL_restartop = 0; goto redo_body; @@ -2480,14 +2565,14 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, AV** avp) /* switch to eval mode */ if (PL_curcop == &PL_compiling) { - SAVESPTR(PL_compiling.cop_stash); - PL_compiling.cop_stash = PL_curstash; + SAVECOPSTASH(&PL_compiling); + CopSTASH_set(&PL_compiling, PL_curstash); } - SAVESPTR(PL_compiling.cop_filegv); - SAVEI16(PL_compiling.cop_line); + SAVECOPFILE(&PL_compiling); + SAVECOPLINE(&PL_compiling); sprintf(tmpbuf, "_<(%.10s_eval %lu)", code, (unsigned long)++PL_evalseq); - PL_compiling.cop_filegv = gv_fetchfile(tmpbuf+2); - PL_compiling.cop_line = 1; + CopFILE_set(&PL_compiling, tmpbuf+2); + CopLINE_set(&PL_compiling, 1); /* XXX For Cs within BEGIN {} blocks, this ends up deleting the eval's FILEGV from the stash before gv_check() runs (i.e. before run-time proper). To work around the coredump that @@ -2499,7 +2584,7 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, AV** avp) #ifdef OP_IN_REGISTER PL_opsave = op; #else - SAVEPPTR(PL_op); + SAVEVPTR(PL_op); #endif PL_hints = 0; @@ -2507,7 +2592,7 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, char *code, AV** avp) PL_op->op_type = OP_ENTEREVAL; PL_op->op_flags = 0; /* Avoid uninit warning. */ PUSHBLOCK(cx, CXt_EVAL, SP); - PUSHEVAL(cx, 0, PL_compiling.cop_filegv); + PUSHEVAL(cx, 0, Nullgv); rop = doeval(G_SCALAR, startop); POPBLOCK(cx,PL_curpm); POPEVAL(cx); @@ -2531,7 +2616,6 @@ S_doeval(pTHX_ int gimme, OP** startop) { dSP; OP *saveop = PL_op; - HV *newstash; CV *caller; AV* comppadlist; I32 i; @@ -2543,7 +2627,7 @@ S_doeval(pTHX_ int gimme, OP** startop) /* set up a scratch pad */ SAVEI32(PL_padix); - SAVESPTR(PL_curpad); + SAVEVPTR(PL_curpad); SAVESPTR(PL_comppad); SAVESPTR(PL_comppad_name); SAVEI32(PL_comppad_name_fill); @@ -2555,7 +2639,7 @@ S_doeval(pTHX_ int gimme, OP** startop) PERL_CONTEXT *cx = &cxstack[i]; if (CxTYPE(cx) == CXt_EVAL) break; - else if (CxTYPE(cx) == CXt_SUB) { + else if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) { caller = cx->blk_sub.cv; break; } @@ -2597,10 +2681,9 @@ S_doeval(pTHX_ int gimme, OP** startop) /* make sure we compile in the right package */ - newstash = PL_curcop->cop_stash; - if (PL_curstash != newstash) { + if (CopSTASH_ne(PL_curcop, PL_curstash)) { SAVESPTR(PL_curstash); - PL_curstash = newstash; + PL_curstash = CopSTASH(PL_curcop); } SAVESPTR(PL_beginav); PL_beginav = newAV(); @@ -2663,7 +2746,7 @@ S_doeval(pTHX_ int gimme, OP** startop) } SvREFCNT_dec(PL_rs); PL_rs = SvREFCNT_inc(PL_nrs); - PL_compiling.cop_line = 0; + CopLINE_set(&PL_compiling, 0); if (startop) { *startop = PL_eval_root; SvREFCNT_dec(CvOUTSIDE(PL_compcv)); @@ -2685,7 +2768,7 @@ S_doeval(pTHX_ int gimme, OP** startop) if (cv) { dSP; PUSHMARK(SP); - XPUSHs((SV*)PL_compiling.cop_filegv); + XPUSHs((SV*)CopFILEGV(&PL_compiling)); PUTBACK; call_sv((SV*)cv, G_DISCARD); } @@ -2757,10 +2840,54 @@ PP(pp_require) SV *filter_sub = 0; sv = POPs; - if (SvNIOKp(sv) && !SvPOKp(sv)) { - if (Atof(PL_patchlevel) + 0.00000999 < SvNV(sv)) - DIE(aTHX_ "Perl %s required--this is only version %s, stopped", - SvPV(sv,n_a),PL_patchlevel); + if (SvNIOKp(sv)) { + UV rev, ver, sver; + if (SvPOKp(sv) && SvUTF8(sv)) { /* require v5.6.1 */ + I32 len; + U8 *s = (U8*)SvPVX(sv); + U8 *end = (U8*)SvPVX(sv) + SvCUR(sv); + if (s < end) { + rev = utf8_to_uv(s, &len); + s += len; + if (s < end) { + ver = utf8_to_uv(s, &len); + s += len; + if (s < end) + sver = utf8_to_uv(s, &len); + else + sver = 0; + } + else + ver = 0; + } + else + rev = 0; + if (PERL_REVISION < rev + || (PERL_REVISION == rev + && (PERL_VERSION < ver + || (PERL_VERSION == ver + && PERL_SUBVERSION < sver)))) + { + DIE(aTHX_ "Perl v%"UVuf".%"UVuf".%"UVuf" required--this is only version " + "v%"UVuf".%"UVuf".%"UVuf", stopped", rev, ver, sver, PERL_REVISION, + PERL_VERSION, PERL_SUBVERSION); + } + } + else if (!SvPOKp(sv)) { /* require 5.005_03 */ + NV n = SvNV(sv); + rev = (UV)n; + ver = (UV)((n-rev)*1000); + sver = (UV)((((n-rev)*1000 - ver) + 0.0009) * 1000); + + if ((NV)PERL_REVISION + ((NV)PERL_VERSION/(NV)1000) + + ((NV)PERL_SUBVERSION/(NV)1000000) + + 0.00000099 < SvNV(sv)) + { + DIE(aTHX_ "Perl v%"UVuf".%"UVuf".%"UVuf" required--this is only version " + "v%"UVuf".%"UVuf".%"UVuf", stopped", rev, ver, sver, PERL_REVISION, + PERL_VERSION, PERL_SUBVERSION); + } + } RETPUSHYES; } name = SvPV(sv, len); @@ -2774,21 +2901,9 @@ PP(pp_require) /* prepare to compile file */ - if (*name == '/' || - (*name == '.' && - (name[1] == '/' || - (name[1] == '.' && name[2] == '/'))) -#ifdef DOSISH - || (name[0] && name[1] == ':') -#endif -#ifdef WIN32 - || (name[0] == '\\' && name[1] == '\\') /* UNC path */ -#endif -#ifdef VMS - || (strchr(name,':') || ((*name == '[' || *name == '<') && - (isALNUM(name[1]) || strchr("$-_]>",name[1])))) -#endif - ) + if (PERL_FILE_IS_ABSOLUTE(name) + || (*name == '.' && (name[1] == '/' || + (name[1] == '.' && name[2] == '/')))) { tryname = name; tryrsfp = doopen_pmc(name,PERL_SCRIPT_MODE); @@ -2813,8 +2928,8 @@ PP(pp_require) loader = *av_fetch((AV *)SvRV(loader), 0, TRUE); } - Perl_sv_setpvf(aTHX_ namesv, "/loader/0x%lx/%s", - SvANY(loader), name); + Perl_sv_setpvf(aTHX_ namesv, "/loader/0x%"UVxf"/%s", + PTR2UV(SvANY(loader)), name); tryname = SvPVX(namesv); tryrsfp = 0; @@ -2932,8 +3047,8 @@ PP(pp_require) } } } - SAVESPTR(PL_compiling.cop_filegv); - PL_compiling.cop_filegv = gv_fetchfile(tryrsfp ? tryname : name); + SAVECOPFILE(&PL_compiling); + CopFILE_set(&PL_compiling, tryrsfp ? tryname : name); SvREFCNT_dec(namesv); if (!tryrsfp) { if (PL_op->op_type == OP_REQUIRE) { @@ -2968,7 +3083,7 @@ PP(pp_require) /* Assume success here to prevent recursive requirement. */ (void)hv_store(GvHVn(PL_incgv), name, strlen(name), - newSVsv(GvSV(PL_compiling.cop_filegv)), 0 ); + newSVpv(CopFILE(&PL_compiling), 0), 0 ); ENTER; SAVETMPS; @@ -2977,11 +3092,9 @@ PP(pp_require) PL_rsfp_filters = Nullav; PL_rsfp = tryrsfp; - name = savepv(name); - SAVEFREEPV(name); SAVEHINTS(); PL_hints = 0; - SAVEPPTR(PL_compiling.cop_warnings); + SAVESPTR(PL_compiling.cop_warnings); if (PL_dowarn & G_WARN_ALL_ON) PL_compiling.cop_warnings = WARN_ALL ; else if (PL_dowarn & G_WARN_ALL_OFF) @@ -3000,10 +3113,10 @@ PP(pp_require) /* switch to eval mode */ push_return(PL_op->op_next); PUSHBLOCK(cx, CXt_EVAL, SP); - PUSHEVAL(cx, name, PL_compiling.cop_filegv); + PUSHEVAL(cx, name, Nullgv); - SAVEI16(PL_compiling.cop_line); - PL_compiling.cop_line = 0; + SAVECOPLINE(&PL_compiling); + CopLINE_set(&PL_compiling, 0); PUTBACK; #ifdef USE_THREADS @@ -3043,10 +3156,10 @@ PP(pp_entereval) /* switch to eval mode */ - SAVESPTR(PL_compiling.cop_filegv); + SAVECOPFILE(&PL_compiling); sprintf(tmpbuf, "_<(eval %lu)", (unsigned long)++PL_evalseq); - PL_compiling.cop_filegv = gv_fetchfile(tmpbuf+2); - PL_compiling.cop_line = 1; + CopFILE_set(&PL_compiling, tmpbuf+2); + CopLINE_set(&PL_compiling, 1); /* XXX For Cs within BEGIN {} blocks, this ends up deleting the eval's FILEGV from the stash before gv_check() runs (i.e. before run-time proper). To work around the coredump that @@ -3056,7 +3169,7 @@ PP(pp_entereval) SAVEDELETE(PL_defstash, safestr, strlen(safestr)); SAVEHINTS(); PL_hints = PL_op->op_targ; - SAVEPPTR(PL_compiling.cop_warnings); + SAVESPTR(PL_compiling.cop_warnings); if (!specialWARN(PL_compiling.cop_warnings)) { PL_compiling.cop_warnings = newSVsv(PL_compiling.cop_warnings) ; SAVEFREESV(PL_compiling.cop_warnings) ; @@ -3064,12 +3177,12 @@ PP(pp_entereval) push_return(PL_op->op_next); PUSHBLOCK(cx, (CXt_EVAL|CXp_REAL), SP); - PUSHEVAL(cx, 0, PL_compiling.cop_filegv); + PUSHEVAL(cx, 0, Nullgv); /* prepare to compile string */ if (PERLDB_LINE && PL_curstash != PL_debstash) - save_lines(GvAV(PL_compiling.cop_filegv), PL_linestr); + save_lines(CopFILEAV(&PL_compiling), PL_linestr); PUTBACK; #ifdef USE_THREADS MUTEX_LOCK(&PL_eval_mutex); @@ -3118,6 +3231,7 @@ PP(pp_leaveeval) MEXTEND(mark,0); *MARK = &PL_sv_undef; } + SP = MARK; } else { /* in case LEAVE wipes old return values */ @@ -4083,7 +4197,6 @@ S_qsortsv(pTHX_ SV ** array, size_t num_elts, SVCOMPARE_t compare) #ifdef PERL_OBJECT -#define NO_XSLOCKS #undef this #define this pPerl #include "XSUB.h" @@ -4114,6 +4227,80 @@ sortcv(pTHXo_ SV *a, SV *b) return result; } +static I32 +sortcv_stacked(pTHXo_ SV *a, SV *b) +{ + dTHR; + I32 oldsaveix = PL_savestack_ix; + I32 oldscopeix = PL_scopestack_ix; + I32 result; + AV *av; + +#ifdef USE_THREADS + av = (AV*)PL_curpad[0]; +#else + av = GvAV(PL_defgv); +#endif + + if (AvMAX(av) < 1) { + SV** ary = AvALLOC(av); + if (AvARRAY(av) != ary) { + AvMAX(av) += AvARRAY(av) - AvALLOC(av); + SvPVX(av) = (char*)ary; + } + if (AvMAX(av) < 1) { + AvMAX(av) = 1; + Renew(ary,2,SV*); + SvPVX(av) = (char*)ary; + } + } + AvFILLp(av) = 1; + + AvARRAY(av)[0] = a; + AvARRAY(av)[1] = b; + PL_stack_sp = PL_stack_base; + PL_op = PL_sortcop; + CALLRUNOPS(aTHX); + if (PL_stack_sp != PL_stack_base + 1) + Perl_croak(aTHX_ "Sort subroutine didn't return single value"); + if (!SvNIOKp(*PL_stack_sp)) + Perl_croak(aTHX_ "Sort subroutine didn't return a numeric value"); + result = SvIV(*PL_stack_sp); + while (PL_scopestack_ix > oldscopeix) { + LEAVE; + } + leave_scope(oldsaveix); + return result; +} + +static I32 +sortcv_xsub(pTHXo_ SV *a, SV *b) +{ + dSP; + I32 oldsaveix = PL_savestack_ix; + I32 oldscopeix = PL_scopestack_ix; + I32 result; + CV *cv=(CV*)PL_sortcop; + + SP = PL_stack_base; + PUSHMARK(SP); + EXTEND(SP, 2); + *++SP = a; + *++SP = b; + PUTBACK; + (void)(*CvXSUB(cv))(aTHXo_ cv); + if (PL_stack_sp != PL_stack_base + 1) + Perl_croak(aTHX_ "Sort subroutine didn't return single value"); + if (!SvNIOKp(*PL_stack_sp)) + Perl_croak(aTHX_ "Sort subroutine didn't return a numeric value"); + result = SvIV(*PL_stack_sp); + while (PL_scopestack_ix > oldscopeix) { + LEAVE; + } + leave_scope(oldsaveix); + return result; +} + static I32 sv_ncmp(pTHXo_ SV *a, SV *b) diff --git a/pp_hot.c b/pp_hot.c index 904ee9f..1e669c8 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -29,7 +29,6 @@ #include #endif -#define HOP(pos,off) (IN_UTF8 ? utf8_hop(pos, off) : (pos + off)) /* Hot code. */ @@ -40,7 +39,7 @@ static void unset_cvowner(pTHXo_ void *cvarg); PP(pp_const) { djSP; - XPUSHs(cSVOP->op_sv); + XPUSHs(cSVOP_sv); RETURN; } @@ -58,9 +57,9 @@ PP(pp_gvsv) djSP; EXTEND(SP,1); if (PL_op->op_private & OPpLVAL_INTRO) - PUSHs(save_scalar(cGVOP->op_gv)); + PUSHs(save_scalar(cGVOP_gv)); else - PUSHs(GvSV(cGVOP->op_gv)); + PUSHs(GvSV(cGVOP_gv)); RETURN; } @@ -95,7 +94,7 @@ PP(pp_stringify) PP(pp_gv) { djSP; - XPUSHs((SV*)cGVOP->op_gv); + XPUSHs((SV*)cGVOP_gv); RETURN; } @@ -153,8 +152,14 @@ PP(pp_concat) dPOPTOPssrl; STRLEN len; char *s; + if (TARG != left) { s = SvPV(left,len); + if (TARG == right) { + sv_insert(TARG, 0, 0, s, len); + SETs(TARG); + RETURN; + } sv_setpvn(TARG,s,len); } else if (SvGMAGICAL(TARG)) @@ -271,7 +276,7 @@ PP(pp_add) PP(pp_aelemfast) { djSP; - AV *av = GvAV((GV*)cSVOP->op_sv); + AV *av = GvAV(cGVOP_gv); U32 lval = PL_op->op_flags & OPf_MOD; SV** svp = av_fetch(av, PL_op->op_private, lval); SV *sv = (svp ? *svp : &PL_sv_undef); @@ -368,7 +373,7 @@ PP(pp_print) SvPV(sv,n_a)); else if (ckWARN(WARN_CLOSED)) Perl_warner(aTHX_ WARN_CLOSED, - "print on closed filehandle %s", SvPV(sv,n_a)); + "print() on closed filehandle %s", SvPV(sv,n_a)); } SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI); goto just_say_no; @@ -459,7 +464,7 @@ PP(pp_rv2av) PL_op->op_private & HINT_STRICT_REFS) DIE(aTHX_ PL_no_usym, "an ARRAY"); if (ckWARN(WARN_UNINITIALIZED)) - Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit); + report_uninit(); if (GIMME == G_ARRAY) { (void)POPs; RETURN; @@ -559,7 +564,7 @@ PP(pp_rv2hv) PL_op->op_private & HINT_STRICT_REFS) DIE(aTHX_ PL_no_usym, "a HASH"); if (ckWARN(WARN_UNINITIALIZED)) - Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit); + report_uninit(); if (GIMME == G_ARRAY) { SP--; RETURN; @@ -601,15 +606,9 @@ PP(pp_rv2hv) dTARGET; if (SvTYPE(hv) == SVt_PVAV) hv = avhv_keys((AV*)hv); -#ifdef IV_IS_QUAD - if (HvFILL(hv)) - Perl_sv_setpvf(aTHX_ TARG, "%" PERL_PRId64 "/%" PERL_PRId64, - (Quad_t)HvFILL(hv), (Quad_t)HvMAX(hv) + 1); -#else if (HvFILL(hv)) - Perl_sv_setpvf(aTHX_ TARG, "%ld/%ld", - (long)HvFILL(hv), (long)HvMAX(hv) + 1); -#endif + Perl_sv_setpvf(aTHX_ TARG, "%"IVdf"/%"IVdf, + (IV)HvFILL(hv), (IV)HvMAX(hv) + 1); else sv_setiv(TARG, 0); @@ -1091,9 +1090,9 @@ Perl_do_readline(pTHX) if (!fp) { if (IoFLAGS(io) & IOf_ARGV) { if (IoFLAGS(io) & IOf_START) { - IoFLAGS(io) &= ~IOf_START; IoLINES(io) = 0; if (av_len(GvAVn(PL_last_in_gv)) < 0) { + IoFLAGS(io) &= ~IOf_START; do_open(PL_last_in_gv,"-",1,FALSE,O_RDONLY,0,Nullfp); sv_setpvn(GvSV(PL_last_in_gv), "-", 1); SvSETMAGIC(GvSV(PL_last_in_gv)); @@ -1104,7 +1103,6 @@ Perl_do_readline(pTHX) fp = nextargv(PL_last_in_gv); if (!fp) { /* Note: fp != IoIFP(io) */ (void)do_close(PL_last_in_gv, FALSE); /* now it does*/ - IoFLAGS(io) |= IOf_START; } } else if (type == OP_GLOB) { @@ -1196,6 +1194,11 @@ Perl_do_readline(pTHX) } } #else /* !VMS */ +#ifdef MACOS_TRADITIONAL + sv_setpv(tmpcmd, "glob "); + sv_catsv(tmpcmd, tmpglob); + sv_catpv(tmpcmd, " |"); +#else #ifdef DOSISH #ifdef OS2 sv_setpv(tmpcmd, "for a in "); @@ -1227,6 +1230,7 @@ Perl_do_readline(pTHX) #endif #endif /* !CSH */ #endif /* !DOSISH */ +#endif /* MACOS_TRADITIONAL */ (void)do_open(PL_last_in_gv, SvPVX(tmpcmd), SvCUR(tmpcmd), FALSE, O_RDONLY, 0, Nullfp); fp = IoIFP(io); @@ -1256,7 +1260,7 @@ Perl_do_readline(pTHX) SV* sv = sv_newmortal(); gv_efullname3(sv, PL_last_in_gv, Nullch); Perl_warner(aTHX_ WARN_CLOSED, - "Read on closed filehandle %s", + "readline() on closed filehandle %s", SvPV_nolen(sv)); } } @@ -1285,12 +1289,11 @@ Perl_do_readline(pTHX) offset = 0; } -/* flip-flop EOF state for a snarfed empty file */ +/* delay EOF state for a snarfed empty file */ #define SNARF_EOF(gimme,rs,io,sv) \ - ((gimme != G_SCALAR || SvCUR(sv) \ - || (IoFLAGS(io) & IOf_NOLINE) || IoLINES(io) || !RsSNARF(rs)) \ - ? ((IoFLAGS(io) &= ~IOf_NOLINE), TRUE) \ - : ((IoFLAGS(io) |= IOf_NOLINE), FALSE)) + (gimme != G_SCALAR || SvCUR(sv) \ + || !RsSNARF(rs) || (IoFLAGS(io) & IOf_NOLINE) \ + || ((IoFLAGS(io) |= IOf_NOLINE), FALSE)) for (;;) { if (!sv_gets(sv, fp, offset) @@ -1302,7 +1305,6 @@ Perl_do_readline(pTHX) if (fp) continue; (void)do_close(PL_last_in_gv, FALSE); - IoFLAGS(io) |= IOf_START; } else if (type == OP_GLOB) { if (!do_close(PL_last_in_gv, FALSE) && ckWARN(WARN_CLOSED)) { @@ -1511,12 +1513,14 @@ PP(pp_iter) register PERL_CONTEXT *cx; SV* sv; AV* av; + SV **itersvp; EXTEND(SP, 1); cx = &cxstack[cxstack_ix]; if (CxTYPE(cx) != CXt_LOOP) DIE(aTHX_ "panic: pp_iter"); + itersvp = CxITERVAR(cx); av = cx->blk_loop.iterary; if (SvTYPE(av) != SVt_PVAV) { /* iterate ($min .. $max) */ @@ -1527,11 +1531,9 @@ PP(pp_iter) char *max = SvPV((SV*)av, maxlen); if (!SvNIOK(cur) && SvCUR(cur) <= maxlen) { #ifndef USE_THREADS /* don't risk potential race */ - if (SvREFCNT(*cx->blk_loop.itervar) == 1 - && !SvMAGICAL(*cx->blk_loop.itervar)) - { + if (SvREFCNT(*itersvp) == 1 && !SvMAGICAL(*itersvp)) { /* safe to reuse old SV */ - sv_setsv(*cx->blk_loop.itervar, cur); + sv_setsv(*itersvp, cur); } else #endif @@ -1539,8 +1541,8 @@ PP(pp_iter) /* we need a fresh SV every time so that loop body sees a * completely new SV for closures/references to work as * they used to */ - SvREFCNT_dec(*cx->blk_loop.itervar); - *cx->blk_loop.itervar = newSVsv(cur); + SvREFCNT_dec(*itersvp); + *itersvp = newSVsv(cur); } if (strEQ(SvPVX(cur), max)) sv_setiv(cur, 0); /* terminate next time */ @@ -1555,11 +1557,9 @@ PP(pp_iter) RETPUSHNO; #ifndef USE_THREADS /* don't risk potential race */ - if (SvREFCNT(*cx->blk_loop.itervar) == 1 - && !SvMAGICAL(*cx->blk_loop.itervar)) - { + if (SvREFCNT(*itersvp) == 1 && !SvMAGICAL(*itersvp)) { /* safe to reuse old SV */ - sv_setiv(*cx->blk_loop.itervar, cx->blk_loop.iterix++); + sv_setiv(*itersvp, cx->blk_loop.iterix++); } else #endif @@ -1567,8 +1567,8 @@ PP(pp_iter) /* we need a fresh SV every time so that loop body sees a * completely new SV for closures/references to work as they * used to */ - SvREFCNT_dec(*cx->blk_loop.itervar); - *cx->blk_loop.itervar = newSViv(cx->blk_loop.iterix++); + SvREFCNT_dec(*itersvp); + *itersvp = newSViv(cx->blk_loop.iterix++); } RETPUSHYES; } @@ -1577,7 +1577,7 @@ PP(pp_iter) if (cx->blk_loop.iterix >= (av == PL_curstack ? cx->blk_oldsp : AvFILL(av))) RETPUSHNO; - SvREFCNT_dec(*cx->blk_loop.itervar); + SvREFCNT_dec(*itersvp); if (sv = (SvMAGICAL(av)) ? *av_fetch(av, ++cx->blk_loop.iterix, FALSE) @@ -1605,7 +1605,7 @@ PP(pp_iter) sv = (SV*)lv; } - *cx->blk_loop.itervar = SvREFCNT_inc(sv); + *itersvp = SvREFCNT_inc(sv); RETPUSHYES; } @@ -1902,7 +1902,7 @@ PP(pp_grepwhile) SV *src; ENTER; /* enter inner scope */ - SAVESPTR(PL_curpm); + SAVEVPTR(PL_curpm); src = PL_stack_base[*PL_markstack_ptr]; SvTEMP_off(src); @@ -1920,16 +1920,15 @@ PP(pp_leavesub) PMOP *newpm; I32 gimme; register PERL_CONTEXT *cx; - struct block_sub cxsub; + SV *sv; POPBLOCK(cx,newpm); - POPSUB1(cx); /* Delay POPSUB2 until stack values are safe */ TAINT_NOT; if (gimme == G_SCALAR) { MARK = newsp + 1; if (MARK <= SP) { - if (cxsub.cv && CvDEPTH(cxsub.cv) > 1) { + if (cx->blk_sub.cv && CvDEPTH(cx->blk_sub.cv) > 1) { if (SvTEMP(TOPs)) { *MARK = SvREFCNT_inc(TOPs); FREETMPS; @@ -1959,10 +1958,11 @@ PP(pp_leavesub) } PUTBACK; - POPSUB2(); /* Stack values are safe: release CV and @_ ... */ + POPSUB(cx,sv); /* Stack values are safe: release CV and @_ ... */ PL_curpm = newpm; /* ... and pop $1 et al */ LEAVE; + LEAVESUB(sv); return pop_return(); } @@ -1976,10 +1976,9 @@ PP(pp_leavesublv) PMOP *newpm; I32 gimme; register PERL_CONTEXT *cx; - struct block_sub cxsub; + SV *sv; POPBLOCK(cx,newpm); - POPSUB1(cx); /* Delay POPSUB2 until stack values are safe */ TAINT_NOT; @@ -1994,7 +1993,7 @@ PP(pp_leavesublv) if (gimme == G_SCALAR) goto temporise; if (gimme == G_ARRAY) { - if (!CvLVALUE(cxsub.cv)) + if (!CvLVALUE(cx->blk_sub.cv)) goto temporise_array; EXTEND_MORTAL(SP - newsp); for (mark = newsp + 1; mark <= SP; mark++) { @@ -2005,7 +2004,7 @@ PP(pp_leavesublv) else { /* Can be a localized value subject to deletion. */ PL_tmps_stack[++PL_tmps_ix] = *mark; - SvREFCNT_inc(*mark); + (void)SvREFCNT_inc(*mark); } } } @@ -2014,9 +2013,11 @@ PP(pp_leavesublv) /* Here we go for robustness, not for speed, so we change all * the refcounts so the caller gets a live guy. Cannot set * TEMP, so sv_2mortal is out of question. */ - if (!CvLVALUE(cxsub.cv)) { - POPSUB2(); + if (!CvLVALUE(cx->blk_sub.cv)) { + POPSUB(cx,sv); PL_curpm = newpm; + LEAVE; + LEAVESUB(sv); DIE(aTHX_ "Can't modify non-lvalue subroutine call"); } if (gimme == G_SCALAR) { @@ -2024,20 +2025,24 @@ PP(pp_leavesublv) EXTEND_MORTAL(1); if (MARK == SP) { if (SvFLAGS(TOPs) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)) { - POPSUB2(); + POPSUB(cx,sv); PL_curpm = newpm; + LEAVE; + LEAVESUB(sv); DIE(aTHX_ "Can't return a %s from lvalue subroutine", SvREADONLY(TOPs) ? "readonly value" : "temporary"); } else { /* Can be a localized value * subject to deletion. */ PL_tmps_stack[++PL_tmps_ix] = *mark; - SvREFCNT_inc(*mark); + (void)SvREFCNT_inc(*mark); } } else { /* Should not happen? */ - POPSUB2(); + POPSUB(cx,sv); PL_curpm = newpm; + LEAVE; + LEAVESUB(sv); DIE(aTHX_ "%s returned from lvalue subroutine in scalar context", (MARK > SP ? "Empty array" : "Array")); } @@ -2049,8 +2054,10 @@ PP(pp_leavesublv) if (SvFLAGS(*mark) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)) { /* Might be flattened array after $#array = */ PUTBACK; - POPSUB2(); + POPSUB(cx,sv); PL_curpm = newpm; + LEAVE; + LEAVESUB(sv); DIE(aTHX_ "Can't return %s from lvalue subroutine", (*mark != &PL_sv_undef) ? (SvREADONLY(TOPs) @@ -2061,7 +2068,7 @@ PP(pp_leavesublv) mortalize: /* Can be a localized value subject to deletion. */ PL_tmps_stack[++PL_tmps_ix] = *mark; - SvREFCNT_inc(*mark); + (void)SvREFCNT_inc(*mark); } } } @@ -2071,7 +2078,7 @@ PP(pp_leavesublv) temporise: MARK = newsp + 1; if (MARK <= SP) { - if (cxsub.cv && CvDEPTH(cxsub.cv) > 1) { + if (cx->blk_sub.cv && CvDEPTH(cx->blk_sub.cv) > 1) { if (SvTEMP(TOPs)) { *MARK = SvREFCNT_inc(TOPs); FREETMPS; @@ -2103,10 +2110,11 @@ PP(pp_leavesublv) } PUTBACK; - POPSUB2(); /* Stack values are safe: release CV and @_ ... */ + POPSUB(cx,sv); /* Stack values are safe: release CV and @_ ... */ PL_curpm = newpm; /* ... and pop $1 et al */ LEAVE; + LEAVESUB(sv); return pop_return(); } @@ -2294,10 +2302,10 @@ try_autoload: while (MgOWNER(mg)) COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg)); MgOWNER(mg) = thr; - DEBUG_S(PerlIO_printf(PerlIO_stderr(), "%p: pp_entersub lock %p\n", + DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: pp_entersub lock %p\n", thr, sv);) MUTEX_UNLOCK(MgMUTEXP(mg)); - SAVEDESTRUCTOR(Perl_unlock_condpair, sv); + SAVEDESTRUCTOR_X(Perl_unlock_condpair, sv); } MUTEX_LOCK(CvMUTEXP(cv)); } @@ -2336,13 +2344,13 @@ try_autoload: /* We already have a clone to use */ MUTEX_UNLOCK(CvMUTEXP(cv)); cv = *(CV**)svp; - DEBUG_S(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(Perl_debug_log, "entersub: %p already has clone %p:%s\n", thr, cv, SvPEEK((SV*)cv))); CvOWNER(cv) = thr; SvREFCNT_inc(cv); if (CvDEPTH(cv) == 0) - SAVEDESTRUCTOR(unset_cvowner, (void*) cv); + SAVEDESTRUCTOR_X(unset_cvowner, (void*) cv); } else { /* (2) => grab ownership of cv. (3) => make clone */ @@ -2350,7 +2358,7 @@ try_autoload: CvOWNER(cv) = thr; SvREFCNT_inc(cv); MUTEX_UNLOCK(CvMUTEXP(cv)); - DEBUG_S(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(Perl_debug_log, "entersub: %p grabbing %p:%s in stash %s\n", thr, cv, SvPEEK((SV*)cv), CvSTASH(cv) ? HvNAME(CvSTASH(cv)) : "(none)")); @@ -2360,7 +2368,7 @@ try_autoload: CV *clonecv; SvREFCNT_inc(cv); /* don't let it vanish from under us */ MUTEX_UNLOCK(CvMUTEXP(cv)); - DEBUG_S((PerlIO_printf(PerlIO_stderr(), + DEBUG_S((PerlIO_printf(Perl_debug_log, "entersub: %p cloning %p:%s\n", thr, cv, SvPEEK((SV*)cv)))); /* @@ -2378,9 +2386,9 @@ try_autoload: SvREFCNT_inc(cv); } DEBUG_S(if (CvDEPTH(cv) != 0) - PerlIO_printf(PerlIO_stderr(), "depth %ld != 0\n", + PerlIO_printf(Perl_debug_log, "depth %ld != 0\n", CvDEPTH(cv));); - SAVEDESTRUCTOR(unset_cvowner, (void*) cv); + SAVEDESTRUCTOR_X(unset_cvowner, (void*) cv); } } #endif /* USE_THREADS */ @@ -2397,7 +2405,7 @@ try_autoload: SP--; } PL_stack_sp = mark + 1; - fp3 = (I32(*)(int,int,int)))CvXSUB(cv; + fp3 = (I32(*)(int,int,int))CvXSUB(cv); items = (*fp3)(CvXSUBANY(cv).any_i32, MARK - PL_stack_base + 1, items); @@ -2433,7 +2441,7 @@ try_autoload: } /* We assume first XSUB in &DB::sub is the called one. */ if (PL_curcopdb) { - SAVESPTR(PL_curcop); + SAVEVPTR(PL_curcop); PL_curcop = PL_curcopdb; PL_curcopdb = NULL; } @@ -2469,14 +2477,16 @@ try_autoload: if (CvDEPTH(cv) < 2) (void)SvREFCNT_inc(cv); else { /* save temporaries on recursion? */ + PERL_STACK_OVERFLOW_CHECK(); if (CvDEPTH(cv) > AvFILLp(padlist)) { AV *av; AV *newpad = newAV(); SV **oldpad = AvARRAY(svp[CvDEPTH(cv)-1]); I32 ix = AvFILLp((AV*)svp[1]); + I32 names_fill = AvFILLp((AV*)svp[0]); svp = AvARRAY(svp[0]); for ( ;ix > 0; ix--) { - if (svp[ix] != &PL_sv_undef) { + if (names_fill >= ix && svp[ix] != &PL_sv_undef) { char *name = SvPVX(svp[ix]); if ((SvFLAGS(svp[ix]) & SVf_FAKE) /* outer lexical? */ || *name == '&') /* anonymous code? */ @@ -2493,6 +2503,9 @@ try_autoload: SvPADMY_on(sv); } } + else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) { + av_store(newpad, ix, sv = SvREFCNT_inc(oldpad[ix])); + } else { av_store(newpad, ix, sv = NEWSV(0,0)); SvPADTMP_on(sv); @@ -2521,7 +2534,7 @@ try_autoload: } } #endif /* USE_THREADS */ - SAVESPTR(PL_curpad); + SAVEVPTR(PL_curpad); PL_curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]); #ifndef USE_THREADS if (hasargs) @@ -2531,11 +2544,17 @@ try_autoload: SV** ary; #if 0 - DEBUG_S(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(Perl_debug_log, "%p entersub preparing @_\n", thr)); #endif av = (AV*)PL_curpad[0]; - assert(!AvREAL(av)); + if (AvREAL(av)) { + /* @_ is normally not REAL--this should only ever + * happen when DB::sub() calls things that modify @_ */ + av_clear(av); + AvREAL_off(av); + AvREIFY_on(av); + } #ifndef USE_THREADS cx->blk_sub.savearray = GvAV(PL_defgv); GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av); @@ -2573,7 +2592,7 @@ try_autoload: && !(PERLDB_SUB && cv == GvCV(PL_DBsub))) sub_crush_depth(cv); #if 0 - DEBUG_S(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(Perl_debug_log, "%p entersub returning %p\n", thr, CvSTART(cv))); #endif RETURNOP(CvSTART(cv)); @@ -2769,7 +2788,7 @@ S_method_common(pTHX_ SV* meth, U32* hashp) sep = p, leaf = p + 2; } if (!sep || ((sep - name) == 5 && strnEQ(name, "SUPER", 5))) { - packname = HvNAME(sep ? PL_curcop->cop_stash : stash); + packname = sep ? CopSTASHPV(PL_curcop) : HvNAME(stash); packlen = strlen(packname); } else { @@ -2792,11 +2811,11 @@ unset_cvowner(pTHXo_ void *cvarg) dTHR; #endif /* DEBUGGING */ - DEBUG_S((PerlIO_printf(PerlIO_stderr(), "%p unsetting CvOWNER of %p:%s\n", + DEBUG_S((PerlIO_printf(Perl_debug_log, "%p unsetting CvOWNER of %p:%s\n", thr, cv, SvPEEK((SV*)cv)))); MUTEX_LOCK(CvMUTEXP(cv)); DEBUG_S(if (CvDEPTH(cv) != 0) - PerlIO_printf(PerlIO_stderr(), "depth %ld != 0\n", + PerlIO_printf(Perl_debug_log, "depth %ld != 0\n", CvDEPTH(cv));); assert(thr == CvOWNER(cv)); CvOWNER(cv) = 0; diff --git a/pp_sys.c b/pp_sys.c index cf08f73..39a599a 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -247,7 +247,7 @@ S_emulate_eaccess(pTHX_ const char* path, Mode_t mode) Gid_t egid = getegid(); int res; - MUTEX_LOCK(&PL_cred_mutex); + LOCK_CRED_MUTEX; #if !defined(HAS_SETREUID) && !defined(HAS_SETRESUID) Perl_croak(aTHX_ "switching effective uid is not implemented"); #else @@ -293,7 +293,7 @@ S_emulate_eaccess(pTHX_ const char* path, Mode_t mode) #endif #endif Perl_croak(aTHX_ "leaving effective gid failed"); - MUTEX_UNLOCK(&PL_cred_mutex); + UNLOCK_CRED_MUTEX; return res; } @@ -411,7 +411,7 @@ PP(pp_indread) PP(pp_rcatline) { - PL_last_in_gv = cGVOP->op_gv; + PL_last_in_gv = cGVOP_gv; return do_readline(); } @@ -475,8 +475,8 @@ PP(pp_die) HV *stash = SvSTASH(SvRV(error)); GV *gv = gv_fetchmethod(stash, "PROPAGATE"); if (gv) { - SV *file = sv_2mortal(newSVsv(GvSV(PL_curcop->cop_filegv))); - SV *line = sv_2mortal(newSViv(PL_curcop->cop_line)); + SV *file = sv_2mortal(newSVpv(CopFILE(PL_curcop),0)); + SV *line = sv_2mortal(newSViv(CopLINE(PL_curcop))); EXTEND(SP, 3); PUSHMARK(SP); PUSHs(error); @@ -532,22 +532,6 @@ PP(pp_open) if (GvIOp(gv)) IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT; -#if 0 /* no undef means tmpfile() yet */ - if (sv == &PL_sv_undef) { -#ifdef PerlIO - PerlIO *fp = PerlIO_tmpfile(); -#else - PerlIO *fp = tmpfile(); -#endif - if (fp != Nullfp && do_open(gv, "+>&", 3, FALSE, 0, 0, fp)) - PUSHi( (I32)PL_forkprocess ); - else - RETPUSHUNDEF; - RETURN; - } -#endif /* no undef means tmpfile() yet */ - - if (mg = SvTIED_mg((SV*)gv, 'q')) { PUSHMARK(SP); XPUSHs(SvTIED_obj((SV*)gv, mg)); @@ -825,17 +809,10 @@ PP(pp_untie) if (ckWARN(WARN_UNTIE)) { MAGIC * mg ; if (mg = SvTIED_mg(sv, how)) { -#ifdef IV_IS_QUAD if (mg && SvREFCNT(SvRV(mg->mg_obj)) > 1) Perl_warner(aTHX_ WARN_UNTIE, - "untie attempted while %" PERL_PRIu64 " inner references still exist", + "untie attempted while %"UVuf" inner references still exist", (UV)SvREFCNT(SvRV(mg->mg_obj)) - 1 ) ; -#else - if (mg && SvREFCNT(SvRV(mg->mg_obj)) > 1) - Perl_warner(aTHX_ WARN_UNTIE, - "untie attempted while %lu inner references still exist", - (unsigned long)SvREFCNT(SvRV(mg->mg_obj)) - 1 ) ; -#endif } } @@ -1118,8 +1095,6 @@ PP(pp_getc) gv = PL_stdingv; else gv = (GV*)POPs; - if (!gv) - gv = PL_argvgv; if (mg = SvTIED_mg((SV*)gv, 'q')) { I32 gimme = GIMME_V; @@ -1161,9 +1136,9 @@ S_doform(pTHX_ CV *cv, GV *gv, OP *retop) SAVETMPS; push_return(retop); - PUSHBLOCK(cx, CXt_SUB, PL_stack_sp); + PUSHBLOCK(cx, CXt_FORMAT, PL_stack_sp); PUSHFORMAT(cx); - SAVESPTR(PL_curpad); + SAVEVPTR(PL_curpad); PL_curpad = AvARRAY((AV*)svp[1]); setdefout(gv); /* locally select filehandle so $% et al work */ @@ -1304,7 +1279,7 @@ PP(pp_leavewrite) SvPV_nolen(sv)); else if (ckWARN(WARN_CLOSED)) Perl_warner(aTHX_ WARN_CLOSED, - "Write on closed filehandle %s", SvPV_nolen(sv)); + "write() on closed filehandle %s", SvPV_nolen(sv)); } PUSHs(&PL_sv_no); } @@ -1384,7 +1359,7 @@ PP(pp_prtf) SvPV(sv,n_a)); else if (ckWARN(WARN_CLOSED)) Perl_warner(aTHX_ WARN_CLOSED, - "printf on closed filehandle %s", SvPV(sv,n_a)); + "printf() on closed filehandle %s", SvPV(sv,n_a)); } SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI); goto just_say_no; @@ -1615,10 +1590,10 @@ PP(pp_send) djSP; dMARK; dORIGMARK; dTARGET; GV *gv; IO *io; - int offset; + Off_t offset; SV *bufsv; char *buffer; - int length; + Off_t length; STRLEN blen; MAGIC *mg; @@ -1641,7 +1616,11 @@ PP(pp_send) goto say_undef; bufsv = *++MARK; buffer = SvPV(bufsv, blen); +#if Off_t_SIZE > IVSIZE + length = SvNVx(*++MARK); +#else length = SvIVx(*++MARK); +#endif if (length < 0) DIE(aTHX_ "Negative length"); SETERRNO(0,0); @@ -1650,14 +1629,18 @@ PP(pp_send) length = -1; if (ckWARN(WARN_CLOSED)) { if (PL_op->op_type == OP_SYSWRITE) - Perl_warner(aTHX_ WARN_CLOSED, "Syswrite on closed filehandle"); + Perl_warner(aTHX_ WARN_CLOSED, "syswrite() on closed filehandle"); else - Perl_warner(aTHX_ WARN_CLOSED, "Send on closed socket"); + Perl_warner(aTHX_ WARN_CLOSED, "send() on closed socket"); } } else if (PL_op->op_type == OP_SYSWRITE) { if (MARK < SP) { +#if Off_t_SIZE > IVSIZE + offset = SvNVx(*++MARK); +#else offset = SvIVx(*++MARK); +#endif if (offset < 0) { if (-offset > blen) DIE(aTHX_ "Offset outside string"); @@ -1718,10 +1701,28 @@ PP(pp_eof) GV *gv; MAGIC *mg; - if (MAXARG <= 0) - gv = PL_last_in_gv; + if (MAXARG <= 0) { + if (PL_op->op_flags & OPf_SPECIAL) { /* eof() */ + IO *io; + gv = PL_last_in_gv = PL_argvgv; + io = GvIO(gv); + if (io && !IoIFP(io)) { + if ((IoFLAGS(io) & IOf_START) && av_len(GvAVn(gv)) < 0) { + IoLINES(io) = 0; + IoFLAGS(io) &= ~IOf_START; + do_open(gv, "-", 1, FALSE, O_RDONLY, 0, Nullfp); + sv_setpvn(GvSV(gv), "-", 1); + SvSETMAGIC(GvSV(gv)); + } + else if (!nextargv(gv)) + RETPUSHYES; + } + } + else + gv = PL_last_in_gv; /* eof */ + } else - gv = PL_last_in_gv = (GV*)POPs; + gv = PL_last_in_gv = (GV*)POPs; /* eof(FH) */ if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) { PUSHMARK(SP); @@ -1760,7 +1761,11 @@ PP(pp_tell) RETURN; } +#if LSEEKSIZE > IVSIZE + PUSHn( do_tell(gv) ); +#else PUSHi( do_tell(gv) ); +#endif RETURN; } @@ -1774,7 +1779,11 @@ PP(pp_sysseek) djSP; GV *gv; int whence = POPi; +#if LSEEKSIZE > IVSIZE + Off_t offset = (Off_t)SvNVx(POPs); +#else Off_t offset = (Off_t)SvIVx(POPs); +#endif MAGIC *mg; gv = PL_last_in_gv = (GV*)POPs; @@ -1796,9 +1805,18 @@ PP(pp_sysseek) PUSHs(boolSV(do_seek(gv, offset, whence))); else { Off_t n = do_sysseek(gv, offset, whence); - PUSHs((n < 0) ? &PL_sv_undef - : sv_2mortal(n ? newSViv((IV)n) - : newSVpvn(zero_but_true, ZBTLEN))); + if (n < 0) + PUSHs(&PL_sv_undef); + else { + SV* sv = n ? +#if LSEEKSIZE > IVSIZE + newSVnv((NV)n) +#else + newSViv((IV)n) +#endif + : newSVpvn(zero_but_true, ZBTLEN); + PUSHs(sv_2mortal(sv)); + } } RETURN; } @@ -2120,7 +2138,7 @@ PP(pp_bind) nuts: if (ckWARN(WARN_CLOSED)) - Perl_warner(aTHX_ WARN_CLOSED, "bind() on closed fd"); + Perl_warner(aTHX_ WARN_CLOSED, "bind() on closed socket"); SETERRNO(EBADF,SS$_IVCHAN); RETPUSHUNDEF; #else @@ -2150,7 +2168,7 @@ PP(pp_connect) nuts: if (ckWARN(WARN_CLOSED)) - Perl_warner(aTHX_ WARN_CLOSED, "connect() on closed fd"); + Perl_warner(aTHX_ WARN_CLOSED, "connect() on closed socket"); SETERRNO(EBADF,SS$_IVCHAN); RETPUSHUNDEF; #else @@ -2176,7 +2194,7 @@ PP(pp_listen) nuts: if (ckWARN(WARN_CLOSED)) - Perl_warner(aTHX_ WARN_CLOSED, "listen() on closed fd"); + Perl_warner(aTHX_ WARN_CLOSED, "listen() on closed socket"); SETERRNO(EBADF,SS$_IVCHAN); RETPUSHUNDEF; #else @@ -2230,7 +2248,7 @@ PP(pp_accept) nuts: if (ckWARN(WARN_CLOSED)) - Perl_warner(aTHX_ WARN_CLOSED, "accept() on closed fd"); + Perl_warner(aTHX_ WARN_CLOSED, "accept() on closed socket"); SETERRNO(EBADF,SS$_IVCHAN); badexit: @@ -2257,7 +2275,7 @@ PP(pp_shutdown) nuts: if (ckWARN(WARN_CLOSED)) - Perl_warner(aTHX_ WARN_CLOSED, "shutdown() on closed fd"); + Perl_warner(aTHX_ WARN_CLOSED, "shutdown() on closed socket"); SETERRNO(EBADF,SS$_IVCHAN); RETPUSHUNDEF; #else @@ -2336,7 +2354,8 @@ PP(pp_ssockopt) nuts: if (ckWARN(WARN_CLOSED)) - Perl_warner(aTHX_ WARN_CLOSED, "[gs]etsockopt() on closed fd"); + Perl_warner(aTHX_ WARN_CLOSED, "%cetsockopt() on closed socket", + optype == OP_GSOCKOPT ? 'g' : 's'); SETERRNO(EBADF,SS$_IVCHAN); nuts2: RETPUSHUNDEF; @@ -2409,7 +2428,8 @@ PP(pp_getpeername) nuts: if (ckWARN(WARN_CLOSED)) - Perl_warner(aTHX_ WARN_CLOSED, "get{sock, peer}name() on closed fd"); + Perl_warner(aTHX_ WARN_CLOSED, "get%sname() on closed socket", + optype == OP_GETSOCKNAME ? "sock" : "peer"); SETERRNO(EBADF,SS$_IVCHAN); nuts2: RETPUSHUNDEF; @@ -2435,7 +2455,7 @@ PP(pp_stat) STRLEN n_a; if (PL_op->op_flags & OPf_REF) { - tmpgv = cGVOP->op_gv; + tmpgv = cGVOP_gv; do_fstat: if (tmpgv != PL_defgv) { PL_laststype = OP_STAT; @@ -2486,14 +2506,26 @@ PP(pp_stat) PUSHs(sv_2mortal(newSViv(PL_statcache.st_ino))); PUSHs(sv_2mortal(newSViv(PL_statcache.st_mode))); PUSHs(sv_2mortal(newSViv(PL_statcache.st_nlink))); +#if Uid_t_size > IVSIZE + PUSHs(sv_2mortal(newSVnv(PL_statcache.st_uid))); +#else PUSHs(sv_2mortal(newSViv(PL_statcache.st_uid))); +#endif +#if Gid_t_size > IVSIZE + PUSHs(sv_2mortal(newSVnv(PL_statcache.st_gid))); +#else PUSHs(sv_2mortal(newSViv(PL_statcache.st_gid))); +#endif #ifdef USE_STAT_RDEV PUSHs(sv_2mortal(newSViv(PL_statcache.st_rdev))); #else PUSHs(sv_2mortal(newSVpvn("", 0))); #endif +#if Off_t_size > IVSIZE + PUSHs(sv_2mortal(newSVnv(PL_statcache.st_size))); +#else PUSHs(sv_2mortal(newSViv(PL_statcache.st_size))); +#endif #ifdef BIG_TIME PUSHs(sv_2mortal(newSVnv(PL_statcache.st_atime))); PUSHs(sv_2mortal(newSVnv(PL_statcache.st_mtime))); @@ -2696,7 +2728,8 @@ PP(pp_ftrowned) djSP; if (result < 0) RETPUSHUNDEF; - if (PL_statcache.st_uid == (PL_op->op_type == OP_FTEOWNED ? PL_euid : PL_uid) ) + if (PL_statcache.st_uid == (PL_op->op_type == OP_FTEOWNED ? + PL_euid : PL_uid) ) RETPUSHYES; RETPUSHNO; } @@ -2707,7 +2740,7 @@ PP(pp_ftzero) djSP; if (result < 0) RETPUSHUNDEF; - if (!PL_statcache.st_size) + if (PL_statcache.st_size == 0) RETPUSHYES; RETPUSHNO; } @@ -2718,7 +2751,11 @@ PP(pp_ftsize) djSP; dTARGET; if (result < 0) RETPUSHUNDEF; +#if Off_t_size > IVSIZE + PUSHn(PL_statcache.st_size); +#else PUSHi(PL_statcache.st_size); +#endif RETURN; } @@ -2880,7 +2917,7 @@ PP(pp_fttty) STRLEN n_a; if (PL_op->op_flags & OPf_REF) - gv = cGVOP->op_gv; + gv = cGVOP_gv; else if (isGV(TOPs)) gv = (GV*)POPs; else if (SvROK(TOPs) && isGV(SvRV(TOPs))) @@ -2919,9 +2956,10 @@ PP(pp_fttext) register SV *sv; GV *gv; STRLEN n_a; + PerlIO *fp; if (PL_op->op_flags & OPf_REF) - gv = cGVOP->op_gv; + gv = cGVOP_gv; else if (isGV(TOPs)) gv = (GV*)POPs; else if (SvROK(TOPs) && isGV(SvRV(TOPs))) @@ -2970,9 +3008,11 @@ PP(pp_fttext) len = 512; } else { - if (ckWARN(WARN_UNOPENED)) + if (ckWARN(WARN_UNOPENED)) { + gv = cGVOP_gv; Perl_warner(aTHX_ WARN_UNOPENED, "Test on unopened file <%s>", - GvENAME(cGVOP->op_gv)); + GvENAME(gv)); + } SETERRNO(EBADF,RMS$_IFI); RETPUSHUNDEF; } @@ -2983,21 +3023,19 @@ PP(pp_fttext) PL_statgv = Nullgv; PL_laststatval = -1; sv_setpv(PL_statname, SvPV(sv, n_a)); -#ifdef HAS_OPEN3 - i = PerlLIO_open3(SvPV(sv, n_a), O_RDONLY, 0); -#else - i = PerlLIO_open(SvPV(sv, n_a), 0); -#endif - if (i < 0) { + if (!(fp = PerlIO_open(SvPVX(PL_statname), "r"))) { if (ckWARN(WARN_NEWLINE) && strchr(SvPV(sv, n_a), '\n')) Perl_warner(aTHX_ WARN_NEWLINE, PL_warn_nl, "open"); RETPUSHUNDEF; } - PL_laststatval = PerlLIO_fstat(i, &PL_statcache); - if (PL_laststatval < 0) + PL_laststatval = PerlLIO_fstat(PerlIO_fileno(fp), &PL_statcache); + if (PL_laststatval < 0) { + (void)PerlIO_close(fp); RETPUSHUNDEF; - len = PerlLIO_read(i, tbuf, 512); - (void)PerlLIO_close(i); + } + do_binmode(fp, '<', TRUE); + len = PerlIO_read(fp, tbuf, sizeof(tbuf)); + (void)PerlIO_close(fp); if (len <= 0) { if (S_ISDIR(PL_statcache.st_mode) && PL_op->op_type == OP_FTTEXT) RETPUSHNO; /* special case NFS directories */ @@ -3009,6 +3047,12 @@ PP(pp_fttext) /* now scan s to look for textiness */ /* XXX ASCII dependent code */ +#if defined(DOSISH) || defined(USEMYBINMODE) + /* ignore trailing ^Z on short files */ + if (len && len < sizeof(tbuf) && tbuf[len-1] == 26) + --len; +#endif + for (i = 0; i < len; i++, s++) { if (!*s) { /* null never allowed in text */ odd += len; @@ -3018,8 +3062,12 @@ PP(pp_fttext) else if (!(isPRINT(*s) || isSPACE(*s))) odd++; #else - else if (*s & 128) - odd++; + else if (*s & 128) { +#ifdef USE_LOCALE + if (!(PL_op->op_private & OPpLOCALE) || !isALPHA_LC(*s)) +#endif + odd++; + } else if (*s < 32 && *s != '\n' && *s != '\r' && *s != '\b' && *s != '\t' && *s != '\f' && *s != 27) @@ -3172,7 +3220,7 @@ PP(pp_link) char *tmps2 = POPpx; char *tmps = SvPV(TOPs, n_a); TAINT_PROPER("link"); - SETi( link(tmps, tmps2) >= 0 ); + SETi( PerlLIO_link(tmps, tmps2) >= 0 ); #else DIE(aTHX_ PL_no_func, "Unsupported function link"); #endif @@ -3548,19 +3596,30 @@ PP(pp_fork) if (!childpid) { /*SUPPRESS 560*/ if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV)) - sv_setiv(GvSV(tmpgv), (IV)getpid()); + sv_setiv(GvSV(tmpgv), (IV)PerlProc_getpid()); hv_clear(PL_pidstatus); /* no kids, so don't wait for 'em */ } PUSHi(childpid); RETURN; #else +# if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS) + djSP; dTARGET; + Pid_t childpid; + + EXTEND(SP, 1); + PERL_FLUSHALL_FOR_CHILD; + childpid = PerlProc_fork(); + PUSHi(childpid); + RETURN; +# else DIE(aTHX_ PL_no_func, "Unsupported function fork"); +# endif #endif } PP(pp_wait) { -#if !defined(DOSISH) || defined(OS2) || defined(WIN32) +#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(MACOS_TRADITIONAL) djSP; dTARGET; Pid_t childpid; int argflags; @@ -3576,7 +3635,7 @@ PP(pp_wait) PP(pp_waitpid) { -#if !defined(DOSISH) || defined(OS2) || defined(WIN32) +#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(MACOS_TRADITIONAL) djSP; dTARGET; Pid_t childpid; int optype; @@ -3740,6 +3799,12 @@ PP(pp_exec) # endif #endif } + +#if !defined(HAS_FORK) && defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS) + if (value >= 0) + my_exit(value); +#endif + SP = ORIGMARK; PUSHi(value); RETURN; @@ -3784,7 +3849,7 @@ PP(pp_getpgrp) #ifdef BSD_GETPGRP pgrp = (I32)BSD_GETPGRP(pid); #else - if (pid != 0 && pid != getpid()) + if (pid != 0 && pid != PerlProc_getpid()) DIE(aTHX_ "POSIX getpgrp can't take an argument"); pgrp = getpgrp(); #endif @@ -3814,8 +3879,11 @@ PP(pp_setpgrp) #ifdef BSD_SETPGRP SETi( BSD_SETPGRP(pid, pgrp) >= 0 ); #else - if ((pgrp != 0 && pgrp != getpid()) || (pid != 0 && pid != getpid())) - DIE(aTHX_ "POSIX setpgrp can't take an argument"); + if ((pgrp != 0 && pgrp != PerlProc_getpid()) + || (pid != 0 && pid != PerlProc_getpid())) + { + DIE(aTHX_ "setpgrp can't take arguments"); + } SETi( setpgrp() >= 0 ); #endif /* USE_BSDPGRP */ RETURN; diff --git a/proto.h b/proto.h index 2f68d9b..36f4a40 100644 --- a/proto.h +++ b/proto.h @@ -4,745 +4,821 @@ * and run 'make regen_headers' to effect changes. */ + + +START_EXTERN_C + +#if defined(PERL_IMPLICIT_SYS) +PERL_CALLCONV PerlInterpreter* perl_alloc_using(struct IPerlMem* m, struct IPerlMem* ms, struct IPerlMem* mp, struct IPerlEnv* e, struct IPerlStdIO* io, struct IPerlLIO* lio, struct IPerlDir* d, struct IPerlSock* s, struct IPerlProc* p); +#else +PERL_CALLCONV PerlInterpreter* perl_alloc(void); +#endif +PERL_CALLCONV void perl_construct(PerlInterpreter* interp); +PERL_CALLCONV void perl_destruct(PerlInterpreter* interp); +PERL_CALLCONV void perl_free(PerlInterpreter* interp); +PERL_CALLCONV int perl_run(PerlInterpreter* interp); +PERL_CALLCONV int perl_parse(PerlInterpreter* interp, XSINIT_t xsinit, int argc, char** argv, char** env); +#if defined(USE_ITHREADS) +PERL_CALLCONV PerlInterpreter* perl_clone(PerlInterpreter* interp, UV flags); +# if defined(PERL_IMPLICIT_SYS) +PERL_CALLCONV PerlInterpreter* perl_clone_using(PerlInterpreter *interp, UV flags, struct IPerlMem* m, struct IPerlMem* ms, struct IPerlMem* mp, struct IPerlEnv* e, struct IPerlStdIO* io, struct IPerlLIO* lio, struct IPerlDir* d, struct IPerlSock* s, struct IPerlProc* p); +# endif +#endif + +#if defined(MYMALLOC) +PERL_CALLCONV Malloc_t Perl_malloc(MEM_SIZE nbytes); +PERL_CALLCONV Malloc_t Perl_calloc(MEM_SIZE elements, MEM_SIZE size); +PERL_CALLCONV Malloc_t Perl_realloc(Malloc_t where, MEM_SIZE nbytes); +PERL_CALLCONV Free_t Perl_mfree(Malloc_t where); +PERL_CALLCONV MEM_SIZE Perl_malloced_size(void *p); +#endif + +END_EXTERN_C + +/* functions with flag 'n' should come before here */ #if defined(PERL_OBJECT) +class CPerlObj { public: + struct interpreter interp; + CPerlObj(IPerlMem*, IPerlMem*, IPerlMem*, IPerlEnv*, IPerlStdIO*, + IPerlLIO*, IPerlDir*, IPerlSock*, IPerlProc*); + void* operator new(size_t nSize, IPerlMem *pvtbl); +#ifndef __BORLANDC__ + static void operator delete(void* pPerl, IPerlMem *pvtbl); #endif -VIRTUAL SV* Perl_amagic_call(pTHX_ SV* left, SV* right, int method, int dir); -VIRTUAL bool Perl_Gv_AMupdate(pTHX_ HV* stash); -VIRTUAL OP* Perl_append_elem(pTHX_ I32 optype, OP* head, OP* tail); -VIRTUAL OP* Perl_append_list(pTHX_ I32 optype, LISTOP* first, LISTOP* last); -VIRTUAL I32 Perl_apply(pTHX_ I32 type, SV** mark, SV** sp); -VIRTUAL bool Perl_avhv_exists_ent(pTHX_ AV *ar, SV* keysv, U32 hash); -VIRTUAL SV** Perl_avhv_fetch_ent(pTHX_ AV *ar, SV* keysv, I32 lval, U32 hash); -VIRTUAL HE* Perl_avhv_iternext(pTHX_ AV *ar); -VIRTUAL SV* Perl_avhv_iterval(pTHX_ AV *ar, HE* entry); -VIRTUAL HV* Perl_avhv_keys(pTHX_ AV *ar); -VIRTUAL void Perl_av_clear(pTHX_ AV* ar); -VIRTUAL void Perl_av_extend(pTHX_ AV* ar, I32 key); -VIRTUAL AV* Perl_av_fake(pTHX_ I32 size, SV** svp); -VIRTUAL SV** Perl_av_fetch(pTHX_ AV* ar, I32 key, I32 lval); -VIRTUAL void Perl_av_fill(pTHX_ AV* ar, I32 fill); -VIRTUAL I32 Perl_av_len(pTHX_ AV* ar); -VIRTUAL AV* Perl_av_make(pTHX_ I32 size, SV** svp); -VIRTUAL SV* Perl_av_pop(pTHX_ AV* ar); -VIRTUAL void Perl_av_push(pTHX_ AV* ar, SV* val); -VIRTUAL void Perl_av_reify(pTHX_ AV* ar); -VIRTUAL SV* Perl_av_shift(pTHX_ AV* ar); -VIRTUAL SV** Perl_av_store(pTHX_ AV* ar, I32 key, SV* val); -VIRTUAL void Perl_av_undef(pTHX_ AV* ar); -VIRTUAL void Perl_av_unshift(pTHX_ AV* ar, I32 num); -VIRTUAL OP* Perl_bind_match(pTHX_ I32 type, OP* left, OP* pat); -VIRTUAL OP* Perl_block_end(pTHX_ I32 floor, OP* seq); -VIRTUAL I32 Perl_block_gimme(pTHX); -VIRTUAL int Perl_block_start(pTHX_ int full); -VIRTUAL void Perl_boot_core_UNIVERSAL(pTHX); -VIRTUAL void Perl_call_list(pTHX_ I32 oldscope, AV* av_list); -VIRTUAL bool Perl_cando(pTHX_ Mode_t mode, Uid_t effective, Stat_t* statbufp); -VIRTUAL U32 Perl_cast_ulong(pTHX_ NV f); -VIRTUAL I32 Perl_cast_i32(pTHX_ NV f); -VIRTUAL IV Perl_cast_iv(pTHX_ NV f); -VIRTUAL UV Perl_cast_uv(pTHX_ NV f); + int do_aspawn (void *vreally, void **vmark, void **vsp); +#endif +#if defined(PERL_OBJECT) +public: +#else +START_EXTERN_C +#endif +# include "pp_proto.h" +PERL_CALLCONV SV* Perl_amagic_call(pTHX_ SV* left, SV* right, int method, int dir); +PERL_CALLCONV bool Perl_Gv_AMupdate(pTHX_ HV* stash); +PERL_CALLCONV OP* Perl_append_elem(pTHX_ I32 optype, OP* head, OP* tail); +PERL_CALLCONV OP* Perl_append_list(pTHX_ I32 optype, LISTOP* first, LISTOP* last); +PERL_CALLCONV I32 Perl_apply(pTHX_ I32 type, SV** mark, SV** sp); +PERL_CALLCONV SV* Perl_avhv_delete_ent(pTHX_ AV *ar, SV* keysv, I32 flags, U32 hash); +PERL_CALLCONV bool Perl_avhv_exists_ent(pTHX_ AV *ar, SV* keysv, U32 hash); +PERL_CALLCONV SV** Perl_avhv_fetch_ent(pTHX_ AV *ar, SV* keysv, I32 lval, U32 hash); +PERL_CALLCONV HE* Perl_avhv_iternext(pTHX_ AV *ar); +PERL_CALLCONV SV* Perl_avhv_iterval(pTHX_ AV *ar, HE* entry); +PERL_CALLCONV HV* Perl_avhv_keys(pTHX_ AV *ar); +PERL_CALLCONV void Perl_av_clear(pTHX_ AV* ar); +PERL_CALLCONV SV* Perl_av_delete(pTHX_ AV* ar, I32 key, I32 flags); +PERL_CALLCONV bool Perl_av_exists(pTHX_ AV* ar, I32 key); +PERL_CALLCONV void Perl_av_extend(pTHX_ AV* ar, I32 key); +PERL_CALLCONV AV* Perl_av_fake(pTHX_ I32 size, SV** svp); +PERL_CALLCONV SV** Perl_av_fetch(pTHX_ AV* ar, I32 key, I32 lval); +PERL_CALLCONV void Perl_av_fill(pTHX_ AV* ar, I32 fill); +PERL_CALLCONV I32 Perl_av_len(pTHX_ AV* ar); +PERL_CALLCONV AV* Perl_av_make(pTHX_ I32 size, SV** svp); +PERL_CALLCONV SV* Perl_av_pop(pTHX_ AV* ar); +PERL_CALLCONV void Perl_av_push(pTHX_ AV* ar, SV* val); +PERL_CALLCONV void Perl_av_reify(pTHX_ AV* ar); +PERL_CALLCONV SV* Perl_av_shift(pTHX_ AV* ar); +PERL_CALLCONV SV** Perl_av_store(pTHX_ AV* ar, I32 key, SV* val); +PERL_CALLCONV void Perl_av_undef(pTHX_ AV* ar); +PERL_CALLCONV void Perl_av_unshift(pTHX_ AV* ar, I32 num); +PERL_CALLCONV OP* Perl_bind_match(pTHX_ I32 type, OP* left, OP* pat); +PERL_CALLCONV OP* Perl_block_end(pTHX_ I32 floor, OP* seq); +PERL_CALLCONV I32 Perl_block_gimme(pTHX); +PERL_CALLCONV int Perl_block_start(pTHX_ int full); +PERL_CALLCONV void Perl_boot_core_UNIVERSAL(pTHX); +PERL_CALLCONV void Perl_call_list(pTHX_ I32 oldscope, AV* av_list); +PERL_CALLCONV bool Perl_cando(pTHX_ Mode_t mode, Uid_t effective, Stat_t* statbufp); +PERL_CALLCONV U32 Perl_cast_ulong(pTHX_ NV f); +PERL_CALLCONV I32 Perl_cast_i32(pTHX_ NV f); +PERL_CALLCONV IV Perl_cast_iv(pTHX_ NV f); +PERL_CALLCONV UV Perl_cast_uv(pTHX_ NV f); #if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP) -VIRTUAL I32 Perl_my_chsize(pTHX_ int fd, Off_t length); +PERL_CALLCONV I32 Perl_my_chsize(pTHX_ int fd, Off_t length); #endif #if defined(USE_THREADS) -VIRTUAL MAGIC* Perl_condpair_magic(pTHX_ SV *sv); +PERL_CALLCONV MAGIC* Perl_condpair_magic(pTHX_ SV *sv); #endif -VIRTUAL OP* Perl_convert(pTHX_ I32 optype, I32 flags, OP* o); -VIRTUAL void Perl_croak(pTHX_ const char* pat, ...) __attribute__((noreturn)); -VIRTUAL void Perl_vcroak(pTHX_ const char* pat, va_list* args) __attribute__((noreturn)); +PERL_CALLCONV OP* Perl_convert(pTHX_ I32 optype, I32 flags, OP* o); +PERL_CALLCONV void Perl_croak(pTHX_ const char* pat, ...) __attribute__((noreturn)); +PERL_CALLCONV void Perl_vcroak(pTHX_ const char* pat, va_list* args) __attribute__((noreturn)); #if defined(PERL_IMPLICIT_CONTEXT) -VIRTUAL void Perl_croak_nocontext(const char* pat, ...) __attribute__((noreturn)); -VIRTUAL OP* Perl_die_nocontext(const char* pat, ...); -VIRTUAL void Perl_deb_nocontext(const char* pat, ...); -VIRTUAL char* Perl_form_nocontext(const char* pat, ...); -VIRTUAL SV* Perl_mess_nocontext(const char* pat, ...); -VIRTUAL void Perl_warn_nocontext(const char* pat, ...); -VIRTUAL void Perl_warner_nocontext(U32 err, const char* pat, ...); -VIRTUAL SV* Perl_newSVpvf_nocontext(const char* pat, ...); -VIRTUAL void Perl_sv_catpvf_nocontext(SV* sv, const char* pat, ...); -VIRTUAL void Perl_sv_setpvf_nocontext(SV* sv, const char* pat, ...); -VIRTUAL void Perl_sv_catpvf_mg_nocontext(SV* sv, const char* pat, ...); -VIRTUAL void Perl_sv_setpvf_mg_nocontext(SV* sv, const char* pat, ...); -VIRTUAL int Perl_fprintf_nocontext(PerlIO* stream, const char* fmt, ...); -#endif -VIRTUAL void Perl_cv_ckproto(pTHX_ CV* cv, GV* gv, char* p); -VIRTUAL CV* Perl_cv_clone(pTHX_ CV* proto); -VIRTUAL SV* Perl_cv_const_sv(pTHX_ CV* cv); -VIRTUAL SV* Perl_op_const_sv(pTHX_ OP* o, CV* cv); -VIRTUAL void Perl_cv_undef(pTHX_ CV* cv); -VIRTUAL void Perl_cx_dump(pTHX_ PERL_CONTEXT* cs); -VIRTUAL SV* Perl_filter_add(pTHX_ filter_t funcp, SV* datasv); -VIRTUAL void Perl_filter_del(pTHX_ filter_t funcp); -VIRTUAL I32 Perl_filter_read(pTHX_ int idx, SV* buffer, int maxlen); -VIRTUAL char** Perl_get_op_descs(pTHX); -VIRTUAL char** Perl_get_op_names(pTHX); -VIRTUAL char* Perl_get_no_modify(pTHX); -VIRTUAL U32* Perl_get_opargs(pTHX); -VIRTUAL PPADDR_t* Perl_get_ppaddr(pTHX); -VIRTUAL I32 Perl_cxinc(pTHX); -VIRTUAL void Perl_deb(pTHX_ const char* pat, ...); -VIRTUAL void Perl_vdeb(pTHX_ const char* pat, va_list* args); -VIRTUAL void Perl_deb_growlevel(pTHX); -VIRTUAL void Perl_debprofdump(pTHX); -VIRTUAL I32 Perl_debop(pTHX_ OP* o); -VIRTUAL I32 Perl_debstack(pTHX); -VIRTUAL I32 Perl_debstackptrs(pTHX); -VIRTUAL char* Perl_delimcpy(pTHX_ char* to, char* toend, char* from, char* fromend, int delim, I32* retlen); -VIRTUAL void Perl_deprecate(pTHX_ char* s); -VIRTUAL OP* Perl_die(pTHX_ const char* pat, ...); -VIRTUAL OP* Perl_vdie(pTHX_ const char* pat, va_list* args); -VIRTUAL OP* Perl_die_where(pTHX_ char* message, STRLEN msglen); -VIRTUAL void Perl_dounwind(pTHX_ I32 cxix); -VIRTUAL bool Perl_do_aexec(pTHX_ SV* really, SV** mark, SV** sp); -VIRTUAL bool Perl_do_aexec5(pTHX_ SV* really, SV** mark, SV** sp, int fd, int flag); -VIRTUAL int Perl_do_binmode(pTHX_ PerlIO *fp, int iotype, int flag); -VIRTUAL void Perl_do_chop(pTHX_ SV* asv, SV* sv); -VIRTUAL bool Perl_do_close(pTHX_ GV* gv, bool not_implicit); -VIRTUAL bool Perl_do_eof(pTHX_ GV* gv); -VIRTUAL bool Perl_do_exec(pTHX_ char* cmd); +PERL_CALLCONV void Perl_croak_nocontext(const char* pat, ...) __attribute__((noreturn)); +PERL_CALLCONV OP* Perl_die_nocontext(const char* pat, ...); +PERL_CALLCONV void Perl_deb_nocontext(const char* pat, ...); +PERL_CALLCONV char* Perl_form_nocontext(const char* pat, ...); +PERL_CALLCONV SV* Perl_mess_nocontext(const char* pat, ...); +PERL_CALLCONV void Perl_warn_nocontext(const char* pat, ...); +PERL_CALLCONV void Perl_warner_nocontext(U32 err, const char* pat, ...); +PERL_CALLCONV SV* Perl_newSVpvf_nocontext(const char* pat, ...); +PERL_CALLCONV void Perl_sv_catpvf_nocontext(SV* sv, const char* pat, ...); +PERL_CALLCONV void Perl_sv_setpvf_nocontext(SV* sv, const char* pat, ...); +PERL_CALLCONV void Perl_sv_catpvf_mg_nocontext(SV* sv, const char* pat, ...); +PERL_CALLCONV void Perl_sv_setpvf_mg_nocontext(SV* sv, const char* pat, ...); +PERL_CALLCONV int Perl_fprintf_nocontext(PerlIO* stream, const char* fmt, ...); +#endif +PERL_CALLCONV void Perl_cv_ckproto(pTHX_ CV* cv, GV* gv, char* p); +PERL_CALLCONV CV* Perl_cv_clone(pTHX_ CV* proto); +PERL_CALLCONV SV* Perl_cv_const_sv(pTHX_ CV* cv); +PERL_CALLCONV SV* Perl_op_const_sv(pTHX_ OP* o, CV* cv); +PERL_CALLCONV void Perl_cv_undef(pTHX_ CV* cv); +PERL_CALLCONV void Perl_cx_dump(pTHX_ PERL_CONTEXT* cs); +PERL_CALLCONV SV* Perl_filter_add(pTHX_ filter_t funcp, SV* datasv); +PERL_CALLCONV void Perl_filter_del(pTHX_ filter_t funcp); +PERL_CALLCONV I32 Perl_filter_read(pTHX_ int idx, SV* buffer, int maxlen); +PERL_CALLCONV char** Perl_get_op_descs(pTHX); +PERL_CALLCONV char** Perl_get_op_names(pTHX); +PERL_CALLCONV char* Perl_get_no_modify(pTHX); +PERL_CALLCONV U32* Perl_get_opargs(pTHX); +PERL_CALLCONV PPADDR_t* Perl_get_ppaddr(pTHX); +PERL_CALLCONV I32 Perl_cxinc(pTHX); +PERL_CALLCONV void Perl_deb(pTHX_ const char* pat, ...); +PERL_CALLCONV void Perl_vdeb(pTHX_ const char* pat, va_list* args); +PERL_CALLCONV void Perl_debprofdump(pTHX); +PERL_CALLCONV I32 Perl_debop(pTHX_ OP* o); +PERL_CALLCONV I32 Perl_debstack(pTHX); +PERL_CALLCONV I32 Perl_debstackptrs(pTHX); +PERL_CALLCONV char* Perl_delimcpy(pTHX_ char* to, char* toend, char* from, char* fromend, int delim, I32* retlen); +PERL_CALLCONV void Perl_deprecate(pTHX_ char* s); +PERL_CALLCONV OP* Perl_die(pTHX_ const char* pat, ...); +PERL_CALLCONV OP* Perl_vdie(pTHX_ const char* pat, va_list* args); +PERL_CALLCONV OP* Perl_die_where(pTHX_ char* message, STRLEN msglen); +PERL_CALLCONV void Perl_dounwind(pTHX_ I32 cxix); +PERL_CALLCONV bool Perl_do_aexec(pTHX_ SV* really, SV** mark, SV** sp); +PERL_CALLCONV bool Perl_do_aexec5(pTHX_ SV* really, SV** mark, SV** sp, int fd, int flag); +PERL_CALLCONV int Perl_do_binmode(pTHX_ PerlIO *fp, int iotype, int flag); +PERL_CALLCONV void Perl_do_chop(pTHX_ SV* asv, SV* sv); +PERL_CALLCONV bool Perl_do_close(pTHX_ GV* gv, bool not_implicit); +PERL_CALLCONV bool Perl_do_eof(pTHX_ GV* gv); +PERL_CALLCONV bool Perl_do_exec(pTHX_ char* cmd); #if !defined(WIN32) -VIRTUAL bool Perl_do_exec3(pTHX_ char* cmd, int fd, int flag); +PERL_CALLCONV bool Perl_do_exec3(pTHX_ char* cmd, int fd, int flag); #endif -VIRTUAL void Perl_do_execfree(pTHX); +PERL_CALLCONV void Perl_do_execfree(pTHX); #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) -VIRTUAL I32 Perl_do_ipcctl(pTHX_ I32 optype, SV** mark, SV** sp); -VIRTUAL I32 Perl_do_ipcget(pTHX_ I32 optype, SV** mark, SV** sp); -VIRTUAL I32 Perl_do_msgrcv(pTHX_ SV** mark, SV** sp); -VIRTUAL I32 Perl_do_msgsnd(pTHX_ SV** mark, SV** sp); -VIRTUAL I32 Perl_do_semop(pTHX_ SV** mark, SV** sp); -VIRTUAL I32 Perl_do_shmio(pTHX_ I32 optype, SV** mark, SV** sp); -#endif -VIRTUAL void Perl_do_join(pTHX_ SV* sv, SV* del, SV** mark, SV** sp); -VIRTUAL OP* Perl_do_kv(pTHX); -VIRTUAL bool Perl_do_open(pTHX_ GV* gv, char* name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO* supplied_fp); -VIRTUAL bool Perl_do_open9(pTHX_ GV *gv, char *name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp, SV *svs, I32 num); -VIRTUAL void Perl_do_pipe(pTHX_ SV* sv, GV* rgv, GV* wgv); -VIRTUAL bool Perl_do_print(pTHX_ SV* sv, PerlIO* fp); -VIRTUAL OP* Perl_do_readline(pTHX); -VIRTUAL I32 Perl_do_chomp(pTHX_ SV* sv); -VIRTUAL bool Perl_do_seek(pTHX_ GV* gv, Off_t pos, int whence); -VIRTUAL void Perl_do_sprintf(pTHX_ SV* sv, I32 len, SV** sarg); -VIRTUAL Off_t Perl_do_sysseek(pTHX_ GV* gv, Off_t pos, int whence); -VIRTUAL Off_t Perl_do_tell(pTHX_ GV* gv); -VIRTUAL I32 Perl_do_trans(pTHX_ SV* sv); -VIRTUAL UV Perl_do_vecget(pTHX_ SV* sv, I32 offset, I32 size); -VIRTUAL void Perl_do_vecset(pTHX_ SV* sv); -VIRTUAL void Perl_do_vop(pTHX_ I32 optype, SV* sv, SV* left, SV* right); -VIRTUAL OP* Perl_dofile(pTHX_ OP* term); -VIRTUAL I32 Perl_dowantarray(pTHX); -VIRTUAL void Perl_dump_all(pTHX); -VIRTUAL void Perl_dump_eval(pTHX); +PERL_CALLCONV I32 Perl_do_ipcctl(pTHX_ I32 optype, SV** mark, SV** sp); +PERL_CALLCONV I32 Perl_do_ipcget(pTHX_ I32 optype, SV** mark, SV** sp); +PERL_CALLCONV I32 Perl_do_msgrcv(pTHX_ SV** mark, SV** sp); +PERL_CALLCONV I32 Perl_do_msgsnd(pTHX_ SV** mark, SV** sp); +PERL_CALLCONV I32 Perl_do_semop(pTHX_ SV** mark, SV** sp); +PERL_CALLCONV I32 Perl_do_shmio(pTHX_ I32 optype, SV** mark, SV** sp); +#endif +PERL_CALLCONV void Perl_do_join(pTHX_ SV* sv, SV* del, SV** mark, SV** sp); +PERL_CALLCONV OP* Perl_do_kv(pTHX); +PERL_CALLCONV bool Perl_do_open(pTHX_ GV* gv, char* name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO* supplied_fp); +PERL_CALLCONV bool Perl_do_open9(pTHX_ GV *gv, char *name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp, SV *svs, I32 num); +PERL_CALLCONV void Perl_do_pipe(pTHX_ SV* sv, GV* rgv, GV* wgv); +PERL_CALLCONV bool Perl_do_print(pTHX_ SV* sv, PerlIO* fp); +PERL_CALLCONV OP* Perl_do_readline(pTHX); +PERL_CALLCONV I32 Perl_do_chomp(pTHX_ SV* sv); +PERL_CALLCONV bool Perl_do_seek(pTHX_ GV* gv, Off_t pos, int whence); +PERL_CALLCONV void Perl_do_sprintf(pTHX_ SV* sv, I32 len, SV** sarg); +PERL_CALLCONV Off_t Perl_do_sysseek(pTHX_ GV* gv, Off_t pos, int whence); +PERL_CALLCONV Off_t Perl_do_tell(pTHX_ GV* gv); +PERL_CALLCONV I32 Perl_do_trans(pTHX_ SV* sv); +PERL_CALLCONV UV Perl_do_vecget(pTHX_ SV* sv, I32 offset, I32 size); +PERL_CALLCONV void Perl_do_vecset(pTHX_ SV* sv); +PERL_CALLCONV void Perl_do_vop(pTHX_ I32 optype, SV* sv, SV* left, SV* right); +PERL_CALLCONV OP* Perl_dofile(pTHX_ OP* term); +PERL_CALLCONV I32 Perl_dowantarray(pTHX); +PERL_CALLCONV void Perl_dump_all(pTHX); +PERL_CALLCONV void Perl_dump_eval(pTHX); #if defined(DUMP_FDS) -VIRTUAL void Perl_dump_fds(pTHX_ char* s); -#endif -VIRTUAL void Perl_dump_form(pTHX_ GV* gv); -VIRTUAL void Perl_gv_dump(pTHX_ GV* gv); -VIRTUAL void Perl_op_dump(pTHX_ OP* arg); -VIRTUAL void Perl_pmop_dump(pTHX_ PMOP* pm); -VIRTUAL void Perl_dump_packsubs(pTHX_ HV* stash); -VIRTUAL void Perl_dump_sub(pTHX_ GV* gv); -VIRTUAL void Perl_fbm_compile(pTHX_ SV* sv, U32 flags); -VIRTUAL char* Perl_fbm_instr(pTHX_ unsigned char* big, unsigned char* bigend, SV* littlesv, U32 flags); -VIRTUAL char* Perl_find_script(pTHX_ char *scriptname, bool dosearch, char **search_ext, I32 flags); +PERL_CALLCONV void Perl_dump_fds(pTHX_ char* s); +#endif +PERL_CALLCONV void Perl_dump_form(pTHX_ GV* gv); +PERL_CALLCONV void Perl_gv_dump(pTHX_ GV* gv); +PERL_CALLCONV void Perl_op_dump(pTHX_ OP* arg); +PERL_CALLCONV void Perl_pmop_dump(pTHX_ PMOP* pm); +PERL_CALLCONV void Perl_dump_packsubs(pTHX_ HV* stash); +PERL_CALLCONV void Perl_dump_sub(pTHX_ GV* gv); +PERL_CALLCONV void Perl_fbm_compile(pTHX_ SV* sv, U32 flags); +PERL_CALLCONV char* Perl_fbm_instr(pTHX_ unsigned char* big, unsigned char* bigend, SV* littlesv, U32 flags); +PERL_CALLCONV char* Perl_find_script(pTHX_ char *scriptname, bool dosearch, char **search_ext, I32 flags); #if defined(USE_THREADS) -VIRTUAL PADOFFSET Perl_find_threadsv(pTHX_ const char *name); -#endif -VIRTUAL OP* Perl_force_list(pTHX_ OP* arg); -VIRTUAL OP* Perl_fold_constants(pTHX_ OP* arg); -VIRTUAL char* Perl_form(pTHX_ const char* pat, ...); -VIRTUAL char* Perl_vform(pTHX_ const char* pat, va_list* args); -VIRTUAL void Perl_free_tmps(pTHX); -VIRTUAL OP* Perl_gen_constant_list(pTHX_ OP* o); +PERL_CALLCONV PADOFFSET Perl_find_threadsv(pTHX_ const char *name); +#endif +PERL_CALLCONV OP* Perl_force_list(pTHX_ OP* arg); +PERL_CALLCONV OP* Perl_fold_constants(pTHX_ OP* arg); +PERL_CALLCONV char* Perl_form(pTHX_ const char* pat, ...); +PERL_CALLCONV char* Perl_vform(pTHX_ const char* pat, va_list* args); +PERL_CALLCONV void Perl_free_tmps(pTHX); +PERL_CALLCONV OP* Perl_gen_constant_list(pTHX_ OP* o); #if !defined(HAS_GETENV_LEN) -VIRTUAL char* Perl_getenv_len(pTHX_ char* key, unsigned long *len); -#endif -VIRTUAL void Perl_gp_free(pTHX_ GV* gv); -VIRTUAL GP* Perl_gp_ref(pTHX_ GP* gp); -VIRTUAL GV* Perl_gv_AVadd(pTHX_ GV* gv); -VIRTUAL GV* Perl_gv_HVadd(pTHX_ GV* gv); -VIRTUAL GV* Perl_gv_IOadd(pTHX_ GV* gv); -VIRTUAL GV* Perl_gv_autoload4(pTHX_ HV* stash, const char* name, STRLEN len, I32 method); -VIRTUAL void Perl_gv_check(pTHX_ HV* stash); -VIRTUAL void Perl_gv_efullname(pTHX_ SV* sv, GV* gv); -VIRTUAL void Perl_gv_efullname3(pTHX_ SV* sv, GV* gv, const char* prefix); -VIRTUAL GV* Perl_gv_fetchfile(pTHX_ const char* name); -VIRTUAL GV* Perl_gv_fetchmeth(pTHX_ HV* stash, const char* name, STRLEN len, I32 level); -VIRTUAL GV* Perl_gv_fetchmethod(pTHX_ HV* stash, const char* name); -VIRTUAL GV* Perl_gv_fetchmethod_autoload(pTHX_ HV* stash, const char* name, I32 autoload); -VIRTUAL GV* Perl_gv_fetchpv(pTHX_ const char* name, I32 add, I32 sv_type); -VIRTUAL void Perl_gv_fullname(pTHX_ SV* sv, GV* gv); -VIRTUAL void Perl_gv_fullname3(pTHX_ SV* sv, GV* gv, const char* prefix); -VIRTUAL void Perl_gv_init(pTHX_ GV* gv, HV* stash, const char* name, STRLEN len, int multi); -VIRTUAL HV* Perl_gv_stashpv(pTHX_ const char* name, I32 create); -VIRTUAL HV* Perl_gv_stashpvn(pTHX_ const char* name, U32 namelen, I32 create); -VIRTUAL HV* Perl_gv_stashsv(pTHX_ SV* sv, I32 create); -VIRTUAL void Perl_hv_clear(pTHX_ HV* tb); -VIRTUAL void Perl_hv_delayfree_ent(pTHX_ HV* hv, HE* entry); -VIRTUAL SV* Perl_hv_delete(pTHX_ HV* tb, const char* key, U32 klen, I32 flags); -VIRTUAL SV* Perl_hv_delete_ent(pTHX_ HV* tb, SV* key, I32 flags, U32 hash); -VIRTUAL bool Perl_hv_exists(pTHX_ HV* tb, const char* key, U32 klen); -VIRTUAL bool Perl_hv_exists_ent(pTHX_ HV* tb, SV* key, U32 hash); -VIRTUAL SV** Perl_hv_fetch(pTHX_ HV* tb, const char* key, U32 klen, I32 lval); -VIRTUAL HE* Perl_hv_fetch_ent(pTHX_ HV* tb, SV* key, I32 lval, U32 hash); -VIRTUAL void Perl_hv_free_ent(pTHX_ HV* hv, HE* entry); -VIRTUAL I32 Perl_hv_iterinit(pTHX_ HV* tb); -VIRTUAL char* Perl_hv_iterkey(pTHX_ HE* entry, I32* retlen); -VIRTUAL SV* Perl_hv_iterkeysv(pTHX_ HE* entry); -VIRTUAL HE* Perl_hv_iternext(pTHX_ HV* tb); -VIRTUAL SV* Perl_hv_iternextsv(pTHX_ HV* hv, char** key, I32* retlen); -VIRTUAL SV* Perl_hv_iterval(pTHX_ HV* tb, HE* entry); -VIRTUAL void Perl_hv_ksplit(pTHX_ HV* hv, IV newmax); -VIRTUAL void Perl_hv_magic(pTHX_ HV* hv, GV* gv, int how); -VIRTUAL SV** Perl_hv_store(pTHX_ HV* tb, const char* key, U32 klen, SV* val, U32 hash); -VIRTUAL HE* Perl_hv_store_ent(pTHX_ HV* tb, SV* key, SV* val, U32 hash); -VIRTUAL void Perl_hv_undef(pTHX_ HV* tb); -VIRTUAL I32 Perl_ibcmp(pTHX_ const char* a, const char* b, I32 len); -VIRTUAL I32 Perl_ibcmp_locale(pTHX_ const char* a, const char* b, I32 len); -VIRTUAL bool Perl_ingroup(pTHX_ Gid_t testgid, Uid_t effective); -VIRTUAL void Perl_init_debugger(pTHX); -VIRTUAL void Perl_init_stacks(pTHX); -VIRTUAL U32 Perl_intro_my(pTHX); -VIRTUAL char* Perl_instr(pTHX_ const char* big, const char* little); -VIRTUAL bool Perl_io_close(pTHX_ IO* io, bool not_implicit); -VIRTUAL OP* Perl_invert(pTHX_ OP* cmd); -VIRTUAL bool Perl_is_uni_alnum(pTHX_ U32 c); -VIRTUAL bool Perl_is_uni_alnumc(pTHX_ U32 c); -VIRTUAL bool Perl_is_uni_idfirst(pTHX_ U32 c); -VIRTUAL bool Perl_is_uni_alpha(pTHX_ U32 c); -VIRTUAL bool Perl_is_uni_ascii(pTHX_ U32 c); -VIRTUAL bool Perl_is_uni_space(pTHX_ U32 c); -VIRTUAL bool Perl_is_uni_cntrl(pTHX_ U32 c); -VIRTUAL bool Perl_is_uni_graph(pTHX_ U32 c); -VIRTUAL bool Perl_is_uni_digit(pTHX_ U32 c); -VIRTUAL bool Perl_is_uni_upper(pTHX_ U32 c); -VIRTUAL bool Perl_is_uni_lower(pTHX_ U32 c); -VIRTUAL bool Perl_is_uni_print(pTHX_ U32 c); -VIRTUAL bool Perl_is_uni_punct(pTHX_ U32 c); -VIRTUAL bool Perl_is_uni_xdigit(pTHX_ U32 c); -VIRTUAL U32 Perl_to_uni_upper(pTHX_ U32 c); -VIRTUAL U32 Perl_to_uni_title(pTHX_ U32 c); -VIRTUAL U32 Perl_to_uni_lower(pTHX_ U32 c); -VIRTUAL bool Perl_is_uni_alnum_lc(pTHX_ U32 c); -VIRTUAL bool Perl_is_uni_alnumc_lc(pTHX_ U32 c); -VIRTUAL bool Perl_is_uni_idfirst_lc(pTHX_ U32 c); -VIRTUAL bool Perl_is_uni_alpha_lc(pTHX_ U32 c); -VIRTUAL bool Perl_is_uni_ascii_lc(pTHX_ U32 c); -VIRTUAL bool Perl_is_uni_space_lc(pTHX_ U32 c); -VIRTUAL bool Perl_is_uni_cntrl_lc(pTHX_ U32 c); -VIRTUAL bool Perl_is_uni_graph_lc(pTHX_ U32 c); -VIRTUAL bool Perl_is_uni_digit_lc(pTHX_ U32 c); -VIRTUAL bool Perl_is_uni_upper_lc(pTHX_ U32 c); -VIRTUAL bool Perl_is_uni_lower_lc(pTHX_ U32 c); -VIRTUAL bool Perl_is_uni_print_lc(pTHX_ U32 c); -VIRTUAL bool Perl_is_uni_punct_lc(pTHX_ U32 c); -VIRTUAL bool Perl_is_uni_xdigit_lc(pTHX_ U32 c); -VIRTUAL U32 Perl_to_uni_upper_lc(pTHX_ U32 c); -VIRTUAL U32 Perl_to_uni_title_lc(pTHX_ U32 c); -VIRTUAL U32 Perl_to_uni_lower_lc(pTHX_ U32 c); -VIRTUAL bool Perl_is_utf8_alnum(pTHX_ U8 *p); -VIRTUAL bool Perl_is_utf8_alnumc(pTHX_ U8 *p); -VIRTUAL bool Perl_is_utf8_idfirst(pTHX_ U8 *p); -VIRTUAL bool Perl_is_utf8_alpha(pTHX_ U8 *p); -VIRTUAL bool Perl_is_utf8_ascii(pTHX_ U8 *p); -VIRTUAL bool Perl_is_utf8_space(pTHX_ U8 *p); -VIRTUAL bool Perl_is_utf8_cntrl(pTHX_ U8 *p); -VIRTUAL bool Perl_is_utf8_digit(pTHX_ U8 *p); -VIRTUAL bool Perl_is_utf8_graph(pTHX_ U8 *p); -VIRTUAL bool Perl_is_utf8_upper(pTHX_ U8 *p); -VIRTUAL bool Perl_is_utf8_lower(pTHX_ U8 *p); -VIRTUAL bool Perl_is_utf8_print(pTHX_ U8 *p); -VIRTUAL bool Perl_is_utf8_punct(pTHX_ U8 *p); -VIRTUAL bool Perl_is_utf8_xdigit(pTHX_ U8 *p); -VIRTUAL bool Perl_is_utf8_mark(pTHX_ U8 *p); -VIRTUAL OP* Perl_jmaybe(pTHX_ OP* arg); -VIRTUAL I32 Perl_keyword(pTHX_ char* d, I32 len); -VIRTUAL void Perl_leave_scope(pTHX_ I32 base); -VIRTUAL void Perl_lex_end(pTHX); -VIRTUAL void Perl_lex_start(pTHX_ SV* line); -VIRTUAL OP* Perl_linklist(pTHX_ OP* o); -VIRTUAL OP* Perl_list(pTHX_ OP* o); -VIRTUAL OP* Perl_listkids(pTHX_ OP* o); -VIRTUAL OP* Perl_localize(pTHX_ OP* arg, I32 lexical); -VIRTUAL I32 Perl_looks_like_number(pTHX_ SV* sv); -VIRTUAL int Perl_magic_clearenv(pTHX_ SV* sv, MAGIC* mg); -VIRTUAL int Perl_magic_clear_all_env(pTHX_ SV* sv, MAGIC* mg); -VIRTUAL int Perl_magic_clearpack(pTHX_ SV* sv, MAGIC* mg); -VIRTUAL int Perl_magic_clearsig(pTHX_ SV* sv, MAGIC* mg); -VIRTUAL int Perl_magic_existspack(pTHX_ SV* sv, MAGIC* mg); -VIRTUAL int Perl_magic_freeregexp(pTHX_ SV* sv, MAGIC* mg); -VIRTUAL int Perl_magic_get(pTHX_ SV* sv, MAGIC* mg); -VIRTUAL int Perl_magic_getarylen(pTHX_ SV* sv, MAGIC* mg); -VIRTUAL int Perl_magic_getdefelem(pTHX_ SV* sv, MAGIC* mg); -VIRTUAL int Perl_magic_getglob(pTHX_ SV* sv, MAGIC* mg); -VIRTUAL int Perl_magic_getnkeys(pTHX_ SV* sv, MAGIC* mg); -VIRTUAL int Perl_magic_getpack(pTHX_ SV* sv, MAGIC* mg); -VIRTUAL int Perl_magic_getpos(pTHX_ SV* sv, MAGIC* mg); -VIRTUAL int Perl_magic_getsig(pTHX_ SV* sv, MAGIC* mg); -VIRTUAL int Perl_magic_getsubstr(pTHX_ SV* sv, MAGIC* mg); -VIRTUAL int Perl_magic_gettaint(pTHX_ SV* sv, MAGIC* mg); -VIRTUAL int Perl_magic_getuvar(pTHX_ SV* sv, MAGIC* mg); -VIRTUAL int Perl_magic_getvec(pTHX_ SV* sv, MAGIC* mg); -VIRTUAL U32 Perl_magic_len(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV char* Perl_getenv_len(pTHX_ char* key, unsigned long *len); +#endif +PERL_CALLCONV void Perl_gp_free(pTHX_ GV* gv); +PERL_CALLCONV GP* Perl_gp_ref(pTHX_ GP* gp); +PERL_CALLCONV GV* Perl_gv_AVadd(pTHX_ GV* gv); +PERL_CALLCONV GV* Perl_gv_HVadd(pTHX_ GV* gv); +PERL_CALLCONV GV* Perl_gv_IOadd(pTHX_ GV* gv); +PERL_CALLCONV GV* Perl_gv_autoload4(pTHX_ HV* stash, const char* name, STRLEN len, I32 method); +PERL_CALLCONV void Perl_gv_check(pTHX_ HV* stash); +PERL_CALLCONV void Perl_gv_efullname(pTHX_ SV* sv, GV* gv); +PERL_CALLCONV void Perl_gv_efullname3(pTHX_ SV* sv, GV* gv, const char* prefix); +PERL_CALLCONV GV* Perl_gv_fetchfile(pTHX_ const char* name); +PERL_CALLCONV GV* Perl_gv_fetchmeth(pTHX_ HV* stash, const char* name, STRLEN len, I32 level); +PERL_CALLCONV GV* Perl_gv_fetchmethod(pTHX_ HV* stash, const char* name); +PERL_CALLCONV GV* Perl_gv_fetchmethod_autoload(pTHX_ HV* stash, const char* name, I32 autoload); +PERL_CALLCONV GV* Perl_gv_fetchpv(pTHX_ const char* name, I32 add, I32 sv_type); +PERL_CALLCONV void Perl_gv_fullname(pTHX_ SV* sv, GV* gv); +PERL_CALLCONV void Perl_gv_fullname3(pTHX_ SV* sv, GV* gv, const char* prefix); +PERL_CALLCONV void Perl_gv_init(pTHX_ GV* gv, HV* stash, const char* name, STRLEN len, int multi); +PERL_CALLCONV HV* Perl_gv_stashpv(pTHX_ const char* name, I32 create); +PERL_CALLCONV HV* Perl_gv_stashpvn(pTHX_ const char* name, U32 namelen, I32 create); +PERL_CALLCONV HV* Perl_gv_stashsv(pTHX_ SV* sv, I32 create); +PERL_CALLCONV void Perl_hv_clear(pTHX_ HV* tb); +PERL_CALLCONV void Perl_hv_delayfree_ent(pTHX_ HV* hv, HE* entry); +PERL_CALLCONV SV* Perl_hv_delete(pTHX_ HV* tb, const char* key, U32 klen, I32 flags); +PERL_CALLCONV SV* Perl_hv_delete_ent(pTHX_ HV* tb, SV* key, I32 flags, U32 hash); +PERL_CALLCONV bool Perl_hv_exists(pTHX_ HV* tb, const char* key, U32 klen); +PERL_CALLCONV bool Perl_hv_exists_ent(pTHX_ HV* tb, SV* key, U32 hash); +PERL_CALLCONV SV** Perl_hv_fetch(pTHX_ HV* tb, const char* key, U32 klen, I32 lval); +PERL_CALLCONV HE* Perl_hv_fetch_ent(pTHX_ HV* tb, SV* key, I32 lval, U32 hash); +PERL_CALLCONV void Perl_hv_free_ent(pTHX_ HV* hv, HE* entry); +PERL_CALLCONV I32 Perl_hv_iterinit(pTHX_ HV* tb); +PERL_CALLCONV char* Perl_hv_iterkey(pTHX_ HE* entry, I32* retlen); +PERL_CALLCONV SV* Perl_hv_iterkeysv(pTHX_ HE* entry); +PERL_CALLCONV HE* Perl_hv_iternext(pTHX_ HV* tb); +PERL_CALLCONV SV* Perl_hv_iternextsv(pTHX_ HV* hv, char** key, I32* retlen); +PERL_CALLCONV SV* Perl_hv_iterval(pTHX_ HV* tb, HE* entry); +PERL_CALLCONV void Perl_hv_ksplit(pTHX_ HV* hv, IV newmax); +PERL_CALLCONV void Perl_hv_magic(pTHX_ HV* hv, GV* gv, int how); +PERL_CALLCONV SV** Perl_hv_store(pTHX_ HV* tb, const char* key, U32 klen, SV* val, U32 hash); +PERL_CALLCONV HE* Perl_hv_store_ent(pTHX_ HV* tb, SV* key, SV* val, U32 hash); +PERL_CALLCONV void Perl_hv_undef(pTHX_ HV* tb); +PERL_CALLCONV I32 Perl_ibcmp(pTHX_ const char* a, const char* b, I32 len); +PERL_CALLCONV I32 Perl_ibcmp_locale(pTHX_ const char* a, const char* b, I32 len); +PERL_CALLCONV bool Perl_ingroup(pTHX_ Gid_t testgid, Uid_t effective); +PERL_CALLCONV void Perl_init_debugger(pTHX); +PERL_CALLCONV void Perl_init_stacks(pTHX); +PERL_CALLCONV U32 Perl_intro_my(pTHX); +PERL_CALLCONV char* Perl_instr(pTHX_ const char* big, const char* little); +PERL_CALLCONV bool Perl_io_close(pTHX_ IO* io, bool not_implicit); +PERL_CALLCONV OP* Perl_invert(pTHX_ OP* cmd); +PERL_CALLCONV bool Perl_is_uni_alnum(pTHX_ U32 c); +PERL_CALLCONV bool Perl_is_uni_alnumc(pTHX_ U32 c); +PERL_CALLCONV bool Perl_is_uni_idfirst(pTHX_ U32 c); +PERL_CALLCONV bool Perl_is_uni_alpha(pTHX_ U32 c); +PERL_CALLCONV bool Perl_is_uni_ascii(pTHX_ U32 c); +PERL_CALLCONV bool Perl_is_uni_space(pTHX_ U32 c); +PERL_CALLCONV bool Perl_is_uni_cntrl(pTHX_ U32 c); +PERL_CALLCONV bool Perl_is_uni_graph(pTHX_ U32 c); +PERL_CALLCONV bool Perl_is_uni_digit(pTHX_ U32 c); +PERL_CALLCONV bool Perl_is_uni_upper(pTHX_ U32 c); +PERL_CALLCONV bool Perl_is_uni_lower(pTHX_ U32 c); +PERL_CALLCONV bool Perl_is_uni_print(pTHX_ U32 c); +PERL_CALLCONV bool Perl_is_uni_punct(pTHX_ U32 c); +PERL_CALLCONV bool Perl_is_uni_xdigit(pTHX_ U32 c); +PERL_CALLCONV U32 Perl_to_uni_upper(pTHX_ U32 c); +PERL_CALLCONV U32 Perl_to_uni_title(pTHX_ U32 c); +PERL_CALLCONV U32 Perl_to_uni_lower(pTHX_ U32 c); +PERL_CALLCONV bool Perl_is_uni_alnum_lc(pTHX_ U32 c); +PERL_CALLCONV bool Perl_is_uni_alnumc_lc(pTHX_ U32 c); +PERL_CALLCONV bool Perl_is_uni_idfirst_lc(pTHX_ U32 c); +PERL_CALLCONV bool Perl_is_uni_alpha_lc(pTHX_ U32 c); +PERL_CALLCONV bool Perl_is_uni_ascii_lc(pTHX_ U32 c); +PERL_CALLCONV bool Perl_is_uni_space_lc(pTHX_ U32 c); +PERL_CALLCONV bool Perl_is_uni_cntrl_lc(pTHX_ U32 c); +PERL_CALLCONV bool Perl_is_uni_graph_lc(pTHX_ U32 c); +PERL_CALLCONV bool Perl_is_uni_digit_lc(pTHX_ U32 c); +PERL_CALLCONV bool Perl_is_uni_upper_lc(pTHX_ U32 c); +PERL_CALLCONV bool Perl_is_uni_lower_lc(pTHX_ U32 c); +PERL_CALLCONV bool Perl_is_uni_print_lc(pTHX_ U32 c); +PERL_CALLCONV bool Perl_is_uni_punct_lc(pTHX_ U32 c); +PERL_CALLCONV bool Perl_is_uni_xdigit_lc(pTHX_ U32 c); +PERL_CALLCONV U32 Perl_to_uni_upper_lc(pTHX_ U32 c); +PERL_CALLCONV U32 Perl_to_uni_title_lc(pTHX_ U32 c); +PERL_CALLCONV U32 Perl_to_uni_lower_lc(pTHX_ U32 c); +PERL_CALLCONV bool Perl_is_utf8_alnum(pTHX_ U8 *p); +PERL_CALLCONV bool Perl_is_utf8_alnumc(pTHX_ U8 *p); +PERL_CALLCONV bool Perl_is_utf8_idfirst(pTHX_ U8 *p); +PERL_CALLCONV bool Perl_is_utf8_alpha(pTHX_ U8 *p); +PERL_CALLCONV bool Perl_is_utf8_ascii(pTHX_ U8 *p); +PERL_CALLCONV bool Perl_is_utf8_space(pTHX_ U8 *p); +PERL_CALLCONV bool Perl_is_utf8_cntrl(pTHX_ U8 *p); +PERL_CALLCONV bool Perl_is_utf8_digit(pTHX_ U8 *p); +PERL_CALLCONV bool Perl_is_utf8_graph(pTHX_ U8 *p); +PERL_CALLCONV bool Perl_is_utf8_upper(pTHX_ U8 *p); +PERL_CALLCONV bool Perl_is_utf8_lower(pTHX_ U8 *p); +PERL_CALLCONV bool Perl_is_utf8_print(pTHX_ U8 *p); +PERL_CALLCONV bool Perl_is_utf8_punct(pTHX_ U8 *p); +PERL_CALLCONV bool Perl_is_utf8_xdigit(pTHX_ U8 *p); +PERL_CALLCONV bool Perl_is_utf8_mark(pTHX_ U8 *p); +PERL_CALLCONV OP* Perl_jmaybe(pTHX_ OP* arg); +PERL_CALLCONV I32 Perl_keyword(pTHX_ char* d, I32 len); +PERL_CALLCONV void Perl_leave_scope(pTHX_ I32 base); +PERL_CALLCONV void Perl_lex_end(pTHX); +PERL_CALLCONV void Perl_lex_start(pTHX_ SV* line); +PERL_CALLCONV OP* Perl_linklist(pTHX_ OP* o); +PERL_CALLCONV OP* Perl_list(pTHX_ OP* o); +PERL_CALLCONV OP* Perl_listkids(pTHX_ OP* o); +PERL_CALLCONV OP* Perl_localize(pTHX_ OP* arg, I32 lexical); +PERL_CALLCONV I32 Perl_looks_like_number(pTHX_ SV* sv); +PERL_CALLCONV int Perl_magic_clearenv(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV int Perl_magic_clear_all_env(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV int Perl_magic_clearpack(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV int Perl_magic_clearsig(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV int Perl_magic_existspack(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV int Perl_magic_freeregexp(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV int Perl_magic_get(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV int Perl_magic_getarylen(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV int Perl_magic_getdefelem(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV int Perl_magic_getglob(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV int Perl_magic_getnkeys(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV int Perl_magic_getpack(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV int Perl_magic_getpos(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV int Perl_magic_getsig(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV int Perl_magic_getsubstr(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV int Perl_magic_gettaint(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV int Perl_magic_getuvar(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV int Perl_magic_getvec(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV U32 Perl_magic_len(pTHX_ SV* sv, MAGIC* mg); #if defined(USE_THREADS) -VIRTUAL int Perl_magic_mutexfree(pTHX_ SV* sv, MAGIC* mg); -#endif -VIRTUAL int Perl_magic_nextpack(pTHX_ SV* sv, MAGIC* mg, SV* key); -VIRTUAL U32 Perl_magic_regdata_cnt(pTHX_ SV* sv, MAGIC* mg); -VIRTUAL int Perl_magic_regdatum_get(pTHX_ SV* sv, MAGIC* mg); -VIRTUAL int Perl_magic_set(pTHX_ SV* sv, MAGIC* mg); -VIRTUAL int Perl_magic_setamagic(pTHX_ SV* sv, MAGIC* mg); -VIRTUAL int Perl_magic_setarylen(pTHX_ SV* sv, MAGIC* mg); -VIRTUAL int Perl_magic_setbm(pTHX_ SV* sv, MAGIC* mg); -VIRTUAL int Perl_magic_setdbline(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV int Perl_magic_mutexfree(pTHX_ SV* sv, MAGIC* mg); +#endif +PERL_CALLCONV int Perl_magic_nextpack(pTHX_ SV* sv, MAGIC* mg, SV* key); +PERL_CALLCONV U32 Perl_magic_regdata_cnt(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV int Perl_magic_regdatum_get(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV int Perl_magic_set(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV int Perl_magic_setamagic(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV int Perl_magic_setarylen(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV int Perl_magic_setbm(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV int Perl_magic_setdbline(pTHX_ SV* sv, MAGIC* mg); #if defined(USE_LOCALE_COLLATE) -VIRTUAL int Perl_magic_setcollxfrm(pTHX_ SV* sv, MAGIC* mg); -#endif -VIRTUAL int Perl_magic_setdefelem(pTHX_ SV* sv, MAGIC* mg); -VIRTUAL int Perl_magic_setenv(pTHX_ SV* sv, MAGIC* mg); -VIRTUAL int Perl_magic_setfm(pTHX_ SV* sv, MAGIC* mg); -VIRTUAL int Perl_magic_setisa(pTHX_ SV* sv, MAGIC* mg); -VIRTUAL int Perl_magic_setglob(pTHX_ SV* sv, MAGIC* mg); -VIRTUAL int Perl_magic_setmglob(pTHX_ SV* sv, MAGIC* mg); -VIRTUAL int Perl_magic_setnkeys(pTHX_ SV* sv, MAGIC* mg); -VIRTUAL int Perl_magic_setpack(pTHX_ SV* sv, MAGIC* mg); -VIRTUAL int Perl_magic_setpos(pTHX_ SV* sv, MAGIC* mg); -VIRTUAL int Perl_magic_setsig(pTHX_ SV* sv, MAGIC* mg); -VIRTUAL int Perl_magic_setsubstr(pTHX_ SV* sv, MAGIC* mg); -VIRTUAL int Perl_magic_settaint(pTHX_ SV* sv, MAGIC* mg); -VIRTUAL int Perl_magic_setuvar(pTHX_ SV* sv, MAGIC* mg); -VIRTUAL int Perl_magic_setvec(pTHX_ SV* sv, MAGIC* mg); -VIRTUAL int Perl_magic_set_all_env(pTHX_ SV* sv, MAGIC* mg); -VIRTUAL U32 Perl_magic_sizepack(pTHX_ SV* sv, MAGIC* mg); -VIRTUAL int Perl_magic_wipepack(pTHX_ SV* sv, MAGIC* mg); -VIRTUAL void Perl_magicname(pTHX_ char* sym, char* name, I32 namlen); -#if defined(MYMALLOC) -VIRTUAL MEM_SIZE Perl_malloced_size(void *p); +PERL_CALLCONV int Perl_magic_setcollxfrm(pTHX_ SV* sv, MAGIC* mg); #endif -VIRTUAL void Perl_markstack_grow(pTHX); +PERL_CALLCONV int Perl_magic_setdefelem(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV int Perl_magic_setenv(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV int Perl_magic_setfm(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV int Perl_magic_setisa(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV int Perl_magic_setglob(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV int Perl_magic_setmglob(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV int Perl_magic_setnkeys(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV int Perl_magic_setpack(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV int Perl_magic_setpos(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV int Perl_magic_setsig(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV int Perl_magic_setsubstr(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV int Perl_magic_settaint(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV int Perl_magic_setuvar(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV int Perl_magic_setvec(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV int Perl_magic_set_all_env(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV U32 Perl_magic_sizepack(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV int Perl_magic_wipepack(pTHX_ SV* sv, MAGIC* mg); +PERL_CALLCONV void Perl_magicname(pTHX_ char* sym, char* name, I32 namlen); +PERL_CALLCONV void Perl_markstack_grow(pTHX); #if defined(USE_LOCALE_COLLATE) -VIRTUAL char* Perl_mem_collxfrm(pTHX_ const char* s, STRLEN len, STRLEN* xlen); -#endif -VIRTUAL SV* Perl_mess(pTHX_ const char* pat, ...); -VIRTUAL SV* Perl_vmess(pTHX_ const char* pat, va_list* args); -VIRTUAL void Perl_qerror(pTHX_ SV* err); -VIRTUAL int Perl_mg_clear(pTHX_ SV* sv); -VIRTUAL int Perl_mg_copy(pTHX_ SV* sv, SV* nsv, const char* key, I32 klen); -VIRTUAL MAGIC* Perl_mg_find(pTHX_ SV* sv, int type); -VIRTUAL int Perl_mg_free(pTHX_ SV* sv); -VIRTUAL int Perl_mg_get(pTHX_ SV* sv); -VIRTUAL U32 Perl_mg_length(pTHX_ SV* sv); -VIRTUAL void Perl_mg_magical(pTHX_ SV* sv); -VIRTUAL int Perl_mg_set(pTHX_ SV* sv); -VIRTUAL I32 Perl_mg_size(pTHX_ SV* sv); -VIRTUAL OP* Perl_mod(pTHX_ OP* o, I32 type); -VIRTUAL char* Perl_moreswitches(pTHX_ char* s); -VIRTUAL OP* Perl_my(pTHX_ OP* o); -VIRTUAL NV Perl_my_atof(pTHX_ const char *s); +PERL_CALLCONV char* Perl_mem_collxfrm(pTHX_ const char* s, STRLEN len, STRLEN* xlen); +#endif +PERL_CALLCONV SV* Perl_mess(pTHX_ const char* pat, ...); +PERL_CALLCONV SV* Perl_vmess(pTHX_ const char* pat, va_list* args); +PERL_CALLCONV void Perl_qerror(pTHX_ SV* err); +PERL_CALLCONV int Perl_mg_clear(pTHX_ SV* sv); +PERL_CALLCONV int Perl_mg_copy(pTHX_ SV* sv, SV* nsv, const char* key, I32 klen); +PERL_CALLCONV MAGIC* Perl_mg_find(pTHX_ SV* sv, int type); +PERL_CALLCONV int Perl_mg_free(pTHX_ SV* sv); +PERL_CALLCONV int Perl_mg_get(pTHX_ SV* sv); +PERL_CALLCONV U32 Perl_mg_length(pTHX_ SV* sv); +PERL_CALLCONV void Perl_mg_magical(pTHX_ SV* sv); +PERL_CALLCONV int Perl_mg_set(pTHX_ SV* sv); +PERL_CALLCONV I32 Perl_mg_size(pTHX_ SV* sv); +PERL_CALLCONV OP* Perl_mod(pTHX_ OP* o, I32 type); +PERL_CALLCONV char* Perl_moreswitches(pTHX_ char* s); +PERL_CALLCONV OP* Perl_my(pTHX_ OP* o); +PERL_CALLCONV NV Perl_my_atof(pTHX_ const char *s); #if !defined(HAS_BCOPY) || !defined(HAS_SAFE_BCOPY) -VIRTUAL char* Perl_my_bcopy(pTHX_ const char* from, char* to, I32 len); +PERL_CALLCONV char* Perl_my_bcopy(const char* from, char* to, I32 len); #endif #if !defined(HAS_BZERO) && !defined(HAS_MEMSET) -VIRTUAL char* Perl_my_bzero(pTHX_ char* loc, I32 len); +PERL_CALLCONV char* Perl_my_bzero(char* loc, I32 len); #endif -VIRTUAL void Perl_my_exit(pTHX_ U32 status) __attribute__((noreturn)); -VIRTUAL void Perl_my_failure_exit(pTHX) __attribute__((noreturn)); -VIRTUAL I32 Perl_my_fflush_all(pTHX); -VIRTUAL I32 Perl_my_lstat(pTHX); +PERL_CALLCONV void Perl_my_exit(pTHX_ U32 status) __attribute__((noreturn)); +PERL_CALLCONV void Perl_my_failure_exit(pTHX) __attribute__((noreturn)); +PERL_CALLCONV I32 Perl_my_fflush_all(pTHX); +PERL_CALLCONV I32 Perl_my_lstat(pTHX); #if !defined(HAS_MEMCMP) || !defined(HAS_SANE_MEMCMP) -VIRTUAL I32 Perl_my_memcmp(pTHX_ const char* s1, const char* s2, I32 len); +PERL_CALLCONV I32 Perl_my_memcmp(const char* s1, const char* s2, I32 len); #endif #if !defined(HAS_MEMSET) -VIRTUAL void* Perl_my_memset(pTHX_ char* loc, I32 ch, I32 len); +PERL_CALLCONV void* Perl_my_memset(char* loc, I32 ch, I32 len); #endif #if !defined(PERL_OBJECT) -VIRTUAL I32 Perl_my_pclose(pTHX_ PerlIO* ptr); -VIRTUAL PerlIO* Perl_my_popen(pTHX_ char* cmd, char* mode); +PERL_CALLCONV I32 Perl_my_pclose(pTHX_ PerlIO* ptr); +PERL_CALLCONV PerlIO* Perl_my_popen(pTHX_ char* cmd, char* mode); #endif -VIRTUAL void Perl_my_setenv(pTHX_ char* nam, char* val); -VIRTUAL I32 Perl_my_stat(pTHX); +PERL_CALLCONV void Perl_my_setenv(pTHX_ char* nam, char* val); +PERL_CALLCONV I32 Perl_my_stat(pTHX); #if defined(MYSWAP) -VIRTUAL short Perl_my_swap(pTHX_ short s); -VIRTUAL long Perl_my_htonl(pTHX_ long l); -VIRTUAL long Perl_my_ntohl(pTHX_ long l); -#endif -VIRTUAL void Perl_my_unexec(pTHX); -VIRTUAL OP* Perl_newANONLIST(pTHX_ OP* o); -VIRTUAL OP* Perl_newANONHASH(pTHX_ OP* o); -VIRTUAL OP* Perl_newANONSUB(pTHX_ I32 floor, OP* proto, OP* block); -VIRTUAL OP* Perl_newASSIGNOP(pTHX_ I32 flags, OP* left, I32 optype, OP* right); -VIRTUAL OP* Perl_newCONDOP(pTHX_ I32 flags, OP* expr, OP* trueop, OP* falseop); -VIRTUAL void Perl_newCONSTSUB(pTHX_ HV* stash, char* name, SV* sv); -VIRTUAL void Perl_newFORM(pTHX_ I32 floor, OP* o, OP* block); -VIRTUAL OP* Perl_newFOROP(pTHX_ I32 flags, char* label, line_t forline, OP* sclr, OP* expr, OP*block, OP*cont); -VIRTUAL OP* Perl_newLOGOP(pTHX_ I32 optype, I32 flags, OP* left, OP* right); -VIRTUAL OP* Perl_newLOOPEX(pTHX_ I32 type, OP* label); -VIRTUAL OP* Perl_newLOOPOP(pTHX_ I32 flags, I32 debuggable, OP* expr, OP* block); -VIRTUAL OP* Perl_newNULLLIST(pTHX); -VIRTUAL OP* Perl_newOP(pTHX_ I32 optype, I32 flags); -VIRTUAL void Perl_newPROG(pTHX_ OP* o); -VIRTUAL OP* Perl_newRANGE(pTHX_ I32 flags, OP* left, OP* right); -VIRTUAL OP* Perl_newSLICEOP(pTHX_ I32 flags, OP* subscript, OP* listop); -VIRTUAL OP* Perl_newSTATEOP(pTHX_ I32 flags, char* label, OP* o); -VIRTUAL CV* Perl_newSUB(pTHX_ I32 floor, OP* o, OP* proto, OP* block); -VIRTUAL CV* Perl_newXS(pTHX_ char* name, XSUBADDR_t f, char* filename); -VIRTUAL AV* Perl_newAV(pTHX); -VIRTUAL OP* Perl_newAVREF(pTHX_ OP* o); -VIRTUAL OP* Perl_newBINOP(pTHX_ I32 type, I32 flags, OP* first, OP* last); -VIRTUAL OP* Perl_newCVREF(pTHX_ I32 flags, OP* o); -VIRTUAL OP* Perl_newGVOP(pTHX_ I32 type, I32 flags, GV* gv); -VIRTUAL GV* Perl_newGVgen(pTHX_ char* pack); -VIRTUAL OP* Perl_newGVREF(pTHX_ I32 type, OP* o); -VIRTUAL OP* Perl_newHVREF(pTHX_ OP* o); -VIRTUAL HV* Perl_newHV(pTHX); -VIRTUAL HV* Perl_newHVhv(pTHX_ HV* hv); -VIRTUAL IO* Perl_newIO(pTHX); -VIRTUAL OP* Perl_newLISTOP(pTHX_ I32 type, I32 flags, OP* first, OP* last); -VIRTUAL OP* Perl_newPMOP(pTHX_ I32 type, I32 flags); -VIRTUAL OP* Perl_newPVOP(pTHX_ I32 type, I32 flags, char* pv); -VIRTUAL SV* Perl_newRV(pTHX_ SV* pref); -VIRTUAL SV* Perl_newRV_noinc(pTHX_ SV *sv); -VIRTUAL SV* Perl_newSV(pTHX_ STRLEN len); -VIRTUAL OP* Perl_newSVREF(pTHX_ OP* o); -VIRTUAL OP* Perl_newSVOP(pTHX_ I32 type, I32 flags, SV* sv); -VIRTUAL SV* Perl_newSViv(pTHX_ IV i); -VIRTUAL SV* Perl_newSVnv(pTHX_ NV n); -VIRTUAL SV* Perl_newSVpv(pTHX_ const char* s, STRLEN len); -VIRTUAL SV* Perl_newSVpvn(pTHX_ const char* s, STRLEN len); -VIRTUAL SV* Perl_newSVpvf(pTHX_ const char* pat, ...); -VIRTUAL SV* Perl_vnewSVpvf(pTHX_ const char* pat, va_list* args); -VIRTUAL SV* Perl_newSVrv(pTHX_ SV* rv, const char* classname); -VIRTUAL SV* Perl_newSVsv(pTHX_ SV* old); -VIRTUAL OP* Perl_newUNOP(pTHX_ I32 type, I32 flags, OP* first); -VIRTUAL OP* Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP* loop, I32 whileline, OP* expr, OP* block, OP* cont); -VIRTUAL PERL_SI* Perl_new_stackinfo(pTHX_ I32 stitems, I32 cxitems); -VIRTUAL PerlIO* Perl_nextargv(pTHX_ GV* gv); -VIRTUAL char* Perl_ninstr(pTHX_ const char* big, const char* bigend, const char* little, const char* lend); -VIRTUAL OP* Perl_oopsCV(pTHX_ OP* o); -VIRTUAL void Perl_op_free(pTHX_ OP* arg); -VIRTUAL void Perl_package(pTHX_ OP* o); -VIRTUAL PADOFFSET Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype); -VIRTUAL PADOFFSET Perl_pad_allocmy(pTHX_ char* name); -VIRTUAL PADOFFSET Perl_pad_findmy(pTHX_ char* name); -VIRTUAL OP* Perl_oopsAV(pTHX_ OP* o); -VIRTUAL OP* Perl_oopsHV(pTHX_ OP* o); -VIRTUAL void Perl_pad_leavemy(pTHX_ I32 fill); -VIRTUAL SV* Perl_pad_sv(pTHX_ PADOFFSET po); -VIRTUAL void Perl_pad_free(pTHX_ PADOFFSET po); -VIRTUAL void Perl_pad_reset(pTHX); -VIRTUAL void Perl_pad_swipe(pTHX_ PADOFFSET po); -VIRTUAL void Perl_peep(pTHX_ OP* o); +PERL_CALLCONV short Perl_my_swap(pTHX_ short s); +PERL_CALLCONV long Perl_my_htonl(pTHX_ long l); +PERL_CALLCONV long Perl_my_ntohl(pTHX_ long l); +#endif +PERL_CALLCONV void Perl_my_unexec(pTHX); +PERL_CALLCONV OP* Perl_newANONLIST(pTHX_ OP* o); +PERL_CALLCONV OP* Perl_newANONHASH(pTHX_ OP* o); +PERL_CALLCONV OP* Perl_newANONSUB(pTHX_ I32 floor, OP* proto, OP* block); +PERL_CALLCONV OP* Perl_newASSIGNOP(pTHX_ I32 flags, OP* left, I32 optype, OP* right); +PERL_CALLCONV OP* Perl_newCONDOP(pTHX_ I32 flags, OP* expr, OP* trueop, OP* falseop); +PERL_CALLCONV void Perl_newCONSTSUB(pTHX_ HV* stash, char* name, SV* sv); +PERL_CALLCONV void Perl_newFORM(pTHX_ I32 floor, OP* o, OP* block); +PERL_CALLCONV OP* Perl_newFOROP(pTHX_ I32 flags, char* label, line_t forline, OP* sclr, OP* expr, OP*block, OP*cont); +PERL_CALLCONV OP* Perl_newLOGOP(pTHX_ I32 optype, I32 flags, OP* left, OP* right); +PERL_CALLCONV OP* Perl_newLOOPEX(pTHX_ I32 type, OP* label); +PERL_CALLCONV OP* Perl_newLOOPOP(pTHX_ I32 flags, I32 debuggable, OP* expr, OP* block); +PERL_CALLCONV OP* Perl_newNULLLIST(pTHX); +PERL_CALLCONV OP* Perl_newOP(pTHX_ I32 optype, I32 flags); +PERL_CALLCONV void Perl_newPROG(pTHX_ OP* o); +PERL_CALLCONV OP* Perl_newRANGE(pTHX_ I32 flags, OP* left, OP* right); +PERL_CALLCONV OP* Perl_newSLICEOP(pTHX_ I32 flags, OP* subscript, OP* listop); +PERL_CALLCONV OP* Perl_newSTATEOP(pTHX_ I32 flags, char* label, OP* o); +PERL_CALLCONV CV* Perl_newSUB(pTHX_ I32 floor, OP* o, OP* proto, OP* block); +PERL_CALLCONV CV* Perl_newXS(pTHX_ char* name, XSUBADDR_t f, char* filename); +PERL_CALLCONV AV* Perl_newAV(pTHX); +PERL_CALLCONV OP* Perl_newAVREF(pTHX_ OP* o); +PERL_CALLCONV OP* Perl_newBINOP(pTHX_ I32 type, I32 flags, OP* first, OP* last); +PERL_CALLCONV OP* Perl_newCVREF(pTHX_ I32 flags, OP* o); +PERL_CALLCONV OP* Perl_newGVOP(pTHX_ I32 type, I32 flags, GV* gv); +PERL_CALLCONV GV* Perl_newGVgen(pTHX_ char* pack); +PERL_CALLCONV OP* Perl_newGVREF(pTHX_ I32 type, OP* o); +PERL_CALLCONV OP* Perl_newHVREF(pTHX_ OP* o); +PERL_CALLCONV HV* Perl_newHV(pTHX); +PERL_CALLCONV HV* Perl_newHVhv(pTHX_ HV* hv); +PERL_CALLCONV IO* Perl_newIO(pTHX); +PERL_CALLCONV OP* Perl_newLISTOP(pTHX_ I32 type, I32 flags, OP* first, OP* last); +PERL_CALLCONV OP* Perl_newPADOP(pTHX_ I32 type, I32 flags, SV* sv); +PERL_CALLCONV OP* Perl_newPMOP(pTHX_ I32 type, I32 flags); +PERL_CALLCONV OP* Perl_newPVOP(pTHX_ I32 type, I32 flags, char* pv); +PERL_CALLCONV SV* Perl_newRV(pTHX_ SV* pref); +PERL_CALLCONV SV* Perl_newRV_noinc(pTHX_ SV *sv); +PERL_CALLCONV SV* Perl_newSV(pTHX_ STRLEN len); +PERL_CALLCONV OP* Perl_newSVREF(pTHX_ OP* o); +PERL_CALLCONV OP* Perl_newSVOP(pTHX_ I32 type, I32 flags, SV* sv); +PERL_CALLCONV SV* Perl_newSViv(pTHX_ IV i); +PERL_CALLCONV SV* Perl_newSVnv(pTHX_ NV n); +PERL_CALLCONV SV* Perl_newSVpv(pTHX_ const char* s, STRLEN len); +PERL_CALLCONV SV* Perl_newSVpvn(pTHX_ const char* s, STRLEN len); +PERL_CALLCONV SV* Perl_newSVpvf(pTHX_ const char* pat, ...); +PERL_CALLCONV SV* Perl_vnewSVpvf(pTHX_ const char* pat, va_list* args); +PERL_CALLCONV SV* Perl_newSVrv(pTHX_ SV* rv, const char* classname); +PERL_CALLCONV SV* Perl_newSVsv(pTHX_ SV* old); +PERL_CALLCONV OP* Perl_newUNOP(pTHX_ I32 type, I32 flags, OP* first); +PERL_CALLCONV OP* Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP* loop, I32 whileline, OP* expr, OP* block, OP* cont); + +PERL_CALLCONV PERL_SI* Perl_new_stackinfo(pTHX_ I32 stitems, I32 cxitems); +PERL_CALLCONV PerlIO* Perl_nextargv(pTHX_ GV* gv); +PERL_CALLCONV char* Perl_ninstr(pTHX_ const char* big, const char* bigend, const char* little, const char* lend); +PERL_CALLCONV OP* Perl_oopsCV(pTHX_ OP* o); +PERL_CALLCONV void Perl_op_free(pTHX_ OP* arg); +PERL_CALLCONV void Perl_package(pTHX_ OP* o); +PERL_CALLCONV PADOFFSET Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype); +PERL_CALLCONV PADOFFSET Perl_pad_allocmy(pTHX_ char* name); +PERL_CALLCONV PADOFFSET Perl_pad_findmy(pTHX_ char* name); +PERL_CALLCONV OP* Perl_oopsAV(pTHX_ OP* o); +PERL_CALLCONV OP* Perl_oopsHV(pTHX_ OP* o); +PERL_CALLCONV void Perl_pad_leavemy(pTHX_ I32 fill); +PERL_CALLCONV SV* Perl_pad_sv(pTHX_ PADOFFSET po); +PERL_CALLCONV void Perl_pad_free(pTHX_ PADOFFSET po); +PERL_CALLCONV void Perl_pad_reset(pTHX); +PERL_CALLCONV void Perl_pad_swipe(pTHX_ PADOFFSET po); +PERL_CALLCONV void Perl_peep(pTHX_ OP* o); #if defined(PERL_OBJECT) -VIRTUAL void perl_construct(void); -VIRTUAL void perl_destruct(void); -VIRTUAL void perl_free(void); -VIRTUAL int perl_run(void); -VIRTUAL int perl_parse(XSINIT_t xsinit, int argc, char** argv, char** env); -#else -VIRTUAL PerlInterpreter* perl_alloc(void); -VIRTUAL void perl_construct(PerlInterpreter* sv_interp); -VIRTUAL void perl_destruct(PerlInterpreter* sv_interp); -VIRTUAL void perl_free(PerlInterpreter* sv_interp); -VIRTUAL int perl_run(PerlInterpreter* sv_interp); -VIRTUAL int perl_parse(PerlInterpreter* sv_interp, XSINIT_t xsinit, int argc, char** argv, char** env); +PERL_CALLCONV void Perl_construct(pTHX); +PERL_CALLCONV void Perl_destruct(pTHX); +PERL_CALLCONV void Perl_free(pTHX); +PERL_CALLCONV int Perl_run(pTHX); +PERL_CALLCONV int Perl_parse(pTHX_ XSINIT_t xsinit, int argc, char** argv, char** env); +#endif #if defined(USE_THREADS) -VIRTUAL struct perl_thread* Perl_new_struct_thread(pTHX_ struct perl_thread *t); -#endif -#endif -VIRTUAL void Perl_call_atexit(pTHX_ ATEXIT_t fn, void *ptr); -VIRTUAL I32 Perl_call_argv(pTHX_ const char* sub_name, I32 flags, char** argv); -VIRTUAL I32 Perl_call_method(pTHX_ const char* methname, I32 flags); -VIRTUAL I32 Perl_call_pv(pTHX_ const char* sub_name, I32 flags); -VIRTUAL I32 Perl_call_sv(pTHX_ SV* sv, I32 flags); -VIRTUAL SV* Perl_eval_pv(pTHX_ const char* p, I32 croak_on_error); -VIRTUAL I32 Perl_eval_sv(pTHX_ SV* sv, I32 flags); -VIRTUAL SV* Perl_get_sv(pTHX_ const char* name, I32 create); -VIRTUAL AV* Perl_get_av(pTHX_ const char* name, I32 create); -VIRTUAL HV* Perl_get_hv(pTHX_ const char* name, I32 create); -VIRTUAL CV* Perl_get_cv(pTHX_ const char* name, I32 create); -VIRTUAL int Perl_init_i18nl10n(pTHX_ int printwarn); -VIRTUAL int Perl_init_i18nl14n(pTHX_ int printwarn); -VIRTUAL void Perl_new_collate(pTHX_ const char* newcoll); -VIRTUAL void Perl_new_ctype(pTHX_ const char* newctype); -VIRTUAL void Perl_new_numeric(pTHX_ const char* newcoll); -VIRTUAL void Perl_set_numeric_local(pTHX); -VIRTUAL void Perl_set_numeric_radix(pTHX); -VIRTUAL void Perl_set_numeric_standard(pTHX); -VIRTUAL void Perl_require_pv(pTHX_ const char* pv); -VIRTUAL void Perl_pidgone(pTHX_ Pid_t pid, int status); -VIRTUAL void Perl_pmflag(pTHX_ U16* pmfl, int ch); -VIRTUAL OP* Perl_pmruntime(pTHX_ OP* pm, OP* expr, OP* repl); -VIRTUAL OP* Perl_pmtrans(pTHX_ OP* o, OP* expr, OP* repl); -VIRTUAL OP* Perl_pop_return(pTHX); -VIRTUAL void Perl_pop_scope(pTHX); -VIRTUAL OP* Perl_prepend_elem(pTHX_ I32 optype, OP* head, OP* tail); -VIRTUAL void Perl_push_return(pTHX_ OP* o); -VIRTUAL void Perl_push_scope(pTHX); -VIRTUAL OP* Perl_ref(pTHX_ OP* o, I32 type); -VIRTUAL OP* Perl_refkids(pTHX_ OP* o, I32 type); -VIRTUAL void Perl_regdump(pTHX_ regexp* r); -VIRTUAL I32 Perl_pregexec(pTHX_ regexp* prog, char* stringarg, char* strend, char* strbeg, I32 minend, SV* screamer, U32 nosave); -VIRTUAL void Perl_pregfree(pTHX_ struct regexp* r); -VIRTUAL regexp* Perl_pregcomp(pTHX_ char* exp, char* xend, PMOP* pm); -VIRTUAL char* Perl_re_intuit_start(pTHX_ regexp* prog, SV* sv, char* strpos, char* strend, U32 flags, struct re_scream_pos_data_s *data); -VIRTUAL SV* Perl_re_intuit_string(pTHX_ regexp* prog); -VIRTUAL I32 Perl_regexec_flags(pTHX_ regexp* prog, char* stringarg, char* strend, char* strbeg, I32 minend, SV* screamer, void* data, U32 flags); -VIRTUAL regnode* Perl_regnext(pTHX_ regnode* p); -VIRTUAL void Perl_regprop(pTHX_ SV* sv, regnode* o); -VIRTUAL void Perl_repeatcpy(pTHX_ char* to, const char* from, I32 len, I32 count); -VIRTUAL char* Perl_rninstr(pTHX_ const char* big, const char* bigend, const char* little, const char* lend); -VIRTUAL Sighandler_t Perl_rsignal(pTHX_ int i, Sighandler_t t); -VIRTUAL int Perl_rsignal_restore(pTHX_ int i, Sigsave_t* t); -VIRTUAL int Perl_rsignal_save(pTHX_ int i, Sighandler_t t1, Sigsave_t* t2); -VIRTUAL Sighandler_t Perl_rsignal_state(pTHX_ int i); -VIRTUAL void Perl_rxres_free(pTHX_ void** rsp); -VIRTUAL void Perl_rxres_restore(pTHX_ void** rsp, REGEXP* prx); -VIRTUAL void Perl_rxres_save(pTHX_ void** rsp, REGEXP* prx); +PERL_CALLCONV struct perl_thread* Perl_new_struct_thread(pTHX_ struct perl_thread *t); +#endif +PERL_CALLCONV void Perl_call_atexit(pTHX_ ATEXIT_t fn, void *ptr); +PERL_CALLCONV I32 Perl_call_argv(pTHX_ const char* sub_name, I32 flags, char** argv); +PERL_CALLCONV I32 Perl_call_method(pTHX_ const char* methname, I32 flags); +PERL_CALLCONV I32 Perl_call_pv(pTHX_ const char* sub_name, I32 flags); +PERL_CALLCONV I32 Perl_call_sv(pTHX_ SV* sv, I32 flags); +PERL_CALLCONV SV* Perl_eval_pv(pTHX_ const char* p, I32 croak_on_error); +PERL_CALLCONV I32 Perl_eval_sv(pTHX_ SV* sv, I32 flags); +PERL_CALLCONV SV* Perl_get_sv(pTHX_ const char* name, I32 create); +PERL_CALLCONV AV* Perl_get_av(pTHX_ const char* name, I32 create); +PERL_CALLCONV HV* Perl_get_hv(pTHX_ const char* name, I32 create); +PERL_CALLCONV CV* Perl_get_cv(pTHX_ const char* name, I32 create); +PERL_CALLCONV int Perl_init_i18nl10n(pTHX_ int printwarn); +PERL_CALLCONV int Perl_init_i18nl14n(pTHX_ int printwarn); +PERL_CALLCONV void Perl_new_collate(pTHX_ const char* newcoll); +PERL_CALLCONV void Perl_new_ctype(pTHX_ const char* newctype); +PERL_CALLCONV void Perl_new_numeric(pTHX_ const char* newcoll); +PERL_CALLCONV void Perl_set_numeric_local(pTHX); +PERL_CALLCONV void Perl_set_numeric_radix(pTHX); +PERL_CALLCONV void Perl_set_numeric_standard(pTHX); +PERL_CALLCONV void Perl_require_pv(pTHX_ const char* pv); +PERL_CALLCONV void Perl_pidgone(pTHX_ Pid_t pid, int status); +PERL_CALLCONV void Perl_pmflag(pTHX_ U16* pmfl, int ch); +PERL_CALLCONV OP* Perl_pmruntime(pTHX_ OP* pm, OP* expr, OP* repl); +PERL_CALLCONV OP* Perl_pmtrans(pTHX_ OP* o, OP* expr, OP* repl); +PERL_CALLCONV OP* Perl_pop_return(pTHX); +PERL_CALLCONV void Perl_pop_scope(pTHX); +PERL_CALLCONV OP* Perl_prepend_elem(pTHX_ I32 optype, OP* head, OP* tail); +PERL_CALLCONV void Perl_push_return(pTHX_ OP* o); +PERL_CALLCONV void Perl_push_scope(pTHX); +PERL_CALLCONV OP* Perl_ref(pTHX_ OP* o, I32 type); +PERL_CALLCONV OP* Perl_refkids(pTHX_ OP* o, I32 type); +PERL_CALLCONV void Perl_regdump(pTHX_ regexp* r); +PERL_CALLCONV I32 Perl_pregexec(pTHX_ regexp* prog, char* stringarg, char* strend, char* strbeg, I32 minend, SV* screamer, U32 nosave); +PERL_CALLCONV void Perl_pregfree(pTHX_ struct regexp* r); +PERL_CALLCONV regexp* Perl_pregcomp(pTHX_ char* exp, char* xend, PMOP* pm); +PERL_CALLCONV char* Perl_re_intuit_start(pTHX_ regexp* prog, SV* sv, char* strpos, char* strend, U32 flags, struct re_scream_pos_data_s *data); +PERL_CALLCONV SV* Perl_re_intuit_string(pTHX_ regexp* prog); +PERL_CALLCONV I32 Perl_regexec_flags(pTHX_ regexp* prog, char* stringarg, char* strend, char* strbeg, I32 minend, SV* screamer, void* data, U32 flags); +PERL_CALLCONV regnode* Perl_regnext(pTHX_ regnode* p); +PERL_CALLCONV void Perl_regprop(pTHX_ SV* sv, regnode* o); +PERL_CALLCONV void Perl_repeatcpy(pTHX_ char* to, const char* from, I32 len, I32 count); +PERL_CALLCONV char* Perl_rninstr(pTHX_ const char* big, const char* bigend, const char* little, const char* lend); +PERL_CALLCONV Sighandler_t Perl_rsignal(pTHX_ int i, Sighandler_t t); +PERL_CALLCONV int Perl_rsignal_restore(pTHX_ int i, Sigsave_t* t); +PERL_CALLCONV int Perl_rsignal_save(pTHX_ int i, Sighandler_t t1, Sigsave_t* t2); +PERL_CALLCONV Sighandler_t Perl_rsignal_state(pTHX_ int i); +PERL_CALLCONV void Perl_rxres_free(pTHX_ void** rsp); +PERL_CALLCONV void Perl_rxres_restore(pTHX_ void** rsp, REGEXP* prx); +PERL_CALLCONV void Perl_rxres_save(pTHX_ void** rsp, REGEXP* prx); #if !defined(HAS_RENAME) -VIRTUAL I32 Perl_same_dirent(pTHX_ char* a, char* b); -#endif -VIRTUAL char* Perl_savepv(pTHX_ const char* sv); -VIRTUAL char* Perl_savepvn(pTHX_ const char* sv, I32 len); -VIRTUAL void Perl_savestack_grow(pTHX); -VIRTUAL void Perl_save_aelem(pTHX_ AV* av, I32 idx, SV **sptr); -VIRTUAL I32 Perl_save_alloc(pTHX_ I32 size, I32 pad); -VIRTUAL void Perl_save_aptr(pTHX_ AV** aptr); -VIRTUAL AV* Perl_save_ary(pTHX_ GV* gv); -VIRTUAL void Perl_save_clearsv(pTHX_ SV** svp); -VIRTUAL void Perl_save_delete(pTHX_ HV* hv, char* key, I32 klen); -VIRTUAL void Perl_save_destructor(pTHX_ DESTRUCTORFUNC_t f, void* p); -VIRTUAL void Perl_save_freesv(pTHX_ SV* sv); -VIRTUAL void Perl_save_freeop(pTHX_ OP* o); -VIRTUAL void Perl_save_freepv(pTHX_ char* pv); -VIRTUAL void Perl_save_generic_svref(pTHX_ SV** sptr); -VIRTUAL void Perl_save_gp(pTHX_ GV* gv, I32 empty); -VIRTUAL HV* Perl_save_hash(pTHX_ GV* gv); -VIRTUAL void Perl_save_helem(pTHX_ HV* hv, SV *key, SV **sptr); -VIRTUAL void Perl_save_hints(pTHX); -VIRTUAL void Perl_save_hptr(pTHX_ HV** hptr); -VIRTUAL void Perl_save_I16(pTHX_ I16* intp); -VIRTUAL void Perl_save_I32(pTHX_ I32* intp); -VIRTUAL void Perl_save_int(pTHX_ int* intp); -VIRTUAL void Perl_save_item(pTHX_ SV* item); -VIRTUAL void Perl_save_iv(pTHX_ IV* iv); -VIRTUAL void Perl_save_list(pTHX_ SV** sarg, I32 maxsarg); -VIRTUAL void Perl_save_long(pTHX_ long* longp); -VIRTUAL void Perl_save_nogv(pTHX_ GV* gv); -VIRTUAL void Perl_save_op(pTHX); -VIRTUAL SV* Perl_save_scalar(pTHX_ GV* gv); -VIRTUAL void Perl_save_pptr(pTHX_ char** pptr); -VIRTUAL void Perl_save_re_context(pTHX); -VIRTUAL void Perl_save_sptr(pTHX_ SV** sptr); -VIRTUAL SV* Perl_save_svref(pTHX_ SV** sptr); -VIRTUAL SV** Perl_save_threadsv(pTHX_ PADOFFSET i); -VIRTUAL OP* Perl_sawparens(pTHX_ OP* o); -VIRTUAL OP* Perl_scalar(pTHX_ OP* o); -VIRTUAL OP* Perl_scalarkids(pTHX_ OP* o); -VIRTUAL OP* Perl_scalarseq(pTHX_ OP* o); -VIRTUAL OP* Perl_scalarvoid(pTHX_ OP* o); -VIRTUAL NV Perl_scan_bin(pTHX_ char* start, I32 len, I32* retlen); -VIRTUAL NV Perl_scan_hex(pTHX_ char* start, I32 len, I32* retlen); -VIRTUAL char* Perl_scan_num(pTHX_ char* s); -VIRTUAL NV Perl_scan_oct(pTHX_ char* start, I32 len, I32* retlen); -VIRTUAL OP* Perl_scope(pTHX_ OP* o); -VIRTUAL char* Perl_screaminstr(pTHX_ SV* bigsv, SV* littlesv, I32 start_shift, I32 end_shift, I32 *state, I32 last); +PERL_CALLCONV I32 Perl_same_dirent(pTHX_ char* a, char* b); +#endif +PERL_CALLCONV char* Perl_savepv(pTHX_ const char* sv); +PERL_CALLCONV char* Perl_savepvn(pTHX_ const char* sv, I32 len); +PERL_CALLCONV void Perl_savestack_grow(pTHX); +PERL_CALLCONV void Perl_save_aelem(pTHX_ AV* av, I32 idx, SV **sptr); +PERL_CALLCONV I32 Perl_save_alloc(pTHX_ I32 size, I32 pad); +PERL_CALLCONV void Perl_save_aptr(pTHX_ AV** aptr); +PERL_CALLCONV AV* Perl_save_ary(pTHX_ GV* gv); +PERL_CALLCONV void Perl_save_clearsv(pTHX_ SV** svp); +PERL_CALLCONV void Perl_save_delete(pTHX_ HV* hv, char* key, I32 klen); +PERL_CALLCONV void Perl_save_destructor(pTHX_ DESTRUCTORFUNC_NOCONTEXT_t f, void* p); +PERL_CALLCONV void Perl_save_destructor_x(pTHX_ DESTRUCTORFUNC_t f, void* p); +PERL_CALLCONV void Perl_save_freesv(pTHX_ SV* sv); +PERL_CALLCONV void Perl_save_freeop(pTHX_ OP* o); +PERL_CALLCONV void Perl_save_freepv(pTHX_ char* pv); +PERL_CALLCONV void Perl_save_generic_svref(pTHX_ SV** sptr); +PERL_CALLCONV void Perl_save_gp(pTHX_ GV* gv, I32 empty); +PERL_CALLCONV HV* Perl_save_hash(pTHX_ GV* gv); +PERL_CALLCONV void Perl_save_helem(pTHX_ HV* hv, SV *key, SV **sptr); +PERL_CALLCONV void Perl_save_hints(pTHX); +PERL_CALLCONV void Perl_save_hptr(pTHX_ HV** hptr); +PERL_CALLCONV void Perl_save_I16(pTHX_ I16* intp); +PERL_CALLCONV void Perl_save_I32(pTHX_ I32* intp); +PERL_CALLCONV void Perl_save_I8(pTHX_ I8* bytep); +PERL_CALLCONV void Perl_save_int(pTHX_ int* intp); +PERL_CALLCONV void Perl_save_item(pTHX_ SV* item); +PERL_CALLCONV void Perl_save_iv(pTHX_ IV* iv); +PERL_CALLCONV void Perl_save_list(pTHX_ SV** sarg, I32 maxsarg); +PERL_CALLCONV void Perl_save_long(pTHX_ long* longp); +PERL_CALLCONV void Perl_save_nogv(pTHX_ GV* gv); +PERL_CALLCONV void Perl_save_op(pTHX); +PERL_CALLCONV SV* Perl_save_scalar(pTHX_ GV* gv); +PERL_CALLCONV void Perl_save_pptr(pTHX_ char** pptr); +PERL_CALLCONV void Perl_save_vptr(pTHX_ void* pptr); +PERL_CALLCONV void Perl_save_re_context(pTHX); +PERL_CALLCONV void Perl_save_sptr(pTHX_ SV** sptr); +PERL_CALLCONV SV* Perl_save_svref(pTHX_ SV** sptr); +PERL_CALLCONV SV** Perl_save_threadsv(pTHX_ PADOFFSET i); +PERL_CALLCONV OP* Perl_sawparens(pTHX_ OP* o); +PERL_CALLCONV OP* Perl_scalar(pTHX_ OP* o); +PERL_CALLCONV OP* Perl_scalarkids(pTHX_ OP* o); +PERL_CALLCONV OP* Perl_scalarseq(pTHX_ OP* o); +PERL_CALLCONV OP* Perl_scalarvoid(pTHX_ OP* o); +PERL_CALLCONV NV Perl_scan_bin(pTHX_ char* start, I32 len, I32* retlen); +PERL_CALLCONV NV Perl_scan_hex(pTHX_ char* start, I32 len, I32* retlen); +PERL_CALLCONV char* Perl_scan_num(pTHX_ char* s); +PERL_CALLCONV NV Perl_scan_oct(pTHX_ char* start, I32 len, I32* retlen); +PERL_CALLCONV OP* Perl_scope(pTHX_ OP* o); +PERL_CALLCONV char* Perl_screaminstr(pTHX_ SV* bigsv, SV* littlesv, I32 start_shift, I32 end_shift, I32 *state, I32 last); #if !defined(VMS) -VIRTUAL I32 Perl_setenv_getix(pTHX_ char* nam); -#endif -VIRTUAL void Perl_setdefout(pTHX_ GV* gv); -VIRTUAL char* Perl_sharepvn(pTHX_ const char* sv, I32 len, U32 hash); -VIRTUAL HEK* Perl_share_hek(pTHX_ const char* sv, I32 len, U32 hash); -VIRTUAL Signal_t Perl_sighandler(int sig); -VIRTUAL SV** Perl_stack_grow(pTHX_ SV** sp, SV**p, int n); -VIRTUAL I32 Perl_start_subparse(pTHX_ I32 is_format, U32 flags); -VIRTUAL void Perl_sub_crush_depth(pTHX_ CV* cv); -VIRTUAL bool Perl_sv_2bool(pTHX_ SV* sv); -VIRTUAL CV* Perl_sv_2cv(pTHX_ SV* sv, HV** st, GV** gvp, I32 lref); -VIRTUAL IO* Perl_sv_2io(pTHX_ SV* sv); -VIRTUAL IV Perl_sv_2iv(pTHX_ SV* sv); -VIRTUAL SV* Perl_sv_2mortal(pTHX_ SV* sv); -VIRTUAL NV Perl_sv_2nv(pTHX_ SV* sv); -VIRTUAL char* Perl_sv_2pv(pTHX_ SV* sv, STRLEN* lp); -VIRTUAL UV Perl_sv_2uv(pTHX_ SV* sv); -VIRTUAL IV Perl_sv_iv(pTHX_ SV* sv); -VIRTUAL UV Perl_sv_uv(pTHX_ SV* sv); -VIRTUAL NV Perl_sv_nv(pTHX_ SV* sv); -VIRTUAL char* Perl_sv_pvn(pTHX_ SV *sv, STRLEN *len); -VIRTUAL I32 Perl_sv_true(pTHX_ SV *sv); -VIRTUAL void Perl_sv_add_arena(pTHX_ char* ptr, U32 size, U32 flags); -VIRTUAL int Perl_sv_backoff(pTHX_ SV* sv); -VIRTUAL SV* Perl_sv_bless(pTHX_ SV* sv, HV* stash); -VIRTUAL void Perl_sv_catpvf(pTHX_ SV* sv, const char* pat, ...); -VIRTUAL void Perl_sv_vcatpvf(pTHX_ SV* sv, const char* pat, va_list* args); -VIRTUAL void Perl_sv_catpv(pTHX_ SV* sv, const char* ptr); -VIRTUAL void Perl_sv_catpvn(pTHX_ SV* sv, const char* ptr, STRLEN len); -VIRTUAL void Perl_sv_catsv(pTHX_ SV* dsv, SV* ssv); -VIRTUAL void Perl_sv_chop(pTHX_ SV* sv, char* ptr); -VIRTUAL void Perl_sv_clean_all(pTHX); -VIRTUAL void Perl_sv_clean_objs(pTHX); -VIRTUAL void Perl_sv_clear(pTHX_ SV* sv); -VIRTUAL I32 Perl_sv_cmp(pTHX_ SV* sv1, SV* sv2); -VIRTUAL I32 Perl_sv_cmp_locale(pTHX_ SV* sv1, SV* sv2); +PERL_CALLCONV I32 Perl_setenv_getix(pTHX_ char* nam); +#endif +PERL_CALLCONV void Perl_setdefout(pTHX_ GV* gv); +PERL_CALLCONV char* Perl_sharepvn(pTHX_ const char* sv, I32 len, U32 hash); +PERL_CALLCONV HEK* Perl_share_hek(pTHX_ const char* sv, I32 len, U32 hash); +PERL_CALLCONV Signal_t Perl_sighandler(int sig); +PERL_CALLCONV SV** Perl_stack_grow(pTHX_ SV** sp, SV**p, int n); +PERL_CALLCONV I32 Perl_start_subparse(pTHX_ I32 is_format, U32 flags); +PERL_CALLCONV void Perl_sub_crush_depth(pTHX_ CV* cv); +PERL_CALLCONV bool Perl_sv_2bool(pTHX_ SV* sv); +PERL_CALLCONV CV* Perl_sv_2cv(pTHX_ SV* sv, HV** st, GV** gvp, I32 lref); +PERL_CALLCONV IO* Perl_sv_2io(pTHX_ SV* sv); +PERL_CALLCONV IV Perl_sv_2iv(pTHX_ SV* sv); +PERL_CALLCONV SV* Perl_sv_2mortal(pTHX_ SV* sv); +PERL_CALLCONV NV Perl_sv_2nv(pTHX_ SV* sv); +PERL_CALLCONV char* Perl_sv_2pv(pTHX_ SV* sv, STRLEN* lp); +PERL_CALLCONV char* Perl_sv_2pvutf8(pTHX_ SV* sv, STRLEN* lp); +PERL_CALLCONV char* Perl_sv_2pvbyte(pTHX_ SV* sv, STRLEN* lp); +PERL_CALLCONV UV Perl_sv_2uv(pTHX_ SV* sv); +PERL_CALLCONV IV Perl_sv_iv(pTHX_ SV* sv); +PERL_CALLCONV UV Perl_sv_uv(pTHX_ SV* sv); +PERL_CALLCONV NV Perl_sv_nv(pTHX_ SV* sv); +PERL_CALLCONV char* Perl_sv_pvn(pTHX_ SV *sv, STRLEN *len); +PERL_CALLCONV char* Perl_sv_pvutf8n(pTHX_ SV *sv, STRLEN *len); +PERL_CALLCONV char* Perl_sv_pvbyten(pTHX_ SV *sv, STRLEN *len); +PERL_CALLCONV I32 Perl_sv_true(pTHX_ SV *sv); +PERL_CALLCONV void Perl_sv_add_arena(pTHX_ char* ptr, U32 size, U32 flags); +PERL_CALLCONV int Perl_sv_backoff(pTHX_ SV* sv); +PERL_CALLCONV SV* Perl_sv_bless(pTHX_ SV* sv, HV* stash); +PERL_CALLCONV void Perl_sv_catpvf(pTHX_ SV* sv, const char* pat, ...); +PERL_CALLCONV void Perl_sv_vcatpvf(pTHX_ SV* sv, const char* pat, va_list* args); +PERL_CALLCONV void Perl_sv_catpv(pTHX_ SV* sv, const char* ptr); +PERL_CALLCONV void Perl_sv_catpvn(pTHX_ SV* sv, const char* ptr, STRLEN len); +PERL_CALLCONV void Perl_sv_catsv(pTHX_ SV* dsv, SV* ssv); +PERL_CALLCONV void Perl_sv_chop(pTHX_ SV* sv, char* ptr); +PERL_CALLCONV void Perl_sv_clean_all(pTHX); +PERL_CALLCONV void Perl_sv_clean_objs(pTHX); +PERL_CALLCONV void Perl_sv_clear(pTHX_ SV* sv); +PERL_CALLCONV I32 Perl_sv_cmp(pTHX_ SV* sv1, SV* sv2); +PERL_CALLCONV I32 Perl_sv_cmp_locale(pTHX_ SV* sv1, SV* sv2); #if defined(USE_LOCALE_COLLATE) -VIRTUAL char* Perl_sv_collxfrm(pTHX_ SV* sv, STRLEN* nxp); -#endif -VIRTUAL OP* Perl_sv_compile_2op(pTHX_ SV* sv, OP** startp, char* code, AV** avp); -VIRTUAL void Perl_sv_dec(pTHX_ SV* sv); -VIRTUAL void Perl_sv_dump(pTHX_ SV* sv); -VIRTUAL bool Perl_sv_derived_from(pTHX_ SV* sv, const char* name); -VIRTUAL I32 Perl_sv_eq(pTHX_ SV* sv1, SV* sv2); -VIRTUAL void Perl_sv_free(pTHX_ SV* sv); -VIRTUAL void Perl_sv_free_arenas(pTHX); -VIRTUAL char* Perl_sv_gets(pTHX_ SV* sv, PerlIO* fp, I32 append); -VIRTUAL char* Perl_sv_grow(pTHX_ SV* sv, STRLEN newlen); -VIRTUAL void Perl_sv_inc(pTHX_ SV* sv); -VIRTUAL void Perl_sv_insert(pTHX_ SV* bigsv, STRLEN offset, STRLEN len, char* little, STRLEN littlelen); -VIRTUAL int Perl_sv_isa(pTHX_ SV* sv, const char* name); -VIRTUAL int Perl_sv_isobject(pTHX_ SV* sv); -VIRTUAL STRLEN Perl_sv_len(pTHX_ SV* sv); -VIRTUAL STRLEN Perl_sv_len_utf8(pTHX_ SV* sv); -VIRTUAL void Perl_sv_magic(pTHX_ SV* sv, SV* obj, int how, const char* name, I32 namlen); -VIRTUAL SV* Perl_sv_mortalcopy(pTHX_ SV* oldsv); -VIRTUAL SV* Perl_sv_newmortal(pTHX); -VIRTUAL SV* Perl_sv_newref(pTHX_ SV* sv); -VIRTUAL char* Perl_sv_peek(pTHX_ SV* sv); -VIRTUAL void Perl_sv_pos_u2b(pTHX_ SV* sv, I32* offsetp, I32* lenp); -VIRTUAL void Perl_sv_pos_b2u(pTHX_ SV* sv, I32* offsetp); -VIRTUAL char* Perl_sv_pvn_force(pTHX_ SV* sv, STRLEN* lp); -VIRTUAL char* Perl_sv_reftype(pTHX_ SV* sv, int ob); -VIRTUAL void Perl_sv_replace(pTHX_ SV* sv, SV* nsv); -VIRTUAL void Perl_sv_report_used(pTHX); -VIRTUAL void Perl_sv_reset(pTHX_ char* s, HV* stash); -VIRTUAL void Perl_sv_setpvf(pTHX_ SV* sv, const char* pat, ...); -VIRTUAL void Perl_sv_vsetpvf(pTHX_ SV* sv, const char* pat, va_list* args); -VIRTUAL void Perl_sv_setiv(pTHX_ SV* sv, IV num); -VIRTUAL void Perl_sv_setpviv(pTHX_ SV* sv, IV num); -VIRTUAL void Perl_sv_setuv(pTHX_ SV* sv, UV num); -VIRTUAL void Perl_sv_setnv(pTHX_ SV* sv, NV num); -VIRTUAL SV* Perl_sv_setref_iv(pTHX_ SV* rv, const char* classname, IV iv); -VIRTUAL SV* Perl_sv_setref_nv(pTHX_ SV* rv, const char* classname, NV nv); -VIRTUAL SV* Perl_sv_setref_pv(pTHX_ SV* rv, const char* classname, void* pv); -VIRTUAL SV* Perl_sv_setref_pvn(pTHX_ SV* rv, const char* classname, char* pv, STRLEN n); -VIRTUAL void Perl_sv_setpv(pTHX_ SV* sv, const char* ptr); -VIRTUAL void Perl_sv_setpvn(pTHX_ SV* sv, const char* ptr, STRLEN len); -VIRTUAL void Perl_sv_setsv(pTHX_ SV* dsv, SV* ssv); -VIRTUAL void Perl_sv_taint(pTHX_ SV* sv); -VIRTUAL bool Perl_sv_tainted(pTHX_ SV* sv); -VIRTUAL int Perl_sv_unmagic(pTHX_ SV* sv, int type); -VIRTUAL void Perl_sv_unref(pTHX_ SV* sv); -VIRTUAL void Perl_sv_untaint(pTHX_ SV* sv); -VIRTUAL bool Perl_sv_upgrade(pTHX_ SV* sv, U32 mt); -VIRTUAL void Perl_sv_usepvn(pTHX_ SV* sv, char* ptr, STRLEN len); -VIRTUAL void Perl_sv_vcatpvfn(pTHX_ SV* sv, const char* pat, STRLEN patlen, va_list* args, SV** svargs, I32 svmax, bool *maybe_tainted); -VIRTUAL void Perl_sv_vsetpvfn(pTHX_ SV* sv, const char* pat, STRLEN patlen, va_list* args, SV** svargs, I32 svmax, bool *maybe_tainted); -VIRTUAL SV* Perl_swash_init(pTHX_ char* pkg, char* name, SV* listsv, I32 minbits, I32 none); -VIRTUAL UV Perl_swash_fetch(pTHX_ SV *sv, U8 *ptr); -VIRTUAL void Perl_taint_env(pTHX); -VIRTUAL void Perl_taint_proper(pTHX_ const char* f, char* s); -VIRTUAL UV Perl_to_utf8_lower(pTHX_ U8 *p); -VIRTUAL UV Perl_to_utf8_upper(pTHX_ U8 *p); -VIRTUAL UV Perl_to_utf8_title(pTHX_ U8 *p); +PERL_CALLCONV char* Perl_sv_collxfrm(pTHX_ SV* sv, STRLEN* nxp); +#endif +PERL_CALLCONV OP* Perl_sv_compile_2op(pTHX_ SV* sv, OP** startp, char* code, AV** avp); +PERL_CALLCONV void Perl_sv_dec(pTHX_ SV* sv); +PERL_CALLCONV void Perl_sv_dump(pTHX_ SV* sv); +PERL_CALLCONV bool Perl_sv_derived_from(pTHX_ SV* sv, const char* name); +PERL_CALLCONV I32 Perl_sv_eq(pTHX_ SV* sv1, SV* sv2); +PERL_CALLCONV void Perl_sv_free(pTHX_ SV* sv); +PERL_CALLCONV void Perl_sv_free_arenas(pTHX); +PERL_CALLCONV char* Perl_sv_gets(pTHX_ SV* sv, PerlIO* fp, I32 append); +PERL_CALLCONV char* Perl_sv_grow(pTHX_ SV* sv, STRLEN newlen); +PERL_CALLCONV void Perl_sv_inc(pTHX_ SV* sv); +PERL_CALLCONV void Perl_sv_insert(pTHX_ SV* bigsv, STRLEN offset, STRLEN len, char* little, STRLEN littlelen); +PERL_CALLCONV int Perl_sv_isa(pTHX_ SV* sv, const char* name); +PERL_CALLCONV int Perl_sv_isobject(pTHX_ SV* sv); +PERL_CALLCONV STRLEN Perl_sv_len(pTHX_ SV* sv); +PERL_CALLCONV STRLEN Perl_sv_len_utf8(pTHX_ SV* sv); +PERL_CALLCONV void Perl_sv_magic(pTHX_ SV* sv, SV* obj, int how, const char* name, I32 namlen); +PERL_CALLCONV SV* Perl_sv_mortalcopy(pTHX_ SV* oldsv); +PERL_CALLCONV SV* Perl_sv_newmortal(pTHX); +PERL_CALLCONV SV* Perl_sv_newref(pTHX_ SV* sv); +PERL_CALLCONV char* Perl_sv_peek(pTHX_ SV* sv); +PERL_CALLCONV void Perl_sv_pos_u2b(pTHX_ SV* sv, I32* offsetp, I32* lenp); +PERL_CALLCONV void Perl_sv_pos_b2u(pTHX_ SV* sv, I32* offsetp); +PERL_CALLCONV char* Perl_sv_pvn_force(pTHX_ SV* sv, STRLEN* lp); +PERL_CALLCONV char* Perl_sv_pvutf8n_force(pTHX_ SV* sv, STRLEN* lp); +PERL_CALLCONV char* Perl_sv_pvbyten_force(pTHX_ SV* sv, STRLEN* lp); +PERL_CALLCONV char* Perl_sv_reftype(pTHX_ SV* sv, int ob); +PERL_CALLCONV void Perl_sv_replace(pTHX_ SV* sv, SV* nsv); +PERL_CALLCONV void Perl_sv_report_used(pTHX); +PERL_CALLCONV void Perl_sv_reset(pTHX_ char* s, HV* stash); +PERL_CALLCONV void Perl_sv_setpvf(pTHX_ SV* sv, const char* pat, ...); +PERL_CALLCONV void Perl_sv_vsetpvf(pTHX_ SV* sv, const char* pat, va_list* args); +PERL_CALLCONV void Perl_sv_setiv(pTHX_ SV* sv, IV num); +PERL_CALLCONV void Perl_sv_setpviv(pTHX_ SV* sv, IV num); +PERL_CALLCONV void Perl_sv_setuv(pTHX_ SV* sv, UV num); +PERL_CALLCONV void Perl_sv_setnv(pTHX_ SV* sv, NV num); +PERL_CALLCONV SV* Perl_sv_setref_iv(pTHX_ SV* rv, const char* classname, IV iv); +PERL_CALLCONV SV* Perl_sv_setref_nv(pTHX_ SV* rv, const char* classname, NV nv); +PERL_CALLCONV SV* Perl_sv_setref_pv(pTHX_ SV* rv, const char* classname, void* pv); +PERL_CALLCONV SV* Perl_sv_setref_pvn(pTHX_ SV* rv, const char* classname, char* pv, STRLEN n); +PERL_CALLCONV void Perl_sv_setpv(pTHX_ SV* sv, const char* ptr); +PERL_CALLCONV void Perl_sv_setpvn(pTHX_ SV* sv, const char* ptr, STRLEN len); +PERL_CALLCONV void Perl_sv_setsv(pTHX_ SV* dsv, SV* ssv); +PERL_CALLCONV void Perl_sv_taint(pTHX_ SV* sv); +PERL_CALLCONV bool Perl_sv_tainted(pTHX_ SV* sv); +PERL_CALLCONV int Perl_sv_unmagic(pTHX_ SV* sv, int type); +PERL_CALLCONV void Perl_sv_unref(pTHX_ SV* sv); +PERL_CALLCONV void Perl_sv_untaint(pTHX_ SV* sv); +PERL_CALLCONV bool Perl_sv_upgrade(pTHX_ SV* sv, U32 mt); +PERL_CALLCONV void Perl_sv_usepvn(pTHX_ SV* sv, char* ptr, STRLEN len); +PERL_CALLCONV void Perl_sv_vcatpvfn(pTHX_ SV* sv, const char* pat, STRLEN patlen, va_list* args, SV** svargs, I32 svmax, bool *maybe_tainted); +PERL_CALLCONV void Perl_sv_vsetpvfn(pTHX_ SV* sv, const char* pat, STRLEN patlen, va_list* args, SV** svargs, I32 svmax, bool *maybe_tainted); +PERL_CALLCONV SV* Perl_swash_init(pTHX_ char* pkg, char* name, SV* listsv, I32 minbits, I32 none); +PERL_CALLCONV UV Perl_swash_fetch(pTHX_ SV *sv, U8 *ptr); +PERL_CALLCONV void Perl_taint_env(pTHX); +PERL_CALLCONV void Perl_taint_proper(pTHX_ const char* f, const char* s); +PERL_CALLCONV UV Perl_to_utf8_lower(pTHX_ U8 *p); +PERL_CALLCONV UV Perl_to_utf8_upper(pTHX_ U8 *p); +PERL_CALLCONV UV Perl_to_utf8_title(pTHX_ U8 *p); #if defined(UNLINK_ALL_VERSIONS) -VIRTUAL I32 Perl_unlnk(pTHX_ char* f); +PERL_CALLCONV I32 Perl_unlnk(pTHX_ char* f); #endif #if defined(USE_THREADS) -VIRTUAL void Perl_unlock_condpair(pTHX_ void* svv); -#endif -VIRTUAL void Perl_unsharepvn(pTHX_ const char* sv, I32 len, U32 hash); -VIRTUAL void Perl_unshare_hek(pTHX_ HEK* hek); -VIRTUAL void Perl_utilize(pTHX_ int aver, I32 floor, OP* version, OP* id, OP* arg); -VIRTUAL U8* Perl_utf16_to_utf8(pTHX_ U16* p, U8 *d, I32 bytelen); -VIRTUAL U8* Perl_utf16_to_utf8_reversed(pTHX_ U16* p, U8 *d, I32 bytelen); -VIRTUAL I32 Perl_utf8_distance(pTHX_ U8 *a, U8 *b); -VIRTUAL U8* Perl_utf8_hop(pTHX_ U8 *s, I32 off); -VIRTUAL UV Perl_utf8_to_uv(pTHX_ U8 *s, I32* retlen); -VIRTUAL U8* Perl_uv_to_utf8(pTHX_ U8 *d, UV uv); -VIRTUAL void Perl_vivify_defelem(pTHX_ SV* sv); -VIRTUAL void Perl_vivify_ref(pTHX_ SV* sv, U32 to_what); -VIRTUAL I32 Perl_wait4pid(pTHX_ Pid_t pid, int* statusp, int flags); -VIRTUAL void Perl_warn(pTHX_ const char* pat, ...); -VIRTUAL void Perl_vwarn(pTHX_ const char* pat, va_list* args); -VIRTUAL void Perl_warner(pTHX_ U32 err, const char* pat, ...); -VIRTUAL void Perl_vwarner(pTHX_ U32 err, const char* pat, va_list* args); -VIRTUAL void Perl_watch(pTHX_ char** addr); -VIRTUAL I32 Perl_whichsig(pTHX_ char* sig); -VIRTUAL int Perl_yyerror(pTHX_ char* s); +PERL_CALLCONV void Perl_unlock_condpair(pTHX_ void* svv); +#endif +PERL_CALLCONV void Perl_unsharepvn(pTHX_ const char* sv, I32 len, U32 hash); +PERL_CALLCONV void Perl_unshare_hek(pTHX_ HEK* hek); +PERL_CALLCONV void Perl_utilize(pTHX_ int aver, I32 floor, OP* version, OP* id, OP* arg); +PERL_CALLCONV U8* Perl_utf16_to_utf8(pTHX_ U16* p, U8 *d, I32 bytelen); +PERL_CALLCONV U8* Perl_utf16_to_utf8_reversed(pTHX_ U16* p, U8 *d, I32 bytelen); +PERL_CALLCONV I32 Perl_utf8_distance(pTHX_ U8 *a, U8 *b); +PERL_CALLCONV U8* Perl_utf8_hop(pTHX_ U8 *s, I32 off); +PERL_CALLCONV UV Perl_utf8_to_uv(pTHX_ U8 *s, I32* retlen); +PERL_CALLCONV U8* Perl_uv_to_utf8(pTHX_ U8 *d, UV uv); +PERL_CALLCONV void Perl_vivify_defelem(pTHX_ SV* sv); +PERL_CALLCONV void Perl_vivify_ref(pTHX_ SV* sv, U32 to_what); +PERL_CALLCONV I32 Perl_wait4pid(pTHX_ Pid_t pid, int* statusp, int flags); +PERL_CALLCONV void Perl_report_uninit(pTHX); +PERL_CALLCONV void Perl_warn(pTHX_ const char* pat, ...); +PERL_CALLCONV void Perl_vwarn(pTHX_ const char* pat, va_list* args); +PERL_CALLCONV void Perl_warner(pTHX_ U32 err, const char* pat, ...); +PERL_CALLCONV void Perl_vwarner(pTHX_ U32 err, const char* pat, va_list* args); +PERL_CALLCONV void Perl_watch(pTHX_ char** addr); +PERL_CALLCONV I32 Perl_whichsig(pTHX_ char* sig); +PERL_CALLCONV int Perl_yyerror(pTHX_ char* s); #if defined(USE_PURE_BISON) -VIRTUAL int Perl_yylex(pTHX_ YYSTYPE *lvalp, int *lcharp); +PERL_CALLCONV int Perl_yylex(pTHX_ YYSTYPE *lvalp, int *lcharp); #else -VIRTUAL int Perl_yylex(pTHX); +PERL_CALLCONV int Perl_yylex(pTHX); #endif -VIRTUAL int Perl_yyparse(pTHX); -VIRTUAL int Perl_yywarn(pTHX_ char* s); +PERL_CALLCONV int Perl_yyparse(pTHX); +PERL_CALLCONV int Perl_yywarn(pTHX_ char* s); #if defined(MYMALLOC) -VIRTUAL void Perl_dump_mstats(pTHX_ char* s); -VIRTUAL Malloc_t Perl_malloc(MEM_SIZE nbytes); -VIRTUAL Malloc_t Perl_calloc(MEM_SIZE elements, MEM_SIZE size); -VIRTUAL Malloc_t Perl_realloc(Malloc_t where, MEM_SIZE nbytes); -VIRTUAL Free_t Perl_mfree(Malloc_t where); -#endif -VIRTUAL Malloc_t Perl_safesysmalloc(MEM_SIZE nbytes); -VIRTUAL Malloc_t Perl_safesyscalloc(MEM_SIZE elements, MEM_SIZE size); -VIRTUAL Malloc_t Perl_safesysrealloc(Malloc_t where, MEM_SIZE nbytes); -VIRTUAL Free_t Perl_safesysfree(Malloc_t where); +PERL_CALLCONV void Perl_dump_mstats(pTHX_ char* s); +#endif +PERL_CALLCONV Malloc_t Perl_safesysmalloc(MEM_SIZE nbytes); +PERL_CALLCONV Malloc_t Perl_safesyscalloc(MEM_SIZE elements, MEM_SIZE size); +PERL_CALLCONV Malloc_t Perl_safesysrealloc(Malloc_t where, MEM_SIZE nbytes); +PERL_CALLCONV Free_t Perl_safesysfree(Malloc_t where); #if defined(LEAKTEST) -VIRTUAL Malloc_t Perl_safexmalloc(I32 x, MEM_SIZE size); -VIRTUAL Malloc_t Perl_safexcalloc(I32 x, MEM_SIZE elements, MEM_SIZE size); -VIRTUAL Malloc_t Perl_safexrealloc(Malloc_t where, MEM_SIZE size); -VIRTUAL void Perl_safexfree(Malloc_t where); +PERL_CALLCONV Malloc_t Perl_safexmalloc(I32 x, MEM_SIZE size); +PERL_CALLCONV Malloc_t Perl_safexcalloc(I32 x, MEM_SIZE elements, MEM_SIZE size); +PERL_CALLCONV Malloc_t Perl_safexrealloc(Malloc_t where, MEM_SIZE size); +PERL_CALLCONV void Perl_safexfree(Malloc_t where); #endif #if defined(PERL_GLOBAL_STRUCT) -VIRTUAL struct perl_vars * Perl_GetVars(pTHX); -#endif -VIRTUAL int Perl_runops_standard(pTHX); -VIRTUAL int Perl_runops_debug(pTHX); -VIRTUAL void Perl_sv_catpvf_mg(pTHX_ SV *sv, const char* pat, ...); -VIRTUAL void Perl_sv_vcatpvf_mg(pTHX_ SV* sv, const char* pat, va_list* args); -VIRTUAL void Perl_sv_catpv_mg(pTHX_ SV *sv, const char *ptr); -VIRTUAL void Perl_sv_catpvn_mg(pTHX_ SV *sv, const char *ptr, STRLEN len); -VIRTUAL void Perl_sv_catsv_mg(pTHX_ SV *dstr, SV *sstr); -VIRTUAL void Perl_sv_setpvf_mg(pTHX_ SV *sv, const char* pat, ...); -VIRTUAL void Perl_sv_vsetpvf_mg(pTHX_ SV* sv, const char* pat, va_list* args); -VIRTUAL void Perl_sv_setiv_mg(pTHX_ SV *sv, IV i); -VIRTUAL void Perl_sv_setpviv_mg(pTHX_ SV *sv, IV iv); -VIRTUAL void Perl_sv_setuv_mg(pTHX_ SV *sv, UV u); -VIRTUAL void Perl_sv_setnv_mg(pTHX_ SV *sv, NV num); -VIRTUAL void Perl_sv_setpv_mg(pTHX_ SV *sv, const char *ptr); -VIRTUAL void Perl_sv_setpvn_mg(pTHX_ SV *sv, const char *ptr, STRLEN len); -VIRTUAL void Perl_sv_setsv_mg(pTHX_ SV *dstr, SV *sstr); -VIRTUAL void Perl_sv_usepvn_mg(pTHX_ SV *sv, char *ptr, STRLEN len); -VIRTUAL MGVTBL* Perl_get_vtbl(pTHX_ int vtbl_id); -VIRTUAL char* Perl_pv_display(pTHX_ SV *sv, char *pv, STRLEN cur, STRLEN len, STRLEN pvlim); -VIRTUAL void Perl_dump_indent(pTHX_ I32 level, PerlIO *file, const char* pat, ...); -VIRTUAL void Perl_dump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args); -VIRTUAL void Perl_do_gv_dump(pTHX_ I32 level, PerlIO *file, char *name, GV *sv); -VIRTUAL void Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO *file, char *name, GV *sv); -VIRTUAL void Perl_do_hv_dump(pTHX_ I32 level, PerlIO *file, char *name, HV *sv); -VIRTUAL void Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, MAGIC *mg, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim); -VIRTUAL void Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o); -VIRTUAL void Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, PMOP *pm); -VIRTUAL void Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim); -VIRTUAL void Perl_magic_dump(pTHX_ MAGIC *mg); -VIRTUAL void* Perl_default_protect(pTHX_ int *excpt, protect_body_t body, ...); -VIRTUAL void* Perl_vdefault_protect(pTHX_ int *excpt, protect_body_t body, va_list *args); -VIRTUAL void Perl_reginitcolors(pTHX); -VIRTUAL char* Perl_sv_2pv_nolen(pTHX_ SV* sv); -VIRTUAL char* Perl_sv_pv(pTHX_ SV *sv); -VIRTUAL void Perl_sv_force_normal(pTHX_ SV *sv); -VIRTUAL void Perl_tmps_grow(pTHX_ I32 n); -VIRTUAL SV* Perl_sv_rvweaken(pTHX_ SV *sv); -VIRTUAL int Perl_magic_killbackrefs(pTHX_ SV *sv, MAGIC *mg); -VIRTUAL OP* Perl_newANONATTRSUB(pTHX_ I32 floor, OP *proto, OP *attrs, OP *block); -VIRTUAL CV* Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block); -VIRTUAL void Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block); -VIRTUAL OP * Perl_my_attrs(pTHX_ OP *o, OP *attrs); -VIRTUAL void Perl_boot_core_xsutils(pTHX); +PERL_CALLCONV struct perl_vars * Perl_GetVars(pTHX); +#endif +PERL_CALLCONV int Perl_runops_standard(pTHX); +PERL_CALLCONV int Perl_runops_debug(pTHX); +PERL_CALLCONV void Perl_sv_catpvf_mg(pTHX_ SV *sv, const char* pat, ...); +PERL_CALLCONV void Perl_sv_vcatpvf_mg(pTHX_ SV* sv, const char* pat, va_list* args); +PERL_CALLCONV void Perl_sv_catpv_mg(pTHX_ SV *sv, const char *ptr); +PERL_CALLCONV void Perl_sv_catpvn_mg(pTHX_ SV *sv, const char *ptr, STRLEN len); +PERL_CALLCONV void Perl_sv_catsv_mg(pTHX_ SV *dstr, SV *sstr); +PERL_CALLCONV void Perl_sv_setpvf_mg(pTHX_ SV *sv, const char* pat, ...); +PERL_CALLCONV void Perl_sv_vsetpvf_mg(pTHX_ SV* sv, const char* pat, va_list* args); +PERL_CALLCONV void Perl_sv_setiv_mg(pTHX_ SV *sv, IV i); +PERL_CALLCONV void Perl_sv_setpviv_mg(pTHX_ SV *sv, IV iv); +PERL_CALLCONV void Perl_sv_setuv_mg(pTHX_ SV *sv, UV u); +PERL_CALLCONV void Perl_sv_setnv_mg(pTHX_ SV *sv, NV num); +PERL_CALLCONV void Perl_sv_setpv_mg(pTHX_ SV *sv, const char *ptr); +PERL_CALLCONV void Perl_sv_setpvn_mg(pTHX_ SV *sv, const char *ptr, STRLEN len); +PERL_CALLCONV void Perl_sv_setsv_mg(pTHX_ SV *dstr, SV *sstr); +PERL_CALLCONV void Perl_sv_usepvn_mg(pTHX_ SV *sv, char *ptr, STRLEN len); +PERL_CALLCONV MGVTBL* Perl_get_vtbl(pTHX_ int vtbl_id); +PERL_CALLCONV char* Perl_pv_display(pTHX_ SV *sv, char *pv, STRLEN cur, STRLEN len, STRLEN pvlim); +PERL_CALLCONV void Perl_dump_indent(pTHX_ I32 level, PerlIO *file, const char* pat, ...); +PERL_CALLCONV void Perl_dump_vindent(pTHX_ I32 level, PerlIO *file, const char* pat, va_list *args); +PERL_CALLCONV void Perl_do_gv_dump(pTHX_ I32 level, PerlIO *file, char *name, GV *sv); +PERL_CALLCONV void Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO *file, char *name, GV *sv); +PERL_CALLCONV void Perl_do_hv_dump(pTHX_ I32 level, PerlIO *file, char *name, HV *sv); +PERL_CALLCONV void Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, MAGIC *mg, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim); +PERL_CALLCONV void Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o); +PERL_CALLCONV void Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, PMOP *pm); +PERL_CALLCONV void Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim); +PERL_CALLCONV void Perl_magic_dump(pTHX_ MAGIC *mg); +PERL_CALLCONV void* Perl_default_protect(pTHX_ volatile JMPENV *je, int *excpt, protect_body_t body, ...); +PERL_CALLCONV void* Perl_vdefault_protect(pTHX_ volatile JMPENV *je, int *excpt, protect_body_t body, va_list *args); +PERL_CALLCONV void Perl_reginitcolors(pTHX); +PERL_CALLCONV char* Perl_sv_2pv_nolen(pTHX_ SV* sv); +PERL_CALLCONV char* Perl_sv_2pvutf8_nolen(pTHX_ SV* sv); +PERL_CALLCONV char* Perl_sv_2pvbyte_nolen(pTHX_ SV* sv); +PERL_CALLCONV char* Perl_sv_pv(pTHX_ SV *sv); +PERL_CALLCONV char* Perl_sv_pvutf8(pTHX_ SV *sv); +PERL_CALLCONV char* Perl_sv_pvbyte(pTHX_ SV *sv); +PERL_CALLCONV void Perl_sv_force_normal(pTHX_ SV *sv); +PERL_CALLCONV void Perl_tmps_grow(pTHX_ I32 n); +PERL_CALLCONV SV* Perl_sv_rvweaken(pTHX_ SV *sv); +PERL_CALLCONV int Perl_magic_killbackrefs(pTHX_ SV *sv, MAGIC *mg); +PERL_CALLCONV OP* Perl_newANONATTRSUB(pTHX_ I32 floor, OP *proto, OP *attrs, OP *block); +PERL_CALLCONV CV* Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block); +PERL_CALLCONV void Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block); +PERL_CALLCONV OP * Perl_my_attrs(pTHX_ OP *o, OP *attrs); +PERL_CALLCONV void Perl_boot_core_xsutils(pTHX); +#if defined(USE_ITHREADS) +PERL_CALLCONV PERL_CONTEXT* Perl_cx_dup(pTHX_ PERL_CONTEXT* cx, I32 ix, I32 max); +PERL_CALLCONV PERL_SI* Perl_si_dup(pTHX_ PERL_SI* si); +PERL_CALLCONV ANY* Perl_ss_dup(pTHX_ PerlInterpreter* proto_perl); +PERL_CALLCONV void* Perl_any_dup(pTHX_ void* v, PerlInterpreter* proto_perl); +PERL_CALLCONV HE* Perl_he_dup(pTHX_ HE* e, bool shared); +PERL_CALLCONV REGEXP* Perl_re_dup(pTHX_ REGEXP* r); +PERL_CALLCONV PerlIO* Perl_fp_dup(pTHX_ PerlIO* fp, char type); +PERL_CALLCONV DIR* Perl_dirp_dup(pTHX_ DIR* dp); +PERL_CALLCONV GP* Perl_gp_dup(pTHX_ GP* gp); +PERL_CALLCONV MAGIC* Perl_mg_dup(pTHX_ MAGIC* mg); +PERL_CALLCONV SV* Perl_sv_dup(pTHX_ SV* sstr); +#if defined(HAVE_INTERP_INTERN) +PERL_CALLCONV void Perl_sys_intern_dup(pTHX_ struct interp_intern* src, struct interp_intern* dst); +#endif +PERL_CALLCONV PTR_TBL_t* Perl_ptr_table_new(pTHX); +PERL_CALLCONV void* Perl_ptr_table_fetch(pTHX_ PTR_TBL_t *tbl, void *sv); +PERL_CALLCONV void Perl_ptr_table_store(pTHX_ PTR_TBL_t *tbl, void *oldsv, void *newsv); +PERL_CALLCONV void Perl_ptr_table_split(pTHX_ PTR_TBL_t *tbl); +#endif + #if defined(PERL_OBJECT) protected: +#else +END_EXTERN_C #endif + #if defined(PERL_IN_AV_C) || defined(PERL_DECL_PROT) STATIC I32 S_avhv_index_sv(pTHX_ SV* sv); #endif + #if defined(PERL_IN_DOOP_C) || defined(PERL_DECL_PROT) STATIC I32 S_do_trans_CC_simple(pTHX_ SV *sv); STATIC I32 S_do_trans_CC_count(pTHX_ SV *sv); @@ -755,9 +831,11 @@ STATIC I32 S_do_trans_CU_simple(pTHX_ SV *sv); STATIC I32 S_do_trans_UC_trivial(pTHX_ SV *sv); STATIC I32 S_do_trans_CU_trivial(pTHX_ SV *sv); #endif + #if defined(PERL_IN_GV_C) || defined(PERL_DECL_PROT) STATIC void S_gv_init_sv(pTHX_ GV *gv, I32 sv_type); #endif + #if defined(PERL_IN_HV_C) || defined(PERL_DECL_PROT) STATIC void S_hsplit(pTHX_ HV *hv); STATIC void S_hfreeentries(pTHX_ HV *hv); @@ -767,11 +845,13 @@ STATIC void S_del_he(pTHX_ HE *p); STATIC HEK* S_save_hek(pTHX_ const char *str, I32 len, U32 hash); STATIC void S_hv_magic_check(pTHX_ HV *hv, bool *needs_copy, bool *needs_store); #endif + #if defined(PERL_IN_MG_C) || defined(PERL_DECL_PROT) STATIC void S_save_magic(pTHX_ I32 mgs_ix, SV *sv); STATIC int S_magic_methpack(pTHX_ SV *sv, MAGIC *mg, char *meth); STATIC int S_magic_methcall(pTHX_ SV *sv, MAGIC *mg, char *meth, I32 f, int n, SV *val); #endif + #if defined(PERL_IN_OP_C) || defined(PERL_DECL_PROT) STATIC I32 S_list_assignment(pTHX_ OP *o); STATIC void S_bad_type(pTHX_ I32 n, char *t, char *name, OP *kid); @@ -790,6 +870,7 @@ STATIC OP* S_new_logop(pTHX_ I32 type, I32 flags, OP **firstp, OP **otherp); STATIC void S_simplify_sort(pTHX_ OP *o); STATIC bool S_is_handle_constructor(pTHX_ OP *o, I32 argnum); STATIC char* S_gv_ename(pTHX_ GV *gv); +STATIC void S_cv_dump(pTHX_ CV *cv); STATIC CV* S_cv_clone2(pTHX_ CV *proto, CV *outside); STATIC bool S_scalar_mod_type(pTHX_ OP *o, I32 type); STATIC OP * S_my_kid(pTHX_ OP *o, OP *attrs); @@ -799,6 +880,7 @@ STATIC void S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs); STATIC void* S_Slab_Alloc(pTHX_ int m, size_t sz); # endif #endif + #if defined(PERL_IN_PERL_C) || defined(PERL_DECL_PROT) STATIC void S_find_beginning(pTHX); STATIC void S_forbid_setid(pTHX_ char *); @@ -827,6 +909,7 @@ STATIC void* S_call_list_body(pTHX_ va_list args); STATIC struct perl_thread * S_init_main_thread(pTHX); # endif #endif + #if defined(PERL_IN_PP_C) || defined(PERL_DECL_PROT) STATIC void S_doencodes(pTHX_ SV* sv, char* s, I32 len); STATIC SV* S_refto(pTHX_ SV* sv); @@ -835,6 +918,7 @@ STATIC SV* S_mul128(pTHX_ SV *sv, U8 m); STATIC SV* S_is_an_int(pTHX_ char *s, STRLEN l); STATIC int S_div128(pTHX_ SV *pnum, bool *done); #endif + #if defined(PERL_IN_PP_CTL_C) || defined(PERL_DECL_PROT) STATIC OP* S_docatch(pTHX_ OP *o); STATIC void* S_docatch_body(pTHX_ va_list args); @@ -851,10 +935,12 @@ STATIC OP* S_doeval(pTHX_ int gimme, OP** startop); STATIC PerlIO * S_doopen_pmc(pTHX_ const char *name, const char *mode); STATIC void S_qsortsv(pTHX_ SV ** array, size_t num_elts, SVCOMPARE_t f); #endif + #if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT) STATIC CV* S_get_db_sub(pTHX_ SV **svp, CV *cv); STATIC SV* S_method_common(pTHX_ SV* meth, U32* hashp); #endif + #if defined(PERL_IN_PP_SYS_C) || defined(PERL_DECL_PROT) STATIC OP* S_doform(pTHX_ CV *cv, GV *gv, OP *retop); STATIC int S_emulate_eaccess(pTHX_ const char* path, Mode_t mode); @@ -862,6 +948,7 @@ STATIC int S_emulate_eaccess(pTHX_ const char* path, Mode_t mode); STATIC int S_dooneliner(pTHX_ char *cmd, char *filename); # endif #endif + #if defined(PERL_IN_REGCOMP_C) || defined(PERL_DECL_PROT) STATIC regnode* S_reg(pTHX_ I32, I32 *); STATIC regnode* S_reganode(pTHX_ U8, U32); @@ -879,19 +966,27 @@ STATIC void S_regtail(pTHX_ regnode *, regnode *); STATIC char* S_regwhite(pTHX_ char *, char *); STATIC char* S_nextchar(pTHX); STATIC regnode* S_dumpuntil(pTHX_ regnode *start, regnode *node, regnode *last, SV* sv, I32 l); +STATIC void S_put_byte(pTHX_ SV* sv, int c); STATIC void S_scan_commit(pTHX_ struct scan_data_t *data); +STATIC void S_cl_anything(pTHX_ struct regnode_charclass_class *cl); +STATIC int S_cl_is_anything(pTHX_ struct regnode_charclass_class *cl); +STATIC void S_cl_init(pTHX_ struct regnode_charclass_class *cl); +STATIC void S_cl_init_zero(pTHX_ struct regnode_charclass_class *cl); +STATIC void S_cl_and(pTHX_ struct regnode_charclass_class *cl, struct regnode_charclass_class *and_with); +STATIC void S_cl_or(pTHX_ struct regnode_charclass_class *cl, struct regnode_charclass_class *or_with); STATIC I32 S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, struct scan_data_t *data, U32 flags); STATIC I32 S_add_data(pTHX_ I32 n, char *s); STATIC void S_re_croak2(pTHX_ const char* pat1, const char* pat2, ...) __attribute__((noreturn)); STATIC I32 S_regpposixcc(pTHX_ I32 value); STATIC void S_checkposixcc(pTHX); #endif + #if defined(PERL_IN_REGEXEC_C) || defined(PERL_DECL_PROT) STATIC I32 S_regmatch(pTHX_ regnode *prog); STATIC I32 S_regrepeat(pTHX_ regnode *p, I32 max); STATIC I32 S_regrepeat_hard(pTHX_ regnode *p, I32 max, I32 *lp); STATIC I32 S_regtry(pTHX_ regexp *prog, char *startpos); -STATIC bool S_reginclass(pTHX_ char *p, I32 c); +STATIC bool S_reginclass(pTHX_ regnode *p, I32 c); STATIC bool S_reginclassutf8(pTHX_ regnode *f, U8* p); STATIC CHECKPOINT S_regcppush(pTHX_ I32 parenfloor); STATIC char* S_regcppop(pTHX); @@ -899,13 +994,17 @@ STATIC char* S_regcp_set_to(pTHX_ I32 ss); STATIC void S_cache_re(pTHX_ regexp *prog); STATIC U8* S_reghop(pTHX_ U8 *pos, I32 off); STATIC U8* S_reghopmaybe(pTHX_ U8 *pos, I32 off); +STATIC char* S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *startpos, I32 norun); #endif + #if defined(PERL_IN_RUN_C) || defined(PERL_DECL_PROT) STATIC void S_debprof(pTHX_ OP *o); #endif + #if defined(PERL_IN_SCOPE_C) || defined(PERL_DECL_PROT) STATIC SV* S_save_scalar_at(pTHX_ SV **sptr); #endif + #if defined(PERL_IN_SV_C) || defined(PERL_DECL_PROT) STATIC IV S_asIV(pTHX_ SV* sv); STATIC UV S_asUV(pTHX_ SV* sv); @@ -961,6 +1060,7 @@ STATIC void S_sv_del_backref(pTHX_ SV *sv); STATIC void S_del_sv(pTHX_ SV *p); # endif #endif + #if defined(PERL_IN_TOKE_C) || defined(PERL_DECL_PROT) STATIC void S_check_uni(pTHX); STATIC void S_force_next(pTHX_ I32 type); @@ -983,7 +1083,7 @@ STATIC void S_force_ident(pTHX_ char *s, int kind); STATIC void S_incline(pTHX_ char *s); STATIC int S_intuit_method(pTHX_ char *s, GV *gv); STATIC int S_intuit_more(pTHX_ char *s); -STATIC I32 S_lop(pTHX_ I32 f, expectation x, char *s); +STATIC I32 S_lop(pTHX_ I32 f, int x, char *s); STATIC void S_missingterm(pTHX_ char *s); STATIC void S_no_op(pTHX_ char *what, char *s); STATIC void S_set_csh(pTHX); @@ -991,7 +1091,7 @@ STATIC I32 S_sublex_done(pTHX); STATIC I32 S_sublex_push(pTHX); STATIC I32 S_sublex_start(pTHX); STATIC char * S_filter_gets(pTHX_ SV *sv, PerlIO *fp, STRLEN append); -STATIC SV* S_new_constant(pTHX_ char *s, STRLEN len, char *key, SV *sv, SV *pv, char *type); +STATIC SV* S_new_constant(pTHX_ char *s, STRLEN len, const char *key, SV *sv, SV *pv, const char *type); STATIC int S_ao(pTHX_ int toketype); STATIC void S_depcom(pTHX); STATIC char* S_incl_perldb(pTHX); @@ -1000,16 +1100,22 @@ STATIC I32 S_utf16rev_textfilter(pTHX_ int idx, SV *sv, int maxlen); # if defined(CRIPPLED_CC) STATIC int S_uni(pTHX_ I32 f, char *s); # endif -# if defined(WIN32) -STATIC I32 S_win32_textfilter(pTHX_ int idx, SV *sv, int maxlen); +# if defined(PERL_CR_FILTER) +STATIC I32 S_cr_textfilter(pTHX_ int idx, SV *sv, int maxlen); # endif #endif + #if defined(PERL_IN_UNIVERSAL_C) || defined(PERL_DECL_PROT) STATIC SV* S_isa_lookup(pTHX_ HV *stash, const char *name, int len, int level); #endif + #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT) STATIC SV* S_mess_alloc(pTHX); # if defined(LEAKTEST) STATIC void S_xstat(pTHX_ int); # endif #endif + +#if defined(PERL_OBJECT) +}; +#endif diff --git a/regcomp.c b/regcomp.c index 64c06f0..90500a4 100644 --- a/regcomp.c +++ b/regcomp.c @@ -151,6 +151,7 @@ typedef struct scan_data_t { I32 offset_float_max; I32 flags; I32 whilem_c; + struct regnode_charclass_class *start_class; } scan_data_t; /* @@ -158,7 +159,7 @@ typedef struct scan_data_t { */ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0 }; + 0, 0, 0, 0, 0 }; #define SF_BEFORE_EOL (SF_BEFORE_SEOL|SF_BEFORE_MEOL) #define SF_BEFORE_SEOL 0x1 @@ -184,6 +185,9 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, #define SF_IN_PAR 0x100 #define SF_HAS_EVAL 0x200 #define SCF_DO_SUBSTR 0x400 +#define SCF_DO_STCLASS_AND 0x0800 +#define SCF_DO_STCLASS_OR 0x1000 +#define SCF_DO_STCLASS (SCF_DO_STCLASS_AND|SCF_DO_STCLASS_OR) #define RF_utf8 8 #define UTF (PL_reg_flags & RF_utf8) @@ -202,6 +206,10 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, static void clear_re(pTHXo_ void *r); +/* Mark that we cannot extend a found fixed substring at this point. + Updata the longest found anchored substring and the longest found + floating substrings if needed. */ + STATIC void S_scan_commit(pTHX_ scan_data_t *data) { @@ -236,6 +244,135 @@ S_scan_commit(pTHX_ scan_data_t *data) data->flags &= ~SF_BEFORE_EOL; } +/* Can match anything (initialization) */ +STATIC void +S_cl_anything(pTHX_ struct regnode_charclass_class *cl) +{ + int value; + + ANYOF_CLASS_ZERO(cl); + for (value = 0; value < 256; ++value) + ANYOF_BITMAP_SET(cl, value); + cl->flags = ANYOF_EOS; + if (LOC) + cl->flags |= ANYOF_LOCALE; +} + +/* Can match anything (initialization) */ +STATIC int +S_cl_is_anything(pTHX_ struct regnode_charclass_class *cl) +{ + int value; + + for (value = 0; value < ANYOF_MAX; value += 2) + if (ANYOF_CLASS_TEST(cl, value) && ANYOF_CLASS_TEST(cl, value + 1)) + return 1; + for (value = 0; value < 256; ++value) + if (!ANYOF_BITMAP_TEST(cl, value)) + return 0; + return 1; +} + +/* Can match anything (initialization) */ +STATIC void +S_cl_init(pTHX_ struct regnode_charclass_class *cl) +{ + cl->type = ANYOF; + cl_anything(cl); +} + +STATIC void +S_cl_init_zero(pTHX_ struct regnode_charclass_class *cl) +{ + cl->type = ANYOF; + cl_anything(cl); + ANYOF_CLASS_ZERO(cl); + ANYOF_BITMAP_ZERO(cl); + if (LOC) + cl->flags |= ANYOF_LOCALE; +} + +/* 'And' a given class with another one. Can create false positives */ +/* We assume that cl is not inverted */ +STATIC void +S_cl_and(pTHX_ struct regnode_charclass_class *cl, + struct regnode_charclass_class *and_with) +{ + int value; + + if (!(and_with->flags & ANYOF_CLASS) + && !(cl->flags & ANYOF_CLASS) + && (and_with->flags & ANYOF_LOCALE) == (cl->flags & ANYOF_LOCALE) + && !(and_with->flags & ANYOF_FOLD) + && !(cl->flags & ANYOF_FOLD)) { + int i; + + if (and_with->flags & ANYOF_INVERT) + for (i = 0; i < ANYOF_BITMAP_SIZE; i++) + cl->bitmap[i] &= ~and_with->bitmap[i]; + else + for (i = 0; i < ANYOF_BITMAP_SIZE; i++) + cl->bitmap[i] &= and_with->bitmap[i]; + } /* XXXX: logic is complicated otherwise, leave it along for a moment. */ + if (!(and_with->flags & ANYOF_EOS)) + cl->flags &= ~ANYOF_EOS; +} + +/* 'OR' a given class with another one. Can create false positives */ +/* We assume that cl is not inverted */ +STATIC void +S_cl_or(pTHX_ struct regnode_charclass_class *cl, struct regnode_charclass_class *or_with) +{ + int value; + + if (or_with->flags & ANYOF_INVERT) { + /* We do not use + * (B1 | CL1) | (!B2 & !CL2) = (B1 | !B2 & !CL2) | (CL1 | (!B2 & !CL2)) + * <= (B1 | !B2) | (CL1 | !CL2) + * which is wasteful if CL2 is small, but we ignore CL2: + * (B1 | CL1) | (!B2 & !CL2) <= (B1 | CL1) | !B2 = (B1 | !B2) | CL1 + * XXXX Can we handle case-fold? Unclear: + * (OK1(i) | OK1(i')) | !(OK1(i) | OK1(i')) = + * (OK1(i) | OK1(i')) | (!OK1(i) & !OK1(i')) + */ + if ( (or_with->flags & ANYOF_LOCALE) == (cl->flags & ANYOF_LOCALE) + && !(or_with->flags & ANYOF_FOLD) + && !(cl->flags & ANYOF_FOLD) ) { + int i; + + for (i = 0; i < ANYOF_BITMAP_SIZE; i++) + cl->bitmap[i] |= ~or_with->bitmap[i]; + } /* XXXX: logic is complicated otherwise */ + else { + cl_anything(cl); + } + } else { + /* (B1 | CL1) | (B2 | CL2) = (B1 | B2) | (CL1 | CL2)) */ + if ( (or_with->flags & ANYOF_LOCALE) == (cl->flags & ANYOF_LOCALE) + && (!(or_with->flags & ANYOF_FOLD) + || (cl->flags & ANYOF_FOLD)) ) { + int i; + + /* OR char bitmap and class bitmap separately */ + for (i = 0; i < ANYOF_BITMAP_SIZE; i++) + cl->bitmap[i] |= or_with->bitmap[i]; + if (or_with->flags & ANYOF_CLASS) { + for (i = 0; i < ANYOF_CLASSBITMAP_SIZE; i++) + cl->classflags[i] |= or_with->classflags[i]; + cl->flags |= ANYOF_CLASS; + } + } + else { /* XXXX: logic is complicated, leave it along for a moment. */ + cl_anything(cl); + } + } + if (or_with->flags & ANYOF_EOS) + cl->flags |= ANYOF_EOS; +} + +/* REx optimizer. Converts nodes into quickier variants "in place". + Finds fixed substrings. */ + /* Stops at toplevel WHILEM as well as at `last'. At end *scanp is set to the position after last scanned or to NULL. */ @@ -253,11 +390,13 @@ S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, scan_data_t *da int is_inf_internal = 0; /* The studied chunk is infinite */ I32 is_par = OP(scan) == OPEN ? ARG(scan) : 0; scan_data_t data_fake; + struct regnode_charclass_class and_with; /* Valid if flags & SCF_DO_STCLASS_OR */ while (scan && OP(scan) != END && scan < last) { /* Peephole optimizer: */ if (PL_regkind[(U8)OP(scan)] == EXACT) { + /* Merge several consecutive EXACTish nodes into one. */ regnode *n = regnext(scan); U32 stringok = 1; #ifdef DEBUGGING @@ -305,19 +444,16 @@ S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, scan_data_t *da /* Allow dumping */ n = scan + NODE_SZ_STR(scan); while (n <= stop) { - /* Purify reports a benign UMR here sometimes, because we - * don't initialize the OP() slot of a node when that node - * is occupied by just the trailing null of the string in - * an EXACT node */ if (PL_regkind[(U8)OP(n)] != NOTHING || OP(n) == NOTHING) { OP(n) = OPTIMIZED; NEXT_OFF(n) = 0; } n++; } -#endif - +#endif } + /* Follow the next-chain of the current node and optimize + away all the NOTHINGs from it. */ if (OP(scan) != CURLYX) { int max = (reg_off_by_arg[OP(scan)] ? I32_MAX @@ -338,6 +474,8 @@ S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, scan_data_t *da else NEXT_OFF(scan) = off; } + /* The principal pseudo-switch. Cannot be a switch, since we + look into several different things. */ if (OP(scan) == BRANCH || OP(scan) == BRANCHJ || OP(scan) == IFTHEN || OP(scan) == SUSPEND) { next = regnext(scan); @@ -345,11 +483,15 @@ S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, scan_data_t *da if (OP(next) == code || code == IFTHEN || code == SUSPEND) { I32 max1 = 0, min1 = I32_MAX, num = 0; + struct regnode_charclass_class accum; - if (flags & SCF_DO_SUBSTR) - scan_commit(data); + if (flags & SCF_DO_SUBSTR) /* XXXX Add !SUSPEND? */ + scan_commit(data); /* Cannot merge strings after this. */ + if (flags & SCF_DO_STCLASS) + cl_init_zero(&accum); while (OP(scan) == code) { - I32 deltanext, minnext; + I32 deltanext, minnext, f = 0; + struct regnode_charclass_class this_class; num++; data_fake.flags = 0; @@ -359,9 +501,14 @@ S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, scan_data_t *da scan = NEXTOPER(scan); if (code != BRANCH) scan = NEXTOPER(scan); - /* We suppose the run is continuous, last=next...*/ + if (flags & SCF_DO_STCLASS) { + cl_init(&this_class); + data_fake.start_class = &this_class; + f = SCF_DO_STCLASS_AND; + } + /* we suppose the run is continuous, last=next...*/ minnext = study_chunk(&scan, &deltanext, next, - &data_fake, 0); + &data_fake, f); if (min1 > minnext) min1 = minnext; if (max1 < minnext + deltanext) @@ -375,6 +522,8 @@ S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, scan_data_t *da data->flags |= SF_HAS_EVAL; if (data) data->whilem_c = data_fake.whilem_c; + if (flags & SCF_DO_STCLASS) + cl_or(&accum, &this_class); if (code == SUSPEND) break; } @@ -388,6 +537,30 @@ S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, scan_data_t *da } min += min1; delta += max1 - min1; + if (flags & SCF_DO_STCLASS_OR) { + cl_or(data->start_class, &accum); + if (min1) { + cl_and(data->start_class, &and_with); + flags &= ~SCF_DO_STCLASS; + } + } + else if (flags & SCF_DO_STCLASS_AND) { + if (min1) { + cl_and(data->start_class, &accum); + flags &= ~SCF_DO_STCLASS; + } + else { + /* Switch to OR mode: cache the old value of + * data->start_class */ + StructCopy(data->start_class, &and_with, + struct regnode_charclass_class); + flags &= ~SCF_DO_STCLASS_AND; + StructCopy(&accum, data->start_class, + struct regnode_charclass_class); + flags |= SCF_DO_STCLASS_OR; + data->start_class->flags |= ANYOF_EOS; + } + } } else if (code == BRANCHJ) /* single branch is optimized. */ scan = NEXTOPER(NEXTOPER(scan)); @@ -421,9 +594,34 @@ S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, scan_data_t *da data->pos_min += l; /* As in the first entry. */ data->flags &= ~SF_BEFORE_EOL; } + if (flags & SCF_DO_STCLASS_AND) { + /* Check whether it is compatible with what we know already! */ + int compat = 1; + + if (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE)) + && !ANYOF_BITMAP_TEST(data->start_class, *STRING(scan)) + && (!(data->start_class->flags & ANYOF_FOLD) + || !ANYOF_BITMAP_TEST(data->start_class, + PL_fold[*STRING(scan)]))) + compat = 0; + ANYOF_CLASS_ZERO(data->start_class); + ANYOF_BITMAP_ZERO(data->start_class); + if (compat) + ANYOF_BITMAP_SET(data->start_class, *STRING(scan)); + data->start_class->flags &= ~ANYOF_EOS; + } + else if (flags & SCF_DO_STCLASS_OR) { + /* false positive possible if the class is case-folded */ + ANYOF_BITMAP_SET(data->start_class, *STRING(scan)); + data->start_class->flags &= ~ANYOF_EOS; + cl_and(data->start_class, &and_with); + } + flags &= ~SCF_DO_STCLASS; } - else if (PL_regkind[(U8)OP(scan)] == EXACT) { + else if (PL_regkind[(U8)OP(scan)] == EXACT) { /* But OP != EXACT! */ I32 l = STR_LEN(scan); + + /* Search for fixed substrings supports EXACT only. */ if (flags & SCF_DO_SUBSTR) scan_commit(data); if (UTF) { @@ -439,19 +637,51 @@ S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, scan_data_t *da min += l; if (data && (flags & SCF_DO_SUBSTR)) data->pos_min += l; + if (flags & SCF_DO_STCLASS_AND) { + /* Check whether it is compatible with what we know already! */ + int compat = 1; + + if (!(data->start_class->flags & (ANYOF_CLASS | ANYOF_LOCALE)) + && !ANYOF_BITMAP_TEST(data->start_class, *STRING(scan)) + && !ANYOF_BITMAP_TEST(data->start_class, + PL_fold[*STRING(scan)])) + compat = 0; + ANYOF_CLASS_ZERO(data->start_class); + ANYOF_BITMAP_ZERO(data->start_class); + if (compat) { + ANYOF_BITMAP_SET(data->start_class, *STRING(scan)); + data->start_class->flags &= ~ANYOF_EOS; + data->start_class->flags |= ANYOF_FOLD; + if (OP(scan) == EXACTFL) + data->start_class->flags |= ANYOF_LOCALE; + } + } + else if (flags & SCF_DO_STCLASS_OR) { + if (data->start_class->flags & ANYOF_FOLD) { + /* false positive possible if the class is case-folded. + Assume that the locale settings are the same... */ + ANYOF_BITMAP_SET(data->start_class, *STRING(scan)); + data->start_class->flags &= ~ANYOF_EOS; + } + cl_and(data->start_class, &and_with); + } + flags &= ~SCF_DO_STCLASS; } else if (strchr((char*)PL_varies,OP(scan))) { I32 mincount, maxcount, minnext, deltanext, pos_before, fl; + I32 f = flags; regnode *oscan = scan; - + struct regnode_charclass_class this_class; + struct regnode_charclass_class *oclass = NULL; + switch (PL_regkind[(U8)OP(scan)]) { - case WHILEM: + case WHILEM: /* End of (?:...)* . */ scan = NEXTOPER(scan); goto finish; case PLUS: - if (flags & SCF_DO_SUBSTR) { + if (flags & (SCF_DO_SUBSTR | SCF_DO_STCLASS)) { next = NEXTOPER(scan); - if (OP(next) == EXACT) { + if (OP(next) == EXACT || (flags & SCF_DO_STCLASS)) { mincount = 1; maxcount = REG_INFTY; next = regnext(scan); @@ -464,10 +694,17 @@ S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, scan_data_t *da min++; /* Fall through. */ case STAR: + if (flags & SCF_DO_STCLASS) { + mincount = 0; + maxcount = REG_INFTY; + next = regnext(scan); + scan = NEXTOPER(scan); + goto do_curly; + } is_inf = is_inf_internal = 1; scan = regnext(scan); if (flags & SCF_DO_SUBSTR) { - scan_commit(data); + scan_commit(data); /* Cannot extend fixed substrings */ data->longest = &(data->longest_float); } goto optimize_curly_tail; @@ -478,7 +715,7 @@ S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, scan_data_t *da scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS; do_curly: if (flags & SCF_DO_SUBSTR) { - if (mincount == 0) scan_commit(data); + if (mincount == 0) scan_commit(data); /* Cannot extend fixed substrings */ pos_before = data->pos_min; } if (data) { @@ -487,10 +724,45 @@ S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, scan_data_t *da if (is_inf) data->flags |= SF_IS_INF; } + if (flags & SCF_DO_STCLASS) { + cl_init(&this_class); + oclass = data->start_class; + data->start_class = &this_class; + f |= SCF_DO_STCLASS_AND; + f &= ~SCF_DO_STCLASS_OR; + } + /* This will finish on WHILEM, setting scan, or on NULL: */ minnext = study_chunk(&scan, &deltanext, last, data, mincount == 0 - ? (flags & ~SCF_DO_SUBSTR) : flags); + ? (f & ~SCF_DO_SUBSTR) : f); + + if (flags & SCF_DO_STCLASS) + data->start_class = oclass; + if (mincount == 0 || minnext == 0) { + if (flags & SCF_DO_STCLASS_OR) { + cl_or(data->start_class, &this_class); + } + else if (flags & SCF_DO_STCLASS_AND) { + /* Switch to OR mode: cache the old value of + * data->start_class */ + StructCopy(data->start_class, &and_with, + struct regnode_charclass_class); + flags &= ~SCF_DO_STCLASS_AND; + StructCopy(&this_class, data->start_class, + struct regnode_charclass_class); + flags |= SCF_DO_STCLASS_OR; + data->start_class->flags |= ANYOF_EOS; + } + } else { /* Non-zero len */ + if (flags & SCF_DO_STCLASS_OR) { + cl_or(data->start_class, &this_class); + cl_and(data->start_class, &and_with); + } + else if (flags & SCF_DO_STCLASS_AND) + cl_and(data->start_class, &this_class); + flags &= ~SCF_DO_STCLASS; + } if (!scan) /* It was not CURLYX, but CURLY. */ scan = next; if (ckWARN(WARN_UNSAFE) && (minnext + deltanext == 0) @@ -640,6 +912,8 @@ S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, scan_data_t *da data->pos_delta += - counted * deltanext + (minnext + deltanext) * maxcount - minnext * mincount; if (mincount != maxcount) { + /* Cannot extend fixed substrings found inside + the group. */ scan_commit(data); if (mincount && last_str) { sv_setsv(data->last_found, last_str); @@ -664,49 +938,264 @@ S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, scan_data_t *da NEXT_OFF(oscan) += NEXT_OFF(next); } continue; - default: /* REF only? */ + default: /* REF and CLUMP only? */ if (flags & SCF_DO_SUBSTR) { - scan_commit(data); + scan_commit(data); /* Cannot expect anything... */ data->longest = &(data->longest_float); } is_inf = is_inf_internal = 1; + if (flags & SCF_DO_STCLASS_OR) + cl_anything(data->start_class); + flags &= ~SCF_DO_STCLASS; break; } } else if (strchr((char*)PL_simple,OP(scan)) || PL_regkind[(U8)OP(scan)] == ANYUTF8) { + int value; + if (flags & SCF_DO_SUBSTR) { scan_commit(data); data->pos_min++; } min++; + if (flags & SCF_DO_STCLASS) { + data->start_class->flags &= ~ANYOF_EOS; /* No match on empty */ + + /* Some of the logic below assumes that switching + locale on will only add false positives. */ + switch (PL_regkind[(U8)OP(scan)]) { + case ANYUTF8: + case SANY: + case SANYUTF8: + case ALNUMUTF8: + case ANYOFUTF8: + case ALNUMLUTF8: + case NALNUMUTF8: + case NALNUMLUTF8: + case SPACEUTF8: + case NSPACEUTF8: + case SPACELUTF8: + case NSPACELUTF8: + case DIGITUTF8: + case NDIGITUTF8: + default: + do_default: + /* Perl_croak(aTHX_ "panic: unexpected simple REx opcode %d", OP(scan)); */ + if (flags & SCF_DO_STCLASS_OR) /* Allow everything */ + cl_anything(data->start_class); + break; + case REG_ANY: + if (OP(scan) == SANY) + goto do_default; + if (flags & SCF_DO_STCLASS_OR) { /* Everything but \n */ + value = (ANYOF_BITMAP_TEST(data->start_class,'\n') + || (data->start_class->flags & ANYOF_CLASS)); + cl_anything(data->start_class); + } + if (flags & SCF_DO_STCLASS_AND || !value) + ANYOF_BITMAP_CLEAR(data->start_class,'\n'); + break; + case ANYOF: + if (flags & SCF_DO_STCLASS_AND) + cl_and(data->start_class, + (struct regnode_charclass_class*)scan); + else + cl_or(data->start_class, + (struct regnode_charclass_class*)scan); + break; + case ALNUM: + if (flags & SCF_DO_STCLASS_AND) { + if (!(data->start_class->flags & ANYOF_LOCALE)) { + ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NALNUM); + for (value = 0; value < 256; value++) + if (!isALNUM(value)) + ANYOF_BITMAP_CLEAR(data->start_class, value); + } + } + else { + if (data->start_class->flags & ANYOF_LOCALE) + ANYOF_CLASS_SET(data->start_class,ANYOF_ALNUM); + else { + for (value = 0; value < 256; value++) + if (isALNUM(value)) + ANYOF_BITMAP_SET(data->start_class, value); + } + } + break; + case ALNUML: + if (flags & SCF_DO_STCLASS_AND) { + if (data->start_class->flags & ANYOF_LOCALE) + ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NALNUM); + } + else { + ANYOF_CLASS_SET(data->start_class,ANYOF_ALNUM); + data->start_class->flags |= ANYOF_LOCALE; + } + break; + case NALNUM: + if (flags & SCF_DO_STCLASS_AND) { + if (!(data->start_class->flags & ANYOF_LOCALE)) { + ANYOF_CLASS_CLEAR(data->start_class,ANYOF_ALNUM); + for (value = 0; value < 256; value++) + if (isALNUM(value)) + ANYOF_BITMAP_CLEAR(data->start_class, value); + } + } + else { + if (data->start_class->flags & ANYOF_LOCALE) + ANYOF_CLASS_SET(data->start_class,ANYOF_NALNUM); + else { + for (value = 0; value < 256; value++) + if (!isALNUM(value)) + ANYOF_BITMAP_SET(data->start_class, value); + } + } + break; + case NALNUML: + if (flags & SCF_DO_STCLASS_AND) { + if (data->start_class->flags & ANYOF_LOCALE) + ANYOF_CLASS_CLEAR(data->start_class,ANYOF_ALNUM); + } + else { + data->start_class->flags |= ANYOF_LOCALE; + ANYOF_CLASS_SET(data->start_class,ANYOF_NALNUM); + } + break; + case SPACE: + if (flags & SCF_DO_STCLASS_AND) { + if (!(data->start_class->flags & ANYOF_LOCALE)) { + ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NSPACE); + for (value = 0; value < 256; value++) + if (!isSPACE(value)) + ANYOF_BITMAP_CLEAR(data->start_class, value); + } + } + else { + if (data->start_class->flags & ANYOF_LOCALE) + ANYOF_CLASS_SET(data->start_class,ANYOF_SPACE); + else { + for (value = 0; value < 256; value++) + if (isSPACE(value)) + ANYOF_BITMAP_SET(data->start_class, value); + } + } + break; + case SPACEL: + if (flags & SCF_DO_STCLASS_AND) { + if (data->start_class->flags & ANYOF_LOCALE) + ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NSPACE); + } + else { + data->start_class->flags |= ANYOF_LOCALE; + ANYOF_CLASS_SET(data->start_class,ANYOF_SPACE); + } + break; + case NSPACE: + if (flags & SCF_DO_STCLASS_AND) { + if (!(data->start_class->flags & ANYOF_LOCALE)) { + ANYOF_CLASS_CLEAR(data->start_class,ANYOF_SPACE); + for (value = 0; value < 256; value++) + if (isSPACE(value)) + ANYOF_BITMAP_CLEAR(data->start_class, value); + } + } + else { + if (data->start_class->flags & ANYOF_LOCALE) + ANYOF_CLASS_SET(data->start_class,ANYOF_NSPACE); + else { + for (value = 0; value < 256; value++) + if (!isSPACE(value)) + ANYOF_BITMAP_SET(data->start_class, value); + } + } + break; + case NSPACEL: + if (flags & SCF_DO_STCLASS_AND) { + if (data->start_class->flags & ANYOF_LOCALE) { + ANYOF_CLASS_CLEAR(data->start_class,ANYOF_SPACE); + for (value = 0; value < 256; value++) + if (!isSPACE(value)) + ANYOF_BITMAP_CLEAR(data->start_class, value); + } + } + else { + data->start_class->flags |= ANYOF_LOCALE; + ANYOF_CLASS_SET(data->start_class,ANYOF_NSPACE); + } + break; + case DIGIT: + if (flags & SCF_DO_STCLASS_AND) { + ANYOF_CLASS_CLEAR(data->start_class,ANYOF_NDIGIT); + for (value = 0; value < 256; value++) + if (!isDIGIT(value)) + ANYOF_BITMAP_CLEAR(data->start_class, value); + } + else { + if (data->start_class->flags & ANYOF_LOCALE) + ANYOF_CLASS_SET(data->start_class,ANYOF_DIGIT); + else { + for (value = 0; value < 256; value++) + if (isDIGIT(value)) + ANYOF_BITMAP_SET(data->start_class, value); + } + } + break; + case NDIGIT: + if (flags & SCF_DO_STCLASS_AND) { + ANYOF_CLASS_CLEAR(data->start_class,ANYOF_DIGIT); + for (value = 0; value < 256; value++) + if (isDIGIT(value)) + ANYOF_BITMAP_CLEAR(data->start_class, value); + } + else { + if (data->start_class->flags & ANYOF_LOCALE) + ANYOF_CLASS_SET(data->start_class,ANYOF_NDIGIT); + else { + for (value = 0; value < 256; value++) + if (!isDIGIT(value)) + ANYOF_BITMAP_SET(data->start_class, value); + } + } + break; + } + if (flags & SCF_DO_STCLASS_OR) + cl_and(data->start_class, &and_with); + flags &= ~SCF_DO_STCLASS; + } } else if (PL_regkind[(U8)OP(scan)] == EOL && flags & SCF_DO_SUBSTR) { data->flags |= (OP(scan) == MEOL ? SF_BEFORE_MEOL : SF_BEFORE_SEOL); } - else if (PL_regkind[(U8)OP(scan)] == BRANCHJ - && (scan->flags || data) + else if ( PL_regkind[(U8)OP(scan)] == BRANCHJ + /* Lookbehind, or need to calculate parens/evals/stclass: */ + && (scan->flags || data || (flags & SCF_DO_STCLASS)) && (OP(scan) == IFMATCH || OP(scan) == UNLESSM)) { + /* Lookahead/lookbehind */ I32 deltanext, minnext; regnode *nscan; + struct regnode_charclass_class intrnl; + int f = 0; data_fake.flags = 0; if (data) data_fake.whilem_c = data->whilem_c; + if ( flags & SCF_DO_STCLASS && !scan->flags + && OP(scan) == IFMATCH ) { /* Lookahead */ + cl_init(&intrnl); + data_fake.start_class = &intrnl; + f = SCF_DO_STCLASS_AND; + } next = regnext(scan); nscan = NEXTOPER(NEXTOPER(scan)); - minnext = study_chunk(&nscan, &deltanext, last, &data_fake, 0); + minnext = study_chunk(&nscan, &deltanext, last, &data_fake, f); if (scan->flags) { if (deltanext) { FAIL("variable length lookbehind not implemented"); } else if (minnext > U8_MAX) { -#ifdef UV_IS_QUAD - FAIL2("lookbehind longer than %" PERL_PRIu64 " not implemented", (UV)U8_MAX); -#else - FAIL2("lookbehind longer than %d not implemented", U8_MAX); -#endif + FAIL2("lookbehind longer than %"UVuf" not implemented", (UV)U8_MAX); } scan->flags = minnext; } @@ -716,6 +1205,13 @@ S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, scan_data_t *da data->flags |= SF_HAS_EVAL; if (data) data->whilem_c = data_fake.whilem_c; + if (f) { + int was = (data->start_class->flags & ANYOF_EOS); + + cl_and(data->start_class, &intrnl); + if (was) + data->start_class->flags |= ANYOF_EOS; + } } else if (OP(scan) == OPEN) { pars++; @@ -736,6 +1232,8 @@ S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, scan_data_t *da data->longest = &(data->longest_float); } is_inf = is_inf_internal = 1; + if (flags & SCF_DO_STCLASS_OR) /* Allow everything */ + cl_anything(data->start_class); } /* Else: zero-length, ignore. */ scan = regnext(scan); @@ -756,6 +1254,8 @@ S_study_chunk(pTHX_ regnode **scanp, I32 *deltap, regnode *last, scan_data_t *da data->flags |= SF_HAS_PAR; data->flags &= ~SF_IN_PAR; } + if (flags & SCF_DO_STCLASS_OR) + cl_and(data->start_class, &and_with); return min; } @@ -848,7 +1348,7 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) DEBUG_r(if (!PL_colorset) reginitcolors()); DEBUG_r(PerlIO_printf(Perl_debug_log, "%sCompiling REx%s `%s%*s%s'\n", PL_colors[4],PL_colors[5],PL_colors[0], - xend - exp, PL_regprecomp, PL_colors[1])); + (int)(xend - exp), PL_regprecomp, PL_colors[1])); PL_regflags = pm->op_pmflags; PL_regsawback = 0; @@ -871,7 +1371,7 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) PL_regprecomp = Nullch; return(NULL); } - DEBUG_r(PerlIO_printf(Perl_debug_log, "size %d ", PL_regsize)); + DEBUG_r(PerlIO_printf(Perl_debug_log, "size %"IVdf" ", (IV)PL_regsize)); /* Small enough for pointer-storage convention? If extralen==0, this means that we will not need long jumps. */ @@ -928,16 +1428,21 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) Newz(1004, r->substrs, 1, struct reg_substr_data); StructCopy(&zero_scan_data, &data, scan_data_t); + /* XXXX Should not we check for something else? Usually it is OPEN1... */ if (OP(scan) != BRANCH) { /* Only one top-level choice. */ I32 fake; STRLEN longest_float_length, longest_fixed_length; + struct regnode_charclass_class ch_class; + int stclass_flag; first = scan; /* Skip introductions and multiplicators >= 1. */ while ((OP(first) == OPEN && (sawopen = 1)) || + /* An OR of *one* alternative - should not happen now. */ (OP(first) == BRANCH && OP(regnext(first)) != BRANCH) || (OP(first) == PLUS) || (OP(first) == MINMOD) || + /* An {n,m} with n>0 */ (PL_regkind[(U8)OP(first)] == CURLY && ARG1(first) > 0) ) { if (OP(first) == PLUS) sawplus = 1; @@ -948,8 +1453,13 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) /* Starting-point info. */ again: - if (OP(first) == EXACT); /* Empty, get anchored substr later. */ - else if (strchr((char*)PL_simple+4,OP(first))) + if (PL_regkind[(U8)OP(first)] == EXACT) { + if (OP(first) == EXACT); /* Empty, get anchored substr later. */ + else if ((OP(first) == EXACTF || OP(first) == EXACTFL) + && !UTF) + r->regstclass = first; + } + else if (strchr((char*)PL_simple,OP(first))) r->regstclass = first; else if (PL_regkind[(U8)OP(first)] == BOUND || PL_regkind[(U8)OP(first)] == NBOUND) @@ -990,8 +1500,8 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) r->reganch |= ROPT_SKIP; /* Scan is after the zeroth branch, first is atomic matcher. */ - DEBUG_r(PerlIO_printf(Perl_debug_log, "first at %d\n", - first - scan + 1)); + DEBUG_r(PerlIO_printf(Perl_debug_log, "first at %"IVdf"\n", + (IV)(first - scan + 1))); /* * If there's something expensive in the r.e., find the * longest literal string that must appear and make it the @@ -1010,9 +1520,15 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) data.last_found = newSVpvn("",0); data.longest = &(data.longest_fixed); first = scan; - + if (!r->regstclass) { + cl_init(&ch_class); + data.start_class = &ch_class; + stclass_flag = SCF_DO_STCLASS_AND; + } else /* XXXX Check for BOUND? */ + stclass_flag = 0; + minlen = study_chunk(&first, &fake, scan + PL_regsize, /* Up to end */ - &data, SCF_DO_SUBSTR); + &data, SCF_DO_SUBSTR | stclass_flag); if ( PL_regnpar == 1 && data.longest == &(data.longest_fixed) && data.last_start_min == 0 && data.last_end > 0 && !PL_seen_zerolen @@ -1067,6 +1583,28 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) SvREFCNT_dec(data.longest_fixed); longest_fixed_length = 0; } + if (r->regstclass + && (OP(r->regstclass) == REG_ANY || OP(r->regstclass) == ANYUTF8 + || OP(r->regstclass) == SANYUTF8 || OP(r->regstclass) == SANY)) + r->regstclass = NULL; + if ((!r->anchored_substr || r->anchored_offset) && stclass_flag + && !(data.start_class->flags & ANYOF_EOS) + && !cl_is_anything(data.start_class)) { + SV *sv; + I32 n = add_data(1, "f"); + + New(1006, PL_regcomp_rx->data->data[n], 1, + struct regnode_charclass_class); + StructCopy(data.start_class, + (struct regnode_charclass_class*)PL_regcomp_rx->data->data[n], + struct regnode_charclass_class); + r->regstclass = (regnode*)PL_regcomp_rx->data->data[n]; + r->reganch &= ~ROPT_SKIP; /* Used in find_byclass(). */ + DEBUG_r((sv = sv_newmortal(), + regprop(sv, (regnode*)data.start_class), + PerlIO_printf(Perl_debug_log, "synthetic stclass.\n", + SvPVX(sv)))); + } /* A temporary algorithm prefers floated substr to fixed one to dig more info. */ if (longest_fixed_length > longest_float_length) { @@ -1080,7 +1618,9 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) r->check_offset_min = data.offset_float_min; r->check_offset_max = data.offset_float_max; } - if (r->check_substr) { + /* XXXX Currently intuiting is not compatible with ANCH_GPOS. + This should be changed ASAP! */ + if (r->check_substr && !(r->reganch & ROPT_ANCH_GPOS)) { r->reganch |= RE_USE_INTUIT; if (SvTAIL(r->check_substr)) r->reganch |= RE_INTUIT_TAIL; @@ -1089,11 +1629,31 @@ Perl_pregcomp(pTHX_ char *exp, char *xend, PMOP *pm) else { /* Several toplevels. Best we can is to set minlen. */ I32 fake; + struct regnode_charclass_class ch_class; DEBUG_r(PerlIO_printf(Perl_debug_log, "\n")); scan = r->program + 1; - minlen = study_chunk(&scan, &fake, scan + PL_regsize, &data, 0); + cl_init(&ch_class); + data.start_class = &ch_class; + minlen = study_chunk(&scan, &fake, scan + PL_regsize, &data, SCF_DO_STCLASS_AND); r->check_substr = r->anchored_substr = r->float_substr = Nullsv; + if (!(data.start_class->flags & ANYOF_EOS) + && !cl_is_anything(data.start_class)) { + SV *sv; + I32 n = add_data(1, "f"); + + New(1006, PL_regcomp_rx->data->data[n], 1, + struct regnode_charclass_class); + StructCopy(data.start_class, + (struct regnode_charclass_class*)PL_regcomp_rx->data->data[n], + struct regnode_charclass_class); + r->regstclass = (regnode*)PL_regcomp_rx->data->data[n]; + r->reganch &= ~ROPT_SKIP; /* Used in find_byclass(). */ + DEBUG_r((sv = sv_newmortal(), + regprop(sv, (regnode*)data.start_class), + PerlIO_printf(Perl_debug_log, "synthetic stclass.\n", + SvPVX(sv)))); + } } r->minlen = minlen; @@ -2010,11 +2570,19 @@ tryagain: p++; break; case 'e': - ender = '\033'; +#ifdef ASCIIish + ender = '\033'; +#else + ender = '\047'; +#endif p++; break; case 'a': - ender = '\007'; +#ifdef ASCIIish + ender = '\007'; +#else + ender = '\057'; +#endif p++; break; case 'x': @@ -2024,7 +2592,7 @@ tryagain: if (!e) FAIL("Missing right brace on \\x{}"); else if (UTF) { - ender = scan_hex(p + 1, e - p, &numlen); + ender = (UV)scan_hex(p + 1, e - p, &numlen); if (numlen + len >= 127) { /* numlen is generous */ p--; goto loopdone; @@ -2035,7 +2603,7 @@ tryagain: FAIL("Can't use \\x{} without 'use utf8' declaration"); } else { - ender = scan_hex(p, 2, &numlen); + ender = (UV)scan_hex(p, 2, &numlen); p += numlen; } break; @@ -2048,7 +2616,7 @@ tryagain: case '5': case '6': case '7': case '8':case '9': if (*p == '0' || (isDIGIT(p[1]) && atoi(p) >= PL_regnpar) ) { - ender = scan_oct(p, 3, &numlen); + ender = (UV)scan_oct(p, 3, &numlen); p += numlen; } else { @@ -2063,9 +2631,9 @@ tryagain: default: if (!SIZE_ONLY && ckWARN(WARN_UNSAFE) && isALPHA(*p)) Perl_warner(aTHX_ WARN_UNSAFE, - "/%.127s/: Unrecognized escape \\%c passed through", - PL_regprecomp, - *p); + "/%.127s/: Unrecognized escape \\%c passed through", + PL_regprecomp, + *p); goto normal_default; } break; @@ -2158,7 +2726,7 @@ S_regpposixcc(pTHX_ I32 value) { dTHR; char *posixcc = 0; - I32 namedclass = -1; + I32 namedclass = OOB_NAMEDCLASS; if (value == '[' && PL_regcomp_parse + 1 < PL_regxend && /* I smell either [: or [= or [. -- POSIX has been here, right? */ @@ -2271,7 +2839,7 @@ S_regpposixcc(pTHX_ I32 value) STATIC void S_checkposixcc(pTHX) { - if (ckWARN(WARN_UNSAFE) && !SIZE_ONLY && + if (!SIZE_ONLY && ckWARN(WARN_UNSAFE) && (*PL_regcomp_parse == ':' || *PL_regcomp_parse == '=' || *PL_regcomp_parse == '.')) { @@ -2294,43 +2862,45 @@ STATIC regnode * S_regclass(pTHX) { dTHR; - register char *opnd, *s; - register I32 value; + register UV value; register I32 lastvalue = OOB_CHAR8; register I32 range = 0; register regnode *ret; register I32 def; I32 numlen; I32 namedclass; + char *rangebegin; + bool need_class = 0; - s = opnd = MASK(PL_regcode); ret = reg_node(ANYOF); - for (value = 0; value < ANYOF_SIZE; value++) - REGC(0, s++); + if (SIZE_ONLY) + PL_regsize += ANYOF_SKIP; + else { + ret->flags = 0; + ANYOF_BITMAP_ZERO(ret); + PL_regcode += ANYOF_SKIP; + if (FOLD) + ANYOF_FLAGS(ret) |= ANYOF_FOLD; + if (LOC) + ANYOF_FLAGS(ret) |= ANYOF_LOCALE; + } if (*PL_regcomp_parse == '^') { /* Complement of range. */ PL_regnaughty++; PL_regcomp_parse++; if (!SIZE_ONLY) - ANYOF_FLAGS(opnd) |= ANYOF_INVERT; - } - if (!SIZE_ONLY) { - PL_regcode += ANY_SKIP; - if (FOLD) - ANYOF_FLAGS(opnd) |= ANYOF_FOLD; - if (LOC) - ANYOF_FLAGS(opnd) |= ANYOF_LOCALE; - } - else { - PL_regsize += ANY_SKIP; + ANYOF_FLAGS(ret) |= ANYOF_INVERT; } - checkposixcc(); + if (!SIZE_ONLY && ckWARN(WARN_UNSAFE)) + checkposixcc(); if (*PL_regcomp_parse == ']' || *PL_regcomp_parse == '-') goto skipcond; /* allow 1st char to be ] or - */ while (PL_regcomp_parse < PL_regxend && *PL_regcomp_parse != ']') { skipcond: namedclass = OOB_NAMEDCLASS; + if (!range) + rangebegin = PL_regcomp_parse; value = UCHARAT(PL_regcomp_parse++); if (value == '[') namedclass = regpposixcc(value); @@ -2348,10 +2918,15 @@ S_regclass(pTHX) case 't': value = '\t'; break; case 'f': value = '\f'; break; case 'b': value = '\b'; break; +#ifdef ASCIIish case 'e': value = '\033'; break; case 'a': value = '\007'; break; +#else + case 'e': value = '\047'; break; + case 'a': value = '\057'; break; +#endif case 'x': - value = scan_hex(PL_regcomp_parse, 2, &numlen); + value = (UV)scan_hex(PL_regcomp_parse, 2, &numlen); PL_regcomp_parse += numlen; break; case 'c': @@ -2360,269 +2935,320 @@ S_regclass(pTHX) break; case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': - value = scan_oct(--PL_regcomp_parse, 3, &numlen); + value = (UV)scan_oct(--PL_regcomp_parse, 3, &numlen); PL_regcomp_parse += numlen; break; + default: + if (!SIZE_ONLY && ckWARN(WARN_UNSAFE) && isALPHA(value)) + Perl_warner(aTHX_ WARN_UNSAFE, + "/%.127s/: Unrecognized escape \\%c in character class passed through", + PL_regprecomp, + (int)value); + break; } } - if (!SIZE_ONLY && namedclass > OOB_NAMEDCLASS) { - if (range) - FAIL("invalid [] range in regexp"); /* [a-\w], [a-[:word:]] */ - switch (namedclass) { - case ANYOF_ALNUM: - if (LOC) - ANYOF_CLASS_SET(opnd, ANYOF_ALNUM); - else { - for (value = 0; value < 256; value++) - if (isALNUM(value)) - ANYOF_BITMAP_SET(opnd, value); - } - break; - case ANYOF_NALNUM: - if (LOC) - ANYOF_CLASS_SET(opnd, ANYOF_NALNUM); - else { - for (value = 0; value < 256; value++) - if (!isALNUM(value)) - ANYOF_BITMAP_SET(opnd, value); - } - break; - case ANYOF_SPACE: - if (LOC) - ANYOF_CLASS_SET(opnd, ANYOF_SPACE); - else { - for (value = 0; value < 256; value++) - if (isSPACE(value)) - ANYOF_BITMAP_SET(opnd, value); - } - break; - case ANYOF_NSPACE: - if (LOC) - ANYOF_CLASS_SET(opnd, ANYOF_NSPACE); - else { - for (value = 0; value < 256; value++) - if (!isSPACE(value)) - ANYOF_BITMAP_SET(opnd, value); - } - break; - case ANYOF_DIGIT: - if (LOC) - ANYOF_CLASS_SET(opnd, ANYOF_DIGIT); - else { - for (value = '0'; value <= '9'; value++) - ANYOF_BITMAP_SET(opnd, value); - } - break; - case ANYOF_NDIGIT: - if (LOC) - ANYOF_CLASS_SET(opnd, ANYOF_NDIGIT); - else { - for (value = 0; value < '0'; value++) - ANYOF_BITMAP_SET(opnd, value); - for (value = '9' + 1; value < 256; value++) - ANYOF_BITMAP_SET(opnd, value); - } - break; - case ANYOF_NALNUMC: - if (LOC) - ANYOF_CLASS_SET(opnd, ANYOF_NALNUMC); - else { - for (value = 0; value < 256; value++) - if (!isALNUMC(value)) - ANYOF_BITMAP_SET(opnd, value); - } - break; - case ANYOF_ALNUMC: - if (LOC) - ANYOF_CLASS_SET(opnd, ANYOF_ALNUMC); - else { - for (value = 0; value < 256; value++) - if (isALNUMC(value)) - ANYOF_BITMAP_SET(opnd, value); - } - break; - case ANYOF_ALPHA: - if (LOC) - ANYOF_CLASS_SET(opnd, ANYOF_ALPHA); - else { - for (value = 0; value < 256; value++) - if (isALPHA(value)) - ANYOF_BITMAP_SET(opnd, value); - } - break; - case ANYOF_NALPHA: - if (LOC) - ANYOF_CLASS_SET(opnd, ANYOF_NALPHA); - else { - for (value = 0; value < 256; value++) - if (!isALPHA(value)) - ANYOF_BITMAP_SET(opnd, value); - } - break; - case ANYOF_ASCII: - if (LOC) - ANYOF_CLASS_SET(opnd, ANYOF_ASCII); - else { - for (value = 0; value < 128; value++) - ANYOF_BITMAP_SET(opnd, value); - } - break; - case ANYOF_NASCII: - if (LOC) - ANYOF_CLASS_SET(opnd, ANYOF_NASCII); - else { - for (value = 128; value < 256; value++) - ANYOF_BITMAP_SET(opnd, value); - } - break; - case ANYOF_CNTRL: - if (LOC) - ANYOF_CLASS_SET(opnd, ANYOF_CNTRL); - else { - for (value = 0; value < 256; value++) - if (isCNTRL(value)) - ANYOF_BITMAP_SET(opnd, value); - } - lastvalue = OOB_CHAR8; - break; - case ANYOF_NCNTRL: - if (LOC) - ANYOF_CLASS_SET(opnd, ANYOF_NCNTRL); - else { - for (value = 0; value < 256; value++) - if (!isCNTRL(value)) - ANYOF_BITMAP_SET(opnd, value); - } - break; - case ANYOF_GRAPH: - if (LOC) - ANYOF_CLASS_SET(opnd, ANYOF_GRAPH); - else { - for (value = 0; value < 256; value++) - if (isGRAPH(value)) - ANYOF_BITMAP_SET(opnd, value); - } - break; - case ANYOF_NGRAPH: - if (LOC) - ANYOF_CLASS_SET(opnd, ANYOF_NGRAPH); - else { - for (value = 0; value < 256; value++) - if (!isGRAPH(value)) - ANYOF_BITMAP_SET(opnd, value); - } - break; - case ANYOF_LOWER: - if (LOC) - ANYOF_CLASS_SET(opnd, ANYOF_LOWER); - else { - for (value = 0; value < 256; value++) - if (isLOWER(value)) - ANYOF_BITMAP_SET(opnd, value); - } - break; - case ANYOF_NLOWER: - if (LOC) - ANYOF_CLASS_SET(opnd, ANYOF_NLOWER); - else { - for (value = 0; value < 256; value++) - if (!isLOWER(value)) - ANYOF_BITMAP_SET(opnd, value); - } - break; - case ANYOF_PRINT: - if (LOC) - ANYOF_CLASS_SET(opnd, ANYOF_PRINT); - else { - for (value = 0; value < 256; value++) - if (isPRINT(value)) - ANYOF_BITMAP_SET(opnd, value); - } - break; - case ANYOF_NPRINT: - if (LOC) - ANYOF_CLASS_SET(opnd, ANYOF_NPRINT); - else { - for (value = 0; value < 256; value++) - if (!isPRINT(value)) - ANYOF_BITMAP_SET(opnd, value); - } - break; - case ANYOF_PUNCT: - if (LOC) - ANYOF_CLASS_SET(opnd, ANYOF_PUNCT); - else { - for (value = 0; value < 256; value++) - if (isPUNCT(value)) - ANYOF_BITMAP_SET(opnd, value); - } - break; - case ANYOF_NPUNCT: - if (LOC) - ANYOF_CLASS_SET(opnd, ANYOF_NPUNCT); - else { - for (value = 0; value < 256; value++) - if (!isPUNCT(value)) - ANYOF_BITMAP_SET(opnd, value); - } - break; - case ANYOF_UPPER: - if (LOC) - ANYOF_CLASS_SET(opnd, ANYOF_UPPER); - else { - for (value = 0; value < 256; value++) - if (isUPPER(value)) - ANYOF_BITMAP_SET(opnd, value); - } - break; - case ANYOF_NUPPER: - if (LOC) - ANYOF_CLASS_SET(opnd, ANYOF_NUPPER); - else { - for (value = 0; value < 256; value++) - if (!isUPPER(value)) - ANYOF_BITMAP_SET(opnd, value); + if (namedclass > OOB_NAMEDCLASS) { + if (!need_class && !SIZE_ONLY) + ANYOF_CLASS_ZERO(ret); + need_class = 1; + if (range) { /* a-\d, a-[:digit:] */ + if (!SIZE_ONLY) { + if (ckWARN(WARN_UNSAFE)) + Perl_warner(aTHX_ WARN_UNSAFE, + "/%.127s/: false [] range \"%*.*s\" in regexp", + PL_regprecomp, + PL_regcomp_parse - rangebegin, + PL_regcomp_parse - rangebegin, + rangebegin); + ANYOF_BITMAP_SET(ret, lastvalue); + ANYOF_BITMAP_SET(ret, '-'); } - break; - case ANYOF_XDIGIT: - if (LOC) - ANYOF_CLASS_SET(opnd, ANYOF_XDIGIT); - else { - for (value = 0; value < 256; value++) - if (isXDIGIT(value)) - ANYOF_BITMAP_SET(opnd, value); + range = 0; /* this is not a true range */ + } + if (!SIZE_ONLY) { + switch (namedclass) { + case ANYOF_ALNUM: + if (LOC) + ANYOF_CLASS_SET(ret, ANYOF_ALNUM); + else { + for (value = 0; value < 256; value++) + if (isALNUM(value)) + ANYOF_BITMAP_SET(ret, value); + } + break; + case ANYOF_NALNUM: + if (LOC) + ANYOF_CLASS_SET(ret, ANYOF_NALNUM); + else { + for (value = 0; value < 256; value++) + if (!isALNUM(value)) + ANYOF_BITMAP_SET(ret, value); + } + break; + case ANYOF_SPACE: + if (LOC) + ANYOF_CLASS_SET(ret, ANYOF_SPACE); + else { + for (value = 0; value < 256; value++) + if (isSPACE(value)) + ANYOF_BITMAP_SET(ret, value); + } + break; + case ANYOF_NSPACE: + if (LOC) + ANYOF_CLASS_SET(ret, ANYOF_NSPACE); + else { + for (value = 0; value < 256; value++) + if (!isSPACE(value)) + ANYOF_BITMAP_SET(ret, value); + } + break; + case ANYOF_DIGIT: + if (LOC) + ANYOF_CLASS_SET(ret, ANYOF_DIGIT); + else { + for (value = '0'; value <= '9'; value++) + ANYOF_BITMAP_SET(ret, value); + } + break; + case ANYOF_NDIGIT: + if (LOC) + ANYOF_CLASS_SET(ret, ANYOF_NDIGIT); + else { + for (value = 0; value < '0'; value++) + ANYOF_BITMAP_SET(ret, value); + for (value = '9' + 1; value < 256; value++) + ANYOF_BITMAP_SET(ret, value); + } + break; + case ANYOF_NALNUMC: + if (LOC) + ANYOF_CLASS_SET(ret, ANYOF_NALNUMC); + else { + for (value = 0; value < 256; value++) + if (!isALNUMC(value)) + ANYOF_BITMAP_SET(ret, value); + } + break; + case ANYOF_ALNUMC: + if (LOC) + ANYOF_CLASS_SET(ret, ANYOF_ALNUMC); + else { + for (value = 0; value < 256; value++) + if (isALNUMC(value)) + ANYOF_BITMAP_SET(ret, value); + } + break; + case ANYOF_ALPHA: + if (LOC) + ANYOF_CLASS_SET(ret, ANYOF_ALPHA); + else { + for (value = 0; value < 256; value++) + if (isALPHA(value)) + ANYOF_BITMAP_SET(ret, value); + } + break; + case ANYOF_NALPHA: + if (LOC) + ANYOF_CLASS_SET(ret, ANYOF_NALPHA); + else { + for (value = 0; value < 256; value++) + if (!isALPHA(value)) + ANYOF_BITMAP_SET(ret, value); + } + break; + case ANYOF_ASCII: + if (LOC) + ANYOF_CLASS_SET(ret, ANYOF_ASCII); + else { +#ifdef ASCIIish + for (value = 0; value < 128; value++) + ANYOF_BITMAP_SET(ret, value); +#else /* EBCDIC */ + for (value = 0; value < 256; value++) + if (isASCII(value)) + ANYOF_BITMAP_SET(ret, value); +#endif /* EBCDIC */ + } + break; + case ANYOF_NASCII: + if (LOC) + ANYOF_CLASS_SET(ret, ANYOF_NASCII); + else { +#ifdef ASCIIish + for (value = 128; value < 256; value++) + ANYOF_BITMAP_SET(ret, value); +#else /* EBCDIC */ + for (value = 0; value < 256; value++) + if (!isASCII(value)) + ANYOF_BITMAP_SET(ret, value); +#endif /* EBCDIC */ + } + break; + case ANYOF_CNTRL: + if (LOC) + ANYOF_CLASS_SET(ret, ANYOF_CNTRL); + else { + for (value = 0; value < 256; value++) + if (isCNTRL(value)) + ANYOF_BITMAP_SET(ret, value); + } + lastvalue = OOB_CHAR8; + break; + case ANYOF_NCNTRL: + if (LOC) + ANYOF_CLASS_SET(ret, ANYOF_NCNTRL); + else { + for (value = 0; value < 256; value++) + if (!isCNTRL(value)) + ANYOF_BITMAP_SET(ret, value); + } + break; + case ANYOF_GRAPH: + if (LOC) + ANYOF_CLASS_SET(ret, ANYOF_GRAPH); + else { + for (value = 0; value < 256; value++) + if (isGRAPH(value)) + ANYOF_BITMAP_SET(ret, value); + } + break; + case ANYOF_NGRAPH: + if (LOC) + ANYOF_CLASS_SET(ret, ANYOF_NGRAPH); + else { + for (value = 0; value < 256; value++) + if (!isGRAPH(value)) + ANYOF_BITMAP_SET(ret, value); + } + break; + case ANYOF_LOWER: + if (LOC) + ANYOF_CLASS_SET(ret, ANYOF_LOWER); + else { + for (value = 0; value < 256; value++) + if (isLOWER(value)) + ANYOF_BITMAP_SET(ret, value); + } + break; + case ANYOF_NLOWER: + if (LOC) + ANYOF_CLASS_SET(ret, ANYOF_NLOWER); + else { + for (value = 0; value < 256; value++) + if (!isLOWER(value)) + ANYOF_BITMAP_SET(ret, value); + } + break; + case ANYOF_PRINT: + if (LOC) + ANYOF_CLASS_SET(ret, ANYOF_PRINT); + else { + for (value = 0; value < 256; value++) + if (isPRINT(value)) + ANYOF_BITMAP_SET(ret, value); + } + break; + case ANYOF_NPRINT: + if (LOC) + ANYOF_CLASS_SET(ret, ANYOF_NPRINT); + else { + for (value = 0; value < 256; value++) + if (!isPRINT(value)) + ANYOF_BITMAP_SET(ret, value); + } + break; + case ANYOF_PUNCT: + if (LOC) + ANYOF_CLASS_SET(ret, ANYOF_PUNCT); + else { + for (value = 0; value < 256; value++) + if (isPUNCT(value)) + ANYOF_BITMAP_SET(ret, value); + } + break; + case ANYOF_NPUNCT: + if (LOC) + ANYOF_CLASS_SET(ret, ANYOF_NPUNCT); + else { + for (value = 0; value < 256; value++) + if (!isPUNCT(value)) + ANYOF_BITMAP_SET(ret, value); + } + break; + case ANYOF_UPPER: + if (LOC) + ANYOF_CLASS_SET(ret, ANYOF_UPPER); + else { + for (value = 0; value < 256; value++) + if (isUPPER(value)) + ANYOF_BITMAP_SET(ret, value); + } + break; + case ANYOF_NUPPER: + if (LOC) + ANYOF_CLASS_SET(ret, ANYOF_NUPPER); + else { + for (value = 0; value < 256; value++) + if (!isUPPER(value)) + ANYOF_BITMAP_SET(ret, value); + } + break; + case ANYOF_XDIGIT: + if (LOC) + ANYOF_CLASS_SET(ret, ANYOF_XDIGIT); + else { + for (value = 0; value < 256; value++) + if (isXDIGIT(value)) + ANYOF_BITMAP_SET(ret, value); + } + break; + case ANYOF_NXDIGIT: + if (LOC) + ANYOF_CLASS_SET(ret, ANYOF_NXDIGIT); + else { + for (value = 0; value < 256; value++) + if (!isXDIGIT(value)) + ANYOF_BITMAP_SET(ret, value); + } + break; + default: + FAIL("invalid [::] class in regexp"); + break; } - break; - case ANYOF_NXDIGIT: if (LOC) - ANYOF_CLASS_SET(opnd, ANYOF_NXDIGIT); - else { - for (value = 0; value < 256; value++) - if (!isXDIGIT(value)) - ANYOF_BITMAP_SET(opnd, value); - } - break; - default: - FAIL("invalid [::] class in regexp"); - break; + ANYOF_FLAGS(ret) |= ANYOF_CLASS; + continue; } - if (LOC) - ANYOF_FLAGS(opnd) |= ANYOF_CLASS; - continue; } if (range) { - if (lastvalue > value) - FAIL("invalid [] range in regexp"); /* [b-a] */ + if (lastvalue > value) /* b-a */ { + Perl_croak(aTHX_ + "/%.127s/: invalid [] range \"%*.*s\" in regexp", + PL_regprecomp, + PL_regcomp_parse - rangebegin, + PL_regcomp_parse - rangebegin, + rangebegin); + } range = 0; } else { lastvalue = value; if (*PL_regcomp_parse == '-' && PL_regcomp_parse+1 < PL_regxend && PL_regcomp_parse[1] != ']') { - if (namedclass > OOB_NAMEDCLASS) - FAIL("invalid [] range in regexp"); /* [\w-a] */ PL_regcomp_parse++; - range = 1; + if (namedclass > OOB_NAMEDCLASS) { /* \w-, [:word:]- */ + if (ckWARN(WARN_UNSAFE)) + Perl_warner(aTHX_ WARN_UNSAFE, + "/%.127s/: false [] range \"%*.*s\" in regexp", + PL_regprecomp, + PL_regcomp_parse - rangebegin, + PL_regcomp_parse - rangebegin, + rangebegin); + if (!SIZE_ONLY) + ANYOF_BITMAP_SET(ret, '-'); + } else + range = 1; continue; /* do it next time */ } } @@ -2636,36 +3262,42 @@ S_regclass(pTHX) if (isLOWER(lastvalue)) { for (i = lastvalue; i <= value; i++) if (isLOWER(i)) - ANYOF_BITMAP_SET(opnd, i); + ANYOF_BITMAP_SET(ret, i); } else { for (i = lastvalue; i <= value; i++) if (isUPPER(i)) - ANYOF_BITMAP_SET(opnd, i); + ANYOF_BITMAP_SET(ret, i); } } else #endif for ( ; lastvalue <= value; lastvalue++) - ANYOF_BITMAP_SET(opnd, lastvalue); + ANYOF_BITMAP_SET(ret, lastvalue); } range = 0; } + if (need_class) { + if (SIZE_ONLY) + PL_regsize += ANYOF_CLASS_ADD_SKIP; + else + PL_regcode += ANYOF_CLASS_ADD_SKIP; + } /* optimize case-insensitive simple patterns (e.g. /[a-z]/i) */ if (!SIZE_ONLY && - (ANYOF_FLAGS(opnd) & (ANYOF_FLAGS_ALL ^ ANYOF_INVERT)) == ANYOF_FOLD) { + (ANYOF_FLAGS(ret) & (ANYOF_FLAGS_ALL ^ ANYOF_INVERT)) == ANYOF_FOLD) { for (value = 0; value < 256; ++value) { - if (ANYOF_BITMAP_TEST(opnd, value)) { + if (ANYOF_BITMAP_TEST(ret, value)) { I32 cf = PL_fold[value]; - ANYOF_BITMAP_SET(opnd, cf); + ANYOF_BITMAP_SET(ret, cf); } } - ANYOF_FLAGS(opnd) &= ~ANYOF_FOLD; + ANYOF_FLAGS(ret) &= ~ANYOF_FOLD; } /* optimize inverted simple patterns (e.g. [^a-z]) */ - if (!SIZE_ONLY && (ANYOF_FLAGS(opnd) & ANYOF_FLAGS_ALL) == ANYOF_INVERT) { + if (!SIZE_ONLY && (ANYOF_FLAGS(ret) & ANYOF_FLAGS_ALL) == ANYOF_INVERT) { for (value = 0; value < ANYOF_BITMAP_SIZE; ++value) - opnd[ANYOF_BITMAP_OFFSET + value] ^= ANYOF_FLAGS_ALL; - ANYOF_FLAGS(opnd) = 0; + ANYOF_BITMAP(ret)[value] ^= ANYOF_FLAGS_ALL; + ANYOF_FLAGS(ret) = 0; } return ret; } @@ -2674,8 +3306,8 @@ STATIC regnode * S_regclassutf8(pTHX) { dTHR; - register char *opnd, *e; - register U32 value; + register char *e; + register UV value; register U32 lastvalue = OOB_UTF8; register I32 range = 0; register regnode *ret; @@ -2684,6 +3316,7 @@ S_regclassutf8(pTHX) SV *listsv; U8 flags = 0; I32 namedclass; + char *rangebegin; if (*PL_regcomp_parse == '^') { /* Complement of range. */ PL_regnaughty++; @@ -2699,7 +3332,8 @@ S_regclassutf8(pTHX) listsv = newSVpvn("# comment\n",10); } - checkposixcc(); + if (!SIZE_ONLY && ckWARN(WARN_UNSAFE)) + checkposixcc(); if (*PL_regcomp_parse == ']' || *PL_regcomp_parse == '-') goto skipcond; /* allow 1st char to be ] or - */ @@ -2707,9 +3341,10 @@ S_regclassutf8(pTHX) while (PL_regcomp_parse < PL_regxend && *PL_regcomp_parse != ']') { skipcond: namedclass = OOB_NAMEDCLASS; + if (!range) + rangebegin = PL_regcomp_parse; value = utf8_to_uv((U8*)PL_regcomp_parse, &numlen); PL_regcomp_parse += numlen; - if (value == '[') namedclass = regpposixcc(value); else if (value == '\\') { @@ -2750,20 +3385,25 @@ S_regclassutf8(pTHX) case 't': value = '\t'; break; case 'f': value = '\f'; break; case 'b': value = '\b'; break; +#ifdef ASCIIish case 'e': value = '\033'; break; case 'a': value = '\007'; break; +#else + case 'e': value = '\047'; break; + case 'a': value = '\057'; break; +#endif case 'x': if (*PL_regcomp_parse == '{') { e = strchr(PL_regcomp_parse++, '}'); if (!e) FAIL("Missing right brace on \\x{}"); - value = scan_hex(PL_regcomp_parse, + value = (UV)scan_hex(PL_regcomp_parse, e - PL_regcomp_parse, &numlen); PL_regcomp_parse = e + 1; } else { - value = scan_hex(PL_regcomp_parse, 2, &numlen); + value = (UV)scan_hex(PL_regcomp_parse, 2, &numlen); PL_regcomp_parse += numlen; } break; @@ -2773,101 +3413,129 @@ S_regclassutf8(pTHX) break; case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': - value = scan_oct(--PL_regcomp_parse, 3, &numlen); + value = (UV)scan_oct(--PL_regcomp_parse, 3, &numlen); PL_regcomp_parse += numlen; break; + default: + if (!SIZE_ONLY && ckWARN(WARN_UNSAFE) && isALPHA(value)) + Perl_warner(aTHX_ WARN_UNSAFE, + "/%.127s/: Unrecognized escape \\%c in character class passed through", + PL_regprecomp, + (int)value); + break; } } - if (!SIZE_ONLY && namedclass > OOB_NAMEDCLASS) { - if (range) - FAIL("invalid [] range in regexp"); /* [a-\w], [a-[:word:]] */ - switch (namedclass) { - case ANYOF_ALNUM: - Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsWord\n"); break; - case ANYOF_NALNUM: - Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsWord\n"); break; - case ANYOF_ALNUMC: - Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsAlnum\n"); break; - case ANYOF_NALNUMC: - Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsAlnum\n"); break; - case ANYOF_ALPHA: - Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsAlpha\n"); break; - case ANYOF_NALPHA: - Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsAlpha\n"); break; - case ANYOF_ASCII: - Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsASCII\n"); break; - case ANYOF_NASCII: - Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsASCII\n"); break; - case ANYOF_CNTRL: - Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsCntrl\n"); break; - case ANYOF_NCNTRL: - Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsCntrl\n"); break; - case ANYOF_GRAPH: - Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsGraph\n"); break; - case ANYOF_NGRAPH: - Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsGraph\n"); break; - case ANYOF_DIGIT: - Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsDigit\n"); break; - case ANYOF_NDIGIT: - Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsDigit\n"); break; - case ANYOF_LOWER: - Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsLower\n"); break; - case ANYOF_NLOWER: - Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsLower\n"); break; - case ANYOF_PRINT: - Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsPrint\n"); break; - case ANYOF_NPRINT: - Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsPrint\n"); break; - case ANYOF_PUNCT: - Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsPunct\n"); break; - case ANYOF_NPUNCT: - Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsPunct\n"); break; - case ANYOF_SPACE: - Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsSpace\n"); break; - case ANYOF_NSPACE: - Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsSpace\n"); break; - case ANYOF_UPPER: - Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsUpper\n"); break; - case ANYOF_NUPPER: - Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsUpper\n"); break; - case ANYOF_XDIGIT: - Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsXDigit\n"); break; - case ANYOF_NXDIGIT: - Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsXDigit\n"); break; + if (namedclass > OOB_NAMEDCLASS) { + if (range) { /* a-\d, a-[:digit:] */ + if (!SIZE_ONLY) { + if (ckWARN(WARN_UNSAFE)) + Perl_warner(aTHX_ WARN_UNSAFE, + "/%.127s/: false [] range \"%*.*s\" in regexp", + PL_regprecomp, + PL_regcomp_parse - rangebegin, + PL_regcomp_parse - rangebegin, + rangebegin); + Perl_sv_catpvf(aTHX_ listsv, + /* 0x002D is Unicode for '-' */ + "%04"UVxf"\n002D\n", (UV)lastvalue); + } + range = 0; + } + if (!SIZE_ONLY) { + switch (namedclass) { + case ANYOF_ALNUM: + Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsWord\n"); break; + case ANYOF_NALNUM: + Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsWord\n"); break; + case ANYOF_ALNUMC: + Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsAlnum\n"); break; + case ANYOF_NALNUMC: + Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsAlnum\n"); break; + case ANYOF_ALPHA: + Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsAlpha\n"); break; + case ANYOF_NALPHA: + Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsAlpha\n"); break; + case ANYOF_ASCII: + Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsASCII\n"); break; + case ANYOF_NASCII: + Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsASCII\n"); break; + case ANYOF_CNTRL: + Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsCntrl\n"); break; + case ANYOF_NCNTRL: + Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsCntrl\n"); break; + case ANYOF_GRAPH: + Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsGraph\n"); break; + case ANYOF_NGRAPH: + Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsGraph\n"); break; + case ANYOF_DIGIT: + Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsDigit\n"); break; + case ANYOF_NDIGIT: + Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsDigit\n"); break; + case ANYOF_LOWER: + Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsLower\n"); break; + case ANYOF_NLOWER: + Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsLower\n"); break; + case ANYOF_PRINT: + Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsPrint\n"); break; + case ANYOF_NPRINT: + Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsPrint\n"); break; + case ANYOF_PUNCT: + Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsPunct\n"); break; + case ANYOF_NPUNCT: + Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsPunct\n"); break; + case ANYOF_SPACE: + Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsSpace\n"); break; + case ANYOF_NSPACE: + Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsSpace\n"); break; + case ANYOF_UPPER: + Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsUpper\n"); break; + case ANYOF_NUPPER: + Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsUpper\n"); break; + case ANYOF_XDIGIT: + Perl_sv_catpvf(aTHX_ listsv, "+utf8::IsXDigit\n"); break; + case ANYOF_NXDIGIT: + Perl_sv_catpvf(aTHX_ listsv, "!utf8::IsXDigit\n"); break; + } + continue; } - continue; } if (range) { - if (lastvalue > value) - FAIL("invalid [] range in regexp"); /* [b-a] */ -#ifdef UV_IS_QUAD - if (!SIZE_ONLY) - Perl_sv_catpvf(aTHX_ listsv, "%04" PERL_PRIx64 "\t%04" PERL_PRIx64 "\n", (UV)lastvalue, (UV)value); -#else - if (!SIZE_ONLY) - Perl_sv_catpvf(aTHX_ listsv, "%04x\t%04x\n", lastvalue, value); -#endif + if (lastvalue > value) { /* b-a */ + Perl_croak(aTHX_ + "/%.127s/: invalid [] range \"%*.*s\" in regexp", + PL_regprecomp, + PL_regcomp_parse - rangebegin, + PL_regcomp_parse - rangebegin, + rangebegin); + } range = 0; } else { lastvalue = value; if (*PL_regcomp_parse == '-' && PL_regcomp_parse+1 < PL_regxend && PL_regcomp_parse[1] != ']') { - if (namedclass > OOB_NAMEDCLASS) - FAIL("invalid [] range in regexp"); /* [\w-a] */ PL_regcomp_parse++; - range = 1; + if (namedclass > OOB_NAMEDCLASS) { /* \w-, [:word:]- */ + if (ckWARN(WARN_UNSAFE)) + Perl_warner(aTHX_ WARN_UNSAFE, + "/%.127s/: false [] range \"%*.*s\" in regexp", + PL_regprecomp, + PL_regcomp_parse - rangebegin, + PL_regcomp_parse - rangebegin, + rangebegin); + if (!SIZE_ONLY) + Perl_sv_catpvf(aTHX_ listsv, + /* 0x002D is Unicode for '-' */ + "002D\n"); + } else + range = 1; continue; /* do it next time */ } } /* now is the next time */ -#ifdef UV_IS_QUAD - if (!SIZE_ONLY) - Perl_sv_catpvf(aTHX_ listsv, "%04" PERL_PRIx64 "\n", (UV)value); -#else if (!SIZE_ONLY) - Perl_sv_catpvf(aTHX_ listsv, "%04x\n", value); -#endif + Perl_sv_catpvf(aTHX_ listsv, "%04"UVxf"\t%04"UVxf"\n", + (UV)lastvalue, (UV)value); range = 0; } @@ -3106,12 +3774,12 @@ S_dumpuntil(pTHX_ regnode *start, regnode *node, regnode *last, SV* sv, I32 l) if (OP(node) == OPTIMIZED) goto after_print; regprop(sv, node); - PerlIO_printf(Perl_debug_log, "%4d:%*s%s", node - start, - 2*l + 1, "", SvPVX(sv)); + PerlIO_printf(Perl_debug_log, "%4"IVdf":%*s%s", (IV)(node - start), + (int)(2*l + 1), "", SvPVX(sv)); if (next == NULL) /* Next ptr. */ PerlIO_printf(Perl_debug_log, "(0)"); else - PerlIO_printf(Perl_debug_log, "(%d)", next - start); + PerlIO_printf(Perl_debug_log, "(%"IVdf")", (IV)(next - start)); (void)PerlIO_putc(Perl_debug_log, '\n'); after_print: if (PL_regkind[(U8)op] == BRANCHJ) { @@ -3138,7 +3806,7 @@ S_dumpuntil(pTHX_ regnode *start, regnode *node, regnode *last, SV* sv, I32 l) } else if (op == ANYOF) { node = NEXTOPER(node); - node += ANY_SKIP; + node += ANYOF_SKIP; } else if (PL_regkind[(U8)op] == EXACT) { /* Literal string, where present. */ @@ -3172,21 +3840,23 @@ Perl_regdump(pTHX_ regexp *r) /* Header fields of interest. */ if (r->anchored_substr) - PerlIO_printf(Perl_debug_log, "anchored `%s%.*s%s'%s at %d ", + PerlIO_printf(Perl_debug_log, + "anchored `%s%.*s%s'%s at %"IVdf" ", PL_colors[0], - SvCUR(r->anchored_substr) - (SvTAIL(r->anchored_substr)!=0), + (int)(SvCUR(r->anchored_substr) - (SvTAIL(r->anchored_substr)!=0)), SvPVX(r->anchored_substr), PL_colors[1], SvTAIL(r->anchored_substr) ? "$" : "", - r->anchored_offset); + (IV)r->anchored_offset); if (r->float_substr) - PerlIO_printf(Perl_debug_log, "floating `%s%.*s%s'%s at %d..%u ", + PerlIO_printf(Perl_debug_log, + "floating `%s%.*s%s'%s at %"IVdf"..%"UVuf" ", PL_colors[0], - SvCUR(r->float_substr) - (SvTAIL(r->float_substr)!=0), + (int)(SvCUR(r->float_substr) - (SvTAIL(r->float_substr)!=0)), SvPVX(r->float_substr), PL_colors[1], SvTAIL(r->float_substr) ? "$" : "", - r->float_min_offset, r->float_max_offset); + (IV)r->float_min_offset, (UV)r->float_max_offset); if (r->check_substr) PerlIO_printf(Perl_debug_log, r->check_substr == r->float_substr @@ -3227,6 +3897,17 @@ Perl_regdump(pTHX_ regexp *r) #endif /* DEBUGGING */ } +STATIC void +S_put_byte(pTHX_ SV *sv, int c) +{ + if (c <= ' ' || c == 127 || c == 255) + Perl_sv_catpvf(aTHX_ sv, "\\%o", c); + else if (c == '-' || c == ']' || c == '\\' || c == '^') + Perl_sv_catpvf(aTHX_ sv, "\\%c", c); + else + Perl_sv_catpvf(aTHX_ sv, "%c", c); +} + /* - regprop - printable representation of opcode */ @@ -3258,6 +3939,67 @@ Perl_regprop(pTHX_ SV *sv, regnode *o) Perl_sv_catpvf(aTHX_ sv, "%d", ARG(o)); /* Parenth number */ else if (k == LOGICAL) Perl_sv_catpvf(aTHX_ sv, "[%d]", o->flags); /* 2: embedded, otherwise 1 */ + else if (k == ANYOF) { + int i, rangestart = -1; + const char * const out[] = { /* Should be syncronized with + a table in regcomp.h */ + "\\w", + "\\W", + "\\s", + "\\S", + "\\d", + "\\D", + "[:alnum:]", + "[:^alnum:]", + "[:alpha:]", + "[:^alpha:]", + "[:ascii:]", + "[:^ascii:]", + "[:ctrl:]", + "[:^ctrl:]", + "[:graph:]", + "[:^graph:]", + "[:lower:]", + "[:^lower:]", + "[:print:]", + "[:^print:]", + "[:punct:]", + "[:^punct:]", + "[:upper:]", + "[:!upper:]", + "[:xdigit:]", + "[:^xdigit:]" + }; + + if (o->flags & ANYOF_LOCALE) + sv_catpv(sv, "{loc}"); + if (o->flags & ANYOF_FOLD) + sv_catpv(sv, "{i}"); + Perl_sv_catpvf(aTHX_ sv, "[%s", PL_colors[0]); + if (o->flags & ANYOF_INVERT) + sv_catpv(sv, "^"); + for (i = 0; i <= 256; i++) { + if (i < 256 && ANYOF_BITMAP_TEST(o,i)) { + if (rangestart == -1) + rangestart = i; + } else if (rangestart != -1) { + if (i <= rangestart + 3) + for (; rangestart < i; rangestart++) + put_byte(sv, rangestart); + else { + put_byte(sv, rangestart); + sv_catpv(sv, "-"); + put_byte(sv, i - 1); + } + rangestart = -1; + } + } + if (o->flags & ANYOF_CLASS) + for (i = 0; i < sizeof(out)/sizeof(char*); i++) + if (ANYOF_CLASS_TEST(o,i)) + sv_catpv(sv, out[i]); + Perl_sv_catpvf(aTHX_ sv, "%s]", PL_colors[1]); + } else if (k == BRANCHJ && (OP(o) == UNLESSM || OP(o) == IFMATCH)) Perl_sv_catpvf(aTHX_ sv, "[-%d]", o->flags); #endif /* DEBUGGING */ @@ -3319,6 +4061,9 @@ Perl_pregfree(pTHX_ struct regexp *r) case 's': SvREFCNT_dec((SV*)r->data->data[n]); break; + case 'f': + Safefree(r->data->data[n]); + break; case 'p': new_comppad = (AV*)r->data->data[n]; break; @@ -3419,46 +4164,45 @@ Perl_save_re_context(pTHX) SAVEPPTR(PL_reginput); /* String-input pointer. */ SAVEPPTR(PL_regbol); /* Beginning of input, for ^ check. */ SAVEPPTR(PL_regeol); /* End of input, for $ check. */ - SAVESPTR(PL_regstartp); /* Pointer to startp array. */ - SAVESPTR(PL_regendp); /* Ditto for endp. */ - SAVESPTR(PL_reglastparen); /* Similarly for lastparen. */ + SAVEVPTR(PL_regstartp); /* Pointer to startp array. */ + SAVEVPTR(PL_regendp); /* Ditto for endp. */ + SAVEVPTR(PL_reglastparen); /* Similarly for lastparen. */ SAVEPPTR(PL_regtill); /* How far we are required to go. */ - SAVEI32(PL_regprev); /* char before regbol, \n if none */ - SAVESPTR(PL_reg_start_tmp); /* from regexec.c */ + SAVEI8(PL_regprev); /* char before regbol, \n if none */ + SAVEVPTR(PL_reg_start_tmp); /* from regexec.c */ PL_reg_start_tmp = 0; SAVEFREEPV(PL_reg_start_tmp); SAVEI32(PL_reg_start_tmpl); /* from regexec.c */ PL_reg_start_tmpl = 0; - SAVESPTR(PL_regdata); + SAVEVPTR(PL_regdata); SAVEI32(PL_reg_flags); /* from regexec.c */ SAVEI32(PL_reg_eval_set); /* from regexec.c */ SAVEI32(PL_regnarrate); /* from regexec.c */ - SAVESPTR(PL_regprogram); /* from regexec.c */ + SAVEVPTR(PL_regprogram); /* from regexec.c */ SAVEINT(PL_regindent); /* from regexec.c */ - SAVESPTR(PL_regcc); /* from regexec.c */ - SAVESPTR(PL_curcop); - SAVESPTR(PL_regcomp_rx); /* from regcomp.c */ + SAVEVPTR(PL_regcc); /* from regexec.c */ + SAVEVPTR(PL_curcop); + SAVEVPTR(PL_regcomp_rx); /* from regcomp.c */ SAVEI32(PL_regseen); /* from regcomp.c */ SAVEI32(PL_regsawback); /* Did we see \1, ...? */ SAVEI32(PL_regnaughty); /* How bad is this pattern? */ - SAVESPTR(PL_regcode); /* Code-emit pointer; ®dummy = don't */ + SAVEVPTR(PL_regcode); /* Code-emit pointer; ®dummy = don't */ SAVEPPTR(PL_regxend); /* End of input for compile */ SAVEPPTR(PL_regcomp_parse); /* Input-scan pointer. */ - SAVESPTR(PL_reg_call_cc); /* from regexec.c */ - SAVESPTR(PL_reg_re); /* from regexec.c */ + SAVEVPTR(PL_reg_call_cc); /* from regexec.c */ + SAVEVPTR(PL_reg_re); /* from regexec.c */ SAVEPPTR(PL_reg_ganch); /* from regexec.c */ SAVESPTR(PL_reg_sv); /* from regexec.c */ - SAVESPTR(PL_reg_magic); /* from regexec.c */ + SAVEVPTR(PL_reg_magic); /* from regexec.c */ SAVEI32(PL_reg_oldpos); /* from regexec.c */ - SAVESPTR(PL_reg_oldcurpm); /* from regexec.c */ - SAVESPTR(PL_reg_curpm); /* from regexec.c */ + SAVEVPTR(PL_reg_oldcurpm); /* from regexec.c */ + SAVEVPTR(PL_reg_curpm); /* from regexec.c */ #ifdef DEBUGGING SAVEPPTR(PL_reg_starttry); /* from regexec.c */ #endif } #ifdef PERL_OBJECT -#define NO_XSLOCKS #include "XSUB.h" #undef this #define this pPerl diff --git a/regcomp.h b/regcomp.h index e30c8e7..3624917 100644 --- a/regcomp.h +++ b/regcomp.h @@ -87,6 +87,24 @@ struct regnode_2 { U16 arg2; }; +#define ANYOF_BITMAP_SIZE 32 /* 256 b/(8 b/B) */ +#define ANYOF_CLASSBITMAP_SIZE 4 + +struct regnode_charclass { + U8 flags; + U8 type; + U16 next_off; + char bitmap[ANYOF_BITMAP_SIZE]; +}; + +struct regnode_charclass_class { + U8 flags; + U8 type; + U16 next_off; + char bitmap[ANYOF_BITMAP_SIZE]; + char classflags[ANYOF_CLASSBITMAP_SIZE]; +}; + /* XXX fix this description. Impose a limit of REG_INFTY on various pattern matching operations to limit stack growth and to avoid "infinite" recursions. @@ -160,14 +178,19 @@ struct regnode_2 { #define SIZE_ONLY (PL_regcode == &PL_regdummy) -/* Flags for first parameter byte [0] of ANYOF */ +/* Flags for node->flags of ANYOF */ #define ANYOF_CLASS 0x08 #define ANYOF_INVERT 0x04 #define ANYOF_FOLD 0x02 #define ANYOF_LOCALE 0x01 -/* Character classes for bytes [1..4] of ANYOF */ +/* Used for regstclass only */ +#define ANYOF_EOS 0x10 /* Can match an empty string too */ + +/* Character classes for node->classflags of ANYOF */ +/* Should be synchronized with a table in regprop() */ +/* 2n should pair with 2n+1 */ #define ANYOF_ALNUM 0 /* \w, utf8::IsWord, isALNUM() */ #define ANYOF_NALNUM 1 @@ -207,29 +230,31 @@ struct regnode_2 { /* Utility macros for the bitmap and classes of ANYOF */ -#define ANYOF_OPND_SIZE 1 -#define ANYOF_CLASS_SIZE 4 -#define ANYOF_BITMAP_SIZE 32 /* 256 b/(8 b/B) */ -#define ANYOF_SIZE (ANYOF_OPND_SIZE+ANYOF_CLASS_SIZE+ANYOF_BITMAP_SIZE) +#define ANYOF_SIZE (sizeof(struct regnode_charclass)) +#define ANYOF_CLASS_SIZE (sizeof(struct regnode_charclass_class)) -#define ANYOF_FLAGS(p) ((p)[0]) +#define ANYOF_FLAGS(p) ((p)->flags) #define ANYOF_FLAGS_ALL 0xff #define ANYOF_BIT(c) (1 << ((c) & 7)) -#define ANYOF_CLASS_OFFSET ANYOF_OPND_SIZE -#define ANYOF_CLASS_BYTE(p, c) ((p)[ANYOF_CLASS_OFFSET + (((c) >> 3) & 3)]) +#define ANYOF_CLASS_BYTE(p, c) (((struct regnode_charclass_class*)(p))->classflags[((c) >> 3) & 3]) #define ANYOF_CLASS_SET(p, c) (ANYOF_CLASS_BYTE(p, c) |= ANYOF_BIT(c)) #define ANYOF_CLASS_CLEAR(p, c) (ANYOF_CLASS_BYTE(p, c) &= ~ANYOF_BIT(c)) #define ANYOF_CLASS_TEST(p, c) (ANYOF_CLASS_BYTE(p, c) & ANYOF_BIT(c)) -#define ANYOF_BITMAP_OFFSET (ANYOF_CLASS_OFFSET+ANYOF_CLASS_SIZE) -#define ANYOF_BITMAP_BYTE(p, c) ((p)[ANYOF_BITMAP_OFFSET + (((c) >> 3) & 31)]) +#define ANYOF_CLASS_ZERO(ret) Zero(((struct regnode_charclass_class*)(ret))->classflags, ANYOF_CLASSBITMAP_SIZE, char) +#define ANYOF_BITMAP_ZERO(ret) Zero(((struct regnode_charclass*)(ret))->bitmap, ANYOF_BITMAP_SIZE, char) + +#define ANYOF_BITMAP(p) (((struct regnode_charclass*)(p))->bitmap) +#define ANYOF_BITMAP_BYTE(p, c) (ANYOF_BITMAP(p)[((c) >> 3) & 31]) #define ANYOF_BITMAP_SET(p, c) (ANYOF_BITMAP_BYTE(p, c) |= ANYOF_BIT(c)) #define ANYOF_BITMAP_CLEAR(p,c) (ANYOF_BITMAP_BYTE(p, c) &= ~ANYOF_BIT(c)) #define ANYOF_BITMAP_TEST(p, c) (ANYOF_BITMAP_BYTE(p, c) & ANYOF_BIT(c)) -#define ANY_SKIP ((ANYOF_SIZE - 1)/sizeof(regnode) + 1) +#define ANYOF_SKIP ((ANYOF_SIZE - 1)/sizeof(regnode)) +#define ANYOF_CLASS_SKIP ((ANYOF_CLASS_SIZE - 1)/sizeof(regnode)) +#define ANYOF_CLASS_ADD_SKIP (ANYOF_CLASS_SKIP - ANYOF_SKIP) /* * Utility definitions. @@ -247,14 +272,14 @@ struct regnode_2 { #define FAIL(m) \ STMT_START { \ if (!SIZE_ONLY) \ - SAVEDESTRUCTOR(clear_re,(void*)PL_regcomp_rx); \ + SAVEDESTRUCTOR_X(clear_re,(void*)PL_regcomp_rx); \ Perl_croak(aTHX_ "/%.127s/: %s", PL_regprecomp,m); \ } STMT_END #define FAIL2(pat,m) \ STMT_START { \ if (!SIZE_ONLY) \ - SAVEDESTRUCTOR(clear_re,(void*)PL_regcomp_rx); \ + SAVEDESTRUCTOR_X(clear_re,(void*)PL_regcomp_rx); \ S_re_croak2(aTHX_ "/%.127s/: ",pat,PL_regprecomp,m); \ } STMT_END diff --git a/regexec.c b/regexec.c index a567353..acdbd89 100644 --- a/regexec.c +++ b/regexec.c @@ -146,13 +146,13 @@ S_regcppush(pTHX_ I32 parenfloor) /* These are needed since we do not localize EVAL nodes: */ # define REGCP_SET DEBUG_r(PerlIO_printf(Perl_debug_log, \ - " Setting an EVAL scope, savestack=%i\n", \ - PL_savestack_ix)); lastcp = PL_savestack_ix + " Setting an EVAL scope, savestack=%"IVdf"\n", \ + (IV)PL_savestack_ix)); lastcp = PL_savestack_ix # define REGCP_UNWIND DEBUG_r(lastcp != PL_savestack_ix ? \ PerlIO_printf(Perl_debug_log, \ - " Clearing an EVAL scope, savestack=%i..%i\n", \ - lastcp, PL_savestack_ix) : 0); regcpblow(lastcp) + " Clearing an EVAL scope, savestack=%"IVdf"..%"IVdf"\n", \ + (IV)lastcp, (IV)PL_savestack_ix) : 0); regcpblow(lastcp) STATIC char * S_regcppop(pTHX) @@ -176,18 +176,18 @@ S_regcppop(pTHX) PL_regendp[paren] = tmps; DEBUG_r( PerlIO_printf(Perl_debug_log, - " restoring \\%d to %d(%d)..%d%s\n", - paren, PL_regstartp[paren], - PL_reg_start_tmp[paren] - PL_bostr, - PL_regendp[paren], + " restoring \\%"UVuf" to %"IVdf"(%"IVdf")..%"IVdf"%s\n", + (UV)paren, (IV)PL_regstartp[paren], + (IV)(PL_reg_start_tmp[paren] - PL_bostr), + (IV)PL_regendp[paren], (paren > *PL_reglastparen ? "(no)" : "")); ); } DEBUG_r( if (*PL_reglastparen + 1 <= PL_regnpar) { PerlIO_printf(Perl_debug_log, - " restoring \\%d..\\%d to undef\n", - *PL_reglastparen + 1, PL_regnpar); + " restoring \\%"IVdf"..\\%"IVdf" to undef\n", + (IV)(*PL_reglastparen + 1), (IV)PL_regnpar); } ); for (paren = *PL_reglastparen + 1; paren <= PL_regnpar; paren++) { @@ -275,6 +275,13 @@ S_cache_re(pTHX_ regexp *prog) /* XXXX We assume that strpos is strbeg unless sv. */ +/* XXXX Some places assume that there is a fixed substring. + An update may be needed if optimizer marks as "INTUITable" + RExen without fixed substrings. Similarly, it is assumed that + lengths of all the strings are no more than minlen, thus they + cannot come from lookahead. + (Or minlen should take into account lookahead.) */ + /* A failure to find a constant substring means that there is no need to make an expensive call to REx engine, thus we celebrate a failure. Similarly, finding a substring too deep into the string means that less calls to @@ -285,10 +292,14 @@ S_cache_re(pTHX_ regexp *prog) b) Fixed substring; c) Whether we are anchored (beginning-of-line or \G); d) First node (of those at offset 0) which may distingush positions; - We use 'a', 'b', multiline-part of 'c', and try to find a position in the + We use a)b)d) and multiline-part of c), and try to find a position in the string which does not contradict any of them. */ +/* Most of decisions we do here should have been done at compile time. + The nodes of the REx which we used for the search should have been + deleted from the finite automaton. */ + char * Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, char *strend, U32 flags, re_scream_pos_data *data) @@ -301,7 +312,8 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, char *t; I32 ml_anch; char *tmp; - register char *other_last = Nullch; + register char *other_last = Nullch; /* other substr checked before this */ + char *check_at; /* check substr found at this pos */ #ifdef DEBUGGING char *i_strpos = strpos; #endif @@ -314,7 +326,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, PL_colors[1], (strlen(prog->precomp) > 60 ? "..." : ""), PL_colors[0], - (strend - strpos > 60 ? 60 : strend - strpos), + (int)(strend - strpos > 60 ? 60 : strend - strpos), strpos, PL_colors[1], (strend - strpos > 60 ? "..." : "")) ); @@ -323,6 +335,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, DEBUG_r(PerlIO_printf(Perl_debug_log, "String too short...\n")); goto fail; } + check = prog->check_substr; if (prog->reganch & ROPT_ANCH) { /* Match at beg-of-str or after \n */ ml_anch = !( (prog->reganch & ROPT_ANCH_SINGLE) || ( (prog->reganch & ROPT_ANCH_BOL) @@ -339,8 +352,8 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, } PL_regeol = strend; /* Used in HOP() */ s = HOPc(strpos, prog->check_offset_min); - if (SvTAIL(prog->check_substr)) { - slen = SvCUR(prog->check_substr); /* >= 1 */ + if (SvTAIL(check)) { + slen = SvCUR(check); /* >= 1 */ if ( strend - s > slen || strend - s < slen - 1 || (strend - s == slen && strend[-1] != '\n')) { @@ -349,29 +362,28 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, } /* Now should match s[0..slen-2] */ slen--; - if (slen && (*SvPVX(prog->check_substr) != *s + if (slen && (*SvPVX(check) != *s || (slen > 1 - && memNE(SvPVX(prog->check_substr), s, slen)))) { + && memNE(SvPVX(check), s, slen)))) { report_neq: DEBUG_r(PerlIO_printf(Perl_debug_log, "String not equal...\n")); goto fail_finish; } } - else if (*SvPVX(prog->check_substr) != *s - || ((slen = SvCUR(prog->check_substr)) > 1 - && memNE(SvPVX(prog->check_substr), s, slen))) + else if (*SvPVX(check) != *s + || ((slen = SvCUR(check)) > 1 + && memNE(SvPVX(check), s, slen))) goto report_neq; goto success_at_start; } /* Match is anchored, but substr is not anchored wrt beg-of-str. */ s = strpos; start_shift = prog->check_offset_min; /* okay to underestimate on CC */ - /* Should be nonnegative! */ end_shift = prog->minlen - start_shift - - CHR_SVLEN(prog->check_substr) + (SvTAIL(prog->check_substr) != 0); + CHR_SVLEN(check) + (SvTAIL(check) != 0); if (!ml_anch) { - I32 end = prog->check_offset_max + CHR_SVLEN(prog->check_substr) - - (SvTAIL(prog->check_substr) != 0); + I32 end = prog->check_offset_max + CHR_SVLEN(check) + - (SvTAIL(check) != 0); I32 eshift = strend - s - end; if (end_shift < eshift) @@ -384,7 +396,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, start_shift = prog->check_offset_min; /* okay to underestimate on CC */ /* Should be nonnegative! */ end_shift = prog->minlen - start_shift - - CHR_SVLEN(prog->check_substr) + (SvTAIL(prog->check_substr) != 0); + CHR_SVLEN(check) + (SvTAIL(check) != 0); } #ifdef DEBUGGING /* 7/99: reports of failure (with the older version) */ @@ -392,7 +404,6 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, Perl_croak(aTHX_ "panic: end_shift"); #endif - check = prog->check_substr; restart: /* Find a possible match in the region s..strend by looking for the "check" substring in the region corrected by start/end_shift. */ @@ -424,13 +435,16 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, (s ? "Found" : "Did not find"), ((check == prog->anchored_substr) ? "anchored" : "floating"), PL_colors[0], - SvCUR(check) - (SvTAIL(check)!=0), SvPVX(check), + (int)(SvCUR(check) - (SvTAIL(check)!=0)), + SvPVX(check), PL_colors[1], (SvTAIL(check) ? "$" : ""), (s ? " at offset " : "...\n") ) ); if (!s) goto fail_finish; + check_at = s; + /* Finish the diagnostic message */ DEBUG_r(PerlIO_printf(Perl_debug_log, "%ld...\n", (long)(s - i_strpos)) ); @@ -446,7 +460,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, /* Take into account the "other" substring. */ /* XXXX May be hopelessly wrong for UTF... */ if (!other_last) - other_last = strpos - 1; + other_last = strpos; if (check == prog->float_substr) { do_other_anchored: { @@ -464,8 +478,8 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, else t = strpos; t += prog->anchored_offset; - if (t <= other_last) - t = other_last + 1; + if (t < other_last) /* These positions already checked */ + t = other_last; PL_bostr = tmp; last2 = last1 = strend - prog->minlen; if (last < last1) @@ -480,8 +494,8 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, DEBUG_r(PerlIO_printf(Perl_debug_log, "%s anchored substr `%s%.*s%s'%s", (s ? "Found" : "Contradicts"), PL_colors[0], - SvCUR(prog->anchored_substr) - - (SvTAIL(prog->anchored_substr)!=0), + (int)(SvCUR(prog->anchored_substr) + - (SvTAIL(prog->anchored_substr)!=0)), SvPVX(prog->anchored_substr), PL_colors[1], (SvTAIL(prog->anchored_substr) ? "$" : ""))); if (!s) { @@ -494,7 +508,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, ", trying floating at offset %ld...\n", (long)(s1 + 1 - i_strpos))); PL_regeol = strend; /* Used in HOP() */ - other_last = last1 + prog->anchored_offset; + other_last = last1 + prog->anchored_offset + 1; s = HOPc(last, 1); goto restart; } @@ -502,7 +516,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, DEBUG_r(PerlIO_printf(Perl_debug_log, " at offset %ld...\n", (long)(s - i_strpos))); t = s - prog->anchored_offset; - other_last = s - 1; + other_last = s + 1; s = s1; if (t == strpos) goto try_at_start; @@ -519,8 +533,8 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, if (last - t > prog->float_max_offset) last = t + prog->float_max_offset; s = t + prog->float_min_offset; - if (s <= other_last) - s = other_last + 1; + if (s < other_last) + s = other_last; /* XXXX It is not documented what units *_offsets are in. Assume bytes. */ /* fbm_instr() takes into account exact value of end-of-str if the check is SvTAIL(ed). Since false positives are OK, @@ -532,8 +546,8 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, DEBUG_r(PerlIO_printf(Perl_debug_log, "%s floating substr `%s%.*s%s'%s", (s ? "Found" : "Contradicts"), PL_colors[0], - SvCUR(prog->float_substr) - - (SvTAIL(prog->float_substr)!=0), + (int)(SvCUR(prog->float_substr) + - (SvTAIL(prog->float_substr)!=0)), SvPVX(prog->float_substr), PL_colors[1], (SvTAIL(prog->float_substr) ? "$" : ""))); if (!s) { @@ -545,7 +559,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, DEBUG_r(PerlIO_printf(Perl_debug_log, ", trying anchored starting at offset %ld...\n", (long)(s1 + 1 - i_strpos))); - other_last = last; + other_last = last + 1; PL_regeol = strend; /* Used in HOP() */ s = HOPc(t, 1); goto restart; @@ -553,7 +567,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, else { DEBUG_r(PerlIO_printf(Perl_debug_log, " at offset %ld...\n", (long)(s - i_strpos))); - other_last = s - 1; + other_last = s + 1; s = s1; if (t == strpos) goto try_at_start; @@ -625,7 +639,10 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, /* Even in this situation we may use MBOL flag if strpos is offset wrt the start of the string. */ if (ml_anch && sv - && (strpos + SvCUR(sv) != strend) && strpos[-1] != '\n') { + && (strpos + SvCUR(sv) != strend) && strpos[-1] != '\n' + /* May be due to an implicit anchor of m{.*foo} */ + && !(prog->reganch & ROPT_IMPLICIT)) + { t = strpos; goto find_anchor; } @@ -635,410 +652,283 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos, ); success_at_start: if (!(prog->reganch & ROPT_NAUGHTY) /* XXXX If strpos moved? */ + && prog->check_substr /* Could be deleted already */ && --BmUSEFUL(prog->check_substr) < 0 - && prog->check_substr == prog->float_substr) { /* boo */ + && prog->check_substr == prog->float_substr) + { /* If flags & SOMETHING - do not do it many times on the same match */ SvREFCNT_dec(prog->check_substr); prog->check_substr = Nullsv; /* disable */ prog->float_substr = Nullsv; /* clear */ s = strpos; + /* XXXX This is a remnant of the old implementation. It + looks wasteful, since now INTUIT can use many + other heuristics. */ prog->reganch &= ~RE_USE_INTUIT; } else s = strpos; } + /* Last resort... */ + /* XXXX BmUSEFUL already changed, maybe multiple change is meaningful... */ + if (prog->regstclass) { + /* minlen == 0 is possible if regstclass is \b or \B, + and the fixed substr is ''$. + Since minlen is already taken into account, s+1 is before strend; + accidentally, minlen >= 1 guaranties no false positives at s + 1 + even for \b or \B. But (minlen? 1 : 0) below assumes that + regstclass does not come from lookahead... */ + /* If regstclass takes bytelength more than 1: If charlength==1, OK. + This leaves EXACTF only, which is dealt with in find_byclass(). */ + int cl_l = (PL_regkind[(U8)OP(prog->regstclass)] == EXACT + ? STR_LEN(prog->regstclass) + : 1); + char *endpos = (prog->anchored_substr || ml_anch) + ? s + (prog->minlen? cl_l : 0) + : (prog->float_substr ? check_at - start_shift + cl_l + : strend) ; + char *startpos = sv ? strend - SvCUR(sv) : s; + + t = s; + if (prog->reganch & ROPT_UTF8) { + PL_regdata = prog->data; /* Used by REGINCLASS UTF logic */ + PL_bostr = startpos; + } + s = find_byclass(prog, prog->regstclass, s, endpos, startpos, 1); + if (!s) { +#ifdef DEBUGGING + char *what; +#endif + if (endpos == strend) { + DEBUG_r( PerlIO_printf(Perl_debug_log, + "Could not match STCLASS...\n") ); + goto fail; + } + DEBUG_r( PerlIO_printf(Perl_debug_log, + "This position contradicts STCLASS...\n") ); + if ((prog->reganch & ROPT_ANCH) && !ml_anch) + goto fail; + /* Contradict one of substrings */ + if (prog->anchored_substr) { + if (prog->anchored_substr == check) { + DEBUG_r( what = "anchored" ); + hop_and_restart: + PL_regeol = strend; /* Used in HOP() */ + s = HOPc(t, 1); + if (s + start_shift + end_shift > strend) { + /* XXXX Should be taken into account earlier? */ + DEBUG_r( PerlIO_printf(Perl_debug_log, + "Could not match STCLASS...\n") ); + goto fail; + } + DEBUG_r( PerlIO_printf(Perl_debug_log, + "Trying %s substr starting at offset %ld...\n", + what, (long)(s + start_shift - i_strpos)) ); + goto restart; + } + /* Have both, check_string is floating */ + if (t + start_shift >= check_at) /* Contradicts floating=check */ + goto retry_floating_check; + /* Recheck anchored substring, but not floating... */ + s = check_at; + DEBUG_r( PerlIO_printf(Perl_debug_log, + "Trying anchored substr starting at offset %ld...\n", + (long)(other_last - i_strpos)) ); + goto do_other_anchored; + } + /* Another way we could have checked stclass at the + current position only: */ + if (ml_anch) { + s = t = t + 1; + DEBUG_r( PerlIO_printf(Perl_debug_log, + "Trying /^/m starting at offset %ld...\n", + (long)(t - i_strpos)) ); + goto try_at_offset; + } + if (!prog->float_substr) /* Could have been deleted */ + goto fail; + /* Check is floating subtring. */ + retry_floating_check: + t = check_at - start_shift; + DEBUG_r( what = "floating" ); + goto hop_and_restart; + } + DEBUG_r( if (t != s) + PerlIO_printf(Perl_debug_log, + "By STCLASS: moving %ld --> %ld\n", + (long)(t - i_strpos), (long)(s - i_strpos)); + else + PerlIO_printf(Perl_debug_log, + "Does not contradict STCLASS...\n") ); + } DEBUG_r(PerlIO_printf(Perl_debug_log, "%sGuessed:%s match at offset %ld\n", PL_colors[4], PL_colors[5], (long)(s - i_strpos)) ); return s; fail_finish: /* Substring not found */ - BmUSEFUL(prog->check_substr) += 5; /* hooray */ + if (prog->check_substr) /* could be removed already */ + BmUSEFUL(prog->check_substr) += 5; /* hooray */ fail: DEBUG_r(PerlIO_printf(Perl_debug_log, "%sMatch rejected by optimizer%s\n", PL_colors[4],PL_colors[5])); return Nullch; } -/* - - regexec_flags - match a regexp against a string - */ -I32 -Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *strend, - char *strbeg, I32 minend, SV *sv, void *data, U32 flags) -/* strend: pointer to null at end of string */ -/* strbeg: real beginning of string */ -/* minend: end of match must be >=minend after stringarg. */ -/* data: May be used for some additional optimizations. */ -/* nosave: For optimizations. */ +/* We know what class REx starts with. Try to find this position... */ +STATIC char * +S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *startpos, I32 norun) { - dTHR; - register char *s; - register regnode *c; - register char *startpos = stringarg; - register I32 tmp; - I32 minlen; /* must match at least this many chars */ - I32 dontbother = 0; /* how many characters not to try at end */ - I32 start_shift = 0; /* Offset of the start to find - constant substr. */ /* CC */ - I32 end_shift = 0; /* Same for the end. */ /* CC */ - I32 scream_pos = -1; /* Internal iterator of scream. */ - char *scream_olds; - SV* oreplsv = GvSV(PL_replgv); - - PL_regcc = 0; - - cache_re(prog); -#ifdef DEBUGGING - PL_regnarrate = PL_debug & 512; -#endif - - /* Be paranoid... */ - if (prog == NULL || startpos == NULL) { - Perl_croak(aTHX_ "NULL regexp parameter"); - return 0; - } - - minlen = prog->minlen; - if (strend - startpos < minlen) goto phooey; - - if (startpos == strbeg) /* is ^ valid at stringarg? */ - PL_regprev = '\n'; - else { - PL_regprev = (U32)stringarg[-1]; - if (!PL_multiline && PL_regprev == '\n') - PL_regprev = '\0'; /* force ^ to NOT match */ - } - - /* Check validity of program. */ - if (UCHARAT(prog->program) != REG_MAGIC) { - Perl_croak(aTHX_ "corrupted regexp program"); - } - - PL_reg_flags = 0; - PL_reg_eval_set = 0; - PL_reg_maxiter = 0; - - if (prog->reganch & ROPT_UTF8) - PL_reg_flags |= RF_utf8; - - /* Mark beginning of line for ^ and lookbehind. */ - PL_regbol = startpos; - PL_bostr = strbeg; - PL_reg_sv = sv; - - /* Mark end of line for $ (and such) */ - PL_regeol = strend; - - /* see how far we have to get to not match where we matched before */ - PL_regtill = startpos+minend; - - /* We start without call_cc context. */ - PL_reg_call_cc = 0; - - /* If there is a "must appear" string, look for it. */ - s = startpos; - - if (prog->reganch & ROPT_GPOS_SEEN) { - MAGIC *mg; - - if (!(flags & REXEC_IGNOREPOS) && sv && SvTYPE(sv) >= SVt_PVMG - && SvMAGIC(sv) && (mg = mg_find(sv, 'g')) && mg->mg_len >= 0) - PL_reg_ganch = strbeg + mg->mg_len; - else - PL_reg_ganch = startpos; - if (prog->reganch & ROPT_ANCH_GPOS) { - if (s > PL_reg_ganch) - goto phooey; - s = PL_reg_ganch; - } - } - - if (!(flags & REXEC_CHECKED) && prog->check_substr != Nullsv) { - re_scream_pos_data d; - - d.scream_olds = &scream_olds; - d.scream_pos = &scream_pos; - s = re_intuit_start(prog, sv, s, strend, flags, &d); - if (!s) - goto phooey; /* not present */ - } - - DEBUG_r( if (!PL_colorset) reginitcolors() ); - DEBUG_r(PerlIO_printf(Perl_debug_log, - "%sMatching REx%s `%s%.60s%s%s' against `%s%.*s%s%s'\n", - PL_colors[4],PL_colors[5],PL_colors[0], - prog->precomp, - PL_colors[1], - (strlen(prog->precomp) > 60 ? "..." : ""), - PL_colors[0], - (strend - startpos > 60 ? 60 : strend - startpos), - startpos, PL_colors[1], - (strend - startpos > 60 ? "..." : "")) - ); - - /* Simplest case: anchored match need be tried only once. */ - /* [unless only anchor is BOL and multiline is set] */ - if (prog->reganch & (ROPT_ANCH & ~ROPT_ANCH_GPOS)) { - if (s == startpos && regtry(prog, startpos)) - goto got_it; - else if (PL_multiline || (prog->reganch & ROPT_IMPLICIT) - || (prog->reganch & ROPT_ANCH_MBOL)) /* XXXX SBOL? */ - { - char *end; + I32 doevery = (prog->reganch & ROPT_SKIP) == 0; + char *m; + int ln; + int c1; + int c2; + char *e; + register I32 tmp = 1; /* Scratch variable? */ - if (minlen) - dontbother = minlen - 1; - end = HOPc(strend, -dontbother) - 1; - /* for multiline we only have to try after newlines */ - if (prog->check_substr) { - if (s == startpos) - goto after_try; - while (1) { - if (regtry(prog, s)) + /* We know what class it must start with. */ + switch (OP(c)) { + case ANYOFUTF8: + while (s < strend) { + if (REGINCLASSUTF8(c, (U8*)s)) { + if (tmp && (norun || regtry(prog, s))) goto got_it; - after_try: - if (s >= end) - goto phooey; - s = re_intuit_start(prog, sv, s + 1, strend, flags, NULL); - if (!s) - goto phooey; - } + else + tmp = doevery; + } + else + tmp = 1; + s += UTF8SKIP(s); + } + break; + case ANYOF: + while (s < strend) { + if (REGINCLASS(c, *s)) { + if (tmp && (norun || regtry(prog, s))) + goto got_it; + else + tmp = doevery; + } + else + tmp = 1; + s++; + } + break; + case EXACTF: + m = STRING(c); + ln = STR_LEN(c); + c1 = *m; + c2 = PL_fold[c1]; + goto do_exactf; + case EXACTFL: + m = STRING(c); + ln = STR_LEN(c); + c1 = *m; + c2 = PL_fold_locale[c1]; + do_exactf: + e = strend - ln; + + if (norun && e < s) + e = s; /* Due to minlen logic of intuit() */ + /* Here it is NOT UTF! */ + if (c1 == c2) { + while (s <= e) { + if ( *s == c1 + && (ln == 1 || !(OP(c) == EXACTF + ? ibcmp(s, m, ln) + : ibcmp_locale(s, m, ln))) + && (norun || regtry(prog, s)) ) + goto got_it; + s++; + } } else { - if (s > startpos) - s--; - while (s < end) { - if (*s++ == '\n') { /* don't need PL_utf8skip here */ - if (regtry(prog, s)) - goto got_it; - } - } + while (s <= e) { + if ( (*s == c1 || *s == c2) + && (ln == 1 || !(OP(c) == EXACTF + ? ibcmp(s, m, ln) + : ibcmp_locale(s, m, ln))) + && (norun || regtry(prog, s)) ) + goto got_it; + s++; + } } - } - goto phooey; - } else if (prog->reganch & ROPT_ANCH_GPOS) { - if (regtry(prog, PL_reg_ganch)) - goto got_it; - goto phooey; - } - - /* Messy cases: unanchored match. */ - if (prog->anchored_substr && prog->reganch & ROPT_SKIP) { - /* we have /x+whatever/ */ - /* it must be a one character string (XXXX Except UTF?) */ - char ch = SvPVX(prog->anchored_substr)[0]; - if (UTF) { + break; + case BOUNDL: + PL_reg_flags |= RF_tainted; + /* FALL THROUGH */ + case BOUND: + tmp = (s != startpos) ? UCHARAT(s - 1) : '\n'; + tmp = ((OP(c) == BOUND ? isALNUM(tmp) : isALNUM_LC(tmp)) != 0); while (s < strend) { - if (*s == ch) { - if (regtry(prog, s)) goto got_it; - s += UTF8SKIP(s); - while (s < strend && *s == ch) - s += UTF8SKIP(s); + if (tmp == !(OP(c) == BOUND ? isALNUM(*s) : isALNUM_LC(*s))) { + tmp = !tmp; + if ((norun || regtry(prog, s))) + goto got_it; } - s += UTF8SKIP(s); + s++; } - } - else { + if ((!prog->minlen && tmp) && (norun || regtry(prog, s))) + goto got_it; + break; + case BOUNDLUTF8: + PL_reg_flags |= RF_tainted; + /* FALL THROUGH */ + case BOUNDUTF8: + tmp = (I32)(s != startpos) ? utf8_to_uv(reghop((U8*)s, -1), 0) : '\n'; + tmp = ((OP(c) == BOUNDUTF8 ? isALNUM_uni(tmp) : isALNUM_LC_uni(tmp)) != 0); while (s < strend) { - if (*s == ch) { - if (regtry(prog, s)) goto got_it; - s++; - while (s < strend && *s == ch) - s++; + if (tmp == !(OP(c) == BOUNDUTF8 ? + swash_fetch(PL_utf8_alnum, (U8*)s) : + isALNUM_LC_utf8((U8*)s))) + { + tmp = !tmp; + if ((norun || regtry(prog, s))) + goto got_it; } + s += UTF8SKIP(s); + } + if ((!prog->minlen && tmp) && (norun || regtry(prog, s))) + goto got_it; + break; + case NBOUNDL: + PL_reg_flags |= RF_tainted; + /* FALL THROUGH */ + case NBOUND: + tmp = (s != startpos) ? UCHARAT(s - 1) : '\n'; + tmp = ((OP(c) == NBOUND ? isALNUM(tmp) : isALNUM_LC(tmp)) != 0); + while (s < strend) { + if (tmp == !(OP(c) == NBOUND ? isALNUM(*s) : isALNUM_LC(*s))) + tmp = !tmp; + else if ((norun || regtry(prog, s))) + goto got_it; s++; } - } - } - /*SUPPRESS 560*/ - else if (prog->anchored_substr != Nullsv - || (prog->float_substr != Nullsv - && prog->float_max_offset < strend - s)) { - SV *must = prog->anchored_substr - ? prog->anchored_substr : prog->float_substr; - I32 back_max = - prog->anchored_substr ? prog->anchored_offset : prog->float_max_offset; - I32 back_min = - prog->anchored_substr ? prog->anchored_offset : prog->float_min_offset; - I32 delta = back_max - back_min; - char *last = HOPc(strend, /* Cannot start after this */ - -(I32)(CHR_SVLEN(must) - - (SvTAIL(must) != 0) + back_min)); - char *last1; /* Last position checked before */ - - if (s > PL_bostr) - last1 = HOPc(s, -1); - else - last1 = s - 1; /* bogus */ - - /* XXXX check_substr already used to find `s', can optimize if - check_substr==must. */ - scream_pos = -1; - dontbother = end_shift; - strend = HOPc(strend, -dontbother); - while ( (s <= last) && - ((flags & REXEC_SCREAM) - ? (s = screaminstr(sv, must, HOPc(s, back_min) - strbeg, - end_shift, &scream_pos, 0)) - : (s = fbm_instr((unsigned char*)HOP(s, back_min), - (unsigned char*)strend, must, - PL_multiline ? FBMrf_MULTILINE : 0))) ) { - if (HOPc(s, -back_max) > last1) { - last1 = HOPc(s, -back_min); - s = HOPc(s, -back_max); - } - else { - char *t = (last1 >= PL_bostr) ? HOPc(last1, 1) : last1 + 1; - - last1 = HOPc(s, -back_min); - s = t; - } - if (UTF) { - while (s <= last1) { - if (regtry(prog, s)) - goto got_it; - s += UTF8SKIP(s); - } - } - else { - while (s <= last1) { - if (regtry(prog, s)) - goto got_it; - s++; - } - } - } - goto phooey; - } - else if (c = prog->regstclass) { - I32 doevery = (prog->reganch & ROPT_SKIP) == 0; - char *cc; - - if (minlen) - dontbother = minlen - 1; - strend = HOPc(strend, -dontbother); /* don't bother with what can't match */ - tmp = 1; - /* We know what class it must start with. */ - switch (OP(c)) { - case ANYOFUTF8: - cc = MASK(c); - while (s < strend) { - if (REGINCLASSUTF8(c, (U8*)s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s += UTF8SKIP(s); - } - break; - case ANYOF: - cc = MASK(c); - while (s < strend) { - if (REGINCLASS(cc, *s)) { - if (tmp && regtry(prog, s)) - goto got_it; - else - tmp = doevery; - } - else - tmp = 1; - s++; - } - break; - case BOUNDL: - PL_reg_flags |= RF_tainted; - /* FALL THROUGH */ - case BOUND: - if (minlen) { - dontbother++; - strend -= 1; - } - tmp = (s != startpos) ? UCHARAT(s - 1) : PL_regprev; - tmp = ((OP(c) == BOUND ? isALNUM(tmp) : isALNUM_LC(tmp)) != 0); - while (s < strend) { - if (tmp == !(OP(c) == BOUND ? isALNUM(*s) : isALNUM_LC(*s))) { - tmp = !tmp; - if (regtry(prog, s)) - goto got_it; - } - s++; - } - if ((minlen || tmp) && regtry(prog,s)) - goto got_it; - break; - case BOUNDLUTF8: - PL_reg_flags |= RF_tainted; - /* FALL THROUGH */ - case BOUNDUTF8: - if (minlen) { - dontbother++; - strend = reghop_c(strend, -1); - } - tmp = (I32)(s != startpos) ? utf8_to_uv(reghop((U8*)s, -1), 0) : PL_regprev; - tmp = ((OP(c) == BOUND ? isALNUM_uni(tmp) : isALNUM_LC_uni(tmp)) != 0); - while (s < strend) { - if (tmp == !(OP(c) == BOUND ? - swash_fetch(PL_utf8_alnum, (U8*)s) : - isALNUM_LC_utf8((U8*)s))) - { - tmp = !tmp; - if (regtry(prog, s)) - goto got_it; - } - s += UTF8SKIP(s); - } - if ((minlen || tmp) && regtry(prog,s)) - goto got_it; - break; - case NBOUNDL: - PL_reg_flags |= RF_tainted; - /* FALL THROUGH */ - case NBOUND: - if (minlen) { - dontbother++; - strend -= 1; - } - tmp = (s != startpos) ? UCHARAT(s - 1) : PL_regprev; - tmp = ((OP(c) == NBOUND ? isALNUM(tmp) : isALNUM_LC(tmp)) != 0); - while (s < strend) { - if (tmp == !(OP(c) == NBOUND ? isALNUM(*s) : isALNUM_LC(*s))) - tmp = !tmp; - else if (regtry(prog, s)) - goto got_it; - s++; - } - if ((minlen || !tmp) && regtry(prog,s)) + if ((!prog->minlen && !tmp) && (norun || regtry(prog, s))) goto got_it; break; case NBOUNDLUTF8: PL_reg_flags |= RF_tainted; /* FALL THROUGH */ case NBOUNDUTF8: - if (minlen) { - dontbother++; - strend = reghop_c(strend, -1); - } - tmp = (I32)(s != startpos) ? utf8_to_uv(reghop((U8*)s, -1), 0) : PL_regprev; - tmp = ((OP(c) == NBOUND ? isALNUM_uni(tmp) : isALNUM_LC_uni(tmp)) != 0); + tmp = (I32)(s != startpos) ? utf8_to_uv(reghop((U8*)s, -1), 0) : '\n'; + tmp = ((OP(c) == NBOUNDUTF8 ? isALNUM_uni(tmp) : isALNUM_LC_uni(tmp)) != 0); while (s < strend) { - if (tmp == !(OP(c) == NBOUND ? + if (tmp == !(OP(c) == NBOUNDUTF8 ? swash_fetch(PL_utf8_alnum, (U8*)s) : isALNUM_LC_utf8((U8*)s))) tmp = !tmp; - else if (regtry(prog, s)) + else if ((norun || regtry(prog, s))) goto got_it; s += UTF8SKIP(s); } - if ((minlen || !tmp) && regtry(prog,s)) + if ((!prog->minlen && !tmp) && (norun || regtry(prog, s))) goto got_it; break; case ALNUM: while (s < strend) { if (isALNUM(*s)) { - if (tmp && regtry(prog, s)) + if (tmp && (norun || regtry(prog, s))) goto got_it; else tmp = doevery; @@ -1051,7 +941,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * case ALNUMUTF8: while (s < strend) { if (swash_fetch(PL_utf8_alnum, (U8*)s)) { - if (tmp && regtry(prog, s)) + if (tmp && (norun || regtry(prog, s))) goto got_it; else tmp = doevery; @@ -1065,7 +955,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * PL_reg_flags |= RF_tainted; while (s < strend) { if (isALNUM_LC(*s)) { - if (tmp && regtry(prog, s)) + if (tmp && (norun || regtry(prog, s))) goto got_it; else tmp = doevery; @@ -1079,7 +969,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * PL_reg_flags |= RF_tainted; while (s < strend) { if (isALNUM_LC_utf8((U8*)s)) { - if (tmp && regtry(prog, s)) + if (tmp && (norun || regtry(prog, s))) goto got_it; else tmp = doevery; @@ -1092,7 +982,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * case NALNUM: while (s < strend) { if (!isALNUM(*s)) { - if (tmp && regtry(prog, s)) + if (tmp && (norun || regtry(prog, s))) goto got_it; else tmp = doevery; @@ -1105,7 +995,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * case NALNUMUTF8: while (s < strend) { if (!swash_fetch(PL_utf8_alnum, (U8*)s)) { - if (tmp && regtry(prog, s)) + if (tmp && (norun || regtry(prog, s))) goto got_it; else tmp = doevery; @@ -1119,7 +1009,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * PL_reg_flags |= RF_tainted; while (s < strend) { if (!isALNUM_LC(*s)) { - if (tmp && regtry(prog, s)) + if (tmp && (norun || regtry(prog, s))) goto got_it; else tmp = doevery; @@ -1133,7 +1023,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * PL_reg_flags |= RF_tainted; while (s < strend) { if (!isALNUM_LC_utf8((U8*)s)) { - if (tmp && regtry(prog, s)) + if (tmp && (norun || regtry(prog, s))) goto got_it; else tmp = doevery; @@ -1146,7 +1036,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * case SPACE: while (s < strend) { if (isSPACE(*s)) { - if (tmp && regtry(prog, s)) + if (tmp && (norun || regtry(prog, s))) goto got_it; else tmp = doevery; @@ -1159,7 +1049,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * case SPACEUTF8: while (s < strend) { if (*s == ' ' || swash_fetch(PL_utf8_space,(U8*)s)) { - if (tmp && regtry(prog, s)) + if (tmp && (norun || regtry(prog, s))) goto got_it; else tmp = doevery; @@ -1173,7 +1063,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * PL_reg_flags |= RF_tainted; while (s < strend) { if (isSPACE_LC(*s)) { - if (tmp && regtry(prog, s)) + if (tmp && (norun || regtry(prog, s))) goto got_it; else tmp = doevery; @@ -1187,7 +1077,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * PL_reg_flags |= RF_tainted; while (s < strend) { if (*s == ' ' || isSPACE_LC_utf8((U8*)s)) { - if (tmp && regtry(prog, s)) + if (tmp && (norun || regtry(prog, s))) goto got_it; else tmp = doevery; @@ -1200,7 +1090,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * case NSPACE: while (s < strend) { if (!isSPACE(*s)) { - if (tmp && regtry(prog, s)) + if (tmp && (norun || regtry(prog, s))) goto got_it; else tmp = doevery; @@ -1213,7 +1103,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * case NSPACEUTF8: while (s < strend) { if (!(*s == ' ' || swash_fetch(PL_utf8_space,(U8*)s))) { - if (tmp && regtry(prog, s)) + if (tmp && (norun || regtry(prog, s))) goto got_it; else tmp = doevery; @@ -1227,7 +1117,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * PL_reg_flags |= RF_tainted; while (s < strend) { if (!isSPACE_LC(*s)) { - if (tmp && regtry(prog, s)) + if (tmp && (norun || regtry(prog, s))) goto got_it; else tmp = doevery; @@ -1241,7 +1131,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * PL_reg_flags |= RF_tainted; while (s < strend) { if (!(*s == ' ' || isSPACE_LC_utf8((U8*)s))) { - if (tmp && regtry(prog, s)) + if (tmp && (norun || regtry(prog, s))) goto got_it; else tmp = doevery; @@ -1254,7 +1144,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * case DIGIT: while (s < strend) { if (isDIGIT(*s)) { - if (tmp && regtry(prog, s)) + if (tmp && (norun || regtry(prog, s))) goto got_it; else tmp = doevery; @@ -1267,7 +1157,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * case DIGITUTF8: while (s < strend) { if (swash_fetch(PL_utf8_digit,(U8*)s)) { - if (tmp && regtry(prog, s)) + if (tmp && (norun || regtry(prog, s))) goto got_it; else tmp = doevery; @@ -1281,7 +1171,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * PL_reg_flags |= RF_tainted; while (s < strend) { if (isDIGIT_LC(*s)) { - if (tmp && regtry(prog, s)) + if (tmp && (norun || regtry(prog, s))) goto got_it; else tmp = doevery; @@ -1295,7 +1185,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * PL_reg_flags |= RF_tainted; while (s < strend) { if (isDIGIT_LC_utf8((U8*)s)) { - if (tmp && regtry(prog, s)) + if (tmp && (norun || regtry(prog, s))) goto got_it; else tmp = doevery; @@ -1308,7 +1198,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * case NDIGIT: while (s < strend) { if (!isDIGIT(*s)) { - if (tmp && regtry(prog, s)) + if (tmp && (norun || regtry(prog, s))) goto got_it; else tmp = doevery; @@ -1321,7 +1211,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * case NDIGITUTF8: while (s < strend) { if (!swash_fetch(PL_utf8_digit,(U8*)s)) { - if (tmp && regtry(prog, s)) + if (tmp && (norun || regtry(prog, s))) goto got_it; else tmp = doevery; @@ -1335,7 +1225,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * PL_reg_flags |= RF_tainted; while (s < strend) { if (!isDIGIT_LC(*s)) { - if (tmp && regtry(prog, s)) + if (tmp && (norun || regtry(prog, s))) goto got_it; else tmp = doevery; @@ -1349,7 +1239,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * PL_reg_flags |= RF_tainted; while (s < strend) { if (!isDIGIT_LC_utf8((U8*)s)) { - if (tmp && regtry(prog, s)) + if (tmp && (norun || regtry(prog, s))) goto got_it; else tmp = doevery; @@ -1359,7 +1249,279 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * s += UTF8SKIP(s); } break; + default: + Perl_croak(aTHX_ "panic: unknown regstclass %d", (int)OP(c)); + break; + } + return 0; + got_it: + return s; +} + +/* + - regexec_flags - match a regexp against a string + */ +I32 +Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *strend, + char *strbeg, I32 minend, SV *sv, void *data, U32 flags) +/* strend: pointer to null at end of string */ +/* strbeg: real beginning of string */ +/* minend: end of match must be >=minend after stringarg. */ +/* data: May be used for some additional optimizations. */ +/* nosave: For optimizations. */ +{ + dTHR; + register char *s; + register regnode *c; + register char *startpos = stringarg; + register I32 tmp; + I32 minlen; /* must match at least this many chars */ + I32 dontbother = 0; /* how many characters not to try at end */ + I32 start_shift = 0; /* Offset of the start to find + constant substr. */ /* CC */ + I32 end_shift = 0; /* Same for the end. */ /* CC */ + I32 scream_pos = -1; /* Internal iterator of scream. */ + char *scream_olds; + SV* oreplsv = GvSV(PL_replgv); + + PL_regcc = 0; + + cache_re(prog); +#ifdef DEBUGGING + PL_regnarrate = PL_debug & 512; +#endif + + /* Be paranoid... */ + if (prog == NULL || startpos == NULL) { + Perl_croak(aTHX_ "NULL regexp parameter"); + return 0; + } + + minlen = prog->minlen; + if (strend - startpos < minlen) goto phooey; + + if (startpos == strbeg) /* is ^ valid at stringarg? */ + PL_regprev = '\n'; + else { + PL_regprev = (U32)stringarg[-1]; + if (!PL_multiline && PL_regprev == '\n') + PL_regprev = '\0'; /* force ^ to NOT match */ + } + + /* Check validity of program. */ + if (UCHARAT(prog->program) != REG_MAGIC) { + Perl_croak(aTHX_ "corrupted regexp program"); + } + + PL_reg_flags = 0; + PL_reg_eval_set = 0; + PL_reg_maxiter = 0; + + if (prog->reganch & ROPT_UTF8) + PL_reg_flags |= RF_utf8; + + /* Mark beginning of line for ^ and lookbehind. */ + PL_regbol = startpos; + PL_bostr = strbeg; + PL_reg_sv = sv; + + /* Mark end of line for $ (and such) */ + PL_regeol = strend; + + /* see how far we have to get to not match where we matched before */ + PL_regtill = startpos+minend; + + /* We start without call_cc context. */ + PL_reg_call_cc = 0; + + /* If there is a "must appear" string, look for it. */ + s = startpos; + + if (prog->reganch & ROPT_GPOS_SEEN) { /* Need to have PL_reg_ganch */ + MAGIC *mg; + + if (flags & REXEC_IGNOREPOS) /* Means: check only at start */ + PL_reg_ganch = startpos; + else if (sv && SvTYPE(sv) >= SVt_PVMG + && SvMAGIC(sv) + && (mg = mg_find(sv, 'g')) && mg->mg_len >= 0) { + PL_reg_ganch = strbeg + mg->mg_len; /* Defined pos() */ + if (prog->reganch & ROPT_ANCH_GPOS) { + if (s > PL_reg_ganch) + goto phooey; + s = PL_reg_ganch; + } + } + else /* pos() not defined */ + PL_reg_ganch = strbeg; + } + + if (!(flags & REXEC_CHECKED) && prog->check_substr != Nullsv) { + re_scream_pos_data d; + + d.scream_olds = &scream_olds; + d.scream_pos = &scream_pos; + s = re_intuit_start(prog, sv, s, strend, flags, &d); + if (!s) + goto phooey; /* not present */ + } + + DEBUG_r( if (!PL_colorset) reginitcolors() ); + DEBUG_r(PerlIO_printf(Perl_debug_log, + "%sMatching REx%s `%s%.60s%s%s' against `%s%.*s%s%s'\n", + PL_colors[4],PL_colors[5],PL_colors[0], + prog->precomp, + PL_colors[1], + (strlen(prog->precomp) > 60 ? "..." : ""), + PL_colors[0], + (int)(strend - startpos > 60 ? 60 : strend - startpos), + startpos, PL_colors[1], + (strend - startpos > 60 ? "..." : "")) + ); + + /* Simplest case: anchored match need be tried only once. */ + /* [unless only anchor is BOL and multiline is set] */ + if (prog->reganch & (ROPT_ANCH & ~ROPT_ANCH_GPOS)) { + if (s == startpos && regtry(prog, startpos)) + goto got_it; + else if (PL_multiline || (prog->reganch & ROPT_IMPLICIT) + || (prog->reganch & ROPT_ANCH_MBOL)) /* XXXX SBOL? */ + { + char *end; + + if (minlen) + dontbother = minlen - 1; + end = HOPc(strend, -dontbother) - 1; + /* for multiline we only have to try after newlines */ + if (prog->check_substr) { + if (s == startpos) + goto after_try; + while (1) { + if (regtry(prog, s)) + goto got_it; + after_try: + if (s >= end) + goto phooey; + if (prog->reganch & RE_USE_INTUIT) { + s = re_intuit_start(prog, sv, s + 1, strend, flags, NULL); + if (!s) + goto phooey; + } + else + s++; + } + } else { + if (s > startpos) + s--; + while (s < end) { + if (*s++ == '\n') { /* don't need PL_utf8skip here */ + if (regtry(prog, s)) + goto got_it; + } + } + } + } + goto phooey; + } else if (prog->reganch & ROPT_ANCH_GPOS) { + if (regtry(prog, PL_reg_ganch)) + goto got_it; + goto phooey; + } + + /* Messy cases: unanchored match. */ + if (prog->anchored_substr && prog->reganch & ROPT_SKIP) { + /* we have /x+whatever/ */ + /* it must be a one character string (XXXX Except UTF?) */ + char ch = SvPVX(prog->anchored_substr)[0]; + if (UTF) { + while (s < strend) { + if (*s == ch) { + if (regtry(prog, s)) goto got_it; + s += UTF8SKIP(s); + while (s < strend && *s == ch) + s += UTF8SKIP(s); + } + s += UTF8SKIP(s); + } + } + else { + while (s < strend) { + if (*s == ch) { + if (regtry(prog, s)) goto got_it; + s++; + while (s < strend && *s == ch) + s++; + } + s++; + } + } + } + /*SUPPRESS 560*/ + else if (prog->anchored_substr != Nullsv + || (prog->float_substr != Nullsv + && prog->float_max_offset < strend - s)) { + SV *must = prog->anchored_substr + ? prog->anchored_substr : prog->float_substr; + I32 back_max = + prog->anchored_substr ? prog->anchored_offset : prog->float_max_offset; + I32 back_min = + prog->anchored_substr ? prog->anchored_offset : prog->float_min_offset; + I32 delta = back_max - back_min; + char *last = HOPc(strend, /* Cannot start after this */ + -(I32)(CHR_SVLEN(must) + - (SvTAIL(must) != 0) + back_min)); + char *last1; /* Last position checked before */ + + if (s > PL_bostr) + last1 = HOPc(s, -1); + else + last1 = s - 1; /* bogus */ + + /* XXXX check_substr already used to find `s', can optimize if + check_substr==must. */ + scream_pos = -1; + dontbother = end_shift; + strend = HOPc(strend, -dontbother); + while ( (s <= last) && + ((flags & REXEC_SCREAM) + ? (s = screaminstr(sv, must, HOPc(s, back_min) - strbeg, + end_shift, &scream_pos, 0)) + : (s = fbm_instr((unsigned char*)HOP(s, back_min), + (unsigned char*)strend, must, + PL_multiline ? FBMrf_MULTILINE : 0))) ) { + if (HOPc(s, -back_max) > last1) { + last1 = HOPc(s, -back_min); + s = HOPc(s, -back_max); + } + else { + char *t = (last1 >= PL_bostr) ? HOPc(last1, 1) : last1 + 1; + + last1 = HOPc(s, -back_min); + s = t; + } + if (UTF) { + while (s <= last1) { + if (regtry(prog, s)) + goto got_it; + s += UTF8SKIP(s); + } + } + else { + while (s <= last1) { + if (regtry(prog, s)) + goto got_it; + s++; + } + } } + goto phooey; + } + else if (c = prog->regstclass) { + if (minlen && PL_regkind[(U8)OP(prog->regstclass)] != EXACT) + /* don't bother with what can't match */ + strend = HOPc(strend, -(minlen - 1)); + if (find_byclass(prog, c, s, strend, startpos, 0)) + goto got_it; } else { dontbother = 0; @@ -1477,15 +1639,15 @@ S_regtry(pTHX_ regexp *prog, char *startpos) PL_reg_eval_set = RS_init; DEBUG_r(DEBUG_s( - PerlIO_printf(Perl_debug_log, " setting stack tmpbase at %i\n", - PL_stack_sp - PL_stack_base); + PerlIO_printf(Perl_debug_log, " setting stack tmpbase at %"IVdf"\n", + (IV)(PL_stack_sp - PL_stack_base)); )); - SAVEINT(cxstack[cxstack_ix].blk_oldsp); + SAVEI32(cxstack[cxstack_ix].blk_oldsp); cxstack[cxstack_ix].blk_oldsp = PL_stack_sp - PL_stack_base; /* Otherwise OP_NEXTSTATE will free whatever on stack now. */ SAVETMPS; /* Apparently this is not needed, judging by wantarray. */ - /* SAVEINT(cxstack[cxstack_ix].blk_gimme); + /* SAVEI8(cxstack[cxstack_ix].blk_gimme); cxstack[cxstack_ix].blk_gimme = G_SCALAR; */ if (PL_reg_sv) { @@ -1505,7 +1667,7 @@ S_regtry(pTHX_ regexp *prog, char *startpos) } PL_reg_magic = mg; PL_reg_oldpos = mg->mg_len; - SAVEDESTRUCTOR(restore_pos, 0); + SAVEDESTRUCTOR_X(restore_pos, 0); } if (!PL_reg_curpm) New(22,PL_reg_curpm, 1, PMOP); @@ -1641,8 +1803,8 @@ S_regmatch(pTHX_ regnode *prog) pref0_len = pref_len; regprop(prop, scan); PerlIO_printf(Perl_debug_log, - "%4i <%s%.*s%s%s%.*s%s%s%s%.*s%s>%*s|%3d:%*s%s\n", - locinput - PL_bostr, + "%4"IVdf" <%s%.*s%s%s%.*s%s%s%s%.*s%s>%*s|%3"IVdf":%*s%s\n", + (IV)(locinput - PL_bostr), PL_colors[4], pref0_len, locinput - pref_len, PL_colors[5], PL_colors[2], pref_len - pref0_len, @@ -1651,7 +1813,7 @@ S_regmatch(pTHX_ regnode *prog) PL_colors[0], l, locinput, PL_colors[1], 15 - l - pref_len + 1, "", - scan - PL_regprogram, PL_regindent*2, "", + (IV)(scan - PL_regprogram), PL_regindent*2, "", SvPVX(prop)); } ); @@ -1797,7 +1959,6 @@ S_regmatch(pTHX_ regnode *prog) nextchr = UCHARAT(locinput); break; case ANYOFUTF8: - s = MASK(scan); if (!REGINCLASSUTF8(scan, (U8*)locinput)) sayNO; if (locinput >= PL_regeol) @@ -1806,10 +1967,9 @@ S_regmatch(pTHX_ regnode *prog) nextchr = UCHARAT(locinput); break; case ANYOF: - s = MASK(scan); if (nextchr < 0) nextchr = UCHARAT(locinput); - if (!REGINCLASS(s, nextchr)) + if (!REGINCLASS(scan, nextchr)) sayNO; if (!nextchr && locinput >= PL_regeol) sayNO; @@ -2137,7 +2297,7 @@ S_regmatch(pTHX_ regnode *prog) n = ARG(scan); PL_op = (OP_4tree*)PL_regdata->data[n]; - DEBUG_r( PerlIO_printf(Perl_debug_log, " re_eval 0x%x\n", PL_op) ); + DEBUG_r( PerlIO_printf(Perl_debug_log, " re_eval 0x%"UVxf"\n", PTR2UV(PL_op)) ); PL_curpad = AvARRAY((AV*)PL_regdata->data[n + 2]); PL_regendp[0] = PL_reg_magic->mg_len = locinput - PL_bostr; @@ -2700,8 +2860,9 @@ S_regmatch(pTHX_ regnode *prog) locinput = PL_reginput; DEBUG_r( PerlIO_printf(Perl_debug_log, - "%*s matched %ld times, len=%ld...\n", - REPORT_CODE_OFF+PL_regindent*2, "", n, l) + "%*s matched %"IVdf" times, len=%"IVdf"...\n", + (int)(REPORT_CODE_OFF+PL_regindent*2), "", + (IV) n, (IV)l) ); if (n >= ln) { if (PL_regkind[(U8)OP(next)] == EXACT) { @@ -2725,8 +2886,8 @@ S_regmatch(pTHX_ regnode *prog) { DEBUG_r( PerlIO_printf(Perl_debug_log, - "%*s trying tail with n=%ld...\n", - REPORT_CODE_OFF+PL_regindent*2, "", n) + "%*s trying tail with n=%"IVdf"...\n", + (int)(REPORT_CODE_OFF+PL_regindent*2), "", (IV)n) ); if (paren) { if (n) { @@ -3047,8 +3208,8 @@ S_regmatch(pTHX_ regnode *prog) next = NULL; break; default: - PerlIO_printf(PerlIO_stderr(), "%lx %d\n", - (unsigned long)scan, OP(scan)); + PerlIO_printf(Perl_error_log, "%"UVxf" %d\n", + PTR2UV(scan), OP(scan)); Perl_croak(aTHX_ "regexp memory corruption"); } scan = next; @@ -3106,7 +3267,6 @@ S_regrepeat(pTHX_ regnode *p, I32 max) { dTHR; register char *scan; - register char *opnd; register I32 c; register char *loceol = PL_regeol; register I32 hardcount = 0; @@ -3162,8 +3322,7 @@ S_regrepeat(pTHX_ regnode *p, I32 max) } break; case ANYOF: - opnd = MASK(p); - while (scan < loceol && REGINCLASS(opnd, *scan)) + while (scan < loceol && REGINCLASS(p, *scan)) scan++; break; case ALNUM: @@ -3302,8 +3461,8 @@ S_regrepeat(pTHX_ regnode *p, I32 max) regprop(prop, p); PerlIO_printf(Perl_debug_log, - "%*s %s can match %ld times out of %ld...\n", - REPORT_CODE_OFF+1, "", SvPVX(prop),c,max); + "%*s %s can match %"IVdf" times out of %"IVdf"...\n", + REPORT_CODE_OFF+1, "", SvPVX(prop),(IV)c,(IV)max); }); return(c); @@ -3367,7 +3526,7 @@ S_regrepeat_hard(pTHX_ regnode *p, I32 max, I32 *lp) */ STATIC bool -S_reginclass(pTHX_ register char *p, register I32 c) +S_reginclass(pTHX_ register regnode *p, register I32 c) { dTHR; char flags = ANYOF_FLAGS(p); @@ -3505,7 +3664,6 @@ S_reghopmaybe(pTHX_ U8* s, I32 off) } #ifdef PERL_OBJECT -#define NO_XSLOCKS #include "XSUB.h" #endif diff --git a/regexp.h b/regexp.h index 5d787e0..9e86a1e 100644 --- a/regexp.h +++ b/regexp.h @@ -52,13 +52,13 @@ typedef struct regexp { #define ROPT_CHECK_ALL 0x00100 #define ROPT_LOOKBEHIND_SEEN 0x00200 #define ROPT_EVAL_SEEN 0x00400 -#define ROPT_TAINTED_SEEN 0x00800 /* 0xf800 of reganch is used by PMf_COMPILETIME */ #define ROPT_UTF8 0x10000 #define ROPT_NAUGHTY 0x20000 /* how exponential is this pattern? */ #define ROPT_COPY_DONE 0x40000 /* subbeg is a copy of the string */ +#define ROPT_TAINTED_SEEN 0x80000 #define RE_USE_INTUIT_NOML 0x0100000 /* Best to intuit before matching */ #define RE_USE_INTUIT_ML 0x0200000 diff --git a/run.c b/run.c index decf040..2491b93 100644 --- a/run.c +++ b/run.c @@ -22,7 +22,9 @@ Perl_runops_standard(pTHX) { dTHR; - while ( PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX) ) ; + while ( PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX) ) { + PERL_ASYNC_CHECK(); + } TAINT_NOT; return 0; @@ -40,10 +42,13 @@ Perl_runops_debug(pTHX) } do { + PERL_ASYNC_CHECK(); if (PL_debug) { if (PL_watchaddr != 0 && *PL_watchaddr != PL_watchok) - PerlIO_printf(Perl_debug_log, "WARNING: %lx changed from %lx to %lx\n", - (long)PL_watchaddr, (long)PL_watchok, (long)*PL_watchaddr); + PerlIO_printf(Perl_debug_log, + "WARNING: %"UVxf" changed from %"UVxf" to %"UVxf"\n", + PTR2UV(PL_watchaddr), PTR2UV(PL_watchok), + PTR2UV(*PL_watchaddr)); DEBUG_s(debstack()); DEBUG_t(debop(PL_op)); DEBUG_P(debprof(PL_op)); @@ -66,13 +71,13 @@ Perl_debop(pTHX_ OP *o) Perl_deb(aTHX_ "%s", PL_op_name[o->op_type]); switch (o->op_type) { case OP_CONST: - PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo->op_sv)); + PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo_sv)); break; case OP_GVSV: case OP_GV: - if (cGVOPo->op_gv) { + if (cGVOPo_gv) { sv = NEWSV(0,0); - gv_fullname3(sv, cGVOPo->op_gv, Nullch); + gv_fullname3(sv, cGVOPo_gv, Nullch); PerlIO_printf(Perl_debug_log, "(%s)", SvPV(sv, n_a)); SvREFCNT_dec(sv); } @@ -94,8 +99,8 @@ Perl_watch(pTHX_ char **addr) dTHR; PL_watchaddr = addr; PL_watchok = *addr; - PerlIO_printf(Perl_debug_log, "WATCHING, %lx is currently %lx\n", - (long)PL_watchaddr, (long)PL_watchok); + PerlIO_printf(Perl_debug_log, "WATCHING, %"UVxf" is currently %"UVxf"\n", + PTR2UV(PL_watchaddr), PTR2UV(PL_watchok)); #endif /* DEBUGGING */ } diff --git a/scope.c b/scope.c index 44c3d92..7052282 100644 --- a/scope.c +++ b/scope.c @@ -17,26 +17,27 @@ #include "perl.h" void * -Perl_default_protect(pTHX_ int *excpt, protect_body_t body, ...) +Perl_default_protect(pTHX_ volatile JMPENV *pcur_env, int *excpt, + protect_body_t body, ...) { void *ret; va_list args; va_start(args, body); - ret = vdefault_protect(excpt, body, &args); + ret = vdefault_protect(pcur_env, excpt, body, &args); va_end(args); return ret; } void * -Perl_vdefault_protect(pTHX_ int *excpt, protect_body_t body, va_list *args) +Perl_vdefault_protect(pTHX_ volatile JMPENV *pcur_env, int *excpt, + protect_body_t body, va_list *args) { dTHR; - dJMPENV; int ex; void *ret; DEBUG_l(Perl_deb(aTHX_ "Setting up local jumplevel %p, was %p\n", - &cur_env, PL_top_env)); + pcur_env, PL_top_env)); JMPENV_PUSH(ex); if (ex) ret = NULL; @@ -278,12 +279,17 @@ Perl_save_gp(pTHX_ GV *gv, I32 empty) if (empty) { register GP *gp; + Newz(602, gp, 1, GP); + if (GvCVu(gv)) PL_sub_generation++; /* taking a method out of circulation */ - Newz(602, gp, 1, GP); + if (GvIOp(gv) && (IoFLAGS(GvIOp(gv)) & IOf_ARGV)) { + gp->gp_io = newIO(); + IoFLAGS(gp->gp_io) |= IOf_ARGV|IOf_START; + } GvGP(gv) = gp_ref(gp); GvSV(gv) = NEWSV(72,0); - GvLINE(gv) = PL_curcop->cop_line; + GvLINE(gv) = CopLINE(PL_curcop); GvEGV(gv) = gv; } else { @@ -399,6 +405,16 @@ Perl_save_I16(pTHX_ I16 *intp) } void +Perl_save_I8(pTHX_ I8 *bytep) +{ + dTHR; + SSCHECK(3); + SSPUSHINT(*bytep); + SSPUSHPTR(bytep); + SSPUSHINT(SAVEt_I8); +} + +void Perl_save_iv(pTHX_ IV *ivp) { dTHR; @@ -422,6 +438,16 @@ Perl_save_pptr(pTHX_ char **pptr) } void +Perl_save_vptr(pTHX_ void *ptr) +{ + dTHR; + SSCHECK(3); + SSPUSHPTR(*(char**)ptr); + SSPUSHPTR(ptr); + SSPUSHINT(SAVEt_VPTR); +} + +void Perl_save_sptr(pTHX_ SV **sptr) { dTHR; @@ -437,8 +463,8 @@ Perl_save_threadsv(pTHX_ PADOFFSET i) #ifdef USE_THREADS dTHR; SV **svp = &THREADSV(i); /* XXX Change to save by offset */ - DEBUG_S(PerlIO_printf(PerlIO_stderr(), "save_threadsv %u: %p %p:%s\n", - i, svp, *svp, SvPEEK(*svp))); + DEBUG_S(PerlIO_printf(Perl_debug_log, "save_threadsv %"UVuf": %p %p:%s\n", + (UV)i, svp, *svp, SvPEEK(*svp))); save_svref(svp); return svp; #else @@ -541,7 +567,7 @@ Perl_save_list(pTHX_ register SV **sarg, I32 maxsarg) } void -Perl_save_destructor(pTHX_ DESTRUCTORFUNC_t f, void* p) +Perl_save_destructor(pTHX_ DESTRUCTORFUNC_NOCONTEXT_t f, void* p) { dTHR; SSCHECK(3); @@ -551,6 +577,16 @@ Perl_save_destructor(pTHX_ DESTRUCTORFUNC_t f, void* p) } void +Perl_save_destructor_x(pTHX_ DESTRUCTORFUNC_t f, void* p) +{ + dTHR; + SSCHECK(3); + SSPUSHDXPTR(f); + SSPUSHPTR(p); + SSPUSHINT(SAVEt_DESTRUCTOR_X); +} + +void Perl_save_aelem(pTHX_ AV *av, I32 idx, SV **sptr) { dTHR; @@ -646,7 +682,7 @@ Perl_leave_scope(pTHX_ I32 base) ptr = SSPOPPTR; restore_sv: sv = *(SV**)ptr; - DEBUG_S(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(Perl_debug_log, "restore svref: %p %p:%s -> %p:%s\n", ptr, sv, SvPEEK(sv), value, SvPEEK(value))); if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv) && @@ -725,6 +761,10 @@ Perl_leave_scope(pTHX_ I32 base) ptr = SSPOPPTR; *(I16*)ptr = (I16)SSPOPINT; break; + case SAVEt_I8: /* I8 reference */ + ptr = SSPOPPTR; + *(I8*)ptr = (I8)SSPOPINT; + break; case SAVEt_IV: /* IV reference */ ptr = SSPOPPTR; *(IV*)ptr = (IV)SSPOPIV; @@ -733,6 +773,7 @@ Perl_leave_scope(pTHX_ I32 base) ptr = SSPOPPTR; *(SV**)ptr = (SV*)SSPOPPTR; break; + case SAVEt_VPTR: /* random* reference */ case SAVEt_PPTR: /* char* reference */ ptr = SSPOPPTR; *(char**)ptr = (char*)SSPOPPTR; @@ -831,7 +872,11 @@ Perl_leave_scope(pTHX_ I32 base) break; case SAVEt_DESTRUCTOR: ptr = SSPOPPTR; - CALLDESTRUCTOR(aTHXo_ ptr); + (*SSPOPDPTR)(ptr); + break; + case SAVEt_DESTRUCTOR_X: + ptr = SSPOPPTR; + (*SSPOPDXPTR)(aTHXo_ ptr); break; case SAVEt_REGCONTEXT: case SAVEt_ALLOC: @@ -903,28 +948,38 @@ Perl_cx_dump(pTHX_ PERL_CONTEXT *cx) PerlIO_printf(Perl_debug_log, "CX %ld = %s\n", (long)(cx - cxstack), PL_block_type[CxTYPE(cx)]); if (CxTYPE(cx) != CXt_SUBST) { PerlIO_printf(Perl_debug_log, "BLK_OLDSP = %ld\n", (long)cx->blk_oldsp); - PerlIO_printf(Perl_debug_log, "BLK_OLDCOP = 0x%lx\n", (long)cx->blk_oldcop); + PerlIO_printf(Perl_debug_log, "BLK_OLDCOP = 0x%"UVxf"\n", + PTR2UV(cx->blk_oldcop)); PerlIO_printf(Perl_debug_log, "BLK_OLDMARKSP = %ld\n", (long)cx->blk_oldmarksp); PerlIO_printf(Perl_debug_log, "BLK_OLDSCOPESP = %ld\n", (long)cx->blk_oldscopesp); PerlIO_printf(Perl_debug_log, "BLK_OLDRETSP = %ld\n", (long)cx->blk_oldretsp); - PerlIO_printf(Perl_debug_log, "BLK_OLDPM = 0x%lx\n", (long)cx->blk_oldpm); + PerlIO_printf(Perl_debug_log, "BLK_OLDPM = 0x%"UVxf"\n", + PTR2UV(cx->blk_oldpm)); PerlIO_printf(Perl_debug_log, "BLK_GIMME = %s\n", cx->blk_gimme ? "LIST" : "SCALAR"); } switch (CxTYPE(cx)) { case CXt_NULL: case CXt_BLOCK: break; + case CXt_FORMAT: + PerlIO_printf(Perl_debug_log, "BLK_SUB.CV = 0x%"UVxf"\n", + PTR2UV(cx->blk_sub.cv)); + PerlIO_printf(Perl_debug_log, "BLK_SUB.GV = 0x%"UVxf"\n", + PTR2UV(cx->blk_sub.gv)); + PerlIO_printf(Perl_debug_log, "BLK_SUB.DFOUTGV = 0x%"UVxf"\n", + PTR2UV(cx->blk_sub.dfoutgv)); + PerlIO_printf(Perl_debug_log, "BLK_SUB.HASARGS = %d\n", + (int)cx->blk_sub.hasargs); + break; case CXt_SUB: - PerlIO_printf(Perl_debug_log, "BLK_SUB.CV = 0x%lx\n", - (long)cx->blk_sub.cv); - PerlIO_printf(Perl_debug_log, "BLK_SUB.GV = 0x%lx\n", - (long)cx->blk_sub.gv); - PerlIO_printf(Perl_debug_log, "BLK_SUB.DFOUTGV = 0x%lx\n", - (long)cx->blk_sub.dfoutgv); + PerlIO_printf(Perl_debug_log, "BLK_SUB.CV = 0x%"UVxf"\n", + PTR2UV(cx->blk_sub.cv)); PerlIO_printf(Perl_debug_log, "BLK_SUB.OLDDEPTH = %ld\n", (long)cx->blk_sub.olddepth); PerlIO_printf(Perl_debug_log, "BLK_SUB.HASARGS = %d\n", (int)cx->blk_sub.hasargs); + PerlIO_printf(Perl_debug_log, "BLK_SUB.LVAL = %d\n", + (int)cx->blk_sub.lval); break; case CXt_EVAL: PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_IN_EVAL = %ld\n", @@ -934,8 +989,8 @@ Perl_cx_dump(pTHX_ PERL_CONTEXT *cx) PL_op_desc[cx->blk_eval.old_op_type]); PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_NAME = %s\n", cx->blk_eval.old_name); - PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_EVAL_ROOT = 0x%lx\n", - (long)cx->blk_eval.old_eval_root); + PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_EVAL_ROOT = 0x%"UVxf"\n", + PTR2UV(cx->blk_eval.old_eval_root)); break; case CXt_LOOP: @@ -943,23 +998,23 @@ Perl_cx_dump(pTHX_ PERL_CONTEXT *cx) cx->blk_loop.label); PerlIO_printf(Perl_debug_log, "BLK_LOOP.RESETSP = %ld\n", (long)cx->blk_loop.resetsp); - PerlIO_printf(Perl_debug_log, "BLK_LOOP.REDO_OP = 0x%lx\n", - (long)cx->blk_loop.redo_op); - PerlIO_printf(Perl_debug_log, "BLK_LOOP.NEXT_OP = 0x%lx\n", - (long)cx->blk_loop.next_op); - PerlIO_printf(Perl_debug_log, "BLK_LOOP.LAST_OP = 0x%lx\n", - (long)cx->blk_loop.last_op); + PerlIO_printf(Perl_debug_log, "BLK_LOOP.REDO_OP = 0x%"UVxf"\n", + PTR2UV(cx->blk_loop.redo_op)); + PerlIO_printf(Perl_debug_log, "BLK_LOOP.NEXT_OP = 0x%"UVxf"\n", + PTR2UV(cx->blk_loop.next_op)); + PerlIO_printf(Perl_debug_log, "BLK_LOOP.LAST_OP = 0x%"UVxf"\n", + PTR2UV(cx->blk_loop.last_op)); PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERIX = %ld\n", (long)cx->blk_loop.iterix); - PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERARY = 0x%lx\n", - (long)cx->blk_loop.iterary); - PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERVAR = 0x%lx\n", - (long)cx->blk_loop.itervar); - if (cx->blk_loop.itervar) - PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERSAVE = 0x%lx\n", - (long)cx->blk_loop.itersave); - PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERLVAL = 0x%lx\n", - (long)cx->blk_loop.iterlval); + PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERARY = 0x%"UVxf"\n", + PTR2UV(cx->blk_loop.iterary)); + PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERVAR = 0x%"UVxf"\n", + PTR2UV(CxITERVAR(cx))); + if (CxITERVAR(cx)) + PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERSAVE = 0x%"UVxf"\n", + PTR2UV(cx->blk_loop.itersave)); + PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERLVAL = 0x%"UVxf"\n", + PTR2UV(cx->blk_loop.iterlval)); break; case CXt_SUBST: @@ -973,18 +1028,18 @@ Perl_cx_dump(pTHX_ PERL_CONTEXT *cx) (long)cx->sb_once); PerlIO_printf(Perl_debug_log, "SB_ORIG = %s\n", cx->sb_orig); - PerlIO_printf(Perl_debug_log, "SB_DSTR = 0x%lx\n", - (long)cx->sb_dstr); - PerlIO_printf(Perl_debug_log, "SB_TARG = 0x%lx\n", - (long)cx->sb_targ); - PerlIO_printf(Perl_debug_log, "SB_S = 0x%lx\n", - (long)cx->sb_s); - PerlIO_printf(Perl_debug_log, "SB_M = 0x%lx\n", - (long)cx->sb_m); - PerlIO_printf(Perl_debug_log, "SB_STREND = 0x%lx\n", - (long)cx->sb_strend); - PerlIO_printf(Perl_debug_log, "SB_RXRES = 0x%lx\n", - (long)cx->sb_rxres); + PerlIO_printf(Perl_debug_log, "SB_DSTR = 0x%"UVxf"\n", + PTR2UV(cx->sb_dstr)); + PerlIO_printf(Perl_debug_log, "SB_TARG = 0x%"UVxf"\n", + PTR2UV(cx->sb_targ)); + PerlIO_printf(Perl_debug_log, "SB_S = 0x%"UVxf"\n", + PTR2UV(cx->sb_s)); + PerlIO_printf(Perl_debug_log, "SB_M = 0x%"UVxf"\n", + PTR2UV(cx->sb_m)); + PerlIO_printf(Perl_debug_log, "SB_STREND = 0x%"UVxf"\n", + PTR2UV(cx->sb_strend)); + PerlIO_printf(Perl_debug_log, "SB_RXRES = 0x%"UVxf"\n", + PTR2UV(cx->sb_rxres)); break; } #endif /* DEBUGGING */ diff --git a/scope.h b/scope.h index efaf589..6944630 100644 --- a/scope.h +++ b/scope.h @@ -28,6 +28,9 @@ #define SAVEt_HINTS 27 #define SAVEt_ALLOC 28 #define SAVEt_GENERIC_SVREF 29 +#define SAVEt_DESTRUCTOR_X 30 +#define SAVEt_VPTR 31 +#define SAVEt_I8 32 #define SSCHECK(need) if (PL_savestack_ix + need > PL_savestack_max) savestack_grow() #define SSPUSHINT(i) (PL_savestack[PL_savestack_ix++].any_i32 = (I32)(i)) @@ -35,11 +38,13 @@ #define SSPUSHIV(i) (PL_savestack[PL_savestack_ix++].any_iv = (IV)(i)) #define SSPUSHPTR(p) (PL_savestack[PL_savestack_ix++].any_ptr = (void*)(p)) #define SSPUSHDPTR(p) (PL_savestack[PL_savestack_ix++].any_dptr = (p)) +#define SSPUSHDXPTR(p) (PL_savestack[PL_savestack_ix++].any_dxptr = (p)) #define SSPOPINT (PL_savestack[--PL_savestack_ix].any_i32) #define SSPOPLONG (PL_savestack[--PL_savestack_ix].any_long) #define SSPOPIV (PL_savestack[--PL_savestack_ix].any_iv) #define SSPOPPTR (PL_savestack[--PL_savestack_ix].any_ptr) #define SSPOPDPTR (PL_savestack[--PL_savestack_ix].any_dptr) +#define SSPOPDXPTR (PL_savestack[--PL_savestack_ix].any_dxptr) #define SAVETMPS save_int((int*)&PL_tmps_floor), PL_tmps_floor = PL_tmps_ix #define FREETMPS if (PL_tmps_ix > PL_tmps_floor) free_tmps() @@ -67,6 +72,7 @@ * Not using SOFT_CAST on SAVESPTR, SAVEGENERICSV and SAVEFREESV * because these are used for several kinds of pointer values */ +#define SAVEI8(i) save_I8(SOFT_CAST(I8*)&(i)) #define SAVEI16(i) save_I16(SOFT_CAST(I16*)&(i)) #define SAVEI32(i) save_I32(SOFT_CAST(I32*)&(i)) #define SAVEINT(i) save_int(SOFT_CAST(int*)&(i)) @@ -74,6 +80,7 @@ #define SAVELONG(l) save_long(SOFT_CAST(long*)&(l)) #define SAVESPTR(s) save_sptr((SV**)&(s)) #define SAVEPPTR(s) save_pptr(SOFT_CAST(char**)&(s)) +#define SAVEVPTR(s) save_vptr((void*)&(s)) #define SAVEFREESV(s) save_freesv((SV*)(s)) #define SAVEFREEOP(o) save_freeop(SOFT_CAST(OP*)(o)) #define SAVEFREEPV(p) save_freepv(SOFT_CAST(char*)(p)) @@ -81,9 +88,11 @@ #define SAVEGENERICSV(s) save_generic_svref((SV**)&(s)) #define SAVEDELETE(h,k,l) \ save_delete(SOFT_CAST(HV*)(h), SOFT_CAST(char*)(k), (I32)(l)) -#define CALLDESTRUCTOR (*SSPOPDPTR) #define SAVEDESTRUCTOR(f,p) \ - save_destructor((DESTRUCTORFUNC_t)(f), SOFT_CAST(void*)(p)) + save_destructor((DESTRUCTORFUNC_NOCONTEXT_t)(f), SOFT_CAST(void*)(p)) + +#define SAVEDESTRUCTOR_X(f,p) \ + save_destructor_x((DESTRUCTORFUNC_t)(f), SOFT_CAST(void*)(p)) #define SAVESTACK_POS() \ STMT_START { \ @@ -105,6 +114,16 @@ } \ } STMT_END +#ifdef USE_ITHREADS +# define SAVECOPSTASH(cop) SAVEPPTR(CopSTASHPV(cop)) +# define SAVECOPFILE(cop) SAVEPPTR(CopFILE(cop)) +#else +# define SAVECOPSTASH(cop) SAVESPTR(CopSTASH(cop)) +# define SAVECOPFILE(cop) SAVESPTR(CopFILEGV(cop)) +#endif + +#define SAVECOPLINE(cop) SAVEI16(CopLINE(cop)) + /* SSNEW() temporarily allocates a specified number of bytes of data on the * savestack. It returns an integer index into the savestack, because a * pointer would get broken if the savestack is moved on reallocation. @@ -143,6 +162,7 @@ struct jmpenv { int je_ret; /* last exception thrown */ bool je_mustcatch; /* need to call longjmp()? */ void (*je_throw)(int v); /* last for bincompat */ + bool je_noset; /* no need for setjmp() */ }; typedef struct jmpenv JMPENV; @@ -152,7 +172,8 @@ typedef struct jmpenv JMPENV; * body of protected processing. */ typedef void *(CPERLscope(*protect_body_t)) (pTHX_ va_list); -typedef void *(CPERLscope(*protect_proc_t)) (pTHX_ int *, protect_body_t, ...); +typedef void *(CPERLscope(*protect_proc_t)) (pTHX_ volatile JMPENV *pcur_env, + int *, protect_body_t, ...); /* * How to build the first jmpenv. @@ -170,6 +191,7 @@ typedef void *(CPERLscope(*protect_proc_t)) (pTHX_ int *, protect_body_t, ...); PL_start_env.je_throw = NULL; \ PL_start_env.je_ret = -1; \ PL_start_env.je_mustcatch = TRUE; \ + PL_start_env.je_noset = 0; \ PL_top_env = &PL_start_env; \ } STMT_END @@ -211,43 +233,49 @@ typedef void *(CPERLscope(*protect_proc_t)) (pTHX_ int *, protect_body_t, ...); * JMPENV_POP; // don't forget this! */ -#define dJMPENV JMPENV cur_env +#define dJMPENV JMPENV cur_env; \ + volatile JMPENV *pcur_env = ((cur_env.je_noset = 0),&cur_env) -#define JMPENV_PUSH_INIT_ENV(cur_env,THROWFUNC) \ +#define JMPENV_PUSH_INIT_ENV(ce,THROWFUNC) \ STMT_START { \ - cur_env.je_throw = (THROWFUNC); \ - cur_env.je_ret = -1; \ - cur_env.je_mustcatch = FALSE; \ - cur_env.je_prev = PL_top_env; \ - PL_top_env = &cur_env; \ + (ce).je_throw = (THROWFUNC); \ + (ce).je_ret = -1; \ + (ce).je_mustcatch = FALSE; \ + (ce).je_prev = PL_top_env; \ + PL_top_env = &(ce); \ OP_REG_TO_MEM; \ } STMT_END -#define JMPENV_PUSH_INIT(THROWFUNC) JMPENV_PUSH_INIT_ENV(cur_env,THROWFUNC) +#define JMPENV_PUSH_INIT(THROWFUNC) JMPENV_PUSH_INIT_ENV(*(JMPENV*)pcur_env,THROWFUNC) -#define JMPENV_POST_CATCH_ENV(cur_env) \ +#define JMPENV_POST_CATCH_ENV(ce) \ STMT_START { \ OP_MEM_TO_REG; \ - PL_top_env = &cur_env; \ + PL_top_env = &(ce); \ } STMT_END -#define JMPENV_POST_CATCH JMPENV_POST_CATCH_ENV(cur_env) +#define JMPENV_POST_CATCH JMPENV_POST_CATCH_ENV(*(JMPENV*)pcur_env) -#define JMPENV_PUSH_ENV(cur_env,v) \ - STMT_START { \ - JMPENV_PUSH_INIT_ENV(cur_env,NULL); \ - EXCEPT_SET_ENV(cur_env,PerlProc_setjmp(cur_env.je_buf, 1)); \ - JMPENV_POST_CATCH_ENV(cur_env); \ - (v) = EXCEPT_GET_ENV(cur_env); \ +#define JMPENV_PUSH_ENV(ce,v) \ + STMT_START { \ + if (!(ce).je_noset) { \ + JMPENV_PUSH_INIT_ENV(ce,NULL); \ + EXCEPT_SET_ENV(ce,PerlProc_setjmp((ce).je_buf, 1));\ + (ce).je_noset = 1; \ + } \ + else \ + EXCEPT_SET_ENV(ce,0); \ + JMPENV_POST_CATCH_ENV(ce); \ + (v) = EXCEPT_GET_ENV(ce); \ } STMT_END -#define JMPENV_PUSH(v) JMPENV_PUSH_ENV(cur_env,v) +#define JMPENV_PUSH(v) JMPENV_PUSH_ENV(*(JMPENV*)pcur_env,v) -#define JMPENV_POP_ENV(cur_env) \ - STMT_START { PL_top_env = cur_env.je_prev; } STMT_END +#define JMPENV_POP_ENV(ce) \ + STMT_START { PL_top_env = (ce).je_prev; } STMT_END -#define JMPENV_POP JMPENV_POP_ENV(cur_env) +#define JMPENV_POP JMPENV_POP_ENV(*(JMPENV*)pcur_env) #define JMPENV_JUMP(v) \ STMT_START { \ @@ -260,15 +288,14 @@ typedef void *(CPERLscope(*protect_proc_t)) (pTHX_ int *, protect_body_t, ...); } \ if ((v) == 2) \ PerlProc_exit(STATUS_NATIVE_EXPORT); \ - PerlIO_printf(PerlIO_stderr(), "panic: top_env\n"); \ + PerlIO_printf(Perl_error_log, "panic: top_env\n"); \ PerlProc_exit(1); \ } STMT_END -#define EXCEPT_GET_ENV(cur_env) (cur_env.je_ret) -#define EXCEPT_GET EXCEPT_GET_ENV(cur_env) -#define EXCEPT_SET_ENV(cur_env,v) (cur_env.je_ret = (v)) -#define EXCEPT_SET(v) EXCEPT_SET_ENV(cur_env,v) +#define EXCEPT_GET_ENV(ce) ((ce).je_ret) +#define EXCEPT_GET EXCEPT_GET_ENV(*(JMPENV*)pcur_env) +#define EXCEPT_SET_ENV(ce,v) ((ce).je_ret = (v)) +#define EXCEPT_SET(v) EXCEPT_SET_ENV(*(JMPENV*)pcur_env,v) -#define CATCH_GET (PL_top_env->je_mustcatch) -#define CATCH_SET(v) (PL_top_env->je_mustcatch = (v)) - +#define CATCH_GET (PL_top_env->je_mustcatch) +#define CATCH_SET(v) (PL_top_env->je_mustcatch = (v)) diff --git a/sv.c b/sv.c index ba5833f..0b838a1 100644 --- a/sv.c +++ b/sv.c @@ -186,7 +186,8 @@ S_del_sv(pTHX_ SV *p) if (!ok) { if (ckWARN_d(WARN_INTERNAL)) Perl_warner(aTHX_ WARN_INTERNAL, - "Attempt to free non-arena SV: 0x%lx", (unsigned long)p); + "Attempt to free non-arena SV: 0x%"UVxf, + PTR2UV(p)); return; } } @@ -315,6 +316,16 @@ Perl_sv_free_arenas(pTHX) PL_sv_root = 0; } +void +Perl_report_uninit(pTHX) +{ + if (PL_op) + Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit, + " in ", PL_op_desc[PL_op->op_type]); + else + Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit, "", ""); +} + STATIC XPVIV* S_new_xiv(pTHX) { @@ -1206,7 +1217,8 @@ Perl_sv_grow(pTHX_ register SV *sv, register STRLEN newlen) #ifdef HAS_64K_LIMIT if (newlen >= 0x10000) { - PerlIO_printf(Perl_debug_log, "Allocation too large: %lx\n", newlen); + PerlIO_printf(Perl_debug_log, + "Allocation too large: %"UVxf"\n", (UV)newlen); my_exit(1); } #endif /* HAS_64K_LIMIT */ @@ -1425,7 +1437,7 @@ Perl_sv_2iv(pTHX_ register SV *sv) if (!(SvFLAGS(sv) & SVs_PADTMP)) { dTHR; if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing) - Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit); + report_uninit(); } return 0; } @@ -1440,7 +1452,7 @@ Perl_sv_2iv(pTHX_ register SV *sv) if (SvREADONLY(sv) && !SvOK(sv)) { dTHR; if (ckWARN(WARN_UNINITIALIZED)) - Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit); + report_uninit(); return 0; } } @@ -1468,17 +1480,11 @@ Perl_sv_2iv(pTHX_ register SV *sv) SvUVX(sv) = U_V(SvNVX(sv)); SvIsUV_on(sv); ret_iv_max: -#ifdef IV_IS_QUAD DEBUG_c(PerlIO_printf(Perl_debug_log, - "0x%" PERL_PRIx64 " 2iv(%" PERL_PRIu64 " => %" PERL_PRId64 ") (as unsigned)\n", + "0x%"UVxf" 2iv(%"UVuf" => %"IVdf") (as unsigned)\n", PTR2UV(sv), - (UV)SvUVX(sv), (IV)SvUVX(sv))); -#else - DEBUG_c(PerlIO_printf(Perl_debug_log, - "0x%lx 2iv(%lu => %ld) (as unsigned)\n", - (unsigned long)sv, - (unsigned long)SvUVX(sv), (long)(IV)SvUVX(sv))); -#endif + SvUVX(sv), + SvUVX(sv))); return (IV)SvUVX(sv); } } @@ -1506,11 +1512,11 @@ Perl_sv_2iv(pTHX_ register SV *sv) (void)SvNOK_on(sv); (void)SvIOK_on(sv); #if defined(USE_LONG_DOUBLE) - DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%" PERL_PRIgldbl ")\n", - (unsigned long)sv, SvNVX(sv))); + DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2nv(%" PERL_PRIgldbl ")\n", + PTR2UV(sv), SvNVX(sv))); #else - DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%g)\n", - (unsigned long)sv, SvNVX(sv))); + DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2nv(%g)\n", + PTR2UV(sv), SvNVX(sv))); #endif if (SvNVX(sv) < (NV)IV_MAX + 0.5) SvIVX(sv) = I_V(SvNVX(sv)); @@ -1542,14 +1548,14 @@ Perl_sv_2iv(pTHX_ register SV *sv) else { dTHR; if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP)) - Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit); + report_uninit(); if (SvTYPE(sv) < SVt_IV) /* Typically the caller expects that sv_any is not NULL now. */ sv_upgrade(sv, SVt_IV); return 0; } - DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2iv(%ld)\n", - (unsigned long)sv,(long)SvIVX(sv))); + DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2iv(%"IVdf")\n", + PTR2UV(sv),SvIVX(sv))); return SvIsUV(sv) ? (IV)SvUVX(sv) : SvIVX(sv); } @@ -1570,7 +1576,7 @@ Perl_sv_2uv(pTHX_ register SV *sv) if (!(SvFLAGS(sv) & SVs_PADTMP)) { dTHR; if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing) - Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit); + report_uninit(); } return 0; } @@ -1585,7 +1591,7 @@ Perl_sv_2uv(pTHX_ register SV *sv) if (SvREADONLY(sv) && !SvOK(sv)) { dTHR; if (ckWARN(WARN_UNINITIALIZED)) - Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit); + report_uninit(); return 0; } } @@ -1612,17 +1618,11 @@ Perl_sv_2uv(pTHX_ register SV *sv) else { SvIVX(sv) = I_V(SvNVX(sv)); ret_zero: -#ifdef IV_IS_QUAD DEBUG_c(PerlIO_printf(Perl_debug_log, - "0x%" PERL_PRIx64 " 2uv(%" PERL_PRId64 " => %" PERL_PRIu64 ") (as signed)\n", - (unsigned long)sv,(long)SvIVX(sv), - (long)(UV)SvIVX(sv))); -#else - DEBUG_c(PerlIO_printf(Perl_debug_log, - "0x%lx 2uv(%ld => %lu) (as signed)\n", - (unsigned long)sv,(long)SvIVX(sv), - (long)(UV)SvIVX(sv))); -#endif + "0x%"UVxf" 2uv(%"IVdf" => %"IVdf") (as signed)\n", + PTR2UV(sv), + SvIVX(sv), + (IV)(UV)SvIVX(sv))); return (UV)SvIVX(sv); } } @@ -1650,11 +1650,13 @@ Perl_sv_2uv(pTHX_ register SV *sv) (void)SvNOK_on(sv); (void)SvIOK_on(sv); #if defined(USE_LONG_DOUBLE) - DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%" PERL_PRIgldbl ")\n", - (unsigned long)sv, SvNVX(sv))); + DEBUG_c(PerlIO_printf(Perl_debug_log, + "0x%"UVxf" 2nv(%" PERL_PRIgldbl ")\n", + PTR2UV(sv), SvNVX(sv))); #else - DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%g)\n", - (unsigned long)sv, SvNVX(sv))); + DEBUG_c(PerlIO_printf(Perl_debug_log, + "0x%"UVxf" 2nv(%g)\n", + PTR2UV(sv), SvNVX(sv))); #endif if (SvNVX(sv) < -0.5) { SvIVX(sv) = I_V(SvNVX(sv)); @@ -1703,7 +1705,7 @@ Perl_sv_2uv(pTHX_ register SV *sv) if (!(SvFLAGS(sv) & SVs_PADTMP)) { dTHR; if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing) - Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit); + report_uninit(); } if (SvTYPE(sv) < SVt_IV) /* Typically the caller expects that sv_any is not NULL now. */ @@ -1711,8 +1713,8 @@ Perl_sv_2uv(pTHX_ register SV *sv) return 0; } - DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2uv(%lu)\n", - (unsigned long)sv,SvUVX(sv))); + DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2uv(%"UVuf")\n", + PTR2UV(sv),SvUVX(sv))); return SvIsUV(sv) ? SvUVX(sv) : (UV)SvIVX(sv); } @@ -1741,7 +1743,7 @@ Perl_sv_2nv(pTHX_ register SV *sv) if (!(SvFLAGS(sv) & SVs_PADTMP)) { dTHR; if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing) - Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit); + report_uninit(); } return 0; } @@ -1756,7 +1758,7 @@ Perl_sv_2nv(pTHX_ register SV *sv) if (SvREADONLY(sv) && !SvOK(sv)) { dTHR; if (ckWARN(WARN_UNINITIALIZED)) - Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit); + report_uninit(); return 0.0; } } @@ -1768,15 +1770,16 @@ Perl_sv_2nv(pTHX_ register SV *sv) #if defined(USE_LONG_DOUBLE) DEBUG_c({ RESTORE_NUMERIC_STANDARD(); - PerlIO_printf(Perl_debug_log, "0x%lx num(%" PERL_PRIgldbl ")\n", - (unsigned long)sv, SvNVX(sv)); + PerlIO_printf(Perl_debug_log, + "0x%"UVxf" num(%" PERL_PRIgldbl ")\n", + PTR2UV(sv), SvNVX(sv)); RESTORE_NUMERIC_LOCAL(); }); #else DEBUG_c({ RESTORE_NUMERIC_STANDARD(); - PerlIO_printf(Perl_debug_log, "0x%lx num(%g)\n", - (unsigned long)sv, SvNVX(sv)); + PerlIO_printf(Perl_debug_log, "0x%"UVxf" num(%g)\n", + PTR2UV(sv), SvNVX(sv)); RESTORE_NUMERIC_LOCAL(); }); #endif @@ -1797,7 +1800,7 @@ Perl_sv_2nv(pTHX_ register SV *sv) else { dTHR; if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP)) - Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit); + report_uninit(); if (SvTYPE(sv) < SVt_NV) /* Typically the caller expects that sv_any is not NULL now. */ sv_upgrade(sv, SVt_NV); @@ -1807,15 +1810,15 @@ Perl_sv_2nv(pTHX_ register SV *sv) #if defined(USE_LONG_DOUBLE) DEBUG_c({ RESTORE_NUMERIC_STANDARD(); - PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%" PERL_PRIgldbl ")\n", - (unsigned long)sv, SvNVX(sv)); + PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2nv(%" PERL_PRIgldbl ")\n", + PTR2UV(sv), SvNVX(sv)); RESTORE_NUMERIC_LOCAL(); }); #else DEBUG_c({ RESTORE_NUMERIC_STANDARD(); - PerlIO_printf(Perl_debug_log, "0x%lx 1nv(%g)\n", - (unsigned long)sv, SvNVX(sv)); + PerlIO_printf(Perl_debug_log, "0x%"UVxf" 1nv(%g)\n", + PTR2UV(sv), SvNVX(sv)); RESTORE_NUMERIC_LOCAL(); }); #endif @@ -2026,17 +2029,10 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp) return SvPVX(sv); } if (SvIOKp(sv)) { -#ifdef IV_IS_QUAD if (SvIsUV(sv)) - (void)sprintf(tmpbuf,"%" PERL_PRIu64,(UV)SvUVX(sv)); + (void)sprintf(tmpbuf,"%"UVuf, (UV)SvUVX(sv)); else - (void)sprintf(tmpbuf,"%" PERL_PRId64,(IV)SvIVX(sv)); -#else - if (SvIsUV(sv)) - (void)sprintf(tmpbuf,"%lu",(unsigned long)SvUVX(sv)); - else - (void)sprintf(tmpbuf,"%ld",(long)SvIVX(sv)); -#endif + (void)sprintf(tmpbuf,"%"IVdf, (IV)SvIVX(sv)); tsv = Nullsv; goto tokensave; } @@ -2049,7 +2045,7 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp) if (!(SvFLAGS(sv) & SVs_PADTMP)) { dTHR; if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing) - Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit); + report_uninit(); } *lp = 0; return ""; @@ -2134,11 +2130,7 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp) Perl_sv_setpvf(aTHX_ tsv, "%s=%s", HvNAME(SvSTASH(sv)), s); else sv_setpv(tsv, s); -#ifdef IV_IS_QUAD - Perl_sv_catpvf(aTHX_ tsv, "(0x%" PERL_PRIx64")", PTR2UV(sv)); -#else - Perl_sv_catpvf(aTHX_ tsv, "(0x%lx)", (unsigned long)sv); -#endif + Perl_sv_catpvf(aTHX_ tsv, "(0x%"UVxf")", PTR2UV(sv)); goto tokensaveref; } *lp = strlen(s); @@ -2147,7 +2139,7 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp) if (SvREADONLY(sv) && !SvOK(sv)) { dTHR; if (ckWARN(WARN_UNINITIALIZED)) - Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit); + report_uninit(); *lp = 0; return ""; } @@ -2211,7 +2203,7 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp) if (ckWARN(WARN_UNINITIALIZED) && !PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP)) { - Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit); + report_uninit(); } *lp = 0; if (SvTYPE(sv) < SVt_PV) @@ -2222,8 +2214,8 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp) *lp = s - SvPVX(sv); SvCUR_set(sv, *lp); SvPOK_on(sv); - DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2pv(%s)\n", - (unsigned long)sv,SvPVX(sv))); + DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2pv(%s)\n", + PTR2UV(sv),SvPVX(sv))); return SvPVX(sv); tokensave: @@ -2266,6 +2258,30 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp) } } +char * +Perl_sv_2pvbyte_nolen(pTHX_ register SV *sv) +{ + return sv_2pv_nolen(sv); +} + +char * +Perl_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp) +{ + return sv_2pv(sv,lp); +} + +char * +Perl_sv_2pvutf8_nolen(pTHX_ register SV *sv) +{ + return sv_2pv_nolen(sv); +} + +char * +Perl_sv_2pvutf8(pTHX_ register SV *sv, STRLEN *lp) +{ + return sv_2pv(sv,lp); +} + /* This function is only called on magical items */ bool Perl_sv_2bool(pTHX_ register SV *sv) @@ -2387,8 +2403,11 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr) SvTYPE(SvRV(sstr)) == SVt_PVGV) { sstr = SvRV(sstr); if (sstr == dstr) { - if (PL_curcop->cop_stash != GvSTASH(dstr)) + if (GvIMPORTED(dstr) != GVf_IMPORTED + && CopSTASH_ne(PL_curcop, GvSTASH(dstr))) + { GvIMPORTED_on(dstr); + } GvMULTI_on(dstr); return; } @@ -2442,8 +2461,11 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr) gp_free((GV*)dstr); GvGP(dstr) = gp_ref(GvGP(sstr)); SvTAINT(dstr); - if (PL_curcop->cop_stash != GvSTASH(dstr)) + if (GvIMPORTED(dstr) != GVf_IMPORTED + && CopSTASH_ne(PL_curcop, GvSTASH(dstr))) + { GvIMPORTED_on(dstr); + } GvMULTI_on(dstr); return; } @@ -2475,12 +2497,12 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr) if (intro) { GP *gp; - GvGP(dstr)->gp_refcnt--; + gp_free((GV*)dstr); GvINTRO_off(dstr); /* one-shot flag */ Newz(602,gp, 1, GP); GvGP(dstr) = gp_ref(gp); GvSV(dstr) = NEWSV(72,0); - GvLINE(dstr) = PL_curcop->cop_line; + GvLINE(dstr) = CopLINE(PL_curcop); GvEGV(dstr) = (GV*)dstr; } GvMULTI_on(dstr); @@ -2491,8 +2513,11 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr) else dref = (SV*)GvAV(dstr); GvAV(dstr) = (AV*)sref; - if (PL_curcop->cop_stash != GvSTASH(dstr)) + if (GvIMPORTED_AV_off(dstr) + && CopSTASH_ne(PL_curcop, GvSTASH(dstr))) + { GvIMPORTED_AV_on(dstr); + } break; case SVt_PVHV: if (intro) @@ -2500,8 +2525,11 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr) else dref = (SV*)GvHV(dstr); GvHV(dstr) = (HV*)sref; - if (PL_curcop->cop_stash != GvSTASH(dstr)) + if (GvIMPORTED_HV_off(dstr) + && CopSTASH_ne(PL_curcop, GvSTASH(dstr))) + { GvIMPORTED_HV_on(dstr); + } break; case SVt_PVCV: if (intro) { @@ -2553,8 +2581,11 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr) GvASSUMECV_on(dstr); PL_sub_generation++; } - if (PL_curcop->cop_stash != GvSTASH(dstr)) + if (GvIMPORTED_CV_off(dstr) + && CopSTASH_ne(PL_curcop, GvSTASH(dstr))) + { GvIMPORTED_CV_on(dstr); + } break; case SVt_PVIO: if (intro) @@ -2569,8 +2600,11 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr) else dref = (SV*)GvSV(dstr); GvSV(dstr) = sref; - if (PL_curcop->cop_stash != GvSTASH(dstr)) + if (GvIMPORTED_SV_off(dstr) + && CopSTASH_ne(PL_curcop, GvSTASH(dstr))) + { GvIMPORTED_SV_on(dstr); + } break; } if (dref) @@ -2645,6 +2679,8 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr) *SvEND(dstr) = '\0'; (void)SvPOK_only(dstr); } + if (SvUTF8(sstr)) + SvUTF8_on(dstr); /*SUPPRESS 560*/ if (sflags & SVp_NOK) { SvNOK_on(dstr); @@ -3075,7 +3111,7 @@ Perl_sv_unmagic(pTHX_ SV *sv, int type) if (mg->mg_type == type) { MGVTBL* vtbl = mg->mg_virtual; *mgp = mg->mg_moremagic; - if (vtbl && (vtbl->svt_free != NULL)) + if (vtbl && vtbl->svt_free) CALL_FPTR(vtbl->svt_free)(aTHX_ sv, mg); if (mg->mg_ptr && mg->mg_type != 'g') if (mg->mg_len >= 0) @@ -3174,6 +3210,7 @@ Perl_sv_insert(pTHX_ SV *bigstr, STRLEN offset, STRLEN len, char *little, STRLEN SvCUR_set(bigstr, offset+len); } + SvTAINT(bigstr); i = littlelen - len; if (i > 0) { /* string might grow */ big = SvGROW(bigstr, SvCUR(bigstr) + i + 1); @@ -3336,10 +3373,9 @@ Perl_sv_clear(pTHX_ register SV *sv) { io_close((IO*)sv, FALSE); } - if (IoDIRP(sv)) { + if (IoDIRP(sv) && !(IoFLAGS(sv) & IOf_FAKE_DIRP)) PerlDir_close(IoDIRP(sv)); - IoDIRP(sv) = 0; - } + IoDIRP(sv) = (DIR*)NULL; Safefree(IoTOP_NAME(sv)); Safefree(IoFMT_NAME(sv)); Safefree(IoBOTTOM_NAME(sv)); @@ -3489,7 +3525,8 @@ Perl_sv_free(pTHX_ SV *sv) if (SvTEMP(sv)) { if (ckWARN_d(WARN_DEBUGGING)) Perl_warner(aTHX_ WARN_DEBUGGING, - "Attempt to free temp prematurely: SV 0x%lx", (unsigned long)sv); + "Attempt to free temp prematurely: SV 0x%"UVxf, + PTR2UV(sv)); return; } #endif @@ -3868,11 +3905,11 @@ Perl_sv_gets(pTHX_ register SV *sv, register PerlIO *fp, I32 append) bp = (STDCHAR*)SvPVX(sv) + append; /* move these two too to registers */ ptr = (STDCHAR*)PerlIO_get_ptr(fp); DEBUG_P(PerlIO_printf(Perl_debug_log, - "Screamer: entering, ptr=%ld, cnt=%ld\n",(long)ptr,(long)cnt)); + "Screamer: entering, ptr=%"UVuf", cnt=%ld\n",PTR2UV(ptr),(long)cnt)); DEBUG_P(PerlIO_printf(Perl_debug_log, - "Screamer: entering: FILE * thinks ptr=%ld, cnt=%ld, base=%ld\n", - (long)PerlIO_get_ptr(fp), (long)PerlIO_get_cnt(fp), - (long)(PerlIO_has_base(fp) ? PerlIO_get_base(fp) : 0))); + "Screamer: entering: FILE * thinks ptr=%"UVuf", cnt=%ld, base=%"UVuf"\n", + PTR2UV(PerlIO_get_ptr(fp)), (long)PerlIO_get_cnt(fp), + PTR2UV(PerlIO_has_base(fp) ? PerlIO_get_base(fp) : 0))); for (;;) { screamer: if (cnt > 0) { @@ -3902,24 +3939,25 @@ Perl_sv_gets(pTHX_ register SV *sv, register PerlIO *fp, I32 append) } DEBUG_P(PerlIO_printf(Perl_debug_log, - "Screamer: going to getc, ptr=%ld, cnt=%ld\n",(long)ptr,(long)cnt)); + "Screamer: going to getc, ptr=%"UVuf", cnt=%ld\n", + PTR2UV(ptr),(long)cnt)); PerlIO_set_ptrcnt(fp, ptr, cnt); /* deregisterize cnt and ptr */ DEBUG_P(PerlIO_printf(Perl_debug_log, - "Screamer: pre: FILE * thinks ptr=%ld, cnt=%ld, base=%ld\n", - (long)PerlIO_get_ptr(fp), (long)PerlIO_get_cnt(fp), - (long)(PerlIO_has_base (fp) ? PerlIO_get_base(fp) : 0))); + "Screamer: pre: FILE * thinks ptr=%"UVuf", cnt=%ld, base=%"UVuf"\n", + PTR2UV(PerlIO_get_ptr(fp)), (long)PerlIO_get_cnt(fp), + PTR2UV(PerlIO_has_base (fp) ? PerlIO_get_base(fp) : 0))); /* This used to call 'filbuf' in stdio form, but as that behaves like getc when cnt <= 0 we use PerlIO_getc here to avoid introducing another abstraction. */ i = PerlIO_getc(fp); /* get more characters */ DEBUG_P(PerlIO_printf(Perl_debug_log, - "Screamer: post: FILE * thinks ptr=%ld, cnt=%ld, base=%ld\n", - (long)PerlIO_get_ptr(fp), (long)PerlIO_get_cnt(fp), - (long)(PerlIO_has_base (fp) ? PerlIO_get_base(fp) : 0))); + "Screamer: post: FILE * thinks ptr=%"UVuf", cnt=%ld, base=%"UVuf"\n", + PTR2UV(PerlIO_get_ptr(fp)), (long)PerlIO_get_cnt(fp), + PTR2UV(PerlIO_has_base (fp) ? PerlIO_get_base(fp) : 0))); cnt = PerlIO_get_cnt(fp); ptr = (STDCHAR*)PerlIO_get_ptr(fp); /* reregisterize cnt and ptr */ DEBUG_P(PerlIO_printf(Perl_debug_log, - "Screamer: after getc, ptr=%ld, cnt=%ld\n",(long)ptr,(long)cnt)); + "Screamer: after getc, ptr=%"UVuf", cnt=%ld\n",PTR2UV(ptr),(long)cnt)); if (i == EOF) /* all done for ever? */ goto thats_really_all_folks; @@ -3943,12 +3981,12 @@ thats_really_all_folks: if (shortbuffered) cnt += shortbuffered; DEBUG_P(PerlIO_printf(Perl_debug_log, - "Screamer: quitting, ptr=%ld, cnt=%ld\n",(long)ptr,(long)cnt)); + "Screamer: quitting, ptr=%"UVuf", cnt=%ld\n",PTR2UV(ptr),(long)cnt)); PerlIO_set_ptrcnt(fp, ptr, cnt); /* put these back or we're in trouble */ DEBUG_P(PerlIO_printf(Perl_debug_log, - "Screamer: end: FILE * thinks ptr=%ld, cnt=%ld, base=%ld\n", - (long)PerlIO_get_ptr(fp), (long)PerlIO_get_cnt(fp), - (long)(PerlIO_has_base (fp) ? PerlIO_get_base(fp) : 0))); + "Screamer: end: FILE * thinks ptr=%"UVuf", cnt=%ld, base=%"UVuf"\n", + PTR2UV(PerlIO_get_ptr(fp)), (long)PerlIO_get_cnt(fp), + PTR2UV(PerlIO_has_base (fp) ? PerlIO_get_base(fp) : 0))); *bp = '\0'; SvCUR_set(sv, bp - (STDCHAR*)SvPVX(sv)); /* set length */ DEBUG_P(PerlIO_printf(Perl_debug_log, @@ -4021,10 +4059,6 @@ screamer2: } } -#ifdef WIN32 - win32_strip_return(sv); -#endif - return (SvCUR(sv) - append) ? SvPVX(sv) : Nullch; } @@ -4651,14 +4685,50 @@ Perl_sv_pvn_force(pTHX_ SV *sv, STRLEN *lp) if (!SvPOK(sv)) { SvPOK_on(sv); /* validate pointer */ SvTAINT(sv); - DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2pv(%s)\n", - (unsigned long)sv,SvPVX(sv))); + DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2pv(%s)\n", + PTR2UV(sv),SvPVX(sv))); } } return SvPVX(sv); } char * +Perl_sv_pvbyte(pTHX_ SV *sv) +{ + return sv_pv(sv); +} + +char * +Perl_sv_pvbyten(pTHX_ SV *sv, STRLEN *lp) +{ + return sv_pvn(sv,lp); +} + +char * +Perl_sv_pvbyten_force(pTHX_ SV *sv, STRLEN *lp) +{ + return sv_pvn_force(sv,lp); +} + +char * +Perl_sv_pvutf8(pTHX_ SV *sv) +{ + return sv_pv(sv); +} + +char * +Perl_sv_pvutf8n(pTHX_ SV *sv, STRLEN *lp) +{ + return sv_pvn(sv,lp); +} + +char * +Perl_sv_pvutf8n_force(pTHX_ SV *sv, STRLEN *lp) +{ + return sv_pvn_force(sv,lp); +} + +char * Perl_sv_reftype(pTHX_ SV *sv, int ob) { if (ob && SvOBJECT(sv)) @@ -5162,6 +5232,13 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV /* SIZE */ switch (*q) { +#ifdef HAS_QUAD + case 'L': /* Ld */ + case 'q': /* qd */ + intsize = 'q'; + q++; + break; +#endif case 'l': #ifdef HAS_QUAD if (*(q + 1) == 'l') { /* lld */ @@ -5169,12 +5246,8 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV q += 2; break; } - case 'L': /* Ld */ - case 'q': /* qd */ - intsize = 'q'; - q++; - break; #endif + /* FALL THROUGH */ case 'h': /* FALL THROUGH */ case 'V': @@ -5216,6 +5289,12 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV if (args) { eptr = va_arg(*args, char*); if (eptr) +#ifdef MACOS_TRADITIONAL + /* On MacOS, %#s format is used for Pascal strings */ + if (alt) + elen = *eptr++; + else +#endif elen = strlen(eptr); else { eptr = nullstr; @@ -5368,7 +5447,8 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV case 16: if (!uv) alt = FALSE; - p = (c == 'X') ? "0123456789ABCDEF" : "0123456789abcdef"; + p = (char*)((c == 'X') + ? "0123456789ABCDEF" : "0123456789abcdef"); do { dig = uv & 15; *--eptr = p[dig]; @@ -5498,38 +5578,6 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV eptr = PL_efloatbuf; elen = strlen(PL_efloatbuf); - -#ifdef USE_LOCALE_NUMERIC - /* - * User-defined locales may include arbitrary characters. - * And, unfortunately, some (broken) systems may allow the - * "C" locale to be overridden by a malicious user. - * XXX This is an extreme way to cope with broken systems. - */ - if (maybe_tainted && PL_tainting) { - /* safe if it matches /[-+]?\d*(\.\d*)?([eE][-+]?\d*)?/ */ - if (*eptr == '-' || *eptr == '+') - ++eptr; - while (isDIGIT(*eptr)) - ++eptr; - if (*eptr == '.') { - ++eptr; - while (isDIGIT(*eptr)) - ++eptr; - } - if (*eptr == 'e' || *eptr == 'E') { - ++eptr; - if (*eptr == '-' || *eptr == '+') - ++eptr; - while (isDIGIT(*eptr)) - ++eptr; - } - if (*eptr) - *maybe_tainted = TRUE; /* results are suspect */ - eptr = PL_efloatbuf; - } -#endif /* USE_LOCALE_NUMERIC */ - break; /* SPECIAL */ @@ -5561,19 +5609,13 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV Perl_sv_setpvf(aTHX_ msg, "Invalid conversion in %s: ", (PL_op->op_type == OP_PRTF) ? "printf" : "sprintf"); if (c) { -#ifdef UV_IS_QUAD if (isPRINT(c)) Perl_sv_catpvf(aTHX_ msg, "\"%%%c\"", c & 0xFF); else Perl_sv_catpvf(aTHX_ msg, - "\"%%\\%03" PERL_PRIo64 "\"", + "\"%%\\%03"UVof"\"", (UV)c & 0xFF); -#else - Perl_sv_catpvf(aTHX_ msg, isPRINT(c) ? - "\"%%%c\"" : "\"%%\\%03o\"", - c & 0xFF); -#endif } else sv_catpv(msg, "end of string"); Perl_warner(aTHX_ WARN_PRINTF, "%_", msg); /* yes, this is reentrant */ @@ -5630,18 +5672,1614 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV } } +#if defined(USE_ITHREADS) + +#if defined(USE_THREADS) +# include "error: USE_THREADS and USE_ITHREADS are incompatible" +#endif + +#ifndef OpREFCNT_inc +# define OpREFCNT_inc(o) ((o) ? (++(o)->op_targ, (o)) : Nullop) +#endif + +#ifndef GpREFCNT_inc +# define GpREFCNT_inc(gp) ((gp) ? (++(gp)->gp_refcnt, (gp)) : (GP*)NULL) +#endif + + +#define sv_dup_inc(s) SvREFCNT_inc(sv_dup(s)) +#define av_dup(s) (AV*)sv_dup((SV*)s) +#define av_dup_inc(s) (AV*)SvREFCNT_inc(sv_dup((SV*)s)) +#define hv_dup(s) (HV*)sv_dup((SV*)s) +#define hv_dup_inc(s) (HV*)SvREFCNT_inc(sv_dup((SV*)s)) +#define cv_dup(s) (CV*)sv_dup((SV*)s) +#define cv_dup_inc(s) (CV*)SvREFCNT_inc(sv_dup((SV*)s)) +#define io_dup(s) (IO*)sv_dup((SV*)s) +#define io_dup_inc(s) (IO*)SvREFCNT_inc(sv_dup((SV*)s)) +#define gv_dup(s) (GV*)sv_dup((SV*)s) +#define gv_dup_inc(s) (GV*)SvREFCNT_inc(sv_dup((SV*)s)) +#define SAVEPV(p) (p ? savepv(p) : Nullch) +#define SAVEPVN(p,n) (p ? savepvn(p,n) : Nullch) + +REGEXP * +Perl_re_dup(pTHX_ REGEXP *r) +{ + /* XXX fix when pmop->op_pmregexp becomes shared */ + return ReREFCNT_inc(r); +} + +PerlIO * +Perl_fp_dup(pTHX_ PerlIO *fp, char type) +{ + PerlIO *ret; + if (!fp) + return (PerlIO*)NULL; + + /* look for it in the table first */ + ret = (PerlIO*)ptr_table_fetch(PL_ptr_table, fp); + if (ret) + return ret; + + /* create anew and remember what it is */ + ret = PerlIO_fdupopen(fp); + ptr_table_store(PL_ptr_table, fp, ret); + return ret; +} + +DIR * +Perl_dirp_dup(pTHX_ DIR *dp) +{ + if (!dp) + return (DIR*)NULL; + /* XXX TODO */ + return dp; +} + +GP * +Perl_gp_dup(pTHX_ GP *gp) +{ + GP *ret; + if (!gp) + return (GP*)NULL; + /* look for it in the table first */ + ret = (GP*)ptr_table_fetch(PL_ptr_table, gp); + if (ret) + return ret; + + /* create anew and remember what it is */ + Newz(0, ret, 1, GP); + ptr_table_store(PL_ptr_table, gp, ret); + + /* clone */ + ret->gp_refcnt = 0; /* must be before any other dups! */ + ret->gp_sv = sv_dup_inc(gp->gp_sv); + ret->gp_io = io_dup_inc(gp->gp_io); + ret->gp_form = cv_dup_inc(gp->gp_form); + ret->gp_av = av_dup_inc(gp->gp_av); + ret->gp_hv = hv_dup_inc(gp->gp_hv); + ret->gp_egv = gv_dup(gp->gp_egv); /* GvEGV is not refcounted */ + ret->gp_cv = cv_dup_inc(gp->gp_cv); + ret->gp_cvgen = gp->gp_cvgen; + ret->gp_flags = gp->gp_flags; + ret->gp_line = gp->gp_line; + ret->gp_file = gp->gp_file; /* points to COP.cop_file */ + return ret; +} + +MAGIC * +Perl_mg_dup(pTHX_ MAGIC *mg) +{ + MAGIC *mgret = (MAGIC*)NULL; + MAGIC *mgprev; + if (!mg) + return (MAGIC*)NULL; + /* look for it in the table first */ + mgret = (MAGIC*)ptr_table_fetch(PL_ptr_table, mg); + if (mgret) + return mgret; + + for (; mg; mg = mg->mg_moremagic) { + MAGIC *nmg; + Newz(0, nmg, 1, MAGIC); + if (!mgret) + mgret = nmg; + else + mgprev->mg_moremagic = nmg; + nmg->mg_virtual = mg->mg_virtual; /* XXX copy dynamic vtable? */ + nmg->mg_private = mg->mg_private; + nmg->mg_type = mg->mg_type; + nmg->mg_flags = mg->mg_flags; + if (mg->mg_type == 'r') { + nmg->mg_obj = (SV*)re_dup((REGEXP*)mg->mg_obj); + } + else { + nmg->mg_obj = (mg->mg_flags & MGf_REFCOUNTED) + ? sv_dup_inc(mg->mg_obj) + : sv_dup(mg->mg_obj); + } + nmg->mg_len = mg->mg_len; + nmg->mg_ptr = mg->mg_ptr; /* XXX random ptr? */ + if (mg->mg_ptr && mg->mg_type != 'g') { + if (mg->mg_len >= 0) { + nmg->mg_ptr = SAVEPVN(mg->mg_ptr, mg->mg_len); + if (mg->mg_type == 'c' && AMT_AMAGIC((AMT*)mg->mg_ptr)) { + AMT *amtp = (AMT*)mg->mg_ptr; + AMT *namtp = (AMT*)nmg->mg_ptr; + I32 i; + for (i = 1; i < NofAMmeth; i++) { + namtp->table[i] = cv_dup_inc(amtp->table[i]); + } + } + } + else if (mg->mg_len == HEf_SVKEY) + nmg->mg_ptr = (char*)sv_dup_inc((SV*)mg->mg_ptr); + } + mgprev = nmg; + } + return mgret; +} + +PTR_TBL_t * +Perl_ptr_table_new(pTHX) +{ + PTR_TBL_t *tbl; + Newz(0, tbl, 1, PTR_TBL_t); + tbl->tbl_max = 511; + tbl->tbl_items = 0; + Newz(0, tbl->tbl_ary, tbl->tbl_max + 1, PTR_TBL_ENT_t*); + return tbl; +} + +void * +Perl_ptr_table_fetch(pTHX_ PTR_TBL_t *tbl, void *sv) +{ + PTR_TBL_ENT_t *tblent; + UV hash = (UV)sv; + assert(tbl); + tblent = tbl->tbl_ary[hash & tbl->tbl_max]; + for (; tblent; tblent = tblent->next) { + if (tblent->oldval == sv) + return tblent->newval; + } + return (void*)NULL; +} + +void +Perl_ptr_table_store(pTHX_ PTR_TBL_t *tbl, void *oldv, void *newv) +{ + PTR_TBL_ENT_t *tblent, **otblent; + /* XXX this may be pessimal on platforms where pointers aren't good + * hash values e.g. if they grow faster in the most significant + * bits */ + UV hash = (UV)oldv; + bool i = 1; + + assert(tbl); + otblent = &tbl->tbl_ary[hash & tbl->tbl_max]; + for (tblent = *otblent; tblent; i=0, tblent = tblent->next) { + if (tblent->oldval == oldv) { + tblent->newval = newv; + tbl->tbl_items++; + return; + } + } + Newz(0, tblent, 1, PTR_TBL_ENT_t); + tblent->oldval = oldv; + tblent->newval = newv; + tblent->next = *otblent; + *otblent = tblent; + tbl->tbl_items++; + if (i && tbl->tbl_items > tbl->tbl_max) + ptr_table_split(tbl); +} + +void +Perl_ptr_table_split(pTHX_ PTR_TBL_t *tbl) +{ + PTR_TBL_ENT_t **ary = tbl->tbl_ary; + UV oldsize = tbl->tbl_max + 1; + UV newsize = oldsize * 2; + UV i; + + Renew(ary, newsize, PTR_TBL_ENT_t*); + Zero(&ary[oldsize], newsize-oldsize, PTR_TBL_ENT_t*); + tbl->tbl_max = --newsize; + tbl->tbl_ary = ary; + for (i=0; i < oldsize; i++, ary++) { + PTR_TBL_ENT_t **curentp, **entp, *ent; + if (!*ary) + continue; + curentp = ary + oldsize; + for (entp = ary, ent = *ary; ent; ent = *entp) { + if ((newsize & (UV)ent->oldval) != i) { + *entp = ent->next; + ent->next = *curentp; + *curentp = ent; + continue; + } + else + entp = &ent->next; + } + } +} + +#ifdef DEBUGGING +char *PL_watch_pvx; +#endif + +SV * +Perl_sv_dup(pTHX_ SV *sstr) +{ + U32 sflags; + int dtype; + int stype; + SV *dstr; + + if (!sstr || SvTYPE(sstr) == SVTYPEMASK) + return Nullsv; + /* look for it in the table first */ + dstr = (SV*)ptr_table_fetch(PL_ptr_table, sstr); + if (dstr) + return dstr; + + /* create anew and remember what it is */ + new_SV(dstr); + ptr_table_store(PL_ptr_table, sstr, dstr); + + /* clone */ + SvFLAGS(dstr) = SvFLAGS(sstr); + SvFLAGS(dstr) &= ~SVf_OOK; /* don't propagate OOK hack */ + SvREFCNT(dstr) = 0; /* must be before any other dups! */ + +#ifdef DEBUGGING + if (SvANY(sstr) && PL_watch_pvx && SvPVX(sstr) == PL_watch_pvx) + PerlIO_printf(Perl_debug_log, "watch at %p hit, found string \"%s\"\n", + PL_watch_pvx, SvPVX(sstr)); +#endif + + switch (SvTYPE(sstr)) { + case SVt_NULL: + SvANY(dstr) = NULL; + break; + case SVt_IV: + SvANY(dstr) = new_XIV(); + SvIVX(dstr) = SvIVX(sstr); + break; + case SVt_NV: + SvANY(dstr) = new_XNV(); + SvNVX(dstr) = SvNVX(sstr); + break; + case SVt_RV: + SvANY(dstr) = new_XRV(); + SvRV(dstr) = sv_dup_inc(SvRV(sstr)); + break; + case SVt_PV: + SvANY(dstr) = new_XPV(); + SvCUR(dstr) = SvCUR(sstr); + SvLEN(dstr) = SvLEN(sstr); + if (SvROK(sstr)) + SvRV(dstr) = sv_dup_inc(SvRV(sstr)); + else if (SvPVX(sstr) && SvLEN(sstr)) + SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1); + else + SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */ + break; + case SVt_PVIV: + SvANY(dstr) = new_XPVIV(); + SvCUR(dstr) = SvCUR(sstr); + SvLEN(dstr) = SvLEN(sstr); + SvIVX(dstr) = SvIVX(sstr); + if (SvROK(sstr)) + SvRV(dstr) = sv_dup_inc(SvRV(sstr)); + else if (SvPVX(sstr) && SvLEN(sstr)) + SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1); + else + SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */ + break; + case SVt_PVNV: + SvANY(dstr) = new_XPVNV(); + SvCUR(dstr) = SvCUR(sstr); + SvLEN(dstr) = SvLEN(sstr); + SvIVX(dstr) = SvIVX(sstr); + SvNVX(dstr) = SvNVX(sstr); + if (SvROK(sstr)) + SvRV(dstr) = sv_dup_inc(SvRV(sstr)); + else if (SvPVX(sstr) && SvLEN(sstr)) + SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1); + else + SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */ + break; + case SVt_PVMG: + SvANY(dstr) = new_XPVMG(); + SvCUR(dstr) = SvCUR(sstr); + SvLEN(dstr) = SvLEN(sstr); + SvIVX(dstr) = SvIVX(sstr); + SvNVX(dstr) = SvNVX(sstr); + SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr)); + SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr)); + if (SvROK(sstr)) + SvRV(dstr) = sv_dup_inc(SvRV(sstr)); + else if (SvPVX(sstr) && SvLEN(sstr)) + SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1); + else + SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */ + break; + case SVt_PVBM: + SvANY(dstr) = new_XPVBM(); + SvCUR(dstr) = SvCUR(sstr); + SvLEN(dstr) = SvLEN(sstr); + SvIVX(dstr) = SvIVX(sstr); + SvNVX(dstr) = SvNVX(sstr); + SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr)); + SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr)); + if (SvROK(sstr)) + SvRV(dstr) = sv_dup_inc(SvRV(sstr)); + else if (SvPVX(sstr) && SvLEN(sstr)) + SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1); + else + SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */ + BmRARE(dstr) = BmRARE(sstr); + BmUSEFUL(dstr) = BmUSEFUL(sstr); + BmPREVIOUS(dstr)= BmPREVIOUS(sstr); + break; + case SVt_PVLV: + SvANY(dstr) = new_XPVLV(); + SvCUR(dstr) = SvCUR(sstr); + SvLEN(dstr) = SvLEN(sstr); + SvIVX(dstr) = SvIVX(sstr); + SvNVX(dstr) = SvNVX(sstr); + SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr)); + SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr)); + if (SvROK(sstr)) + SvRV(dstr) = sv_dup_inc(SvRV(sstr)); + else if (SvPVX(sstr) && SvLEN(sstr)) + SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1); + else + SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */ + LvTARGOFF(dstr) = LvTARGOFF(sstr); /* XXX sometimes holds PMOP* when DEBUGGING */ + LvTARGLEN(dstr) = LvTARGLEN(sstr); + LvTARG(dstr) = sv_dup_inc(LvTARG(sstr)); + LvTYPE(dstr) = LvTYPE(sstr); + break; + case SVt_PVGV: + SvANY(dstr) = new_XPVGV(); + SvCUR(dstr) = SvCUR(sstr); + SvLEN(dstr) = SvLEN(sstr); + SvIVX(dstr) = SvIVX(sstr); + SvNVX(dstr) = SvNVX(sstr); + SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr)); + SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr)); + if (SvROK(sstr)) + SvRV(dstr) = sv_dup_inc(SvRV(sstr)); + else if (SvPVX(sstr) && SvLEN(sstr)) + SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1); + else + SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */ + GvNAMELEN(dstr) = GvNAMELEN(sstr); + GvNAME(dstr) = SAVEPVN(GvNAME(sstr), GvNAMELEN(sstr)); + GvSTASH(dstr) = hv_dup_inc(GvSTASH(sstr)); + GvFLAGS(dstr) = GvFLAGS(sstr); + GvGP(dstr) = gp_dup(GvGP(sstr)); + (void)GpREFCNT_inc(GvGP(dstr)); + break; + case SVt_PVIO: + SvANY(dstr) = new_XPVIO(); + SvCUR(dstr) = SvCUR(sstr); + SvLEN(dstr) = SvLEN(sstr); + SvIVX(dstr) = SvIVX(sstr); + SvNVX(dstr) = SvNVX(sstr); + SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr)); + SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr)); + if (SvROK(sstr)) + SvRV(dstr) = sv_dup_inc(SvRV(sstr)); + else if (SvPVX(sstr) && SvLEN(sstr)) + SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1); + else + SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */ + IoIFP(dstr) = fp_dup(IoIFP(sstr), IoTYPE(sstr)); + if (IoOFP(sstr) == IoIFP(sstr)) + IoOFP(dstr) = IoIFP(dstr); + else + IoOFP(dstr) = fp_dup(IoOFP(sstr), IoTYPE(sstr)); + /* PL_rsfp_filters entries have fake IoDIRP() */ + if (IoDIRP(sstr) && !(IoFLAGS(sstr) & IOf_FAKE_DIRP)) + IoDIRP(dstr) = dirp_dup(IoDIRP(sstr)); + else + IoDIRP(dstr) = IoDIRP(sstr); + IoLINES(dstr) = IoLINES(sstr); + IoPAGE(dstr) = IoPAGE(sstr); + IoPAGE_LEN(dstr) = IoPAGE_LEN(sstr); + IoLINES_LEFT(dstr) = IoLINES_LEFT(sstr); + IoTOP_NAME(dstr) = SAVEPV(IoTOP_NAME(sstr)); + IoTOP_GV(dstr) = gv_dup(IoTOP_GV(sstr)); + IoFMT_NAME(dstr) = SAVEPV(IoFMT_NAME(sstr)); + IoFMT_GV(dstr) = gv_dup(IoFMT_GV(sstr)); + IoBOTTOM_NAME(dstr) = SAVEPV(IoBOTTOM_NAME(sstr)); + IoBOTTOM_GV(dstr) = gv_dup(IoBOTTOM_GV(sstr)); + IoSUBPROCESS(dstr) = IoSUBPROCESS(sstr); + IoTYPE(dstr) = IoTYPE(sstr); + IoFLAGS(dstr) = IoFLAGS(sstr); + break; + case SVt_PVAV: + SvANY(dstr) = new_XPVAV(); + SvCUR(dstr) = SvCUR(sstr); + SvLEN(dstr) = SvLEN(sstr); + SvIVX(dstr) = SvIVX(sstr); + SvNVX(dstr) = SvNVX(sstr); + SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr)); + SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr)); + AvARYLEN((AV*)dstr) = sv_dup_inc(AvARYLEN((AV*)sstr)); + AvFLAGS((AV*)dstr) = AvFLAGS((AV*)sstr); + if (AvARRAY((AV*)sstr)) { + SV **dst_ary, **src_ary; + SSize_t items = AvFILLp((AV*)sstr) + 1; + + src_ary = AvARRAY((AV*)sstr); + Newz(0, dst_ary, AvMAX((AV*)sstr)+1, SV*); + ptr_table_store(PL_ptr_table, src_ary, dst_ary); + SvPVX(dstr) = (char*)dst_ary; + AvALLOC((AV*)dstr) = dst_ary; + if (AvREAL((AV*)sstr)) { + while (items-- > 0) + *dst_ary++ = sv_dup_inc(*src_ary++); + } + else { + while (items-- > 0) + *dst_ary++ = sv_dup(*src_ary++); + } + items = AvMAX((AV*)sstr) - AvFILLp((AV*)sstr); + while (items-- > 0) { + *dst_ary++ = &PL_sv_undef; + } + } + else { + SvPVX(dstr) = Nullch; + AvALLOC((AV*)dstr) = (SV**)NULL; + } + break; + case SVt_PVHV: + SvANY(dstr) = new_XPVHV(); + SvCUR(dstr) = SvCUR(sstr); + SvLEN(dstr) = SvLEN(sstr); + SvIVX(dstr) = SvIVX(sstr); + SvNVX(dstr) = SvNVX(sstr); + SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr)); + SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr)); + HvRITER((HV*)dstr) = HvRITER((HV*)sstr); + if (HvARRAY((HV*)sstr)) { + HE *entry; + STRLEN i = 0; + XPVHV *dxhv = (XPVHV*)SvANY(dstr); + XPVHV *sxhv = (XPVHV*)SvANY(sstr); + Newz(0, dxhv->xhv_array, + PERL_HV_ARRAY_ALLOC_BYTES(dxhv->xhv_max+1), char); + while (i <= sxhv->xhv_max) { + ((HE**)dxhv->xhv_array)[i] = he_dup(((HE**)sxhv->xhv_array)[i], + !!HvSHAREKEYS(sstr)); + ++i; + } + dxhv->xhv_eiter = he_dup(sxhv->xhv_eiter, !!HvSHAREKEYS(sstr)); + } + else { + SvPVX(dstr) = Nullch; + HvEITER((HV*)dstr) = (HE*)NULL; + } + HvPMROOT((HV*)dstr) = HvPMROOT((HV*)sstr); /* XXX */ + HvNAME((HV*)dstr) = SAVEPV(HvNAME((HV*)sstr)); + break; + case SVt_PVFM: + SvANY(dstr) = new_XPVFM(); + FmLINES(dstr) = FmLINES(sstr); + goto dup_pvcv; + /* NOTREACHED */ + case SVt_PVCV: + SvANY(dstr) = new_XPVCV(); +dup_pvcv: + SvCUR(dstr) = SvCUR(sstr); + SvLEN(dstr) = SvLEN(sstr); + SvIVX(dstr) = SvIVX(sstr); + SvNVX(dstr) = SvNVX(sstr); + SvMAGIC(dstr) = mg_dup(SvMAGIC(sstr)); + SvSTASH(dstr) = hv_dup_inc(SvSTASH(sstr)); + if (SvPVX(sstr) && SvLEN(sstr)) + SvPVX(dstr) = SAVEPVN(SvPVX(sstr), SvLEN(sstr)-1); + else + SvPVX(dstr) = SvPVX(sstr); /* XXX shared string/random ptr? */ + CvSTASH(dstr) = hv_dup(CvSTASH(sstr));/* NOTE: not refcounted */ + CvSTART(dstr) = CvSTART(sstr); + CvROOT(dstr) = OpREFCNT_inc(CvROOT(sstr)); + CvXSUB(dstr) = CvXSUB(sstr); + CvXSUBANY(dstr) = CvXSUBANY(sstr); + CvGV(dstr) = gv_dup_inc(CvGV(sstr)); + CvDEPTH(dstr) = CvDEPTH(sstr); + if (CvPADLIST(sstr) && !AvREAL(CvPADLIST(sstr))) { + /* XXX padlists are real, but pretend to be not */ + AvREAL_on(CvPADLIST(sstr)); + CvPADLIST(dstr) = av_dup_inc(CvPADLIST(sstr)); + AvREAL_off(CvPADLIST(sstr)); + AvREAL_off(CvPADLIST(dstr)); + } + else + CvPADLIST(dstr) = av_dup_inc(CvPADLIST(sstr)); + CvOUTSIDE(dstr) = cv_dup_inc(CvOUTSIDE(sstr)); + CvFLAGS(dstr) = CvFLAGS(sstr); + break; + default: + Perl_croak(aTHX_ "Bizarre SvTYPE [%d]", SvTYPE(sstr)); + break; + } + + if (SvOBJECT(dstr) && SvTYPE(dstr) != SVt_PVIO) + ++PL_sv_objcount; + + return dstr; +} + +PERL_CONTEXT * +Perl_cx_dup(pTHX_ PERL_CONTEXT *cxs, I32 ix, I32 max) +{ + PERL_CONTEXT *ncxs; + + if (!cxs) + return (PERL_CONTEXT*)NULL; + + /* look for it in the table first */ + ncxs = (PERL_CONTEXT*)ptr_table_fetch(PL_ptr_table, cxs); + if (ncxs) + return ncxs; + + /* create anew and remember what it is */ + Newz(56, ncxs, max + 1, PERL_CONTEXT); + ptr_table_store(PL_ptr_table, cxs, ncxs); + + while (ix >= 0) { + PERL_CONTEXT *cx = &cxs[ix]; + PERL_CONTEXT *ncx = &ncxs[ix]; + ncx->cx_type = cx->cx_type; + if (CxTYPE(cx) == CXt_SUBST) { + Perl_croak(aTHX_ "Cloning substitution context is unimplemented"); + } + else { + ncx->blk_oldsp = cx->blk_oldsp; + ncx->blk_oldcop = cx->blk_oldcop; + ncx->blk_oldretsp = cx->blk_oldretsp; + ncx->blk_oldmarksp = cx->blk_oldmarksp; + ncx->blk_oldscopesp = cx->blk_oldscopesp; + ncx->blk_oldpm = cx->blk_oldpm; + ncx->blk_gimme = cx->blk_gimme; + switch (CxTYPE(cx)) { + case CXt_SUB: + ncx->blk_sub.cv = (cx->blk_sub.olddepth == 0 + ? cv_dup_inc(cx->blk_sub.cv) + : cv_dup(cx->blk_sub.cv)); + ncx->blk_sub.argarray = (cx->blk_sub.hasargs + ? av_dup_inc(cx->blk_sub.argarray) + : Nullav); + ncx->blk_sub.savearray = av_dup(cx->blk_sub.savearray); + ncx->blk_sub.olddepth = cx->blk_sub.olddepth; + ncx->blk_sub.hasargs = cx->blk_sub.hasargs; + ncx->blk_sub.lval = cx->blk_sub.lval; + break; + case CXt_EVAL: + ncx->blk_eval.old_in_eval = cx->blk_eval.old_in_eval; + ncx->blk_eval.old_op_type = cx->blk_eval.old_op_type; + ncx->blk_eval.old_name = SAVEPV(cx->blk_eval.old_name); + ncx->blk_eval.old_eval_root = cx->blk_eval.old_eval_root; + ncx->blk_eval.cur_text = sv_dup(cx->blk_eval.cur_text); + break; + case CXt_LOOP: + ncx->blk_loop.label = cx->blk_loop.label; + ncx->blk_loop.resetsp = cx->blk_loop.resetsp; + ncx->blk_loop.redo_op = cx->blk_loop.redo_op; + ncx->blk_loop.next_op = cx->blk_loop.next_op; + ncx->blk_loop.last_op = cx->blk_loop.last_op; + ncx->blk_loop.iterdata = (CxPADLOOP(cx) + ? cx->blk_loop.iterdata + : gv_dup((GV*)cx->blk_loop.iterdata)); + ncx->blk_loop.itersave = sv_dup_inc(cx->blk_loop.itersave); + ncx->blk_loop.iterlval = sv_dup_inc(cx->blk_loop.iterlval); + ncx->blk_loop.iterary = av_dup_inc(cx->blk_loop.iterary); + ncx->blk_loop.iterix = cx->blk_loop.iterix; + ncx->blk_loop.itermax = cx->blk_loop.itermax; + break; + case CXt_FORMAT: + ncx->blk_sub.cv = cv_dup(cx->blk_sub.cv); + ncx->blk_sub.gv = gv_dup(cx->blk_sub.gv); + ncx->blk_sub.dfoutgv = gv_dup_inc(cx->blk_sub.dfoutgv); + ncx->blk_sub.hasargs = cx->blk_sub.hasargs; + break; + case CXt_BLOCK: + case CXt_NULL: + break; + } + } + --ix; + } + return ncxs; +} + +PERL_SI * +Perl_si_dup(pTHX_ PERL_SI *si) +{ + PERL_SI *nsi; + + if (!si) + return (PERL_SI*)NULL; + + /* look for it in the table first */ + nsi = (PERL_SI*)ptr_table_fetch(PL_ptr_table, si); + if (nsi) + return nsi; + + /* create anew and remember what it is */ + Newz(56, nsi, 1, PERL_SI); + ptr_table_store(PL_ptr_table, si, nsi); + + nsi->si_stack = av_dup_inc(si->si_stack); + nsi->si_cxix = si->si_cxix; + nsi->si_cxmax = si->si_cxmax; + nsi->si_cxstack = cx_dup(si->si_cxstack, si->si_cxix, si->si_cxmax); + nsi->si_type = si->si_type; + nsi->si_prev = si_dup(si->si_prev); + nsi->si_next = si_dup(si->si_next); + nsi->si_markoff = si->si_markoff; + + return nsi; +} + +#define POPINT(ss,ix) ((ss)[--(ix)].any_i32) +#define TOPINT(ss,ix) ((ss)[ix].any_i32) +#define POPLONG(ss,ix) ((ss)[--(ix)].any_long) +#define TOPLONG(ss,ix) ((ss)[ix].any_long) +#define POPIV(ss,ix) ((ss)[--(ix)].any_iv) +#define TOPIV(ss,ix) ((ss)[ix].any_iv) +#define POPPTR(ss,ix) ((ss)[--(ix)].any_ptr) +#define TOPPTR(ss,ix) ((ss)[ix].any_ptr) +#define POPDPTR(ss,ix) ((ss)[--(ix)].any_dptr) +#define TOPDPTR(ss,ix) ((ss)[ix].any_dptr) +#define POPDXPTR(ss,ix) ((ss)[--(ix)].any_dxptr) +#define TOPDXPTR(ss,ix) ((ss)[ix].any_dxptr) + +/* XXXXX todo */ +#define pv_dup_inc(p) SAVEPV(p) +#define pv_dup(p) SAVEPV(p) +#define svp_dup_inc(p,pp) any_dup(p,pp) + +void * +Perl_any_dup(pTHX_ void *v, PerlInterpreter *proto_perl) +{ + void *ret; + + if (!v) + return (void*)NULL; + + /* look for it in the table first */ + ret = ptr_table_fetch(PL_ptr_table, v); + if (ret) + return ret; + + /* see if it is part of the interpreter structure */ + if (v >= (void*)proto_perl && v < (void*)(proto_perl+1)) + ret = (void*)(((char*)aTHXo) + (((char*)v) - (char*)proto_perl)); + else + ret = v; + + return ret; +} + +ANY * +Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl) +{ + ANY *ss = proto_perl->Tsavestack; + I32 ix = proto_perl->Tsavestack_ix; + I32 max = proto_perl->Tsavestack_max; + ANY *nss; + SV *sv; + GV *gv; + AV *av; + HV *hv; + void* ptr; + int intval; + long longval; + GP *gp; + IV iv; + I32 i; + char *c; + void (*dptr) (void*); + void (*dxptr) (pTHXo_ void*); + + Newz(54, nss, max, ANY); + + while (ix > 0) { + i = POPINT(ss,ix); + TOPINT(nss,ix) = i; + switch (i) { + case SAVEt_ITEM: /* normal string */ + sv = (SV*)POPPTR(ss,ix); + TOPPTR(nss,ix) = sv_dup_inc(sv); + sv = (SV*)POPPTR(ss,ix); + TOPPTR(nss,ix) = sv_dup_inc(sv); + break; + case SAVEt_SV: /* scalar reference */ + sv = (SV*)POPPTR(ss,ix); + TOPPTR(nss,ix) = sv_dup_inc(sv); + gv = (GV*)POPPTR(ss,ix); + TOPPTR(nss,ix) = gv_dup_inc(gv); + break; + case SAVEt_GENERIC_SVREF: /* generic sv */ + case SAVEt_SVREF: /* scalar reference */ + sv = (SV*)POPPTR(ss,ix); + TOPPTR(nss,ix) = sv_dup_inc(sv); + ptr = POPPTR(ss,ix); + TOPPTR(nss,ix) = svp_dup_inc((SV**)ptr, proto_perl);/* XXXXX */ + break; + case SAVEt_AV: /* array reference */ + av = (AV*)POPPTR(ss,ix); + TOPPTR(nss,ix) = av_dup_inc(av); + gv = (GV*)POPPTR(ss,ix); + TOPPTR(nss,ix) = gv_dup(gv); + break; + case SAVEt_HV: /* hash reference */ + hv = (HV*)POPPTR(ss,ix); + TOPPTR(nss,ix) = hv_dup_inc(hv); + gv = (GV*)POPPTR(ss,ix); + TOPPTR(nss,ix) = gv_dup(gv); + break; + case SAVEt_INT: /* int reference */ + ptr = POPPTR(ss,ix); + TOPPTR(nss,ix) = any_dup(ptr, proto_perl); + intval = (int)POPINT(ss,ix); + TOPINT(nss,ix) = intval; + break; + case SAVEt_LONG: /* long reference */ + ptr = POPPTR(ss,ix); + TOPPTR(nss,ix) = any_dup(ptr, proto_perl); + longval = (long)POPLONG(ss,ix); + TOPLONG(nss,ix) = longval; + break; + case SAVEt_I32: /* I32 reference */ + case SAVEt_I16: /* I16 reference */ + case SAVEt_I8: /* I8 reference */ + ptr = POPPTR(ss,ix); + TOPPTR(nss,ix) = any_dup(ptr, proto_perl); + i = POPINT(ss,ix); + TOPINT(nss,ix) = i; + break; + case SAVEt_IV: /* IV reference */ + ptr = POPPTR(ss,ix); + TOPPTR(nss,ix) = any_dup(ptr, proto_perl); + iv = POPIV(ss,ix); + TOPIV(nss,ix) = iv; + break; + case SAVEt_SPTR: /* SV* reference */ + ptr = POPPTR(ss,ix); + TOPPTR(nss,ix) = any_dup(ptr, proto_perl); + sv = (SV*)POPPTR(ss,ix); + TOPPTR(nss,ix) = sv_dup(sv); + break; + case SAVEt_VPTR: /* random* reference */ + ptr = POPPTR(ss,ix); + TOPPTR(nss,ix) = any_dup(ptr, proto_perl); + ptr = POPPTR(ss,ix); + TOPPTR(nss,ix) = any_dup(ptr, proto_perl); + break; + case SAVEt_PPTR: /* char* reference */ + ptr = POPPTR(ss,ix); + TOPPTR(nss,ix) = any_dup(ptr, proto_perl); + c = (char*)POPPTR(ss,ix); + TOPPTR(nss,ix) = pv_dup(c); + break; + case SAVEt_HPTR: /* HV* reference */ + ptr = POPPTR(ss,ix); + TOPPTR(nss,ix) = any_dup(ptr, proto_perl); + hv = (HV*)POPPTR(ss,ix); + TOPPTR(nss,ix) = hv_dup(hv); + break; + case SAVEt_APTR: /* AV* reference */ + ptr = POPPTR(ss,ix); + TOPPTR(nss,ix) = any_dup(ptr, proto_perl); + av = (AV*)POPPTR(ss,ix); + TOPPTR(nss,ix) = av_dup(av); + break; + case SAVEt_NSTAB: + gv = (GV*)POPPTR(ss,ix); + TOPPTR(nss,ix) = gv_dup(gv); + break; + case SAVEt_GP: /* scalar reference */ + gp = (GP*)POPPTR(ss,ix); + TOPPTR(nss,ix) = gp = gp_dup(gp); + (void)GpREFCNT_inc(gp); + gv = (GV*)POPPTR(ss,ix); + TOPPTR(nss,ix) = gv_dup_inc(c); + c = (char*)POPPTR(ss,ix); + TOPPTR(nss,ix) = pv_dup(c); + iv = POPIV(ss,ix); + TOPIV(nss,ix) = iv; + iv = POPIV(ss,ix); + TOPIV(nss,ix) = iv; + break; + case SAVEt_FREESV: + sv = (SV*)POPPTR(ss,ix); + TOPPTR(nss,ix) = sv_dup_inc(sv); + break; + case SAVEt_FREEOP: + ptr = POPPTR(ss,ix); + if (ptr && (((OP*)ptr)->op_private & OPpREFCOUNTED)) { + /* these are assumed to be refcounted properly */ + switch (((OP*)ptr)->op_type) { + case OP_LEAVESUB: + case OP_LEAVESUBLV: + case OP_LEAVEEVAL: + case OP_LEAVE: + case OP_SCOPE: + case OP_LEAVEWRITE: + TOPPTR(nss,ix) = any_dup(ptr, proto_perl); + break; + default: + TOPPTR(nss,ix) = Nullop; + break; + } + } + else + TOPPTR(nss,ix) = Nullop; + break; + case SAVEt_FREEPV: + c = (char*)POPPTR(ss,ix); + TOPPTR(nss,ix) = pv_dup_inc(c); + break; + case SAVEt_CLEARSV: + longval = POPLONG(ss,ix); + TOPLONG(nss,ix) = longval; + break; + case SAVEt_DELETE: + hv = (HV*)POPPTR(ss,ix); + TOPPTR(nss,ix) = hv_dup_inc(hv); + c = (char*)POPPTR(ss,ix); + TOPPTR(nss,ix) = pv_dup_inc(c); + i = POPINT(ss,ix); + TOPINT(nss,ix) = i; + break; + case SAVEt_DESTRUCTOR: + ptr = POPPTR(ss,ix); + TOPPTR(nss,ix) = any_dup(ptr, proto_perl); /* XXX quite arbitrary */ + dptr = POPDPTR(ss,ix); + TOPDPTR(nss,ix) = (void (*)(void*))any_dup(dptr, proto_perl); + break; + case SAVEt_DESTRUCTOR_X: + ptr = POPPTR(ss,ix); + TOPPTR(nss,ix) = any_dup(ptr, proto_perl); /* XXX quite arbitrary */ + dxptr = POPDXPTR(ss,ix); + TOPDXPTR(nss,ix) = (void (*)(pTHXo_ void*))any_dup(dxptr, proto_perl); + break; + case SAVEt_REGCONTEXT: + case SAVEt_ALLOC: + i = POPINT(ss,ix); + TOPINT(nss,ix) = i; + ix -= i; + break; + case SAVEt_STACK_POS: /* Position on Perl stack */ + i = POPINT(ss,ix); + TOPINT(nss,ix) = i; + break; + case SAVEt_AELEM: /* array element */ + sv = (SV*)POPPTR(ss,ix); + TOPPTR(nss,ix) = sv_dup_inc(sv); + i = POPINT(ss,ix); + TOPINT(nss,ix) = i; + av = (AV*)POPPTR(ss,ix); + TOPPTR(nss,ix) = av_dup_inc(av); + break; + case SAVEt_HELEM: /* hash element */ + sv = (SV*)POPPTR(ss,ix); + TOPPTR(nss,ix) = sv_dup_inc(sv); + sv = (SV*)POPPTR(ss,ix); + TOPPTR(nss,ix) = sv_dup_inc(sv); + hv = (HV*)POPPTR(ss,ix); + TOPPTR(nss,ix) = hv_dup_inc(hv); + break; + case SAVEt_OP: + ptr = POPPTR(ss,ix); + TOPPTR(nss,ix) = ptr; + break; + case SAVEt_HINTS: + i = POPINT(ss,ix); + TOPINT(nss,ix) = i; + break; + default: + Perl_croak(aTHX_ "panic: ss_dup inconsistency"); + } + } + + return nss; +} + +#ifdef PERL_OBJECT +#include "XSUB.h" +#endif + +PerlInterpreter * +perl_clone(PerlInterpreter *proto_perl, UV flags) +{ +#ifdef PERL_OBJECT + CPerlObj *pPerl = (CPerlObj*)proto_perl; +#endif + +#ifdef PERL_IMPLICIT_SYS + return perl_clone_using(proto_perl, flags, + proto_perl->IMem, + proto_perl->IMemShared, + proto_perl->IMemParse, + proto_perl->IEnv, + proto_perl->IStdIO, + proto_perl->ILIO, + proto_perl->IDir, + proto_perl->ISock, + proto_perl->IProc); +} + +PerlInterpreter * +perl_clone_using(PerlInterpreter *proto_perl, UV flags, + struct IPerlMem* ipM, struct IPerlMem* ipMS, + struct IPerlMem* ipMP, struct IPerlEnv* ipE, + struct IPerlStdIO* ipStd, struct IPerlLIO* ipLIO, + struct IPerlDir* ipD, struct IPerlSock* ipS, + struct IPerlProc* ipP) +{ + /* XXX many of the string copies here can be optimized if they're + * constants; they need to be allocated as common memory and just + * their pointers copied. */ + + IV i; + SV *sv; + SV **svp; +# ifdef PERL_OBJECT + CPerlObj *pPerl = new(ipM) CPerlObj(ipM, ipMS, ipMP, ipE, ipStd, ipLIO, + ipD, ipS, ipP); + PERL_SET_INTERP(pPerl); +# else /* !PERL_OBJECT */ + PerlInterpreter *my_perl = (PerlInterpreter*)(*ipM->pMalloc)(ipM, sizeof(PerlInterpreter)); + PERL_SET_INTERP(my_perl); + +# ifdef DEBUGGING + memset(my_perl, 0xab, sizeof(PerlInterpreter)); + PL_markstack = 0; + PL_scopestack = 0; + PL_savestack = 0; + PL_retstack = 0; +# else /* !DEBUGGING */ + Zero(my_perl, 1, PerlInterpreter); +# endif /* DEBUGGING */ + + /* host pointers */ + PL_Mem = ipM; + PL_MemShared = ipMS; + PL_MemParse = ipMP; + PL_Env = ipE; + PL_StdIO = ipStd; + PL_LIO = ipLIO; + PL_Dir = ipD; + PL_Sock = ipS; + PL_Proc = ipP; +# endif /* PERL_OBJECT */ +#else /* !PERL_IMPLICIT_SYS */ + IV i; + SV *sv; + SV **svp; + PerlInterpreter *my_perl = (PerlInterpreter*)PerlMem_malloc(sizeof(PerlInterpreter)); + PERL_SET_INTERP(my_perl); + +# ifdef DEBUGGING + memset(my_perl, 0xab, sizeof(PerlInterpreter)); + PL_markstack = 0; + PL_scopestack = 0; + PL_savestack = 0; + PL_retstack = 0; +# else /* !DEBUGGING */ + Zero(my_perl, 1, PerlInterpreter); +# endif /* DEBUGGING */ +#endif /* PERL_IMPLICIT_SYS */ + + /* arena roots */ + PL_xiv_arenaroot = NULL; + PL_xiv_root = NULL; + PL_xnv_root = NULL; + PL_xrv_root = NULL; + PL_xpv_root = NULL; + PL_xpviv_root = NULL; + PL_xpvnv_root = NULL; + PL_xpvcv_root = NULL; + PL_xpvav_root = NULL; + PL_xpvhv_root = NULL; + PL_xpvmg_root = NULL; + PL_xpvlv_root = NULL; + PL_xpvbm_root = NULL; + PL_he_root = NULL; + PL_nice_chunk = NULL; + PL_nice_chunk_size = 0; + PL_sv_count = 0; + PL_sv_objcount = 0; + PL_sv_root = Nullsv; + PL_sv_arenaroot = Nullsv; + + PL_debug = proto_perl->Idebug; + + /* create SV map for pointer relocation */ + PL_ptr_table = ptr_table_new(); + + /* initialize these special pointers as early as possible */ + SvANY(&PL_sv_undef) = NULL; + SvREFCNT(&PL_sv_undef) = (~(U32)0)/2; + SvFLAGS(&PL_sv_undef) = SVf_READONLY|SVt_NULL; + ptr_table_store(PL_ptr_table, &proto_perl->Isv_undef, &PL_sv_undef); + +#ifdef PERL_OBJECT + SvUPGRADE(&PL_sv_no, SVt_PVNV); +#else + SvANY(&PL_sv_no) = new_XPVNV(); +#endif + SvREFCNT(&PL_sv_no) = (~(U32)0)/2; + SvFLAGS(&PL_sv_no) = SVp_NOK|SVf_NOK|SVp_POK|SVf_POK|SVf_READONLY|SVt_PVNV; + SvPVX(&PL_sv_no) = SAVEPVN(PL_No, 0); + SvCUR(&PL_sv_no) = 0; + SvLEN(&PL_sv_no) = 1; + SvNVX(&PL_sv_no) = 0; + ptr_table_store(PL_ptr_table, &proto_perl->Isv_no, &PL_sv_no); + +#ifdef PERL_OBJECT + SvUPGRADE(&PL_sv_yes, SVt_PVNV); +#else + SvANY(&PL_sv_yes) = new_XPVNV(); +#endif + SvREFCNT(&PL_sv_yes) = (~(U32)0)/2; + SvFLAGS(&PL_sv_yes) = SVp_NOK|SVf_NOK|SVp_POK|SVf_POK|SVf_READONLY|SVt_PVNV; + SvPVX(&PL_sv_yes) = SAVEPVN(PL_Yes, 1); + SvCUR(&PL_sv_yes) = 1; + SvLEN(&PL_sv_yes) = 2; + SvNVX(&PL_sv_yes) = 1; + ptr_table_store(PL_ptr_table, &proto_perl->Isv_yes, &PL_sv_yes); + + /* create shared string table */ + PL_strtab = newHV(); + HvSHAREKEYS_off(PL_strtab); + hv_ksplit(PL_strtab, 512); + ptr_table_store(PL_ptr_table, proto_perl->Istrtab, PL_strtab); + + PL_compiling = proto_perl->Icompiling; + PL_compiling.cop_stashpv = SAVEPV(PL_compiling.cop_stashpv); + PL_compiling.cop_file = SAVEPV(PL_compiling.cop_file); + ptr_table_store(PL_ptr_table, &proto_perl->Icompiling, &PL_compiling); + if (!specialWARN(PL_compiling.cop_warnings)) + PL_compiling.cop_warnings = sv_dup_inc(PL_compiling.cop_warnings); + PL_curcop = (COP*)any_dup(proto_perl->Tcurcop, proto_perl); + + /* pseudo environmental stuff */ + PL_origargc = proto_perl->Iorigargc; + i = PL_origargc; + New(0, PL_origargv, i+1, char*); + PL_origargv[i] = '\0'; + while (i-- > 0) { + PL_origargv[i] = SAVEPV(proto_perl->Iorigargv[i]); + } + PL_envgv = gv_dup(proto_perl->Ienvgv); + PL_incgv = gv_dup(proto_perl->Iincgv); + PL_hintgv = gv_dup(proto_perl->Ihintgv); + PL_origfilename = SAVEPV(proto_perl->Iorigfilename); + PL_diehook = sv_dup_inc(proto_perl->Idiehook); + PL_warnhook = sv_dup_inc(proto_perl->Iwarnhook); + + /* switches */ + PL_minus_c = proto_perl->Iminus_c; + PL_patchlevel = sv_dup_inc(proto_perl->Ipatchlevel); + PL_localpatches = proto_perl->Ilocalpatches; + PL_splitstr = proto_perl->Isplitstr; + PL_preprocess = proto_perl->Ipreprocess; + PL_minus_n = proto_perl->Iminus_n; + PL_minus_p = proto_perl->Iminus_p; + PL_minus_l = proto_perl->Iminus_l; + PL_minus_a = proto_perl->Iminus_a; + PL_minus_F = proto_perl->Iminus_F; + PL_doswitches = proto_perl->Idoswitches; + PL_dowarn = proto_perl->Idowarn; + PL_doextract = proto_perl->Idoextract; + PL_sawampersand = proto_perl->Isawampersand; + PL_unsafe = proto_perl->Iunsafe; + PL_inplace = SAVEPV(proto_perl->Iinplace); + PL_e_script = sv_dup_inc(proto_perl->Ie_script); + PL_perldb = proto_perl->Iperldb; + PL_perl_destruct_level = proto_perl->Iperl_destruct_level; + + /* magical thingies */ + /* XXX time(&PL_basetime) when asked for? */ + PL_basetime = proto_perl->Ibasetime; + PL_formfeed = sv_dup(proto_perl->Iformfeed); + + PL_maxsysfd = proto_perl->Imaxsysfd; + PL_multiline = proto_perl->Imultiline; + PL_statusvalue = proto_perl->Istatusvalue; +#ifdef VMS + PL_statusvalue_vms = proto_perl->Istatusvalue_vms; +#endif + + /* shortcuts to various I/O objects */ + PL_stdingv = gv_dup(proto_perl->Istdingv); + PL_stderrgv = gv_dup(proto_perl->Istderrgv); + PL_defgv = gv_dup(proto_perl->Idefgv); + PL_argvgv = gv_dup(proto_perl->Iargvgv); + PL_argvoutgv = gv_dup(proto_perl->Iargvoutgv); + PL_argvout_stack = av_dup(proto_perl->Iargvout_stack); + + /* shortcuts to regexp stuff */ + PL_replgv = gv_dup(proto_perl->Ireplgv); + + /* shortcuts to misc objects */ + PL_errgv = gv_dup(proto_perl->Ierrgv); + + /* shortcuts to debugging objects */ + PL_DBgv = gv_dup(proto_perl->IDBgv); + PL_DBline = gv_dup(proto_perl->IDBline); + PL_DBsub = gv_dup(proto_perl->IDBsub); + PL_DBsingle = sv_dup(proto_perl->IDBsingle); + PL_DBtrace = sv_dup(proto_perl->IDBtrace); + PL_DBsignal = sv_dup(proto_perl->IDBsignal); + PL_lineary = av_dup(proto_perl->Ilineary); + PL_dbargs = av_dup(proto_perl->Idbargs); + + /* symbol tables */ + PL_defstash = hv_dup_inc(proto_perl->Tdefstash); + PL_curstash = hv_dup(proto_perl->Tcurstash); + PL_debstash = hv_dup(proto_perl->Idebstash); + PL_globalstash = hv_dup(proto_perl->Iglobalstash); + PL_curstname = sv_dup_inc(proto_perl->Icurstname); + + PL_beginav = av_dup_inc(proto_perl->Ibeginav); + PL_endav = av_dup_inc(proto_perl->Iendav); + PL_stopav = av_dup_inc(proto_perl->Istopav); + PL_initav = av_dup_inc(proto_perl->Iinitav); + + PL_sub_generation = proto_perl->Isub_generation; + + /* funky return mechanisms */ + PL_forkprocess = proto_perl->Iforkprocess; + + /* subprocess state */ + PL_fdpid = av_dup_inc(proto_perl->Ifdpid); + + /* internal state */ + PL_tainting = proto_perl->Itainting; + PL_maxo = proto_perl->Imaxo; + if (proto_perl->Iop_mask) + PL_op_mask = SAVEPVN(proto_perl->Iop_mask, PL_maxo); + else + PL_op_mask = Nullch; + + /* current interpreter roots */ + PL_main_cv = cv_dup_inc(proto_perl->Imain_cv); + PL_main_root = OpREFCNT_inc(proto_perl->Imain_root); + PL_main_start = proto_perl->Imain_start; + PL_eval_root = OpREFCNT_inc(proto_perl->Ieval_root); + PL_eval_start = proto_perl->Ieval_start; + + /* runtime control stuff */ + PL_curcopdb = (COP*)any_dup(proto_perl->Icurcopdb, proto_perl); + PL_copline = proto_perl->Icopline; + + PL_filemode = proto_perl->Ifilemode; + PL_lastfd = proto_perl->Ilastfd; + PL_oldname = proto_perl->Ioldname; /* XXX not quite right */ + PL_Argv = NULL; + PL_Cmd = Nullch; + PL_gensym = proto_perl->Igensym; + PL_preambled = proto_perl->Ipreambled; + PL_preambleav = av_dup_inc(proto_perl->Ipreambleav); + PL_laststatval = proto_perl->Ilaststatval; + PL_laststype = proto_perl->Ilaststype; + PL_mess_sv = Nullsv; + + PL_orslen = proto_perl->Iorslen; + PL_ors = SAVEPVN(proto_perl->Iors, PL_orslen); + PL_ofmt = SAVEPV(proto_perl->Iofmt); + + /* interpreter atexit processing */ + PL_exitlistlen = proto_perl->Iexitlistlen; + if (PL_exitlistlen) { + New(0, PL_exitlist, PL_exitlistlen, PerlExitListEntry); + Copy(proto_perl->Iexitlist, PL_exitlist, PL_exitlistlen, PerlExitListEntry); + } + else + PL_exitlist = (PerlExitListEntry*)NULL; + PL_modglobal = hv_dup_inc(proto_perl->Imodglobal); + + PL_profiledata = NULL; + PL_rsfp = fp_dup(proto_perl->Irsfp, '<'); + /* PL_rsfp_filters entries have fake IoDIRP() */ + PL_rsfp_filters = av_dup_inc(proto_perl->Irsfp_filters); + + PL_compcv = cv_dup(proto_perl->Icompcv); + PL_comppad = av_dup(proto_perl->Icomppad); + PL_comppad_name = av_dup(proto_perl->Icomppad_name); + PL_comppad_name_fill = proto_perl->Icomppad_name_fill; + PL_comppad_name_floor = proto_perl->Icomppad_name_floor; + PL_curpad = (SV**)ptr_table_fetch(PL_ptr_table, + proto_perl->Tcurpad); + +#ifdef HAVE_INTERP_INTERN + sys_intern_dup(&proto_perl->Isys_intern, &PL_sys_intern); +#endif + + /* more statics moved here */ + PL_generation = proto_perl->Igeneration; + PL_DBcv = cv_dup(proto_perl->IDBcv); + + PL_in_clean_objs = proto_perl->Iin_clean_objs; + PL_in_clean_all = proto_perl->Iin_clean_all; + + PL_uid = proto_perl->Iuid; + PL_euid = proto_perl->Ieuid; + PL_gid = proto_perl->Igid; + PL_egid = proto_perl->Iegid; + PL_nomemok = proto_perl->Inomemok; + PL_an = proto_perl->Ian; + PL_cop_seqmax = proto_perl->Icop_seqmax; + PL_op_seqmax = proto_perl->Iop_seqmax; + PL_evalseq = proto_perl->Ievalseq; + PL_origenviron = proto_perl->Iorigenviron; /* XXX not quite right */ + PL_origalen = proto_perl->Iorigalen; + PL_pidstatus = newHV(); /* XXX flag for cloning? */ + PL_osname = SAVEPV(proto_perl->Iosname); + PL_sh_path = SAVEPV(proto_perl->Ish_path); + PL_sighandlerp = proto_perl->Isighandlerp; + + + PL_runops = proto_perl->Irunops; + + Copy(proto_perl->Itokenbuf, PL_tokenbuf, 256, char); + +#ifdef CSH + PL_cshlen = proto_perl->Icshlen; + PL_cshname = SAVEPVN(proto_perl->Icshname, PL_cshlen); +#endif + + PL_lex_state = proto_perl->Ilex_state; + PL_lex_defer = proto_perl->Ilex_defer; + PL_lex_expect = proto_perl->Ilex_expect; + PL_lex_formbrack = proto_perl->Ilex_formbrack; + PL_lex_dojoin = proto_perl->Ilex_dojoin; + PL_lex_starts = proto_perl->Ilex_starts; + PL_lex_stuff = sv_dup_inc(proto_perl->Ilex_stuff); + PL_lex_repl = sv_dup_inc(proto_perl->Ilex_repl); + PL_lex_op = proto_perl->Ilex_op; + PL_lex_inpat = proto_perl->Ilex_inpat; + PL_lex_inwhat = proto_perl->Ilex_inwhat; + PL_lex_brackets = proto_perl->Ilex_brackets; + i = (PL_lex_brackets < 120 ? 120 : PL_lex_brackets); + PL_lex_brackstack = SAVEPVN(proto_perl->Ilex_brackstack,i); + PL_lex_casemods = proto_perl->Ilex_casemods; + i = (PL_lex_casemods < 12 ? 12 : PL_lex_casemods); + PL_lex_casestack = SAVEPVN(proto_perl->Ilex_casestack,i); + + Copy(proto_perl->Inextval, PL_nextval, 5, YYSTYPE); + Copy(proto_perl->Inexttype, PL_nexttype, 5, I32); + PL_nexttoke = proto_perl->Inexttoke; + + PL_linestr = sv_dup_inc(proto_perl->Ilinestr); + i = proto_perl->Ibufptr - SvPVX(proto_perl->Ilinestr); + PL_bufptr = SvPVX(PL_linestr) + (i < 0 ? 0 : i); + i = proto_perl->Ioldbufptr - SvPVX(proto_perl->Ilinestr); + PL_oldbufptr = SvPVX(PL_linestr) + (i < 0 ? 0 : i); + i = proto_perl->Ioldoldbufptr - SvPVX(proto_perl->Ilinestr); + PL_oldoldbufptr = SvPVX(PL_linestr) + (i < 0 ? 0 : i); + PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr); + i = proto_perl->Ilinestart - SvPVX(proto_perl->Ilinestr); + PL_linestart = SvPVX(PL_linestr) + (i < 0 ? 0 : i); + PL_pending_ident = proto_perl->Ipending_ident; + PL_sublex_info = proto_perl->Isublex_info; /* XXX not quite right */ + + PL_expect = proto_perl->Iexpect; + + PL_multi_start = proto_perl->Imulti_start; + PL_multi_end = proto_perl->Imulti_end; + PL_multi_open = proto_perl->Imulti_open; + PL_multi_close = proto_perl->Imulti_close; + + PL_error_count = proto_perl->Ierror_count; + PL_subline = proto_perl->Isubline; + PL_subname = sv_dup_inc(proto_perl->Isubname); + + PL_min_intro_pending = proto_perl->Imin_intro_pending; + PL_max_intro_pending = proto_perl->Imax_intro_pending; + PL_padix = proto_perl->Ipadix; + PL_padix_floor = proto_perl->Ipadix_floor; + PL_pad_reset_pending = proto_perl->Ipad_reset_pending; + + i = proto_perl->Ilast_uni - SvPVX(proto_perl->Ilinestr); + PL_last_uni = SvPVX(PL_linestr) + (i < 0 ? 0 : i); + i = proto_perl->Ilast_lop - SvPVX(proto_perl->Ilinestr); + PL_last_lop = SvPVX(PL_linestr) + (i < 0 ? 0 : i); + PL_last_lop_op = proto_perl->Ilast_lop_op; + PL_in_my = proto_perl->Iin_my; + PL_in_my_stash = hv_dup(proto_perl->Iin_my_stash); +#ifdef FCRYPT + PL_cryptseen = proto_perl->Icryptseen; +#endif + + PL_hints = proto_perl->Ihints; + + PL_amagic_generation = proto_perl->Iamagic_generation; + +#ifdef USE_LOCALE_COLLATE + PL_collation_ix = proto_perl->Icollation_ix; + PL_collation_name = SAVEPV(proto_perl->Icollation_name); + PL_collation_standard = proto_perl->Icollation_standard; + PL_collxfrm_base = proto_perl->Icollxfrm_base; + PL_collxfrm_mult = proto_perl->Icollxfrm_mult; +#endif /* USE_LOCALE_COLLATE */ + +#ifdef USE_LOCALE_NUMERIC + PL_numeric_name = SAVEPV(proto_perl->Inumeric_name); + PL_numeric_standard = proto_perl->Inumeric_standard; + PL_numeric_local = proto_perl->Inumeric_local; + PL_numeric_radix = proto_perl->Inumeric_radix; +#endif /* !USE_LOCALE_NUMERIC */ + + /* utf8 character classes */ + PL_utf8_alnum = sv_dup_inc(proto_perl->Iutf8_alnum); + PL_utf8_alnumc = sv_dup_inc(proto_perl->Iutf8_alnumc); + PL_utf8_ascii = sv_dup_inc(proto_perl->Iutf8_ascii); + PL_utf8_alpha = sv_dup_inc(proto_perl->Iutf8_alpha); + PL_utf8_space = sv_dup_inc(proto_perl->Iutf8_space); + PL_utf8_cntrl = sv_dup_inc(proto_perl->Iutf8_cntrl); + PL_utf8_graph = sv_dup_inc(proto_perl->Iutf8_graph); + PL_utf8_digit = sv_dup_inc(proto_perl->Iutf8_digit); + PL_utf8_upper = sv_dup_inc(proto_perl->Iutf8_upper); + PL_utf8_lower = sv_dup_inc(proto_perl->Iutf8_lower); + PL_utf8_print = sv_dup_inc(proto_perl->Iutf8_print); + PL_utf8_punct = sv_dup_inc(proto_perl->Iutf8_punct); + PL_utf8_xdigit = sv_dup_inc(proto_perl->Iutf8_xdigit); + PL_utf8_mark = sv_dup_inc(proto_perl->Iutf8_mark); + PL_utf8_toupper = sv_dup_inc(proto_perl->Iutf8_toupper); + PL_utf8_totitle = sv_dup_inc(proto_perl->Iutf8_totitle); + PL_utf8_tolower = sv_dup_inc(proto_perl->Iutf8_tolower); + + /* swatch cache */ + PL_last_swash_hv = Nullhv; /* reinits on demand */ + PL_last_swash_klen = 0; + PL_last_swash_key[0]= '\0'; + PL_last_swash_tmps = (U8*)NULL; + PL_last_swash_slen = 0; + + /* perly.c globals */ + PL_yydebug = proto_perl->Iyydebug; + PL_yynerrs = proto_perl->Iyynerrs; + PL_yyerrflag = proto_perl->Iyyerrflag; + PL_yychar = proto_perl->Iyychar; + PL_yyval = proto_perl->Iyyval; + PL_yylval = proto_perl->Iyylval; + + PL_glob_index = proto_perl->Iglob_index; + PL_srand_called = proto_perl->Isrand_called; + PL_uudmap['M'] = 0; /* reinits on demand */ + PL_bitcount = Nullch; /* reinits on demand */ + + if (proto_perl->Ipsig_ptr) { + int sig_num[] = { SIG_NUM }; + Newz(0, PL_psig_ptr, sizeof(sig_num)/sizeof(*sig_num), SV*); + Newz(0, PL_psig_name, sizeof(sig_num)/sizeof(*sig_num), SV*); + for (i = 1; PL_sig_name[i]; i++) { + PL_psig_ptr[i] = sv_dup_inc(proto_perl->Ipsig_ptr[i]); + PL_psig_name[i] = sv_dup_inc(proto_perl->Ipsig_name[i]); + } + } + else { + PL_psig_ptr = (SV**)NULL; + PL_psig_name = (SV**)NULL; + } + + /* thrdvar.h stuff */ + + if (flags & 1) { + /* next allocation will be PL_tmps_stack[PL_tmps_ix+1] */ + PL_tmps_ix = proto_perl->Ttmps_ix; + PL_tmps_max = proto_perl->Ttmps_max; + PL_tmps_floor = proto_perl->Ttmps_floor; + Newz(50, PL_tmps_stack, PL_tmps_max, SV*); + i = 0; + while (i <= PL_tmps_ix) { + PL_tmps_stack[i] = sv_dup_inc(proto_perl->Ttmps_stack[i]); + ++i; + } + + /* next PUSHMARK() sets *(PL_markstack_ptr+1) */ + i = proto_perl->Tmarkstack_max - proto_perl->Tmarkstack; + Newz(54, PL_markstack, i, I32); + PL_markstack_max = PL_markstack + (proto_perl->Tmarkstack_max + - proto_perl->Tmarkstack); + PL_markstack_ptr = PL_markstack + (proto_perl->Tmarkstack_ptr + - proto_perl->Tmarkstack); + Copy(proto_perl->Tmarkstack, PL_markstack, + PL_markstack_ptr - PL_markstack + 1, I32); + + /* next push_scope()/ENTER sets PL_scopestack[PL_scopestack_ix] + * NOTE: unlike the others! */ + PL_scopestack_ix = proto_perl->Tscopestack_ix; + PL_scopestack_max = proto_perl->Tscopestack_max; + Newz(54, PL_scopestack, PL_scopestack_max, I32); + Copy(proto_perl->Tscopestack, PL_scopestack, PL_scopestack_ix, I32); + + /* next push_return() sets PL_retstack[PL_retstack_ix] + * NOTE: unlike the others! */ + PL_retstack_ix = proto_perl->Tretstack_ix; + PL_retstack_max = proto_perl->Tretstack_max; + Newz(54, PL_retstack, PL_retstack_max, OP*); + Copy(proto_perl->Tretstack, PL_retstack, PL_retstack_ix, I32); + + /* NOTE: si_dup() looks at PL_markstack */ + PL_curstackinfo = si_dup(proto_perl->Tcurstackinfo); + + /* PL_curstack = PL_curstackinfo->si_stack; */ + PL_curstack = av_dup(proto_perl->Tcurstack); + PL_mainstack = av_dup(proto_perl->Tmainstack); + + /* next PUSHs() etc. set *(PL_stack_sp+1) */ + PL_stack_base = AvARRAY(PL_curstack); + PL_stack_sp = PL_stack_base + (proto_perl->Tstack_sp + - proto_perl->Tstack_base); + PL_stack_max = PL_stack_base + AvMAX(PL_curstack); + + /* next SSPUSHFOO() sets PL_savestack[PL_savestack_ix] + * NOTE: unlike the others! */ + PL_savestack_ix = proto_perl->Tsavestack_ix; + PL_savestack_max = proto_perl->Tsavestack_max; + /*Newz(54, PL_savestack, PL_savestack_max, ANY);*/ + PL_savestack = ss_dup(proto_perl); + } + else { + init_stacks(); + } + + PL_start_env = proto_perl->Tstart_env; /* XXXXXX */ + PL_top_env = &PL_start_env; + + PL_op = proto_perl->Top; + + PL_Sv = Nullsv; + PL_Xpv = (XPV*)NULL; + PL_na = proto_perl->Tna; + + PL_statbuf = proto_perl->Tstatbuf; + PL_statcache = proto_perl->Tstatcache; + PL_statgv = gv_dup(proto_perl->Tstatgv); + PL_statname = sv_dup_inc(proto_perl->Tstatname); +#ifdef HAS_TIMES + PL_timesbuf = proto_perl->Ttimesbuf; +#endif + + PL_tainted = proto_perl->Ttainted; + PL_curpm = proto_perl->Tcurpm; /* XXX No PMOP ref count */ + PL_nrs = sv_dup_inc(proto_perl->Tnrs); + PL_rs = sv_dup_inc(proto_perl->Trs); + PL_last_in_gv = gv_dup(proto_perl->Tlast_in_gv); + PL_ofslen = proto_perl->Tofslen; + PL_ofs = SAVEPVN(proto_perl->Tofs, PL_ofslen); + PL_defoutgv = gv_dup_inc(proto_perl->Tdefoutgv); + PL_chopset = proto_perl->Tchopset; /* XXX never deallocated */ + PL_toptarget = sv_dup_inc(proto_perl->Ttoptarget); + PL_bodytarget = sv_dup_inc(proto_perl->Tbodytarget); + PL_formtarget = sv_dup(proto_perl->Tformtarget); + + PL_restartop = proto_perl->Trestartop; + PL_in_eval = proto_perl->Tin_eval; + PL_delaymagic = proto_perl->Tdelaymagic; + PL_dirty = proto_perl->Tdirty; + PL_localizing = proto_perl->Tlocalizing; + + PL_protect = proto_perl->Tprotect; + PL_errors = sv_dup_inc(proto_perl->Terrors); + PL_av_fetch_sv = Nullsv; + PL_hv_fetch_sv = Nullsv; + Zero(&PL_hv_fetch_ent_mh, 1, HE); /* XXX */ + PL_modcount = proto_perl->Tmodcount; + PL_lastgotoprobe = Nullop; + PL_dumpindent = proto_perl->Tdumpindent; + + PL_sortcop = (OP*)any_dup(proto_perl->Tsortcop, proto_perl); + PL_sortstash = hv_dup(proto_perl->Tsortstash); + PL_firstgv = gv_dup(proto_perl->Tfirstgv); + PL_secondgv = gv_dup(proto_perl->Tsecondgv); + PL_sortcxix = proto_perl->Tsortcxix; + PL_efloatbuf = Nullch; /* reinits on demand */ + PL_efloatsize = 0; /* reinits on demand */ + + /* regex stuff */ + + PL_screamfirst = NULL; + PL_screamnext = NULL; + PL_maxscream = -1; /* reinits on demand */ + PL_lastscream = Nullsv; + + PL_watchaddr = NULL; + PL_watchok = Nullch; + + PL_regdummy = proto_perl->Tregdummy; + PL_regcomp_parse = Nullch; + PL_regxend = Nullch; + PL_regcode = (regnode*)NULL; + PL_regnaughty = 0; + PL_regsawback = 0; + PL_regprecomp = Nullch; + PL_regnpar = 0; + PL_regsize = 0; + PL_regflags = 0; + PL_regseen = 0; + PL_seen_zerolen = 0; + PL_seen_evals = 0; + PL_regcomp_rx = (regexp*)NULL; + PL_extralen = 0; + PL_colorset = 0; /* reinits PL_colors[] */ + /*PL_colors[6] = {0,0,0,0,0,0};*/ + PL_reg_whilem_seen = 0; + PL_reginput = Nullch; + PL_regbol = Nullch; + PL_regeol = Nullch; + PL_regstartp = (I32*)NULL; + PL_regendp = (I32*)NULL; + PL_reglastparen = (U32*)NULL; + PL_regtill = Nullch; + PL_regprev = '\n'; + PL_reg_start_tmp = (char**)NULL; + PL_reg_start_tmpl = 0; + PL_regdata = (struct reg_data*)NULL; + PL_bostr = Nullch; + PL_reg_flags = 0; + PL_reg_eval_set = 0; + PL_regnarrate = 0; + PL_regprogram = (regnode*)NULL; + PL_regindent = 0; + PL_regcc = (CURCUR*)NULL; + PL_reg_call_cc = (struct re_cc_state*)NULL; + PL_reg_re = (regexp*)NULL; + PL_reg_ganch = Nullch; + PL_reg_sv = Nullsv; + PL_reg_magic = (MAGIC*)NULL; + PL_reg_oldpos = 0; + PL_reg_oldcurpm = (PMOP*)NULL; + PL_reg_curpm = (PMOP*)NULL; + PL_reg_oldsaved = Nullch; + PL_reg_oldsavedlen = 0; + PL_reg_maxiter = 0; + PL_reg_leftiter = 0; + PL_reg_poscache = Nullch; + PL_reg_poscache_size= 0; + + /* RE engine - function pointers */ + PL_regcompp = proto_perl->Tregcompp; + PL_regexecp = proto_perl->Tregexecp; + PL_regint_start = proto_perl->Tregint_start; + PL_regint_string = proto_perl->Tregint_string; + PL_regfree = proto_perl->Tregfree; + + PL_reginterp_cnt = 0; + PL_reg_starttry = 0; + +#ifdef PERL_OBJECT + return (PerlInterpreter*)pPerl; +#else + return my_perl; +#endif +} + +#else /* !USE_ITHREADS */ #ifdef PERL_OBJECT -#define NO_XSLOCKS #include "XSUB.h" #endif +#endif /* USE_ITHREADS */ + static void do_report_used(pTHXo_ SV *sv) { if (SvTYPE(sv) != SVTYPEMASK) { - /* XXX Perhaps this ought to go to Perl_debug_log, if DEBUGGING. */ - PerlIO_printf(PerlIO_stderr(), "****\n"); + PerlIO_printf(Perl_debug_log, "****\n"); sv_dump(sv); } } @@ -5665,7 +7303,7 @@ do_clean_objs(pTHXo_ SV *sv) static void do_clean_named_objs(pTHXo_ SV *sv) { - if (SvTYPE(sv) == SVt_PVGV) { + if (SvTYPE(sv) == SVt_PVGV && GvGP(sv)) { if ( SvOBJECT(GvSV(sv)) || GvAV(sv) && SvOBJECT(GvAV(sv)) || GvHV(sv) && SvOBJECT(GvHV(sv)) || @@ -5682,7 +7320,7 @@ do_clean_named_objs(pTHXo_ SV *sv) static void do_clean_all(pTHXo_ SV *sv) { - DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning loops: SV at 0x%lx\n", sv) );) + DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning loops: SV at 0x%"UVxf"\n", PTR2UV(sv)) );) SvFLAGS(sv) |= SVf_BREAK; SvREFCNT_dec(sv); } diff --git a/sv.h b/sv.h index e99891d..4505d60 100644 --- a/sv.h +++ b/sv.h @@ -137,13 +137,16 @@ struct io { #define SVf_BREAK 0x00400000 /* refcnt is artificially low */ #define SVf_READONLY 0x00800000 /* may not be modified */ -#define SVf_THINKFIRST (SVf_READONLY|SVf_ROK|SVf_FAKE) #define SVp_IOK 0x01000000 /* has valid non-public integer value */ #define SVp_NOK 0x02000000 /* has valid non-public numeric value */ #define SVp_POK 0x04000000 /* has valid non-public pointer value */ #define SVp_SCREAM 0x08000000 /* has been studied? */ +#define SVf_UTF8 0x20000000 /* SvPVX is UTF-8 encoded */ + +#define SVf_THINKFIRST (SVf_READONLY|SVf_ROK|SVf_FAKE|SVf_UTF8) + #define SVf_OK (SVf_IOK|SVf_NOK|SVf_POK|SVf_ROK| \ SVp_IOK|SVp_NOK|SVp_POK) @@ -153,6 +156,7 @@ struct io { /* Some private flags. */ +/* SVpad_OUR may be set on SVt_PV{NV,MG,GV} types */ #define SVpad_OUR 0x80000000 /* pad name is "our" instead of "my" */ #define SVf_IVisUV 0x80000000 /* use XPVUV instead of XPVIV */ @@ -257,7 +261,7 @@ struct xpvbm { U8 xbm_rare; /* rarest character in string */ }; -/* This structure much match XPVCV */ +/* This structure much match XPVCV in cv.h */ typedef U16 cv_flags_t; @@ -276,8 +280,8 @@ struct xpvfm { void (*xcv_xsub)(pTHXo_ CV*); ANY xcv_xsubany; GV * xcv_gv; - GV * xcv_filegv; - long xcv_depth; /* >= 2 indicates recursive call */ + char * xcv_file; + long xcv_depth; /* >= 2 indicates recursive call */ AV * xcv_padlist; CV * xcv_outside; #ifdef USE_THREADS @@ -316,12 +320,13 @@ struct xpvio { char xio_flags; }; -#define IOf_ARGV 1 /* this fp iterates over ARGV */ -#define IOf_START 2 /* check for null ARGV and substitute '-' */ -#define IOf_FLUSH 4 /* this fp wants a flush after write op */ -#define IOf_DIDTOP 8 /* just did top of form */ -#define IOf_UNTAINT 16 /* consider this fp (and its data) "safe" */ -#define IOf_NOLINE 32 /* slurped a pseudo-line from empty file */ +#define IOf_ARGV 1 /* this fp iterates over ARGV */ +#define IOf_START 2 /* check for null ARGV and substitute '-' */ +#define IOf_FLUSH 4 /* this fp wants a flush after write op */ +#define IOf_DIDTOP 8 /* just did top of form */ +#define IOf_UNTAINT 16 /* consider this fp (and its data) "safe" */ +#define IOf_NOLINE 32 /* slurped a pseudo-line from empty file */ +#define IOf_FAKE_DIRP 64 /* xio_dirp is fake (source filters kludge) */ /* The following macros define implementation-independent predicates on SVs. */ @@ -353,7 +358,7 @@ struct xpvio { SvFLAGS(sv) |= (SVf_IOK|SVp_IOK)) #define SvIOK_only_UV(sv) (SvOK_off_exc_UV(sv), \ SvFLAGS(sv) |= (SVf_IOK|SVp_IOK)) - + #define SvIOK_UV(sv) ((SvFLAGS(sv) & (SVf_IOK|SVf_IVisUV)) \ == (SVf_IOK|SVf_IVisUV)) #define SvIOK_notUV(sv) ((SvFLAGS(sv) & (SVf_IOK|SVf_IVisUV)) \ @@ -369,6 +374,10 @@ struct xpvio { #define SvNOK_only(sv) (SvOK_off(sv), \ SvFLAGS(sv) |= (SVf_NOK|SVp_NOK)) +#define SvUTF8(sv) (SvFLAGS(sv) & SVf_UTF8) +#define SvUTF8_on(sv) (SvFLAGS(sv) |= (SVf_UTF8)) +#define SvUTF8_off(sv) (SvFLAGS(sv) &= ~(SVf_UTF8)) + #define SvPOK(sv) (SvFLAGS(sv) & SVf_POK) #define SvPOK_on(sv) (SvFLAGS(sv) |= (SVf_POK|SVp_POK)) #define SvPOK_off(sv) (SvFLAGS(sv) &= ~(SVf_POK|SVp_POK)) @@ -544,11 +553,26 @@ struct xpvio { #define SvPV_force(sv, lp) sv_pvn_force(sv, &lp) #define SvPV(sv, lp) sv_pvn(sv, &lp) #define SvPV_nolen(sv) sv_pv(sv) + +#define SvPVutf8_force(sv, lp) sv_pvutf8n_force(sv, &lp) +#define SvPVutf8(sv, lp) sv_pvutf8n(sv, &lp) +#define SvPVutf8_nolen(sv) sv_pvutf8(sv) + +#define SvPVbyte_force(sv, lp) sv_pvbyte_force(sv, &lp) +#define SvPVbyte(sv, lp) sv_pvbyten(sv, &lp) +#define SvPVbyte_nolen(sv) sv_pvbyte(sv) + +#define SvPVx(sv, lp) sv_pvn(sv, &lp) +#define SvPVx_force(sv, lp) sv_pvn_force(sv, &lp) +#define SvPVutf8x(sv, lp) sv_pvutf8n(sv, &lp) +#define SvPVutf8x_force(sv, lp) sv_pvutf8n_force(sv, &lp) +#define SvPVbytex(sv, lp) sv_pvbyten(sv, &lp) +#define SvPVbytex_force(sv, lp) sv_pvbyten_force(sv, &lp) + #define SvIVx(sv) sv_iv(sv) #define SvUVx(sv) sv_uv(sv) #define SvNVx(sv) sv_nv(sv) -#define SvPVx(sv, lp) sv_pvn(sv, &lp) -#define SvPVx_force(sv, lp) sv_pvn_force(sv, &lp) + #define SvTRUEx(sv) sv_true(sv) #define SvIV(sv) SvIVx(sv) @@ -571,7 +595,9 @@ struct xpvio { #undef SvPV #define SvPV(sv, lp) \ - (SvPOK(sv) ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv(sv, &lp)) + ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ + ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv(sv, &lp)) + #undef SvPV_force #define SvPV_force(sv, lp) \ @@ -580,19 +606,70 @@ struct xpvio { #undef SvPV_nolen #define SvPV_nolen(sv) \ - (SvPOK(sv) ? SvPVX(sv) : sv_2pv_nolen(sv)) + ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ + ? SvPVX(sv) : sv_2pv_nolen(sv)) + +#undef SvPVutf8 +#define SvPVutf8(sv, lp) \ + ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK|SVf_UTF8) \ + ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvutf8(sv, &lp)) + +#undef SvPVutf8_force +#define SvPVutf8_force(sv, lp) \ + ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == (SVf_POK|SVf_UTF8) \ + ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvutf8n_force(sv, &lp)) + +#undef SvPVutf8_nolen +#define SvPVutf8_nolen(sv) \ + ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK|SVf_UTF8)\ + ? SvPVX(sv) : sv_2pvutf8_nolen(sv)) + +#undef SvPVutf8 +#define SvPVutf8(sv, lp) \ + ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK|SVf_UTF8) \ + ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvutf8(sv, &lp)) + +#undef SvPVutf8_force +#define SvPVutf8_force(sv, lp) \ + ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == (SVf_POK|SVf_UTF8) \ + ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvutf8n_force(sv, &lp)) + +#undef SvPVutf8_nolen +#define SvPVutf8_nolen(sv) \ + ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK|SVf_UTF8)\ + ? SvPVX(sv) : sv_2pvutf8_nolen(sv)) + +#undef SvPVbyte +#define SvPVbyte(sv, lp) \ + ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \ + ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp)) + +#undef SvPVbyte_force +#define SvPVbyte_force(sv, lp) \ + ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVf_THINKFIRST)) == (SVf_POK) \ + ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvbyte_force(sv, &lp)) + +#undef SvPVbyte_nolen +#define SvPVbyte_nolen(sv) \ + ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK)\ + ? SvPVX(sv) : sv_2pvbyte_nolen(sv)) + #ifdef __GNUC__ # undef SvIVx # undef SvUVx # undef SvNVx # undef SvPVx +# undef SvPVutf8x +# undef SvPVbytex # undef SvTRUE # undef SvTRUEx # define SvIVx(sv) ({SV *nsv = (SV*)(sv); SvIV(nsv); }) # define SvUVx(sv) ({SV *nsv = (SV*)(sv); SvUV(nsv); }) # define SvNVx(sv) ({SV *nsv = (SV*)(sv); SvNV(nsv); }) # define SvPVx(sv, lp) ({SV *nsv = (sv); SvPV(nsv, lp); }) +# define SvPVutf8x(sv, lp) ({SV *nsv = (sv); SvPVutf8(nsv, lp); }) +# define SvPVbytex(sv, lp) ({SV *nsv = (sv); SvPVbyte(nsv, lp); }) # define SvTRUE(sv) ( \ !sv \ ? 0 \ @@ -620,12 +697,16 @@ struct xpvio { # undef SvUVx # undef SvNVx # undef SvPVx +# undef SvPVutf8x +# undef SvPVbytex # undef SvTRUE # undef SvTRUEx # define SvIVx(sv) ((PL_Sv = (sv)), SvIV(PL_Sv)) # define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv)) # define SvNVx(sv) ((PL_Sv = (sv)), SvNV(PL_Sv)) # define SvPVx(sv, lp) ((PL_Sv = (sv)), SvPV(PL_Sv, lp)) +# define SvPVutf8x(sv, lp) ((PL_Sv = (sv)), SvPVutf8(PL_Sv, lp)) +# define SvPVbytex(sv, lp) ((PL_Sv = (sv)), SvPVbyte(PL_Sv, lp)) # define SvTRUE(sv) ( \ !sv \ ? 0 \ diff --git a/t/TEST b/t/TEST index 1f9190d..0b674af 100755 --- a/t/TEST +++ b/t/TEST @@ -153,7 +153,7 @@ EOT } } else { - $pct = sprintf("%.2f", ($files - $bad) / $files * 100); + $pct = $files ? sprintf("%.2f", ($files - $bad) / $files * 100) : "0.00"; if ($bad == 1) { warn "Failed 1 test script out of $files, $pct% okay.\n"; } diff --git a/t/comp/bproto.t b/t/comp/bproto.t index 699ea57..01efb84 100755 --- a/t/comp/bproto.t +++ b/t/comp/bproto.t @@ -8,7 +8,7 @@ BEGIN { unshift @INC, '../lib'; } -print "1..7\n"; +print "1..10\n"; my $i = 1; @@ -38,4 +38,7 @@ q[ scalar(&foo,$bar); defined &foo, &foo, &foo; undef &foo, $bar; uc $bar,$bar; + grep(not($bar), $bar); + grep(not($bar, $bar), $bar); + grep((not $bar, $bar, $bar), $bar); ]; diff --git a/t/comp/require.t b/t/comp/require.t index 581dcba..d4c9d8c 100755 --- a/t/comp/require.t +++ b/t/comp/require.t @@ -7,7 +7,7 @@ BEGIN { # don't make this lexical $i = 1; -print "1..4\n"; +print "1..16\n"; sub do_require { %INC = (); @@ -23,6 +23,56 @@ sub write_file { close REQ; } +# new style version numbers + +eval { require v5.5.630; }; +print "# $@\nnot " if $@; +print "ok ",$i++,"\n"; + +eval { require v10.0.2; }; +print "# $@\nnot " unless $@ =~ /^Perl v10\.0\.2 required/; +print "ok ",$i++,"\n"; + +eval q{ use v5.5.630; }; +print "# $@\nnot " if $@; +print "ok ",$i++,"\n"; + +eval q{ use v10.0.2; }; +print "# $@\nnot " unless $@ =~ /^Perl v10\.0\.2 required/; +print "ok ",$i++,"\n"; + +my $ver = v5.5.630; +eval { require $ver; }; +print "# $@\nnot " if $@; +print "ok ",$i++,"\n"; + +$ver = v10.0.2; +eval { require $ver; }; +print "# $@\nnot " unless $@ =~ /^Perl v10\.0\.2 required/; +print "ok ",$i++,"\n"; + +print "not " unless v5.5.1 gt v5.5; +print "ok ",$i++,"\n"; + +print "not " unless 5.005_01 > v5.5; +print "ok ",$i++,"\n"; + +print "not " unless 5.005_64 - v5.5.640 < 0.0000001; +print "ok ",$i++,"\n"; + +{ + use utf8; + print "not " unless v5.5.640 eq "\x{5}\x{5}\x{280}"; + print "ok ",$i++,"\n"; + + print "not " unless v7.15 eq "\x{7}\x{f}"; + print "ok ",$i++,"\n"; + + print "not " + unless v1.20.300.4000.50000.600000 eq "\x{1}\x{14}\x{12c}\x{fa0}\x{c350}\x{927c0}"; + print "ok ",$i++,"\n"; +} + # interaction with pod (see the eof) write_file('bleah.pm', "print 'ok $i\n'; 1;\n"); require "bleah.pm"; diff --git a/t/comp/term.t b/t/comp/term.t index eb99680..f079eef 100755 --- a/t/comp/term.t +++ b/t/comp/term.t @@ -1,10 +1,8 @@ #!./perl -# $RCSfile: term.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:24 $ - # tests that aren't important enough for base.term -print "1..22\n"; +print "1..23\n"; $x = "\\n"; print "#1\t:$x: eq " . ':\n:' . "\n"; @@ -68,3 +66,7 @@ if (ref($a) eq 'HASH') {print "ok 21\n";} else {print "not ok 21\n";} $a = "+{ \$a=>'foo'}"; $a = eval $a; if (ref($a) eq 'HASH') {print "ok 22\n";} else {print "not ok 22\n";} + +$a = "{ 0x01 => 'foo'}->{0x01}"; +$a = eval $a; +if ($a eq 'foo') {print "ok 23\n";} else {print "not ok 23\n";} diff --git a/t/io/argv.t b/t/io/argv.t index c6565dc..d6093f9 100755 --- a/t/io/argv.t +++ b/t/io/argv.t @@ -1,24 +1,33 @@ #!./perl -print "1..6\n"; +BEGIN { + chdir 't' if -d 't'; + unshift @INC, '../lib'; +} + +print "1..20\n"; + +use File::Spec; + +my $devnull = File::Spec->devnull; -open(try, '>Io.argv.tmp') || (die "Can't open temp file: $!"); +open(try, '>Io_argv1.tmp') || (die "Can't open temp file: $!"); print try "a line\n"; close try; if ($^O eq 'MSWin32') { - $x = `.\\perl -e "while (<>) {print \$.,\$_;}" Io.argv.tmp Io.argv.tmp`; + $x = `.\\perl -e "while (<>) {print \$.,\$_;}" Io_argv1.tmp Io_argv1.tmp`; } else { - $x = `./perl -e 'while (<>) {print \$.,\$_;}' Io.argv.tmp Io.argv.tmp`; + $x = `./perl -e 'while (<>) {print \$.,\$_;}' Io_argv1.tmp Io_argv1.tmp`; } if ($x eq "1a line\n2a line\n") {print "ok 1\n";} else {print "not ok 1\n";} if ($^O eq 'MSWin32') { - $x = `.\\perl -le "print 'foo'" | .\\perl -e "while (<>) {print \$_;}" Io.argv.tmp -`; + $x = `.\\perl -le "print 'foo'" | .\\perl -e "while (<>) {print \$_;}" Io_argv1.tmp -`; } else { - $x = `echo foo|./perl -e 'while (<>) {print $_;}' Io.argv.tmp -`; + $x = `echo foo|./perl -e 'while (<>) {print $_;}' Io_argv1.tmp -`; } if ($x eq "a line\nfoo\n") {print "ok 2\n";} else {print "not ok 2\n";} @@ -30,7 +39,7 @@ else { } if ($x eq "foo\n") {print "ok 3\n";} else {print "not ok 3 :$x:\n";} -@ARGV = ('Io.argv.tmp', 'Io.argv.tmp', '/dev/null', 'Io.argv.tmp'); +@ARGV = ('Io_argv1.tmp', 'Io_argv1.tmp', $devnull, 'Io_argv1.tmp'); while (<>) { $y .= $. . $_; if (eof()) { @@ -43,17 +52,74 @@ if ($y eq "1a line\n2a line\n3a line\n") else {print "not ok 5\n";} -open(try, '>Io.argv.tmp') or die "Can't open temp file: $!"; +open(try, '>Io_argv1.tmp') or die "Can't open temp file: $!"; close try; -@ARGV = 'Io.argv.tmp'; +open(try, '>Io_argv2.tmp') or die "Can't open temp file: $!"; +close try; +@ARGV = ('Io_argv1.tmp', 'Io_argv2.tmp'); $^I = '.bak'; $/ = undef; +my $i = 6; while (<>) { - s/^/ok 6\n/; + s/^/ok $i\n/; + ++$i; print; } -open(try, '; +open(try, '; close try; +undef $^I; + +eof try or print 'not '; +print "ok 8\n"; + +eof NEVEROPENED or print 'not '; +print "ok 9\n"; + +open STDIN, 'Io_argv1.tmp' or die $!; +@ARGV = (); +!eof() or print 'not '; +print "ok 10\n"; + +<> eq "ok 6\n" or print 'not '; +print "ok 11\n"; + +open STDIN, $devnull or die $!; +@ARGV = (); +eof() or print 'not '; +print "ok 12\n"; + +@ARGV = ('Io_argv1.tmp'); +!eof() or print 'not '; +print "ok 13\n"; + +@ARGV = ($devnull, $devnull); +!eof() or print 'not '; +print "ok 14\n"; + +close ARGV or die $!; +eof() or print 'not '; +print "ok 15\n"; + +{ + local $/; + open F, 'Io_argv1.tmp' or die; + ; # set $. = 1 + open F, $devnull or die; + print "not " unless defined(); + print "ok 16\n"; + print "not " if defined(); + print "ok 17\n"; + print "not " if defined(); + print "ok 18\n"; + open F, $devnull or die; # restart cycle again + print "not " unless defined(); + print "ok 19\n"; + print "not " if defined(); + print "ok 20\n"; + close F; +} -END { unlink 'Io.argv.tmp', 'Io.argv.tmp.bak' } +END { unlink 'Io_argv1.tmp', 'Io_argv1.tmp.bak', 'Io_argv2.tmp', 'Io_argv2.tmp.bak' } diff --git a/t/io/fs.t b/t/io/fs.t index 087021b..72e9552 100755 --- a/t/io/fs.t +++ b/t/io/fs.t @@ -12,6 +12,10 @@ use Config; $Is_Dosish = ($^O eq 'MSWin32' or $^O eq 'dos' or $^O eq 'os2' or $^O eq 'mint'); +if (defined &Win32::IsWinNT && Win32::IsWinNT()) { + $Is_Dosish = '' if Win32::FsType() eq 'NTFS'; +} + print "1..28\n"; $wd = (($^O eq 'MSWin32') ? `cd` : `pwd`); @@ -54,28 +58,35 @@ elsif (($mode & 0777) == 0666) {print "ok 5\n";} else {print "not ok 5\n";} -if ((chmod 0777,'a') == 1) {print "ok 6\n";} else {print "not ok 6\n";} +$newmode = $^O eq 'MSWin32' ? 0444 : 0777; +if ((chmod $newmode,'a') == 1) {print "ok 6\n";} else {print "not ok 6\n";} ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, $blksize,$blocks) = stat('c'); if ($Is_Dosish) {print "ok 7 # skipped: no link\n";} -elsif (($mode & 0777) == 0777) {print "ok 7\n";} +elsif (($mode & 0777) == $newmode) {print "ok 7\n";} else {print "not ok 7\n";} +$newmode = 0700; +if ($^O eq 'MSWin32') { + chmod 0444, 'x'; + $newmode = 0666; +} + if ($Is_Dosish) {print "ok 8 # skipped: no link\n";} -elsif ((chmod 0700,'c','x') == 2) {print "ok 8\n";} +elsif ((chmod $newmode,'c','x') == 2) {print "ok 8\n";} else {print "not ok 8\n";} ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, $blksize,$blocks) = stat('c'); if ($Is_Dosish) {print "ok 9 # skipped: no link\n";} -elsif (($mode & 0777) == 0700) {print "ok 9\n";} +elsif (($mode & 0777) == $newmode) {print "ok 9\n";} else {print "not ok 9\n";} ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, $blksize,$blocks) = stat('x'); if ($Is_Dosish) {print "ok 10 # skipped: no link\n";} -elsif (($mode & 0777) == 0700) {print "ok 10\n";} +elsif (($mode & 0777) == $newmode) {print "ok 10\n";} else {print "not ok 10\n";} if ($Is_Dosish) {print "ok 11 # skipped: no link\n"; unlink 'b','x'; } @@ -147,12 +158,18 @@ else { print FH "helloworld\n"; truncate FH, 5; } - if ($^O eq 'dos') { + if ($^O eq 'dos' + # Not needed on HPFS, but needed on HPFS386 ?! + or $^O eq 'os2') + { close (FH); open (FH, ">>Iofs.tmp") or die "Can't reopen Iofs.tmp"; } if (-s "Iofs.tmp" == 5) {print "ok 25\n"} else {print "not ok 25\n"} truncate FH, 0; - if ($^O eq 'dos') { + if ($^O eq 'dos' + # Not needed on HPFS, but needed on HPFS386 ?! + or $^O eq 'os2') + { close (FH); open (FH, ">>Iofs.tmp") or die "Can't reopen Iofs.tmp"; } if (-z "Iofs.tmp") {print "ok 26\n"} else {print "not ok 26\n"} diff --git a/t/io/nargv.t b/t/io/nargv.t new file mode 100755 index 0000000..fb13857 --- /dev/null +++ b/t/io/nargv.t @@ -0,0 +1,63 @@ +#!./perl + +print "1..5\n"; + +my $j = 1; +for $i ( 1,2,5,4,3 ) { + $file = mkfiles($i); + open(FH, "> $file") || die "can't create $file: $!"; + print FH "not ok " . $j++ . "\n"; + close(FH) || die "Can't close $file: $!"; +} + + +{ + local *ARGV; + local $^I = '.bak'; + local $_; + @ARGV = mkfiles(1..3); + $n = 0; + while (<>) { + print STDOUT "# initial \@ARGV: [@ARGV]\n"; + if ($n++ == 2) { + other(); + } + show(); + } +} + +$^I = undef; +@ARGV = mkfiles(1..3); +$n = 0; +while (<>) { + print STDOUT "#final \@ARGV: [@ARGV]\n"; + if ($n++ == 2) { + other(); + } + show(); +} + +sub show { + #warn "$ARGV: $_"; + s/^not //; + print; +} + +sub other { + print STDOUT "# Calling other\n"; + local *ARGV; + local *ARGVOUT; + local $_; + @ARGV = mkfiles(5, 4); + while (<>) { + print STDOUT "# inner \@ARGV: [@ARGV]\n"; + show(); + } +} + +sub mkfiles { + my @files = map { "scratch$_" } @_; + return wantarray ? @files : $files[-1]; +} + +END { unlink map { ($_, "$_.bak") } mkfiles(1..5) } diff --git a/t/io/open.t b/t/io/open.t index 418edac..1e94091 100755 --- a/t/io/open.t +++ b/t/io/open.t @@ -5,110 +5,273 @@ $| = 1; $^W = 1; $Is_VMS = $^O eq 'VMS'; -print "1..32\n"; +print "1..66\n"; + +my $test = 1; + +sub ok { print "ok $test\n"; $test++ } # my $file tests +# 1..9 { -unlink("afile") if -f "afile"; -print "$!\nnot " unless open(my $f,"+>afile"); -print "ok 1\n"; -binmode $f; -print "not " unless -f "afile"; -print "ok 2\n"; -print "not " unless print $f "SomeData\n"; -print "ok 3\n"; -print "not " unless tell($f) == 9; -print "ok 4\n"; -print "not " unless seek($f,0,0); -print "ok 5\n"; -$b = <$f>; -print "not " unless $b eq "SomeData\n"; -print "ok 6\n"; -print "not " unless -f $f; -print "ok 7\n"; -eval { die "Message" }; -# warn $@; -print "not " unless $@ =~ /<\$f> line 1/; -print "ok 8\n"; -print "not " unless close($f); -print "ok 9\n"; -unlink("afile"); + unlink("afile") if -f "afile"; + print "$!\nnot " unless open(my $f,"+>afile"); + ok; + binmode $f; + print "not " unless -f "afile"; + ok; + print "not " unless print $f "SomeData\n"; + ok; + print "not " unless tell($f) == 9; + ok; + print "not " unless seek($f,0,0); + ok; + $b = <$f>; + print "not " unless $b eq "SomeData\n"; + ok; + print "not " unless -f $f; + ok; + eval { die "Message" }; + # warn $@; + print "not " unless $@ =~ /<\$f> line 1/; + ok; + print "not " unless close($f); + ok; + unlink("afile"); } + +# 10..12 { -print "# \$!='$!'\nnot " unless open(my $f,'>', 'afile'); -print "ok 10\n"; -print $f "a row\n"; -print "not " unless close($f); -print "ok 11\n"; -print "not " unless -s 'afile' < 10; -print "ok 12\n"; + print "# \$!='$!'\nnot " unless open(my $f,'>', 'afile'); + ok; + print $f "a row\n"; + print "not " unless close($f); + ok; + print "not " unless -s 'afile' < 10; + ok; } + +# 13..15 { -print "# \$!='$!'\nnot " unless open(my $f,'>>', 'afile'); -print "ok 13\n"; -print $f "a row\n"; -print "not " unless close($f); -print "ok 14\n"; -print "not " unless -s 'afile' > 10; -print "ok 15\n"; + print "# \$!='$!'\nnot " unless open(my $f,'>>', 'afile'); + ok; + print $f "a row\n"; + print "not " unless close($f); + ok; + print "not " unless -s 'afile' > 10; + ok; } + +# 16..18 { -print "# \$!='$!'\nnot " unless open(my $f, '<', 'afile'); -print "ok 16\n"; -@rows = <$f>; -print "not " unless @rows == 2; -print "ok 17\n"; -print "not " unless close($f); -print "ok 18\n"; + print "# \$!='$!'\nnot " unless open(my $f, '<', 'afile'); + ok; + @rows = <$f>; + print "not " unless @rows == 2; + ok; + print "not " unless close($f); + ok; } + +# 19..23 { -print "not " unless -s 'afile' < 20; -print "ok 19\n"; -print "# \$!='$!'\nnot " unless open(my $f, '+<', 'afile'); -print "ok 20\n"; -@rows = <$f>; -print "not " unless @rows == 2; -print "ok 21\n"; -seek $f, 0, 1; -print $f "yet another row\n"; -print "not " unless close($f); -print "ok 22\n"; -print "not " unless -s 'afile' > 20; -print "ok 23\n"; - -unlink("afile"); -} -if ($Is_VMS) { for (24..46) { print "ok $_ # skipped: not Unix fork\n"; } } + print "not " unless -s 'afile' < 20; + ok; + print "# \$!='$!'\nnot " unless open(my $f, '+<', 'afile'); + ok; + @rows = <$f>; + print "not " unless @rows == 2; + ok; + seek $f, 0, 1; + print $f "yet another row\n"; + print "not " unless close($f); + ok; + print "not " unless -s 'afile' > 20; + ok; + + unlink("afile"); +} + +# 24..26 +if ($Is_VMS) { + for (24..26) { print "ok $_ # skipped: not Unix fork\n"; } +} else { -print "# \$!='$!'\nnot " unless open(my $f, '-|', <<'EOC'); -./perl -e "print qq(a row\n); print qq(another row\n)" + print "# \$!='$!'\nnot " unless open(my $f, '-|', <<'EOC'); + ./perl -e "print qq(a row\n); print qq(another row\n)" EOC -print "ok 24\n"; -@rows = <$f>; -print "not " unless @rows == 2; -print "ok 25\n"; -print "not " unless close($f); -print "ok 26\n"; -} -if ($Is_VMS) { for (27..30) { print "OK $_ # skipped: not Unix fork\n"; } } + ok; + @rows = <$f>; + print "not " unless @rows == 2; + ok; + print "not " unless close($f); + ok; +} + +# 27..30 +if ($Is_VMS) { + for (27..30) { print "ok $_ # skipped: not Unix fork\n"; } +} else { -print "# \$!='$!'\nnot " unless open(my $f, '|-', <<'EOC'); -./perl -pe "s/^not //" + print "# \$!='$!'\nnot " unless open(my $f, '|-', <<'EOC'); + ./perl -pe "s/^not //" EOC -print "ok 27\n"; -@rows = <$f>; -print $f "not ok 28\n"; -print $f "not ok 29\n"; -print "#\nnot " unless close($f); -sleep 1; -print "ok 30\n"; + ok; + @rows = <$f>; + print $f "not ok $test\n"; $test++; + print $f "not ok $test\n"; $test++; + print "#\nnot " unless close($f); + sleep 1; + ok; } +# 31..32 eval <<'EOE' and print "not "; open my $f, '<&', 'afile'; 1; EOE -print "ok 31\n"; +ok; +$@ =~ /Unknown open\(\) mode \'<&\'/ or print "not "; +ok; + +# local $file tests + +# 33..41 +{ + unlink("afile") if -f "afile"; + print "$!\nnot " unless open(local $f,"+>afile"); + ok; + binmode $f; + print "not " unless -f "afile"; + ok; + print "not " unless print $f "SomeData\n"; + ok; + print "not " unless tell($f) == 9; + ok; + print "not " unless seek($f,0,0); + ok; + $b = <$f>; + print "not " unless $b eq "SomeData\n"; + ok; + print "not " unless -f $f; + ok; + eval { die "Message" }; + # warn $@; + print "not " unless $@ =~ /<\$f> line 1/; + ok; + print "not " unless close($f); + ok; + unlink("afile"); +} + +# 42..44 +{ + print "# \$!='$!'\nnot " unless open(local $f,'>', 'afile'); + ok; + print $f "a row\n"; + print "not " unless close($f); + ok; + print "not " unless -s 'afile' < 10; + ok; +} + +# 45..47 +{ + print "# \$!='$!'\nnot " unless open(local $f,'>>', 'afile'); + ok; + print $f "a row\n"; + print "not " unless close($f); + ok; + print "not " unless -s 'afile' > 10; + ok; +} + +# 48..50 +{ + print "# \$!='$!'\nnot " unless open(local $f, '<', 'afile'); + ok; + @rows = <$f>; + print "not " unless @rows == 2; + ok; + print "not " unless close($f); + ok; +} + +# 51..55 +{ + print "not " unless -s 'afile' < 20; + ok; + print "# \$!='$!'\nnot " unless open(local $f, '+<', 'afile'); + ok; + @rows = <$f>; + print "not " unless @rows == 2; + ok; + seek $f, 0, 1; + print $f "yet another row\n"; + print "not " unless close($f); + ok; + print "not " unless -s 'afile' > 20; + ok; + + unlink("afile"); +} + +# 56..58 +if ($Is_VMS) { + for (56..58) { print "ok $_ # skipped: not Unix fork\n"; } +} +else { + print "# \$!='$!'\nnot " unless open(local $f, '-|', <<'EOC'); + ./perl -e "print qq(a row\n); print qq(another row\n)" +EOC + ok; + @rows = <$f>; + print "not " unless @rows == 2; + ok; + print "not " unless close($f); + ok; +} + +# 59..62 +if ($Is_VMS) { + for (59..62) { print "ok $_ # skipped: not Unix fork\n"; } +} +else { + print "# \$!='$!'\nnot " unless open(local $f, '|-', <<'EOC'); + ./perl -pe "s/^not //" +EOC + ok; + @rows = <$f>; + print $f "not ok $test\n"; $test++; + print $f "not ok $test\n"; $test++; + print "#\nnot " unless close($f); + sleep 1; + ok; +} + +# 63..64 +eval <<'EOE' and print "not "; +open local $f, '<&', 'afile'; +1; +EOE +ok; $@ =~ /Unknown open\(\) mode \'<&\'/ or print "not "; -print "ok 32\n"; +ok; + +# 65..66 +{ + local *F; + for (1..2) { + open(F, "echo #foo|") or print "not "; + print ; + close F; + } + ok; + for (1..2) { + open(F, "-|", "echo #foo") or print "not "; + print ; + close F; + } + ok; +} diff --git a/t/io/print.t b/t/io/print.t index 180b1e8..0578ee6 100755 --- a/t/io/print.t +++ b/t/io/print.t @@ -1,8 +1,6 @@ #!./perl -# $RCSfile: print.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:32 $ - -print "1..16\n"; +print "1..18\n"; $foo = 'STDOUT'; print $foo "ok 1\n"; @@ -30,3 +28,7 @@ print "ok","11"; @x = ("ok","12\nok","13\nok"); @y = ("15\nok","16"); print @x,"14\nok",@y; +{ + local $\ = "ok 17\n# null =>[\000]\nok 18\n"; + print ""; +} diff --git a/t/lib/bigfltpm.t b/t/lib/bigfltpm.t index 42cd958..4cfd36e 100755 --- a/t/lib/bigfltpm.t +++ b/t/lib/bigfltpm.t @@ -9,7 +9,7 @@ use Math::BigFloat; $test = 0; $| = 1; -print "1..358\n"; +print "1..362\n"; while () { chop; if (s/^&//) { @@ -41,15 +41,15 @@ while () { $try .= "0+\$x->fsqrt;"; } else { $try .= "\$y = new Math::BigFloat \"$args[1]\";"; - if ($f eq fcmp){ + if ($f eq "fcmp") { $try .= "\$x <=> \$y;"; - }elsif ($f eq fadd){ + } elsif ($f eq "fadd") { $try .= "\$x + \$y;"; - }elsif ($f eq fsub){ + } elsif ($f eq "fsub") { $try .= "\$x - \$y;"; - }elsif ($f eq fmul){ + } elsif ($f eq "fmul") { $try .= "\$x * \$y;"; - }elsif ($f eq fdiv){ + } elsif ($f eq "fdiv") { $try .= "\$x / \$y;"; } else { warn "Unknown op"; } } @@ -271,6 +271,10 @@ abc:+0: +1:-1:1 -1:-1:0 +1:+1:0 +-1.1:0:-1 ++0:-1.1:1 ++1.1:+0:1 ++0:+1.1:-1 +123:+123:0 +123:+12:1 +12:+123:-1 diff --git a/t/lib/charnames.t b/t/lib/charnames.t index 8d5c8db..9775b14 100644 --- a/t/lib/charnames.t +++ b/t/lib/charnames.t @@ -12,27 +12,31 @@ print "1..5\n"; use charnames ':full'; -print "not " unless "Here\N{EXCLAMATION MARK}?" eq 'Here!?'; +print "not " unless "Here\N{EXCLAMATION MARK}?" eq "Here\041?"; print "ok 1\n"; -print "# \$res=$res \$\@='$@'\nnot " - if $res = eval <<'EOE' +{ + no utf8; # UTEST can switch it on + + print "# \$res=$res \$\@='$@'\nnot " + if $res = eval <<'EOE' use charnames ":full"; "Here: \N{CYRILLIC SMALL LETTER BE}!"; 1 EOE - or $@ !~ /above 0xFF/; -print "ok 2\n"; -# print "# \$res=$res \$\@='$@'\n"; + or $@ !~ /above 0xFF/; + print "ok 2\n"; + # print "# \$res=$res \$\@='$@'\n"; -print "# \$res=$res \$\@='$@'\nnot " - if $res = eval <<'EOE' + print "# \$res=$res \$\@='$@'\nnot " + if $res = eval <<'EOE' use charnames 'cyrillic'; "Here: \N{Be}!"; 1 EOE - or $@ !~ /CYRILLIC CAPITAL LETTER BE.*above 0xFF/; -print "ok 3\n"; + or $@ !~ /CYRILLIC CAPITAL LETTER BE.*above 0xFF/; + print "ok 3\n"; +} # If octal representation of unicode char is \0xyzt, then the utf8 is \3xy\2zt $encoded_be = "\320\261"; diff --git a/t/lib/dumper.t b/t/lib/dumper.t index 9130d1c..0ac2696 100755 --- a/t/lib/dumper.t +++ b/t/lib/dumper.t @@ -9,6 +9,8 @@ BEGIN { } use Data::Dumper; +use Config; +my $Is_ebcdic = defined($Config{'ebcdic'}) && $Config{'ebcdic'} eq 'define'; $Data::Dumper::Pad = "#"; my $TMAX; @@ -22,6 +24,14 @@ sub TEST { ++$TNUM; $t =~ s/([A-Z]+)\(0x[0-9a-f]+\)/$1(0xdeadbeef)/g if ($WANT =~ /deadbeef/); + if ($Is_ebcdic) { + # these data need massaging with non ascii character sets + # because of hashing order differences + $WANT = join("\n",sort(split(/\n/,$WANT))); + $WANT =~ s/\,$//mg; + $t = join("\n",sort(split(/\n/,$t))); + $t =~ s/\,$//mg; + } print( ($t eq $WANT and not $@) ? "ok $TNUM\n" : "not ok $TNUM\n--Expected--\n$WANT\n--Got--\n$@$t\n"); @@ -33,6 +43,13 @@ sub TEST { ++$TNUM; $t =~ s/([A-Z]+)\(0x[0-9a-f]+\)/$1(0xdeadbeef)/g if ($WANT =~ /deadbeef/); + if ($Is_ebcdic) { + # here too there are hashing order differences + $WANT = join("\n",sort(split(/\n/,$WANT))); + $WANT =~ s/\,$//mg; + $t = join("\n",sort(split(/\n/,$t))); + $t =~ s/\,$//mg; + } print( ($t eq $WANT and not $@) ? "ok $TNUM\n" : "not ok $TNUM\n--Expected--\n$WANT\n--Got--\n$@$t\n"); } diff --git a/t/lib/english.t b/t/lib/english.t index 2ee6133..dba68db 100755 --- a/t/lib/english.t +++ b/t/lib/english.t @@ -5,7 +5,7 @@ print "1..16\n"; BEGIN { unshift @INC, '../lib' } use English; use Config; -my $threads = $Config{'usethreads'} || 0; +my $threads = $Config{'use5005threads'} || 0; print $PID == $$ ? "ok 1\n" : "not ok 1\n"; diff --git a/t/lib/fields.t b/t/lib/fields.t index 6f3ea5bb..da874d6 100755 --- a/t/lib/fields.t +++ b/t/lib/fields.t @@ -106,7 +106,7 @@ print "ok ", ++$testno, "\n"; # We should get compile time failures field name typos eval q(my D3 $obj3 = $obj2; $obj3->{notthere} = ""); -print "not " unless $@ && $@ =~ /^No such field "notthere"/; +print "not " unless $@ && $@ =~ /^No such pseudo-hash field "notthere"/; print "ok ", ++$testno, "\n"; #fields::_dump(); diff --git a/t/lib/filecopy.t b/t/lib/filecopy.t index e461595..b6fcbea 100755 --- a/t/lib/filecopy.t +++ b/t/lib/filecopy.t @@ -5,86 +5,105 @@ BEGIN { unshift @INC, '../lib'; } -print "1..11\n"; - $| = 1; +my @pass = (0,1); +my $tests = 11; +printf "1..%d\n", $tests * scalar(@pass); + use File::Copy; -# First we create a file -open(F, ">file-$$") or die; -binmode F; # for DOSISH platforms, because test 3 copies to stdout -print F "ok 3\n"; -close F; - -copy "file-$$", "copy-$$"; - -open(F, "copy-$$") or die; -$foo = ; -close(F); - -print "not " if -s "file-$$" != -s "copy-$$"; -print "ok 1\n"; - -print "not " unless $foo eq "ok 3\n"; -print "ok 2\n"; - -binmode STDOUT unless $^O eq 'VMS'; # Copy::copy works in binary mode -copy "copy-$$", \*STDOUT; -unlink "copy-$$" or die "unlink: $!"; - -open(F,"file-$$"); -copy(*F, "copy-$$"); -open(R, "copy-$$") or die "open copy-$$: $!"; $foo = ; close(R); -print "not " unless $foo eq "ok 3\n"; -print "ok 4\n"; -unlink "copy-$$" or die "unlink: $!"; -open(F,"file-$$"); -copy(\*F, "copy-$$"); -close(F) or die "close: $!"; -open(R, "copy-$$") or die; $foo = ; close(R) or die "close: $!"; -print "not " unless $foo eq "ok 3\n"; -print "ok 5\n"; -unlink "copy-$$" or die "unlink: $!"; - -require IO::File; -$fh = IO::File->new(">copy-$$") or die "Cannot open copy-$$:$!"; -binmode $fh or die; -copy("file-$$",$fh); -$fh->close or die "close: $!"; -open(R, "copy-$$") or die; $foo = ; close(R); -print "# foo=`$foo'\nnot " unless $foo eq "ok 3\n"; -print "ok 6\n"; -unlink "copy-$$" or die "unlink: $!"; -require FileHandle; -my $fh = FileHandle->new(">copy-$$") or die "Cannot open copy-$$:$!"; -binmode $fh or die; -copy("file-$$",$fh); -$fh->close; -open(R, "copy-$$") or die; $foo = ; close(R); -print "not " unless $foo eq "ok 3\n"; -print "ok 7\n"; -unlink "file-$$" or die "unlink: $!"; - -print "# moved missing file.\nnot " if move("file-$$", "copy-$$"); -print "# target disappeared.\nnot " if not -e "copy-$$"; -print "ok 8\n"; - -move "copy-$$", "file-$$" or print "# move did not succeed.\n"; -print "# not moved: $!\nnot " unless -e "file-$$" and not -e "copy-$$"; -open(R, "file-$$") or die; $foo = ; close(R); -print "# foo=`$foo'\nnot " unless $foo eq "ok 3\n"; -print "ok 9\n"; - -copy "file-$$", "lib"; -open(R, "lib/file-$$") or die; $foo = ; close(R); -print "not " unless $foo eq "ok 3\n"; -print "ok 10\n"; -unlink "lib/file-$$" or die "unlink: $!"; - -move "file-$$", "lib"; -open(R, "lib/file-$$") or die "open lib/file-$$: $!"; $foo = ; close(R); -print "not " unless $foo eq "ok 3\n" and not -e "file-$$";; -print "ok 11\n"; -unlink "lib/file-$$" or die "unlink: $!"; +for my $pass (@pass) { + + require File::Copy; + + my $loopconst = $pass*$tests; + + # First we create a file + open(F, ">file-$$") or die; + binmode F; # for DOSISH platforms, because test 3 copies to stdout + printf F "ok %d\n", 3 + $loopconst; + close F; + + copy "file-$$", "copy-$$"; + + open(F, "copy-$$") or die; + $foo = ; + close(F); + + print "not " if -s "file-$$" != -s "copy-$$"; + printf "ok %d\n", 1 + $loopconst; + + print "not " unless $foo eq sprintf "ok %d\n", 3+$loopconst; + printf "ok %d\n", 2+$loopconst; + + binmode STDOUT unless $^O eq 'VMS'; # Copy::copy works in binary mode + copy "copy-$$", \*STDOUT; + unlink "copy-$$" or die "unlink: $!"; + + open(F,"file-$$"); + copy(*F, "copy-$$"); + open(R, "copy-$$") or die "open copy-$$: $!"; $foo = ; close(R); + print "not " unless $foo eq sprintf "ok %d\n", 3+$loopconst; + printf "ok %d\n", 4+$loopconst; + unlink "copy-$$" or die "unlink: $!"; + open(F,"file-$$"); + copy(\*F, "copy-$$"); + close(F) or die "close: $!"; + open(R, "copy-$$") or die; $foo = ; close(R) or die "close: $!"; + print "not " unless $foo eq sprintf "ok %d\n", 3+$loopconst; + printf "ok %d\n", 5+$loopconst; + unlink "copy-$$" or die "unlink: $!"; + + require IO::File; + $fh = IO::File->new(">copy-$$") or die "Cannot open copy-$$:$!"; + binmode $fh or die; + copy("file-$$",$fh); + $fh->close or die "close: $!"; + open(R, "copy-$$") or die; $foo = ; close(R); + print "# foo=`$foo'\nnot " unless $foo eq sprintf "ok %d\n", 3+$loopconst; + printf "ok %d\n", 6+$loopconst; + unlink "copy-$$" or die "unlink: $!"; + require FileHandle; + my $fh = FileHandle->new(">copy-$$") or die "Cannot open copy-$$:$!"; + binmode $fh or die; + copy("file-$$",$fh); + $fh->close; + open(R, "copy-$$") or die; $foo = ; close(R); + print "not " unless $foo eq sprintf "ok %d\n", 3+$loopconst; + printf "ok %d\n", 7+$loopconst; + unlink "file-$$" or die "unlink: $!"; + + print "# moved missing file.\nnot " if move("file-$$", "copy-$$"); + print "# target disappeared.\nnot " if not -e "copy-$$"; + printf "ok %d\n", 8+$loopconst; + + move "copy-$$", "file-$$" or print "# move did not succeed.\n"; + print "# not moved: $!\nnot " unless -e "file-$$" and not -e "copy-$$"; + open(R, "file-$$") or die; $foo = ; close(R); + print "# foo=`$foo'\nnot " unless $foo eq sprintf "ok %d\n", 3+$loopconst; + printf "ok %d\n", 9+$loopconst; + + copy "file-$$", "lib"; + open(R, "lib/file-$$") or die; $foo = ; close(R); + print "not " unless $foo eq sprintf "ok %d\n", 3+$loopconst; + printf "ok %d\n", 10+$loopconst; + unlink "lib/file-$$" or die "unlink: $!"; + + move "file-$$", "lib"; + open(R, "lib/file-$$") or die "open lib/file-$$: $!"; $foo = ; close(R); + print "not " unless $foo eq sprintf("ok %d\n", 3+$loopconst) + and not -e "file-$$";; + printf "ok %d\n", 11+$loopconst; + unlink "lib/file-$$" or die "unlink: $!"; + + # warn sprintf "INC->".$INC{"File/Copy.pm"}; + delete $INC{"File/Copy.pm"}; + +} + +END { + 1 while unlink "file-$$"; + 1 while unlink "lib/file-$$"; +} diff --git a/t/lib/filefind.t b/t/lib/filefind.t index 5d1492f..f958b19 100755 --- a/t/lib/filefind.t +++ b/t/lib/filefind.t @@ -1,14 +1,105 @@ -#!./perl +####!./perl + + +my %Expect; +my $symlink_exists = eval { symlink("",""); 1 }; BEGIN { chdir 't' if -d 't'; unshift @INC, '../lib'; } -print "1..2\n"; +if ( $symlink_exists ) { print "1..59\n"; } +else { print "1..31\n"; } use File::Find; -# hope we will eventually find ourself find(sub { print "ok 1\n" if $_ eq 'filefind.t'; }, "."); finddepth(sub { print "ok 2\n" if $_ eq 'filefind.t'; }, "."); + + +my $case = 2; + +END { + unlink 'FA/FA_ord','FA/FSL','FA/FAA/FAA_ord', + 'FA/FAB/FAB_ord','FA/FAB/FABA/FABA_ord','FB/FB_ord','FB/FBA/FBA_ord'; + rmdir 'FA/FAA'; + rmdir 'FA/FAB/FABA'; + rmdir 'FA/FAB'; + rmdir 'FA'; + rmdir 'FB/FBA'; + rmdir 'FB'; +} + +sub Check($) { + $case++; + if ($_[0]) { print "ok $case\n"; } + else { print "not ok $case\n"; } +} + +sub CheckDie($) { + $case++; + if ($_[0]) { print "ok $case\n"; } + else { print "not ok $case\n $!\n"; exit 0; } +} + +sub touch { + CheckDie( open(my $T,'>',$_[0]) ); +} + +sub MkDir($$) { + CheckDie( mkdir($_[0],$_[1]) ); +} + +sub wanted { + print "# '$_' => 1\n"; + Check( $Expect{$_} ); + delete $Expect{$_}; + $File::Find::prune=1 if $_ eq 'FABA'; +} + +MkDir( 'FA',0770 ); +MkDir( 'FB',0770 ); +touch('FB/FB_ord'); +MkDir( 'FB/FBA',0770 ); +touch('FB/FBA/FBA_ord'); +CheckDie( symlink('../FB','FA/FSL') ) if $symlink_exists; +touch('FA/FA_ord'); + +MkDir( 'FA/FAA',0770 ); +touch('FA/FAA/FAA_ord'); +MkDir( 'FA/FAB',0770 ); +touch('FA/FAB/FAB_ord'); +MkDir( 'FA/FAB/FABA',0770 ); +touch('FA/FAB/FABA/FABA_ord'); + +%Expect = ('.' => 1, 'FSL' => 1, 'FA_ord' => 1, 'FAB' => 1, 'FAB_ord' => 1, + 'FABA' => 1, 'FAA' => 1, 'FAA_ord' => 1); +delete $Expect{'FSL'} unless $symlink_exists; +File::Find::find( {wanted => \&wanted, },'FA' ); +Check( scalar(keys %Expect) == 0 ); + +%Expect=('FA' => 1, 'FA/FSL' => 1, 'FA/FA_ord' => 1, 'FA/FAB' => 1, + 'FA/FAB/FAB_ord' => 1, 'FA/FAB/FABA' => 1, + 'FA/FAB/FABA/FABA_ord' => 1, 'FA/FAA' => 1, 'FA/FAA/FAA_ord' => 1); +delete $Expect{'FA/FSL'} unless $symlink_exists; +File::Find::find( {wanted => \&wanted, no_chdir => 1},'FA' ); + +Check( scalar(keys %Expect) == 0 ); + +if ( $symlink_exists ) { + %Expect=('.' => 1, 'FA_ord' => 1, 'FSL' => 1, 'FB_ord' => 1, 'FBA' => 1, + 'FBA_ord' => 1, 'FAB' => 1, 'FAB_ord' => 1, 'FABA' => 1, 'FAA' => 1, + 'FAA_ord' => 1); + + File::Find::find( {wanted => \&wanted, follow_fast => 1},'FA' ); + Check( scalar(keys %Expect) == 0 ); + %Expect=('FA' => 1, 'FA/FA_ord' => 1, 'FA/FSL' => 1, 'FA/FSL/FB_ord' => 1, + 'FA/FSL/FBA' => 1, 'FA/FSL/FBA/FBA_ord' => 1, 'FA/FAB' => 1, + 'FA/FAB/FAB_ord' => 1, 'FA/FAB/FABA' => 1, 'FA/FAB/FABA/FABA_ord' => 1, + 'FA/FAA' => 1, 'FA/FAA/FAA_ord' => 1); + File::Find::find( {wanted => \&wanted, follow_fast => 1, no_chdir => 1},'FA' ); + Check( scalar(keys %Expect) == 0 ); +} + +print "# of cases: $case\n"; diff --git a/t/lib/glob-basic.t b/t/lib/glob-basic.t new file mode 100755 index 0000000..dde8773 --- /dev/null +++ b/t/lib/glob-basic.t @@ -0,0 +1,112 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + unshift @INC, '../lib'; + + print "1..9\n"; +} +END { + print "not ok 1\n" unless $loaded; +} +use File::Glob ':glob'; +$loaded = 1; +print "ok 1\n"; + +sub array { + return '(', join(", ", map {defined $_ ? "\"$_\"" : "undef"} @a), ")\n"; +} + +# look for the contents of the current directory +$ENV{PATH} = "/bin"; +delete @ENV{BASH_ENV, CDPATH, ENV, IFS}; +@correct = (); +if (opendir(D, ".")) { + @correct = grep { !/^\.\.?$/ } sort readdir(D); + closedir D; +} +@a = File::Glob::glob("*", 0); +@a = sort @a; +if ("@a" ne "@correct" || GLOB_ERROR) { + print "# |@a| ne |@correct|\nnot "; +} +print "ok 2\n"; + +# look up the user's home directory +# should return a list with one item, and not set ERROR +if ($^O ne 'MSWin32') { + eval { + ($name, $home) = (getpwuid($>))[0,7]; + 1; + } and do { + @a = File::Glob::glob("~$name", GLOB_TILDE); + if (scalar(@a) != 1 || $a[0] ne $home || GLOB_ERROR) { + print "not "; + } + }; +} +print "ok 3\n"; + +# check backslashing +# should return a list with one item, and not set ERROR +@a = File::Glob::glob('TEST', GLOB_QUOTE); +if (scalar @a != 1 || $a[0] ne 'TEST' || GLOB_ERROR) { + local $/ = "]["; + print "# [@a]\n"; + print "not "; +} +print "ok 4\n"; + +# check nonexistent checks +# should return an empty list +# XXX since errfunc is NULL on win32, this test is not valid there +@a = File::Glob::glob("asdfasdf", 0); +if ($^O ne 'MSWin32' and scalar @a != 0) { + print "# |@a|\nnot "; +} +print "ok 5\n"; + +# check bad protections +# should return an empty list, and set ERROR +if ($^O eq 'MSWin32' or $^O eq 'os2' or not $>) { + print "ok 6 # skipped\n"; +} +else { + $dir = "PtEeRsLt.dir"; + mkdir $dir, 0; + @a = File::Glob::glob("$dir/*", GLOB_ERR); + #print "\@a = ", array(@a); + rmdir $dir; + if (scalar(@a) != 0 || GLOB_ERROR == 0) { + print "not "; + } + print "ok 6\n"; +} + +# check for csh style globbing +@a = File::Glob::glob('{a,b}', GLOB_BRACE | GLOB_NOMAGIC); +unless (@a == 2 and $a[0] eq 'a' and $a[1] eq 'b') { + print "not "; +} +print "ok 7\n"; + +@a = File::Glob::glob( + '{TES*,doesntexist*,a,b}', + GLOB_BRACE | GLOB_NOMAGIC +); +unless (@a == 3 + and $a[0] eq 'TEST' + and $a[1] eq 'a' + and $a[2] eq 'b') +{ + print "not "; +} +print "ok 8\n"; + +# "~" should expand to $ENV{HOME} +$ENV{HOME} = "sweet home"; +@a = File::Glob::glob('~', GLOB_TILDE | GLOB_NOMAGIC); +unless (@a == 1 and $a[0] eq $ENV{HOME}) { + print "not "; +} +print "ok 9\n"; diff --git a/t/lib/glob-case.t b/t/lib/glob-case.t new file mode 100755 index 0000000..2e65a0f --- /dev/null +++ b/t/lib/glob-case.t @@ -0,0 +1,48 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + unshift @INC, '../lib'; + print "1..7\n"; +} +END { + print "not ok 1\n" unless $loaded; +} +use File::Glob qw(:glob csh_glob); +$loaded = 1; +print "ok 1\n"; + +# Test the actual use of the case sensitivity tags, via csh_glob() +import File::Glob ':nocase'; +@a = csh_glob("lib/G*.t"); # At least glob-basic.t glob-case.t glob-global.t +print "not " unless @a >= 3; +print "ok 2\n"; + +# This may fail on systems which are not case-PRESERVING +import File::Glob ':case'; +@a = csh_glob("lib/G*.t"); # None should be uppercase +print "not " unless @a == 0; +print "ok 3\n"; + +# Test the explicit use of the GLOB_NOCASE flag +@a = File::Glob::glob("lib/G*.t", GLOB_NOCASE); +print "not " unless @a >= 3; +print "ok 4\n"; + +# Test Win32 backslash nastiness... +if ($^O ne 'MSWin32') { + print "ok 5\nok 6\nok 7\n"; +} +else { + @a = File::Glob::glob("lib\\g*.t"); + print "not " unless @a >= 3; + print "ok 5\n"; + mkdir "[]", 0; + @a = File::Glob::glob("\\[\\]", GLOB_QUOTE); + rmdir "[]"; + print "# returned @a\nnot " unless @a == 1; + print "ok 6\n"; + @a = File::Glob::glob("lib\\*", GLOB_QUOTE); + print "not " if @a == 0; + print "ok 7\n"; +} diff --git a/t/lib/glob-global.t b/t/lib/glob-global.t new file mode 100755 index 0000000..44d7e8b --- /dev/null +++ b/t/lib/glob-global.t @@ -0,0 +1,106 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + unshift @INC, '../lib'; + + print "1..10\n"; +} +END { + print "not ok 1\n" unless $loaded; +} + +BEGIN { + *CORE::GLOBAL::glob = sub { "Just another Perl hacker," }; +} + +BEGIN { + if ("Just another Perl hacker," ne (<*>)[0]) { + die < works +@r = <*/*.t>; +# at least t/global.t t/basic.t, t/taint.t +print "not " if @r < 3; +print "ok 4\n"; +my $r = scalar @r; + +# check if scalar context works +@r = (); +while (defined($_ = <*/*.t>)) { + #print "# $_\n"; + push @r, $_; +} +print "not " if @r != $r; +print "ok 5\n"; + +# check if array context works +@r = (); +for (<*/*.t>) { + #print "# $_\n"; + push @r, $_; +} +print "not " if @r != $r; +print "ok 6\n"; + +# test if implicit assign to $_ in while() works +@r = (); +while (<*/*.t>) { + #print "# $_\n"; + push @r, $_; +} +print "not " if @r != $r; +print "ok 7\n"; + +# test if explicit glob() gets assign magic too +my @s = (); +while (glob '*/*.t') { + #print "# $_\n"; + push @s, $_; +} +print "not " if "@r" ne "@s"; +print "ok 8\n"; + +# how about in a different package, like? +package Foo; +use File::Glob ':globally'; +@s = (); +while (glob '*/*.t') { + #print "# $_\n"; + push @s, $_; +} +print "not " if "@r" ne "@s"; +print "ok 9\n"; + +# test if different glob ops maintain independent contexts +@s = (); +my $i = 0; +while (<*/*.t>) { + #print "# $_ <"; + push @s, $_; + while () { + #print " $_"; + $i++; + } + #print " >\n"; +} +print "not " if "@r" ne "@s" or not $i; +print "ok 10\n"; diff --git a/t/lib/glob-taint.t b/t/lib/glob-taint.t new file mode 100755 index 0000000..1b9c053 --- /dev/null +++ b/t/lib/glob-taint.t @@ -0,0 +1,21 @@ +#!./perl -T + +BEGIN { + chdir 't' if -d 't'; + unshift @INC, '../lib'; + print "1..2\n"; +} +END { + print "not ok 1\n" unless $loaded; +} +use File::Glob; +$loaded = 1; +print "ok 1\n"; + +# all filenames should be tainted +@a = File::Glob::glob("*"); +eval { $a = join("",@a), kill 0; 1 }; +unless ($@ =~ /Insecure dependency/) { + print "not "; +} +print "ok 2\n"; diff --git a/t/lib/io_unix.t b/t/lib/io_unix.t index 7338861..0e559e0 100644 --- a/t/lib/io_unix.t +++ b/t/lib/io_unix.t @@ -5,6 +5,10 @@ BEGIN { chdir 't' if -d 't'; unshift @INC, '../lib' if -d '../lib'; } + # ``use IO::Socket'' executes too early below in the os2 block + if ($^O eq 'dos') { + print "1..0 # Skip: no fork\n"; + } } use Config; diff --git a/t/lib/ipc_sysv.t b/t/lib/ipc_sysv.t index 00a157b..9777292 100755 --- a/t/lib/ipc_sysv.t +++ b/t/lib/ipc_sysv.t @@ -77,8 +77,34 @@ if ($Config{'d_msgget'} eq 'define' && my $msgtype = 1; my $msgtext = "hello"; - msgsnd($msg,pack("L a*",$msgtype,$msgtext),0) or print "not "; + my $test2bad; + my $test5bad; + my $test6bad; + + unless (msgsnd($msg,pack("L a*",$msgtype,$msgtext),IPC_NOWAIT)) { + print "not "; + $test2bad = 1; + } print "ok 2\n"; + if ($test2bad) { + print <share(qw($foo %bar @baz *glob sayok)); -$cpt->share('$"') unless $Config{archname} =~ /-thread$/; +$cpt->share('$"') unless $Config{use5005threads}; $cpt->reval(q{ package other; @@ -124,7 +124,7 @@ print $@ =~ /foo bar/ ? "ok 29\n" : "not ok 29\n"; my $t = 30; $cpt->rdo('/non/existant/file.name'); # The regexp is getting rather baroque. -print $! =~ /No such file|file specification syntax error|A file or directory in the path name does not exist|Invalid argument|Device not configured|file not found/i ? "ok $t\n" : "not ok $t # $!\n"; $t++; +print $! =~ /No such file|file specification syntax error|A file or directory in the path name does not exist|Invalid argument|Device not configured|file not found|File or directory doesn't exist/i ? "ok $t\n" : "not ok $t # $!\n"; $t++; # test #31 is gone. print 1 ? "ok $t\n" : "not ok $t\n#$@/$!\n"; $t++; diff --git a/t/lib/syslfs.t b/t/lib/syslfs.t index a8a7a0c..942bb4d 100644 --- a/t/lib/syslfs.t +++ b/t/lib/syslfs.t @@ -3,12 +3,6 @@ # If you modify/add tests here, remember to update also t/op/lfs.t. BEGIN { - # Don't bother if there are no quads. - eval { my $q = pack "q", 0 }; - if ($@) { - print "1..0\n# no 64-bit types\n"; - exit(0); - } chdir 't' if -d 't'; unshift @INC, '../lib'; require Config; import Config; @@ -43,20 +37,22 @@ sub explain { EOM } +print "# checking whether we have sparse files...\n"; + # Known have-nots. if ($^O eq 'win32' || $^O eq 'vms') { - print "1..0\n# no sparse files\n"; + print "1..0\n# no sparse files (because this is $^O) \n"; bye(); } # Known haves that have problems running this test # (for example because they do not support sparse files, like UNICOS) if ($^O eq 'unicos') { - print "1..0\n# large files known to work but unable to test them here\n"; + print "1..0\n# large files known to work but unable to test them here ($^O)\n"; bye(); } -# Then try to deduce whether we have sparse files. +# Then try heuristically to deduce whether we have sparse files. # We'll start off by creating a one megabyte file which has # only three "true" bytes. If we have sparseness, we should @@ -85,24 +81,31 @@ unless (@s == 13 && bye(); } +print "# we seem to have sparse files...\n"; + # By now we better be sure that we do have sparse files: # if we are not, the following will hog 5 gigabytes of disk. Ooops. $ENV{LC_ALL} = "C"; sysopen(BIG, "big", O_WRONLY|O_CREAT|O_TRUNC) or - do { warn "sysopen failed: $!\n"; bye }; -sysseek(BIG, 5_000_000_000, SEEK_SET); + do { warn "sysopen 'big' failed: $!\n"; bye }; +my $sysseek = sysseek(BIG, 5_000_000_000, SEEK_SET); +unless (defined $sysseek && $sysseek == 5_000_000_000) { + print "1..0\n# seeking past 2GB failed: $! (sysseek returned ", + defined $sysseek ? $sysseek : 'undef', ")\n"; + explain(); + bye(); +} # The syswrite will fail if there are are filesize limitations (process or fs). -my $syswrite = syswrite(BIG, "big") == 3; -my $close = close BIG if $syswrite; +my $syswrite = syswrite(BIG, "big"); +print "# syswrite failed: $! (syswrite returned ", + defined $syswrite ? $syswrite : 'undef', ")\n" + unless defined $syswrite && $syswrite == 3; +my $close = close BIG; +print "# close failed: $!\n" unless $close; unless($syswrite && $close) { - unless ($syswrite) { - print "# syswrite failed: $!\n" - } else { - print "# close failed: $!\n" - } if ($! =~/too large/i) { print "1..0\n# writing past 2GB failed: process limits?\n"; } elsif ($! =~ /quota/i) { @@ -116,6 +119,12 @@ unless($syswrite && $close) { print "# @s\n"; +unless ($s[7] == 5_000_000_003) { + print "1..0\n# not configured to use large files?\n"; + explain(); + bye(); +} + sub fail () { print "not "; $fail++; diff --git a/t/lib/thread.t b/t/lib/thread.t index 3bca8ba..edfb443 100755 --- a/t/lib/thread.t +++ b/t/lib/thread.t @@ -4,8 +4,8 @@ BEGIN { chdir 't' if -d 't'; unshift @INC, '../lib'; require Config; import Config; - if (! $Config{'usethreads'}) { - print "1..0 # Skip: this perl is not threaded\n"; + if (! $Config{'use5005threads'}) { + print "1..0 # Skip: not use5005threads\n"; exit 0; } @@ -13,8 +13,8 @@ BEGIN { $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3; } $| = 1; -print "1..18\n"; -use Thread; +print "1..21\n"; +use Thread 'yield'; print "ok 1\n"; sub content @@ -55,9 +55,7 @@ sleep 6; print "ok 12\n"; $t->join; -sub islocked -{ - use attrs 'locked'; +sub islocked : locked { my $val = shift; my $ret; print $val; @@ -74,8 +72,7 @@ $t->join->join; { package Loch::Ness; sub new { bless [], shift } - sub monster { - use attrs qw(locked method); + sub monster : locked, method { my($s, $m) = @_; print "ok $m\n"; } @@ -85,3 +82,37 @@ Loch::Ness->monster(15); Loch::Ness->new->monster(16); Loch::Ness->gollum(17); Loch::Ness->new->gollum(18); + +my $short = "This is a long string that goes on and on."; +my $shorte = " a long string that goes on and on."; +my $long = "This is short."; +my $longe = " short."; +my $thr1 = new Thread \&threaded, $short, $shorte, "19"; +my $thr2 = new Thread \&threaded, $long, $longe, "20"; + +sub threaded { + my ($string, $string_end, $testno) = @_; + + # Do the match, saving the output in appropriate variables + $string =~ /(.*)(is)(.*)/; + # Yield control, allowing the other thread to fill in the match variables + yield(); + # Examine the match variable contents; on broken perls this fails + if ($3 eq $string_end) { + print "ok $testno\n"; + } + else { + warn <join; +$thr2->join; +print "ok 21\n"; diff --git a/t/op/array.t b/t/op/array.t index 3409556..1108f49 100755 --- a/t/op/array.t +++ b/t/op/array.t @@ -1,6 +1,6 @@ #!./perl -print "1..65\n"; +print "1..66\n"; # # @foo, @bar, and @ary are also used from tie-stdarray after tie-ing them @@ -211,3 +211,8 @@ my $t = 63; sub reify { $_[1] = ++$t; print "@_\n"; } reify('ok'); reify('ok'); + +# qw() is no more a runtime split, it's compiletime. +print "not " unless qw(foo bar snorfle)[2] eq 'snorfle'; +print "ok 66\n"; + diff --git a/t/op/avhv.t b/t/op/avhv.t index 6837127..23f9c69 100755 --- a/t/op/avhv.t +++ b/t/op/avhv.t @@ -17,7 +17,7 @@ sub STORESIZE { $#{$_[0]} = $_[1]+1 } package main; -print "1..12\n"; +print "1..20\n"; $sch = { 'abc' => 1, @@ -108,3 +108,34 @@ f($a->{key}); print "not " unless $a->[1] eq 'b'; print "ok 12\n"; +# check if exists() is behaving properly +$avhv = [{foo=>1,bar=>2,pants=>3}]; +print "not " if exists $avhv->{bar}; +print "ok 13\n"; + +$avhv->{pants} = undef; +print "not " unless exists $avhv->{pants}; +print "ok 14\n"; +print "not " if exists $avhv->{bar}; +print "ok 15\n"; + +$avhv->{bar} = 10; +print "not " unless exists $avhv->{bar} and $avhv->{bar} == 10; +print "ok 16\n"; + +$v = delete $avhv->{bar}; +print "not " unless $v == 10; +print "ok 17\n"; + +print "not " if exists $avhv->{bar}; +print "ok 18\n"; + +$avhv->{foo} = 'xxx'; +$avhv->{bar} = 'yyy'; +$avhv->{pants} = 'zzz'; +@x = delete @{$avhv}{'foo','pants'}; +print "# @x\nnot " unless "@x" eq "xxx zzz"; +print "ok 19\n"; + +print "not " unless "$avhv->{bar}" eq "yyy"; +print "ok 20\n"; diff --git a/t/op/delete.t b/t/op/delete.t index 6cc4475..10a218b 100755 --- a/t/op/delete.t +++ b/t/op/delete.t @@ -1,8 +1,8 @@ #!./perl -# $RCSfile: delete.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:44 $ +print "1..36\n"; -print "1..16\n"; +# delete() on hash elements $foo{1} = 'a'; $foo{2} = 'b'; @@ -13,7 +13,7 @@ $foo{5} = 'e'; $foo = delete $foo{2}; if ($foo eq 'b') {print "ok 1\n";} else {print "not ok 1 $foo\n";} -if ($foo{2} eq '') {print "ok 2\n";} else {print "not ok 2 $foo{2}\n";} +unless (exists $foo{2}) {print "ok 2\n";} else {print "not ok 2 $foo{2}\n";} if ($foo{1} eq 'a') {print "ok 3\n";} else {print "not ok 3\n";} if ($foo{3} eq 'c') {print "ok 4\n";} else {print "not ok 4\n";} if ($foo{4} eq 'd') {print "ok 5\n";} else {print "not ok 5\n";} @@ -24,8 +24,8 @@ if ($foo{5} eq 'e') {print "ok 6\n";} else {print "not ok 6\n";} if (@foo == 2) {print "ok 7\n";} else {print "not ok 7 ", @foo+0, "\n";} if ($foo[0] eq 'd') {print "ok 8\n";} else {print "not ok 8 ", $foo[0], "\n";} if ($foo[1] eq 'e') {print "ok 9\n";} else {print "not ok 9 ", $foo[1], "\n";} -if ($foo{4} eq '') {print "ok 10\n";} else {print "not ok 10 $foo{4}\n";} -if ($foo{5} eq '') {print "ok 11\n";} else {print "not ok 11 $foo{5}\n";} +unless (exists $foo{4}) {print "ok 10\n";} else {print "not ok 10 $foo{4}\n";} +unless (exists $foo{5}) {print "ok 11\n";} else {print "not ok 11 $foo{5}\n";} if ($foo{1} eq 'a') {print "ok 12\n";} else {print "not ok 12\n";} if ($foo{3} eq 'c') {print "ok 13\n";} else {print "not ok 13\n";} @@ -49,3 +49,75 @@ delete $refhash{"top"}->{"bar"}; @list = keys %{$refhash{"top"}}; print "@list" eq "foo" ? "ok 16\n" : "not ok 16 @list\n"; + +{ + my %a = ('bar', 33); + my($a) = \(values %a); + my $b = \$a{bar}; + my $c = \delete $a{bar}; + + print "not " unless $a == $b && $b == $c; + print "ok 17\n"; +} + +# delete() on array elements + +@foo = (); +$foo[1] = 'a'; +$foo[2] = 'b'; +$foo[3] = 'c'; +$foo[4] = 'd'; +$foo[5] = 'e'; + +$foo = delete $foo[2]; + +if ($foo eq 'b') {print "ok 18\n";} else {print "not ok 18 $foo\n";} +unless (exists $foo[2]) {print "ok 19\n";} else {print "not ok 19 $foo[2]\n";} +if ($foo[1] eq 'a') {print "ok 20\n";} else {print "not ok 20\n";} +if ($foo[3] eq 'c') {print "ok 21\n";} else {print "not ok 21\n";} +if ($foo[4] eq 'd') {print "ok 22\n";} else {print "not ok 22\n";} +if ($foo[5] eq 'e') {print "ok 23\n";} else {print "not ok 23\n";} + +@bar = delete @foo[4,5]; + +if (@bar == 2) {print "ok 24\n";} else {print "not ok 24 ", @bar+0, "\n";} +if ($bar[0] eq 'd') {print "ok 25\n";} else {print "not ok 25 ", $bar[0], "\n";} +if ($bar[1] eq 'e') {print "ok 26\n";} else {print "not ok 26 ", $bar[1], "\n";} +unless (exists $foo[4]) {print "ok 27\n";} else {print "not ok 27 $foo[4]\n";} +unless (exists $foo[5]) {print "ok 28\n";} else {print "not ok 28 $foo[5]\n";} +if ($foo[1] eq 'a') {print "ok 29\n";} else {print "not ok 29\n";} +if ($foo[3] eq 'c') {print "ok 30\n";} else {print "not ok 30\n";} + +$foo = join('',@foo); +if ($foo eq 'ac') {print "ok 31\n";} else {print "not ok 31\n";} + +if (@foo == 4) {print "ok 32\n";} else {print "not ok 32\n";} + +foreach $key (0 .. $#foo) { + delete $foo[$key]; +} + +if (@foo == 0) {print "ok 33\n";} else {print "not ok 33\n";} + +$foo[0] = 'x'; +$foo[1] = 'y'; + +$foo = "@foo"; +print +($foo eq 'x y') ? "ok 34\n" : "not ok 34\n"; + +$refary[0]->[0] = "FOO"; +$refary[0]->[3] = "BAR"; + +delete $refary[0]->[3]; + +print @{$refary[0]} == 1 ? "ok 35\n" : "not ok 35 @list\n"; + +{ + my @a = 33; + my($a) = \(@a); + my $b = \$a[0]; + my $c = \delete $a[bar]; + + print "not " unless $a == $b && $b == $c; + print "ok 36\n"; +} diff --git a/t/op/eval.t b/t/op/eval.t index abcb379..ea6caf4 100755 --- a/t/op/eval.t +++ b/t/op/eval.t @@ -1,6 +1,6 @@ #!./perl -print "1..37\n"; +print "1..38\n"; eval 'print "ok 1\n";'; @@ -176,3 +176,9 @@ $SIG{__DIE__} = sub { eval {1}; die shift }; eval { die "ok ".$x++,"\n" }; print $@; +# does scalar eval"" pop stack correctly? +{ + my $c = eval "(1,2)x10"; + print $c eq '2222222222' ? "ok $x\n" : "# $c\nnot ok $x\n"; + $x++; +} diff --git a/t/op/fork.t b/t/op/fork.t index 20c8747..b743a45 100755 --- a/t/op/fork.t +++ b/t/op/fork.t @@ -1,26 +1,319 @@ #!./perl -# $RCSfile: fork.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:53 $ +# tests for both real and emulated fork() BEGIN { chdir 't' if -d 't'; unshift @INC, '../lib'; require Config; import Config; - unless ($Config{'d_fork'}) { + unless ($Config{'d_fork'} || ($^O eq 'MSWin32' && $Config{'useithreads'})) { print "1..0 # Skip: no fork\n"; exit 0; } + $ENV{PERL5LIB} = "../lib"; } -$| = 1; -print "1..2\n"; +$|=1; + +undef $/; +@prgs = split "\n########\n", ; +print "1..", scalar @prgs, "\n"; + +$tmpfile = "forktmp000"; +1 while -f ++$tmpfile; +END { unlink $tmpfile if $tmpfile; } + +$CAT = (($^O eq 'MSWin32') ? '.\perl -e "print <>"' : 'cat'); +for (@prgs){ + my $switch; + if (s/^\s*(-\w.*)//){ + $switch = $1; + } + my($prog,$expected) = split(/\nEXPECT\n/, $_); + $expected =~ s/\n+$//; + # results can be in any order, so sort 'em + my @expected = sort split /\n/, $expected; + open TEST, ">$tmpfile" or die "Cannot open $tmpfile: $!"; + print TEST $prog, "\n"; + close TEST or die "Cannot close $tmpfile: $!"; + my $results; + if ($^O eq 'MSWin32') { + $results = `.\\perl -I../lib $switch $tmpfile 2>&1`; + } + else { + $results = `./perl $switch $tmpfile 2>&1`; + } + $status = $?; + $results =~ s/\n+$//; + $results =~ s/at\s+forktmp\d+\s+line/at - line/g; + $results =~ s/of\s+forktmp\d+\s+aborted/of - aborted/g; +# bison says 'parse error' instead of 'syntax error', +# various yaccs may or may not capitalize 'syntax'. + $results =~ s/^(syntax|parse) error/syntax error/mig; + my @results = sort split /\n/, $results; + if ( "@results" ne "@expected" ) { + print STDERR "PROG: $switch\n$prog\n"; + print STDERR "EXPECTED:\n$expected\n"; + print STDERR "GOT:\n$results\n"; + print "not "; + } + print "ok ", ++$i, "\n"; +} + +__END__ +$| = 1; if ($cid = fork) { - sleep 2; - if ($result = (kill 9, $cid)) {print "ok 2\n";} else {print "not ok 2 $result\n";} + sleep 1; + if ($result = (kill 9, $cid)) { + print "ok 2\n"; + } + else { + print "not ok 2 $result\n"; + } + sleep 1 if $^O eq 'MSWin32'; # avoid WinNT race bug } else { - $| = 1; print "ok 1\n"; sleep 10; } +EXPECT +ok 1 +ok 2 +######## +$| = 1; +sub forkit { + print "iteration $i start\n"; + my $x = fork; + if (defined $x) { + if ($x) { + print "iteration $i parent\n"; + } + else { + print "iteration $i child\n"; + } + } + else { + print "pid $$ failed to fork\n"; + } +} +while ($i++ < 3) { do { forkit(); }; } +EXPECT +iteration 1 start +iteration 1 parent +iteration 1 child +iteration 2 start +iteration 2 parent +iteration 2 child +iteration 2 start +iteration 2 parent +iteration 2 child +iteration 3 start +iteration 3 parent +iteration 3 child +iteration 3 start +iteration 3 parent +iteration 3 child +iteration 3 start +iteration 3 parent +iteration 3 child +iteration 3 start +iteration 3 parent +iteration 3 child +######## +$| = 1; +fork() + ? (print("parent\n"),sleep(1)) + : (print("child\n"),exit) ; +EXPECT +parent +child +######## +$| = 1; +fork() + ? (print("parent\n"),exit) + : (print("child\n"),sleep(1)) ; +EXPECT +parent +child +######## +$| = 1; +@a = (1..3); +for (@a) { + if (fork) { + print "parent $_\n"; + $_ = "[$_]"; + } + else { + print "child $_\n"; + $_ = "-$_-"; + } +} +print "@a\n"; +EXPECT +parent 1 +child 1 +parent 2 +child 2 +parent 2 +child 2 +parent 3 +child 3 +parent 3 +child 3 +parent 3 +child 3 +parent 3 +child 3 +[1] [2] [3] +-1- [2] [3] +[1] -2- [3] +[1] [2] -3- +-1- -2- [3] +-1- [2] -3- +[1] -2- -3- +-1- -2- -3- +######## +use Config; +$| = 1; +$\ = "\n"; +fork() + ? print($Config{osname} eq $^O) + : print($Config{osname} eq $^O) ; +EXPECT +1 +1 +######## +$| = 1; +$\ = "\n"; +fork() + ? do { require Config; print($Config::Config{osname} eq $^O); } + : do { require Config; print($Config::Config{osname} eq $^O); } +EXPECT +1 +1 +######## +$| = 1; +use Cwd; +$\ = "\n"; +my $dir; +if (fork) { + $dir = "f$$.tst"; + mkdir $dir, 0755; + chdir $dir; + print cwd() =~ /\Q$dir/i ? "ok 1 parent" : "not ok 1 parent"; + chdir ".."; + rmdir $dir; +} +else { + sleep 2; + $dir = "f$$.tst"; + mkdir $dir, 0755; + chdir $dir; + print cwd() =~ /\Q$dir/i ? "ok 1 child" : "not ok 1 child"; + chdir ".."; + rmdir $dir; +} +EXPECT +ok 1 parent +ok 1 child +######## +$| = 1; +$\ = "\n"; +my $getenv; +if ($^O eq 'MSWin32') { + $getenv = qq[$^X -e "print \$ENV{TST}"]; +} +else { + $getenv = qq[$^X -e 'print \$ENV{TST}']; +} +$ENV{TST} = 'foo'; +if (fork) { + sleep 1; + print "parent before: " . `$getenv`; + $ENV{TST} = 'bar'; + print "parent after: " . `$getenv`; +} +else { + print "child before: " . `$getenv`; + $ENV{TST} = 'baz'; + print "child after: " . `$getenv`; +} +EXPECT +child before: foo +child after: baz +parent before: foo +parent after: bar +######## +$| = 1; +$\ = "\n"; +if ($pid = fork) { + waitpid($pid,0); + print "parent got $?" +} +else { + exit(42); +} +EXPECT +parent got 10752 +######## +$| = 1; +$\ = "\n"; +my $echo = 'echo'; +if ($pid = fork) { + waitpid($pid,0); + print "parent got $?" +} +else { + exec("$echo foo"); +} +EXPECT +foo +parent got 0 +######## +if (fork) { + die "parent died"; +} +else { + die "child died"; +} +EXPECT +parent died at - line 2. +child died at - line 5. +######## +if ($pid = fork) { + eval { die "parent died" }; + print $@; +} +else { + eval { die "child died" }; + print $@; +} +EXPECT +parent died at - line 2. +child died at - line 6. +######## +if (eval q{$pid = fork}) { + eval q{ die "parent died" }; + print $@; +} +else { + eval q{ die "child died" }; + print $@; +} +EXPECT +parent died at (eval 2) line 1. +child died at (eval 2) line 1. +######## +BEGIN { + $| = 1; + fork and exit; + print "inner\n"; +} +# XXX In emulated fork(), the child will not execute anything after +# the BEGIN block, due to difficulties in recreating the parse stacks +# and restarting yyparse() midstream in the child. This can potentially +# be overcome by treating what's after the BEGIN{} as a brand new parse. +#print "outer\n" +EXPECT +inner diff --git a/t/op/glob.t b/t/op/glob.t index 253e4a3..4c27445 100755 --- a/t/op/glob.t +++ b/t/op/glob.t @@ -1,6 +1,9 @@ #!./perl -# $RCSfile: glob.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:55 $ +BEGIN { + chdir 't' if -d 't'; + unshift @INC, '../lib'; +} print "1..6\n"; diff --git a/t/op/groups.t b/t/op/groups.t index a8f9fe8..4b655c8 100755 --- a/t/op/groups.t +++ b/t/op/groups.t @@ -10,7 +10,7 @@ sub quit { exit 0; } -quit() if $^O eq 'MSWin32'; +quit() if $^O eq 'MSWin32' or $^O =~ /lynxos/i; # We have to find a command that prints all (effective # and real) group names (not ids). The known commands are: diff --git a/t/op/int.t b/t/op/int.t index eb060ac..6ac0866 100755 --- a/t/op/int.t +++ b/t/op/int.t @@ -1,8 +1,11 @@ #!./perl -# $RCSfile: int.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:00 $ +BEGIN { + chdir 't' if -d 't'; + unshift @INC, '../lib'; +} -print "1..4\n"; +print "1..6\n"; # compile time evaluation @@ -15,3 +18,13 @@ if (int(-1.234) == -1) {print "ok 2\n";} else {print "not ok 2\n";} $x = 1.234; if (int($x) == 1) {print "ok 3\n";} else {print "not ok 3\n";} if (int(-$x) == -1) {print "ok 4\n";} else {print "not ok 4\n";} + +$x = length("abc") % -10; +print $x == -7 ? "ok 5\n" : "# expected -7, got $x\nnot ok 5\n"; + +{ + use integer; + $x = length("abc") % -10; + $y = (3/-10)*-10; + print $x+$y == 3 && abs($x) < 10 ? "ok 6\n" : "not ok 6\n"; +} diff --git a/t/op/lex_assign.t b/t/op/lex_assign.t index b5c471a..56ddfff 100755 --- a/t/op/lex_assign.t +++ b/t/op/lex_assign.t @@ -4,6 +4,7 @@ BEGIN { chdir 't' if -d 't'; unshift @INC, '../lib'; } +$ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3; umask 0; $xref = \ ""; @@ -23,7 +24,7 @@ sub subb {"in s"} @INPUT = ; @simple_input = grep /^\s*\w+\s*\$\w+\s*[#\n]/, @INPUT; -print "1..", (8 + @INPUT + @simple_input), "\n"; +print "1..", (9 + @INPUT + @simple_input), "\n"; $ord = 0; sub wrn {"@_"} @@ -52,6 +53,12 @@ $ord++; print "not " unless $dc == 1; print "ok $ord\n"; +$ord++; +my $xxx = 'b'; +$xxx = 'c' . ($xxx || 'e'); +print "not " unless $xxx eq 'cb'; +print "ok $ord\n"; + { # Check calling STORE my $sc = 0; sub B::TIESCALAR {bless [11], 'B'} diff --git a/t/op/lfs.t b/t/op/lfs.t index 6f25231..0d6d027 100644 --- a/t/op/lfs.t +++ b/t/op/lfs.t @@ -3,12 +3,6 @@ # If you modify/add tests here, remember to update also t/lib/syslfs.t. BEGIN { - # Don't bother if there are no quads. - eval { my $q = pack "q", 0 }; - if ($@) { - print "1..0\n# no 64-bit types\n"; - exit(0); - } chdir 't' if -d 't'; unshift @INC, '../lib'; # Don't bother if there are no quad offsets. @@ -42,20 +36,22 @@ sub explain { EOM } +print "# checking whether we have sparse files...\n"; + # Known have-nots. if ($^O eq 'win32' || $^O eq 'vms') { - print "1..0\n# no sparse files\n"; + print "1..0\n# no sparse files (because this is $^O) \n"; bye(); } # Known haves that have problems running this test # (for example because they do not support sparse files, like UNICOS) if ($^O eq 'unicos') { - print "1..0\n# large files known to work but unable to test them here\n"; + print "1..0\n# large files known to work but unable to test them here ($^O)\n"; bye(); } -# Then try to deduce whether we have sparse files. +# Then try to heuristically deduce whether we have sparse files. # Let's not depend on Fcntl or any other extension. @@ -88,6 +84,8 @@ unless (@s == 13 && bye(); } +print "# we seem to have sparse files...\n"; + # By now we better be sure that we do have sparse files: # if we are not, the following will hog 5 gigabytes of disk. Ooops. @@ -95,18 +93,19 @@ $ENV{LC_ALL} = "C"; open(BIG, ">big") or do { warn "open failed: $!\n"; bye }; binmode BIG; -seek(BIG, 5_000_000_000, $SEEK_SET); +unless (seek(BIG, 5_000_000_000, $SEEK_SET)) { + print "1..0\n# seeking past 2GB failed: $!\n"; + explain(); + bye(); +} # Either the print or (more likely, thanks to buffering) the close will # fail if there are are filesize limitations (process or fs). my $print = print BIG "big"; -my $close = close BIG if $print; +print "# print failed: $!\n" unless $print; +my $close = close BIG; +print "# close failed: $!\n" unless $close; unless ($print && $close) { - unless ($print) { - print "# print failed: $!\n" - } else { - print "# close failed: $!\n" - } if ($! =~/too large/i) { print "1..0\n# writing past 2GB failed: process limits?\n"; } elsif ($! =~ /quota/i) { @@ -120,6 +119,12 @@ unless ($print && $close) { print "# @s\n"; +unless ($s[7] == 5_000_000_003) { + print "1..0\n# not configured to use large files?\n"; + explain(); + bye(); +} + sub fail () { print "not "; $fail++; diff --git a/t/op/magic.t b/t/op/magic.t index 31765e2..0d5190a 100755 --- a/t/op/magic.t +++ b/t/op/magic.t @@ -22,7 +22,8 @@ sub ok { $Is_MSWin32 = $^O eq 'MSWin32'; $Is_VMS = $^O eq 'VMS'; $Is_Dos = $^O eq 'dos'; -$Is_Cygwin = $^O =~ /cygwin/; +$Is_os2 = $^O eq 'os2'; +$Is_Cygwin = $^O eq 'cygwin'; $PERL = ($Is_MSWin32 ? '.\perl' : './perl'); print "1..35\n"; @@ -117,6 +118,9 @@ ok 18, $$ > 0, $$; chomp($wd = `pwd`); $wd =~ s#/t$##; } + elsif($Is_os2) { + $wd = Cwd::sys_cwd(); + } else { $wd = '.'; } @@ -142,6 +146,9 @@ __END__ :endofperl EOT } + elsif ($Is_os2) { + $script = "./show-shebang"; + } if ($^O eq 'os390' or $^O eq 'posix-bc' or $^O eq 'vmesa') { # no shebang $headmaybe = <\nbegin <",shift,">\n" } END { print "end <",shift,">\nargv <@ARGV>\n" } INIT { print "init <",shift,">\n" } +STOP { print "stop <",shift,">\n" } EXPECT -argv +argv begin -init -end -argv <> +stop +init +end +argv ######## -l # fdopen from a system descriptor to a system descriptor used to close @@ -504,4 +506,4 @@ else { if ($x == 0) { print "" } else { print $x } } EXPECT -Use of uninitialized value at - line 4. +Use of uninitialized value in numeric eq (==) at - line 4. diff --git a/t/op/nothread.t b/t/op/nothread.t index a434956..fd36e2e 100755 --- a/t/op/nothread.t +++ b/t/op/nothread.t @@ -9,7 +9,7 @@ BEGIN unshift @INC, "../lib"; require Config; import Config; - if ($Config{'usethreads'}) + if ($Config{'use5005threads'}) { print "1..0 # Skip: this perl is threaded\n"; exit 0; diff --git a/t/op/pack.t b/t/op/pack.t index 092e810..867da8d 100755 --- a/t/op/pack.t +++ b/t/op/pack.t @@ -6,7 +6,7 @@ BEGIN { require Config; import Config; } -print "1..152\n"; +print "1..156\n"; $format = "c2 x5 C C x s d i l a6"; # Need the expression in here to force ary[5] to be numeric. This avoids @@ -19,7 +19,10 @@ print ($#ary == $#ary2 ? "ok 1\n" : "not ok 1\n"); $out1=join(':',@ary); $out2=join(':',@ary2); -print ($out1 eq $out2 ? "ok 2\n" : "not ok 2\n"); +# Using long double NVs may introduce greater accuracy than wanted. +$out2 =~ s/:9\.87654321097999\d*:/:9.87654321098:/ + if $Config{uselongdouble} eq 'define'; +print ($out1 eq $out2? "ok 2\n" : "not ok 2\n"); print ($foo =~ /def/ ? "ok 3\n" : "not ok 3\n"); @@ -208,7 +211,7 @@ EOUU print "not " unless unpack('u', $uu) eq $in; print "ok ", $test++, "\n"; -# 61..72: test the ascii template types (A, a, Z) +# 61..73: test the ascii template types (A, a, Z) print "not " unless pack('A*', "foo\0bar\0 ") eq "foo\0bar\0 "; print "ok ", $test++, "\n"; @@ -234,19 +237,22 @@ print "ok ", $test++, "\n"; print "not " unless unpack('a8', "foo\0bar \0") eq "foo\0bar "; print "ok ", $test++, "\n"; -print "not " unless pack('Z*', "foo\0bar\0 ") eq "foo\0bar\0 "; +print "not " unless pack('Z*', "foo\0bar\0 ") eq "foo\0bar\0 \0"; print "ok ", $test++, "\n"; print "not " unless pack('Z11', "foo\0bar\0 ") eq "foo\0bar\0 \0\0"; print "ok ", $test++, "\n"; +print "not " unless pack('Z3', "foo") eq "fo\0"; +print "ok ", $test++, "\n"; + print "not " unless unpack('Z*', "foo\0bar \0") eq "foo"; print "ok ", $test++, "\n"; print "not " unless unpack('Z8', "foo\0bar \0") eq "foo"; print "ok ", $test++, "\n"; -# 73..78: packing native shorts/ints/longs +# 74..79: packing native shorts/ints/longs print "not " unless length(pack("s!", 0)) == $Config{shortsize}; print "ok ", $test++, "\n"; @@ -266,81 +272,81 @@ print "ok ", $test++, "\n"; print "not " unless length(pack("i!", 0)) == length(pack("i", 0)); print "ok ", $test++, "\n"; -# 79..138: pack <-> unpack bijectionism +# 80..139: pack <-> unpack bijectionism -# 79.. 83 c +# 80.. 84 c foreach my $c (-128, -1, 0, 1, 127) { print "not " unless unpack("c", pack("c", $c)) == $c; print "ok ", $test++, "\n"; } -# 84.. 88: C +# 85.. 89: C foreach my $C (0, 1, 127, 128, 255) { print "not " unless unpack("C", pack("C", $C)) == $C; print "ok ", $test++, "\n"; } -# 89.. 93: s +# 90.. 94: s foreach my $s (-32768, -1, 0, 1, 32767) { print "not " unless unpack("s", pack("s", $s)) == $s; print "ok ", $test++, "\n"; } -# 94.. 98: S +# 95.. 99: S foreach my $S (0, 1, 32767, 32768, 65535) { print "not " unless unpack("S", pack("S", $S)) == $S; print "ok ", $test++, "\n"; } -# 99..103: i +# 100..104: i foreach my $i (-2147483648, -1, 0, 1, 2147483647) { print "not " unless unpack("i", pack("i", $i)) == $i; print "ok ", $test++, "\n"; } -# 104..108: I +# 105..109: I foreach my $I (0, 1, 2147483647, 2147483648, 4294967295) { print "not " unless unpack("I", pack("I", $I)) == $I; print "ok ", $test++, "\n"; } -# 109..113: l +# 110..114: l foreach my $l (-2147483648, -1, 0, 1, 2147483647) { print "not " unless unpack("l", pack("l", $l)) == $l; print "ok ", $test++, "\n"; } -# 114..118: L +# 115..119: L foreach my $L (0, 1, 2147483647, 2147483648, 4294967295) { print "not " unless unpack("L", pack("L", $L)) == $L; print "ok ", $test++, "\n"; } -# 119..123: n +# 120..124: n foreach my $n (0, 1, 32767, 32768, 65535) { print "not " unless unpack("n", pack("n", $n)) == $n; print "ok ", $test++, "\n"; } -# 124..128: v +# 125..129: v foreach my $v (0, 1, 32767, 32768, 65535) { print "not " unless unpack("v", pack("v", $v)) == $v; print "ok ", $test++, "\n"; } -# 129..133: N +# 130..134: N foreach my $N (0, 1, 2147483647, 2147483648, 4294967295) { print "not " unless unpack("N", pack("N", $N)) == $N; print "ok ", $test++, "\n"; } -# 134..138: V +# 135..139: V foreach my $V (0, 1, 2147483647, 2147483648, 4294967295) { print "not " unless unpack("V", pack("V", $V)) == $V; print "ok ", $test++, "\n"; } -# 139..142: pack nvNV byteorders +# 140..143: pack nvNV byteorders print "not " unless pack("n", 0xdead) eq "\xde\xad"; print "ok ", $test++, "\n"; @@ -354,7 +360,7 @@ print "ok ", $test++, "\n"; print "not " unless pack("V", 0xdeadbeef) eq "\xef\xbe\xad\xde"; print "ok ", $test++, "\n"; -# 143..148: / +# 144..152: / my $z; eval { ($x) = unpack '/a*','hello' }; @@ -369,7 +375,21 @@ print 'not ' unless $@; print "ok $test\n"; $test++; $z = pack 'n/a* w/A*','string','etc'; print 'not ' unless $z eq "\000\006string\003etc"; print "ok $test\n"; $test++; -# 149..152: / with # +eval { ($x) = unpack 'a/a*/a*', '212ab345678901234567' }; +print $@ eq '' && $x eq 'ab3456789012' ? "ok $test\n" : "#$x,$@\nnot ok $test\n"; +$test++; + +eval { ($x) = unpack 'a/a*/a*', '3012ab345678901234567' }; +print $@ eq '' && $x eq 'ab3456789012' ? "ok $test\n" : "not ok $test\n"; +$test++; + +eval { ($x) = unpack 'a/a*/b*', '212ab' }; +my $expected_x = '100001100100'; +if ($Config{ebcdic} eq 'define') { $expected_x = '100000010100'; } +print $@ eq '' && $x eq $expected_x ? "ok $test\n" : "#$x,$@\nnot ok $test\n"; +$test++; + +# 153..156: / with # eval { ($z,$x,$y) = unpack < -## Adapted and expanded by Gurusamy Sarathy +## Adapted and expanded by Gurusamy Sarathy ## chdir 't' if -d 't'; @@ -57,7 +57,7 @@ __END__ @a = sort { last ; } @a; } EXPECT -Can't "last" outside a block at - line 3. +Can't "last" outside a loop block at - line 3. ######## package TEST; @@ -174,7 +174,7 @@ exit; bar: print "bar reached\n"; EXPECT -Can't "goto" outside a block at - line 2. +Can't "goto" out of a pseudo block at - line 2. ######## sub sortfn { (split(/./, 'x'x10000))[0]; @@ -227,7 +227,7 @@ tie $bar, TEST; } print "OK\n"; EXPECT -Can't "next" outside a block at - line 8. +Can't "next" outside a loop block at - line 8. ######## package TEST; @@ -285,7 +285,7 @@ package main; tie $bar, TEST; } EXPECT -Can't "next" outside a block at - line 4. +Can't "next" outside a loop block at - line 4. ######## @a = (1, 2, 3); foo: @@ -335,3 +335,17 @@ tie my @bar, 'TEST'; print join('|', @bar[0..3]), "\n"; EXPECT foo|fee|fie|foe +######## +package TH; +sub TIEHASH { bless {}, TH } +sub STORE { eval { print "@_[1,2]\n" }; die "bar\n" } +tie %h, TH; +eval { $h{A} = 1; print "never\n"; }; +print $@; +eval { $h{B} = 2; }; +print $@; +EXPECT +A 1 +bar +B 2 +bar diff --git a/t/op/sort.t b/t/op/sort.t index f7bba3d..6e3d2ca 100755 --- a/t/op/sort.t +++ b/t/op/sort.t @@ -4,12 +4,13 @@ BEGIN { chdir 't' if -d 't'; unshift @INC, '../lib'; } -print "1..38\n"; +print "1..49\n"; # XXX known to leak scalars $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3; sub backwards { $a lt $b ? 1 : $a gt $b ? -1 : 0 } +sub backwards_stacked($$) { my($a,$b) = @_; $a lt $b ? 1 : $a gt $b ? -1 : 0 } my $upperfirst = 'A' lt 'a'; @@ -40,96 +41,107 @@ $expected = $upperfirst ? 'xdogcatCainAbel' : 'CainAbelxdogcat'; print "# 2: x = '$x', expected = '$expected'\n"; print ($x eq $expected ? "ok 2\n" : "not ok 2\n"); +$x = join('', sort( backwards_stacked @harry)); +$expected = $upperfirst ? 'xdogcatCainAbel' : 'CainAbelxdogcat'; +print "# 3: x = '$x', expected = '$expected'\n"; +print ($x eq $expected ? "ok 3\n" : "not ok 3\n"); + $x = join('', sort @george, 'to', @harry); $expected = $upperfirst ? 'AbelAxedCaincatchaseddoggonepunishedtoxyz' : 'catchaseddoggonepunishedtoxyzAbelAxedCain' ; -print "# 3: x = '$x', expected = '$expected'\n"; -print ($x eq $expected ?"ok 3\n":"not ok 3\n"); +print "# 4: x = '$x', expected = '$expected'\n"; +print ($x eq $expected ?"ok 4\n":"not ok 4\n"); @a = (); @b = reverse @a; -print ("@b" eq "" ? "ok 4\n" : "not ok 4 (@b)\n"); +print ("@b" eq "" ? "ok 5\n" : "not ok 5 (@b)\n"); @a = (1); @b = reverse @a; -print ("@b" eq "1" ? "ok 5\n" : "not ok 5 (@b)\n"); +print ("@b" eq "1" ? "ok 6\n" : "not ok 6 (@b)\n"); @a = (1,2); @b = reverse @a; -print ("@b" eq "2 1" ? "ok 6\n" : "not ok 6 (@b)\n"); +print ("@b" eq "2 1" ? "ok 7\n" : "not ok 7 (@b)\n"); @a = (1,2,3); @b = reverse @a; -print ("@b" eq "3 2 1" ? "ok 7\n" : "not ok 7 (@b)\n"); +print ("@b" eq "3 2 1" ? "ok 8\n" : "not ok 8 (@b)\n"); @a = (1,2,3,4); @b = reverse @a; -print ("@b" eq "4 3 2 1" ? "ok 8\n" : "not ok 8 (@b)\n"); +print ("@b" eq "4 3 2 1" ? "ok 9\n" : "not ok 9 (@b)\n"); @a = (10,2,3,4); @b = sort {$a <=> $b;} @a; -print ("@b" eq "2 3 4 10" ? "ok 9\n" : "not ok 9 (@b)\n"); +print ("@b" eq "2 3 4 10" ? "ok 10\n" : "not ok 10 (@b)\n"); $sub = 'backwards'; $x = join('', sort $sub @harry); $expected = $upperfirst ? 'xdogcatCainAbel' : 'CainAbelxdogcat'; -print "# 10: x = $x, expected = '$expected'\n"; -print ($x eq $expected ? "ok 10\n" : "not ok 10\n"); +print "# 11: x = $x, expected = '$expected'\n"; +print ($x eq $expected ? "ok 11\n" : "not ok 11\n"); + +$sub = 'backwards_stacked'; +$x = join('', sort $sub @harry); +$expected = $upperfirst ? 'xdogcatCainAbel' : 'CainAbelxdogcat'; +print "# 12: x = $x, expected = '$expected'\n"; +print ($x eq $expected ? "ok 12\n" : "not ok 12\n"); # literals, combinations @b = sort (4,1,3,2); -print ("@b" eq '1 2 3 4' ? "ok 11\n" : "not ok 11\n"); +print ("@b" eq '1 2 3 4' ? "ok 13\n" : "not ok 13\n"); print "# x = '@b'\n"; @b = sort grep { $_ } (4,1,3,2); -print ("@b" eq '1 2 3 4' ? "ok 12\n" : "not ok 12\n"); +print ("@b" eq '1 2 3 4' ? "ok 14\n" : "not ok 14\n"); print "# x = '@b'\n"; @b = sort map { $_ } (4,1,3,2); -print ("@b" eq '1 2 3 4' ? "ok 13\n" : "not ok 13\n"); +print ("@b" eq '1 2 3 4' ? "ok 15\n" : "not ok 15\n"); print "# x = '@b'\n"; @b = sort reverse (4,1,3,2); -print ("@b" eq '1 2 3 4' ? "ok 14\n" : "not ok 14\n"); +print ("@b" eq '1 2 3 4' ? "ok 16\n" : "not ok 16\n"); print "# x = '@b'\n"; $^W = 0; # redefining sort sub inside the sort sub should fail sub twoface { *twoface = sub { $a <=> $b }; &twoface } eval { @b = sort twoface 4,1,3,2 }; -print ($@ =~ /redefine active sort/ ? "ok 15\n" : "not ok 15\n"); +print ($@ =~ /redefine active sort/ ? "ok 17\n" : "not ok 17\n"); # redefining sort subs outside the sort should not fail eval { *twoface = sub { &backwards } }; -print $@ ? "not ok 16\n" : "ok 16\n"; +print $@ ? "not ok 18\n" : "ok 18\n"; eval { @b = sort twoface 4,1,3,2 }; -print ("@b" eq '4 3 2 1' ? "ok 17\n" : "not ok 17 |@b|\n"); +print ("@b" eq '4 3 2 1' ? "ok 19\n" : "not ok 19 |@b|\n"); *twoface = sub { *twoface = *backwards; $a <=> $b }; eval { @b = sort twoface 4,1 }; -print ($@ =~ /redefine active sort/ ? "ok 18\n" : "not ok 18\n"); +print ($@ =~ /redefine active sort/ ? "ok 20\n" : "not ok 20\n"); *twoface = sub { eval 'sub twoface { $a <=> $b }'; - die($@ =~ /redefine active sort/ ? "ok 19\n" : "not ok 19\n"); + die($@ =~ /redefine active sort/ ? "ok 21\n" : "not ok 21\n"); $a <=> $b; }; eval { @b = sort twoface 4,1 }; -print $@ ? "$@" : "not ok 19\n"; +print $@ ? "$@" : "not ok 21\n"; eval <<'CODE'; my @result = sort main'backwards 'one', 'two'; CODE -print $@ ? "not ok 20\n# $@" : "ok 20\n"; +print $@ ? "not ok 22\n# $@" : "ok 22\n"; eval <<'CODE'; # "sort 'one', 'two'" should not try to parse "'one" as a sort sub my @result = sort 'one', 'two'; CODE -print $@ ? "not ok 21\n# $@" : "ok 21\n"; +print $@ ? "not ok 23\n# $@" : "ok 23\n"; { my $sortsub = \&backwards; @@ -137,13 +149,28 @@ print $@ ? "not ok 21\n# $@" : "ok 21\n"; my $sortglobr = \*backwards; my $sortname = 'backwards'; @b = sort $sortsub 4,1,3,2; - print ("@b" eq '4 3 2 1' ? "ok 22\n" : "not ok 22 |@b|\n"); + print ("@b" eq '4 3 2 1' ? "ok 24\n" : "not ok 24 |@b|\n"); @b = sort $sortglob 4,1,3,2; - print ("@b" eq '4 3 2 1' ? "ok 23\n" : "not ok 23 |@b|\n"); + print ("@b" eq '4 3 2 1' ? "ok 25\n" : "not ok 25 |@b|\n"); @b = sort $sortname 4,1,3,2; - print ("@b" eq '4 3 2 1' ? "ok 24\n" : "not ok 24 |@b|\n"); + print ("@b" eq '4 3 2 1' ? "ok 26\n" : "not ok 26 |@b|\n"); @b = sort $sortglobr 4,1,3,2; - print ("@b" eq '4 3 2 1' ? "ok 25\n" : "not ok 25 |@b|\n"); + print ("@b" eq '4 3 2 1' ? "ok 27\n" : "not ok 27 |@b|\n"); +} + +{ + my $sortsub = \&backwards_stacked; + my $sortglob = *backwards_stacked; + my $sortglobr = \*backwards_stacked; + my $sortname = 'backwards_stacked'; + @b = sort $sortsub 4,1,3,2; + print ("@b" eq '4 3 2 1' ? "ok 28\n" : "not ok 28 |@b|\n"); + @b = sort $sortglob 4,1,3,2; + print ("@b" eq '4 3 2 1' ? "ok 29\n" : "not ok 29 |@b|\n"); + @b = sort $sortname 4,1,3,2; + print ("@b" eq '4 3 2 1' ? "ok 30\n" : "not ok 30 |@b|\n"); + @b = sort $sortglobr 4,1,3,2; + print ("@b" eq '4 3 2 1' ? "ok 31\n" : "not ok 31 |@b|\n"); } { @@ -152,54 +179,76 @@ print $@ ? "not ok 21\n# $@" : "ok 21\n"; local $sortglobr = \*backwards; local $sortname = 'backwards'; @b = sort $sortsub 4,1,3,2; - print ("@b" eq '4 3 2 1' ? "ok 26\n" : "not ok 26 |@b|\n"); + print ("@b" eq '4 3 2 1' ? "ok 32\n" : "not ok 32 |@b|\n"); @b = sort $sortglob 4,1,3,2; - print ("@b" eq '4 3 2 1' ? "ok 27\n" : "not ok 27 |@b|\n"); + print ("@b" eq '4 3 2 1' ? "ok 33\n" : "not ok 33 |@b|\n"); @b = sort $sortname 4,1,3,2; - print ("@b" eq '4 3 2 1' ? "ok 28\n" : "not ok 28 |@b|\n"); + print ("@b" eq '4 3 2 1' ? "ok 34\n" : "not ok 34 |@b|\n"); @b = sort $sortglobr 4,1,3,2; - print ("@b" eq '4 3 2 1' ? "ok 29\n" : "not ok 29 |@b|\n"); + print ("@b" eq '4 3 2 1' ? "ok 35\n" : "not ok 35 |@b|\n"); +} + +{ + local $sortsub = \&backwards_stacked; + local $sortglob = *backwards_stacked; + local $sortglobr = \*backwards_stacked; + local $sortname = 'backwards_stacked'; + @b = sort $sortsub 4,1,3,2; + print ("@b" eq '4 3 2 1' ? "ok 36\n" : "not ok 36 |@b|\n"); + @b = sort $sortglob 4,1,3,2; + print ("@b" eq '4 3 2 1' ? "ok 37\n" : "not ok 37 |@b|\n"); + @b = sort $sortname 4,1,3,2; + print ("@b" eq '4 3 2 1' ? "ok 38\n" : "not ok 38 |@b|\n"); + @b = sort $sortglobr 4,1,3,2; + print ("@b" eq '4 3 2 1' ? "ok 39\n" : "not ok 39 |@b|\n"); } ## exercise sort builtins... ($a <=> $b already tested) @a = ( 5, 19, 1996, 255, 90 ); -@b = sort { $b <=> $a } @a; -print ("@b" eq '1996 255 90 19 5' ? "ok 30\n" : "not ok 30\n"); +@b = sort { + my $dummy; # force blockness + return $b <=> $a +} @a; +print ("@b" eq '1996 255 90 19 5' ? "ok 40\n" : "not ok 40\n"); print "# x = '@b'\n"; $x = join('', sort { $a cmp $b } @harry); $expected = $upperfirst ? 'AbelCaincatdogx' : 'catdogxAbelCain'; -print ($x eq $expected ? "ok 31\n" : "not ok 31\n"); +print ($x eq $expected ? "ok 41\n" : "not ok 41\n"); print "# x = '$x'; expected = '$expected'\n"; $x = join('', sort { $b cmp $a } @harry); $expected = $upperfirst ? 'xdogcatCainAbel' : 'CainAbelxdogcat'; -print ($x eq $expected ? "ok 32\n" : "not ok 32\n"); +print ($x eq $expected ? "ok 42\n" : "not ok 42\n"); print "# x = '$x'; expected = '$expected'\n"; { use integer; @b = sort { $a <=> $b } @a; - print ("@b" eq '5 19 90 255 1996' ? "ok 33\n" : "not ok 33\n"); + print ("@b" eq '5 19 90 255 1996' ? "ok 43\n" : "not ok 43\n"); print "# x = '@b'\n"; @b = sort { $b <=> $a } @a; - print ("@b" eq '1996 255 90 19 5' ? "ok 34\n" : "not ok 34\n"); + print ("@b" eq '1996 255 90 19 5' ? "ok 44\n" : "not ok 44\n"); print "# x = '@b'\n"; $x = join('', sort { $a cmp $b } @harry); $expected = $upperfirst ? 'AbelCaincatdogx' : 'catdogxAbelCain'; - print ($x eq $expected ? "ok 35\n" : "not ok 35\n"); + print ($x eq $expected ? "ok 45\n" : "not ok 45\n"); print "# x = '$x'; expected = '$expected'\n"; $x = join('', sort { $b cmp $a } @harry); $expected = $upperfirst ? 'xdogcatCainAbel' : 'CainAbelxdogcat'; - print ($x eq $expected ? "ok 36\n" : "not ok 36\n"); + print ($x eq $expected ? "ok 46\n" : "not ok 46\n"); print "# x = '$x'; expected = '$expected'\n"; } # test that an optimized-away comparison block doesn't take any other # arguments away with it $x = join('', sort { $a <=> $b } 3, 1, 2); -print $x eq "123" ? "ok 37\n" : "not ok 37\n"; +print $x eq "123" ? "ok 47\n" : "not ok 47\n"; # test sorting in non-main package package Foo; @a = ( 5, 19, 1996, 255, 90 ); @b = sort { $b <=> $a } @a; -print ("@b" eq '1996 255 90 19 5' ? "ok 38\n" : "not ok 38\n"); +print ("@b" eq '1996 255 90 19 5' ? "ok 48\n" : "not ok 48\n"); +print "# x = '@b'\n"; + +@b = sort main::backwards_stacked @a; +print ("@b" eq '90 5 255 1996 19' ? "ok 49\n" : "not ok 49\n"); print "# x = '@b'\n"; diff --git a/t/op/stat.t b/t/op/stat.t index 0af55bb..37237f0 100755 --- a/t/op/stat.t +++ b/t/op/stat.t @@ -14,9 +14,10 @@ print "1..58\n"; $Is_MSWin32 = $^O eq 'MSWin32'; $Is_Dos = $^O eq 'dos'; $Is_Dosish = $Is_Dos || $^O eq 'os2' || $Is_MSWin32; +$Is_Cygwin = $^O eq 'cygwin'; chop($cwd = ($Is_MSWin32 ? `cd` : `pwd`)); -$DEV = `ls -l /dev` unless $Is_Dosish; +$DEV = `ls -l /dev` unless $Is_Dosish or $Is_Cygwin; unlink "Op.stat.tmp"; if (open(FOO, ">Op.stat.tmp")) { @@ -163,7 +164,7 @@ else {print "not ok 33\n";} if (! -b '.') {print "ok 34\n";} else {print "not ok 34\n";} -if ($^O eq 'amigaos' or $Is_Dosish) { +if ($^O eq 'amigaos' or $Is_Dosish or $Is_Cygwin) { print "ok 35 # skipped: no -u\n"; goto tty_test; } diff --git a/t/op/subst.t b/t/op/subst.t index 2d15df4..9757f4c 100755 --- a/t/op/subst.t +++ b/t/op/subst.t @@ -6,7 +6,7 @@ BEGIN { require Config; import Config; } -print "1..83\n"; +print "1..84\n"; $x = 'foo'; $_ = "x"; @@ -375,4 +375,7 @@ $x = $x = 'interp'; eval q% ($_ = "x") =~ s/x(($x)*)/"$1"/e %; print +($_ eq '' and !length $@) ? "ok 83\n" : "not ok 83\n# \$_ eq $_, $@\n"; +$_ = "C:/"; +s/^([a-z]:)/\u$1/ and print "not "; +print "ok 84\n"; diff --git a/t/op/substr.t b/t/op/substr.t index 87efcb4..8d31a9a 100755 --- a/t/op/substr.t +++ b/t/op/substr.t @@ -1,6 +1,6 @@ #!./perl -print "1..106\n"; +print "1..108\n"; #P = start of string Q = start of substr R = end of substr S = end of string @@ -209,3 +209,9 @@ print "ok 105\n"; eval 'substr($a,0,0,"") = "abc"'; print "not " unless $@ && $@ =~ /Can't modify substr/ && $a eq "foo"; print "ok 106\n"; + +$a = "abcdefgh"; +print "not " unless sub { shift }->(substr($a, 0, 4, "xxxx")) eq 'abcd'; +print "ok 107\n"; +print "not " unless $a eq 'xxxxefgh'; +print "ok 108\n"; diff --git a/t/op/taint.t b/t/op/taint.t index fdd1c79..6a9537b 100755 --- a/t/op/taint.t +++ b/t/op/taint.t @@ -254,7 +254,8 @@ print "1..149\n"; # Globs should be forbidden, except under VMS, # which doesn't spawn an external program. -if ($Is_VMS) { +if (1 # built-in glob + or $Is_VMS) { for (35..36) { print "ok $_\n"; } } else { diff --git a/t/op/time.t b/t/op/time.t index 658f9f3..caf2c14 100755 --- a/t/op/time.t +++ b/t/op/time.t @@ -47,7 +47,7 @@ else {print "not ok 5\n";} # This could be stricter. -if (gmtime() =~ /^(Sun|Mon|Tue|Wed|Thu|Fri|Sat) (Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Nov|Dec) ([ \d]\d) (\d\d):(\d\d):(\d\d) (\d\d\d\d)$/) +if (gmtime() =~ /^(Sun|Mon|Tue|Wed|Thu|Fri|Sat) (Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec) ([ \d]\d) (\d\d):(\d\d):(\d\d) (\d\d\d\d)$/) {print "ok 6\n";} else {print "not ok 6\n";} diff --git a/t/pod/emptycmd.t b/t/pod/emptycmd.t index 59e395e..d348a9d 100755 --- a/t/pod/emptycmd.t +++ b/t/pod/emptycmd.t @@ -1,7 +1,7 @@ +#!./perl BEGIN { - use File::Basename; - my $THISDIR = dirname $0; - unshift @INC, $THISDIR; + chdir 't' if -d 't'; + unshift @INC, './pod', '../lib'; require "testp2pt.pl"; import TestPodIncPlainText; } diff --git a/t/pod/for.t b/t/pod/for.t index 44af44f..b8a6ec5 100755 --- a/t/pod/for.t +++ b/t/pod/for.t @@ -1,7 +1,7 @@ +#!./perl BEGIN { - use File::Basename; - my $THISDIR = dirname $0; - unshift @INC, $THISDIR; + chdir 't' if -d 't'; + unshift @INC, './pod', '../lib'; require "testp2pt.pl"; import TestPodIncPlainText; } diff --git a/t/pod/for.xr b/t/pod/for.xr index 25794ab..5f6b8b2 100644 --- a/t/pod/for.xr +++ b/t/pod/for.xr @@ -1,19 +1,21 @@ This is a test - pod2text should see this and this and this + pod2text should see this + and this + and this and everything should see this! - Similarly, this line ... +Similarly, this line ... - and this one ... +and this one ... - as well this one, +as well this one, - should all be in pod2text output +should all be in pod2text output - Tweedley-deedley-dee, Im as happy as can be! Tweedley-deedley- - dum, cuz youre my honey sugar plum! + Tweedley-deedley-dee, Im as happy as can be! Tweedley-deedley-dum, cuz + youre my honey sugar plum! The rest of this should show up in everything. diff --git a/t/pod/headings.t b/t/pod/headings.t index 78608d0..fc7b4b2 100755 --- a/t/pod/headings.t +++ b/t/pod/headings.t @@ -1,7 +1,7 @@ +#!./perl BEGIN { - use File::Basename; - my $THISDIR = dirname $0; - unshift @INC, $THISDIR; + chdir 't' if -d 't'; + unshift @INC, './pod', '../lib'; require "testp2pt.pl"; import TestPodIncPlainText; } diff --git a/t/pod/headings.xr b/t/pod/headings.xr index e1277b7..fb37a2b 100644 --- a/t/pod/headings.xr +++ b/t/pod/headings.xr @@ -5,25 +5,22 @@ SYNOPSIS rdb2pg [*param*=*value* ...] PARAMETERS - rdb2pg uses an IRAF-compatible parameter interface. A template - parameter file is in /proj/axaf/simul/lib/uparm/rdb2pg.par. + rdb2pg uses an IRAF-compatible parameter interface. A template parameter + file is in /proj/axaf/simul/lib/uparm/rdb2pg.par. input *file* - The RDB file to insert into the database. If the given name - is the string `stdin', it reads from the UNIX standard input - stream. - + The RDB file to insert into the database. If the given name is the + string `stdin', it reads from the UNIX standard input stream. DESCRIPTION - rdb2pg will enter the data from an RDB database into a - PostgreSQL database table, optionally creating the database and - the table if they do not exist. It automatically determines the - PostgreSQL data type from the column definition in the RDB file, - but may be overriden via a series of definition files or - directly via one of its parameters. + rdb2pg will enter the data from an RDB database into a PostgreSQL + database table, optionally creating the database and the table if they + do not exist. It automatically determines the PostgreSQL data type from + the column definition in the RDB file, but may be overriden via a series + of definition files or directly via one of its parameters. - The target database and table are specified by the `db' and - `table' parameters. If they do not exist, and the `createdb' - parameter is set, they will be created. Table field definitions - are determined in the following order: + The target database and table are specified by the `db' and `table' + parameters. If they do not exist, and the `createdb' parameter is set, + they will be created. Table field definitions are determined in the + following order: diff --git a/t/pod/include.t b/t/pod/include.t index 4e73b78..6d0b7e3 100755 --- a/t/pod/include.t +++ b/t/pod/include.t @@ -1,7 +1,7 @@ +#!./perl BEGIN { - use File::Basename; - my $THISDIR = dirname $0; - unshift @INC, $THISDIR; + chdir 't' if -d 't'; + unshift @INC, './pod', '../lib'; require "testp2pt.pl"; import TestPodIncPlainText; } diff --git a/t/pod/include.xr b/t/pod/include.xr index 1bac06a..624ee44 100644 --- a/t/pod/include.xr +++ b/t/pod/include.xr @@ -1,20 +1,19 @@ - This file tries to demonstrate a simple =include directive for - pods. It is used as follows: + This file tries to demonstrate a simple =include directive for pods. It + is used as follows: =include filename - where "filename" is expected to be an absolute pathname, or else - reside be relative to the directory in which the current - processed podfile resides, or be relative to the current - directory. + where "filename" is expected to be an absolute pathname, or else reside + be relative to the directory in which the current processed podfile + resides, or be relative to the current directory. Lets try it out with the file "included.t" shall we. ***THIS TEXT IS IMMEDIATELY BEFORE THE INCLUDE*** ###### begin =include included.t ##### - This is the text of the included file named "included.t". It - should appear in the final pod document from pod2xxx + This is the text of the included file named "included.t". It should + appear in the final pod document from pod2xxx ###### end =include included.t ##### ***THIS TEXT IS IMMEDIATELY AFTER THE INCLUDE*** diff --git a/t/pod/included.t b/t/pod/included.t index 4f171c4..0e31a09 100755 --- a/t/pod/included.t +++ b/t/pod/included.t @@ -1,7 +1,7 @@ +#!./perl BEGIN { - use File::Basename; - my $THISDIR = dirname $0; - unshift @INC, $THISDIR; + chdir 't' if -d 't'; + unshift @INC, './pod', '../lib'; require "testp2pt.pl"; import TestPodIncPlainText; } diff --git a/t/pod/included.xr b/t/pod/included.xr index f0bc03b..54142fa 100644 --- a/t/pod/included.xr +++ b/t/pod/included.xr @@ -1,3 +1,3 @@ - This is the text of the included file named "included.t". It - should appear in the final pod document from pod2xxx + This is the text of the included file named "included.t". It should + appear in the final pod document from pod2xxx diff --git a/t/pod/lref.t b/t/pod/lref.t index 02e2c9e..e367d6d 100755 --- a/t/pod/lref.t +++ b/t/pod/lref.t @@ -1,7 +1,7 @@ +#!./perl BEGIN { - use File::Basename; - my $THISDIR = dirname $0; - unshift @INC, $THISDIR; + chdir 't' if -d 't'; + unshift @INC, './pod', '../lib'; require "testp2pt.pl"; import TestPodIncPlainText; } diff --git a/t/pod/lref.xr b/t/pod/lref.xr index d8455e3..297053b 100644 --- a/t/pod/lref.xr +++ b/t/pod/lref.xr @@ -1,22 +1,22 @@ Try out *LOTS* of different ways of specifying references: - Reference the the "section" entry in the manpage manpage + Reference the the section entry in the manpage manpage - Reference the the "section" entry in the manpage manpage + Reference the the section entry in the manpage manpage - Reference the the "section" entry in the manpage manpage + Reference the the section entry in the manpage manpage - Reference the the "section" entry in the manpage manpage + Reference the the section entry in the manpage manpage Reference the the section on "manpage/section" - Reference the the "section" entry in the "manpage" manpage + Reference the the section entry in the "manpage" manpage Reference the the section on "section" in the manpage manpage - Reference the the "section" entry in the manpage manpage + Reference the the section entry in the manpage manpage - Reference the the "section" entry in the manpage manpage + Reference the the section entry in the manpage manpage Now try it using the new "|" stuff ... diff --git a/t/pod/multiline_items.t b/t/pod/multiline_items.t new file mode 100755 index 0000000..37e8d53 --- /dev/null +++ b/t/pod/multiline_items.t @@ -0,0 +1,31 @@ +#!./perl +BEGIN { + chdir 't' if -d 't'; + unshift @INC, './pod', '../lib'; + require "testp2pt.pl"; + import TestPodIncPlainText; +} + +my %options = map { $_ => 1 } @ARGV; ## convert cmdline to options-hash +my $passed = testpodplaintext \%options, $0; +exit( ($passed == 1) ? 0 : -1 ) unless $ENV{HARNESS_ACTIVE}; + + +__END__ + + +=head1 Test multiline item lists + +This is a test to ensure that multiline =item paragraphs +get indented appropriately. + +=over 4 + +=item This +is +a +test. + +=back + +=cut diff --git a/t/pod/multiline_items.xr b/t/pod/multiline_items.xr new file mode 100644 index 0000000..dddf05f --- /dev/null +++ b/t/pod/multiline_items.xr @@ -0,0 +1,5 @@ +Test multiline item lists + This is a test to ensure that multiline =item paragraphs get indented + appropriately. + + This is a test. diff --git a/t/pod/nested_items.t b/t/pod/nested_items.t index c8e9b22..9c09801 100755 --- a/t/pod/nested_items.t +++ b/t/pod/nested_items.t @@ -1,7 +1,7 @@ +#!./perl BEGIN { - use File::Basename; - my $THISDIR = dirname $0; - unshift @INC, $THISDIR; + chdir 't' if -d 't'; + unshift @INC, './pod', '../lib'; require "testp2pt.pl"; import TestPodIncPlainText; } diff --git a/t/pod/nested_items.xr b/t/pod/nested_items.xr index 7d72bbe..dd1adac 100644 --- a/t/pod/nested_items.xr +++ b/t/pod/nested_items.xr @@ -1,6 +1,6 @@ Test nested item lists - This is a test to ensure the nested =item paragraphs get - indented appropriately. + This is a test to ensure the nested =item paragraphs get indented + appropriately. 1 First section. diff --git a/t/pod/nested_seqs.t b/t/pod/nested_seqs.t index 8559f1f..6a5405b 100755 --- a/t/pod/nested_seqs.t +++ b/t/pod/nested_seqs.t @@ -1,7 +1,7 @@ +#!./perl BEGIN { - use File::Basename; - my $THISDIR = dirname $0; - unshift @INC, $THISDIR; + chdir 't' if -d 't'; + unshift @INC, './pod', '../lib'; require "testp2pt.pl"; import TestPodIncPlainText; } diff --git a/t/pod/nested_seqs.xr b/t/pod/nested_seqs.xr index 5a008c1..f981061 100644 --- a/t/pod/nested_seqs.xr +++ b/t/pod/nested_seqs.xr @@ -1,3 +1,3 @@ - The statement: `This is dog kind's *finest* hour!' is a parody - of a quotation from Winston Churchill. + The statement: `This is dog kind's *finest* hour!' is a parody of a + quotation from Winston Churchill. diff --git a/t/pod/oneline_cmds.t b/t/pod/oneline_cmds.t index 28bd1d0..3081ef4 100755 --- a/t/pod/oneline_cmds.t +++ b/t/pod/oneline_cmds.t @@ -1,7 +1,7 @@ +#!./perl BEGIN { - use File::Basename; - my $THISDIR = dirname $0; - unshift @INC, $THISDIR; + chdir 't' if -d 't'; + unshift @INC, './pod', '../lib'; require "testp2pt.pl"; import TestPodIncPlainText; } diff --git a/t/pod/oneline_cmds.xr b/t/pod/oneline_cmds.xr index e1277b7..fb37a2b 100644 --- a/t/pod/oneline_cmds.xr +++ b/t/pod/oneline_cmds.xr @@ -5,25 +5,22 @@ SYNOPSIS rdb2pg [*param*=*value* ...] PARAMETERS - rdb2pg uses an IRAF-compatible parameter interface. A template - parameter file is in /proj/axaf/simul/lib/uparm/rdb2pg.par. + rdb2pg uses an IRAF-compatible parameter interface. A template parameter + file is in /proj/axaf/simul/lib/uparm/rdb2pg.par. input *file* - The RDB file to insert into the database. If the given name - is the string `stdin', it reads from the UNIX standard input - stream. - + The RDB file to insert into the database. If the given name is the + string `stdin', it reads from the UNIX standard input stream. DESCRIPTION - rdb2pg will enter the data from an RDB database into a - PostgreSQL database table, optionally creating the database and - the table if they do not exist. It automatically determines the - PostgreSQL data type from the column definition in the RDB file, - but may be overriden via a series of definition files or - directly via one of its parameters. + rdb2pg will enter the data from an RDB database into a PostgreSQL + database table, optionally creating the database and the table if they + do not exist. It automatically determines the PostgreSQL data type from + the column definition in the RDB file, but may be overriden via a series + of definition files or directly via one of its parameters. - The target database and table are specified by the `db' and - `table' parameters. If they do not exist, and the `createdb' - parameter is set, they will be created. Table field definitions - are determined in the following order: + The target database and table are specified by the `db' and `table' + parameters. If they do not exist, and the `createdb' parameter is set, + they will be created. Table field definitions are determined in the + following order: diff --git a/t/pod/pod2usage.t b/t/pod/pod2usage.t new file mode 100755 index 0000000..bceeeef --- /dev/null +++ b/t/pod/pod2usage.t @@ -0,0 +1,18 @@ +#!./perl +BEGIN { + chdir 't' if -d 't'; + unshift @INC, './pod', '../lib'; + require "testp2pt.pl"; + import TestPodIncPlainText; +} + +my %options = map { $_ => 1 } @ARGV; ## convert cmdline to options-hash +my $passed = testpodplaintext \%options, $0; +exit( ($passed == 1) ? 0 : -1 ) unless $ENV{HARNESS_ACTIVE}; + + +__END__ + +=include pod2usage.PL + + diff --git a/t/pod/pod2usage.xr b/t/pod/pod2usage.xr new file mode 100644 index 0000000..7315d40 --- /dev/null +++ b/t/pod/pod2usage.xr @@ -0,0 +1,55 @@ +###### begin =include pod2usage.PL ##### +NAME + pod2usage - print usage messages from embedded pod docs in files + +SYNOPSIS + pod2usage [-help] [-man] [-exit *exitval*] [-output *outfile*] + [-verbose *level*] [-pathlist *dirlist*] *file* + +OPTIONS AND ARGUMENTS + -help Print a brief help message and exit. + + -man Print this command's manual page and exit. + + -exit *exitval* + The exit status value to return. + + -output *outfile* + The output file to print to. If the special names "-" or ">&1" + or ">&STDOUT" are used then standard output is used. If ">&2" or + ">&STDERR" is used then standard error is used. + + -verbose *level* + The desired level of verbosity to use: + + 1 : print SYNOPSIS only + 2 : print SYNOPSIS sections and any OPTIONS/ARGUMENTS sections + 3 : print the entire manpage (similar to running pod2text) + + -pathlist *dirlist* + Specifies one or more directories to search for the input file + if it was not supplied with an absolute path. Each directory + path in the given list should be separated by a ':' on Unix (';' + on MSWin32 and DOS). + + *file* The pathname of a file containing pod documentation to be output + in usage mesage format (defaults to standard input). + +DESCRIPTION + pod2usage will read the given input file looking for pod documentation + and will print the corresponding usage message. If no input file is + specifed than standard input is read. + + pod2usage invokes the pod2usage() function in the Pod::Usage module. + Please see the pod2usage() entry in the Pod::Usage manpage. + +SEE ALSO + the Pod::Usage manpage, the pod2text(1) manpage + +AUTHOR + Brad Appleton + + Based on code for pod2text(1) written by Tom Christiansen + + +###### end =include pod2usage.PL ##### diff --git a/t/pod/poderrs.t b/t/pod/poderrs.t index 591bd2a..9f7f6bd 100755 --- a/t/pod/poderrs.t +++ b/t/pod/poderrs.t @@ -1,7 +1,7 @@ +#!./perl BEGIN { - use File::Basename; - my $THISDIR = dirname $0; - unshift @INC, $THISDIR; + chdir 't' if -d 't'; + unshift @INC, './pod', '../lib'; require "testpchk.pl"; import TestPodChecker; } @@ -36,4 +36,81 @@ Camps is very, entertaining. And they say we'll have some fun if it stops raining! +=head1 Additional tests + +=head2 item without over + +=item oops + +=head2 back without over + +=back + +=head2 over without back + +=over 4 + +=item oops + +=head2 end without begin + +=end + +=head2 begin and begin + +=begin html + +=begin text + +=end + +=end + +=head2 Nested sequences of the same type + +C>> + +=head2 Garbled entities + +E +E> +E> + +=head2 Unresolved internal links + +L +L<"end with begin"> +L + +=head2 Garbled (almost) links + +L +L<".".":"> +L<"h"/"hh"> +L + +=head2 Warnings + +L +L< some text|page/"section" > + +=over 4 + +=item bla + +=back 200 + +=begin html + +What? + +=end xml + +=over 4 + +=back + +see these unescaped < and > in the text? + =cut + diff --git a/t/pod/poderrs.xr b/t/pod/poderrs.xr index a7bc42d..70408cd 100644 --- a/t/pod/poderrs.xr +++ b/t/pod/poderrs.xr @@ -1,11 +1,35 @@ -*** ERROR: Unknown command "unknown1" at line 21 of file t/poderrs.t -*** ERROR: Unknown interior-sequence "N" at line 21 of file t/poderrs.t -*** ERROR: Unknown interior-sequence "D" at line 22 of file t/poderrs.t -*** ERROR: Unknown interior-sequence "Q" at line 25 of file t/poderrs.t -*** ERROR: Unknown interior-sequence "A" at line 26 of file t/poderrs.t -*** ERROR: Unknown interior-sequence "V" at line 27 of file t/poderrs.t -*** ERROR: Unknown interior-sequence "Y" at line 27 of file t/poderrs.t -** Unterminated B<...> at t/poderrs.t line 31 -** Unterminated I<...> at t/poderrs.t line 30 -** Unterminated C<...> at t/poderrs.t line 33 -t/poderrs.t has 10 pod syntax errors. +*** ERROR: Unknown command "unknown1" at line 21 in file pod/poderrs.t +*** ERROR: Unknown interior-sequence "N" at line 21 in file pod/poderrs.t +*** ERROR: Unknown interior-sequence "D" at line 22 in file pod/poderrs.t +*** ERROR: Unknown interior-sequence "Q" at line 25 in file pod/poderrs.t +*** ERROR: Unknown interior-sequence "A" at line 26 in file pod/poderrs.t +*** ERROR: Unknown interior-sequence "Y" at line 27 in file pod/poderrs.t +*** ERROR: Unknown interior-sequence "V" at line 27 in file pod/poderrs.t +** Unterminated B<...> at pod/poderrs.t line 31 +** Unterminated I<...> at pod/poderrs.t line 30 +** Unterminated C<...> at pod/poderrs.t line 33 +*** ERROR: =item without previous =over at line 43 in file pod/poderrs.t +*** ERROR: =back without previous =over at line 47 in file pod/poderrs.t +*** ERROR: unclosed =over (line 51) at head2 at line 55 in file pod/poderrs.t +*** WARNING: =end without =begin at line 57 in file pod/poderrs.t +*** ERROR: Nested =begin's (first at line 61:html) at line 63 in file pod/poderrs.t +*** WARNING: =end without =begin at line 67 in file pod/poderrs.t +*** ERROR: nested commands C<...C<...>...> at line 71 in file pod/poderrs.t +*** ERROR: garbled entity E at line 75 in file pod/poderrs.t +*** ERROR: garbled entity E> at line 76 in file pod/poderrs.t +*** ERROR: garbled entity E> at line 77 in file pod/poderrs.t +*** ERROR: malformed link L<>: garbled entry (spurious characters `s s / s s / ss') at line 87 in file pod/poderrs.t +*** ERROR: malformed link L<>: garbled entry (spurious characters `".".":"') at line 88 in file pod/poderrs.t +*** ERROR: malformed link L<>: garbled entry (spurious characters `"h"/"hh"') at line 89 in file pod/poderrs.t +*** WARNING: brackets in `passwd(5)' at line 94 in file pod/poderrs.t +*** WARNING: ignoring leading whitespace in link at line 95 in file pod/poderrs.t +*** WARNING: ignoring trailing whitespace in link at line 95 in file pod/poderrs.t +*** WARNING: Spurious character(s) after =back at line 101 in file pod/poderrs.t +*** WARNING: Spurious character(s) after =end at line 107 in file pod/poderrs.t +*** WARNING: No items in =over (at line 109) / =back list at line 111 in file pod/poderrs.t +*** WARNING: 2 unescaped <> at line 113 in file pod/poderrs.t +*** ERROR: unresolved internal link `begin or begin' at line 81 in file pod/poderrs.t +*** ERROR: unresolved internal link `end with begin' at line 82 in file pod/poderrs.t +*** ERROR: unresolved internal link `OoPs' at line 83 in file pod/poderrs.t +*** ERROR: unresolved internal link `b|c' at line 90 in file pod/poderrs.t +pod/poderrs.t has 25 pod syntax errors. diff --git a/t/pod/podselect.t b/t/pod/podselect.t new file mode 100755 index 0000000..30eb30c --- /dev/null +++ b/t/pod/podselect.t @@ -0,0 +1,18 @@ +#!./perl +BEGIN { + chdir 't' if -d 't'; + unshift @INC, './pod', '../lib'; + require "testp2pt.pl"; + import TestPodIncPlainText; +} + +my %options = map { $_ => 1 } @ARGV; ## convert cmdline to options-hash +my $passed = testpodplaintext \%options, $0; +exit( ($passed == 1) ? 0 : -1 ) unless $ENV{HARNESS_ACTIVE}; + + +__END__ + +=include podselect.PL + + diff --git a/t/pod/podselect.xr b/t/pod/podselect.xr new file mode 100644 index 0000000..7d1188d --- /dev/null +++ b/t/pod/podselect.xr @@ -0,0 +1,42 @@ +###### begin =include podselect.PL ##### +NAME + podselect - print selected sections of pod documentation on standard + output + +SYNOPSIS + podselect [-help] [-man] [-section *section-spec*] [*file* ...] + +OPTIONS AND ARGUMENTS + -help Print a brief help message and exit. + + -man Print the manual page and exit. + + -section *section-spec* + Specify a section to include in the output. See the section on + "SECTION SPECIFICATIONS" in the Pod::Parser manpage for the + format to use for *section-spec*. This option may be given + multiple times on the command line. + + *file* The pathname of a file from which to select sections of pod + documentation (defaults to standard input). + +DESCRIPTION + podselect will read the given input files looking for pod documentation + and will print out (in raw pod format) all sections that match one ore + more of the given section specifications. If no section specifications + are given than all pod sections encountered are output. + + podselect invokes the podselect() function exported by Pod::Select + Please see the podselect() entry in the Pod::Select manpage for more + details. + +SEE ALSO + the Pod::Parser manpage and the Pod::Select manpage + +AUTHOR + Brad Appleton + + Based on code for Pod::Text::pod2text(1) written by Tom Christiansen + + +###### end =include podselect.PL ##### diff --git a/t/pod/special_seqs.t b/t/pod/special_seqs.t index 1b31387..572fb8c 100755 --- a/t/pod/special_seqs.t +++ b/t/pod/special_seqs.t @@ -1,7 +1,7 @@ +#!./perl BEGIN { - use File::Basename; - my $THISDIR = dirname $0; - unshift @INC, $THISDIR; + chdir 't' if -d 't'; + unshift @INC, './pod', '../lib'; require "testp2pt.pl"; import TestPodIncPlainText; } diff --git a/t/pod/special_seqs.xr b/t/pod/special_seqs.xr index 6795de0..fc06593 100644 --- a/t/pod/special_seqs.xr +++ b/t/pod/special_seqs.xr @@ -1,13 +1,11 @@ - This is a test to see if I can do not only `$self' and - `method()', but also `$self->method()' and `$self->{FIELDNAME}' - and `{FOO=>BAR}' without resorting to escape sequences. + This is a test to see if I can do not only `$self' and `method()', but + also `$self->method()' and `$self->{FIELDNAME}' and `{FOO=>BAR}' without + resorting to escape sequences. - Now for the grand finale of `$self->method()->{FIELDNAME} = - {FOO=>BAR}'. + Now for the grand finale of `$self->method()->{FIELDNAME} = {FOO=>BAR}'. - Of course I should still be able to do all this *with* escape - sequences too: `$self->method()' and `$self->{FIELDNAME}' and - `{FOO=>BAR}'. + Of course I should still be able to do all this *with* escape sequences + too: `$self->method()' and `$self->{FIELDNAME}' and `{FOO=>BAR}'. Dont forget `$self->method()->{FIELDNAME} = {FOO=>BAR}'. diff --git a/t/pod/testcmp.pl b/t/pod/testcmp.pl index d61bbff..5f62171 100644 --- a/t/pod/testcmp.pl +++ b/t/pod/testcmp.pl @@ -7,6 +7,7 @@ use Carp; use Exporter; use File::Basename; use File::Spec; +use FileHandle; @ISA = qw(Exporter); @EXPORT = qw(&testcmp); diff --git a/t/pod/testp2pt.pl b/t/pod/testp2pt.pl index 9df5b9f..234a527 100644 --- a/t/pod/testp2pt.pl +++ b/t/pod/testp2pt.pl @@ -13,8 +13,6 @@ BEGIN { push @INC, map { File::Spec->catfile($_, 'lib') } ($PARENTDIR, $THISDIR); } -use Pod::PlainText; -use vars qw(@ISA @EXPORT $MYPKG); #use strict; #use diagnostics; use Carp; @@ -22,13 +20,23 @@ use Exporter; #use File::Compare; #use Cwd qw(abs_path); -@ISA = qw(Pod::PlainText); -@EXPORT = qw(&testpodplaintext); +use vars qw($MYPKG @EXPORT @ISA); $MYPKG = eval { (caller)[0] }; +@EXPORT = qw(&testpodplaintext); +BEGIN { + if ( $] >= 5.005_58 ) { + require Pod::Text; + @ISA = qw( Pod::Text ); + } + else { + require Pod::PlainText; + @ISA = qw( Pod::PlainText ); + } +} ## Hardcode settings for TERMCAP and COLUMNS so we can try to get ## reproducible results between environments -@ENV{qw(TERMCAP COLUMNS)} = ('co=72:do=^J', 72); +@ENV{qw(TERMCAP COLUMNS)} = ('co=76:do=^J', 76); sub catfile(@) { File::Spec->catfile(@_); } @@ -37,7 +45,7 @@ $INSTDIR = (dirname $INSTDIR) if (basename($INSTDIR) eq 'xtra'); $INSTDIR = (dirname $INSTDIR) if (basename($INSTDIR) eq 'pod'); $INSTDIR = (dirname $INSTDIR) if (basename($INSTDIR) eq 't'); my @PODINCDIRS = ( catfile($INSTDIR, 'lib', 'Pod'), - catfile($INSTDIR, 'scripts'), + catfile($INSTDIR, 'pod'), catfile($INSTDIR, 't', 'pod'), catfile($INSTDIR, 't', 'pod', 'xtra') ); @@ -111,7 +119,7 @@ sub testpodinc2plaintext( @ ) { return $msg; } - print "+ Running testpodinc2plaintext for '$testname'...\n"; + print "# Running testpodinc2plaintext for '$testname'...\n"; ## Compare the output against the expected result podinc2plaintext($infile, $outfile); if ( testcmp($outfile, $cmpfile) ) { @@ -145,12 +153,12 @@ sub testpodplaintext( @ ) { if ($opts{'-xrgen'}) { if ($opts{'-force'} or ! -e $cmpfile) { ## Create the comparison file - print "+ Creating expected result for \"$testname\"" . + print "# Creating expected result for \"$testname\"" . " pod2plaintext test ...\n"; podinc2plaintext($podfile, $cmpfile); } else { - print "+ File $cmpfile already exists" . + print "# File $cmpfile already exists" . " (use '-force' to regenerate it).\n"; } next; @@ -162,13 +170,13 @@ sub testpodplaintext( @ ) { -Cmp => $cmpfile; if ($failmsg) { ++$failed; - print "+\tFAILED. ($failmsg)\n"; + print "#\tFAILED. ($failmsg)\n"; print "not ok ", $failed+$passes, "\n"; } else { ++$passes; unlink($outfile); - print "+\tPASSED.\n"; + print "#\tPASSED.\n"; print "ok ", $failed+$passes, "\n"; } } diff --git a/t/pod/testpchk.pl b/t/pod/testpchk.pl index cd3c138..640226b 100644 --- a/t/pod/testpchk.pl +++ b/t/pod/testpchk.pl @@ -30,20 +30,7 @@ sub stripname( $ ) { } sub msgcmp( $ $ ) { - ## filter out platform-dependent aspects of error messages my ($line1, $line2) = @_; - for ($line1, $line2) { - if ( /^#*\s*(\S.*?)\s+(?:has \d+\s*)?pod syntax (?:error|OK)/ ) { - my $fname = $1; - s/^#*\s*// if ($^O eq 'MacOS'); - s/^\s*\Q$fname\E/stripname($fname)/e; - } - elsif ( /^#*\s*\*+\s*(?:ERROR|Unterminated)/ ) { - s/^#*\s*// if ($^O eq 'MacOS'); - s/of file\s+(\S.*?)\s*$/"of file ".stripname($1)/e; - s/at\s+(\S.*?)\s+line/"at ".stripname($1)." line"/e; - } - } return $line1 ne $line2; } @@ -62,7 +49,7 @@ sub testpodcheck( @ ) { return $msg; } - print "+ Running podchecker for '$testname'...\n"; + print "# Running podchecker for '$testname'...\n"; ## Compare the output against the expected result podchecker($infile, $outfile); if ( testcmp({'-cmplines' => \&msgcmp}, $outfile, $cmpfile) ) { @@ -96,12 +83,12 @@ sub testpodchecker( @ ) { if ($opts{'-xrgen'}) { if ($opts{'-force'} or ! -e $cmpfile) { ## Create the comparison file - print "+ Creating expected result for \"$testname\"" . + print "# Creating expected result for \"$testname\"" . " podchecker test ...\n"; podchecker($podfile, $cmpfile); } else { - print "+ File $cmpfile already exists" . + print "# File $cmpfile already exists" . " (use '-force' to regenerate it).\n"; } next; @@ -113,13 +100,13 @@ sub testpodchecker( @ ) { -Cmp => $cmpfile; if ($failmsg) { ++$failed; - print "+\tFAILED. ($failmsg)\n"; + print "#\tFAILED. ($failmsg)\n"; print "not ok ", $failed+$passes, "\n"; } else { ++$passes; unlink($outfile); - print "+\tPASSED.\n"; + print "#\tPASSED.\n"; print "ok ", $failed+$passes, "\n"; } } diff --git a/t/pragma/constant.t b/t/pragma/constant.t index 15ce319..5904a4f 100755 --- a/t/pragma/constant.t +++ b/t/pragma/constant.t @@ -14,9 +14,9 @@ END { print @warnings } ######################### We start with some black magic to print on failure. -BEGIN { $| = 1; print "1..46\n"; } +BEGIN { $| = 1; print "1..58\n"; } END {print "not ok 1\n" unless $loaded;} -use constant; +use constant 1.01; $loaded = 1; #print "# Version: $constant::VERSION\n"; print "ok 1\n"; @@ -151,7 +151,46 @@ print CHASH->{foo}; print CARRAY->[1]; print CPHASH->{foo}; eval q{ CPHASH->{bar} }; -test 44, scalar($@ =~ /^No such array/); +test 44, scalar($@ =~ /^No such pseudo-hash field/); print CCODE->(45); eval q{ CCODE->{foo} }; test 46, scalar($@ =~ /^Constant is not a HASH/); + +# Allow leading underscore +use constant _PRIVATE => 47; +test 47, _PRIVATE == 47; + +# Disallow doubled leading underscore +eval q{ + use constant __DISALLOWED => "Oops"; +}; +test 48, $@ =~ /begins with '__'/; + +# Check on declared() and %declared. This sub should be EXACTLY the +# same as the one quoted in the docs! +sub declared ($) { + use constant 1.01; # don't omit this! + my $name = shift; + $name =~ s/^::/main::/; + my $pkg = caller; + my $full_name = $name =~ /::/ ? $name : "${pkg}::$name"; + $constant::declared{$full_name}; +} + +test 49, declared 'PI'; +test 50, $constant::declared{'main::PI'}; + +test 51, !declared 'PIE'; +test 52, !$constant::declared{'main::PIE'}; + +{ + package Other; + use constant IN_OTHER_PACK => 42; + ::test 53, ::declared 'IN_OTHER_PACK'; + ::test 54, $constant::declared{'Other::IN_OTHER_PACK'}; + ::test 55, ::declared 'main::PI'; + ::test 56, $constant::declared{'main::PI'}; +} + +test 57, declared 'Other::IN_OTHER_PACK'; +test 58, $constant::declared{'Other::IN_OTHER_PACK'}; diff --git a/t/pragma/locale.t b/t/pragma/locale.t index c453c47..7642678 100755 --- a/t/pragma/locale.t +++ b/t/pragma/locale.t @@ -286,6 +286,11 @@ Turkish:tr:tr:9 turkish8 Yiddish:::1 15 EOF +if ($^O eq 'os390') { + $locales =~ s/Svenska Swedish:sv:fi se:1 15\n//; + $locales =~ s/Thai:th:th:11 tis620\n//; +} + sub in_utf8 () { $^H & 0x08 } if (in_utf8) { @@ -323,6 +328,9 @@ sub decode_encodings { push @enc, $_; } } + if ($^O eq 'os390') { + push @enc, qw(IBM-037 IBM-819 IBM-1047); + } return @enc; } diff --git a/t/pragma/overload.t b/t/pragma/overload.t index ff8d805..f9a9c59 100755 --- a/t/pragma/overload.t +++ b/t/pragma/overload.t @@ -712,7 +712,14 @@ test($c, "bareword"); # 135 sub new { my ($p, $v) = @_; bless \$v, $p } sub iter { my ($x) = @_; return undef if $$x < 0; return $$x--; } } -{ + +# XXX iterator overload not intended to work with CORE::GLOBAL? +if (defined &CORE::GLOBAL::glob) { + test '1', '1'; # 175 + test '1', '1'; # 176 + test '1', '1'; # 177 +} +else { my $iter = iterator->new(5); my $acc = ''; my $out; @@ -752,7 +759,12 @@ test($c, "bareword"); # 135 }, 'deref'; # Hash: my @cont = sort %$deref; - test "@cont", '23 5 fake foo'; # 178 + if ("\t" eq "\011") { # ascii + test "@cont", '23 5 fake foo'; # 178 + } + else { # ebcdic alpha-numeric sort order + test "@cont", 'fake foo 23 5'; # 178 + } my @keys = sort keys %$deref; test "@keys", 'fake foo'; # 179 my @val = sort values %$deref; diff --git a/t/pragma/strict-subs b/t/pragma/strict-subs index deeb381..ed4fe7a 100644 --- a/t/pragma/strict-subs +++ b/t/pragma/strict-subs @@ -33,6 +33,24 @@ Execution of - aborted due to compilation errors. ######## # strict subs - error +use strict 'subs' ; +my @a = (A..Z); +EXPECT +Bareword "Z" not allowed while "strict subs" in use at - line 4. +Bareword "A" not allowed while "strict subs" in use at - line 4. +Execution of - aborted due to compilation errors. +######## + +# strict subs - error +use strict 'subs' ; +my $a = (B..Y); +EXPECT +Bareword "Y" not allowed while "strict subs" in use at - line 4. +Bareword "B" not allowed while "strict subs" in use at - line 4. +Execution of - aborted due to compilation errors. +######## + +# strict subs - error use strict ; Fred ; EXPECT diff --git a/t/pragma/strict-vars b/t/pragma/strict-vars index b8108d2..dc11f5d 100644 --- a/t/pragma/strict-vars +++ b/t/pragma/strict-vars @@ -307,3 +307,35 @@ print our $fred,"\n"; EXPECT 2 1 +######## + +# "nailed" our declaration visibility across package boundaries +use strict 'vars'; +our $foo; +$foo = 20; +package Foo; +print $foo, "\n"; +EXPECT +20 +######## + +# multiple our declarations in same scope, different packages, no warning +use strict 'vars'; +use warnings; +our $foo; +${foo} = 10; +package Foo; +our $foo = 20; +print $foo, "\n"; +EXPECT +20 +######## + +# multiple our declarations in same scope, same package, warning +use strict 'vars'; +use warnings; +our $foo; +${foo} = 10; +our $foo; +EXPECT +"our" variable $foo masks earlier declaration in same scope at - line 7. diff --git a/t/pragma/sub_lval.t b/t/pragma/sub_lval.t index c382ad5..e96c329 100755 --- a/t/pragma/sub_lval.t +++ b/t/pragma/sub_lval.t @@ -5,8 +5,8 @@ BEGIN { unshift @INC, '../lib'; } -sub a {use attrs 'lvalue'; my $a = 34; bless \$a} # Return a temporary -sub b {use attrs 'lvalue'; shift} +sub a : lvalue { my $a = 34; bless \$a } # Return a temporary +sub b : lvalue { shift } my $out = a(b()); # Check that temporaries are allowed. print "# `$out'\nnot " unless ref $out eq 'main'; # Not reached if error. @@ -20,8 +20,8 @@ my $in; # Check that we can return localized values from subroutines: -sub in {use attrs 'lvalue'; $in = shift;} -sub neg {use attrs 'lvalue'; #(num_str) return num_str +sub in : lvalue { $in = shift; } +sub neg : lvalue { #(num_str) return num_str local $_ = shift; s/^\+/-/; $_; @@ -32,11 +32,11 @@ in(neg("+2")); print "# `$in'\nnot " unless $in eq '-2'; print "ok 3\n"; -sub get_lex {use attrs 'lvalue'; $in} -sub get_st {use attrs 'lvalue'; $blah} -sub id {use attrs 'lvalue'; shift} -sub id1 {use attrs 'lvalue'; $_[0]} -sub inc {use attrs 'lvalue'; ++$_[0]} +sub get_lex : lvalue { $in } +sub get_st : lvalue { $blah } +sub id : lvalue { shift } +sub id1 : lvalue { $_[0] } +sub inc : lvalue { ++$_[0] } $in = 5; $blah = 3; @@ -139,9 +139,9 @@ $#c = 3; # These slots are not fillable. =for disabled constructs -sub a3 {use attrs 'lvalue'; @a} -sub b2 {use attrs 'lvalue'; @b} -sub c4 {use attrs 'lvalue'; @c} +sub a3 :lvalue {@a} +sub b2 : lvalue {@b} +sub c4: lvalue {@c} $_ = ''; @@ -162,7 +162,7 @@ print "ok 22\n"; my $var; -sub a::var {use attrs 'lvalue'; $var} +sub a::var : lvalue { $var } "a"->var = 45; @@ -177,7 +177,7 @@ $o->var = 47; print "# `$var' ne 47\nnot " unless $var eq 47; print "ok 24\n"; -sub o {use attrs 'lvalue'; $o} +sub o : lvalue { $o } o->var = 49; @@ -242,7 +242,7 @@ print "# '$_', '$x0', '$x1'.\nnot " unless /Can\'t modify non-lvalue subroutine call/; print "ok 30\n"; -sub lv0 {use attrs 'lvalue';} # Converted to lv10 in scalar context +sub lv0 : lvalue { } # Converted to lv10 in scalar context $_ = undef; eval <<'EOE' or $_ = $@; @@ -254,7 +254,7 @@ print "# '$_'.\nnot " unless /Can\'t return a readonly value from lvalue subroutine/; print "ok 31\n"; -sub lv10 {use attrs 'lvalue';} +sub lv10 : lvalue {} $_ = undef; eval <<'EOE' or $_ = $@; @@ -265,7 +265,7 @@ EOE print "# '$_'.\nnot " if defined $_; print "ok 32\n"; -sub lv1u {use attrs 'lvalue'; undef } +sub lv1u :lvalue { undef } $_ = undef; eval <<'EOE' or $_ = $@; @@ -288,7 +288,7 @@ print "# '$_'.\nnot " print "ok 34\n"; $x = '1234567'; -sub lv1t {use attrs 'lvalue'; index $x, 2 } +sub lv1t : lvalue { index $x, 2 } $_ = undef; eval <<'EOE' or $_ = $@; @@ -312,7 +312,7 @@ print "ok 36\n"; $xxx = 'xxx'; sub xxx () { $xxx } # Not lvalue -sub lv1tmp {use attrs 'lvalue'; xxx } # is it a TEMP? +sub lv1tmp : lvalue { xxx } # is it a TEMP? $_ = undef; eval <<'EOE' or $_ = $@; @@ -335,7 +335,7 @@ print "# '$_'.\nnot " print "ok 38\n"; sub xxx () { 'xxx' } # Not lvalue -sub lv1tmpr {use attrs 'lvalue'; xxx } # is it a TEMP? +sub lv1tmpr : lvalue { xxx } # is it a TEMP? $_ = undef; eval <<'EOE' or $_ = $@; @@ -359,7 +359,7 @@ print "ok 40\n"; =for disabled constructs -sub lva {use attrs 'lvalue';@a} +sub lva : lvalue {@a} $_ = undef; @a = (); @@ -401,7 +401,7 @@ print "ok 43\n"; print "ok $_\n" for 41..43; -sub lv1n {use attrs 'lvalue'; $newvar } +sub lv1n : lvalue { $newvar } $_ = undef; eval <<'EOE' or $_ = $@; @@ -412,7 +412,7 @@ EOE print "# '$_', '$newvar'.\nnot " unless "'$newvar' $_" eq "'4' "; print "ok 44\n"; -sub lv1nn {use attrs 'lvalue'; $nnewvar } +sub lv1nn : lvalue { $nnewvar } $_ = undef; eval <<'EOE' or $_ = $@; diff --git a/t/pragma/utf8.t b/t/pragma/utf8.t index 01b0f05..2ae8d9c 100755 --- a/t/pragma/utf8.t +++ b/t/pragma/utf8.t @@ -4,6 +4,10 @@ BEGIN { chdir 't' if -d 't'; unshift @INC, '../lib'; $ENV{PERL5LIB} = '../lib'; + if ( ord("\t") != 9 ) { # skip on ebcdic platforms + print "1..0 # Skip utf8 tests on ebcdic platform.\n"; + exit; + } } print "1..12\n"; diff --git a/t/pragma/warn/1global b/t/pragma/warn/1global index 836b7f5..0af8022 100644 --- a/t/pragma/warn/1global +++ b/t/pragma/warn/1global @@ -43,7 +43,7 @@ EXPECT $^W = 1 ; my $b ; chop $b ; EXPECT -Use of uninitialized value at - line 4. +Use of uninitialized value in scalar chop at - line 4. ######## # warnings enabled at compile time, disabled at run time @@ -59,7 +59,7 @@ BEGIN { $^W = 0 } $^W = 1 ; my $b ; chop $b ; EXPECT -Use of uninitialized value at - line 5. +Use of uninitialized value in scalar chop at - line 5. ######## -w --FILE-- abcd @@ -68,7 +68,7 @@ my $b ; chop $b ; --FILE-- require "./abcd"; EXPECT -Use of uninitialized value at ./abcd line 1. +Use of uninitialized value in scalar chop at ./abcd line 1. ######## --FILE-- abcd @@ -78,7 +78,7 @@ my $b ; chop $b ; #! perl -w require "./abcd"; EXPECT -Use of uninitialized value at ./abcd line 1. +Use of uninitialized value in scalar chop at ./abcd line 1. ######## --FILE-- abcd @@ -88,7 +88,7 @@ my $b ; chop $b ; $^W =1 ; require "./abcd"; EXPECT -Use of uninitialized value at ./abcd line 1. +Use of uninitialized value in scalar chop at ./abcd line 1. ######## --FILE-- abcd @@ -110,28 +110,28 @@ $^W =0 ; require "./abcd"; my $b ; chop $b ; EXPECT -Use of uninitialized value at - line 3. +Use of uninitialized value in scalar chop at - line 3. ######## $^W = 1; eval 'my $b ; chop $b ;' ; print $@ ; EXPECT -Use of uninitialized value at (eval 1) line 1. +Use of uninitialized value in scalar chop at (eval 1) line 1. ######## eval '$^W = 1;' ; print $@ ; my $b ; chop $b ; EXPECT -Use of uninitialized value at - line 4. +Use of uninitialized value in scalar chop at - line 4. ######## eval {$^W = 1;} ; print $@ ; my $b ; chop $b ; EXPECT -Use of uninitialized value at - line 4. +Use of uninitialized value in scalar chop at - line 4. ######## { @@ -149,12 +149,12 @@ my $a ; chop $a ; } my $c ; chop $c ; EXPECT -Use of uninitialized value at - line 5. +Use of uninitialized value in scalar chop at - line 5. ######## -w -e undef EXPECT -Use of uninitialized value at - line 2. +Use of uninitialized value in -e at - line 2. ######## $^W = 1 + 2 ; @@ -186,4 +186,4 @@ sub fred { my $b ; chop $b ;} fred() ; } EXPECT -Use of uninitialized value at - line 2. +Use of uninitialized value in scalar chop at - line 2. diff --git a/t/pragma/warn/2use b/t/pragma/warn/2use index 4ec4da0..384b3b3 100644 --- a/t/pragma/warn/2use +++ b/t/pragma/warn/2use @@ -42,7 +42,7 @@ use warnings 'uninitialized' ; } my $b ; chop $b ; EXPECT -Use of uninitialized value at - line 8. +Use of uninitialized value in scalar chop at - line 8. ######## # Check runtime scope of pragma @@ -53,7 +53,7 @@ no warnings ; } my $b ; chop $b ; EXPECT -Use of uninitialized value at - line 6. +Use of uninitialized value in scalar chop at - line 6. ######## # Check runtime scope of pragma @@ -64,7 +64,7 @@ no warnings ; } &$a ; EXPECT -Use of uninitialized value at - line 6. +Use of uninitialized value in scalar chop at - line 6. ######## use warnings 'deprecated' ; @@ -103,7 +103,7 @@ require "./abc"; my $a ; chop $a ; EXPECT Use of EQ is deprecated at ./abc line 2. -Use of uninitialized value at - line 3. +Use of uninitialized value in scalar chop at - line 3. ######## --FILE-- abc.pm @@ -116,7 +116,7 @@ use abc; my $a ; chop $a ; EXPECT Use of EQ is deprecated at abc.pm line 2. -Use of uninitialized value at - line 3. +Use of uninitialized value in scalar chop at - line 3. ######## # Check scope of pragma with eval @@ -137,7 +137,7 @@ eval { }; print STDERR $@ ; my $b ; chop $b ; EXPECT -Use of uninitialized value at - line 6. +Use of uninitialized value in scalar chop at - line 6. ######## # Check scope of pragma with eval @@ -147,8 +147,8 @@ eval { }; print STDERR $@ ; my $b ; chop $b ; EXPECT -Use of uninitialized value at - line 5. -Use of uninitialized value at - line 7. +Use of uninitialized value in scalar chop at - line 5. +Use of uninitialized value in scalar chop at - line 7. ######## # Check scope of pragma with eval @@ -159,7 +159,7 @@ eval { }; print STDERR $@ ; my $b ; chop $b ; EXPECT -Use of uninitialized value at - line 8. +Use of uninitialized value in scalar chop at - line 8. ######## # Check scope of pragma with eval @@ -223,7 +223,7 @@ eval q[ ]; print STDERR $@; my $b ; chop $b ; EXPECT -Use of uninitialized value at (eval 1) line 3. +Use of uninitialized value in scalar chop at (eval 1) line 3. ######## # Check scope of pragma with eval @@ -233,8 +233,8 @@ eval ' '; print STDERR $@ ; my $b ; chop $b ; EXPECT -Use of uninitialized value at (eval 1) line 2. -Use of uninitialized value at - line 7. +Use of uninitialized value in scalar chop at (eval 1) line 2. +Use of uninitialized value in scalar chop at - line 7. ######## # Check scope of pragma with eval @@ -245,7 +245,7 @@ eval ' '; print STDERR $@ ; my $b ; chop $b ; EXPECT -Use of uninitialized value at - line 8. +Use of uninitialized value in scalar chop at - line 8. ######## # Check scope of pragma with eval @@ -303,6 +303,6 @@ no warnings 'deprecated' ; 1 if $a EQ $b ; EXPECT Use of EQ is deprecated at - line 6. -Use of uninitialized value at - line 9. -Use of uninitialized value at - line 11. -Use of uninitialized value at - line 11. +Use of uninitialized value in scalar chop at - line 9. +Use of uninitialized value in string eq at - line 11. +Use of uninitialized value in string eq at - line 11. diff --git a/t/pragma/warn/3both b/t/pragma/warn/3both index 592724a..132b99b 100644 --- a/t/pragma/warn/3both +++ b/t/pragma/warn/3both @@ -13,7 +13,7 @@ sub fred { } EXPECT -Use of uninitialized value at - line 6. +Use of uninitialized value in scalar chop at - line 6. ######## # Check interaction of $^W and use warnings @@ -27,7 +27,7 @@ sub fred { } EXPECT -Use of uninitialized value at - line 6. +Use of uninitialized value in scalar chop at - line 6. ######## # Check interaction of $^W and use warnings @@ -64,7 +64,7 @@ $^W = 1 ; my $b ; chop $b ; EXPECT -Use of uninitialized value at - line 6. +Use of uninitialized value in scalar chop at - line 6. ######## # Check interaction of $^W and use warnings @@ -73,7 +73,7 @@ use warnings ; my $b ; chop $b ; EXPECT -Use of uninitialized value at - line 6. +Use of uninitialized value in scalar chop at - line 6. ######## # Check interaction of $^W and use warnings @@ -107,7 +107,7 @@ use warnings ; my $b ; chop $b ; EXPECT -Use of uninitialized value at - line 5. +Use of uninitialized value in scalar chop at - line 5. ######## # Check interaction of $^W and use warnings @@ -119,7 +119,7 @@ sub fred { BEGIN { $^W = 0 } fred() ; EXPECT -Use of uninitialized value at - line 6. +Use of uninitialized value in scalar chop at - line 6. ######## # Check interaction of $^W and use warnings @@ -141,7 +141,7 @@ BEGIN { $^W = 1 } my $b ; chop $b ; EXPECT -Use of uninitialized value at - line 6. +Use of uninitialized value in scalar chop at - line 6. ######## # Check interaction of $^W and use warnings @@ -150,7 +150,7 @@ use warnings ; my $b ; chop $b ; EXPECT -Use of uninitialized value at - line 6. +Use of uninitialized value in scalar chop at - line 6. ######## # Check interaction of $^W and use warnings @@ -181,7 +181,7 @@ BEGIN { $^W = 1 } my $b ; chop $b ; EXPECT -Use of uninitialized value at - line 10. +Use of uninitialized value in scalar chop at - line 10. ######## # Check interaction of $^W and use warnings @@ -194,4 +194,4 @@ BEGIN { $^W = 0 } my $b ; chop $b ; EXPECT -Use of uninitialized value at - line 7. +Use of uninitialized value in scalar chop at - line 7. diff --git a/t/pragma/warn/4lint b/t/pragma/warn/4lint index 6a08409..db54f31 100644 --- a/t/pragma/warn/4lint +++ b/t/pragma/warn/4lint @@ -9,14 +9,14 @@ $a = 1 if $a EQ $b ; close STDIN ; print STDIN "abc" ; EXPECT Use of EQ is deprecated at - line 5. -print on closed filehandle main::STDIN at - line 6. +print() on closed filehandle main::STDIN at - line 6. ######## -W # lint: check runtime $^W is zapped $^W = 0 ; close STDIN ; print STDIN "abc" ; EXPECT -print on closed filehandle main::STDIN at - line 4. +print() on closed filehandle main::STDIN at - line 4. ######## -W # lint: check runtime $^W is zapped @@ -25,7 +25,7 @@ print on closed filehandle main::STDIN at - line 4. close STDIN ; print STDIN "abc" ; } EXPECT -print on closed filehandle main::STDIN at - line 5. +print() on closed filehandle main::STDIN at - line 5. ######## -W # lint: check "no warnings" is zapped @@ -35,7 +35,7 @@ $a = 1 if $a EQ $b ; close STDIN ; print STDIN "abc" ; EXPECT Use of EQ is deprecated at - line 5. -print on closed filehandle main::STDIN at - line 6. +print() on closed filehandle main::STDIN at - line 6. ######## -W # lint: check "no warnings" is zapped @@ -44,7 +44,7 @@ print on closed filehandle main::STDIN at - line 6. close STDIN ; print STDIN "abc" ; } EXPECT -print on closed filehandle main::STDIN at - line 5. +print() on closed filehandle main::STDIN at - line 5. ######## -Ww # lint: check combination of -w and -W @@ -53,7 +53,7 @@ print on closed filehandle main::STDIN at - line 5. close STDIN ; print STDIN "abc" ; } EXPECT -print on closed filehandle main::STDIN at - line 5. +print() on closed filehandle main::STDIN at - line 5. ######## -W --FILE-- abc.pm @@ -67,7 +67,7 @@ use abc; my $a ; chop $a ; EXPECT Use of EQ is deprecated at abc.pm line 3. -Use of uninitialized value at - line 3. +Use of uninitialized value in scalar chop at - line 3. ######## -W --FILE-- abc @@ -81,7 +81,7 @@ require "./abc"; my $a ; chop $a ; EXPECT Use of EQ is deprecated at ./abc line 3. -Use of uninitialized value at - line 3. +Use of uninitialized value in scalar chop at - line 3. ######## -W --FILE-- abc.pm @@ -95,7 +95,7 @@ use abc; my $a ; chop $a ; EXPECT Use of EQ is deprecated at abc.pm line 3. -Use of uninitialized value at - line 3. +Use of uninitialized value in scalar chop at - line 3. ######## -W --FILE-- abc @@ -109,4 +109,4 @@ require "./abc"; my $a ; chop $a ; EXPECT Use of EQ is deprecated at ./abc line 3. -Use of uninitialized value at - line 3. +Use of uninitialized value in scalar chop at - line 3. diff --git a/t/pragma/warn/7fatal b/t/pragma/warn/7fatal index fe94511..943bb06 100644 --- a/t/pragma/warn/7fatal +++ b/t/pragma/warn/7fatal @@ -23,7 +23,7 @@ use warnings FATAL => 'uninitialized' ; my $b ; chop $b ; print STDERR "The End.\n" ; EXPECT -Use of uninitialized value at - line 8. +Use of uninitialized value in scalar chop at - line 8. ######## # Check runtime scope of pragma @@ -35,7 +35,7 @@ no warnings ; &$a ; print STDERR "The End.\n" ; EXPECT -Use of uninitialized value at - line 6. +Use of uninitialized value in scalar chop at - line 6. ######## --FILE-- abc @@ -69,7 +69,7 @@ my $a ; chop $a ; print STDERR "The End.\n" ; EXPECT Use of EQ is deprecated at ./abc line 2. -Use of uninitialized value at - line 3. +Use of uninitialized value in scalar chop at - line 3. ######## --FILE-- abc.pm @@ -83,7 +83,7 @@ my $a ; chop $a ; print STDERR "The End.\n" ; EXPECT Use of EQ is deprecated at abc.pm line 2. -Use of uninitialized value at - line 3. +Use of uninitialized value in scalar chop at - line 3. ######## # Check scope of pragma with eval @@ -95,7 +95,7 @@ eval { my $b ; chop $b ; print STDERR "The End.\n" ; EXPECT --- Use of uninitialized value at - line 6. +-- Use of uninitialized value in scalar chop at - line 6. The End. ######## @@ -107,8 +107,8 @@ eval { my $b ; chop $b ; print STDERR "The End.\n" ; EXPECT --- Use of uninitialized value at - line 5. -Use of uninitialized value at - line 7. +-- Use of uninitialized value in scalar chop at - line 5. +Use of uninitialized value in scalar chop at - line 7. ######## # Check scope of pragma with eval @@ -120,7 +120,7 @@ eval { my $b ; chop $b ; print STDERR "The End.\n" ; EXPECT -Use of uninitialized value at - line 8. +Use of uninitialized value in scalar chop at - line 8. ######## # Check scope of pragma with eval @@ -178,7 +178,7 @@ eval q[ my $b ; chop $b ; print STDERR "The End.\n" ; EXPECT --- Use of uninitialized value at (eval 1) line 3. +-- Use of uninitialized value in scalar chop at (eval 1) line 3. The End. ######## @@ -190,8 +190,8 @@ eval ' my $b ; chop $b ; print STDERR "The End.\n" ; EXPECT --- Use of uninitialized value at (eval 1) line 2. -Use of uninitialized value at - line 7. +-- Use of uninitialized value in scalar chop at (eval 1) line 2. +Use of uninitialized value in scalar chop at - line 7. ######## # Check scope of pragma with eval @@ -203,7 +203,7 @@ eval ' my $b ; chop $b ; print STDERR "The End.\n" ; EXPECT -Use of uninitialized value at - line 8. +Use of uninitialized value in scalar chop at - line 8. ######## # Check scope of pragma with eval diff --git a/t/pragma/warn/doio b/t/pragma/warn/doio index 5101bde..57dd993 100644 --- a/t/pragma/warn/doio +++ b/t/pragma/warn/doio @@ -1,6 +1,6 @@ doio.c - Can't do bidirectional pipe [Perl_do_open9] + Can't open bidirectional pipe [Perl_do_open9] open(F, "| true |"); Missing command in piped open [Perl_do_open9] @@ -64,7 +64,7 @@ no warnings 'io' ; open(G, '|'.($^O eq 'VMS' ? 'mcr ':'')."$^X -e 1|"); close(G); EXPECT -Can't do bidirectional pipe at - line 3. +Can't open bidirectional pipe at - line 3. ######## # doio.c [Perl_do_open9] use warnings 'io' ; @@ -123,7 +123,7 @@ print $a ; no warnings 'uninitialized' ; print $b ; EXPECT -Use of uninitialized value at - line 3. +Use of uninitialized value in print at - line 3. ######## # doio.c [Perl_my_stat Perl_my_lstat] use warnings 'io' ; diff --git a/t/pragma/warn/doop b/t/pragma/warn/doop index 961d157..cce6bdc 100644 --- a/t/pragma/warn/doop +++ b/t/pragma/warn/doop @@ -12,6 +12,12 @@ EXPECT Malformed UTF-8 character at - line 4. ######## # doop.c +BEGIN { + if (ord("\t") == 5) { + print "SKIPPED\n# Character codes differ on ebcdic machines."; + exit 0; + } +} use warnings 'utf8' ; use utf8 ; $_ = "\x80 \xff" ; @@ -20,6 +26,6 @@ no warnings 'utf8' ; $_ = "\x80 \xff" ; chop ; EXPECT -\x80 will produce malformed UTF-8 character; use \x{80} for that at - line 4. -\xff will produce malformed UTF-8 character; use \x{ff} for that at - line 4. -Malformed UTF-8 character at - line 5. +\x80 will produce malformed UTF-8 character; use \x{80} for that at - line 10. +\xff will produce malformed UTF-8 character; use \x{ff} for that at - line 10. +Malformed UTF-8 character at - line 11. diff --git a/t/pragma/warn/op b/t/pragma/warn/op index 950c0c8..9a278ef 100644 --- a/t/pragma/warn/op +++ b/t/pragma/warn/op @@ -558,7 +558,7 @@ Useless use of a constant in void context at - line 3. Useless use of a constant in void context at - line 4. ######## # op.c -$ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3; # known scalar leak +BEGIN{ $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3; } # known scalar leak use warnings 'unsafe' ; my $a ; my @a = () ; my %a = () ; my $b = \@a ; my $c = \%a ; @a =~ /abc/ ; diff --git a/t/pragma/warn/pp b/t/pragma/warn/pp index 48b5ec8..eb09e05 100644 --- a/t/pragma/warn/pp +++ b/t/pragma/warn/pp @@ -85,7 +85,7 @@ my $b = $$a; no warnings 'uninitialized' ; my $c = $$a; EXPECT -Use of uninitialized value at - line 4. +Use of uninitialized value in scalar dereference at - line 4. ######## # pp.c use warnings 'unsafe' ; @@ -112,6 +112,12 @@ EXPECT Malformed UTF-8 character at - line 4. ######## # pp.c +BEGIN { + if (ord("\t") == 5) { + print "SKIPPED\n# Character codes differ on ebcdic machines."; + exit 0; + } +} use warnings 'utf8' ; use utf8 ; $_ = "\x80 \xff" ; @@ -120,6 +126,6 @@ no warnings 'utf8' ; $_ = "\x80 \xff" ; reverse ; EXPECT -\x80 will produce malformed UTF-8 character; use \x{80} for that at - line 4. -\xff will produce malformed UTF-8 character; use \x{ff} for that at - line 4. -Malformed UTF-8 character at - line 5. +\x80 will produce malformed UTF-8 character; use \x{80} for that at - line 10. +\xff will produce malformed UTF-8 character; use \x{ff} for that at - line 10. +Malformed UTF-8 character at - line 11. diff --git a/t/pragma/warn/pp_ctl b/t/pragma/warn/pp_ctl index 70e6d60..f61da1a 100644 --- a/t/pragma/warn/pp_ctl +++ b/t/pragma/warn/pp_ctl @@ -126,7 +126,7 @@ no warnings 'unsafe' ; @b = sort { last } @a ; EXPECT Exiting pseudo-block via last at - line 4. -Can't "last" outside a block at - line 4. +Can't "last" outside a loop block at - line 4. ######## # pp_ctl.c use warnings 'unsafe' ; diff --git a/t/pragma/warn/pp_hot b/t/pragma/warn/pp_hot index 9a4b0a0..7e19dc5 100644 --- a/t/pragma/warn/pp_hot +++ b/t/pragma/warn/pp_hot @@ -9,7 +9,7 @@ Filehandle %s opened only for output [pp_print] print ; - print on closed filehandle %s [pp_print] + print() on closed filehandle %s [pp_print] close STDIN ; print STDIN "abc" ; uninitialized [pp_rv2av] @@ -30,7 +30,7 @@ glob failed (can't start child: %s) [Perl_do_readline] <; glob failed (child exited with status %d%s) [Perl_do_readline] < ; no warnings 'closed' ; $a = ; EXPECT -Read on closed filehandle main::STDIN at - line 3. +readline() on closed filehandle main::STDIN at - line 3. ######## # pp_hot.c [Perl_do_readline] use warnings 'io' ; diff --git a/t/pragma/warn/pp_sys b/t/pragma/warn/pp_sys index 651cdf9..ea4b536 100644 --- a/t/pragma/warn/pp_sys +++ b/t/pragma/warn/pp_sys @@ -8,7 +8,7 @@ . write STDIN; - Write on closed filehandle %s [pp_leavewrite] + write() on closed filehandle %s [pp_leavewrite] format STDIN = . close STDIN; @@ -23,45 +23,47 @@ $a = "abc"; printf $a "fred" - printf on closed filehandle %s [pp_prtf] + printf() on closed filehandle %s [pp_prtf] close STDIN ; printf STDIN "fred" - Syswrite on closed filehandle [pp_send] + syswrite() on closed filehandle [pp_send] close STDIN; syswrite STDIN, "fred", 1; - Send on closed socket [pp_send] + send() on closed socket [pp_send] close STDIN; send STDIN, "fred", 1 - bind() on closed fd [pp_bind] + bind() on closed socket [pp_bind] close STDIN; bind STDIN, "fred" ; - connect() on closed fd [pp_connect] + connect() on closed socket [pp_connect] close STDIN; connect STDIN, "fred" ; - listen() on closed fd [pp_listen] + listen() on closed socket [pp_listen] close STDIN; listen STDIN, 2; - accept() on closed fd [pp_accept] + accept() on closed socket [pp_accept] close STDIN; accept STDIN, "fred" ; - shutdown() on closed fd [pp_shutdown] + shutdown() on closed socket [pp_shutdown] close STDIN; shutdown STDIN, 0; - [gs]etsockopt() on closed fd [pp_ssockopt] + setsockopt() on closed socket [pp_ssockopt] + getsockopt() on closed socket [pp_ssockopt] close STDIN; setsockopt STDIN, 1,2,3; getsockopt STDIN, 1,2; - get{sock, peer}name() on closed fd [pp_getpeername] + getsockname() on closed socket [pp_getpeername] + getpeername() on closed socket [pp_getpeername] close STDIN; getsockname STDIN; getpeername STDIN; @@ -112,7 +114,7 @@ write STDIN; no warnings 'closed' ; write STDIN; EXPECT -Write on closed filehandle main::STDIN at - line 6. +write() on closed filehandle main::STDIN at - line 6. ######## # pp_sys.c [pp_leavewrite] use warnings 'io' ; @@ -148,7 +150,7 @@ printf STDIN "fred"; no warnings 'closed' ; printf STDIN "fred"; EXPECT -printf on closed filehandle main::STDIN at - line 4. +printf() on closed filehandle main::STDIN at - line 4. ######## # pp_sys.c [pp_prtf] use warnings 'io' ; @@ -165,7 +167,7 @@ syswrite STDIN, "fred", 1; no warnings 'closed' ; syswrite STDIN, "fred", 1; EXPECT -Syswrite on closed filehandle at - line 4. +syswrite() on closed filehandle at - line 4. ######## # pp_sys.c [pp_prtf pp_send pp_bind pp_connect pp_listen pp_accept pp_shutdown pp_ssockopt ppp_getpeername] use warnings 'io' ; @@ -210,16 +212,16 @@ getsockopt STDIN, 1,2; getsockname STDIN; getpeername STDIN; EXPECT -Send on closed socket at - line 22. -bind() on closed fd at - line 23. -connect() on closed fd at - line 24. -listen() on closed fd at - line 25. -accept() on closed fd at - line 26. -shutdown() on closed fd at - line 27. -[gs]etsockopt() on closed fd at - line 28. -[gs]etsockopt() on closed fd at - line 29. -get{sock, peer}name() on closed fd at - line 30. -get{sock, peer}name() on closed fd at - line 31. +send() on closed socket at - line 22. +bind() on closed socket at - line 23. +connect() on closed socket at - line 24. +listen() on closed socket at - line 25. +accept() on closed socket at - line 26. +shutdown() on closed socket at - line 27. +setsockopt() on closed socket at - line 28. +getsockopt() on closed socket at - line 29. +getsockname() on closed socket at - line 30. +getpeername() on closed socket at - line 31. ######## # pp_sys.c [pp_stat] use warnings 'newline' ; diff --git a/t/pragma/warn/regcomp b/t/pragma/warn/regcomp index 9c3677e..bb208db 100644 --- a/t/pragma/warn/regcomp +++ b/t/pragma/warn/regcomp @@ -15,8 +15,13 @@ Character class syntax [%c %c] belongs inside character classes [S_checkposixcc] + /%.127s/: false [] range \"%*.*s\" in regexp [S_regclass] - + /%.127s/: false [] range \"%*.*s\" in regexp [S_regclassutf8] + + /%.127s/: Unrecognized escape \\%c in character class passed through" [S_regclass] + + /%.127s/: Unrecognized escape \\%c in character class passed through" [S_regclassutf8] __END__ # regcomp.c [S_regpiece] @@ -39,8 +44,9 @@ Strange *+?{} on zero-length expression at - line 4. ######## # regcomp.c [S_regatom] use warnings 'unsafe' ; -$a =~ /\m/ ; +$a =~ /a\mb\b/ ; no warnings 'unsafe' ; +$a =~ /a\mb\b/ ; EXPECT Unrecognized escape \m passed through at - line 3. ######## @@ -62,6 +68,7 @@ no warnings 'unsafe' ; /[[.foo.]]/; /[[=bar=]]/; /[:zog:]/; +BEGIN { $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3 } /[[:zog:]]/; EXPECT Character class syntax [: :] belongs inside character classes at - line 4. @@ -72,4 +79,83 @@ Character class syntax [= =] is reserved for future extensions at - line 6. Character class syntax [. .] is reserved for future extensions at - line 8. Character class syntax [= =] is reserved for future extensions at - line 9. Character class syntax [: :] belongs inside character classes at - line 10. -Character class [:zog:] unknown at - line 19. +Character class [:zog:] unknown at - line 20. +######## +# regcomp.c [S_regclass] +$_ = ""; +use warnings 'unsafe' ; +/[a-b]/; +/[a-\d]/; +/[\d-b]/; +/[\s-\d]/; +/[\d-\s]/; +/[a-[:digit:]]/; +/[[:digit:]-b]/; +/[[:alpha:]-[:digit:]]/; +/[[:digit:]-[:alpha:]]/; +no warnings 'unsafe' ; +/[a-b]/; +/[a-\d]/; +/[\d-b]/; +/[\s-\d]/; +/[\d-\s]/; +/[a-[:digit:]]/; +/[[:digit:]-b]/; +/[[:alpha:]-[:digit:]]/; +/[[:digit:]-[:alpha:]]/; +EXPECT +/[a-\d]/: false [] range "a-\d" in regexp at - line 5. +/[\d-b]/: false [] range "\d-" in regexp at - line 6. +/[\s-\d]/: false [] range "\s-" in regexp at - line 7. +/[\d-\s]/: false [] range "\d-" in regexp at - line 8. +/[a-[:digit:]]/: false [] range "a-[:digit:]" in regexp at - line 9. +/[[:digit:]-b]/: false [] range "[:digit:]-" in regexp at - line 10. +/[[:alpha:]-[:digit:]]/: false [] range "[:alpha:]-" in regexp at - line 11. +/[[:digit:]-[:alpha:]]/: false [] range "[:digit:]-" in regexp at - line 12. +######## +# regcomp.c [S_regclassutf8] +BEGIN { + if (ord("\t") == 5) { + print "SKIPPED\n# ebcdic regular expression ranges differ."; + exit 0; + } +} +use utf8; +$_ = ""; +use warnings 'unsafe' ; +/[a-b]/; +/[a-\d]/; +/[\d-b]/; +/[\s-\d]/; +/[\d-\s]/; +/[a-[:digit:]]/; +/[[:digit:]-b]/; +/[[:alpha:]-[:digit:]]/; +/[[:digit:]-[:alpha:]]/; +no warnings 'unsafe' ; +/[a-b]/; +/[a-\d]/; +/[\d-b]/; +/[\s-\d]/; +/[\d-\s]/; +/[a-[:digit:]]/; +/[[:digit:]-b]/; +/[[:alpha:]-[:digit:]]/; +/[[:digit:]-[:alpha:]]/; +EXPECT +/[a-\d]/: false [] range "a-\d" in regexp at - line 12. +/[\d-b]/: false [] range "\d-" in regexp at - line 13. +/[\s-\d]/: false [] range "\s-" in regexp at - line 14. +/[\d-\s]/: false [] range "\d-" in regexp at - line 15. +/[a-[:digit:]]/: false [] range "a-[:digit:]" in regexp at - line 16. +/[[:digit:]-b]/: false [] range "[:digit:]-" in regexp at - line 17. +/[[:alpha:]-[:digit:]]/: false [] range "[:alpha:]-" in regexp at - line 18. +/[[:digit:]-[:alpha:]]/: false [] range "[:digit:]-" in regexp at - line 19. +######## +# regcomp.c [S_regclass S_regclassutf8] +use warnings 'unsafe' ; +$a =~ /[a\zb]/ ; +no warnings 'unsafe' ; +$a =~ /[a\zb]/ ; +EXPECT +/[a\zb]/: Unrecognized escape \z in character class passed through at - line 3. diff --git a/t/pragma/warn/sv b/t/pragma/warn/sv index c02ff01..97d61bc 100644 --- a/t/pragma/warn/sv +++ b/t/pragma/warn/sv @@ -58,7 +58,7 @@ $x = 1 + $a[0] ; # a no warnings 'uninitialized' ; $x = 1 + $b[0] ; # a EXPECT -Use of uninitialized value at - line 4. +Use of uninitialized value in integer addition (+) at - line 4. ######## # sv.c (sv_2iv) package fred ; @@ -73,7 +73,7 @@ $A *= 2 ; no warnings 'uninitialized' ; $A *= 2 ; EXPECT -Use of uninitialized value at - line 10. +Use of uninitialized value in integer multiplication (*) at - line 10. ######## # sv.c use integer ; @@ -82,7 +82,7 @@ my $x *= 2 ; #b no warnings 'uninitialized' ; my $y *= 2 ; #b EXPECT -Use of uninitialized value at - line 4. +Use of uninitialized value in integer multiplication (*) at - line 4. ######## # sv.c (sv_2uv) package fred ; @@ -98,7 +98,7 @@ no warnings 'uninitialized' ; $B = 0 ; $B |= $A ; EXPECT -Use of uninitialized value at - line 10. +Use of uninitialized value in bitwise or (|) at - line 10. ######## # sv.c use warnings 'uninitialized' ; @@ -108,7 +108,7 @@ no warnings 'uninitialized' ; my $Y = 1 ; $x = 1 | $b[$Y] ; EXPECT -Use of uninitialized value at - line 4. +Use of uninitialized value in bitwise or (|) at - line 4. ######## # sv.c use warnings 'uninitialized' ; @@ -116,7 +116,7 @@ my $x *= 1 ; # d no warnings 'uninitialized' ; my $y *= 1 ; # d EXPECT -Use of uninitialized value at - line 3. +Use of uninitialized value in multiplication (*) at - line 3. ######## # sv.c use warnings 'uninitialized' ; @@ -124,7 +124,7 @@ $x = 1 + $a[0] ; # e no warnings 'uninitialized' ; $x = 1 + $b[0] ; # e EXPECT -Use of uninitialized value at - line 3. +Use of uninitialized value in addition (+) at - line 3. ######## # sv.c (sv_2nv) package fred ; @@ -138,7 +138,7 @@ $A *= 2 ; no warnings 'uninitialized' ; $A *= 2 ; EXPECT -Use of uninitialized value at - line 9. +Use of uninitialized value in multiplication (*) at - line 9. ######## # sv.c use warnings 'uninitialized' ; @@ -146,7 +146,7 @@ $x = $y + 1 ; # f no warnings 'uninitialized' ; $x = $z + 1 ; # f EXPECT -Use of uninitialized value at - line 3. +Use of uninitialized value in addition (+) at - line 3. ######## # sv.c use warnings 'uninitialized' ; @@ -162,7 +162,7 @@ $x = chop $y ; # h no warnings 'uninitialized' ; $x = chop $z ; # h EXPECT -Use of uninitialized value at - line 3. +Use of uninitialized value in scalar chop at - line 3. ######## # sv.c (sv_2pv) package fred ; @@ -178,7 +178,7 @@ no warnings 'uninitialized' ; $C = "" ; $C .= $A ; EXPECT -Use of uninitialized value at - line 10. +Use of uninitialized value in concatenation (.) at - line 10. ######## # sv.c use warnings 'numeric' ; @@ -269,6 +269,12 @@ EXPECT Undefined value assigned to typeglob at - line 3. ######## # sv.c +BEGIN { + if (ord("\t") == 5) { + print "SKIPPED\n# ebcdic \\x characters differ."; + exit 0; + } +} use utf8 ; $^W =0 ; { @@ -279,9 +285,9 @@ $^W =0 ; } my $a = rindex "a\xff bc ", "bc" ; EXPECT -\xff will produce malformed UTF-8 character; use \x{ff} for that at - line 6. -Malformed UTF-8 character at - line 6. -Malformed UTF-8 character at - line 10. +\xff will produce malformed UTF-8 character; use \x{ff} for that at - line 12. +Malformed UTF-8 character at - line 12. +Malformed UTF-8 character at - line 16. ######## # sv.c use warnings 'misc'; diff --git a/t/pragma/warn/toke b/t/pragma/warn/toke index ee02efa..515241a 100644 --- a/t/pragma/warn/toke +++ b/t/pragma/warn/toke @@ -462,13 +462,19 @@ EXPECT ######## # toke.c +BEGIN { + if (ord("\t") == 5) { + print "SKIPPED\n# Ebcdic platforms have different \\x constructs."; + exit 0; + } +} use warnings 'utf8' ; use utf8 ; $_ = " \xffe " ; no warnings 'utf8' ; $_ = " \xffe " ; EXPECT -\xff will produce malformed UTF-8 character; use \x{ff} for that at - line 4. +\xff will produce malformed UTF-8 character; use \x{ff} for that at - line 10. ######## # toke.c my $a = rand + 4 ; diff --git a/t/pragma/warn/utf8 b/t/pragma/warn/utf8 index b11514d..19b8d1d 100644 --- a/t/pragma/warn/utf8 +++ b/t/pragma/warn/utf8 @@ -22,6 +22,12 @@ EXPECT Malformed UTF-8 character at - line 3. ######## # utf8.c [utf8_to_uv] +BEGIN { + if (ord("\t") == 5) { + print "SKIPPED\n# Ebcdic platforms have different \\x constructs."; + exit 0; + } +} use utf8 ; my $a = ord "\x80" ; { @@ -31,9 +37,9 @@ my $a = ord "\x80" ; my $a = ord "\x80" ; } EXPECT -Malformed UTF-8 character at - line 3. -\x80 will produce malformed UTF-8 character; use \x{80} for that at - line 6. -Malformed UTF-8 character at - line 6. +Malformed UTF-8 character at - line 9. +\x80 will produce malformed UTF-8 character; use \x{80} for that at - line 12. +Malformed UTF-8 character at - line 12. ######## # utf8.c [utf8_to_uv] use utf8 ; @@ -42,6 +48,12 @@ EXPECT Malformed UTF-8 character at - line 3. ######## # utf8.c [utf8_to_uv] +BEGIN { + if (ord("\t") == 5) { + print "SKIPPED\n# Ebcdic platforms have different \\x constructs."; + exit 0; + } +} use utf8 ; my $a = ord "\xf080" ; { @@ -51,6 +63,6 @@ my $a = ord "\xf080" ; my $a = ord "\xf080" ; } EXPECT -Malformed UTF-8 character at - line 3. -\xf0 will produce malformed UTF-8 character; use \x{f0} for that at - line 6. -Malformed UTF-8 character at - line 6. +Malformed UTF-8 character at - line 9. +\xf0 will produce malformed UTF-8 character; use \x{f0} for that at - line 12. +Malformed UTF-8 character at - line 12. diff --git a/taint.c b/taint.c index 2a5fedc..0f0ce98 100644 --- a/taint.c +++ b/taint.c @@ -9,17 +9,14 @@ #include "perl.h" void -Perl_taint_proper(pTHX_ const char *f, char *s) +Perl_taint_proper(pTHX_ const char *f, const char *s) { dTHR; /* just for taint */ char *ug; -#ifdef IV_IS_QUAD +#ifdef HAS_SETEUID DEBUG_u(PerlIO_printf(Perl_debug_log, - "%s %d %" PERL_PRId64 " %" PERL_PRId64 "\n", s, PL_tainted, (IV)PL_uid, (IV)PL_euid)); -#else - DEBUG_u(PerlIO_printf(Perl_debug_log, - "%s %d %lu %lu\n", s, PL_tainted, (unsigned long)PL_uid, (unsigned long)PL_euid)); + "%s %d %"Uid_t_f" %"Uid_t_f"\n", s, PL_tainted, PL_uid, PL_euid)); #endif if (PL_tainted) { diff --git a/thrdvar.h b/thrdvar.h index 2b64b7e..d228ee2 100644 --- a/thrdvar.h +++ b/thrdvar.h @@ -213,7 +213,6 @@ PERLVAR(threadsv, AV *) /* Per-thread SVs ($_, $@ etc.) */ PERLVAR(threadsvp, SV **) /* AvARRAY(threadsv) */ PERLVAR(specific, AV *) /* Thread-specific user data */ PERLVAR(errsv, SV *) /* Backing SV for $@ */ -PERLVAR(errhv, HV *) /* HV for what was %@ in pp_ctl.c */ PERLVAR(mutex, perl_mutex) /* For the fields others can change */ PERLVAR(tid, U32) PERLVAR(prev, struct perl_thread *) diff --git a/thread.h b/thread.h index f09143d..d03cef1 100644 --- a/thread.h +++ b/thread.h @@ -1,4 +1,4 @@ -#ifdef USE_THREADS +#if defined(USE_THREADS) || defined(USE_ITHREADS) #ifdef WIN32 # include @@ -73,7 +73,9 @@ struct perl_thread *getTHR (void); } STMT_END #define MUTEX_LOCK(m) mutex_lock(*m) +#define MUTEX_LOCK_NOCONTEXT(m) mutex_lock(*m) #define MUTEX_UNLOCK(m) mutex_unlock(*m) +#define MUTEX_UNLOCK_NOCONTEXT(m) mutex_unlock(*m) #define MUTEX_DESTROY(m) \ STMT_START { \ mutex_free(*m); \ @@ -109,7 +111,7 @@ struct perl_thread *getTHR (void); #define JOIN(t, avp) (*(avp) = (AV *)cthread_join(t->self)) #define SET_THR(thr) cthread_set_data(cthread_self(), thr) -#define THR cthread_data(cthread_self()) +#define THR ((struct perl_thread *)cthread_data(cthread_self())) #define INIT_THREADS cthread_init() #define YIELD cthread_yield() @@ -236,10 +238,19 @@ struct perl_thread *getTHR (void); } STMT_END #endif /* SET_THR */ -#ifndef THR -#define THR ((struct perl_thread *) pthread_getspecific(PL_thr_key)) +#ifndef INIT_THREADS +# ifdef NEED_PTHREAD_INIT +# define INIT_THREADS pthread_init() +# endif #endif +#ifndef THREAD_RET_TYPE +# define THREAD_RET_TYPE void * +# define THREAD_RET_CAST(p) ((void *)(p)) +#endif /* THREAD_RET */ + +#if defined(USE_THREADS) + /* * dTHR is performance-critical. Here, we only do the pthread_get_specific * if there may be more than one thread in existence, otherwise we get thr @@ -249,21 +260,18 @@ struct perl_thread *getTHR (void); * * The use of PL_threadnum should be safe here. */ -#ifndef dTHR -# define dTHR \ - struct perl_thread *thr = PL_threadnum? THR : (struct perl_thread*)SvPVX(PL_thrsv) -#endif /* dTHR */ +# if !defined(dTHR) +# define dTHR \ + struct perl_thread *thr = PL_threadnum ? THR : (struct perl_thread*)SvPVX(PL_thrsv) +# endif /* dTHR */ -#ifndef INIT_THREADS -# ifdef NEED_PTHREAD_INIT -# define INIT_THREADS pthread_init() -# else -# define INIT_THREADS NOOP +# if !defined(THR) +# define THR ((struct perl_thread *) pthread_getspecific(PL_thr_key)) # endif -#endif + /* Accessor for per-thread SVs */ -#define THREADSV(i) (thr->threadsvp[i]) +# define THREADSV(i) (thr->threadsvp[i]) /* * LOCK_SV_MUTEX and UNLOCK_SV_MUTEX are performance-critical. Here, we @@ -272,31 +280,12 @@ struct perl_thread *getTHR (void); * remove the "if (threadnum) ..." test. * XXX do NOT use C -- it sets up race conditions! */ -#define LOCK_SV_MUTEX \ - STMT_START { \ - MUTEX_LOCK(&PL_sv_mutex); \ - } STMT_END - -#define UNLOCK_SV_MUTEX \ - STMT_START { \ - MUTEX_UNLOCK(&PL_sv_mutex); \ - } STMT_END - -/* Likewise for strtab_mutex */ -#define LOCK_STRTAB_MUTEX \ - STMT_START { \ - MUTEX_LOCK(&PL_strtab_mutex); \ - } STMT_END - -#define UNLOCK_STRTAB_MUTEX \ - STMT_START { \ - MUTEX_UNLOCK(&PL_strtab_mutex); \ - } STMT_END - -#ifndef THREAD_RET_TYPE -# define THREAD_RET_TYPE void * -# define THREAD_RET_CAST(p) ((void *)(p)) -#endif /* THREAD_RET */ +# define LOCK_SV_MUTEX MUTEX_LOCK(&PL_sv_mutex) +# define UNLOCK_SV_MUTEX MUTEX_UNLOCK(&PL_sv_mutex) +# define LOCK_STRTAB_MUTEX MUTEX_LOCK(&PL_strtab_mutex) +# define UNLOCK_STRTAB_MUTEX MUTEX_UNLOCK(&PL_strtab_mutex) +# define LOCK_CRED_MUTEX MUTEX_LOCK(&PL_cred_mutex) +# define UNLOCK_CRED_MUTEX MUTEX_UNLOCK(&PL_cred_mutex) /* Values and macros for thr->flags */ @@ -314,7 +303,7 @@ struct perl_thread *getTHR (void); #define ThrSETSTATE(t, s) STMT_START { \ (t)->flags &= ~THRf_STATE_MASK; \ (t)->flags |= (s); \ - DEBUG_S(PerlIO_printf(PerlIO_stderr(), \ + DEBUG_S(PerlIO_printf(Perl_debug_log, \ "thread %p set to state %d\n", (t), (s))); \ } STMT_END @@ -330,24 +319,85 @@ typedef struct condpair { #define MgCONDP(mg) (&((condpair_t *)(mg->mg_ptr))->cond) #define MgOWNER(mg) ((condpair_t *)(mg->mg_ptr))->owner -#else -/* USE_THREADS is not defined */ -#define MUTEX_LOCK(m) -#define MUTEX_LOCK_NOCONTEXT(m) -#define MUTEX_UNLOCK(m) -#define MUTEX_UNLOCK_NOCONTEXT(m) -#define MUTEX_INIT(m) -#define MUTEX_DESTROY(m) -#define COND_INIT(c) -#define COND_SIGNAL(c) -#define COND_BROADCAST(c) -#define COND_WAIT(c, m) -#define COND_DESTROY(c) -#define LOCK_SV_MUTEX -#define UNLOCK_SV_MUTEX -#define LOCK_STRTAB_MUTEX -#define UNLOCK_STRTAB_MUTEX - -#define THR -#define dTHR dNOOP #endif /* USE_THREADS */ +#endif /* USE_THREADS || USE_ITHREADS */ + +#ifndef MUTEX_LOCK +# define MUTEX_LOCK(m) +#endif + +#ifndef MUTEX_LOCK_NOCONTEXT +# define MUTEX_LOCK_NOCONTEXT(m) +#endif + +#ifndef MUTEX_UNLOCK +# define MUTEX_UNLOCK(m) +#endif + +#ifndef MUTEX_UNLOCK_NOCONTEXT +# define MUTEX_UNLOCK_NOCONTEXT(m) +#endif + +#ifndef MUTEX_INIT +# define MUTEX_INIT(m) +#endif + +#ifndef MUTEX_DESTROY +# define MUTEX_DESTROY(m) +#endif + +#ifndef COND_INIT +# define COND_INIT(c) +#endif + +#ifndef COND_SIGNAL +# define COND_SIGNAL(c) +#endif + +#ifndef COND_BROADCAST +# define COND_BROADCAST(c) +#endif + +#ifndef COND_WAIT +# define COND_WAIT(c, m) +#endif + +#ifndef COND_DESTROY +# define COND_DESTROY(c) +#endif + +#ifndef LOCK_SV_MUTEX +# define LOCK_SV_MUTEX +#endif + +#ifndef UNLOCK_SV_MUTEX +# define UNLOCK_SV_MUTEX +#endif + +#ifndef LOCK_STRTAB_MUTEX +# define LOCK_STRTAB_MUTEX +#endif + +#ifndef UNLOCK_STRTAB_MUTEX +# define UNLOCK_STRTAB_MUTEX +#endif + +#ifndef LOCK_CRED_MUTEX +# define LOCK_CRED_MUTEX +#endif + +#ifndef UNLOCK_CRED_MUTEX +# define UNLOCK_CRED_MUTEX +#endif + +#ifndef THR +# define THR +#endif + +#ifndef dTHR +# define dTHR dNOOP +#endif + +#ifndef INIT_THREADS +# define INIT_THREADS NOOP +#endif diff --git a/toke.c b/toke.c index 8777426..a38f58f 100644 --- a/toke.c +++ b/toke.c @@ -28,8 +28,9 @@ static char ident_too_long[] = "Identifier too long"; static void restore_rsfp(pTHXo_ void *f); -static void restore_expect(pTHXo_ void *e); -static void restore_lex_expect(pTHXo_ void *e); + +#define XFAKEBRACK 128 +#define XENUMMASK 127 #define UTF (PL_hints & HINT_UTF8) /* @@ -104,7 +105,7 @@ int* yychar_pointer = NULL; #ifdef CLINE #undef CLINE #endif -#define CLINE (PL_copline = (PL_curcop->cop_line < PL_copline ? PL_curcop->cop_line : PL_copline)) +#define CLINE (PL_copline = (CopLINE(PL_curcop) < PL_copline ? CopLINE(PL_curcop) : PL_copline)) /* * Convenience functions to return different tokens and prime the @@ -120,7 +121,7 @@ int* yychar_pointer = NULL; * LOOPX : loop exiting command (goto, last, dump, etc) * FTST : file test operator * FUN0 : zero-argument function - * FUN1 : not used + * FUN1 : not used, except for not, which isn't a UNIOP * BOop : bitwise or or xor * BAop : bitwise and * SHop : shift operator @@ -303,15 +304,36 @@ S_depcom(pTHX) * utf16-to-utf8-reversed. */ -#ifdef WIN32 +#ifdef PERL_CR_FILTER +static void +strip_return(SV *sv) +{ + register char *s = SvPVX(sv); + register char *e = s + SvCUR(sv); + /* outer loop optimized to do nothing if there are no CR-LFs */ + while (s < e) { + if (*s++ == '\r' && *s == '\n') { + /* hit a CR-LF, need to copy the rest */ + register char *d = s - 1; + *d++ = *s++; + while (s < e) { + if (*s == '\r' && s[1] == '\n') + s++; + *d++ = *s++; + } + SvCUR(sv) -= s - d; + return; + } + } +} STATIC I32 -S_win32_textfilter(pTHX_ int idx, SV *sv, int maxlen) +S_cr_textfilter(pTHX_ int idx, SV *sv, int maxlen) { - I32 count = FILTER_READ(idx+1, sv, maxlen); - if (count > 0 && !maxlen) - win32_strip_return(sv); - return count; + I32 count = FILTER_READ(idx+1, sv, maxlen); + if (count > 0 && !maxlen) + strip_return(sv); + return count; } #endif @@ -360,13 +382,12 @@ Perl_lex_start(pTHX_ SV *line) SAVEI32(PL_lex_dojoin); SAVEI32(PL_lex_brackets); - SAVEI32(PL_lex_fakebrack); SAVEI32(PL_lex_casemods); SAVEI32(PL_lex_starts); SAVEI32(PL_lex_state); - SAVESPTR(PL_lex_inpat); + SAVEVPTR(PL_lex_inpat); SAVEI32(PL_lex_inwhat); - SAVEI16(PL_curcop->cop_line); + SAVECOPLINE(PL_curcop); SAVEPPTR(PL_bufptr); SAVEPPTR(PL_bufend); SAVEPPTR(PL_oldbufptr); @@ -375,19 +396,18 @@ Perl_lex_start(pTHX_ SV *line) SAVESPTR(PL_linestr); SAVEPPTR(PL_lex_brackstack); SAVEPPTR(PL_lex_casestack); - SAVEDESTRUCTOR(restore_rsfp, PL_rsfp); + SAVEDESTRUCTOR_X(restore_rsfp, PL_rsfp); SAVESPTR(PL_lex_stuff); SAVEI32(PL_lex_defer); SAVEI32(PL_sublex_info.sub_inwhat); SAVESPTR(PL_lex_repl); - SAVEDESTRUCTOR(restore_expect, PL_tokenbuf + PL_expect); /* encode as pointer */ - SAVEDESTRUCTOR(restore_lex_expect, PL_tokenbuf + PL_expect); + SAVEINT(PL_expect); + SAVEINT(PL_lex_expect); PL_lex_state = LEX_NORMAL; PL_lex_defer = 0; PL_expect = XSTATE; PL_lex_brackets = 0; - PL_lex_fakebrack = 0; New(899, PL_lex_brackstack, 120, char); New(899, PL_lex_casestack, 12, char); SAVEFREEPV(PL_lex_brackstack); @@ -434,7 +454,7 @@ Perl_lex_end(pTHX) * S_incline * This subroutine has nothing to do with tilting, whether at windmills * or pinball tables. Its name is short for "increment line". It - * increments the current line number in PL_curcop->cop_line and checks + * increments the current line number in CopLINE(PL_curcop) and checks * to see whether the line starts with a comment of the form * # line 500 "foo.pm" * If so, it sets the current line number and file to the values in the comment. @@ -449,7 +469,7 @@ S_incline(pTHX_ char *s) char ch; int sawline = 0; - PL_curcop->cop_line++; + CopLINE_inc(PL_curcop); if (*s++ != '#') return; while (*s == ' ' || *s == '\t') s++; @@ -474,11 +494,11 @@ S_incline(pTHX_ char *s) ch = *t; *t = '\0'; if (t - s > 0) - PL_curcop->cop_filegv = gv_fetchfile(s); + CopFILE_set(PL_curcop, s); else - PL_curcop->cop_filegv = gv_fetchfile(PL_origfilename); + CopFILE_set(PL_curcop, PL_origfilename); *t = ch; - PL_curcop->cop_line = atoi(n)-1; + CopLINE_set(PL_curcop, atoi(n)-1); } /* @@ -590,7 +610,7 @@ S_skipspace(pTHX_ register char *s) sv_upgrade(sv, SVt_PVMG); sv_setpvn(sv,PL_bufptr,PL_bufend-PL_bufptr); - av_store(GvAV(PL_curcop->cop_filegv),(I32)PL_curcop->cop_line,sv); + av_store(CopFILEAV(PL_curcop),(I32)CopLINE(PL_curcop),sv); } } } @@ -673,7 +693,7 @@ S_uni(pTHX_ I32 f, char *s) */ STATIC I32 -S_lop(pTHX_ I32 f, expectation x, char *s) +S_lop(pTHX_ I32 f, int x, char *s) { dTHR; yylval.ival = f; @@ -804,13 +824,12 @@ S_force_version(pTHX_ char *s) s = skipspace(s); - /* default VERSION number -- GBARR */ - - if(isDIGIT(*s)) { - char *d; - int c; - for( d=s, c = 1; isDIGIT(*d) || *d == '_' || (*d == '.' && c--); d++); - if((*d == ';' || isSPACE(*d)) && *(skipspace(d)) != ',') { + if (isDIGIT(*s) || (*s == 'v' && isDIGIT(s[1]))) { + char *d = s; + if (*d == 'v') + d++; + for (; isDIGIT(*d) || *d == '_' || *d == '.'; d++); + if ((*d == ';' || isSPACE(*d)) && *(skipspace(d)) != ',') { s = scan_num(s); /* real VERSION number -- GBARR */ version = yylval.opval; @@ -963,13 +982,12 @@ S_sublex_push(pTHX) PL_lex_state = PL_sublex_info.super_state; SAVEI32(PL_lex_dojoin); SAVEI32(PL_lex_brackets); - SAVEI32(PL_lex_fakebrack); SAVEI32(PL_lex_casemods); SAVEI32(PL_lex_starts); SAVEI32(PL_lex_state); - SAVESPTR(PL_lex_inpat); + SAVEVPTR(PL_lex_inpat); SAVEI32(PL_lex_inwhat); - SAVEI16(PL_curcop->cop_line); + SAVECOPLINE(PL_curcop); SAVEPPTR(PL_bufptr); SAVEPPTR(PL_oldbufptr); SAVEPPTR(PL_oldoldbufptr); @@ -988,7 +1006,6 @@ S_sublex_push(pTHX) PL_lex_dojoin = FALSE; PL_lex_brackets = 0; - PL_lex_fakebrack = 0; New(899, PL_lex_brackstack, 120, char); New(899, PL_lex_casestack, 12, char); SAVEFREEPV(PL_lex_brackstack); @@ -997,7 +1014,7 @@ S_sublex_push(pTHX) *PL_lex_casestack = '\0'; PL_lex_starts = 0; PL_lex_state = LEX_INTERPCONCAT; - PL_curcop->cop_line = PL_multi_start; + CopLINE_set(PL_curcop, PL_multi_start); PL_lex_inwhat = PL_sublex_info.sub_inwhat; if (PL_lex_inwhat == OP_MATCH || PL_lex_inwhat == OP_QR || PL_lex_inwhat == OP_SUBST) @@ -1036,7 +1053,6 @@ S_sublex_done(pTHX) SAVEFREESV(PL_linestr); PL_lex_dojoin = FALSE; PL_lex_brackets = 0; - PL_lex_fakebrack = 0; PL_lex_casemods = 0; *PL_lex_casestack = '\0'; PL_lex_starts = 0; @@ -1153,7 +1169,7 @@ S_scan_const(pTHX_ char *start) ? (PL_sublex_info.sub_op->op_private & (PL_lex_repl ? OPpTRANS_FROM_UTF : OPpTRANS_TO_UTF)) : UTF; - char *leaveit = /* set of acceptably-backslashed characters */ + const char *leaveit = /* set of acceptably-backslashed characters */ PL_lex_inpat ? "\\.^$@AGZdDwWsSbBpPXC+*?|()-nrtfeaxcz0123456789[{]} \t\n\r\f\v#" : ""; @@ -1330,7 +1346,7 @@ S_scan_const(pTHX_ char *start) /* \132 indicates an octal constant */ case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': - *d++ = scan_oct(s, 3, &len); + *d++ = (char)scan_oct(s, 3, &len); s += len; continue; @@ -1352,7 +1368,7 @@ S_scan_const(pTHX_ char *start) } /* note: utf always shorter than hex */ d = (char*)uv_to_utf8((U8*)d, - scan_hex(s + 1, e - s - 1, &len)); + (UV)scan_hex(s + 1, e - s - 1, &len)); s = e + 1; } else { @@ -1764,7 +1780,8 @@ S_incl_perldb(pTHX) * store private buffers and state information. * * The supplied datasv parameter is upgraded to a PVIO type - * and the IoDIRP field is used to store the function pointer. + * and the IoDIRP field is used to store the function pointer, + * and IOf_FAKE_DIRP is enabled on datasv to mark this as such. * Note that IoTOP_NAME, IoFMT_NAME, IoBOTTOM_NAME, if set for * private use must be set using malloc'd pointers. */ @@ -1772,10 +1789,9 @@ S_incl_perldb(pTHX) SV * Perl_filter_add(pTHX_ filter_t funcp, SV *datasv) { - if (!funcp){ /* temporary handy debugging hack to be deleted */ - PL_filter_debug = atoi((char*)datasv); - return NULL; - } + if (!funcp) + return Nullsv; + if (!PL_rsfp_filters) PL_rsfp_filters = newAV(); if (!datasv) @@ -1783,12 +1799,9 @@ Perl_filter_add(pTHX_ filter_t funcp, SV *datasv) if (!SvUPGRADE(datasv, SVt_PVIO)) Perl_die(aTHX_ "Can't upgrade filter_add data to SVt_PVIO"); IoDIRP(datasv) = (DIR*)funcp; /* stash funcp into spare field */ -#ifdef DEBUGGING - if (PL_filter_debug) { - STRLEN n_a; - Perl_warn(aTHX_ "filter_add func %p (%s)", funcp, SvPV(datasv, n_a)); - } -#endif /* DEBUGGING */ + IoFLAGS(datasv) |= IOf_FAKE_DIRP; + DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_add func %p (%s)\n", + funcp, SvPV_nolen(datasv))); av_unshift(PL_rsfp_filters, 1); av_store(PL_rsfp_filters, 0, datasv) ; return(datasv); @@ -1799,15 +1812,15 @@ Perl_filter_add(pTHX_ filter_t funcp, SV *datasv) void Perl_filter_del(pTHX_ filter_t funcp) { -#ifdef DEBUGGING - if (PL_filter_debug) - Perl_warn(aTHX_ "filter_del func %p", funcp); -#endif /* DEBUGGING */ + SV *datasv; + DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_del func %p", funcp)); if (!PL_rsfp_filters || AvFILLp(PL_rsfp_filters)<0) return; /* if filter is on top of stack (usual case) just pop it off */ - if (IoDIRP(FILTER_DATA(AvFILLp(PL_rsfp_filters))) == (DIR*)funcp){ - IoDIRP(FILTER_DATA(AvFILLp(PL_rsfp_filters))) = NULL; + datasv = FILTER_DATA(AvFILLp(PL_rsfp_filters)); + if (IoDIRP(datasv) == (DIR*)funcp) { + IoFLAGS(datasv) &= ~IOf_FAKE_DIRP; + IoDIRP(datasv) = (DIR*)NULL; sv_free(av_pop(PL_rsfp_filters)); return; @@ -1832,10 +1845,8 @@ Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen) if (idx > AvFILLp(PL_rsfp_filters)){ /* Any more filters? */ /* Provide a default input filter to make life easy. */ /* Note that we append to the line. This is handy. */ -#ifdef DEBUGGING - if (PL_filter_debug) - Perl_warn(aTHX_ "filter_read %d: from rsfp\n", idx); -#endif /* DEBUGGING */ + DEBUG_P(PerlIO_printf(Perl_debug_log, + "filter_read %d: from rsfp\n", idx)); if (maxlen) { /* Want a block */ int len ; @@ -1863,21 +1874,16 @@ Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen) } /* Skip this filter slot if filter has been deleted */ if ( (datasv = FILTER_DATA(idx)) == &PL_sv_undef){ -#ifdef DEBUGGING - if (PL_filter_debug) - Perl_warn(aTHX_ "filter_read %d: skipped (filter deleted)\n", idx); -#endif /* DEBUGGING */ + DEBUG_P(PerlIO_printf(Perl_debug_log, + "filter_read %d: skipped (filter deleted)\n", + idx)); return FILTER_READ(idx+1, buf_sv, maxlen); /* recurse */ } /* Get function pointer hidden within datasv */ funcp = (filter_t)IoDIRP(datasv); -#ifdef DEBUGGING - if (PL_filter_debug) { - STRLEN n_a; - Perl_warn(aTHX_ "filter_read %d: via function %p (%s)\n", - idx, funcp, SvPV(datasv,n_a)); - } -#endif /* DEBUGGING */ + DEBUG_P(PerlIO_printf(Perl_debug_log, + "filter_read %d: via function %p (%s)\n", + idx, funcp, SvPV_nolen(datasv))); /* Call function. The function is expected to */ /* call "FILTER_READ(idx+1, buf_sv)" first. */ /* Return: <0:error, =0:eof, >0:not eof */ @@ -1887,9 +1893,9 @@ Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen) STATIC char * S_filter_gets(pTHX_ register SV *sv, register PerlIO *fp, STRLEN append) { -#ifdef WIN32FILTER +#ifdef PERL_CR_FILTER if (!PL_rsfp_filters) { - filter_add(win32_textfilter,NULL); + filter_add(S_cr_textfilter,NULL); } #endif if (PL_rsfp_filters) { @@ -2009,15 +2015,19 @@ Perl_yylex(pTHX) } #endif /* USE_THREADS */ if ((tmp = pad_findmy(PL_tokenbuf)) != NOT_IN_PAD) { + SV *namesv = AvARRAY(PL_comppad_name)[tmp]; /* might be an "our" variable" */ - if (SvFLAGS(AvARRAY(PL_comppad_name)[tmp]) & SVpad_OUR) { + if (SvFLAGS(namesv) & SVpad_OUR) { /* build ops for a bareword */ - yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(PL_tokenbuf+1, 0)); + SV *sym = newSVpv(HvNAME(GvSTASH(namesv)),0); + sv_catpvn(sym, "::", 2); + sv_catpv(sym, PL_tokenbuf+1); + yylval.opval = (OP*)newSVOP(OP_CONST, 0, sym); yylval.opval->op_private = OPpCONST_ENTERED; - gv_fetchpv(PL_tokenbuf+1, + gv_fetchpv(SvPVX(sym), (PL_in_eval - ? (GV_ADDMULTI | GV_ADDINEVAL | GV_ADDOUR) - : GV_ADDOUR + ? (GV_ADDMULTI | GV_ADDINEVAL) + : TRUE ), ((PL_tokenbuf[0] == '$') ? SVt_PV : (PL_tokenbuf[0] == '@') ? SVt_PVAV @@ -2266,7 +2276,8 @@ Perl_yylex(pTHX) PL_oldoldbufptr = PL_oldbufptr; PL_oldbufptr = s; DEBUG_p( { - PerlIO_printf(PerlIO_stderr(), "### Tokener expecting %s at %s\n", exp_name[PL_expect], s); + PerlIO_printf(Perl_debug_log, "### Tokener expecting %s at %s\n", + exp_name[PL_expect], s); } ) retry: @@ -2344,7 +2355,7 @@ Perl_yylex(pTHX) sv_upgrade(sv, SVt_PVMG); sv_setsv(sv,PL_linestr); - av_store(GvAV(PL_curcop->cop_filegv),(I32)PL_curcop->cop_line,sv); + av_store(CopFILEAV(PL_curcop),(I32)CopLINE(PL_curcop),sv); } goto retry; } @@ -2393,10 +2404,10 @@ Perl_yylex(pTHX) sv_upgrade(sv, SVt_PVMG); sv_setsv(sv,PL_linestr); - av_store(GvAV(PL_curcop->cop_filegv),(I32)PL_curcop->cop_line,sv); + av_store(CopFILEAV(PL_curcop),(I32)CopLINE(PL_curcop),sv); } PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr); - if (PL_curcop->cop_line == 1) { + if (CopLINE(PL_curcop) == 1) { while (s < PL_bufend && isSPACE(*s)) s++; if (*s == ':' && s[1] != ':') /* for csh execing sh scripts */ @@ -2434,7 +2445,7 @@ Perl_yylex(pTHX) */ SV *x = GvSV(gv_fetchpv("\030", TRUE, SVt_PV)); assert(SvPOK(x) || SvGMAGICAL(x)); - if (sv_eq(x, GvSV(PL_curcop->cop_filegv))) { + if (sv_eq(x, CopFILESV(PL_curcop))) { sv_setpvn(x, ipath, ipathend - ipath); SvSETMAGIC(x); } @@ -2808,8 +2819,8 @@ Perl_yylex(pTHX) PL_expect = XTERM; TOKEN('('); case ';': - if (PL_curcop->cop_line < PL_copline) - PL_copline = PL_curcop->cop_line; + if (CopLINE(PL_curcop) < PL_copline) + PL_copline = CopLINE(PL_curcop); tmp = *s++; OPERATOR(tmp); case ')': @@ -2922,7 +2933,8 @@ Perl_yylex(pTHX) if (++t < PL_bufend && (!isALNUM(*t) || ((*t == 'q' || *t == 'x') && ++t < PL_bufend - && !isALNUM(*t)))) { + && !isALNUM(*t)))) + { char *tmps; char open, close, term; I32 brackets = 1; @@ -2953,8 +2965,10 @@ Perl_yylex(pTHX) } t++; } - else if (isIDFIRST_lazy(s)) { - for (t++; t < PL_bufend && isALNUM_lazy(t); t++) ; + else if (isALNUM_lazy(t)) { + t += UTF8SKIP(t); + while (t < PL_bufend && isALNUM_lazy(t)) + t += UTF8SKIP(t); } while (t < PL_bufend && isSPACE(*t)) t++; @@ -2972,7 +2986,7 @@ Perl_yylex(pTHX) } break; } - yylval.ival = PL_curcop->cop_line; + yylval.ival = CopLINE(PL_curcop); if (isSPACE(*s) || *s == '#') PL_copline = NOLINE; /* invalidate current command line number */ TOKEN('{'); @@ -2987,7 +3001,8 @@ Perl_yylex(pTHX) PL_lex_formbrack = 0; if (PL_lex_state == LEX_INTERPNORMAL) { if (PL_lex_brackets == 0) { - if (PL_lex_fakebrack) { + if (PL_expect & XFAKEBRACK) { + PL_expect &= XENUMMASK; PL_lex_state = LEX_INTERPEND; PL_bufptr = s; return yylex(); /* ignore fake brackets */ @@ -2998,9 +3013,9 @@ Perl_yylex(pTHX) PL_lex_state = LEX_INTERPEND; } } - if (PL_lex_brackets < PL_lex_fakebrack) { + if (PL_expect & XFAKEBRACK) { + PL_expect &= XENUMMASK; PL_bufptr = s; - PL_lex_fakebrack = 0; return yylex(); /* ignore fake brackets */ } force_next('}'); @@ -3013,9 +3028,9 @@ Perl_yylex(pTHX) s--; if (PL_expect == XOPERATOR) { if (ckWARN(WARN_SEMICOLON) && isIDFIRST_lazy(s) && PL_bufptr == PL_linestart) { - PL_curcop->cop_line--; + CopLINE_dec(PL_curcop); Perl_warner(aTHX_ WARN_SEMICOLON, PL_warn_nosemi); - PL_curcop->cop_line++; + CopLINE_inc(PL_curcop); } BAop(OP_BIT_AND); } @@ -3408,6 +3423,19 @@ Perl_yylex(pTHX) no_op("Backslash",s); OPERATOR(REFGEN); + case 'v': + if (isDIGIT(s[1]) && PL_expect == XTERM) { + char *start = s; + start++; + start++; + while (isDIGIT(*start)) + start++; + if (*start == '.' && isDIGIT(start[1])) { + s = scan_num(s); + TERM(THING); + } + } + goto keylookup; case 'x': if (isDIGIT(s[1]) && PL_expect == XOPERATOR) { s++; @@ -3437,7 +3465,7 @@ Perl_yylex(pTHX) case 's': case 'S': case 't': case 'T': case 'u': case 'U': - case 'v': case 'V': + case 'V': case 'w': case 'W': case 'X': case 'y': case 'Y': @@ -3511,6 +3539,7 @@ Perl_yylex(pTHX) } else if (gv && !gvp && -tmp==KEY_lock /* XXX generalizable kludge */ + && GvCVu(gv) && !hv_fetch(GvHVn(PL_incgv), "Thread.pm", 9, FALSE)) { tmp = 0; /* any sub overrides "weak" keyword */ @@ -3549,9 +3578,9 @@ Perl_yylex(pTHX) if (PL_expect == XOPERATOR) { if (PL_bufptr == PL_linestart) { - PL_curcop->cop_line--; + CopLINE_dec(PL_curcop); Perl_warner(aTHX_ WARN_SEMICOLON, PL_warn_nosemi); - PL_curcop->cop_line++; + CopLINE_inc(PL_curcop); } else no_op("Bareword",s); @@ -3603,7 +3632,8 @@ Perl_yylex(pTHX) if (PL_oldoldbufptr && PL_oldoldbufptr < PL_bufptr && - (PL_oldoldbufptr == PL_last_lop || PL_oldoldbufptr == PL_last_uni) && + (PL_oldoldbufptr == PL_last_lop + || PL_oldoldbufptr == PL_last_uni) && /* NO SKIPSPACE BEFORE HERE! */ (PL_expect == XREF || ((PL_opargs[PL_last_lop_op] >> OASHIFT)& 7) == OA_FILEREF)) @@ -3737,17 +3767,12 @@ Perl_yylex(pTHX) case KEY___FILE__: yylval.opval = (OP*)newSVOP(OP_CONST, 0, - newSVsv(GvSV(PL_curcop->cop_filegv))); + newSVpv(CopFILE(PL_curcop),0)); TERM(THING); case KEY___LINE__: -#ifdef IV_IS_QUAD - yylval.opval = (OP*)newSVOP(OP_CONST, 0, - Perl_newSVpvf(aTHX_ "%" PERL_PRId64, (IV)PL_curcop->cop_line)); -#else yylval.opval = (OP*)newSVOP(OP_CONST, 0, - Perl_newSVpvf(aTHX_ "%ld", (long)PL_curcop->cop_line)); -#endif + Perl_newSVpvf(aTHX_ "%"IVdf, (IV)CopLINE(PL_curcop))); TERM(THING); case KEY___PACKAGE__: @@ -3785,6 +3810,28 @@ Perl_yylex(pTHX) IoTYPE(GvIOp(gv)) = '-'; else IoTYPE(GvIOp(gv)) = '<'; +#if defined(WIN32) && !defined(PERL_TEXTMODE_SCRIPTS) + /* if the script was opened in binmode, we need to revert + * it to text mode for compatibility; but only iff it has CRs + * XXX this is a questionable hack at best. */ + if (PL_bufend-PL_bufptr > 2 + && PL_bufend[-1] == '\n' && PL_bufend[-2] == '\r') + { + Off_t loc = 0; + if (IoTYPE(GvIOp(gv)) == '<') { + loc = PerlIO_tell(PL_rsfp); + (void)PerlIO_seek(PL_rsfp, 0L, 0); + } + if (PerlLIO_setmode(PerlIO_fileno(PL_rsfp), O_TEXT) != -1) { +#if defined(__BORLANDC__) + /* XXX see note in do_binmode() */ + ((FILE*)PL_rsfp)->flags |= _F_BIN; +#endif + if (loc > 0) + PerlIO_seek(PL_rsfp, loc, 0); + } + } +#endif PL_rsfp = Nullfp; } goto fake_eof; @@ -3794,6 +3841,7 @@ Perl_yylex(pTHX) case KEY_DESTROY: case KEY_BEGIN: case KEY_END: + case KEY_STOP: case KEY_INIT: if (PL_expect == XSTATE) { s = PL_bufptr; @@ -3861,8 +3909,10 @@ Perl_yylex(pTHX) case KEY_crypt: #ifdef FCRYPT - if (!PL_cryptseen++) + if (!PL_cryptseen) { + PL_cryptseen = TRUE; init_des(); + } #endif LOP(OP_CRYPT,XTERM); @@ -3923,7 +3973,7 @@ Perl_yylex(pTHX) PREBLOCK(ELSE); case KEY_elsif: - yylval.ival = PL_curcop->cop_line; + yylval.ival = CopLINE(PL_curcop); OPERATOR(ELSIF); case KEY_eq: @@ -3973,7 +4023,7 @@ Perl_yylex(pTHX) case KEY_for: case KEY_foreach: - yylval.ival = PL_curcop->cop_line; + yylval.ival = CopLINE(PL_curcop); s = skipspace(s); if (PL_expect == XSTATE && isIDFIRST_lazy(s)) { char *p = s; @@ -4111,7 +4161,7 @@ Perl_yylex(pTHX) UNI(OP_HEX); case KEY_if: - yylval.ival = PL_curcop->cop_line; + yylval.ival = CopLINE(PL_curcop); OPERATOR(IF); case KEY_index: @@ -4230,7 +4280,10 @@ Perl_yylex(pTHX) OPERATOR(USE); case KEY_not: - OPERATOR(NOTOP); + if (*s == '(' || (s = skipspace(s), *s == '(')) + FUN1(OP_NOT); + else + OPERATOR(NOTOP); case KEY_open: s = skipspace(s); @@ -4368,12 +4421,18 @@ Perl_yylex(pTHX) OLDLOP(OP_RETURN); case KEY_require: - *PL_tokenbuf = '\0'; - s = force_word(s,WORD,TRUE,TRUE,FALSE); - if (isIDFIRST_lazy(PL_tokenbuf)) - gv_stashpvn(PL_tokenbuf, strlen(PL_tokenbuf), TRUE); - else if (*s == '<') - yyerror("<> should be quotes"); + s = skipspace(s); + if (isDIGIT(*s) || (*s == 'v' && isDIGIT(s[1]))) { + s = force_version(s); + } + else { + *PL_tokenbuf = '\0'; + s = force_word(s,WORD,TRUE,TRUE,FALSE); + if (isIDFIRST_lazy(PL_tokenbuf)) + gv_stashpvn(PL_tokenbuf, strlen(PL_tokenbuf), TRUE); + else if (*s == '<') + yyerror("<> should be quotes"); + } UNI(OP_REQUIRE); case KEY_reset: @@ -4543,7 +4602,6 @@ Perl_yylex(pTHX) UNI(OP_STAT); case KEY_study: - PL_sawstudy++; UNI(OP_STUDY); case KEY_substr: @@ -4701,11 +4759,11 @@ Perl_yylex(pTHX) UNI(OP_UNTIE); case KEY_until: - yylval.ival = PL_curcop->cop_line; + yylval.ival = CopLINE(PL_curcop); OPERATOR(UNTIL); case KEY_unless: - yylval.ival = PL_curcop->cop_line; + yylval.ival = CopLINE(PL_curcop); OPERATOR(UNLESS); case KEY_unlink: @@ -4736,9 +4794,9 @@ Perl_yylex(pTHX) if (PL_expect != XSTATE) yyerror("\"use\" not allowed in expression"); s = skipspace(s); - if(isDIGIT(*s)) { + if (isDIGIT(*s) || (*s == 'v' && isDIGIT(s[1]))) { s = force_version(s); - if(*s == ';' || (s = skipspace(s), *s == ';')) { + if (*s == ';' || (s = skipspace(s), *s == ';')) { PL_nextval[PL_nexttoke].opval = Nullop; force_next(WORD); } @@ -4754,11 +4812,10 @@ Perl_yylex(pTHX) UNI(OP_VALUES); case KEY_vec: - PL_sawvec = TRUE; LOP(OP_VEC,XTERM); case KEY_while: - yylval.ival = PL_curcop->cop_line; + yylval.ival = CopLINE(PL_curcop); OPERATOR(WHILE); case KEY_warn: @@ -5229,6 +5286,9 @@ Perl_keyword(pTHX_ register char *d, I32 len) break; } break; + case 'S': + if (strEQ(d,"STOP")) return KEY_STOP; + break; case 's': switch (d[1]) { case 0: return KEY_s; @@ -5441,7 +5501,8 @@ S_checkcomma(pTHX_ register char *s, char *name, char *what) if (*w) for (; *w && isSPACE(*w); w++) ; if (!*w || !strchr(";|})]oaiuw!=", *w)) /* an advisory hack only... */ - Perl_warner(aTHX_ WARN_SYNTAX, "%s (...) interpreted as function",name); + Perl_warner(aTHX_ WARN_SYNTAX, + "%s (...) interpreted as function",name); } } while (s < PL_bufend && isSPACE(*s)) @@ -5474,14 +5535,15 @@ S_checkcomma(pTHX_ register char *s, char *name, char *what) and type is used with error messages only. */ STATIC SV * -S_new_constant(pTHX_ char *s, STRLEN len, char *key, SV *sv, SV *pv, char *type) +S_new_constant(pTHX_ char *s, STRLEN len, const char *key, SV *sv, SV *pv, + const char *type) { dSP; HV *table = GvHV(PL_hintgv); /* ^H */ SV *res; SV **cvp; SV *cv, *typesv; - char *why, *why1, *why2; + const char *why, *why1, *why2; if (!(PL_hints & HINT_LOCALIZE_HH)) { SV *msg; @@ -5539,12 +5601,12 @@ S_new_constant(pTHX_ char *s, STRLEN len, char *key, SV *sv, SV *pv, char *type) STRLEN n_a; sv_catpv(ERRSV, "Propagated"); yyerror(SvPV(ERRSV, n_a)); /* Duplicates the message inside eval */ - POPs ; + (void)POPs; res = SvREFCNT_inc(sv); } else { res = POPs; - SvREFCNT_inc(res); + (void)SvREFCNT_inc(res); } PUTBACK ; @@ -5608,8 +5670,6 @@ S_scan_ident(pTHX_ register char *s, register char *send, char *dest, STRLEN des char *bracket = 0; char funny = *s++; - if (PL_lex_brackets == 0) - PL_lex_fakebrack = 0; if (isSPACE(*s)) s = skipspace(s); d = dest; @@ -5709,14 +5769,13 @@ S_scan_ident(pTHX_ register char *s, register char *send, char *dest, STRLEN des if ((*s == '[' || (*s == '{' && strNE(dest, "sub")))) { dTHR; /* only for ckWARN */ if (ckWARN(WARN_AMBIGUOUS) && keyword(dest, d - dest)) { - char *brack = *s == '[' ? "[...]" : "{...}"; + const char *brack = *s == '[' ? "[...]" : "{...}"; Perl_warner(aTHX_ WARN_AMBIGUOUS, "Ambiguous use of %c{%s%s} resolved to %c%s%s", funny, dest, brack, funny, dest, brack); } - PL_lex_fakebrack = PL_lex_brackets+1; bracket++; - PL_lex_brackstack[PL_lex_brackets++] = XOPERATOR; + PL_lex_brackstack[PL_lex_brackets++] = (char)(XOPERATOR | XFAKEBRACK); return s; } } @@ -6049,7 +6108,7 @@ S_scan_heredoc(pTHX_ register char *s) } CLINE; - PL_multi_start = PL_curcop->cop_line; + PL_multi_start = CopLINE(PL_curcop); PL_multi_open = PL_multi_close = '<'; term = *PL_tokenbuf; if (PL_lex_inwhat == OP_SUBST && PL_in_eval && !PL_rsfp) { @@ -6063,10 +6122,10 @@ S_scan_heredoc(pTHX_ register char *s) while (s < bufend && (*s != term || memNE(s,PL_tokenbuf,len)) ) { if (*s++ == '\n') - PL_curcop->cop_line++; + CopLINE_inc(PL_curcop); } if (s >= bufend) { - PL_curcop->cop_line = PL_multi_start; + CopLINE_set(PL_curcop, PL_multi_start); missingterm(PL_tokenbuf); } sv_setpvn(herewas,bufptr,d-bufptr+1); @@ -6083,15 +6142,15 @@ S_scan_heredoc(pTHX_ register char *s) while (s < PL_bufend && (*s != term || memNE(s,PL_tokenbuf,len)) ) { if (*s++ == '\n') - PL_curcop->cop_line++; + CopLINE_inc(PL_curcop); } if (s >= PL_bufend) { - PL_curcop->cop_line = PL_multi_start; + CopLINE_set(PL_curcop, PL_multi_start); missingterm(PL_tokenbuf); } sv_setpvn(tmpstr,d+1,s-d); s += len - 1; - PL_curcop->cop_line++; /* the preceding stmt passes a newline */ + CopLINE_inc(PL_curcop); /* the preceding stmt passes a newline */ sv_catpvn(herewas,s,PL_bufend-s); sv_setsv(PL_linestr,herewas); @@ -6103,10 +6162,10 @@ S_scan_heredoc(pTHX_ register char *s) while (s >= PL_bufend) { /* multiple line string? */ if (!outer || !(PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = filter_gets(PL_linestr, PL_rsfp, 0))) { - PL_curcop->cop_line = PL_multi_start; + CopLINE_set(PL_curcop, PL_multi_start); missingterm(PL_tokenbuf); } - PL_curcop->cop_line++; + CopLINE_inc(PL_curcop); PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr); #ifndef PERL_STRICT_CR if (PL_bufend - PL_linestart >= 2) { @@ -6128,8 +6187,7 @@ S_scan_heredoc(pTHX_ register char *s) sv_upgrade(sv, SVt_PVMG); sv_setsv(sv,PL_linestr); - av_store(GvAV(PL_curcop->cop_filegv), - (I32)PL_curcop->cop_line,sv); + av_store(CopFILEAV(PL_curcop), (I32)CopLINE(PL_curcop),sv); } if (*s == term && memEQ(s,PL_tokenbuf,len)) { s = PL_bufend - 1; @@ -6144,7 +6202,7 @@ S_scan_heredoc(pTHX_ register char *s) } s++; retval: - PL_multi_end = PL_curcop->cop_line; + PL_multi_end = CopLINE(PL_curcop); if (SvCUR(tmpstr) + 5 < SvLEN(tmpstr)) { SvLEN_set(tmpstr, SvCUR(tmpstr) + 1); Renew(SvPVX(tmpstr), SvLEN(tmpstr), char); @@ -6335,7 +6393,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) /* after skipping whitespace, the next character is the terminator */ term = *s; /* mark where we are */ - PL_multi_start = PL_curcop->cop_line; + PL_multi_start = CopLINE(PL_curcop); PL_multi_open = term; /* find corresponding closing delimiter */ @@ -6365,7 +6423,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) for (; s < PL_bufend; s++,to++) { /* embedded newlines increment the current line number */ if (*s == '\n' && !PL_rsfp) - PL_curcop->cop_line++; + CopLINE_inc(PL_curcop); /* handle quoted delimiters */ if (*s == '\\' && s+1 < PL_bufend && term != '\\') { if (!keep_quoted && s[1] == term) @@ -6391,7 +6449,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) for (; s < PL_bufend; s++,to++) { /* embedded newlines increment the line count */ if (*s == '\n' && !PL_rsfp) - PL_curcop->cop_line++; + CopLINE_inc(PL_curcop); /* backslashes can escape the open or closing characters */ if (*s == '\\' && s+1 < PL_bufend) { if (!keep_quoted && @@ -6440,11 +6498,11 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) if (!PL_rsfp || !(PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = filter_gets(PL_linestr, PL_rsfp, 0))) { sv_free(sv); - PL_curcop->cop_line = PL_multi_start; + CopLINE_set(PL_curcop, PL_multi_start); return Nullch; } /* we read a line, so increment our line counter */ - PL_curcop->cop_line++; + CopLINE_inc(PL_curcop); /* update debugger info */ if (PERLDB_LINE && PL_curstash != PL_debstash) { @@ -6452,8 +6510,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) sv_upgrade(sv, SVt_PVMG); sv_setsv(sv,PL_linestr); - av_store(GvAV(PL_curcop->cop_filegv), - (I32)PL_curcop->cop_line, sv); + av_store(CopFILEAV(PL_curcop), (I32)CopLINE(PL_curcop), sv); } /* having changed the buffer, we must update PL_bufend */ @@ -6464,7 +6521,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) if (keep_delims) sv_catpvn(sv, s, 1); - PL_multi_end = PL_curcop->cop_line; + PL_multi_end = CopLINE(PL_curcop); s++; /* if we allocated too much space, give some back */ @@ -6514,7 +6571,7 @@ Perl_scan_num(pTHX_ char *start) register char *e; /* end of temp buffer */ IV tryiv; /* used to see if it can be an IV */ NV value; /* number read, as a double */ - SV *sv; /* place to put the converted number */ + SV *sv = Nullsv; /* place to put the converted number */ bool floatit; /* boolean: int or float? */ char *lastub = 0; /* position of last underbar */ static char number_too_long[] = "Number too long"; @@ -6526,8 +6583,7 @@ Perl_scan_num(pTHX_ char *start) Perl_croak(aTHX_ "panic: scan_num"); /* if it starts with a 0, it could be an octal number, a decimal in - 0.13 disguise, or a hexadecimal number, or a binary number. - */ + 0.13 disguise, or a hexadecimal number, or a binary number. */ case '0': { /* variables: @@ -6789,11 +6845,61 @@ Perl_scan_num(pTHX_ char *start) (floatit ? "float" : "integer"), sv, Nullsv, NULL); break; + /* if it starts with a v, it could be a version number */ + case 'v': + { + char *pos = s; + pos++; + while (isDIGIT(*pos)) + pos++; + if (*pos == '.' && isDIGIT(pos[1])) { + UV rev; + U8 tmpbuf[10]; + U8 *tmpend; + NV nshift = 1.0; + s++; /* get past 'v' */ + + sv = NEWSV(92,5); + SvUPGRADE(sv, SVt_PVNV); + sv_setpvn(sv, "", 0); + + do { + rev = atoi(s); + s = ++pos; + while (isDIGIT(*pos)) + pos++; + + tmpend = uv_to_utf8(tmpbuf, rev); + *tmpend = '\0'; + sv_catpvn(sv, (const char*)tmpbuf, tmpend - tmpbuf); + if (rev > 0) + SvNVX(sv) += (NV)rev/nshift; + nshift *= 1000; + } while (*pos == '.' && isDIGIT(pos[1])); + + rev = atoi(s); + s = pos; + tmpend = uv_to_utf8(tmpbuf, rev); + *tmpend = '\0'; + sv_catpvn(sv, (const char*)tmpbuf, tmpend - tmpbuf); + if (rev > 0) + SvNVX(sv) += (NV)rev/nshift; + + SvPOK_on(sv); + SvNOK_on(sv); + SvREADONLY_on(sv); + SvUTF8_on(sv); + } + } + break; } /* make the op for the constant and return */ - yylval.opval = newSVOP(OP_CONST, 0, sv); + if (sv) + yylval.opval = newSVOP(OP_CONST, 0, sv); + else + yylval.opval = Nullop; return s; } @@ -6835,6 +6941,14 @@ S_scan_formline(pTHX_ register char *s) needargs = TRUE; } sv_catpvn(stuff, s, eol-s); +#ifndef PERL_STRICT_CR + if (eol-s > 1 && eol[-2] == '\r' && eol[-1] == '\n') { + char *end = SvPVX(stuff) + SvCUR(stuff); + end[-2] = '\n'; + end[-1] = '\0'; + SvCUR(stuff)--; + } +#endif } s = eol; if (PL_rsfp) { @@ -6892,10 +7006,10 @@ Perl_start_subparse(pTHX_ I32 is_format, U32 flags) if (PL_compcv) { assert(SvTYPE(PL_compcv) == SVt_PVCV); } - save_I32(&PL_subline); + SAVEI32(PL_subline); save_item(PL_subname); SAVEI32(PL_padix); - SAVESPTR(PL_curpad); + SAVEVPTR(PL_curpad); SAVESPTR(PL_comppad); SAVESPTR(PL_comppad_name); SAVESPTR(PL_compcv); @@ -6915,7 +7029,7 @@ Perl_start_subparse(pTHX_ I32 is_format, U32 flags) PL_comppad_name_fill = 0; PL_min_intro_pending = 0; PL_padix = 0; - PL_subline = PL_curcop->cop_line; + PL_subline = CopLINE(PL_curcop); #ifdef USE_THREADS av_store(PL_comppad_name, 0, newSVpvn("@_", 2)); PL_curpad[0] = (SV*)newAV(); @@ -6995,28 +7109,16 @@ Perl_yyerror(pTHX_ char *s) where = SvPVX(where_sv); } msg = sv_2mortal(newSVpv(s, 0)); -#ifdef IV_IS_QUAD - Perl_sv_catpvf(aTHX_ msg, " at %_ line %" PERL_PRId64 ", ", - GvSV(PL_curcop->cop_filegv), (IV)PL_curcop->cop_line); -#else - Perl_sv_catpvf(aTHX_ msg, " at %_ line %ld, ", - GvSV(PL_curcop->cop_filegv), (long)PL_curcop->cop_line); -#endif + Perl_sv_catpvf(aTHX_ msg, " at %s line %"IVdf", ", + CopFILE(PL_curcop), (IV)CopLINE(PL_curcop)); if (context) Perl_sv_catpvf(aTHX_ msg, "near \"%.*s\"\n", contlen, context); else Perl_sv_catpvf(aTHX_ msg, "%s\n", where); - if (PL_multi_start < PL_multi_end && (U32)(PL_curcop->cop_line - PL_multi_end) <= 1) { -#ifdef IV_IS_QUAD + if (PL_multi_start < PL_multi_end && (U32)(CopLINE(PL_curcop) - PL_multi_end) <= 1) { Perl_sv_catpvf(aTHX_ msg, - " (Might be a runaway multi-line %c%c string starting on line %" PERL_\ -PRId64 ")\n", + " (Might be a runaway multi-line %c%c string starting on line %"IVdf")\n", (int)PL_multi_open,(int)PL_multi_close,(IV)PL_multi_start); -#else - Perl_sv_catpvf(aTHX_ msg, - " (Might be a runaway multi-line %c%c string starting on line %ld)\n", - (int)PL_multi_open,(int)PL_multi_close,(long)PL_multi_start); -#endif PL_multi_end = 0; } if (PL_in_eval & EVAL_WARNONLY) @@ -7024,7 +7126,7 @@ PRId64 ")\n", else qerror(msg); if (PL_error_count >= 10) - Perl_croak(aTHX_ "%_ has too many errors.\n", GvSV(PL_curcop->cop_filegv)); + Perl_croak(aTHX_ "%s has too many errors.\n", CopFILE(PL_curcop)); PL_in_my = 0; PL_in_my_stash = Nullhv; return 0; @@ -7032,7 +7134,6 @@ PRId64 ")\n", #ifdef PERL_OBJECT -#define NO_XSLOCKS #include "XSUB.h" #endif @@ -7052,29 +7153,3 @@ restore_rsfp(pTHXo_ void *f) PerlIO_close(PL_rsfp); PL_rsfp = fp; } - -/* - * restore_expect - * Restores the state of PL_expect when the lexing that begun with a - * start_lex() call has ended. - */ - -static void -restore_expect(pTHXo_ void *e) -{ - /* a safe way to store a small integer in a pointer */ - PL_expect = (expectation)((char *)e - PL_tokenbuf); -} - -/* - * restore_lex_expect - * Restores the state of PL_lex_expect when the lexing that begun with a - * start_lex() call has ended. - */ - -static void -restore_lex_expect(pTHXo_ void *e) -{ - /* a safe way to store a small integer in a pointer */ - PL_lex_expect = (expectation)((char *)e - PL_tokenbuf); -} diff --git a/universal.c b/universal.c index f7d7942..aa5487f 100644 --- a/universal.c +++ b/universal.c @@ -117,10 +117,6 @@ Perl_boot_core_UNIVERSAL(pTHX) newXS("UNIVERSAL::VERSION", XS_UNIVERSAL_VERSION, file); } -#ifdef PERL_OBJECT -#define NO_XSLOCKS -#endif /* PERL_OBJECT */ - #include "XSUB.h" XS(XS_UNIVERSAL_isa) diff --git a/unixish.h b/unixish.h index 2d37fbe..f4fe177 100644 --- a/unixish.h +++ b/unixish.h @@ -99,7 +99,7 @@ #ifndef SIGILL # define SIGILL 6 /* blech */ #endif -#define ABORT() kill(getpid(),SIGABRT); +#define ABORT() kill(PerlProc_getpid(),SIGABRT); /* * fwrite1() should be a routine with the same calling sequence as fwrite(), diff --git a/utf8.c b/utf8.c index a470376..0153fd6 100644 --- a/utf8.c +++ b/utf8.c @@ -68,8 +68,8 @@ Perl_uv_to_utf8(pTHX_ U8 *d, UV uv) *d++ = (( uv & 0x3f) | 0x80); return d; } -#ifdef Quad_t - if (uv < 0x2000000000) +#ifdef HAS_QUAD + if (uv < 0x1000000000LL) #endif { *d++ = 0xfe; /* Can't match U+FEFF! */ @@ -81,7 +81,7 @@ Perl_uv_to_utf8(pTHX_ U8 *d, UV uv) *d++ = (( uv & 0x3f) | 0x80); return d; } -#ifdef Quad_t +#ifdef HAS_QUAD { *d++ = 0xff; /* Can't match U+FFFE! */ *d++ = (((uv >> 36) & 0x3f) | 0x80); diff --git a/utf8.h b/utf8.h index 698c687..e71264c 100644 --- a/utf8.h +++ b/utf8.h @@ -27,5 +27,6 @@ EXTCONST unsigned char PL_utf8skip[]; END_EXTERN_C #define IN_UTF8 (PL_curcop->op_private & HINT_UTF8) +#define IN_BYTE (PL_curcop->op_private & HINT_BYTE) #define UTF8SKIP(s) PL_utf8skip[*(U8*)s] diff --git a/util.c b/util.c index a92c4db..2ecb73a 100644 --- a/util.c +++ b/util.c @@ -85,7 +85,7 @@ Perl_safesysmalloc(MEM_SIZE size) Malloc_t ptr; #ifdef HAS_64K_LIMIT if (size > 0xffff) { - PerlIO_printf(PerlIO_stderr(), + PerlIO_printf(Perl_error_log, "Allocation too large: %lx\n", size) FLUSH; my_exit(1); } @@ -95,13 +95,14 @@ Perl_safesysmalloc(MEM_SIZE size) Perl_croak_nocontext("panic: malloc"); #endif ptr = PerlMem_malloc(size?size:1); /* malloc(0) is NASTY on our system */ - DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) malloc %ld bytes\n",ptr,PL_an++,(long)size)); + PERL_ALLOC_CHECK(ptr); + DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) malloc %ld bytes\n",PTR2UV(ptr),(long)PL_an++,(long)size)); if (ptr != Nullch) return ptr; else if (PL_nomemok) return Nullch; else { - PerlIO_puts(PerlIO_stderr(),PL_no_mem) FLUSH; + PerlIO_puts(Perl_error_log,PL_no_mem) FLUSH; my_exit(1); return Nullch; } @@ -121,7 +122,7 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size) #ifdef HAS_64K_LIMIT if (size > 0xffff) { - PerlIO_printf(PerlIO_stderr(), + PerlIO_printf(Perl_error_log, "Reallocation too large: %lx\n", size) FLUSH; my_exit(1); } @@ -138,16 +139,17 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size) Perl_croak_nocontext("panic: realloc"); #endif ptr = PerlMem_realloc(where,size); - - DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) rfree\n",where,PL_an++)); - DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) realloc %ld bytes\n",ptr,PL_an++,(long)size)); + PERL_ALLOC_CHECK(ptr); + + DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) rfree\n",PTR2UV(where),(long)PL_an++)); + DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) realloc %ld bytes\n",PTR2UV(ptr),(long)PL_an++,(long)size)); if (ptr != Nullch) return ptr; else if (PL_nomemok) return Nullch; else { - PerlIO_puts(PerlIO_stderr(),PL_no_mem) FLUSH; + PerlIO_puts(Perl_error_log,PL_no_mem) FLUSH; my_exit(1); return Nullch; } @@ -160,7 +162,7 @@ Free_t Perl_safesysfree(Malloc_t where) { dTHX; - DEBUG_m( PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) free\n",(char *) where,PL_an++)); + DEBUG_m( PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) free\n",PTR2UV(where),(long)PL_an++)); if (where) { /*SUPPRESS 701*/ PerlMem_free(where); @@ -177,7 +179,7 @@ Perl_safesyscalloc(MEM_SIZE count, MEM_SIZE size) #ifdef HAS_64K_LIMIT if (size * count > 0xffff) { - PerlIO_printf(PerlIO_stderr(), + PerlIO_printf(Perl_error_log, "Allocation too large: %lx\n", size * count) FLUSH; my_exit(1); } @@ -188,7 +190,8 @@ Perl_safesyscalloc(MEM_SIZE count, MEM_SIZE size) #endif size *= count; ptr = PerlMem_malloc(size?size:1); /* malloc(0) is NASTY on our system */ - DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%lx: (%05d) calloc %ld x %ld bytes\n",ptr,PL_an++,(long)count,(long)size)); + PERL_ALLOC_CHECK(ptr); + DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%"UVxf": (%05ld) calloc %ld x %ld bytes\n",PTR2UV(ptr),(long)PL_an++,(long)count,(long)size)); if (ptr != Nullch) { memset((void*)ptr, 0, size); return ptr; @@ -196,7 +199,7 @@ Perl_safesyscalloc(MEM_SIZE count, MEM_SIZE size) else if (PL_nomemok) return Nullch; else { - PerlIO_puts(PerlIO_stderr(),PL_no_mem) FLUSH; + PerlIO_puts(Perl_error_log,PL_no_mem) FLUSH; my_exit(1); return Nullch; } @@ -298,7 +301,7 @@ S_xstat(pTHX_ int flag) subtot[j] = 0; } - PerlIO_printf(PerlIO_stderr(), " Id subtot 4 8 12 16 20 24 28 32 36 40 48 56 64 72 80 80+\n", total); + PerlIO_printf(Perl_debug_log, " Id subtot 4 8 12 16 20 24 28 32 36 40 48 56 64 72 80 80+\n", total); for (i = 0; i < MAXXCOUNT; i++) { total += xcount[i]; for (j = 0; j < MAXYCOUNT; j++) { @@ -309,7 +312,7 @@ S_xstat(pTHX_ int flag) : (flag == 2 ? xcount[i] != lastxcount[i] /* Changed */ : xcount[i] > lastxcount[i])) { /* Growed */ - PerlIO_printf(PerlIO_stderr(),"%2d %02d %7ld ", i / 100, i % 100, + PerlIO_printf(Perl_debug_log,"%2d %02d %7ld ", i / 100, i % 100, flag == 2 ? xcount[i] - lastxcount[i] : xcount[i]); lastxcount[i] = xcount[i]; for (j = 0; j < MAXYCOUNT; j++) { @@ -318,28 +321,28 @@ S_xstat(pTHX_ int flag) : (flag == 2 ? xycount[i][j] != lastxycount[i][j] /* Changed */ : xycount[i][j] > lastxycount[i][j])) { /* Growed */ - PerlIO_printf(PerlIO_stderr(),"%3ld ", + PerlIO_printf(Perl_debug_log,"%3ld ", flag == 2 ? xycount[i][j] - lastxycount[i][j] : xycount[i][j]); lastxycount[i][j] = xycount[i][j]; } else { - PerlIO_printf(PerlIO_stderr(), " . ", xycount[i][j]); + PerlIO_printf(Perl_debug_log, " . ", xycount[i][j]); } } - PerlIO_printf(PerlIO_stderr(), "\n"); + PerlIO_printf(Perl_debug_log, "\n"); } } if (flag != 2) { - PerlIO_printf(PerlIO_stderr(), "Total %7ld ", total); + PerlIO_printf(Perl_debug_log, "Total %7ld ", total); for (j = 0; j < MAXYCOUNT; j++) { if (subtot[j]) { - PerlIO_printf(PerlIO_stderr(), "%3ld ", subtot[j]); + PerlIO_printf(Perl_debug_log, "%3ld ", subtot[j]); } else { - PerlIO_printf(PerlIO_stderr(), " . "); + PerlIO_printf(Perl_debug_log, " . "); } } - PerlIO_printf(PerlIO_stderr(), "\n"); + PerlIO_printf(Perl_debug_log, "\n"); } } @@ -544,8 +547,6 @@ Perl_set_numeric_radix(pTHX) else PL_numeric_radix = 0; # endif /* HAS_LOCALECONV */ -#else - PL_numeric_radix = 0; #endif /* USE_LOCALE_NUMERIC */ } @@ -711,41 +712,41 @@ Perl_init_i18nl10n(pTHX_ int printwarn) if (locwarn) { #ifdef LC_ALL - PerlIO_printf(PerlIO_stderr(), + PerlIO_printf(Perl_error_log, "perl: warning: Setting locale failed.\n"); #else /* !LC_ALL */ - PerlIO_printf(PerlIO_stderr(), + PerlIO_printf(Perl_error_log, "perl: warning: Setting locale failed for the categories:\n\t"); #ifdef USE_LOCALE_CTYPE if (! curctype) - PerlIO_printf(PerlIO_stderr(), "LC_CTYPE "); + PerlIO_printf(Perl_error_log, "LC_CTYPE "); #endif /* USE_LOCALE_CTYPE */ #ifdef USE_LOCALE_COLLATE if (! curcoll) - PerlIO_printf(PerlIO_stderr(), "LC_COLLATE "); + PerlIO_printf(Perl_error_log, "LC_COLLATE "); #endif /* USE_LOCALE_COLLATE */ #ifdef USE_LOCALE_NUMERIC if (! curnum) - PerlIO_printf(PerlIO_stderr(), "LC_NUMERIC "); + PerlIO_printf(Perl_error_log, "LC_NUMERIC "); #endif /* USE_LOCALE_NUMERIC */ - PerlIO_printf(PerlIO_stderr(), "\n"); + PerlIO_printf(Perl_error_log, "\n"); #endif /* LC_ALL */ - PerlIO_printf(PerlIO_stderr(), + PerlIO_printf(Perl_error_log, "perl: warning: Please check that your locale settings:\n"); #ifdef __GLIBC__ - PerlIO_printf(PerlIO_stderr(), + PerlIO_printf(Perl_error_log, "\tLANGUAGE = %c%s%c,\n", language ? '"' : '(', language ? language : "unset", language ? '"' : ')'); #endif - PerlIO_printf(PerlIO_stderr(), + PerlIO_printf(Perl_error_log, "\tLC_ALL = %c%s%c,\n", lc_all ? '"' : '(', lc_all ? lc_all : "unset", @@ -757,18 +758,18 @@ Perl_init_i18nl10n(pTHX_ int printwarn) if (strnEQ(*e, "LC_", 3) && strnNE(*e, "LC_ALL=", 7) && (p = strchr(*e, '='))) - PerlIO_printf(PerlIO_stderr(), "\t%.*s = \"%s\",\n", + PerlIO_printf(Perl_error_log, "\t%.*s = \"%s\",\n", (int)(p - *e), *e, p + 1); } } - PerlIO_printf(PerlIO_stderr(), + PerlIO_printf(Perl_error_log, "\tLANG = %c%s%c\n", lang ? '"' : '(', lang ? lang : "unset", lang ? '"' : ')'); - PerlIO_printf(PerlIO_stderr(), + PerlIO_printf(Perl_error_log, " are supported and installed on your system.\n"); } @@ -776,13 +777,13 @@ Perl_init_i18nl10n(pTHX_ int printwarn) if (setlocale(LC_ALL, "C")) { if (locwarn) - PerlIO_printf(PerlIO_stderr(), + PerlIO_printf(Perl_error_log, "perl: warning: Falling back to the standard locale (\"C\").\n"); ok = 0; } else { if (locwarn) - PerlIO_printf(PerlIO_stderr(), + PerlIO_printf(Perl_error_log, "perl: warning: Failed to fall back to the standard locale (\"C\").\n"); ok = -1; } @@ -802,7 +803,7 @@ Perl_init_i18nl10n(pTHX_ int printwarn) ) { if (locwarn) - PerlIO_printf(PerlIO_stderr(), + PerlIO_printf(Perl_error_log, "perl: warning: Cannot fall back to the standard locale (\"C\").\n"); ok = -1; } @@ -912,7 +913,7 @@ Perl_mem_collxfrm(pTHX_ const char *s, STRLEN len, STRLEN *xlen) If FBMcf_TAIL, the table is created as if the string has a trailing \n. */ void -Perl_fbm_compile(pTHX_ SV *sv, U32 flags /* not used yet */) +Perl_fbm_compile(pTHX_ SV *sv, U32 flags) { register U8 *s; register U8 *table; @@ -928,23 +929,23 @@ Perl_fbm_compile(pTHX_ SV *sv, U32 flags /* not used yet */) if (len == 0) /* TAIL might be on on a zero-length string. */ return; if (len > 2) { - I32 mlen = len; + U8 mlen; unsigned char *sb; - if (mlen > 255) + if (len > 255) mlen = 255; - Sv_Grow(sv,len + 256 + FBM_TABLE_OFFSET); + else + mlen = (U8)len; + Sv_Grow(sv, len + 256 + FBM_TABLE_OFFSET); table = (unsigned char*)(SvPVX(sv) + len + FBM_TABLE_OFFSET); - s = table - 1 - FBM_TABLE_OFFSET; /* Last char */ - for (i = 0; i < 256; i++) { - table[i] = mlen; - } - table[-1] = flags; /* Not used yet */ + s = table - 1 - FBM_TABLE_OFFSET; /* last char */ + memset((void*)table, mlen, 256); + table[-1] = (U8)flags; i = 0; - sb = s - mlen; + sb = s - mlen + 1; /* first char (maybe) */ while (s >= sb) { if (table[*s] == mlen) - table[*s] = i; + table[*s] = (U8)i; s--, i++; } } @@ -963,7 +964,8 @@ Perl_fbm_compile(pTHX_ SV *sv, U32 flags /* not used yet */) BmUSEFUL(sv) = 100; /* Initial value */ if (flags & FBMcf_TAIL) SvTAIL_on(sv); - DEBUG_r(PerlIO_printf(Perl_debug_log, "rarest char %c at %d\n",BmRARE(sv),BmPREVIOUS(sv))); + DEBUG_r(PerlIO_printf(Perl_debug_log, "rarest char %c at %d\n", + BmRARE(sv),BmPREVIOUS(sv))); } /* If SvTAIL(littlestr), it has a fake '\n' at end. */ @@ -1075,15 +1077,17 @@ Perl_fbm_instr(pTHX_ unsigned char *big, register unsigned char *bigend, SV *lit } if (SvTAIL(littlestr) && !multiline) { /* tail anchored? */ s = bigend - littlelen; - if (s >= big - && bigend[-1] == '\n' - && *s == *little + if (s >= big && bigend[-1] == '\n' && *s == *little /* Automatically of length > 2 */ && memEQ((char*)s + 1, (char*)little + 1, littlelen - 2)) + { return (char*)s; /* how sweet it is */ - if (s[1] == *little && memEQ((char*)s + 2,(char*)little + 1, - littlelen - 2)) + } + if (s[1] == *little + && memEQ((char*)s + 2, (char*)little + 1, littlelen - 2)) + { return (char*)s + 1; /* how sweet it is */ + } return Nullch; } if (SvTYPE(littlestr) != SVt_PVBM || !SvVALID(littlestr)) { @@ -1093,9 +1097,11 @@ Perl_fbm_instr(pTHX_ unsigned char *big, register unsigned char *bigend, SV *lit if (!b && SvTAIL(littlestr)) { /* Automatically multiline! */ /* Chop \n from littlestr: */ s = bigend - littlelen + 1; - if (*s == *little && memEQ((char*)s + 1, (char*)little + 1, - littlelen - 2)) + if (*s == *little + && memEQ((char*)s + 1, (char*)little + 1, littlelen - 2)) + { return (char*)s; + } return Nullch; } return b; @@ -1117,7 +1123,7 @@ Perl_fbm_instr(pTHX_ unsigned char *big, register unsigned char *bigend, SV *lit top2: /*SUPPRESS 560*/ - if (tmp = table[*s]) { + if ((tmp = table[*s])) { #ifdef POINTERRIGOR if (bigend - s > tmp) { s += tmp; @@ -1413,29 +1419,16 @@ Perl_vmess(pTHX_ const char *pat, va_list *args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); if (!SvCUR(sv) || *(SvEND(sv) - 1) != '\n') { dTHR; -#ifdef IV_IS_QUAD - if (PL_curcop->cop_line) - Perl_sv_catpvf(aTHX_ sv, " at %_ line %" PERL_PRId64, - GvSV(PL_curcop->cop_filegv), (IV)PL_curcop->cop_line); -#else - if (PL_curcop->cop_line) - Perl_sv_catpvf(aTHX_ sv, " at %_ line %ld", - GvSV(PL_curcop->cop_filegv), (long)PL_curcop->cop_line); -#endif + if (CopLINE(PL_curcop)) + Perl_sv_catpvf(aTHX_ sv, " at %s line %"IVdf, + CopFILE(PL_curcop), (IV)CopLINE(PL_curcop)); if (GvIO(PL_last_in_gv) && IoLINES(GvIOp(PL_last_in_gv))) { bool line_mode = (RsSIMPLE(PL_rs) && SvCUR(PL_rs) == 1 && *SvPVX(PL_rs) == '\n'); -#ifdef IV_IS_QUAD - Perl_sv_catpvf(aTHX_ sv, ", <%s> %s %" PERL_PRId64, + Perl_sv_catpvf(aTHX_ sv, ", <%s> %s %"IVdf, PL_last_in_gv == PL_argvgv ? "" : GvNAME(PL_last_in_gv), line_mode ? "line" : "chunk", (IV)IoLINES(GvIOp(PL_last_in_gv))); -#else - Perl_sv_catpvf(aTHX_ sv, ", <%s> %s %ld", - PL_last_in_gv == PL_argvgv ? "" : GvNAME(PL_last_in_gv), - line_mode ? "line" : "chunk", - (long)IoLINES(GvIOp(PL_last_in_gv))); -#endif } #ifdef USE_THREADS if (thr->tid) @@ -1458,7 +1451,7 @@ Perl_vdie(pTHX_ const char* pat, va_list *args) SV *msv; STRLEN msglen; - DEBUG_S(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: die: curstack = %p, mainstack = %p\n", thr, PL_curstack, PL_mainstack)); @@ -1476,7 +1469,7 @@ Perl_vdie(pTHX_ const char* pat, va_list *args) message = Nullch; } - DEBUG_S(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: die: message = %s\ndiehook = %p\n", thr, message, PL_diehook)); if (PL_diehook) { @@ -1505,18 +1498,14 @@ Perl_vdie(pTHX_ const char* pat, va_list *args) PUSHMARK(SP); XPUSHs(msg); PUTBACK; - /* HACK - REVISIT - avoid CATCH_SET(TRUE) in call_sv() - or we come back here due to a JMPENV_JMP() and do - a POPSTACK - but die_where() will have already done - one as it unwound - NI-S 1999/08/14 */ - call_sv((SV*)cv, G_DISCARD|G_NOCATCH); + call_sv((SV*)cv, G_DISCARD); POPSTACK; LEAVE; } } PL_restartop = die_where(message, msglen); - DEBUG_S(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: die: restartop = %p, was_in_eval = %d, top_env = %p\n", thr, PL_restartop, was_in_eval, PL_top_env)); if ((!PL_restartop && was_in_eval) || PL_top_env->je_prev) @@ -1569,8 +1558,8 @@ Perl_vcroak(pTHX_ const char* pat, va_list *args) else message = SvPV(msv,msglen); - DEBUG_S(PerlIO_printf(PerlIO_stderr(), "croak: 0x%lx %s", - (unsigned long) thr, message)); + DEBUG_S(PerlIO_printf(Perl_debug_log, "croak: 0x%"UVxf" %s", + PTR2UV(thr), message)); if (PL_diehook) { /* sv_2cv might call Perl_croak() */ @@ -1607,8 +1596,10 @@ Perl_vcroak(pTHX_ const char* pat, va_list *args) /* SFIO can really mess with your errno */ int e = errno; #endif - PerlIO_write(PerlIO_stderr(), message, msglen); - (void)PerlIO_flush(PerlIO_stderr()); + PerlIO *serr = Perl_error_log; + + PerlIO_write(serr, message, msglen); + (void)PerlIO_flush(serr); #ifdef USE_SFIO errno = e; #endif @@ -1680,16 +1671,20 @@ Perl_vwarn(pTHX_ const char* pat, va_list *args) return; } } - PerlIO_write(PerlIO_stderr(), message, msglen); + { + PerlIO *serr = Perl_error_log; + + PerlIO_write(serr, message, msglen); #ifdef LEAKTEST - DEBUG_L(*message == '!' - ? (xstat(message[1]=='!' - ? (message[2]=='!' ? 2 : 1) - : 0) - , 0) - : 0); + DEBUG_L(*message == '!' + ? (xstat(message[1]=='!' + ? (message[2]=='!' ? 2 : 1) + : 0) + , 0) + : 0); #endif - (void)PerlIO_flush(PerlIO_stderr()); + (void)PerlIO_flush(serr); + } } #if defined(PERL_IMPLICIT_CONTEXT) @@ -1750,7 +1745,7 @@ Perl_vwarner(pTHX_ U32 err, const char* pat, va_list* args) if (ckDEAD(err)) { #ifdef USE_THREADS - DEBUG_S(PerlIO_printf(PerlIO_stderr(), "croak: 0x%lx %s", (unsigned long) thr, message)); + DEBUG_S(PerlIO_printf(Perl_debug_log, "croak: 0x%"UVxf" %s", PTR2UV(thr), message)); #endif /* USE_THREADS */ if (PL_diehook) { /* sv_2cv might call Perl_croak() */ @@ -1781,8 +1776,11 @@ Perl_vwarner(pTHX_ U32 err, const char* pat, va_list* args) PL_restartop = die_where(message, msglen); JMPENV_JUMP(3); } - PerlIO_write(PerlIO_stderr(), message, msglen); - (void)PerlIO_flush(PerlIO_stderr()); + { + PerlIO *serr = Perl_error_log; + PerlIO_write(serr, message, msglen); + (void)PerlIO_flush(serr); + } my_failure_exit(); } @@ -1814,11 +1812,14 @@ Perl_vwarner(pTHX_ U32 err, const char* pat, va_list* args) return; } } - PerlIO_write(PerlIO_stderr(), message, msglen); + { + PerlIO *serr = Perl_error_log; + PerlIO_write(serr, message, msglen); #ifdef LEAKTEST - DEBUG_L(xstat()); + DEBUG_L(xstat()); #endif - (void)PerlIO_flush(PerlIO_stderr()); + (void)PerlIO_flush(serr); + } } } @@ -1888,7 +1889,7 @@ Perl_my_setenv_init(char ***penviron) } void -my_setenv(char *nam, char *val) +Perl_my_setenv(pTHX_ char *nam, char *val) { /* You can not directly manipulate the environ[] array because * the routines do some additional work that syncs the Cygwin @@ -1900,13 +1901,13 @@ my_setenv(char *nam, char *val) if (!oldstr) return; unsetenv(nam); - Safefree(oldstr); + safesysfree(oldstr); return; } setenv(nam, val, 1); environ = *Perl_main_environ; /* environ realloc can occur in setenv */ if(oldstr && environ[setenv_getix(nam)] != oldstr) - Safefree(oldstr); + safesysfree(oldstr); } #else /* if WIN32 */ @@ -2002,9 +2003,10 @@ Perl_unlnk(pTHX_ char *f) /* unlink all versions of a file */ } #endif +/* this is a drop-in replacement for bcopy() */ #if !defined(HAS_BCOPY) || !defined(HAS_SAFE_BCOPY) char * -Perl_my_bcopy(pTHX_ register const char *from,register char *to,register I32 len) +Perl_my_bcopy(register const char *from,register char *to,register I32 len) { char *retval = to; @@ -2022,9 +2024,10 @@ Perl_my_bcopy(pTHX_ register const char *from,register char *to,register I32 len } #endif +/* this is a drop-in replacement for memset() */ #ifndef HAS_MEMSET void * -Perl_my_memset(pTHX_ register char *loc, register I32 ch, register I32 len) +Perl_my_memset(register char *loc, register I32 ch, register I32 len) { char *retval = loc; @@ -2034,9 +2037,10 @@ Perl_my_memset(pTHX_ register char *loc, register I32 ch, register I32 len) } #endif +/* this is a drop-in replacement for bzero() */ #if !defined(HAS_BZERO) && !defined(HAS_MEMSET) char * -Perl_my_bzero(pTHX_ register char *loc, register I32 len) +Perl_my_bzero(register char *loc, register I32 len) { char *retval = loc; @@ -2046,9 +2050,10 @@ Perl_my_bzero(pTHX_ register char *loc, register I32 len) } #endif +/* this is a drop-in replacement for memcmp() */ #if !defined(HAS_MEMCMP) || !defined(HAS_SANE_MEMCMP) I32 -Perl_my_memcmp(pTHX_ const char *s1, const char *s2, register I32 len) +Perl_my_memcmp(const char *s1, const char *s2, register I32 len) { register U8 *a = (U8 *)s1; register U8 *b = (U8 *)s2; @@ -2224,7 +2229,7 @@ VTOH(vtohl,long) #endif /* VMS' my_popen() is in VMS.c, same with OS/2. */ -#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(__OPEN_VM) && !defined(EPOC) +#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(__OPEN_VM) && !defined(EPOC) && !defined(MACOS_TRADITIONAL) PerlIO * Perl_my_popen(pTHX_ char *cmd, char *mode) { @@ -2301,7 +2306,7 @@ Perl_my_popen(pTHX_ char *cmd, char *mode) #endif /* defined OS2 */ /*SUPPRESS 560*/ if (tmpgv = gv_fetchpv("$",TRUE, SVt_PV)) - sv_setiv(GvSV(tmpgv), getpid()); + sv_setiv(GvSV(tmpgv), PerlProc_getpid()); PL_forkprocess = 0; hv_clear(PL_pidstatus); /* we have no children */ return Nullfp; @@ -2368,12 +2373,12 @@ Perl_dump_fds(pTHX_ char *s) int fd; struct stat tmpstatbuf; - PerlIO_printf(PerlIO_stderr(),"%s", s); + PerlIO_printf(Perl_debug_log,"%s", s); for (fd = 0; fd < 32; fd++) { if (PerlLIO_fstat(fd,&tmpstatbuf) >= 0) - PerlIO_printf(PerlIO_stderr()," %d",fd); + PerlIO_printf(Perl_debug_log," %d",fd); } - PerlIO_printf(PerlIO_stderr(),"\n"); + PerlIO_printf(Perl_debug_log,"\n"); } #endif /* DUMP_FDS */ @@ -2496,7 +2501,7 @@ Perl_rsignal_state(pTHX_ int signo) oldsig = PerlProc_signal(signo, sig_trap); PerlProc_signal(signo, oldsig); if (sig_trapped) - PerlProc_kill(getpid(), signo); + PerlProc_kill(PerlProc_getpid(), signo); return oldsig; } @@ -2516,7 +2521,7 @@ Perl_rsignal_restore(pTHX_ int signo, Sigsave_t *save) #endif /* !HAS_SIGACTION */ /* VMS' my_pclose() is in VMS.c; same with OS/2 */ -#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(__OPEN_VM) && !defined(EPOC) +#if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(__OPEN_VM) && !defined(EPOC) && !defined(MACOS_TRADITIONAL) I32 Perl_my_pclose(pTHX_ PerlIO *ptr) { @@ -2572,7 +2577,7 @@ Perl_my_pclose(pTHX_ PerlIO *ptr) } #endif /* !DOSISH */ -#if !defined(DOSISH) || defined(OS2) || defined(WIN32) +#if (!defined(DOSISH) || defined(OS2) || defined(WIN32)) && !defined(MACOS_TRADITIONAL) I32 Perl_wait4pid(pTHX_ Pid_t pid, int *statusp, int flags) { @@ -2583,7 +2588,7 @@ Perl_wait4pid(pTHX_ Pid_t pid, int *statusp, int flags) if (!pid) return -1; if (pid > 0) { - sprintf(spid, "%d", pid); + sprintf(spid, "%"IVdf, (IV)pid); svp = hv_fetch(PL_pidstatus,spid,strlen(spid),FALSE); if (svp && *svp != &PL_sv_undef) { *statusp = SvIVX(*svp); @@ -2599,7 +2604,7 @@ Perl_wait4pid(pTHX_ Pid_t pid, int *statusp, int flags) pid = atoi(hv_iterkey(entry,(I32*)statusp)); sv = hv_iterval(PL_pidstatus,entry); *statusp = SvIVX(sv); - sprintf(spid, "%d", pid); + sprintf(spid, "%"IVdf, (IV)pid); (void)hv_delete(PL_pidstatus,spid,strlen(spid),G_DISCARD); return pid; } @@ -2639,7 +2644,7 @@ Perl_pidgone(pTHX_ Pid_t pid, int status) register SV *sv; char spid[TYPE_CHARS(int)]; - sprintf(spid, "%d", pid); + sprintf(spid, "%"IVdf, (IV)pid); sv = *hv_fetch(PL_pidstatus,spid,strlen(spid),TRUE); (void)SvUPGRADE(sv,SVt_IV); SvIVX(sv) = status; @@ -3122,15 +3127,26 @@ Perl_find_script(pTHX_ char *scriptname, bool dosearch, char **search_ext, I32 f } #endif +#ifdef MACOS_TRADITIONAL + if (dosearch && !strchr(scriptname, ':') && + (s = PerlEnv_getenv("Commands"))) +#else if (dosearch && !strchr(scriptname, '/') #ifdef DOSISH && !strchr(scriptname, '\\') #endif - && (s = PerlEnv_getenv("PATH"))) { + && (s = PerlEnv_getenv("PATH"))) +#endif + { bool seen_dot = 0; PL_bufend = s + strlen(s); while (s < PL_bufend) { +#ifdef MACOS_TRADITIONAL + s = delimcpy(tmpbuf, tmpbuf + sizeof tmpbuf, s, PL_bufend, + ',', + &len); +#else #if defined(atarist) || defined(DOSISH) for (len = 0; *s # ifdef atarist @@ -3147,10 +3163,15 @@ Perl_find_script(pTHX_ char *scriptname, bool dosearch, char **search_ext, I32 f ':', &len); #endif /* ! (atarist || DOSISH) */ +#endif /* MACOS_TRADITIONAL */ if (s < PL_bufend) s++; if (len + 1 + strlen(scriptname) + MAX_EXT_LEN >= sizeof tmpbuf) continue; /* don't search dir with too-long name */ +#ifdef MACOS_TRADITIONAL + if (len && tmpbuf[len - 1] != ':') + tmpbuf[len++] = ':'; +#else if (len #if defined(atarist) || defined(__MINT__) || defined(DOSISH) && tmpbuf[len - 1] != '/' @@ -3160,6 +3181,7 @@ Perl_find_script(pTHX_ char *scriptname, bool dosearch, char **search_ext, I32 f tmpbuf[len++] = '/'; if (len == 2 && tmpbuf[0] == '.') seen_dot = 1; +#endif (void)strcpy(tmpbuf + len, scriptname); #endif /* !VMS */ @@ -3184,7 +3206,7 @@ Perl_find_script(pTHX_ char *scriptname, bool dosearch, char **search_ext, I32 f continue; if (S_ISREG(PL_statbuf.st_mode) && cando(S_IRUSR,TRUE,&PL_statbuf) -#ifndef DOSISH +#if !defined(DOSISH) && !defined(MACOS_TRADITIONAL) && cando(S_IXUSR,TRUE,&PL_statbuf) #endif ) @@ -3321,11 +3343,11 @@ Perl_condpair_magic(pTHX_ SV *sv) COND_INIT(&cp->owner_cond); COND_INIT(&cp->cond); cp->owner = 0; - MUTEX_LOCK(&PL_cred_mutex); /* XXX need separate mutex? */ + LOCK_CRED_MUTEX; /* XXX need separate mutex? */ mg = mg_find(sv, 'm'); if (mg) { /* someone else beat us to initialising it */ - MUTEX_UNLOCK(&PL_cred_mutex); /* XXX need separate mutex? */ + UNLOCK_CRED_MUTEX; /* XXX need separate mutex? */ MUTEX_DESTROY(&cp->mutex); COND_DESTROY(&cp->owner_cond); COND_DESTROY(&cp->cond); @@ -3336,8 +3358,8 @@ Perl_condpair_magic(pTHX_ SV *sv) mg = SvMAGIC(sv); mg->mg_ptr = (char *)cp; mg->mg_len = sizeof(cp); - MUTEX_UNLOCK(&PL_cred_mutex); /* XXX need separate mutex? */ - DEBUG_S(WITH_THR(PerlIO_printf(PerlIO_stderr(), + UNLOCK_CRED_MUTEX; /* XXX need separate mutex? */ + DEBUG_S(WITH_THR(PerlIO_printf(Perl_debug_log, "%p: condpair_magic %p\n", thr, sv));) } } @@ -3378,8 +3400,6 @@ Perl_new_struct_thread(pTHX_ struct perl_thread *t) Zero(thr, 1, struct perl_thread); #endif - PL_protect = MEMBER_TO_FPTR(Perl_default_protect); - thr->oursv = sv; init_stacks(); @@ -3389,22 +3409,10 @@ Perl_new_struct_thread(pTHX_ struct perl_thread *t) thr->threadsv = newAV(); thr->specific = newAV(); thr->errsv = newSVpvn("", 0); - thr->errhv = newHV(); thr->flags = THRf_R_JOINABLE; MUTEX_INIT(&thr->mutex); - /* top_env needs to be non-zero. It points to an area - in which longjmp() stuff is stored, as C callstack - info there at least is thread specific this has to - be per-thread. Otherwise a 'die' in a thread gives - that thread the C stack of last thread to do an eval {}! - See comments in scope.h - Initialize top entry (as in perl.c for main thread) - */ - PL_start_env.je_prev = NULL; - PL_start_env.je_ret = -1; - PL_start_env.je_mustcatch = TRUE; - PL_top_env = &PL_start_env; + JMPENV_BOOTSTRAP; PL_in_eval = EVAL_NULL; /* ~(EVAL_INEVAL|EVAL_WARNONLY|EVAL_KEEPERR) */ PL_restartop = 0; @@ -3444,9 +3452,12 @@ Perl_new_struct_thread(pTHX_ struct perl_thread *t) PL_ofs = savepvn(t->Tofs, PL_ofslen); PL_defoutgv = (GV*)SvREFCNT_inc(t->Tdefoutgv); PL_chopset = t->Tchopset; - PL_formtarget = newSVsv(t->Tformtarget); PL_bodytarget = newSVsv(t->Tbodytarget); PL_toptarget = newSVsv(t->Ttoptarget); + if (t->Tformtarget == t->Ttoptarget) + PL_formtarget = PL_toptarget; + else + PL_formtarget = PL_bodytarget; /* Initialise all per-thread SVs that the template thread used */ svp = AvARRAY(t->threadsv); @@ -3455,8 +3466,9 @@ Perl_new_struct_thread(pTHX_ struct perl_thread *t) SV *sv = newSVsv(*svp); av_store(thr->threadsv, i, sv); sv_magic(sv, 0, 0, &PL_threadsv_names[i], 1); - DEBUG_S(PerlIO_printf(PerlIO_stderr(), - "new_struct_thread: copied threadsv %d %p->%p\n",i, t, thr)); + DEBUG_S(PerlIO_printf(Perl_debug_log, + "new_struct_thread: copied threadsv %"IVdf" %p->%p\n", + (IV)i, t, thr)); } } thr->threadsvp = AvARRAY(thr->threadsv); diff --git a/util.h b/util.h index 7dcf9ce..1c2c555 100644 --- a/util.h +++ b/util.h @@ -6,3 +6,27 @@ * License or the Artistic License, as specified in the README file. * */ + +#ifdef VMS +# define PERL_FILE_IS_ABSOLUTE(f) \ + (*(f) == '/' \ + || (strchr(f,':') \ + || ((*(f) == '[' || *(f) == '<') \ + && (isALNUM((f)[1]) || strchr("$-_]>",(f)[1]))))) + +#else /* !VMS */ +# ifdef WIN32 +# define PERL_FILE_IS_ABSOLUTE(f) \ + (*(f) == '/' \ + || ((f)[0] && (f)[1] == ':') /* drive name */ \ + || ((f)[0] == '\\' && (f)[1] == '\\')) /* UNC path */ +# else /* !WIN32 */ +# ifdef DOSISH +# define PERL_FILE_IS_ABSOLUTE(f) \ + (*(f) == '/' \ + || ((f)[0] && (f)[1] == ':')) /* drive name */ +# else /* !DOSISH */ +# define PERL_FILE_IS_ABSOLUTE(f) (*(f) == '/') +# endif /* DOSISH */ +# endif /* WIN32 */ +#endif /* VMS */ diff --git a/utils/h2xs.PL b/utils/h2xs.PL index ae266de..ca55c0a 100644 --- a/utils/h2xs.PL +++ b/utils/h2xs.PL @@ -81,7 +81,11 @@ the POD template. =item B<-F> Additional flags to specify to C preprocessor when scanning header for -function declarations. Should not be used without B<-x>. +function declarations. Should not be used without B<-x>. + +=item B<-M> I + +selects functions/macros to process. =item B<-O> @@ -108,7 +112,7 @@ Turn on debugging messages. =item B<-f> Allows an extension to be created for a header even if that header is -not found in /usr/include. +not found in standard include directories. =item B<-h> @@ -118,6 +122,21 @@ Print the usage, help and version for this h2xs and exit. Specifies a name to be used for the extension, e.g., S<-n RPC::DCE> +=item B<-o> I + +Use "opaque" data type for the C types matched by the regular +expression, even if these types are C-equivalent to types +from typemaps. Should not be used without B<-x>. + +This may be useful since, say, types which are C-equivalent +to integers may represent OS-related handles, and one may want to work +with these handles in OO-way, as in C<$handle-Edo_something()>. +Use C<-o .> if you want to handle all the Ced types as opaque types. + +The type-to-match is whitewashed (except for commas, which have no +whitespace before them, and multiple C<*> which have no whitespace +between them). + =item B<-p> I Specify a prefix which should be removed from the Perl function names, e.g., S<-p sec_rgy_> @@ -145,7 +164,8 @@ but XSUBs are emitted only for the declarations included from file NAME2. Note that some types of arguments/return-values for functions may result in XSUB-declarations/typemap-entries which need hand-editing. Such may be objects which cannot be converted from/to a -pointer (like C), pointers to functions, or arrays. +pointer (like C), pointers to functions, or arrays. See +also the section on L>. =back @@ -198,6 +218,12 @@ pointer (like C), pointers to functions, or arrays. # Same with function declaration in proto.h as visible from perl.h. h2xs -xAn perl2 perl.h,proto.h + # Same but select only functions which match /^av_/ + h2xs -M '^av_' -xAn perl2 perl.h,proto.h + + # Same but treat SV* etc as "opaque" types + h2xs -o '^[S]V \*$' -M '^av_' -xAn perl2 perl.h,proto.h + =head1 ENVIRONMENT No environment variables are used. @@ -214,10 +240,74 @@ L, L, L, and L. The usual warnings if it cannot read or write the files involved. +=head1 LIMITATIONS of B<-x> + +F would not distinguish whether an argument to a C function +which is of the form, say, C, is an input, output, or +input/output parameter. In particular, argument declarations of the +form + + int + foo(n) + int *n + +should be better rewritten as + + int + foo(n) + int &n + +if C is an input parameter. + +Additionally, F has no facilities to intuit that a function + + int + foo(addr,l) + char *addr + int l + +takes a pair of address and length of data at this address, so it is better +to rewrite this function as + + int + foo(sv) + SV *addr + PREINIT: + STRLEN len; + char *s; + CODE: + s = SvPV(sv,len); + RETVAL = foo(s, len); + OUTPUT: + RETVAL + +or alternately + + static int + my_foo(SV *sv) + { + STRLEN len; + char *s = SvPV(sv,len); + + return foo(s, len); + } + + MODULE = foo PACKAGE = foo PREFIX = my_ + + int + foo(sv) + SV *sv + +See L and L for additional details. + =cut -my( $H2XS_VERSION ) = ' $Revision: 1.19 $ ' =~ /\$Revision:\s+([^\s]+)/; +use strict; + + +my( $H2XS_VERSION ) = ' $Revision: 1.20 $ ' =~ /\$Revision:\s+([^\s]+)/; my $TEMPLATE_VERSION = '0.01'; +my @ARGS = @ARGV; use Getopt::Std; @@ -228,6 +318,7 @@ version: $H2XS_VERSION -A Omit all autoloading facilities (implies -c). -C Omit creating the Changes file, add HISTORY heading to stub POD. -F Additional flags for C preprocessor (used with -x). + -M Mask to select C functions/macros (default is select all). -O Allow overwriting of a pre-existing extension directory. -P Omit the stub POD section. -X Omit the XS portion (implies both -c and -f). @@ -236,6 +327,7 @@ version: $H2XS_VERSION -f Force creation of the extension even if the C header does not exist. -h Display this help message -n Specify a name to use for the extension (recommended). + -o Regular expression for \"opaque\" types. -p Specify a prefix which should be removed from the Perl function names. -s Create subroutines for specified macros. -v Specify a version number for this extension. @@ -247,7 +339,9 @@ extra_libraries } -getopts("ACF:OPXcdfhn:p:s:v:x") || usage; +getopts("ACF:M:OPXcdfhn:o:p:s:v:x") || usage; +use vars qw($opt_A $opt_C $opt_F $opt_M $opt_O $opt_P $opt_X $opt_c + $opt_d $opt_f $opt_h $opt_n $opt_o $opt_p $opt_s $opt_v $opt_x); usage if $opt_h; @@ -261,7 +355,9 @@ $opt_c = 1 if $opt_A; # -X implies -c and -f $opt_c = $opt_f = 1 if $opt_X; -%const_xsub = map { $_,1 } split(/,+/, $opt_s) if $opt_s; +my %const_xsub = map { $_,1 } split(/,+/, $opt_s) if $opt_s; +my $extralibs; +my @path_h; while (my $arg = shift) { if ($arg =~ /^-l/i) { @@ -274,34 +370,70 @@ while (my $arg = shift) { usage "Must supply header file or module name\n" unless (@path_h or $opt_n); +my $fmask; +my $tmask; + +$fmask = qr{$opt_M} if defined $opt_M; +$tmask = qr{$opt_o} if defined $opt_o; +my $tmask_all = $tmask && $opt_o eq '.'; + +if ($opt_x) { + eval {require C::Scan; 1} + or die <= 0.70 + or die <curdir(), $Config{usrinc}, + (split ' ', $Config{locincpth}), '/usr/include'); + } foreach my $path_h (@path_h) { $name ||= $path_h; if( $path_h =~ s#::#/#g && $opt_n ){ warn "Nesting of headerfile ignored with -n\n"; } $path_h .= ".h" unless $path_h =~ /\.h$/; - $fullpath = $path_h; + my $fullpath = $path_h; $path_h =~ s/,.*$// if $opt_x; - if ($^O eq 'VMS') { # Consider overrides of default location - if ($path_h !~ m![:>\[]!) { - my($hadsys) = ($path_h =~ s!^sys/!!i); - if ($ENV{'DECC$System_Include'}) { $path_h = "DECC\$System_Include:$path_h"; } - elsif ($ENV{'DECC$Library_Include'}) { $path_h = "DECC\$Library_Include:$path_h"; } - elsif ($ENV{'GNU_CC_Include'}) { $path_h = 'GNU_CC_Include:' . - ($hadsys ? '[vms]' : '[000000]') . $path_h; } - elsif ($ENV{'VAXC$Include'}) { $path_h = "VAXC\$_Include:$path_h"; } - else { $path_h = "Sys\$Library:$path_h"; } - } - } - elsif ($^O eq 'os2') { - $path_h = "/usr/include/$path_h" - if $path_h !~ m#^([a-z]:)?[./]#i and -r "/usr/include/$path_h"; - } - else { - $path_h = "/usr/include/$path_h" - if $path_h !~ m#^[./]# and -r "/usr/include/$path_h"; + $fullpath{$path_h} = $fullpath; + + if (not -f $path_h) { + my $tmp_path_h = $path_h; + for my $dir (@paths) { + last if -f ($path_h = File::Spec->catfile($dir, $tmp_path_h)); + } } if (!$opt_c) { @@ -310,10 +442,24 @@ if( @path_h ){ # Record the names of simple #define constants into const_names # Function prototypes are processed below. open(CH, "<$path_h") || die "Can't open $path_h: $!\n"; + defines: while () { - if (/^#[ \t]*define\s+([\$\w]+)\b\s*[^("]/) { - print "Matched $_ ($1)\n" if $opt_d; - $_ = $1; + if (/^[ \t]*#[ \t]*define\s+([\$\w]+)\b(?!\()\s*(?=[^" \t])(.*)/) { + my $def = $1; + my $rest = $2; + $rest =~ s!/\*.*?(\*/|\n)|//.*!!g; # Remove comments + $rest =~ s/^\s+//; + $rest =~ s/\s+$//; + # Cannot do: (-1) and ((LHANDLE)3) are OK: + #print("Skip non-wordy $def => $rest\n"), + # next defines if $rest =~ /[^\w\$]/; + if ($rest =~ /"/) { + print("Skip stringy $def => $rest\n") if $opt_d; + next defines; + } + print "Matched $_ ($def)\n" if $opt_d; + $seen_define{$def} = $rest; + $_ = $def; next if /^_.*_h_*$/i; # special case, but for what? if (defined $opt_p) { if (!/^$opt_p(\d)/) { @@ -323,17 +469,20 @@ if( @path_h ){ warn "can't remove $opt_p prefix from '$_'!\n"; } } - $const_names{$_}++; + $prefixless{$def} = $_; + if (!$fmask or /$fmask/) { + print "... Passes mask of -M.\n" if $opt_d and $fmask; + $const_names{$_}++; + } } } close(CH); } } - @const_names = sort keys %const_names; } -$module = $opt_n || do { +my $module = $opt_n || do { $name =~ s/\.h$//; if( $name !~ /::/ ){ $name =~ s#^.*/##; @@ -342,6 +491,7 @@ $module = $opt_n || do { $name; }; +my ($ext, $nested, @modparts, $modfname, $modpname); (chdir 'ext', $ext = 'ext/') if -d 'ext'; if( $module =~ /::/ ){ @@ -359,11 +509,12 @@ else { if ($opt_O) { warn "Overwriting existing $ext$modpname!!!\n" if -e $modpname; -} else { +} +else { die "Won't overwrite existing $ext$modpname\n" if -e $modpname; } if( $nested ){ - $modpath = ""; + my $modpath = ""; foreach (@modparts){ mkdir("$modpath$_", 0777); $modpath .= "$_/"; @@ -376,19 +527,28 @@ my %types_seen; my %std_types; my $fdecls = []; my $fdecls_parsed = []; +my $typedef_rex; +my %typedefs_pre; +my %known_fnames; + +my @fnames; +my @fnames_no_prefix; if( ! $opt_X ){ # use XS, unless it was disabled open(XS, ">$modfname.xs") || die "Can't create $ext$modpname/$modfname.xs: $!\n"; if ($opt_x) { - require C::Scan; # Run-time directive require Config; # Run-time directive warn "Scanning typemaps...\n"; get_typemap(); - my $c; - my $filter; + my @td; + my @good_td; + my $addflags = $opt_F || ''; + foreach my $filename (@path_h) { - my $addflags = $opt_F || ''; - if ($fullpath =~ /,/) { + my $c; + my $filter; + + if ($fullpath{$filename} =~ /,/) { $filename = $`; $filter = $'; } @@ -396,12 +556,71 @@ if( ! $opt_X ){ # use XS, unless it was disabled $c = new C::Scan 'filename' => $filename, 'filename_filter' => $filter, 'add_cppflags' => $addflags; $c->set('includeDirs' => ["$Config::Config{archlib}/CORE"]); - + push @$fdecls_parsed, @{ $c->get('parsed_fdecls') }; push(@$fdecls, @{$c->get('fdecls')}); + + push @td, @{$c->get('typedefs_maybe')}; + + unless ($tmask_all) { + warn "Scanning $filename for typedefs...\n"; + my $td = $c->get('typedef_hash'); + # eval {require 'dumpvar.pl'; ::dumpValue($td)} or warn $@ if $opt_d; + my @f_good_td = grep $td->{$_}[1] eq '', keys %$td; + push @good_td, @f_good_td; + @typedefs_pre{@f_good_td} = map $_->[0], @$td{@f_good_td}; + } + } + { local $" = '|'; + $typedef_rex = qr(\b(?[$i][1] =~ /$fmask/; # [1] is NAME + push @good, $i; + print "... Function $fdecls_parsed->[$i][1] passes -M mask.\n" + if $opt_d; + } + $fdecls = [@$fdecls[@good]]; + $fdecls_parsed = [@$fdecls_parsed[@good]]; + } + @fnames = sort map $_->[1], @$fdecls_parsed; # 1 is NAME + # Sort declarations: + { + my %h = map( ($_->[1], $_), @$fdecls_parsed); + $fdecls_parsed = [ @h{@fnames} ]; + } + @fnames_no_prefix = @fnames; + @fnames_no_prefix + = sort map { ++$prefix{$_} if s/^$opt_p(?!\d)//; $_ } @fnames_no_prefix; + # Remove macros which expand to typedefs + print "Typedefs are @td.\n" if $opt_d; + my %td = map {($_, $_)} @td; + # Add some other possible but meaningless values for macros + for my $k (qw(char double float int long short unsigned signed void)) { + $td{"$_$k"} = "$_$k" for ('', 'signed ', 'unsigned '); + } + # eval {require 'dumpvar.pl'; ::dumpValue( [\@td, \%td] ); 1} or warn $@; + my $n = 0; + my %bad_macs; + while (keys %td > $n) { + $n = keys %td; + my ($k, $v); + while (($k, $v) = each %seen_define) { + # print("found '$k'=>'$v'\n"), + $bad_macs{$k} = $td{$k} = $td{$v} if exists $td{$v}; + } + } + # Now %bad_macs contains names of bad macros + for my $k (keys %bad_macs) { + delete $const_names{$prefixless{$k}}; + print "Ignoring macro $k which expands to a typedef name '$bad_macs{$k}'\n" if $opt_d; } } } +my @const_names = sort keys %const_names; open(PM, ">$modfname.pm") || die "Can't create $ext$modpname/$modfname.pm: $!\n"; @@ -411,6 +630,7 @@ warn "Writing $ext$modpname/$modfname.pm\n"; print PM <<"END"; package $module; +require 5.005_62; use strict; END @@ -455,10 +675,22 @@ $myISA .= ' DynaLoader' unless $opt_X; # no XS $myISA .= ');'; print PM "\n$myISA\n\n"; +my @exported_names = (@const_names, @fnames_no_prefix); + print PM<<"END"; # Items to export into callers namespace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. + +# This allows declaration use $module ':all'; +# If you do not need this, moving things directly into \@EXPORT or \@EXPORT_OK +# will save memory. +our %EXPORT_TAGS = ( 'all' => [ qw( + @exported_names +) ] ); + +our \@EXPORT_OK = ( \@{ \$EXPORT_TAGS{'all'} } ); + our \@EXPORT = qw( @const_names ); @@ -473,7 +705,7 @@ sub AUTOLOAD { # to the AUTOLOAD in AutoLoader. my \$constname; - our $AUTOLOAD; + our \$AUTOLOAD; (\$constname = \$AUTOLOAD) =~ s/.*:://; croak "&$module::constant not defined" if \$constname eq 'constant'; my \$val = constant(\$constname, \@_ ? \$_[0] : 0); @@ -483,11 +715,19 @@ sub AUTOLOAD { goto &AutoLoader::AUTOLOAD; } else { - croak "Your vendor has not defined $module macro \$constname"; + croak "Your vendor has not defined $module macro \$constname"; + } + } + { + no strict 'refs'; + # Fixed between 5.005_53 and 5.005_61 + if (\$] >= 5.00561) { + *\$AUTOLOAD = sub () { \$val }; + } + else { + *\$AUTOLOAD = sub { \$val }; } } - no strict 'refs'; - *\$AUTOLOAD = sub () { \$val }; goto &\$AUTOLOAD; } @@ -499,6 +739,7 @@ bootstrap $module \$VERSION; END } +my $after; if( $opt_P ){ # if POD is disabled $after = '__END__'; } @@ -522,8 +763,8 @@ print PM <<"END"; __END__ END -$author = "A. U. Thor"; -$email = 'a.u.thor@a.galaxy.far.far.away'; +my $author = "A. U. Thor"; +my $email = 'a.u.thor@a.galaxy.far.far.away'; my $revhist = ''; $revhist = < should be removed. - @{[join "\n ", @$fdecls]} +EOD + $exp_doc .= <\]]##; } @@ -615,54 +869,181 @@ if( @path_h ){ print XS "\n"; } -if( ! $opt_c ){ -print XS <<"END"; -static int -not_here(char *s) +my %pointer_typedefs; +my %struct_typedefs; + +sub td_is_pointer { + my $type = shift; + my $out = $pointer_typedefs{$type}; + return $out if defined $out; + my $otype = $type; + $out = ($type =~ /\*$/); + # This converts only the guys which do not have trailing part in the typedef + if (not $out + and $typedef_rex and $type =~ s/($typedef_rex)/$typedefs_pre{$1}/go) { + $type = normalize_type($type); + print "Is-Pointer: Type mutation via typedefs: $otype ==> $type\n" + if $opt_d; + $out = td_is_pointer($type); + } + return ($pointer_typedefs{$otype} = $out); +} + +sub td_is_struct { + my $type = shift; + my $out = $struct_typedefs{$type}; + return $out if defined $out; + my $otype = $type; + $out = ($type =~ /^struct\b/) && !td_is_pointer($type); + # This converts only the guys which do not have trailing part in the typedef + if (not $out + and $typedef_rex and $type =~ s/($typedef_rex)/$typedefs_pre{$1}/go) { + $type = normalize_type($type); + print "Is-Struct: Type mutation via typedefs: $otype ==> $type\n" + if $opt_d; + $out = td_is_struct($type); + } + return ($struct_typedefs{$otype} = $out); +} + +# Some macros will bomb if you try to return them from a double-returning func. +# Say, ((char *)0), or strlen (if somebody #define STRLEN strlen). +# Fortunately, we can detect both these cases... +sub protect_convert_to_double { + my $in = shift; + my $val; + return '' unless defined ($val = $seen_define{$in}); + return '(IV)' if $known_fnames{$val}; + # OUT_t of ((OUT_t)-1): + return '' unless $val =~ /^\s*(\(\s*)?\(\s*([^()]*?)\s*\)/; + td_is_pointer($2) ? '(IV)' : ''; +} + +# For each of the generated functions, length($pref) leading +# letters are already checked. Moreover, it is recommended that +# the generated functions uses switch on letter at offset at least +# $off + length($pref). +# +# The given list has length($pref) chars removed at front, it is +# guarantied that $off leading chars in the rest are the same for all +# elts of the list. +# +# Returns: how at which offset it was decided to make a switch, or -1 if none. + +sub write_const; + +sub write_const { + my ($fh, $pref, $off, $list) = (shift,shift,shift,shift); + my %leading; + my $offarg = length $pref; + + if (@$list == 0) { # Can happen on the initial iteration only + print $fh <<"END"; +static double +constant(char *name, int len, int arg) { - croak("$module::%s not implemented on this architecture", s); + errno = EINVAL; + return 0; +} +END return -1; + } + + if (@$list == 1) { # Can happen on the initial iteration only + my $protect = protect_convert_to_double("$pref$list->[0]"); + + print $fh <<"END"; +static double +constant(char *name, int len, int arg) +{ + if (strEQ(name + $offarg, "$list->[0]")) { /* $pref removed */ +#ifdef $pref$list->[0] + return $protect$pref$list->[0]; +#else + errno = ENOENT; + return 0; +#endif + } + errno = EINVAL; + return 0; } +END + return -1; + } + + for my $n (@$list) { + my $c = substr $n, $off, 1; + $leading{$c} = [] unless exists $leading{$c}; + push @{$leading{$c}}, substr $n, $off + 1; + } + + if (keys(%leading) == 1) { + return 1 + write_const $fh, $pref, $off + 1, $list; + } + my $leader = substr $list->[0], 0, $off; + foreach my $letter (keys %leading) { + write_const $fh, "$pref$leader$letter", 0, $leading{$letter} + if @{$leading{$letter}} > 1; + } + + my $npref = "_$pref"; + $npref = '' if $pref eq ''; + + print $fh <<"END"; static double -constant(char *name, int arg) +constant$npref(char *name, int len, int arg) { errno = 0; - switch (*name) { END -my(@AZ, @az, @under); - -foreach(@const_names){ - @AZ = 'A' .. 'Z' if !@AZ && /^[A-Z]/; - @az = 'a' .. 'z' if !@az && /^[a-z]/; - @under = '_' if !@under && /^_/; -} + print $fh <<"END" if $off; + if ($offarg + $off >= len ) { + errno = EINVAL; + return 0; + } +END -foreach $letter (@AZ, @az, @under) { + print $fh <<"END"; + switch (name[$offarg + $off]) { +END - last if $letter eq 'a' && !@const_names; + foreach my $letter (sort keys %leading) { + my $let = $letter; + $let = '\0' if $letter eq ''; - print XS " case '$letter':\n"; - my($name); - while (substr($const_names[0],0,1) eq $letter) { - $name = shift(@const_names); - $macro = $prefix{$name} ? "$opt_p$name" : $name; - next if $const_xsub{$macro}; - print XS <<"END"; - if (strEQ(name, "$name")) -#ifdef $macro - return $macro; + print $fh < 1) { + # It makes sense to call a function + if ($off) { + print $fh <[1]} @$args; - my @argtypes = map { normalize_type( $_->[0] ) } @$args; + my @argtypes = map { normalize_type( $_->[0], 1 ) } @$args; my @argarrays = map { $_->[4] || '' } @$args; my $numargs = @$args; if ($numargs and $argtypes[-1] eq '...') { @@ -730,15 +1136,15 @@ sub print_decl { $argnames[-1] = '...'; } local $" = ', '; - $type = normalize_type($type); - + $type = normalize_type($type, 1); + print $fh <<"EOP"; $type $name(@argnames) EOP - for $arg (0 .. $numargs - 1) { + for my $arg (0 .. $numargs - 1) { print $fh <<"EOP"; $argtypes[$arg] $argnames[$arg]$argarrays[$arg] EOP @@ -752,9 +1158,11 @@ sub get_typemap { my $stdtypemap = "$Config::Config{privlib}/ExtUtils/typemap"; unshift @tm, $stdtypemap; my $proto_re = "[" . quotemeta('\$%&*@;') . "]" ; - my $image; - - foreach $typemap (@tm) { + + # Start with useful default values + $typemap{float} = 'T_DOUBLE'; + + foreach my $typemap (@tm) { next unless -e $typemap ; # skip directories, binary files etc. warn " Scanning $typemap\n"; @@ -770,11 +1178,12 @@ sub get_typemap { elsif (/^TYPEMAP\s*$/) { $mode = 'Typemap'; next; } elsif ($mode eq 'Typemap') { next if /^\s*($|\#)/ ; - if ( ($type, $image) = + my ($type, $image); + if ( ($type, $image) = /^\s*(.*?\S)\s+(\S+)\s*($proto_re*)\s*$/o # This may reference undefined functions: and not ($image eq 'T_PACKED' and $typemap eq $stdtypemap)) { - normalize_type($type); + $typemap{normalize_type($type)} = $image; } } } @@ -785,24 +1194,55 @@ sub get_typemap { } -sub normalize_type { - my $ignore_mods = '(?:\b(?:__const__|static|inline|__inline__)\b\s*)*'; +sub normalize_type { # Second arg: do not strip const's before \* my $type = shift; - $type =~ s/$ignore_mods//go; - $type =~ s/([\]\[()])/ \1 /g; - $type =~ s/\s+/ /g; + my $do_keep_deep_const = shift; + # If $do_keep_deep_const this is heuristical only + my $keep_deep_const = ($do_keep_deep_const ? '\b(?![^(,)]*\*)' : ''); + my $ignore_mods + = "(?:\\b(?:(?:__const__|const)$keep_deep_const|static|inline|__inline__)\\b\\s*)*"; + if ($do_keep_deep_const) { # Keep different compiled /RExen/o separately! + $type =~ s/$ignore_mods//go; + } + else { + $type =~ s/$ignore_mods//go; + } + $type =~ s/([^\s\w])/ \1 /g; $type =~ s/\s+$//; $type =~ s/^\s+//; - $type =~ s/\b\*/ */g; - $type =~ s/\*\b/* /g; - $type =~ s/\*\s+(?=\*)/*/g; + $type =~ s/\s+/ /g; + $type =~ s/\* (?=\*)/*/g; + $type =~ s/\. \. \./.../g; + $type =~ s/ ,/,/g; $types_seen{$type}++ unless $type eq '...' or $type eq 'void' or $std_types{$type}; $type; } +my $need_opaque; + +sub assign_typemap_entry { + my $type = shift; + my $otype = $type; + my $entry; + if ($tmask and $type =~ /$tmask/) { + print "Type $type matches -o mask\n" if $opt_d; + $entry = (td_is_struct($type) ? "T_OPAQUE_STRUCT" : "T_PTROBJ"); + } + elsif ($typedef_rex and $type =~ s/($typedef_rex)/$typedefs_pre{$1}/go) { + $type = normalize_type $type; + print "Type mutation via typedefs: $otype ==> $type\n" if $opt_d; + $entry = assign_typemap_entry($type); + } + $entry ||= $typemap{$otype} + || (td_is_struct($type) ? "T_OPAQUE_STRUCT" : "T_PTROBJ"); + $typemap{$otype} = $entry; + $need_opaque = 1 if $entry eq "T_OPAQUE_STRUCT"; + return $entry; +} + if ($opt_x) { - for $decl (@$fdecls_parsed) { print_decl(\*XS, $decl) } + for my $decl (@$fdecls_parsed) { print_decl(\*XS, $decl) } } close XS; @@ -812,10 +1252,32 @@ if (%types_seen) { warn "Writing $ext$modpname/typemap\n"; open TM, ">typemap" or die "Cannot open typemap file for write: $!"; - for $type (keys %types_seen) { - print TM $type, "\t" x (6 - int((length $type)/8)), "T_PTROBJ\n" + for $type (sort keys %types_seen) { + my $entry = assign_typemap_entry $type; + print TM $type, "\t" x (5 - int((length $type)/8)), "\t$entry\n" } + print TM <<'EOP' if $need_opaque; # Older Perls do not have correct entry +############################################################################# +INPUT +T_OPAQUE_STRUCT + if (sv_derived_from($arg, \"${ntype}\")) { + STRLEN len; + char *s = SvPV((SV*)SvRV($arg), len); + + if (len != sizeof($var)) + croak(\"Size %d of packed data != expected %d\", + len, sizeof($var)); + $var = *($type *)s; + } + else + croak(\"$var is not of type ${ntype}\") +############################################################################# +OUTPUT +T_OPAQUE_STRUCT + sv_setref_pvn($arg, \"${ntype}\", (char *)&$var, sizeof($var)); +EOP + close TM or die "Cannot close typemap file for write: $!"; } @@ -833,8 +1295,9 @@ print PL "WriteMakefile(\n"; print PL " 'NAME' => '$module',\n"; print PL " 'VERSION_FROM' => '$modfname.pm', # finds \$VERSION\n"; if( ! $opt_X ){ # print C stuff, unless XS is disabled + $opt_F = '' unless defined $opt_F; print PL " 'LIBS' => ['$extralibs'], # e.g., '-lm' \n"; - print PL " 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING' \n"; + print PL " 'DEFINE' => '$opt_F', # e.g., '-DHAVE_SOMETHING' \n"; print PL " 'INC' => '', # e.g., '-I/usr/include/other' \n"; } print PL ");\n"; @@ -871,17 +1334,24 @@ _END_ close(EX) || die "Can't close $ext$modpname/test.pl: $!\n"; unless ($opt_C) { - warn "Writing $ext$modpname/Changes\n"; - open(EX, ">Changes") || die "Can't create $ext$modpname/Changes: $!\n"; - print EX "Revision history for Perl extension $module.\n\n"; - print EX "$TEMPLATE_VERSION ",scalar localtime,"\n"; - print EX "\t- original version; created by h2xs $H2XS_VERSION\n\n"; - close(EX) || die "Can't close $ext$modpname/Changes: $!\n"; + warn "Writing $ext$modpname/Changes\n"; + $" = ' '; + open(EX, ">Changes") || die "Can't create $ext$modpname/Changes: $!\n"; + @ARGS = map {/[\s\"\'\`\$*?^|&<>\[\]\{\}\(\)]/ ? "'$_'" : $_} @ARGS; + print EX <MANIFEST') or die "Can't create MANIFEST: $!"; -@files = <*>; +my @files = <*>; if (!@files) { eval {opendir(D,'.');}; unless ($@) { @files = readdir(D); closedir(D); } diff --git a/utils/perlbug.PL b/utils/perlbug.PL index 3404d2b..c46df79 100644 --- a/utils/perlbug.PL +++ b/utils/perlbug.PL @@ -1121,7 +1121,7 @@ Include verbose configuration data in the report. =head1 AUTHORS Kenneth Albanowski (Ekjahds@kjahds.comE), subsequently Itored -by Gurusamy Sarathy (Egsar@umich.eduE), Tom Christiansen +by Gurusamy Sarathy (Egsar@activestate.comE), Tom Christiansen (Etchrist@perl.comE), Nathan Torkington (Egnat@frii.comE), Charles F. Randall (Ecfr@pobox.comE), Mike Guy (Emjtg@cam.a.ukE), Dominic Dunlop (Edomo@computer.orgE), diff --git a/utils/perlcc.PL b/utils/perlcc.PL index a585580..6c1fa45 100644 --- a/utils/perlcc.PL +++ b/utils/perlcc.PL @@ -253,20 +253,22 @@ sub _createCode { my ( $backend, $generated_file, $file, $final_output ) = @_; my $return; + my $output_switch = "o"; local($") = " -I"; - open(GENFILE, "> $generated_file") || die "Can't open $generated_file: $!"; - if ($backend eq "Bytecode") { require ByteLoader; + open(GENFILE, "> $generated_file") || die "Can't open $generated_file: $!"; + binmode GENFILE; print GENFILE "#!$^X\n" if @_ == 3; print GENFILE "use ByteLoader $ByteLoader::VERSION;\n"; - } + close(GENFILE); - close(GENFILE); + $output_switch ="a"; + } if (@_ == 3) # compiling a program { @@ -278,7 +280,7 @@ sub _createCode chomp $stash; _print( "$^X -I@INC -MO=$backend,$stash $file\n", 36); - $return = _run("$^X -I@INC -MO=$backend,$stash,-o$generated_file $file", 9); + $return = _run("$^X -I@INC -MO=$backend,$stash,-$output_switch$generated_file $file", 9); $return; } else # compiling a shared object @@ -286,7 +288,7 @@ sub _createCode _print( "$^X -I@INC -MO=$backend,-m$final_output $file\n", 36); $return = - _run("$^X -I@INC -MO=$backend,-m$final_output,-o$generated_file $file ", 9); + _run("$^X -I@INC -MO=$backend,-m$final_output,-$output_switch$generated_file $file ", 9); $return; } } @@ -366,6 +368,8 @@ sub _ccharness my $lperl = $^O eq 'os2' ? '-llibperl' : $^O eq 'MSWin32' ? "$Config{archlibexp}\\CORE\\perl.lib" : '-lperl'; + ($lperl = $Config{libperl}) =~ s/lib(.*)\Q$Config{_a}\E/-l$1/ + if($^O eq 'cygwin'); $optimize = $Config{'optimize'} =~ /-O\d/ ? '' : $Config{'optimize'}; @@ -374,9 +378,11 @@ sub _ccharness } my $libs = _getSharedObjects($sourceprog); + @$libs = grep { !(/DynaLoader\.a$/ && ($dynaloader = $_)) } @$libs + if($^O eq 'cygwin'); my $ccflags = $Config{ccflags}; - $ccflags .= ' -DUSEIMPORTLIB' if $Config{osname} =~ /cygwin/i; + $ccflags .= ' -DUSEIMPORTLIB' if $^O eq 'cygwin'; my $cccmd = "$Config{cc} $ccflags $optimize $incdir " ."@args $dynaloader $linkargs @$libs"; diff --git a/utils/perldoc.PL b/utils/perldoc.PL index 7dc478b..5dd0e1b 100644 --- a/utils/perldoc.PL +++ b/utils/perldoc.PL @@ -51,7 +51,7 @@ if (@ARGV<1) { my $me = $0; # Editing $0 is unportable $me =~ s,.*/,,; die < +# changed /pod/ directory to /pods/ for cygwin +# to support cygwin/win32 # Version 1.14: Wed Jul 15 01:50:20 EST 1998 # Robin Barker # -strict, -w cleanups # Version 1.13: Fri Feb 27 16:20:50 EST 1997 -# Gurusamy Sarathy +# Gurusamy Sarathy # -doc tweaks for -F and -X options # Version 1.12: Sat Apr 12 22:41:09 EST 1997 -# Gurusamy Sarathy +# Gurusamy Sarathy # -various fixes for win32 # Version 1.11: Tue Dec 26 09:54:33 EST 1995 # Kenneth Albanowski diff --git a/vms/descrip_mms.template b/vms/descrip_mms.template index 3f91940..1a37d87 100644 --- a/vms/descrip_mms.template +++ b/vms/descrip_mms.template @@ -1,6 +1,7 @@ !GROK!THIS! # Descrip.MMS for perl5 on VMS -# Last revised 18-Oct-1998 by Charles Bailey bailey@newman.upenn.edu +# Last revised 8-Nov-1999 by Craig Berry craig.berry@metamor.com +# Revised 18-Oct-1998 by Charles Bailey bailey@newman.upenn.edu # #: This file uses MMS syntax, and can be processed using DEC's MMS product, #: or the free MMK clone (available by ftp at ftp.spc.edu). If you want to @@ -286,16 +287,19 @@ obj0 = $(MALLOC_O) $(SOCKOBJ) av$(O) deb$(O) doio$(O) doop$(O) dump$(O) obj1 = globals$(O) gv$(O) hv$(O) mg$(O) miniperlmain$(O) op$(O) perl$(O) obj2 = perlio$(O) perly$(O) pp$(O) pp_ctl$(O) pp_hot$(O) pp_sys$(O) obj3 = regcomp$(O) regexec$(O) run$(O) scope$(O) sockadapt$(O) sv$(O) -obj4 = taint$(O) toke$(O) universal$(O) utf8$(O) util$(O) vms$(O) +obj4 = taint$(O) toke$(O) universal$(O) utf8$(O) util$(O) vms$(O) xsutils$(O) obj = $(obj0) $(obj1) $(obj2) $(obj3) $(obj4) -h0 = $(SOCKH) av.h cc_runtime.h config.h cop.h cv.h embed.h embedvar.h -h1 = extern.h $(THREADH) form.h gv.h handy.h hv.h intern.h intrpvar.h -h2 = iperlsys.h keywords.h mg.h nostdio.h op.h opcode.h patchlevel.h perl.h -h3 = perlio.h perlsdio.h perlvars.h perly.h pp.h pp_proto.h proto.h -h4 = regcomp.h regexp.h regnodes.h scope.h sv.h thrdvar.h -h5 = thread.h utf8.h util.h vmsish.h warnings.h xsub.h opnames.h +h0 = $(SOCKH) $(THREADH) av.h cc_runtime.h config.h cop.h cv.h embed.h +h1 = embedvar.h extern.h form.h gv.h handy.h hv.h intern.h intrpvar.h +h2 = iperlsys.h mg.h nostdio.h objxsub.h op.h opcode.h opnames.h +h3 = patchlevel.h perl.h perlio.h perlsdio.h perlvars.h perly.h pp.h +h4 = pp_proto.h proto.h regexp.h scope.h sv.h thrdvar.h thread.h utf8.h +h5 = util.h vmsish.h warnings.h xsub.h +h6 = regcomp.h regcomp.h +h7 = keywords.h h = $(h0) $(h1) $(h2) $(h3) $(h4) $(h5) +allh = $(h) $(h6) $(h7) ac0 = $(SOCKARCH) $(ARCHCORE)av.h $(ARCHCORE)cc_runtime.h ac1 = $(ARCHCORE)config.h $(ARCHCORE)cop.h $(ARCHCORE)cv.h $(ARCHCORE)embed.h @@ -372,7 +376,7 @@ pod8 = [.lib.pod]perltrap.pod [.lib.pod]perlvar.pod [.lib.pod]perlxs.pod [.lib.p perlpods : $(pod1) $(pod2) $(pod3) $(pod4) $(pod5) $(pod6) $(pod7) $(pod8) [.lib.pod]perlvms.pod @ $(NOOP) -archcorefiles : $(ac1) $(ac2) $(ac3) $(ac4) $(ac5) $(ac6) $(ac7) $(ac8) $(ac9) $(ac10) $(acs) $(acth) $(ARCHAUTO)time.stamp +archcorefiles : $(ac) $(acth) $(ARCHAUTO)time.stamp @ $(NOOP) miniperl : $(DBG)miniperl$(E) @@ -384,9 +388,7 @@ $(DBG)miniperl$(E) : miniperlmain$(O), $(DBG)libperl$(OLB) $(CRTL) $(DBG)libperl$(OLB) : $(obj) @ If F$Search("$(MMS$TARGET)").eqs."" Then Library/Object/Create $(MMS$TARGET) - Library/Object/Replace $(MMS$TARGET) $(obj1) - Library/Object/Replace $(MMS$TARGET) $(obj2) - Library/Object/Replace $(MMS$TARGET) $(obj3) + Library/Object/Replace $(MMS$TARGET) $(MMS$SOURCE_LIST) perlmain.c : miniperlmain.c $(MINIPERL_EXE) [.vms]writemain.pl $(MINIPERL) [.VMS]Writemain.pl "$(EXT)" @@ -414,7 +416,7 @@ $(DBG)perlshr$(E) : $(DBG)libperl$(OLB) $(extobj) $(DBG)perlshr_xtras.ts # The following files are built in one go by gen_shrfls.pl: # perlshr_attr.opt, $(DBG)perlshr_bld.opt - VAX and AXP # perlshr_gbl*.mar, perlshr_gbl*$(O) - VAX only -# The song and dance with gen_shrfls.opt accomodates DCL's 255 character +# The song and dance with gen_shrfls.opt accommodates DCL's 255 character # line length limit. .ifdef PIPES_BROKEN # This is a backup target used only with older versions of the DECCRTL which @@ -520,7 +522,7 @@ dynext : $(LIBPREREQ) $(DBG)perlshr$(E) @ If F$Search("hash$(O)").nes."" Then Rename/NoLog hash$(O),str$(O),util$(O),walk$(O) [.x2p] Link $(LINKFLAGS) /Exe=$(MMS$TARGET) $(MMS$SOURCE_LIST) $(CRTLOPTS) -# Accomodate buggy cpp in some version of DECC, which chokes on illegal +# Accommodate buggy cpp in some version of DECC, which chokes on illegal # filespec "y.tab.c", and broken gcc cpp, which doesn't start #include "" # search in same dir as source file [.x2p]a2p$(O) : [.x2p]a2p.c [.x2p]a2py.c [.x2p]INTERN.h [.x2p]a2p.h [.x2p]hash.h [.x2p]str.h config.h handy.h vmsish.h $(SOCKH) $(MINIPERL_EXE) @@ -779,7 +781,7 @@ perly.h : [.vms]perly_h.vms .ifdef LINK_ONLY .else -perly$(O) : perly.c, perly.h, $(h) +perly$(O) : perly.c, perly.h, $(allh) .endif [.t.lib]vmsfspec.t : [.vms.ext]filespec.t @@ -968,68 +970,68 @@ $(ARCHAUTO)time.stamp : # $(CC) $(CORECFLAGS) $(MMS$SOURCE) # AUTOMATICALLY GENERATED MAKE DEPENDENCIES--PUT NOTHING BELOW THIS LINE .ifdef SOCKET -$(SOCKOBJ) : $(SOCKC) extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h +$(SOCKOBJ) : $(SOCKC) $(h) $(CC) $(CORECFLAGS) $(MMS$SOURCE) .endif -av$(O) : av.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h +av$(O) : av.c $(h) $(CC) $(CORECFLAGS) $(MMS$SOURCE) -deb$(O) : deb.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h +deb$(O) : deb.c $(h) $(CC) $(CORECFLAGS) $(MMS$SOURCE) -doio$(O) : doio.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h +doio$(O) : doio.c $(h) $(CC) $(CORECFLAGS) $(MMS$SOURCE) -doop$(O) : doop.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h +doop$(O) : doop.c $(h) $(CC) $(CORECFLAGS) $(MMS$SOURCE) -dump$(O) : dump.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h regcomp.h regnodes.h +dump$(O) : dump.c $(h) $(h6) $(CC) $(CORECFLAGS) $(MMS$SOURCE) -globals$(O) : globals.c intern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h +globals$(O) : globals.c $(h) $(CC) $(CORECFLAGS) $(MMS$SOURCE) -gv$(O) : gv.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h +gv$(O) : gv.c $(h) $(CC) $(CORECFLAGS) $(MMS$SOURCE) -hv$(O) : hv.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h +hv$(O) : hv.c $(h) $(CC) $(CORECFLAGS) $(MMS$SOURCE) -mg$(O) : mg.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h +mg$(O) : mg.c $(h) $(CC) $(CORECFLAGS) $(MMS$SOURCE) -miniperlmain$(O) : miniperlmain.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h +miniperlmain$(O) : miniperlmain.c $(h) $(CC) $(CORECFLAGS) $(MMS$SOURCE) -op$(O) : op.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h +op$(O) : op.c $(h) $(CC) $(CORECFLAGS) $(MMS$SOURCE) -perl$(O) : perl.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h intrpvar.h thrdvar.h +perl$(O) : perl.c $(h) $(CC) $(CORECFLAGS) $(MMS$SOURCE) -perlio$(O) : perlio.c config.h extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h +perlio$(O) : perlio.c $(h) $(CC) $(CORECFLAGS) $(MMS$SOURCE) -perlmain$(O) : perlmain.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h +perlmain$(O) : perlmain.c $(h) $(CC) $(CORECFLAGS) $(MMS$SOURCE) -perly$(O) : perly.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h +perly$(O) : perly.c $(h) $(CC) $(CORECFLAGS) $(MMS$SOURCE) -pp$(O) : pp.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h +pp$(O) : pp.c $(h) $(CC) $(CORECFLAGS) $(MMS$SOURCE) -pp_ctl$(O) : pp_ctl.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h +pp_ctl$(O) : pp_ctl.c $(h) $(CC) $(CORECFLAGS) $(MMS$SOURCE) -pp_hot$(O) : pp_hot.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h +pp_hot$(O) : pp_hot.c $(h) $(CC) $(CORECFLAGS) $(MMS$SOURCE) -pp_sys$(O) : pp_sys.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h +pp_sys$(O) : pp_sys.c $(h) $(CC) $(CORECFLAGS) $(MMS$SOURCE) -regcomp$(O) : regcomp.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h intern.h regcomp.h regnodes.h +regcomp$(O) : regcomp.c $(h) $(h6) $(CC) $(CORECFLAGS) $(MMS$SOURCE) -regexec$(O) : regexec.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h regcomp.h regnodes.h +regexec$(O) : regexec.c $(h) $(h6) $(CC) $(CORECFLAGS) $(MMS$SOURCE) -run$(O) : run.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h +run$(O) : run.c $(h) $(CC) $(CORECFLAGS) $(MMS$SOURCE) -scope$(O) : scope.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h +scope$(O) : scope.c $(h) $(CC) $(CORECFLAGS) $(MMS$SOURCE) -sv$(O) : sv.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h +sv$(O) : sv.c $(h) $(CC) $(CORECFLAGS) $(MMS$SOURCE) -taint$(O) : taint.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h +taint$(O) : taint.c $(h) $(CC) $(CORECFLAGS) $(MMS$SOURCE) -toke$(O) : toke.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h keywords.h +toke$(O) : toke.c $(h) $(h7) $(CC) $(CORECFLAGS) $(MMS$SOURCE) -universal$(O) : universal.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h xsub.h +universal$(O) : universal.c $(h) $(CC) $(CORECFLAGS) $(MMS$SOURCE) -utf8$(O) : utf8.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h +utf8$(O) : utf8.c $(h) $(CC) $(CORECFLAGS) $(MMS$SOURCE) -util$(O) : util.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h +util$(O) : util.c $(h) $(CC) $(CORECFLAGS) $(MMS$SOURCE) -vms$(O) : vms.c extern.h perl.h config.h embed.h handy.h vmsish.h $(SOCKH) iperlsys.h perlsdio.h regexp.h sv.h util.h form.h gv.h cv.h op.h cop.h av.h hv.h mg.h scope.h warnings.h utf8.h perly.h thread.h pp.h proto.h pp_proto.h opcode.h opnames.h embedvar.h intrpvar.h thrdvar.h perlvars.h patchlevel.h xsub.h +vms$(O) : vms.c $(h) $(CC) $(CORECFLAGS) $(MMS$SOURCE) [.x2p]hash$(O) : [.x2p]hash.c [.x2p]EXTERN.h [.x2p]a2p.h [.x2p]hash.h [.x2p]str.h [.x2p]util.h config.h handy.h vmsish.h $(SOCKH) diff --git a/vms/perly_c.vms b/vms/perly_c.vms index 08fa561..ebc7d57 100644 --- a/vms/perly_c.vms +++ b/vms/perly_c.vms @@ -1388,7 +1388,7 @@ yyparse() struct ysv *ysave; New(73, ysave, 1, struct ysv); - SAVEDESTRUCTOR(yydestruct, ysave); + SAVEDESTRUCTOR_X(yydestruct, ysave); ysave->oldyydebug = yydebug; ysave->oldyynerrs = yynerrs; ysave->oldyyerrflag = yyerrflag; @@ -1664,7 +1664,7 @@ case 21: break; case 22: #line 203 "perly.y" -{ yyval.opval = scope(yyvsp[0].opval); } +{ (yyvsp[0].opval)->op_flags |= OPf_PARENS; yyval.opval = scope(yyvsp[0].opval); } break; case 23: #line 205 "perly.y" @@ -1828,7 +1828,7 @@ case 59: #line 338 "perly.y" { STRLEN n_a; char *name = SvPV(((SVOP*)yyvsp[0].opval)->op_sv,n_a); if (strEQ(name, "BEGIN") || strEQ(name, "END") - || strEQ(name, "INIT")) + || strEQ(name, "STOP") || strEQ(name, "INIT")) CvSPECIAL_on(PL_compcv); yyval.opval = yyvsp[0].opval; } break; @@ -2483,7 +2483,6 @@ yyaccept: } #ifdef PERL_OBJECT -#define NO_XSLOCKS #include "XSUB.h" #endif diff --git a/vms/subconfigure.com b/vms/subconfigure.com index febce77..1e0d003 100644 --- a/vms/subconfigure.com +++ b/vms/subconfigure.com @@ -63,6 +63,15 @@ $ myname = myhostname $ if "''myname'" .eqs. "" THEN myname = f$trnlnm("SYS$NODE") $! $! ##ADD NEW CONSTANTS HERE## +$ perl_d_fs_data_s = "undef" +$ perl_d_getmnt = "undef" +$ perl_d_sqrtl = "define" +$ perl_d_statfs_f_flags = "undef" +$ perl_d_statfs_s = "undef" +$ perl_d_ustat = "undef" +$ perl_i_sysstatfs = "undef" +$ perl_i_sysvfs = "undef" +$ perl_i_ustat = "undef" $ perl_d_llseek="undef" $ perl_d_madvise="undef" $ perl_selectminbits=32 @@ -124,8 +133,14 @@ $ perl_d_cmsghdr_s = "undef" $ IF use_64bit .eqs. "Y" $ THEN $ perl_use64bits = "define" +$ perl_uselargefiles = "define" +$ perl_uselongdouble = "define" +$ perl_usemorebits = "define" $ ELSE $ perl_use64bits = "undef" +$ perl_uselargefiles = "undef" +$ perl_uselongdouble = "undef" +$ perl_usemorebits = "undef" $ ENDIF $ perl_d_drand48proto = "define" $ perl_libpth="/sys$share /sys$library" @@ -176,7 +191,7 @@ $ perl_d_mknod="undef" $ perl_d_union_semun="undef" $ perl_d_semctl_semun="undef" $ perl_d_semctl_semid_ds="undef" -$ IF (sharedperl.EQS."Y") +$ IF (sharedperl.EQS."Y" .AND. F$GETSYI("HW_MODEL").GE.1024) $ THEN $ perl_obj_ext=".abj" $ perl_so="axe" @@ -431,6 +446,9 @@ $ perl_sPRId64 = """Ld""" $ perl_sPRIu64 = """Lu""" $ perl_sPRIo64 = """Lo""" $ perl_sPRIx64 = """Lx""" +$ perl_d_quad = "define" +$ perl_quadtype = "long long" +$ perl_uquadtype = "unsigned long long" $ ELSE $ perl_d_PRIfldbl = "undef" $ perl_d_PRIgldbl = "undef" @@ -444,9 +462,9 @@ $ perl_sPRId64 = "" $ perl_sPRIu64 = "" $ perl_sPRIo64 = "" $ perl_sPRIx64 = "" +$ perl_d_quad = "undef" $ ENDIF $! -$! $! Now some that we build up $! $ LocalTime = f$time() @@ -540,6 +558,7 @@ $ DEASSIGN SYS$ERROR $ OPEN/READ TEMPOUT [-.uu]tempout.lis $ READ TEMPOUT line $ CLOSE TEMPOUT +$ DELETE/NOLOG [-.uu]tempout.lis; $ $ perl_cpp_stuff=line $ WRITE_RESULT "cpp_stuff is ''perl_cpp_stuff'" @@ -570,7 +589,6 @@ $ link temp.obj,temp.opt/opt $ else $ link temp.obj $ endif -$! link temp.obj $ OPEN/WRITE TEMPOUT [-.uu]tempout.lis $ DEASSIGN SYS$OUTPUT $ DEASSIGN SYS$ERROR @@ -583,6 +601,7 @@ $ DEASSIGN SYS$ERROR $ OPEN/READ TEMPOUT [-.uu]tempout.lis $ READ TEMPOUT line $ CLOSE TEMPOUT +$ DELETE/NOLOG [-.uu]tempout.lis; $ $ perl_doublesize=line $ WRITE_RESULT "doublesize is ''perl_doublesize'" @@ -637,6 +656,7 @@ $ DEASSIGN SYS$ERROR $ OPEN/READ TEMPOUT [-.uu]tempout.lis $ READ TEMPOUT line $ CLOSE TEMPOUT +$ DELETE/NOLOG [-.uu]tempout.lis; $ $ perl_longdblsize=line $ perl_d_longdbl="define" @@ -687,141 +707,13 @@ $ DEASSIGN SYS$ERROR $ OPEN/READ TEMPOUT [-.uu]tempout.lis $ READ TEMPOUT line $ CLOSE TEMPOUT -$ +$ DELETE/NOLOG [-.uu]tempout.lis; $ perl_longlongsize=line $ perl_d_longlong="define" $ ENDIF $ WRITE_RESULT "longlongsize is ''perl_longlongsize'" $ WRITE_RESULT "d_longlong is ''perl_d_longlong'" $! -$! Check for int size -$! -$ OS -$ WS "#ifdef __DECC -$ WS "#include -$ WS "#endif -$ WS "#include -$ WS "int main() -$ WS "{" -$ WS "printf(""%d\n"", sizeof(int)); -$ WS "exit(0); -$ WS "}" -$ CS -$ DEFINE SYS$ERROR _NLA0: -$ DEFINE SYS$OUTPUT _NLA0: -$ on error then continue -$ on warning then continue -$ 'Checkcc' temp.c -$ If (Needs_Opt.eqs."Yes") -$ THEN -$ link temp.obj,temp.opt/opt -$ else -$ link temp.obj -$ endif -$ If (Needs_Opt.eqs."Yes") -$ THEN -$ link temp.obj,temp.opt/opt -$ else -$ link temp.obj -$ endif -$ OPEN/WRITE TEMPOUT [-.uu]tempout.lis -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ DEFINE SYS$ERROR TEMPOUT -$ DEFINE SYS$OUTPUT TEMPOUT -$ mcr []temp -$ CLOSE TEMPOUT -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ OPEN/READ TEMPOUT [-.uu]tempout.lis -$ READ TEMPOUT line -$ CLOSE TEMPOUT -$ -$ perl_intsize=line -$ WRITE_RESULT "intsize is ''perl_intsize'" -$! -$! Check for short size -$! -$ OS -$ WS "#ifdef __DECC -$ WS "#include -$ WS "#endif -$ WS "#include -$ WS "int main() -$ WS "{" -$ WS "printf(""%d\n"", sizeof(short)); -$ WS "exit(0); -$ WS "}" -$ CS -$ DEFINE SYS$ERROR _NLA0: -$ DEFINE SYS$OUTPUT _NLA0: -$ on error then continue -$ on warning then continue -$ 'Checkcc' temp.c -$ If (Needs_Opt.eqs."Yes") -$ THEN -$ link temp.obj,temp.opt/opt -$ else -$ link temp.obj -$ endif -$ OPEN/WRITE TEMPOUT [-.uu]tempout.lis -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ DEFINE SYS$ERROR TEMPOUT -$ DEFINE SYS$OUTPUT TEMPOUT -$ mcr []temp -$ CLOSE TEMPOUT -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ OPEN/READ TEMPOUT [-.uu]tempout.lis -$ READ TEMPOUT line -$ CLOSE TEMPOUT -$ -$ perl_shortsize=line -$ WRITE_RESULT "shortsize is ''perl_shortsize'" -$! -$! Check for long size -$! -$ OS -$ WS "#ifdef __DECC -$ WS "#include -$ WS "#endif -$ WS "#include -$ WS "int main() -$ WS "{" -$ WS "int foo; -$ WS "foo = sizeof(long); -$ WS "printf(""%d\n"", foo); -$ WS "exit(0); -$ WS "}" -$ CS -$ DEFINE SYS$ERROR _NLA0: -$ DEFINE SYS$OUTPUT _NLA0: -$ on error then continue -$ on warning then continue -$ 'Checkcc' temp.c -$ If (Needs_Opt.eqs."Yes") -$ THEN -$ link temp.obj,temp.opt/opt -$ else -$ link temp.obj -$ endif -$ OPEN/WRITE TEMPOUT [-.uu]tempout.lis -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ DEFINE SYS$ERROR TEMPOUT -$ DEFINE SYS$OUTPUT TEMPOUT -$ mcr []temp -$ CLOSE TEMPOUT -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ OPEN/READ TEMPOUT [-.uu]tempout.lis -$ READ TEMPOUT line -$ CLOSE TEMPOUT -$ -$ perl_longsize=line -$ WRITE_RESULT "longsize is ''perl_longsize'" -$! $! Check the prototype for getgid $! $ OS @@ -2770,36 +2662,34 @@ $ WS "printf(""%d\n"", foo); $ WS "exit(0); $ WS "}" $ CS -$! copy temp.c sys$output -$! -$ DEFINE SYS$ERROR _NLA0: -$ DEFINE SYS$OUTPUT _NLA0: -$ ON ERROR THEN CONTINUE -$ ON WARNING THEN CONTINUE -$ 'Checkcc' temp.c -$ If (Needs_Opt.eqs."Yes") -$ THEN -$ link temp.obj,temp.opt/opt -$ else -$ link temp.obj -$ endif -$ OPEN/WRITE TEMPOUT [-.uu]tempout.lis -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ DEFINE SYS$ERROR TEMPOUT -$ DEFINE SYS$OUTPUT TEMPOUT -$ mcr []temp -$ CLOSE TEMPOUT -$ DEASSIGN SYS$OUTPUT -$ DEASSIGN SYS$ERROR -$ OPEN/READ TEMPOUT [-.uu]tempout.lis -$ READ TEMPOUT line -$ CLOSE TEMPOUT +$ DEFINE SYS$ERROR _NLA0: +$ DEFINE SYS$OUTPUT _NLA0: +$ ON ERROR THEN CONTINUE +$ ON WARNING THEN CONTINUE +$ 'Checkcc' temp.c +$ If (Needs_Opt.eqs."Yes") +$ THEN +$ link temp.obj,temp.opt/opt +$ ELSE +$ link temp.obj +$ ENDIF +$ OPEN/WRITE TEMPOUT [-.uu]tempout.lis +$ DEASSIGN SYS$OUTPUT +$ DEASSIGN SYS$ERROR +$ DEFINE SYS$ERROR TEMPOUT +$ DEFINE SYS$OUTPUT TEMPOUT +$ mcr []temp.exe +$ CLOSE TEMPOUT +$ DEASSIGN SYS$OUTPUT +$ DEASSIGN SYS$ERROR +$ OPEN/READ TEMPOUT [-.uu]tempout.lis +$ READ TEMPOUT line +$ CLOSE TEMPOUT +$ DELETE/NOLOG [-.uu]tempout.lis; $ $ perl_ptrsize=line $ WRITE_RESULT "ptrsize is ''perl_ptrsize'" $! -$! $! Check rand48 and its ilk $! $ OS @@ -2813,7 +2703,6 @@ $ WS "srand48(12L);" $ WS "exit(0); $ WS "}" $ CS -$! copy temp.c sys$output $! $ DEFINE SYS$ERROR _NLA0: $ DEFINE SYS$OUTPUT _NLA0: @@ -2979,7 +2868,6 @@ $ THEN $ perl_vms_cc_type="vaxc" $ ENDIF $! -$! $! Sockets? $ if ("''Has_Socketshr'".EQS."T").OR.("''Has_Dec_C_Sockets'".EQS."T") $ THEN @@ -3043,6 +2931,146 @@ $ $ perl_d_pthreads_created_joinable="undef" $ ENDIF $! +$! new (5.005_62++) typedefs for primitives +$! +$ perl_ivtype="long" +$ perl_uvtype="unsigned long" +$ perl_i8type="char" +$ perl_u8type="unsigned char" +$ perl_i16type="short" +$ perl_u16type="unsigned short" +$ perl_i32type="int" +$ perl_u32type="unsigned int" +$ perl_i64type="long" +$ perl_u64type="unsigned long" +$ perl_nvtype="double" +$! +$ GOTO beyond_type_size_check +$! +$type_size_check: +$! +$! Check for type sizes +$! +$ OS +$ WS "#ifdef __DECC +$ WS "#include +$ WS "#endif +$ WS "#include +$ WS "int main() +$ WS "{" +$ WS "printf(""%d\n"", sizeof(''type'));" +$ WS "exit(0); +$ WS "}" +$ CS +$ DEFINE SYS$ERROR _NLA0: +$ DEFINE SYS$OUTPUT _NLA0: +$ ON ERROR THEN CONTINUE +$ ON WARNING THEN CONTINUE +$ 'Checkcc' temp.c +$ If (Needs_Opt.eqs."Yes") +$ THEN +$ link temp.obj,temp.opt/opt +$ ELSE +$ link temp.obj +$ ENDIF +$ OPEN/WRITE TEMPOUT [-.uu]tempout.lis +$ DEASSIGN SYS$OUTPUT +$ DEASSIGN SYS$ERROR +$ DEFINE SYS$ERROR TEMPOUT +$ DEFINE SYS$OUTPUT TEMPOUT +$ mcr []temp.exe +$ CLOSE TEMPOUT +$ DEASSIGN SYS$OUTPUT +$ DEASSIGN SYS$ERROR +$ OPEN/READ TEMPOUT [-.uu]tempout.lis +$ READ TEMPOUT line +$ CLOSE TEMPOUT +$ DELETE/NOLOG [-.uu]tempout.lis; +$ WRITE_RESULT "''size_name' is ''line'" +$ DS +$ RETURN +$! +$beyond_type_size_check: +$! +$ line = "" +$ type = "''perl_ivtype'" +$ size_name = "ivsize" +$ gosub type_size_check +$ perl_ivsize="''line'" +$ IF type .eqs. "long" +$ THEN perl_longsize = "''line'" +$ ELSE +$ type = "long" +$ size_name = "longsize" +$ gosub type_size_check +$ perl_longsize="''line'" +$ ENDIF +$ +$ type = "''perl_uvtype'" +$ size_name = "uvsize" +$ gosub type_size_check +$ perl_uvsize="''line'" +$ +$ type = "''perl_i8type'" +$ size_name = "i8size" +$ gosub type_size_check +$ perl_i8size="''line'" +$ +$ type = "''perl_u8type'" +$ size_name = "u8size" +$ gosub type_size_check +$ perl_u8size="''line'" +$ +$ type = "''perl_i16type'" +$ size_name = "i16size" +$ gosub type_size_check +$ perl_i16size="''line'" +$ IF type .eqs. "short" +$ THEN perl_shortsize="''line'" +$ ELSE +$ type = "''perl_i16type'" +$ size_name = "shortsize" +$ gosub type_size_check +$ perl_shortsize="''line'" +$ ENDIF +$ +$ type = "''perl_u16type'" +$ size_name = "u16size" +$ gosub type_size_check +$ perl_u16size="''line'" +$ +$ type = "''perl_i32type'" +$ size_name = "i32size" +$ gosub type_size_check +$ perl_i32size="''line'" +$ IF type .eqs. "int" +$ THEN perl_intsize="''perl_i32size'" +$ ELSE +$ type = "int" +$ size_name = "intsize" +$ gosub type_size_check +$ perl_intsize="''line'" +$ ENDIF +$ +$ type = "''perl_u32type'" +$ size_name = "u32size" +$ gosub type_size_check +$ perl_u32size="''line'" +$ +$ type = "''perl_i64type'" +$ size_name = "i64size" +$ gosub type_size_check +$ perl_i64size="''line'" +$ +$ type = "''perl_u64type'" +$ size_name = "u64size" +$ gosub type_size_check +$ perl_u64size="''line'" +$! +$ perl_ivdformat="""ld""" +$ perl_uvuformat="""lu""" +$ perl_uvoformat="""lo""" +$ perl_uvxformat="""lx""" $! $! Finally the composite ones. All config $ perl_installarchlib="''perl_prefix':[lib.''perl_arch'.''localperlver']" @@ -3441,6 +3469,7 @@ $ WC "d_oldpthreads='" + perl_d_oldpthreads + "'" $ WC "d_longdbl='" + perl_d_longdbl + "'" $ WC "longdblsize='" + perl_longdblsize + "'" $ WC "d_longlong='" + perl_d_longlong + "'" +$ WC "uselonglong='" + perl_d_longlong + "'" $ WC "longlongsize='" + perl_longlongsize + "'" $ WC "d_mkstemp='" + perl_d_mkstemp + "'" $ WC "d_setvbuf='" + perl_d_setvbuf + "'" @@ -3570,6 +3599,49 @@ $ WC "sPRIu64='" + perl_sPRIu64 + "'" $ WC "sPRIo64='" + perl_sPRIo64 + "'" $ WC "sPRIx64='" + perl_sPRIx64 + "'" $ WC "d_llseek='" + perl_d_llseek + "'" +$ WC "uselargefiles='" + perl_uselargefiles + "'" +$ WC "uselongdouble='" + perl_uselongdouble + "'" +$ WC "usemorebits='" + perl_usemorebits + "'" +$ WC "d_quad='" + perl_d_quad + "'" +$ if (use_64bit .eqs. "Y") +$ THEN +$ WC "quadtype='" + perl_quadtype + "'" +$ WC "uquadtype='" + perl_uquadtype + "'" +$ ENDIF +$ WC "d_fs_data_s='" + perl_d_fs_data_s + "'" +$ WC "d_getmnt='" + perl_d_getmnt + "'" +$ WC "d_sqrtl='" + perl_d_sqrtl + "'" +$ WC "d_statfs_f_flags='" + perl_d_statfs_f_flags + "'" +$ WC "d_statfs_s='" + perl_d_statfs_s + "'" +$ WC "d_ustat='" + perl_d_ustat + "'" +$ WC "i_sysstatfs='" + perl_i_sysstatfs + "'" +$ WC "i_sysvfs='" + perl_i_sysvfs + "'" +$ WC "i_ustat='" + perl_i_ustat + "'" +$ WC "ivtype='" + perl_ivtype + "'" +$ WC "uvtype='" + perl_uvtype + "'" +$ WC "i8type='" + perl_i8type + "'" +$ WC "i16type='" + perl_i16type + "'" +$ WC "u8type='" + perl_u8type + "'" +$ WC "u16type='" + perl_u16type + "'" +$ WC "i32type='" + perl_i32type + "'" +$ WC "u32type='" + perl_u32type + "'" +$ WC "i64type='" + perl_i64type + "'" +$ WC "u64type='" + perl_u64type + "'" +$ WC "nvtype='" + perl_nvtype + "'" +$ WC "ivsize='" + perl_ivsize + "'" +$ WC "uvsize='" + perl_uvsize + "'" +$ WC "i8size='" + perl_i8size + "'" +$ WC "u8size='" + perl_u8size + "'" +$ WC "i16size='" + perl_i16size + "'" +$ WC "u16size='" + perl_u16size + "'" +$ WC "i32size='" + perl_i32size + "'" +$ WC "u32size='" + perl_u32size + "'" +$ WC "i64size='" + perl_i64size + "'" +$ WC "u64size='" + perl_u64size + "'" +$ WC "ivdformat='" + perl_ivdformat + "'" +$ WC "uvuformat='" + perl_uvuformat + "'" +$ WC "uvoformat='" + perl_uvoformat + "'" +$ WC "uvxformat='" + perl_uvxformat + "'" $! $! ##WRITE NEW CONSTANTS HERE## $! @@ -3655,6 +3727,7 @@ $ WRITE CONFIG "#define USE_LONG_LONG" $ WRITE CONFIG "#define USE_LONG_DOUBLE" $ ENDIF $ WRITE CONFIG "#define HAS_ENVGETENV" +$ WRITE CONFIG "#define PERL_EXTERNAL_GLOB" $ CLOSE CONFIG $! $! Now build the normal config.h @@ -3721,7 +3794,7 @@ $ echo "Extracting Build_Ext.Com" $ Create Sys$Disk:[-]Build_Ext.Com $ Deck/Dollar="$EndOfTpl$" $!++ Build_Ext.Com -$! NOTE: This files is extracted as part of the VMS configuration process. +$! NOTE: This file is extracted as part of the VMS configuration process. $! Any changes made to it directly will be lost. If you need to make any $! changes, please edit the template in [.vms]SubConfigure.Com instead. $ def = F$Environment("Default") diff --git a/vms/vms.c b/vms/vms.c index 5d5f7f7..aee410d 100644 --- a/vms/vms.c +++ b/vms/vms.c @@ -4401,9 +4401,8 @@ is_null_device(name) /* Do this via $Check_Access on VMS, since the CRTL stat() returns only a * subset of the applicable information. */ -/*{{{I32 cando(I32 bit, I32 effective, struct stat *statbufp)*/ -I32 -Perl_cando(pTHX_ I32 bit, I32 effective, Stat_t *statbufp) +bool +Perl_cando(pTHX_ Mode_t bit, Uid_t effective, Stat_t *statbufp) { if (statbufp == &PL_statcache) return cando_by_name(bit,effective,namecache); else { @@ -4436,9 +4435,9 @@ Perl_cando(pTHX_ I32 bit, I32 effective, Stat_t *statbufp) /*}}}*/ -/*{{{I32 cando_by_name(I32 bit, I32 effective, char *fname)*/ +/*{{{I32 cando_by_name(I32 bit, Uid_t effective, char *fname)*/ I32 -cando_by_name(I32 bit, I32 effective, char *fname) +cando_by_name(I32 bit, Uid_t effective, char *fname) { static char usrname[L_cuserid]; static struct dsc$descriptor_s usrdsc = diff --git a/vms/vmsish.h b/vms/vmsish.h index 261a506..e9b47a0 100644 --- a/vms/vmsish.h +++ b/vms/vmsish.h @@ -252,6 +252,8 @@ #define HAS_KILL #define HAS_WAIT +#define PERL_FS_VER_FMT "%d_%d_%d" + /* VMS: * This symbol, if defined, indicates that the program is running under * VMS. It's a symbol automagically defined by all VMS C compilers I've seen. @@ -635,7 +637,7 @@ int my_sigdelset (sigset_t *, int); int my_sigismember (sigset_t *, int); int my_sigprocmask (int, sigset_t *, sigset_t *); #endif -I32 cando_by_name (I32, I32, char *); +I32 cando_by_name (I32, Uid_t, char *); int flex_fstat (int, Stat_t *); int flex_stat (const char *, Stat_t *); int trim_unixpath (char *, char*, int); @@ -681,6 +683,4 @@ typedef char __VMS_SEPYTOTORP__; #undef HAS_NTOHL #endif -#define TMPPATH "sys$scratch:perl-eXXXXXX" - #endif /* __vmsish_h_included */ diff --git a/vos/vosish.h b/vos/vosish.h index fc53dc1..1648702 100644 --- a/vos/vosish.h +++ b/vos/vosish.h @@ -99,7 +99,7 @@ #ifndef SIGILL # define SIGILL 6 /* blech */ #endif -#define ABORT() kill(getpid(),SIGABRT); +#define ABORT() kill(PerlProc_getpid(),SIGABRT); /* * fwrite1() should be a routine with the same calling sequence as fwrite(), diff --git a/warning.h b/warning.h deleted file mode 100644 index 8b0cace..0000000 --- a/warning.h +++ /dev/null @@ -1,103 +0,0 @@ -/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!! - This file is built by warning.pl - Any changes made here will be lost! -*/ - - -#define Off(x) ((x) / 8) -#define Bit(x) (1 << ((x) % 8)) -#define IsSet(a, x) ((a)[Off(x)] & Bit(x)) - - -#define G_WARN_OFF 0 /* $^W == 0 */ -#define G_WARN_ON 1 /* -w flag and $^W != 0 */ -#define G_WARN_ALL_ON 2 /* -W flag */ -#define G_WARN_ALL_OFF 4 /* -X flag */ -#define G_WARN_ONCE 8 /* set if 'once' ever enabled */ -#define G_WARN_ALL_MASK (G_WARN_ALL_ON|G_WARN_ALL_OFF) - -#define WARN_STD Nullsv -#define WARN_ALL (&PL_sv_yes) /* use warning 'all' */ -#define WARN_NONE (&PL_sv_no) /* no warning 'all' */ - -#define specialWARN(x) ((x) == WARN_STD || (x) == WARN_ALL || \ - (x) == WARN_NONE) - -#define ckDEAD(x) \ - ( ! specialWARN(PL_curcop->cop_warnings) && \ - IsSet(SvPVX(PL_curcop->cop_warnings), 2*x+1)) - -#define ckWARN(x) \ - ( (PL_curcop->cop_warnings != WARN_STD && \ - PL_curcop->cop_warnings != WARN_NONE && \ - (PL_curcop->cop_warnings == WARN_ALL || \ - IsSet(SvPVX(PL_curcop->cop_warnings), 2*x) ) ) \ - || (PL_curcop->cop_warnings == WARN_STD && PL_dowarn & G_WARN_ON) ) - -#define ckWARN2(x,y) \ - ( (PL_curcop->cop_warnings != WARN_STD && \ - PL_curcop->cop_warnings != WARN_NONE && \ - (PL_curcop->cop_warnings == WARN_ALL || \ - IsSet(SvPVX(PL_curcop->cop_warnings), 2*x) || \ - IsSet(SvPVX(PL_curcop->cop_warnings), 2*y) ) ) \ - || (PL_curcop->cop_warnings == WARN_STD && PL_dowarn & G_WARN_ON) ) - -#define ckWARN_d(x) \ - (PL_curcop->cop_warnings == WARN_STD || \ - PL_curcop->cop_warnings == WARN_ALL || \ - (PL_curcop->cop_warnings != WARN_NONE && \ - IsSet(SvPVX(PL_curcop->cop_warnings), 2*x) ) ) - -#define ckWARN2_d(x,y) \ - (PL_curcop->cop_warnings == WARN_STD || \ - PL_curcop->cop_warnings == WARN_ALL || \ - (PL_curcop->cop_warnings != WARN_NONE && \ - (IsSet(SvPVX(PL_curcop->cop_warnings), 2*x) || \ - IsSet(SvPVX(PL_curcop->cop_warnings), 2*y) ) ) ) - - -#define isLEXWARN_on (PL_curcop->cop_warnings != WARN_STD) -#define isLEXWARN_off (PL_curcop->cop_warnings == WARN_STD) -#define isWARN_ONCE (PL_dowarn & (G_WARN_ON|G_WARN_ONCE)) -#define isWARN_on(c,x) (IsSet(SvPVX(c), 2*(x))) - -#define WARN_IO 0 -#define WARN_CLOSED 1 -#define WARN_EXEC 2 -#define WARN_NEWLINE 3 -#define WARN_PIPE 4 -#define WARN_UNOPENED 5 -#define WARN_MISC 6 -#define WARN_NUMERIC 7 -#define WARN_ONCE 8 -#define WARN_RECURSION 9 -#define WARN_REDEFINE 10 -#define WARN_SEVERE 11 -#define WARN_DEBUGGING 12 -#define WARN_INPLACE 13 -#define WARN_INTERNAL 14 -#define WARN_SYNTAX 15 -#define WARN_AMBIGUOUS 16 -#define WARN_DEPRECATED 17 -#define WARN_OCTAL 18 -#define WARN_PARENTHESIS 19 -#define WARN_PRECEDENCE 20 -#define WARN_PRINTF 21 -#define WARN_RESERVED 22 -#define WARN_SEMICOLON 23 -#define WARN_UNINITIALIZED 24 -#define WARN_UNSAFE 25 -#define WARN_CLOSURE 26 -#define WARN_SIGNAL 27 -#define WARN_SUBSTR 28 -#define WARN_TAINT 29 -#define WARN_UNTIE 30 -#define WARN_UTF8 31 -#define WARN_VOID 32 - -#define WARNsize 9 -#define WARN_ALLstring "\125\125\125\125\125\125\125\125\125" -#define WARN_NONEstring "\0\0\0\0\0\0\0\0\0" - -/* end of file warning.h */ - diff --git a/warnings.h b/warnings.h index a5d50bf..8c1bbf7 100644 --- a/warnings.h +++ b/warnings.h @@ -17,8 +17,8 @@ #define G_WARN_ALL_MASK (G_WARN_ALL_ON|G_WARN_ALL_OFF) #define WARN_STD Nullsv -#define WARN_ALL (&PL_sv_yes) /* use warnings 'all' */ -#define WARN_NONE (&PL_sv_no) /* no warnings 'all' */ +#define WARN_ALL (Nullsv+1) /* use warnings 'all' */ +#define WARN_NONE (Nullsv+2) /* no warnings 'all' */ #define specialWARN(x) ((x) == WARN_STD || (x) == WARN_ALL || \ (x) == WARN_NONE) diff --git a/warnings.pl b/warnings.pl index 9ff4197..72d19af 100644 --- a/warnings.pl +++ b/warnings.pl @@ -150,8 +150,8 @@ print WARN <<'EOM' ; #define G_WARN_ALL_MASK (G_WARN_ALL_ON|G_WARN_ALL_OFF) #define WARN_STD Nullsv -#define WARN_ALL (&PL_sv_yes) /* use warnings 'all' */ -#define WARN_NONE (&PL_sv_no) /* no warnings 'all' */ +#define WARN_ALL (Nullsv+1) /* use warnings 'all' */ +#define WARN_NONE (Nullsv+2) /* no warnings 'all' */ #define specialWARN(x) ((x) == WARN_STD || (x) == WARN_ALL || \ (x) == WARN_NONE) diff --git a/win32/Makefile b/win32/Makefile index af3a4fb..c100d45 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -29,7 +29,7 @@ INST_TOP = $(INST_DRV)\perl # versioned installation can be obtained by setting INST_TOP above to a # path that includes an arbitrary version string. # -INST_VER = \5.00561 +INST_VER = \5.5.640 # # Comment this out if you DON'T want your perl installation to have @@ -47,7 +47,7 @@ INST_ARCH = \$(ARCHNAME) # # uncomment to enable threads-capabilities # -#USE_THREADS = define +#USE_5005THREADS= define # # XXX WARNING! This option currently undergoing changes. May be broken. @@ -65,6 +65,22 @@ INST_ARCH = \$(ARCHNAME) #USE_OBJECT = define # +# XXX WARNING! This option currently undergoing changes. May be broken. +# +# Beginnings of interpreter cloning/threads: still rather rough, fails +# tests. This should be enabled to get the fork() emulation. Do not +# enable unless you know what you're doing! +# +#USE_ITHREADS = define + +# +# uncomment to enable the implicit "host" layer for all system calls +# made by perl. This is needed and auto-enabled by USE_OBJECT above. +# This is also needed to get fork(). +# +#USE_IMP_SYS = define + +# # uncomment one of the following lines if you are using either # Visual C++ 2.x or Visual C++ 6.x (aka Visual Studio 98) # @@ -78,12 +94,15 @@ INST_ARCH = \$(ARCHNAME) # # uncomment to enable use of PerlCRT.DLL when using the Visual C compiler. -# Highly recommended. It has patches that fix known bugs in MSVCRT.DLL. +# It has patches that fix known bugs in older versions of MSVCRT.DLL. # This currently requires VC 5.0 with Service Pack 3 or later. # Get it from CPAN at http://www.perl.com/CPAN/authors/id/D/DO/DOUGL/ # and follow the directions in the package to install. # +# Not recommended if you have VC 6.x and you're not running Windows 9x. +# #USE_PERLCRT = define +#BUILD_FOR_WIN95 = define # # uncomment to enable linking with setargv.obj under the Visual C @@ -130,17 +149,36 @@ CCINCDIR = $(CCHOME)\include CCLIBDIR = $(CCHOME)\lib # -# additional compiler flags can be specified here. +# Additional compiler flags can be specified here. # -# Adding -DPERL_POLLUTE enables support for old symbols, at the expense of -# extreme pollution. You most probably want this if you're compiling modules -# from CPAN, or other such serious uses of this experimental perl release. -# We don't enable this by default because we want the modules to get fixed -# instead of clinging to shortcuts like this one. + +# +# This should normally be disabled. Adding -DPERL_POLLUTE enables support +# for old symbols by default, at the expense of extreme pollution. You most +# probably just want to build modules that won't compile with +# perl Makefile.PL POLLUTE=1 +# instead of enabling this. Please report such modules to the respective +# authors. # #BUILDOPT = $(BUILDOPT) -DPERL_POLLUTE # +# This should normally be disabled. Enabling it will disable the File::Glob +# implementation of CORE::glob. +# +#BUILDOPT = $(BUILDOPT) -DPERL_EXTERNAL_GLOB + +# +# This should normally be disabled. Enabling it causes perl to read scripts +# in text mode (which is the 5.005 behavior) and will break ByteLoader. +#BUILDOPT = $(BUILDOPT) -DPERL_TEXTMODE_SCRIPTS + +# +# This should normally be disabled. Enabling it runs a cloned toplevel +# interpreter (*EXPERIMENTAL*, fails tests) +#BUILDOPT = $(BUILDOPT) -DTOP_CLONE + +# # specify semicolon-separated list of extra directories that modules will # look for libraries (spaces in path names need not be quoted) # @@ -150,7 +188,7 @@ EXTRALIBDIRS = # set this to your email address (perl will guess a value from # from your loginname and your hostname, which may not be right) # -#EMAIL = +#EMAIL = ## ## Build configuration ends. @@ -167,16 +205,21 @@ CRYPT_FLAG = -DHAVE_DES_FCRYPT !IF "$(USE_OBJECT)" == "define" PERL_MALLOC = undef -USE_THREADS = undef +USE_5005THREADS = undef USE_MULTI = undef +USE_IMP_SYS = define !ENDIF !IF "$(PERL_MALLOC)" == "" PERL_MALLOC = undef !ENDIF -!IF "$(USE_THREADS)" == "" -USE_THREADS = undef +!IF "$(USE_5005THREADS)" == "" +USE_5005THREADS = undef +!ENDIF + +!IF "$(USE_5005THREADS)" == "define" +USE_ITHREADS = undef !ENDIF !IF "$(USE_MULTI)" == "" @@ -187,10 +230,26 @@ USE_MULTI = undef USE_OBJECT = undef !ENDIF -!IF "$(USE_MULTI)$(USE_THREADS)$(USE_OBJECT)" != "undefundefundef" +!IF "$(USE_ITHREADS)" == "" +USE_ITHREADS = undef +!ENDIF + +!IF "$(USE_IMP_SYS)" == "" +USE_IMP_SYS = undef +!ENDIF + +!IF "$(USE_PERLCRT)" == "" +USE_PERLCRT = undef +!ENDIF + +!IF "$(USE_MULTI)$(USE_5005THREADS)$(USE_OBJECT)" != "undefundefundef" BUILDOPT = $(BUILDOPT) -DPERL_IMPLICIT_CONTEXT !ENDIF +!IF "$(USE_IMP_SYS)" != "undef" +BUILDOPT = $(BUILDOPT) -DPERL_IMPLICIT_SYS +!ENDIF + !IF "$(PROCESSOR_ARCHITECTURE)" == "" PROCESSOR_ARCHITECTURE = x86 !ENDIF @@ -198,7 +257,7 @@ PROCESSOR_ARCHITECTURE = x86 !IF "$(USE_OBJECT)" == "define" ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE)-object !ELSE -!IF "$(USE_THREADS)" == "define" +!IF "$(USE_5005THREADS)" == "define" ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE)-thread !ELSE !IF "$(USE_MULTI)" == "define" @@ -209,6 +268,10 @@ ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE) !ENDIF !ENDIF +!IF "$(USE_ITHREADS)" == "define" +ARCHNAME = $(ARCHNAME)-thread +!ENDIF + # Visual Studio 98 specific !IF "$(CCTYPE)" == "MSVC60" @@ -247,6 +310,7 @@ INST_HTML = $(INST_POD)\html CC = cl LINK32 = link LIB32 = $(LINK32) -lib +RSC = rc # # Options @@ -260,7 +324,7 @@ LOCDEFS = -DPERLDLL -DPERL_CORE SUBSYS = console CXX_FLAG = -TP -GX -!IF "$(USE_PERLCRT)" == "" +!IF "$(USE_PERLCRT)" != "define" ! IF "$(CFG)" == "Debug" PERLCRTLIBC = msvcrtd.lib ! ELSE @@ -274,6 +338,9 @@ PERLCRTLIBC = PerlCRT.lib ! ENDIF !ENDIF +PERLEXE_RES = +PERLDLL_RES = + !IF "$(RUNTIME)" == "-MD" LIBC = $(PERLCRTLIBC) !ELSE @@ -303,10 +370,14 @@ OPTIMIZE = $(OPTIMIZE) $(CXX_FLAG) BUILDOPT = $(BUILDOPT) -DPERL_OBJECT !ENDIF +!IF "$(USE_PERLCRT)" != "define" +BUILDOPT = $(BUILDOPT) -DPERL_MSVCRT_READFIX +!ENDIF + LIBBASEFILES = $(DELAYLOAD) $(CRYPT_LIB) \ - oldnames.lib kernel32.lib user32.lib gdi32.lib \ - winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib \ - oleaut32.lib netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib \ + oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib \ + comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib \ + netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib \ version.lib odbc32.lib odbccp32.lib # we add LIBC here, since we may be using PerlCRT.dll @@ -331,7 +402,7 @@ o = .obj # Rules # -.SUFFIXES : .c $(o) .dll .lib .exe +.SUFFIXES : .c $(o) .dll .lib .exe .rc .res .c$(o): $(CC) -c -I$( perldll.def -$(PERLDLL): perldll.def $(PERLDLL_OBJ) +$(PERLDLL): perldll.def $(PERLDLL_OBJ) $(PERLDLL_RES) $(LINK32) -dll -def:perldll.def -out:$@ @<< - $(LINK_FLAGS) $(LIBFILES) $(PERLDLL_OBJ) + $(LINK_FLAGS) $(LIBFILES) $(PERLDLL_OBJ) $(PERLDLL_RES) << $(XCOPY) $(PERLIMPLIB) $(COREDIR) @@ -765,13 +854,15 @@ perlmain.c : runperl.c perlmain$(o) : perlmain.c $(CC) $(CFLAGS_O) -UPERLDLL $(OBJOUT_FLAG)$@ -c perlmain.c -$(PERLEXE): $(PERLDLL) $(CONFIGPM) $(PERLEXE_OBJ) +$(PERLEXE): $(PERLDLL) $(CONFIGPM) $(PERLEXE_OBJ) $(PERLEXE_RES) $(LINK32) -subsystem:console -out:$@ $(LINK_FLAGS) $(LIBFILES) \ - $(PERLEXE_OBJ) $(SETARGV_OBJ) $(PERLIMPLIB) + $(PERLEXE_OBJ) $(SETARGV_OBJ) $(PERLIMPLIB) $(PERLEXE_RES) + copy $(PERLEXE) $(WPERLEXE) + editbin /subsystem:windows $(WPERLEXE) copy splittree.pl .. $(MINIPERL) -I..\lib ..\splittree.pl "../LIB" $(AUTODIR) -!IF "$(USE_PERLCRT)" == "" +!IF "$(BUILD_FOR_WIN95)" == "define" perl95.c : runperl.c copy runperl.c perl95.c @@ -802,8 +893,10 @@ $(DYNALOADER).c: $(MINIPERL) $(EXTDIR)\DynaLoader\dl_win32.xs $(CONFIGPM) if not exist $(AUTODIR) mkdir $(AUTODIR) cd $(EXTDIR)\$(*B) ..\$(MINIPERL) -I..\..\lib $(*B)_pm.PL + ..\$(MINIPERL) -I..\..\lib XSLoader_pm.PL cd ..\..\win32 $(XCOPY) $(EXTDIR)\$(*B)\$(*B).pm $(LIBDIR)\$(NULL) + $(XCOPY) $(EXTDIR)\$(*B)\XSLoader.pm $(LIBDIR)\$(NULL) cd $(EXTDIR)\$(*B) $(XSUBPP) dl_win32.xs > $(*B).c cd ..\..\win32 @@ -823,6 +916,12 @@ $(DPROF_DLL): $(PERLEXE) $(DPROF).xs $(MAKE) cd ..\..\..\win32 +$(GLOB_DLL): $(PERLEXE) $(GLOB).xs + cd $(EXTDIR)\File\$(*B) + ..\..\..\miniperl -I..\..\..\lib Makefile.PL INSTALLDIRS=perl + $(MAKE) + cd ..\..\..\win32 + $(PEEK_DLL): $(PERLEXE) $(PEEK).xs cd $(EXTDIR)\Devel\$(*B) ..\..\..\miniperl -I..\..\..\lib Makefile.PL INSTALLDIRS=perl @@ -923,12 +1022,14 @@ distclean: clean -del /f $(EXTENSION_C) $(DYNALOADER).c $(ERRNO).pm -del /f $(EXTDIR)\DynaLoader\dl_win32.xs -del /f $(LIBDIR)\.exists $(LIBDIR)\attrs.pm $(LIBDIR)\DynaLoader.pm + -del /f $(LIBDIR)\XSLoader.pm -del /f $(LIBDIR)\Fcntl.pm $(LIBDIR)\IO.pm $(LIBDIR)\Opcode.pm -del /f $(LIBDIR)\ops.pm $(LIBDIR)\Safe.pm $(LIBDIR)\Thread.pm -del /f $(LIBDIR)\SDBM_File.pm $(LIBDIR)\Socket.pm $(LIBDIR)\POSIX.pm -del /f $(LIBDIR)\B.pm $(LIBDIR)\O.pm $(LIBDIR)\re.pm -del /f $(LIBDIR)\Data\Dumper.pm $(LIBDIR)\ByteLoader.pm -del /f $(LIBDIR)\Devel\Peek.pm $(LIBDIR)\Devel\DProf.pm + -del /f $(LIBDIR)\File\Glob.pm -rmdir /s /q $(LIBDIR)\IO || rmdir /s $(LIBDIR)\IO -rmdir /s /q $(LIBDIR)\Thread || rmdir /s $(LIBDIR)\Thread -rmdir /s /q $(LIBDIR)\B || rmdir /s $(LIBDIR)\B @@ -936,7 +1037,7 @@ distclean: clean -del /f $(PODDIR)\*.html -del /f $(PODDIR)\*.bat cd ..\utils - -del /f h2ph splain perlbug pl2pm c2ph h2xs perldoc pstruct dprofpp + -del /f h2ph splain perlbug pl2pm c2ph h2xs perldoc dprofpp -del /f *.bat cd ..\win32 cd ..\x2p @@ -957,9 +1058,10 @@ install : all installbare installhtml installbare : utils $(PERLEXE) ..\installperl -!IF "$(USE_PERLCRT)" == "" +!IF "$(BUILD_FOR_WIN95)" == "define" $(XCOPY) $(PERL95EXE) $(INST_BIN)\*.* !ENDIF + if exist $(WPERLEXE) $(XCOPY) $(WPERLEXE) $(INST_BIN)\*.* $(XCOPY) $(GLOBEXE) $(INST_BIN)\*.* $(XCOPY) bin\*.bat $(INST_SCRIPT)\*.* @@ -1005,6 +1107,7 @@ clean : -@erase /f config.h -@erase $(GLOBEXE) -@erase $(PERLEXE) + -@erase $(WPERLEXE) -@erase $(PERLDLL) -@erase $(CORE_OBJ) -rmdir /s /q $(MINIDIR) || rmdir /s $(MINIDIR) diff --git a/win32/bin/perlglob.pl b/win32/bin/perlglob.pl index 6467e57..17843c8 100644 --- a/win32/bin/perlglob.pl +++ b/win32/bin/perlglob.pl @@ -41,7 +41,7 @@ builtins. =head1 AUTHOR -Gurusamy Sarathy +Gurusamy Sarathy =head1 SEE ALSO diff --git a/win32/config.bc b/win32/config.bc index 46b7796..137347e 100644 --- a/win32/config.bc +++ b/win32/config.bc @@ -8,12 +8,8 @@ Id='$Id' Locker='' Log='$Log' Mcc='Mcc' -PERL_VERSION='~PERL_VERSION~' -PERL_SUBVERSION='~PERL_SUBVERSION~' -PATCHLEVEL='~PERL_VERSION~' RCSfile='$RCSfile' Revision='$Revision' -SUBVERSION='~PERL_SUBVERSION~' Source='' State='' _a='.lib' @@ -23,7 +19,10 @@ afs='false' alignbytes='8' ansi2knr='' aphostname='' -apiversion='5.005' +api_revision='~PERL_API_REVISION~' +api_subversion='~PERL_API_SUBVERSION~' +api_version='~PERL_API_VERSION~' +api_versionstring='~PERL_API_REVISION~.~PERL_API_VERSION~.~PERL_API_SUBVERSION~' ar='tlib /P128' archlib='~INST_TOP~~INST_VER~\lib~INST_ARCH~' archlibexp='~INST_TOP~~INST_VER~\lib~INST_ARCH~' @@ -31,9 +30,10 @@ archname64='' archname='MSWin32' archobjs='' awk='awk' -baserev='5.0' +baserev='5' bash='' bin='~INST_TOP~~INST_VER~\bin~INST_ARCH~' +bincompat5005='undef' binexp='~INST_TOP~~INST_VER~\bin~INST_ARCH~' bison='' byacc='byacc' @@ -49,6 +49,7 @@ ccsymbols='' cf_by='nobody' cf_email='nobody@no.where.net' cf_time='' +charsize='1' chgrp='' chmod='' chown='' @@ -71,13 +72,28 @@ crosscompile='undef' cryptlib='' csh='undef' d_Gconvert='gcvt((x),(n),(b))' +d_PRIEldbl='undef' +d_PRIFldbl='undef' +d_PRIGldbl='undef' +d_PRIX64='undef' +d_PRId64='undef' +d_PRIeldbl='undef' +d_PRIfldbl='undef' +d_PRIgldbl='undef' +d_PRIi64='undef' +d_PRIo64='undef' +d_PRIu64='undef' +d_PRIx64='undef' d_access='define' d_accessx='undef' d_alarm='undef' d_archlib='define' +d_atolf='undef' +d_atoll='undef' d_attribut='undef' d_bcmp='undef' d_bcopy='undef' +d_bincompat5005='undef' d_bsd='define' d_bsdgetpgrp='undef' d_bsdsetpgrp='undef' @@ -89,17 +105,12 @@ d_chown='undef' d_chroot='undef' d_chsize='define' d_closedir='define' -d_cmsghdr_s='undef' d_const='define' d_crypt='undef' d_csh='undef' d_cuserid='undef' d_dbl_dig='define' -d_dbmclose64='undef' -d_dbminit64='undef' -d_delete64='undef' d_difftime='define' -d_dirent64_s='undef' d_dirnamlen='define' d_dlerror='define' d_dlopen='define' @@ -114,6 +125,7 @@ d_endnent='undef' d_endpent='undef' d_endpwent='undef' d_endsent='undef' +d_endspent='undef' d_eofnblk='define' d_eunice='undef' d_fchmod='undef' @@ -122,30 +134,19 @@ d_fcntl='undef' d_fd_macros='define' d_fd_set='define' d_fds_bits='define' -d_fetch64='undef' d_fgetpos='define' -d_fgetpos64='undef' -d_firstkey64='undef' d_flexfnam='define' d_flock='define' -d_flock64_s='undef' -d_fopen64='undef' d_fork='undef' d_fpathconf='undef' -d_freopen64='undef' -d_fseek64='undef' +d_fpos64_t='undef' +d_fs_data_s='undef' d_fseeko='undef' -d_fseeko64='undef' d_fsetpos='define' -d_fsetpos64='undef' -d_fstat64='undef' d_fstatfs='undef' d_fstatvfs='undef' -d_ftell64='undef' d_ftello='undef' -d_ftello64='undef' d_ftime='define' -d_ftruncate64='undef' d_getgrent='undef' d_getgrps='undef' d_gethbyaddr='define' @@ -154,6 +155,8 @@ d_gethent='undef' d_gethname='define' d_gethostprotos='define' d_getlogin='define' +d_getmnt='undef' +d_getmntent='undef' d_getnbyaddr='undef' d_getnbyname='undef' d_getnent='undef' @@ -172,32 +175,30 @@ d_getsbyname='define' d_getsbyport='define' d_getsent='undef' d_getservprotos='define' +d_getspent='undef' +d_getspnam='undef' d_gettimeod='undef' d_grpasswd='undef' +d_hasmntopt='undef' d_gnulibc='undef' d_htonl='define' d_index='undef' d_inetaton='undef' -d_ino64t='undef' d_int64t='undef' -d_iovec_s='undef' d_isascii='define' d_killpg='undef' d_ldbl_dig='define' d_lchown='undef' -d_link='undef' +d_link='define' d_locconv='define' d_lockf='undef' -d_lockf64='undef' d_longdbl='define' d_longlong='undef' -d_lseek64='undef' d_lstat='undef' -d_lstat64='undef' -d_madvise='undef' d_mblen='define' d_mbstowcs='define' d_mbtowc='define' +d_memchr='define' d_memcmp='define' d_memcpy='define' d_memmove='define' @@ -205,8 +206,6 @@ d_memset='define' d_mkdir='define' d_mkfifo='undef' d_mktime='define' -d_mmap='undef' -d_mprotect='undef' d_msg='undef' d_msg_ctrunc='undef' d_msg_dontroute='undef' @@ -215,21 +214,15 @@ d_msg_peek='undef' d_msg_proxy='undef' d_msgctl='undef' d_msgget='undef' -d_msghdr_s='undef' d_msgrcv='undef' d_msgsnd='undef' -d_msync='undef' -d_munmap='undef' d_mymalloc='undef' -d_nextkey64='undef' d_nice='undef' -d_off64t='undef' +d_off64_t='undef' d_old_pthread_create_joinable='undef' d_oldpthreads='undef' d_oldsock='undef' d_open3='undef' -d_open64='undef' -d_opendir64='undef' d_pathconf='undef' d_pause='define' d_phostname='undef' @@ -243,13 +236,11 @@ d_pwclass='undef' d_pwcomment='undef' d_pwexpire='undef' d_pwgecos='undef' -d_pwquota='undef' d_pwpasswd='undef' +d_pwquota='undef' +d_quad='undef' d_readdir='define' -d_readdir64='undef' d_readlink='undef' -d_readv='undef' -d_recvmesg='undef' d_rename='define' d_rewinddir='define' d_rmdir='define' @@ -259,7 +250,6 @@ d_sanemcmp='define' d_sched_yield='undef' d_scm_rights='undef' d_seekdir='define' -d_seekdir64='undef' d_select='define' d_sem='undef' d_semctl='undef' @@ -267,7 +257,6 @@ d_semctl_semid_ds='undef' d_semctl_semun='undef' d_semget='undef' d_semop='undef' -d_sendmsg='undef' d_setegid='undef' d_seteuid='undef' d_setgrent='undef' @@ -290,6 +279,7 @@ d_setrgid='undef' d_setruid='undef' d_setsent='undef' d_setsid='undef' +d_setspent='undef' d_setvbuf='define' d_sfio='undef' d_shm='undef' @@ -302,16 +292,16 @@ d_sigaction='undef' d_sigsetjmp='undef' d_socket='define' d_sockpair='undef' -d_stat64='undef' +d_sqrtl='undef' d_statblks='undef' -d_statfs='undef' -d_statfsflags='undef' +d_statfs_f_flags='undef' +d_statfs_s='undef' d_statvfs='undef' d_stdio_cnt_lval='define' d_stdio_ptr_lval='define' +d_stdio_stream_array='undef' d_stdiobase='define' d_stdstdio='define' -d_store64='undef' d_strchr='define' d_strcoll='define' d_strctcpy='define' @@ -319,7 +309,11 @@ d_strerrm='strerror(e)' d_strerror='define' d_strtod='define' d_strtol='define' +d_strtold='undef' +d_strtoll='undef' d_strtoul='define' +d_strtoull='undef' +d_strtouq='undef' d_strxfrm='define' d_suidsafe='undef' d_symlink='undef' @@ -331,17 +325,17 @@ d_system='define' d_tcgetpgrp='undef' d_tcsetpgrp='undef' d_telldir='define' -d_telldir64='undef' d_telldirproto='define' d_time='define' d_times='define' -d_tmpfile64='undef' d_truncate='undef' -d_truncate64='undef' d_tzname='define' d_umask='define' d_uname='define' d_union_semun='define' +d_ustat='undef' +d_vendorbin='undef' +d_vendorlib='undef' d_vfork='undef' d_void_closedir='undef' d_voidsig='define' @@ -352,7 +346,6 @@ d_wait4='undef' d_waitpid='define' d_wcstombs='define' d_wctomb='define' -d_writev='undef' d_xenix='undef' date='date' db_hashtype='int' @@ -378,11 +371,16 @@ fflushall='undef' find='find' firstmakefile='makefile' flex='' +fpossize='4' fpostype='fpos_t' freetype='void' +full_ar='' full_csh='' full_sed='' gccversion='' +gidformat='"d"' +gidsign='-1' +gidsize='4' gidtype='gid_t' glibpth='/usr/shlib /lib/pa1.1 /usr/lib/large /lib /usr/lib /usr/lib/386 /lib/386 /lib/large /usr/lib/small /lib/small /usr/ccs/lib /usr/ucblib /usr/shlib ' grep='grep' @@ -394,6 +392,14 @@ h_sysfile='true' hint='recommended' hostcat='ypcat hosts' huge='' +i16size='2' +i16type='short' +i32size='4' +i32type='long' +i64size='8' +i64type='__int64' +i8size='1' +i8type='char' i_arpainet='define' i_bsdioctl='' i_db='undef' @@ -416,12 +422,16 @@ i_mntent='undef' i_ndbm='undef' i_netdb='undef' i_neterrno='undef' +i_netinettcp='undef' i_niin='undef' i_poll='undef' +i_pthread='undef' i_pwd='undef' i_rpcsvcdbm='define' i_sfio='undef' i_sgtty='undef' +i_shadow='undef' +i_socks='undef' i_stdarg='define' i_stddef='define' i_stdlib='define' @@ -432,7 +442,6 @@ i_sysfile='undef' i_sysfilio='define' i_sysin='undef' i_sysioctl='undef' -i_sysmman='undef' i_sysmount='undef' i_sysndir='undef' i_sysparam='undef' @@ -440,6 +449,7 @@ i_sysresrc='undef' i_syssecrt='undef' i_sysselct='undef' i_syssockio='' +i_sysstatfs='undef' i_sysstatvfs='undef' i_sysstat='define' i_systime='undef' @@ -448,37 +458,49 @@ i_systimes='undef' i_systypes='define' i_sysuio='undef' i_sysun='undef' +i_sysvfs='undef' i_syswait='undef' i_termio='undef' i_termios='undef' i_time='define' i_unistd='undef' +i_ustat='undef' i_utime='define' i_values='undef' i_varargs='undef' i_varhdr='varargs.h' i_vfork='undef' ignore_versioned_solibs='' +inc_version_list='' incpath='' inews='' installarchlib='~INST_TOP~~INST_VER~\lib~INST_ARCH~' installbin='~INST_TOP~~INST_VER~\bin~INST_ARCH~' installman1dir='~INST_TOP~~INST_VER~\man\man1' installman3dir='~INST_TOP~~INST_VER~\man\man3' +installprefix='~INST_TOP~~INST_VER~' +installprefixexp='~INST_TOP~~INST_VER~' installhtmldir='~INST_TOP~~INST_VER~\html' installhtmlhelpdir='~INST_TOP~~INST_VER~\htmlhelp' installprivlib='~INST_TOP~~INST_VER~\lib' installscript='~INST_TOP~~INST_VER~\bin' installsitearch='~INST_TOP~\site~INST_VER~\lib~INST_ARCH~' installsitelib='~INST_TOP~\site~INST_VER~\lib' +installstyle='lib' installusrbinperl='undef' +installvendorbin='' +installvendorlib='' intsize='4' -known_extensions='DB_File Fcntl GDBM_File NDBM_File ODBM_File Opcode POSIX SDBM_File Socket IO attrs Thread' +ivdformat='"ld"' +ivsize='4' +ivtype='long' +known_extensions='~static_ext~ ~dynamic_ext~ ~nonxs_ext~' ksh='' large='' ld='tlink32' lddlflags='-Tpd ~LINK_FLAGS~' ldflags='~LINK_FLAGS~' +ldlibpthname='' less='less' lib_ext='.lib' libc='cw32mti.lib' @@ -515,10 +537,8 @@ man3dir='~INST_TOP~~INST_VER~\man\man3' man3direxp='~INST_TOP~~INST_VER~\man\man3' man3ext='3' medium='' -mips='' mips_type='' mkdir='mkdir' -mmaptype='void *' models='none' modetype='mode_t' more='more /e' @@ -538,6 +558,8 @@ nm_opt='' nm_so_opt='' nonxs_ext='Errno' nroff='' +nvsize='8' +nvtype='double' o_nonblock='O_NONBLOCK' obj_ext='.obj' old_pthread_create_joinable='' @@ -565,6 +587,8 @@ privlib='~INST_TOP~~INST_VER~\lib' privlibexp='~INST_TOP~~INST_VER~\lib' prototype='define' ptrsize='4' +quadcase='5' +quadtype='__int64' randbits='15' randfunc='rand' randseedtype='unsigned' @@ -573,6 +597,18 @@ rd_nodata='-1' rm='del' rmail='' runnm='true' +sPRIEldbl='"E"' +sPRIFldbl='"F"' +sPRIGldbl='"G"' +sPRIX64='"lX"' +sPRId64='"ld"' +sPRIeldbl='"e"' +sPRIfldbl='"f"' +sPRIgldbl='"g"' +sPRIi64='"li"' +sPRIo64='"lo"' +sPRIu64='"lu"' +sPRIx64='"lx"' sched_yield='' scriptdir='~INST_TOP~~INST_VER~\bin' scriptdirexp='~INST_TOP~~INST_VER~\bin' @@ -588,6 +624,7 @@ shmattype='void *' shortsize='2' shrpenv='' shsharp='true' +sig_count='26' sig_name='ZERO NUM01 INT QUIT ILL NUM05 NUM06 NUM07 FPE KILL NUM10 SEGV NUM12 PIPE ALRM TERM USR1 USR2 CHLD NUM19 USR3 BREAK ABRT STOP NUM24 CONT CLD' sig_name_init='"ZERO", "NUM01", "INT", "QUIT", "ILL", "NUM05", "NUM06", "NUM07", "FPE", "KILL", "NUM10", "SEGV", "NUM12", "PIPE", "ALRM", "TERM", "USR1", "USR2", "CHLD", "NUM19", "USR3", "BREAK", "ABRT", "STOP", "NUM24", "CONT", "CLD", 0' sig_num='0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 18 0' @@ -595,8 +632,12 @@ sig_num_init='0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, signal_t='void' sitearch='~INST_TOP~\site~INST_VER~\lib~INST_ARCH~' sitearchexp='~INST_TOP~\site~INST_VER~\lib~INST_ARCH~' +sitebin='~INST_TOP~\site~INST_VER~\bin~INST_ARCH~' +sitebinexp='~INST_TOP~\site~INST_VER~\bin~INST_ARCH~' sitelib='~INST_TOP~\site~INST_VER~\lib' sitelibexp='~INST_TOP~\site~INST_VER~\lib' +siteprefix='~INST_TOP~\site~INST_VER~' +siteprefixexp='~INST_TOP~\site~INST_VER~' sizetype='size_t' sleep='' smail='' @@ -619,6 +660,7 @@ stdio_bufsiz='((fp)->level + (fp)->curp - (fp)->buffer)' stdio_cnt='((fp)->level)' stdio_filbuf='' stdio_ptr='((fp)->curp)' +stdio_stream_array='' strings='/usr/include/string.h' submit='' subversion='~SUBVERSION~' @@ -634,11 +676,29 @@ touch='touch' tr='' trnl='\012' troff='' +u16size='2' +u16type='unsigned short' +u32size='4' +u32type='unsigned long' +u64size='8' +u64type='unsigned __int64' +u8size='1' +u8type='unsigned char' +uidformat='"d"' +uidsign='-1' +uidsize='4' uidtype='uid_t' uname='uname' uniq='uniq' +uquadtype='unsigned __int64' +use5005threads='undef' use64bits='undef' usedl='define' +useithreads='undef' +uselargefiles='undef' +uselongdouble='undef' +uselonglong='undef' +usemorebits='undef' usemultiplicity='undef' usemymalloc='n' usenm='false' @@ -647,13 +707,34 @@ useperlio='undef' useposix='true' usesfio='false' useshrplib='yes' +usesocks='undef' usethreads='undef' +usevendorprefix='undef' usevfork='false' usrinc='/usr/include' uuname='' +uvoformat='"lo"' +uvsize='4' +uvtype='unsigned long' +uvuformat='"lu"' +uvxformat='"lx"' +vendorbin='' +vendorbinexp='' +vendorlib='' +vendorlibexp='' +vendorprefix='' +vendorprefixexp='' version='~VERSION~' vi='' voidflags='15' xlibpth='/usr/lib/386 /lib/386' zcat='' zip='zip' +PERL_REVISION='~PERL_REVISION~' +PERL_SUBVERSION='~PERL_SUBVERSION~' +PERL_VERSION='~PERL_VERSION~' +PERL_API_REVISION='~PERL_API_REVISION~' +PERL_API_SUBVERSION='~PERL_API_SUBVERSION~' +PERL_API_VERSION='~PERL_API_VERSION~' +PATCHLEVEL='~PERL_VERSION~' +SUBVERSION='~PERL_SUBVERSION~' diff --git a/win32/config.gc b/win32/config.gc index a109f45..abfc288 100644 --- a/win32/config.gc +++ b/win32/config.gc @@ -8,12 +8,8 @@ Id='$Id' Locker='' Log='$Log' Mcc='Mcc' -PERL_VERSION='~PERL_VERSION~' -PERL_SUBVERSION='~PERL_SUBVERSION~' -PATCHLEVEL='~PERL_VERSION~' RCSfile='$RCSfile' Revision='$Revision' -SUBVERSION='~PERL_SUBVERSION~' Source='' State='' _a='.a' @@ -23,7 +19,10 @@ afs='false' alignbytes='8' ansi2knr='' aphostname='' -apiversion='5.005' +api_revision='~PERL_API_REVISION~' +api_subversion='~PERL_API_SUBVERSION~' +api_version='~PERL_API_VERSION~' +api_versionstring='~PERL_API_REVISION~.~PERL_API_VERSION~.~PERL_API_SUBVERSION~' ar='ar' archlib='~INST_TOP~~INST_VER~\lib~INST_ARCH~' archlibexp='~INST_TOP~~INST_VER~\lib~INST_ARCH~' @@ -31,9 +30,10 @@ archname64='' archname='MSWin32' archobjs='' awk='awk' -baserev='5.0' +baserev='5' bash='' bin='~INST_TOP~~INST_VER~\bin~INST_ARCH~' +bincompat5005='undef' binexp='~INST_TOP~~INST_VER~\bin~INST_ARCH~' bison='' byacc='byacc' @@ -49,6 +49,7 @@ ccsymbols='' cf_by='nobody' cf_email='nobody@no.where.net' cf_time='' +charsize='1' chgrp='' chmod='' chown='' @@ -71,13 +72,28 @@ crosscompile='undef' cryptlib='' csh='undef' d_Gconvert='sprintf((b),"%.*g",(n),(x))' +d_PRIEldbl='undef' +d_PRIFldbl='undef' +d_PRIGldbl='undef' +d_PRIX64='undef' +d_PRId64='undef' +d_PRIeldbl='undef' +d_PRIfldbl='undef' +d_PRIgldbl='undef' +d_PRIi64='undef' +d_PRIo64='undef' +d_PRIu64='undef' +d_PRIx64='undef' d_access='define' d_accessx='undef' d_alarm='undef' d_archlib='define' +d_atolf='undef' +d_atoll='undef' d_attribut='define' d_bcmp='undef' d_bcopy='undef' +d_bincompat5005='undef' d_bsd='define' d_bsdgetpgrp='undef' d_bsdsetpgrp='undef' @@ -89,17 +105,12 @@ d_chown='undef' d_chroot='undef' d_chsize='define' d_closedir='define' -d_cmsghdr_s='undef' d_const='define' d_crypt='undef' d_csh='undef' d_cuserid='undef' d_dbl_dig='define' -d_dbmclose64='undef' -d_dbminit64='undef' -d_delete64='undef' d_difftime='define' -d_dirent64_s='undef' d_dirnamlen='define' d_dlerror='define' d_dlopen='define' @@ -114,6 +125,7 @@ d_endnent='undef' d_endpent='undef' d_endpwent='undef' d_endsent='undef' +d_endspent='undef' d_eofnblk='define' d_eunice='undef' d_fchmod='undef' @@ -122,30 +134,19 @@ d_fcntl='undef' d_fd_macros='define' d_fd_set='define' d_fds_bits='define' -d_fetch64='undef' d_fgetpos='define' -d_fgetpos64='undef' -d_firstkey64='undef' d_flexfnam='define' d_flock='define' -d_flock64_s='undef' -d_fopen64='undef' d_fork='undef' d_fpathconf='undef' -d_freopen64='undef' -d_fseek64='undef' +d_fpos64_t='undef' +d_fs_data_s='undef' d_fseeko='undef' -d_fseeko64='undef' d_fsetpos='define' -d_fsetpos64='undef' -d_fstat64='undef' d_fstatfs='undef' d_fstatvfs='undef' -d_ftell64='undef' d_ftello='undef' -d_ftello64='undef' d_ftime='define' -d_ftruncate64='undef' d_getgrent='undef' d_getgrps='undef' d_gethbyaddr='define' @@ -154,6 +155,8 @@ d_gethent='undef' d_gethname='define' d_gethostprotos='define' d_getlogin='define' +d_getmnt='undef' +d_getmntent='undef' d_getnbyaddr='undef' d_getnbyname='undef' d_getnent='undef' @@ -172,32 +175,30 @@ d_getsbyname='define' d_getsbyport='define' d_getsent='undef' d_getservprotos='define' +d_getspent='undef' +d_getspnam='undef' d_gettimeod='undef' d_grpasswd='undef' +d_hasmntopt='undef' d_gnulibc='undef' d_htonl='define' d_index='undef' d_inetaton='undef' -d_ino64t='undef' d_int64t='undef' -d_iovec_s='undef' d_isascii='define' d_killpg='undef' d_ldbl_dig='define' d_lchown='undef' -d_link='undef' +d_link='define' d_locconv='define' d_lockf='undef' -d_lockf64='undef' d_longdbl='define' d_longlong='undef' -d_lseek64='undef' d_lstat='undef' -d_lstat64='undef' -d_madvise='undef' d_mblen='define' d_mbstowcs='define' d_mbtowc='define' +d_memchr='define' d_memcmp='define' d_memcpy='define' d_memmove='define' @@ -205,8 +206,6 @@ d_memset='define' d_mkdir='define' d_mkfifo='undef' d_mktime='define' -d_mmap='undef' -d_mprotect='undef' d_msg='undef' d_msg_ctrunc='undef' d_msg_dontroute='undef' @@ -215,21 +214,15 @@ d_msg_peek='undef' d_msg_proxy='undef' d_msgctl='undef' d_msgget='undef' -d_msghdr_s='undef' d_msgrcv='undef' d_msgsnd='undef' -d_msync='undef' -d_munmap='undef' d_mymalloc='undef' -d_nextkey64='undef' d_nice='undef' -d_off64t='undef' +d_off64_t='undef' d_old_pthread_create_joinable='undef' d_oldpthreads='undef' d_oldsock='undef' d_open3='undef' -d_open64='undef' -d_opendir64='undef' d_pathconf='undef' d_pause='define' d_phostname='undef' @@ -243,13 +236,11 @@ d_pwclass='undef' d_pwcomment='undef' d_pwexpire='undef' d_pwgecos='undef' -d_pwquota='undef' d_pwpasswd='undef' +d_pwquota='undef' +d_quad='undef' d_readdir='define' -d_readdir64='undef' d_readlink='undef' -d_readv='undef' -d_recvmesg='undef' d_rename='define' d_rewinddir='define' d_rmdir='define' @@ -259,7 +250,6 @@ d_sanemcmp='define' d_sched_yield='undef' d_scm_rights='undef' d_seekdir='define' -d_seekdir64='undef' d_select='define' d_sem='undef' d_semctl='undef' @@ -267,7 +257,6 @@ d_semctl_semid_ds='undef' d_semctl_semun='undef' d_semget='undef' d_semop='undef' -d_sendmsg='undef' d_setegid='undef' d_seteuid='undef' d_setgrent='undef' @@ -290,6 +279,7 @@ d_setrgid='undef' d_setruid='undef' d_setsent='undef' d_setsid='undef' +d_setspent='undef' d_setvbuf='define' d_sfio='undef' d_shm='undef' @@ -302,16 +292,16 @@ d_sigaction='undef' d_sigsetjmp='undef' d_socket='define' d_sockpair='undef' -d_stat64='undef' +d_sqrtl='undef' d_statblks='undef' -d_statfs='undef' -d_statfsflags='undef' +d_statfs_f_flags='undef' +d_statfs_s='undef' d_statvfs='undef' d_stdio_cnt_lval='define' d_stdio_ptr_lval='define' -d_stdiobase='undef' -d_stdstdio='undef' -d_store64='undef' +d_stdio_stream_array='undef' +d_stdiobase='define' +d_stdstdio='define' d_strchr='define' d_strcoll='define' d_strctcpy='define' @@ -319,7 +309,11 @@ d_strerrm='strerror(e)' d_strerror='define' d_strtod='define' d_strtol='define' +d_strtold='undef' +d_strtoll='undef' d_strtoul='define' +d_strtoull='undef' +d_strtouq='undef' d_strxfrm='define' d_suidsafe='undef' d_symlink='undef' @@ -331,17 +325,17 @@ d_system='define' d_tcgetpgrp='undef' d_tcsetpgrp='undef' d_telldir='define' -d_telldir64='undef' d_telldirproto='define' d_time='define' d_times='define' -d_tmpfile64='undef' d_truncate='undef' -d_truncate64='undef' -d_tzname='undef' +d_tzname='define' d_umask='define' d_uname='define' d_union_semun='define' +d_ustat='undef' +d_vendorbin='undef' +d_vendorlib='undef' d_vfork='undef' d_void_closedir='undef' d_voidsig='define' @@ -352,7 +346,6 @@ d_wait4='undef' d_waitpid='define' d_wcstombs='define' d_wctomb='define' -d_writev='undef' d_xenix='undef' date='date' db_hashtype='int' @@ -378,11 +371,16 @@ fflushall='undef' find='find' firstmakefile='makefile' flex='' +fpossize='4' fpostype='fpos_t' freetype='void' +full_ar='' full_csh='' full_sed='' gccversion='' +gidformat='"ld"' +gidsign='-1' +gidsize='4' gidtype='gid_t' glibpth='/usr/shlib /lib/pa1.1 /usr/lib/large /lib /usr/lib /usr/lib/386 /lib/386 /lib/large /usr/lib/small /lib/small /usr/ccs/lib /usr/ucblib /usr/shlib ' grep='grep' @@ -394,6 +392,14 @@ h_sysfile='true' hint='recommended' hostcat='ypcat hosts' huge='' +i16size='2' +i16type='short' +i32size='4' +i32type='long' +i64size='8' +i64type='long long' +i8size='1' +i8type='char' i_arpainet='define' i_bsdioctl='' i_db='undef' @@ -416,12 +422,16 @@ i_mntent='undef' i_ndbm='undef' i_netdb='undef' i_neterrno='undef' +i_netinettcp='undef' i_niin='undef' i_poll='undef' +i_pthread='undef' i_pwd='undef' i_rpcsvcdbm='define' i_sfio='undef' i_sgtty='undef' +i_shadow='undef' +i_socks='undef' i_stdarg='define' i_stddef='define' i_stdlib='define' @@ -432,7 +442,6 @@ i_sysfile='undef' i_sysfilio='define' i_sysin='undef' i_sysioctl='undef' -i_sysmman='undef' i_sysmount='undef' i_sysndir='undef' i_sysparam='undef' @@ -440,6 +449,7 @@ i_sysresrc='undef' i_syssecrt='undef' i_sysselct='undef' i_syssockio='' +i_sysstatfs='undef' i_sysstatvfs='undef' i_sysstat='define' i_systime='undef' @@ -448,40 +458,52 @@ i_systimes='undef' i_systypes='define' i_sysuio='undef' i_sysun='undef' +i_sysvfs='undef' i_syswait='undef' i_termio='undef' i_termios='undef' i_time='define' i_unistd='undef' +i_ustat='undef' i_utime='define' i_values='undef' i_varargs='undef' i_varhdr='varargs.h' i_vfork='undef' ignore_versioned_solibs='' +inc_version_list='' incpath='' inews='' installarchlib='~INST_TOP~~INST_VER~\lib~INST_ARCH~' installbin='~INST_TOP~~INST_VER~\bin~INST_ARCH~' installman1dir='~INST_TOP~~INST_VER~\man\man1' installman3dir='~INST_TOP~~INST_VER~\man\man3' +installprefix='~INST_TOP~~INST_VER~' +installprefixexp='~INST_TOP~~INST_VER~' installhtmldir='~INST_TOP~~INST_VER~\html' installhtmlhelpdir='~INST_TOP~~INST_VER~\htmlhelp' installprivlib='~INST_TOP~~INST_VER~\lib' installscript='~INST_TOP~~INST_VER~\bin' installsitearch='~INST_TOP~\site~INST_VER~\lib~INST_ARCH~' installsitelib='~INST_TOP~\site~INST_VER~\lib' +installstyle='lib' installusrbinperl='undef' +installvendorbin='' +installvendorlib='' intsize='4' -known_extensions='DB_File Fcntl GDBM_File NDBM_File ODBM_File Opcode POSIX SDBM_File Socket IO attrs Thread' +ivdformat='"ld"' +ivsize='4' +ivtype='long' +known_extensions='~static_ext~ ~dynamic_ext~ ~nonxs_ext~' ksh='' large='' ld='gcc' lddlflags='-mdll ~LINK_FLAGS~' ldflags='~LINK_FLAGS~' +ldlibpthname='' less='less' lib_ext='.a' -libc='libcrtdll.a' +libc='libmsvcrt.a' libperl='libperl.a' libpth='' libs='' @@ -515,10 +537,8 @@ man3dir='~INST_TOP~~INST_VER~\man\man3' man3direxp='~INST_TOP~~INST_VER~\man\man3' man3ext='3' medium='' -mips='' mips_type='' mkdir='mkdir' -mmaptype='void *' models='none' modetype='mode_t' more='more /e' @@ -538,6 +558,8 @@ nm_opt='' nm_so_opt='' nonxs_ext='Errno' nroff='' +nvsize='8' +nvtype='double' o_nonblock='O_NONBLOCK' obj_ext='.o' old_pthread_create_joinable='' @@ -565,6 +587,8 @@ privlib='~INST_TOP~~INST_VER~\lib' privlibexp='~INST_TOP~~INST_VER~\lib' prototype='define' ptrsize='4' +quadcase='5' +quadtype='long long' randbits='15' randfunc='rand' randseedtype='unsigned' @@ -573,6 +597,18 @@ rd_nodata='-1' rm='del' rmail='' runnm='true' +sPRIEldbl='"E"' +sPRIFldbl='"F"' +sPRIGldbl='"G"' +sPRIX64='"lX"' +sPRId64='"ld"' +sPRIeldbl='"e"' +sPRIfldbl='"f"' +sPRIgldbl='"g"' +sPRIi64='"li"' +sPRIo64='"lo"' +sPRIu64='"lu"' +sPRIx64='"lx"' sched_yield='' scriptdir='~INST_TOP~~INST_VER~\bin' scriptdirexp='~INST_TOP~~INST_VER~\bin' @@ -588,6 +624,7 @@ shmattype='void *' shortsize='2' shrpenv='' shsharp='true' +sig_count='26' sig_name='ZERO NUM01 INT QUIT ILL NUM05 NUM06 NUM07 FPE KILL NUM10 SEGV NUM12 PIPE ALRM TERM NUM16 NUM17 NUM18 NUM19 CHLD BREAK ABRT STOP NUM24 CONT CLD' sig_name_init='"ZERO", "NUM01", "INT", "QUIT", "ILL", "NUM05", "NUM06", "NUM07", "FPE", "KILL", "NUM10", "SEGV", "NUM12", "PIPE", "ALRM", "TERM", "NUM16", "NUM17", "NUM18", "NUM19", "CHLD", "BREAK", "ABRT", "STOP", "NUM24", "CONT", "CLD", 0' sig_num='0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 20 0' @@ -595,8 +632,12 @@ sig_num_init='0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, signal_t='void' sitearch='~INST_TOP~\site~INST_VER~\lib~INST_ARCH~' sitearchexp='~INST_TOP~\site~INST_VER~\lib~INST_ARCH~' +sitebin='~INST_TOP~\site~INST_VER~\bin~INST_ARCH~' +sitebinexp='~INST_TOP~\site~INST_VER~\bin~INST_ARCH~' sitelib='~INST_TOP~\site~INST_VER~\lib' sitelibexp='~INST_TOP~\site~INST_VER~\lib' +siteprefix='~INST_TOP~\site~INST_VER~' +siteprefixexp='~INST_TOP~\site~INST_VER~' sizetype='size_t' sleep='' smail='' @@ -619,6 +660,7 @@ stdio_bufsiz='((fp)->_cnt + (fp)->_ptr - (fp)->_base)' stdio_cnt='((fp)->_cnt)' stdio_filbuf='' stdio_ptr='((fp)->_ptr)' +stdio_stream_array='' strings='/usr/include/string.h' submit='' subversion='~SUBVERSION~' @@ -634,12 +676,30 @@ touch='touch' tr='' trnl='\012' troff='' +u16size='2' +u16type='unsigned short' +u32size='4' +u32type='unsigned long' +u64size='8' +u64type='unsigned long long' +u8size='1' +u8type='unsigned char' +uidformat='"ld"' +uidsign='-1' +uidsize='4' uidtype='uid_t' uname='uname' uniq='uniq' +uquadtype='unsigned long long' +use5005threads='undef' use64bits='undef' usedl='define' -usemultiplicity='define' +useithreads='undef' +uselargefiles='undef' +uselongdouble='undef' +uselonglong='undef' +usemorebits='undef' +usemultiplicity='undef' usemymalloc='n' usenm='false' useopcode='true' @@ -647,13 +707,34 @@ useperlio='undef' useposix='true' usesfio='false' useshrplib='yes' +usesocks='undef' usethreads='undef' +usevendorprefix='undef' usevfork='false' usrinc='/usr/include' uuname='' +uvoformat='"lo"' +uvsize='4' +uvtype='unsigned long' +uvuformat='"lu"' +uvxformat='"lx"' +vendorbin='' +vendorbinexp='' +vendorlib='' +vendorlibexp='' +vendorprefix='' +vendorprefixexp='' version='~VERSION~' vi='' voidflags='15' xlibpth='/usr/lib/386 /lib/386' zcat='' zip='zip' +PERL_REVISION='~PERL_REVISION~' +PERL_SUBVERSION='~PERL_SUBVERSION~' +PERL_VERSION='~PERL_VERSION~' +PERL_API_REVISION='~PERL_API_REVISION~' +PERL_API_SUBVERSION='~PERL_API_SUBVERSION~' +PERL_API_VERSION='~PERL_API_VERSION~' +PATCHLEVEL='~PERL_VERSION~' +SUBVERSION='~PERL_SUBVERSION~' diff --git a/win32/config.vc b/win32/config.vc index 24603d8..729beb8 100644 --- a/win32/config.vc +++ b/win32/config.vc @@ -8,12 +8,8 @@ Id='$Id' Locker='' Log='$Log' Mcc='Mcc' -PERL_VERSION='~PERL_VERSION~' -PERL_SUBVERSION='~PERL_SUBVERSION~' -PATCHLEVEL='~PERL_VERSION~' RCSfile='$RCSfile' Revision='$Revision' -SUBVERSION='~PERL_SUBVERSION~' Source='' State='' _a='.lib' @@ -23,7 +19,10 @@ afs='false' alignbytes='8' ansi2knr='' aphostname='' -apiversion='5.005' +api_revision='~PERL_API_REVISION~' +api_subversion='~PERL_API_SUBVERSION~' +api_version='~PERL_API_VERSION~' +api_versionstring='~PERL_API_REVISION~.~PERL_API_VERSION~.~PERL_API_SUBVERSION~' ar='lib' archlib='~INST_TOP~~INST_VER~\lib~INST_ARCH~' archlibexp='~INST_TOP~~INST_VER~\lib~INST_ARCH~' @@ -31,9 +30,10 @@ archname64='' archname='MSWin32' archobjs='' awk='awk' -baserev='5.0' +baserev='5' bash='' bin='~INST_TOP~~INST_VER~\bin~INST_ARCH~' +bincompat5005='undef' binexp='~INST_TOP~~INST_VER~\bin~INST_ARCH~' bison='' byacc='byacc' @@ -49,6 +49,7 @@ ccsymbols='' cf_by='nobody' cf_email='nobody@no.where.net' cf_time='' +charsize='1' chgrp='' chmod='' chown='' @@ -71,13 +72,28 @@ crosscompile='undef' cryptlib='' csh='undef' d_Gconvert='sprintf((b),"%.*g",(n),(x))' +d_PRIEldbl='undef' +d_PRIFldbl='undef' +d_PRIGldbl='undef' +d_PRIX64='undef' +d_PRId64='undef' +d_PRIeldbl='undef' +d_PRIfldbl='undef' +d_PRIgldbl='undef' +d_PRIi64='undef' +d_PRIo64='undef' +d_PRIu64='undef' +d_PRIx64='undef' d_access='define' d_accessx='undef' d_alarm='undef' d_archlib='define' +d_atolf='undef' +d_atoll='undef' d_attribut='undef' d_bcmp='undef' d_bcopy='undef' +d_bincompat5005='undef' d_bsd='define' d_bsdgetpgrp='undef' d_bsdsetpgrp='undef' @@ -89,17 +105,12 @@ d_chown='undef' d_chroot='undef' d_chsize='define' d_closedir='define' -d_cmsghdr_s='undef' d_const='define' d_crypt='undef' d_csh='undef' d_cuserid='undef' d_dbl_dig='define' -d_dbmclose64='undef' -d_dbminit64='undef' -d_delete64='undef' d_difftime='define' -d_dirent64_s='undef' d_dirnamlen='define' d_dlerror='define' d_dlopen='define' @@ -114,6 +125,7 @@ d_endnent='undef' d_endpent='undef' d_endpwent='undef' d_endsent='undef' +d_endspent='undef' d_eofnblk='define' d_eunice='undef' d_fchmod='undef' @@ -122,30 +134,19 @@ d_fcntl='undef' d_fd_macros='define' d_fd_set='define' d_fds_bits='define' -d_fetch64='undef' d_fgetpos='define' -d_fgetpos64='undef' -d_firstkey64='undef' d_flexfnam='define' d_flock='define' -d_flock64_s='undef' -d_fopen64='undef' d_fork='undef' d_fpathconf='undef' -d_freopen64='undef' -d_fseek64='undef' +d_fpos64_t='undef' +d_fs_data_s='undef' d_fseeko='undef' -d_fseeko64='undef' d_fsetpos='define' -d_fsetpos64='undef' -d_fstat64='undef' d_fstatfs='undef' d_fstatvfs='undef' -d_ftell64='undef' d_ftello='undef' -d_ftello64='undef' d_ftime='define' -d_ftruncate64='undef' d_getgrent='undef' d_getgrps='undef' d_gethbyaddr='define' @@ -154,6 +155,8 @@ d_gethent='undef' d_gethname='define' d_gethostprotos='define' d_getlogin='define' +d_getmnt='undef' +d_getmntent='undef' d_getnbyaddr='undef' d_getnbyname='undef' d_getnent='undef' @@ -172,32 +175,30 @@ d_getsbyname='define' d_getsbyport='define' d_getsent='undef' d_getservprotos='define' +d_getspent='undef' +d_getspnam='undef' d_gettimeod='undef' d_grpasswd='undef' +d_hasmntopt='undef' d_gnulibc='undef' d_htonl='define' d_index='undef' d_inetaton='undef' -d_ino64t='undef' d_int64t='undef' -d_iovec_s='undef' d_isascii='define' d_killpg='undef' d_ldbl_dig='define' d_lchown='undef' -d_link='undef' +d_link='define' d_locconv='define' d_lockf='undef' -d_lockf64='undef' d_longdbl='define' d_longlong='undef' -d_lseek64='undef' d_lstat='undef' -d_lstat64='undef' -d_madvise='undef' d_mblen='define' d_mbstowcs='define' d_mbtowc='define' +d_memchr='define' d_memcmp='define' d_memcpy='define' d_memmove='define' @@ -205,8 +206,6 @@ d_memset='define' d_mkdir='define' d_mkfifo='undef' d_mktime='define' -d_mmap='undef' -d_mprotect='undef' d_msg='undef' d_msg_ctrunc='undef' d_msg_dontroute='undef' @@ -215,21 +214,15 @@ d_msg_peek='undef' d_msg_proxy='undef' d_msgctl='undef' d_msgget='undef' -d_msghdr_s='undef' d_msgrcv='undef' d_msgsnd='undef' -d_msync='undef' -d_munmap='undef' d_mymalloc='undef' -d_nextkey64='undef' d_nice='undef' -d_off64t='undef' +d_off64_t='undef' d_old_pthread_create_joinable='undef' d_oldpthreads='undef' d_oldsock='undef' d_open3='undef' -d_open64='undef' -d_opendir64='undef' d_pathconf='undef' d_pause='define' d_phostname='undef' @@ -243,13 +236,11 @@ d_pwclass='undef' d_pwcomment='undef' d_pwexpire='undef' d_pwgecos='undef' -d_pwquota='undef' d_pwpasswd='undef' +d_pwquota='undef' +d_quad='undef' d_readdir='define' -d_readdir64='undef' d_readlink='undef' -d_readv='undef' -d_recvmesg='undef' d_rename='define' d_rewinddir='define' d_rmdir='define' @@ -259,7 +250,6 @@ d_sanemcmp='define' d_sched_yield='undef' d_scm_rights='undef' d_seekdir='define' -d_seekdir64='undef' d_select='define' d_sem='undef' d_semctl='undef' @@ -267,7 +257,6 @@ d_semctl_semid_ds='undef' d_semctl_semun='undef' d_semget='undef' d_semop='undef' -d_sendmsg='undef' d_setegid='undef' d_seteuid='undef' d_setgrent='undef' @@ -290,6 +279,7 @@ d_setrgid='undef' d_setruid='undef' d_setsent='undef' d_setsid='undef' +d_setspent='undef' d_setvbuf='define' d_sfio='undef' d_shm='undef' @@ -302,16 +292,16 @@ d_sigaction='undef' d_sigsetjmp='undef' d_socket='define' d_sockpair='undef' -d_stat64='undef' +d_sqrtl='undef' d_statblks='undef' -d_statfs='undef' -d_statfsflags='undef' +d_statfs_f_flags='undef' +d_statfs_s='undef' d_statvfs='undef' d_stdio_cnt_lval='define' d_stdio_ptr_lval='define' +d_stdio_stream_array='undef' d_stdiobase='define' d_stdstdio='define' -d_store64='undef' d_strchr='define' d_strcoll='define' d_strctcpy='define' @@ -319,7 +309,11 @@ d_strerrm='strerror(e)' d_strerror='define' d_strtod='define' d_strtol='define' +d_strtold='undef' +d_strtoll='undef' d_strtoul='define' +d_strtoull='undef' +d_strtouq='undef' d_strxfrm='define' d_suidsafe='undef' d_symlink='undef' @@ -331,17 +325,17 @@ d_system='define' d_tcgetpgrp='undef' d_tcsetpgrp='undef' d_telldir='define' -d_telldir64='undef' d_telldirproto='define' d_time='define' d_times='define' -d_tmpfile64='undef' d_truncate='undef' -d_truncate64='undef' d_tzname='define' d_umask='define' d_uname='define' d_union_semun='define' +d_ustat='undef' +d_vendorbin='undef' +d_vendorlib='undef' d_vfork='undef' d_void_closedir='undef' d_voidsig='define' @@ -352,7 +346,6 @@ d_wait4='undef' d_waitpid='define' d_wcstombs='define' d_wctomb='define' -d_writev='undef' d_xenix='undef' date='date' db_hashtype='int' @@ -378,11 +371,16 @@ fflushall='undef' find='find' firstmakefile='makefile' flex='' +fpossize='4' fpostype='fpos_t' freetype='void' +full_ar='' full_csh='' full_sed='' gccversion='' +gidformat='"ld"' +gidsign='-1' +gidsize='4' gidtype='gid_t' glibpth='/usr/shlib /lib/pa1.1 /usr/lib/large /lib /usr/lib /usr/lib/386 /lib/386 /lib/large /usr/lib/small /lib/small /usr/ccs/lib /usr/ucblib /usr/shlib ' grep='grep' @@ -394,6 +392,14 @@ h_sysfile='true' hint='recommended' hostcat='ypcat hosts' huge='' +i16size='2' +i16type='short' +i32size='4' +i32type='long' +i64size='8' +i64type='__int64' +i8size='1' +i8type='char' i_arpainet='define' i_bsdioctl='' i_db='undef' @@ -416,12 +422,16 @@ i_mntent='undef' i_ndbm='undef' i_netdb='undef' i_neterrno='undef' +i_netinettcp='undef' i_niin='undef' i_poll='undef' +i_pthread='undef' i_pwd='undef' i_rpcsvcdbm='define' i_sfio='undef' i_sgtty='undef' +i_shadow='undef' +i_socks='undef' i_stdarg='define' i_stddef='define' i_stdlib='define' @@ -432,7 +442,6 @@ i_sysfile='undef' i_sysfilio='define' i_sysin='undef' i_sysioctl='undef' -i_sysmman='undef' i_sysmount='undef' i_sysndir='undef' i_sysparam='undef' @@ -440,6 +449,7 @@ i_sysresrc='undef' i_syssecrt='undef' i_sysselct='undef' i_syssockio='' +i_sysstatfs='undef' i_sysstatvfs='undef' i_sysstat='define' i_systime='undef' @@ -448,37 +458,49 @@ i_systimes='undef' i_systypes='define' i_sysuio='undef' i_sysun='undef' +i_sysvfs='undef' i_syswait='undef' i_termio='undef' i_termios='undef' i_time='define' i_unistd='undef' +i_ustat='undef' i_utime='define' i_values='undef' i_varargs='undef' i_varhdr='varargs.h' i_vfork='undef' ignore_versioned_solibs='' +inc_version_list='' incpath='' inews='' installarchlib='~INST_TOP~~INST_VER~\lib~INST_ARCH~' installbin='~INST_TOP~~INST_VER~\bin~INST_ARCH~' installman1dir='~INST_TOP~~INST_VER~\man\man1' installman3dir='~INST_TOP~~INST_VER~\man\man3' +installprefix='~INST_TOP~~INST_VER~' +installprefixexp='~INST_TOP~~INST_VER~' installhtmldir='~INST_TOP~~INST_VER~\html' installhtmlhelpdir='~INST_TOP~~INST_VER~\htmlhelp' installprivlib='~INST_TOP~~INST_VER~\lib' installscript='~INST_TOP~~INST_VER~\bin' installsitearch='~INST_TOP~\site~INST_VER~\lib~INST_ARCH~' installsitelib='~INST_TOP~\site~INST_VER~\lib' +installstyle='lib' installusrbinperl='undef' +installvendorbin='' +installvendorlib='' intsize='4' -known_extensions='DB_File Fcntl GDBM_File NDBM_File ODBM_File Opcode POSIX SDBM_File Socket IO attrs Thread' +ivdformat='"ld"' +ivsize='4' +ivtype='long' +known_extensions='~static_ext~ ~dynamic_ext~ ~nonxs_ext~' ksh='' large='' ld='link' lddlflags='-dll ~LINK_FLAGS~' ldflags='~LINK_FLAGS~' +ldlibpthname='' less='less' lib_ext='.lib' libc='msvcrt.lib' @@ -515,10 +537,8 @@ man3dir='~INST_TOP~~INST_VER~\man\man3' man3direxp='~INST_TOP~~INST_VER~\man\man3' man3ext='3' medium='' -mips='' mips_type='' mkdir='mkdir' -mmaptype='void *' models='none' modetype='mode_t' more='more /e' @@ -538,6 +558,8 @@ nm_opt='' nm_so_opt='' nonxs_ext='Errno' nroff='' +nvsize='8' +nvtype='double' o_nonblock='O_NONBLOCK' obj_ext='.obj' old_pthread_create_joinable='' @@ -565,6 +587,8 @@ privlib='~INST_TOP~~INST_VER~\lib' privlibexp='~INST_TOP~~INST_VER~\lib' prototype='define' ptrsize='4' +quadcase='5' +quadtype='__int64' randbits='15' randfunc='rand' randseedtype='unsigned' @@ -573,6 +597,18 @@ rd_nodata='-1' rm='del' rmail='' runnm='true' +sPRIEldbl='"E"' +sPRIFldbl='"F"' +sPRIGldbl='"G"' +sPRIX64='"lX"' +sPRId64='"ld"' +sPRIeldbl='"e"' +sPRIfldbl='"f"' +sPRIgldbl='"g"' +sPRIi64='"li"' +sPRIo64='"lo"' +sPRIu64='"lu"' +sPRIx64='"lx"' sched_yield='' scriptdir='~INST_TOP~~INST_VER~\bin' scriptdirexp='~INST_TOP~~INST_VER~\bin' @@ -588,6 +624,7 @@ shmattype='void *' shortsize='2' shrpenv='' shsharp='true' +sig_count='26' sig_name='ZERO NUM01 INT QUIT ILL NUM05 NUM06 NUM07 FPE KILL NUM10 SEGV NUM12 PIPE ALRM TERM NUM16 NUM17 NUM18 NUM19 CHLD BREAK ABRT STOP NUM24 CONT CLD' sig_name_init='"ZERO", "NUM01", "INT", "QUIT", "ILL", "NUM05", "NUM06", "NUM07", "FPE", "KILL", "NUM10", "SEGV", "NUM12", "PIPE", "ALRM", "TERM", "NUM16", "NUM17", "NUM18", "NUM19", "CHLD", "BREAK", "ABRT", "STOP", "NUM24", "CONT", "CLD", 0' sig_num='0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 20 0' @@ -595,8 +632,12 @@ sig_num_init='0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, signal_t='void' sitearch='~INST_TOP~\site~INST_VER~\lib~INST_ARCH~' sitearchexp='~INST_TOP~\site~INST_VER~\lib~INST_ARCH~' +sitebin='~INST_TOP~\site~INST_VER~\bin~INST_ARCH~' +sitebinexp='~INST_TOP~\site~INST_VER~\bin~INST_ARCH~' sitelib='~INST_TOP~\site~INST_VER~\lib' sitelibexp='~INST_TOP~\site~INST_VER~\lib' +siteprefix='~INST_TOP~\site~INST_VER~' +siteprefixexp='~INST_TOP~\site~INST_VER~' sizetype='size_t' sleep='' smail='' @@ -619,6 +660,7 @@ stdio_bufsiz='((fp)->_cnt + (fp)->_ptr - (fp)->_base)' stdio_cnt='((fp)->_cnt)' stdio_filbuf='' stdio_ptr='((fp)->_ptr)' +stdio_stream_array='' strings='/usr/include/string.h' submit='' subversion='~SUBVERSION~' @@ -634,11 +676,29 @@ touch='touch' tr='' trnl='\012' troff='' +u16size='2' +u16type='unsigned short' +u32size='4' +u32type='unsigned long' +u64size='8' +u64type='unsigned __int64' +u8size='1' +u8type='unsigned char' +uidformat='"ld"' +uidsign='-1' +uidsize='4' uidtype='uid_t' uname='uname' uniq='uniq' +uquadtype='unsigned __int64' +use5005threads='undef' use64bits='undef' usedl='define' +useithreads='undef' +uselargefiles='undef' +uselongdouble='undef' +uselonglong='undef' +usemorebits='undef' usemultiplicity='undef' usemymalloc='n' usenm='false' @@ -647,13 +707,34 @@ useperlio='undef' useposix='true' usesfio='false' useshrplib='yes' +usesocks='undef' usethreads='undef' +usevendorprefix='undef' usevfork='false' usrinc='/usr/include' uuname='' +uvoformat='"lo"' +uvsize='4' +uvtype='unsigned long' +uvuformat='"lu"' +uvxformat='"lx"' +vendorbin='' +vendorbinexp='' +vendorlib='' +vendorlibexp='' +vendorprefix='' +vendorprefixexp='' version='~VERSION~' vi='' voidflags='15' xlibpth='/usr/lib/386 /lib/386' zcat='' zip='zip' +PERL_REVISION='~PERL_REVISION~' +PERL_VERSION='~PERL_VERSION~' +PERL_SUBVERSION='~PERL_SUBVERSION~' +PERL_API_REVISION='~PERL_API_REVISION~' +PERL_API_SUBVERSION='~PERL_API_SUBVERSION~' +PERL_API_VERSION='~PERL_API_VERSION~' +PATCHLEVEL='~PERL_VERSION~' +SUBVERSION='~PERL_SUBVERSION~' diff --git a/win32/config_H.bc b/win32/config_H.bc index 80636a4..399111f 100644 --- a/win32/config_H.bc +++ b/win32/config_H.bc @@ -13,7 +13,7 @@ /* * Package name : perl5 * Source directory : - * Configuration time: undef + * Configuration time: Tue Jan 18 21:01:00 2000 * Configured by : gsar * Target system : */ @@ -273,7 +273,7 @@ * This symbol, if defined, indicates that the link routine is * available to create hard links. */ -/*#define HAS_LINK /**/ +#define HAS_LINK /**/ /* HAS_LOCALECONV: * This symbol, if defined, indicates that the localeconv routine is @@ -358,18 +358,6 @@ */ #define HAS_MKTIME /**/ -/* HAS_MSYNC: - * This symbol, if defined, indicates that the msync system call is - * available to synchronize a mapped file. - */ -/*#define HAS_MSYNC /**/ - -/* HAS_MUNMAP: - * This symbol, if defined, indicates that the munmap system call is - * available to unmap a region, usually mapped by mmap(). - */ -/*#define HAS_MUNMAP /**/ - /* HAS_NICE: * This symbol, if defined, indicates that the nice routine is * available. @@ -992,30 +980,6 @@ */ #define STDCHAR unsigned char /**/ -/* HAS_ACCESSX: - * This symbol, if defined, indicates that the accessx routine is - * available to do extended access checks. - */ -/*#define HAS_ACCESSX /**/ - -/* HAS_EACCESS: - * This symbol, if defined, indicates that the eaccess routine is - * available to do extended access checks. - */ -/*#define HAS_EACCESS /**/ - -/* I_SYS_ACCESS: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -/*#define I_SYS_ACCESS /**/ - -/* I_SYS_SECURITY: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -/*#define I_SYS_SECURITY /**/ - /* CROSSCOMPILE: * This symbol, if defined, signifies that we our * build process is a cross-compilation. @@ -1047,6 +1011,53 @@ */ /*#define MULTIARCH /**/ +/* HAS_QUAD: + * This symbol, if defined, tells that there's a 64-bit integer type, + * Quad_t, and its unsigned counterpar, Uquad_t. QUADKIND will be one + * of QUAD_IS_INT, QUAD_IS_LONG, QUAD_IS_LONG_LONG, or QUAD_IS_INT64_T. + */ +/*#define HAS_QUAD /**/ +#ifdef HAS_QUAD +# define Quad_t __int64 /**/ +# define Uquad_t unsigned __int64 /**/ +# define QUADKIND undef /**/ +# define QUAD_IS_INT 1 +# define QUAD_IS_LONG 2 +# define QUAD_IS_LONG_LONG 3 +# define QUAD_IS_INT64_T 4 +#endif + +/* HAS_ACCESSX: + * This symbol, if defined, indicates that the accessx routine is + * available to do extended access checks. + */ +/*#define HAS_ACCESSX /**/ + +/* HAS_EACCESS: + * This symbol, if defined, indicates that the eaccess routine is + * available to do extended access checks. + */ +/*#define HAS_EACCESS /**/ + +/* I_SYS_ACCESS: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +/*#define I_SYS_ACCESS /**/ + +/* I_SYS_SECURITY: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +/*#define I_SYS_SECURITY /**/ + +/* OSNAME: + * This symbol contains the name of the operating system, as determined + * by Configure. You shouldn't rely on it too much; the specific + * feature tests from Configure are generally more reliable. + */ +#define OSNAME "MSWin32" /**/ + /* MEM_ALIGNBYTES: * This symbol contains the number of bytes required to align a * double. Usual values are 2, 4 and 8. The default is eight, @@ -1058,6 +1069,61 @@ #define MEM_ALIGNBYTES 8 #endif +/* ARCHLIB: + * This variable, if defined, holds the name of the directory in + * which the user wants to put architecture-dependent public + * library files for perl5. It is most often a local directory + * such as /usr/local/lib. Programs using this variable must be + * prepared to deal with filename expansion. If ARCHLIB is the + * same as PRIVLIB, it is not defined, since presumably the + * program already searches PRIVLIB. + */ +/* ARCHLIB_EXP: + * This symbol contains the ~name expanded version of ARCHLIB, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. + */ +#define ARCHLIB "c:\\perl\\5.5.640\\lib\\MSWin32-x86" /**/ +/*#define ARCHLIB_EXP "" /**/ + +/* ARCHNAME: + * This symbol holds a string representing the architecture name. + * It may be used to construct an architecture-dependant pathname + * where library files may be held under a private library, for + * instance. + */ +#define ARCHNAME "MSWin32-x86" /**/ + +/* HAS_ATOLF: + * This symbol, if defined, indicates that the atolf routine is + * available to convert strings into long doubles. + */ +/*#define HAS_ATOLF /**/ + +/* HAS_ATOLL: + * This symbol, if defined, indicates that the atoll routine is + * available to convert strings into long longs. + */ +/*#define HAS_ATOLL /**/ + +/* BIN: + * This symbol holds the path of the bin directory where the package will + * be installed. Program must be prepared to deal with ~name substitution. + */ +/* BIN_EXP: + * This symbol is the filename expanded version of the BIN symbol, for + * programs that do not want to deal with that at run-time. + */ +#define BIN "c:\\perl\\5.5.640\\bin\\MSWin32-x86" /**/ +#define BIN_EXP "c:\\perl\\5.5.640\\bin\\MSWin32-x86" /**/ + +/* PERL_BINCOMPAT_5005: + * This symbol, if defined, indicates that Perl 5.006 should be + * binary-compatible with Perl 5.005. This is impossible for builds + * that use features like threads and multiplicity it is always undef + * for those versions. + */ +/*#define PERL_BINCOMPAT_5005 /**/ + /* BYTEORDER: * This symbol holds the hexadecimal constant defined in byteorder, * i.e. 0x1234 or 0x4321, etc... @@ -1101,6 +1167,58 @@ #define BYTEORDER 0x1234 /* large digits for MSB */ #endif /* NeXT */ +/* CAT2: + * This macro catenates 2 tokens together. + */ +/* STRINGIFY: + * This macro surrounds its token with double quotes. + */ +#if 42 == 1 +#define CAT2(a,b)a/**/b +#define STRINGIFY(a)"a" + /* If you can get stringification with catify, tell me how! */ +#endif +#if 42 == 42 +#define CAT2(a,b)a ## b +#define StGiFy(a)# a +#define STRINGIFY(a)StGiFy(a) +#endif +#if 42 != 1 && 42 != 42 +#include "Bletch: How does this C preprocessor catenate tokens?" +#endif + +/* CPPSTDIN: + * This symbol contains the first part of the string which will invoke + * the C preprocessor on the standard input and produce to standard + * output. Typical value of "cc -E" or "/lib/cpp", but it can also + * call a wrapper. See CPPRUN. + */ +/* CPPMINUS: + * This symbol contains the second part of the string which will invoke + * the C preprocessor on the standard input and produce to standard + * output. This symbol will have the value "-" if CPPSTDIN needs a minus + * to specify standard input, otherwise the value is "". + */ +/* CPPRUN: + * This symbol contains the string which will invoke a C preprocessor on + * the standard input and produce to standard output. It needs to end + * with CPPLAST, after all other preprocessor flags have been specified. + * The main difference with CPPSTDIN is that this program will never be a + * pointer to a shell wrapper, i.e. it will be empty if no preprocessor is + * available directly to the user. Note that it may well be different from + * the preprocessor used to compile the C program. + */ +#define CPPSTDIN "cpp32 -oCON" +#define CPPMINUS "" +#define CPPRUN "cpp32 -oCON" + +/* HAS_ACCESS: + * This manifest constant lets the C program know that the access() + * system call is available to check for accessibility using real UID/GID. + * (always present on UNIX.) + */ +#define HAS_ACCESS /**/ + /* CASTI32: * This symbol is defined if the C compiler can cast negative * or large floating point numbers to 32-bit ints. @@ -1128,12 +1246,104 @@ */ /*#define VOID_CLOSEDIR /**/ +/* HAS_CSH: + * This symbol, if defined, indicates that the C-shell exists. + */ +/* CSH: + * This symbol, if defined, contains the full pathname of csh. + */ +/*#define HAS_CSH /**/ +#ifdef HAS_CSH +#define CSH "" /**/ +#endif + +/* DLSYM_NEEDS_UNDERSCORE: + * This symbol, if defined, indicates that we need to prepend an + * underscore to the symbol name before calling dlsym(). This only + * makes sense if you *have* dlsym, which we will presume is the + * case if you're using dl_dlopen.xs. + */ +/*#define DLSYM_NEEDS_UNDERSCORE /**/ + +/* HAS_DRAND48_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the drand48() function. Otherwise, it is up + * to the program to supply one. A good guess is + * extern double drand48 _((void)); + */ +/*#define HAS_DRAND48_PROTO /**/ + +/* HAS_ENDGRENT: + * This symbol, if defined, indicates that the getgrent routine is + * available for finalizing sequential access of the group database. + */ +/*#define HAS_ENDGRENT /**/ + +/* HAS_ENDHOSTENT: + * This symbol, if defined, indicates that the endhostent() routine is + * available to close whatever was being used for host queries. + */ +/*#define HAS_ENDHOSTENT /**/ + +/* HAS_ENDNETENT: + * This symbol, if defined, indicates that the endnetent() routine is + * available to close whatever was being used for network queries. + */ +/*#define HAS_ENDNETENT /**/ + +/* HAS_ENDPROTOENT: + * This symbol, if defined, indicates that the endprotoent() routine is + * available to close whatever was being used for protocol queries. + */ +/*#define HAS_ENDPROTOENT /**/ + +/* HAS_ENDPWENT: + * This symbol, if defined, indicates that the getgrent routine is + * available for finalizing sequential access of the passwd database. + */ +/*#define HAS_ENDPWENT /**/ + +/* HAS_ENDSERVENT: + * This symbol, if defined, indicates that the endservent() routine is + * available to close whatever was being used for service queries. + */ +/*#define HAS_ENDSERVENT /**/ + +/* HAS_ENDSPENT: + * This symbol, if defined, indicates that the endspent system call is + * available to finalize the scan of SysV shadow password entries. + */ +/*#define HAS_ENDSPENT /**/ + /* HAS_FD_SET: * This symbol, when defined, indicates presence of the fd_set typedef * in */ #define HAS_FD_SET /**/ +/* HAS_STRUCT_FS_DATA: + * This symbol, if defined, indicates that the struct fs_data + * to do statfs() is supported. + */ +/*#define HAS_STRUCT_FS_DATA /**/ + +/* HAS_FSEEKO: + * This symbol, if defined, indicates that the fseeko routine is + * available to fseek beyond 32 bits (useful for ILP32 hosts). + */ +/*#define HAS_FSEEKO /**/ + +/* HAS_FSTATFS: + * This symbol, if defined, indicates that the fstatfs routine is + * available to stat filesystems by file descriptors. + */ +/*#define HAS_FSTATFS /**/ +/* HAS_FTELLO: + * This symbol, if defined, indicates that the ftello routine is + * available to ftell beyond 32 bits (useful for ILP32 hosts). + */ +/*#define HAS_FTELLO /**/ + /* Gconvert: * This preprocessor macro is defined to convert a floating point * number to a string without a trailing decimal point. This @@ -1151,451 +1361,6 @@ */ #define Gconvert(x,n,t,b) gcvt((x),(n),(b)) -/* HAS_GNULIBC: - * This symbol, if defined, indicates to the C program that - * the GNU C library is being used. - */ -/*#define HAS_GNULIBC /**/ -/* HAS_ISASCII: - * This manifest constant lets the C program know that isascii - * is available. - */ -#define HAS_ISASCII /**/ - -/* HAS_LCHOWN: - * This symbol, if defined, indicates that the lchown routine is - * available to operate on a symbolic link (instead of following the - * link). - */ -/*#define HAS_LCHOWN /**/ - -/* HAS_OPEN3: - * This manifest constant lets the C program know that the three - * argument form of open(2) is available. - */ -/*#define HAS_OPEN3 /**/ - -/* HAS_SAFE_BCOPY: - * This symbol, if defined, indicates that the bcopy routine is available - * to copy potentially overlapping memory blocks. Otherwise you should - * probably use memmove() or memcpy(). If neither is defined, roll your - * own version. - */ -/*#define HAS_SAFE_BCOPY /**/ - -/* HAS_SAFE_MEMCPY: - * This symbol, if defined, indicates that the memcpy routine is available - * to copy potentially overlapping memory blocks. Otherwise you should - * probably use memmove() or memcpy(). If neither is defined, roll your - * own version. - */ -/*#define HAS_SAFE_MEMCPY /**/ - -/* HAS_SANE_MEMCMP: - * This symbol, if defined, indicates that the memcmp routine is available - * and can be used to compare relative magnitudes of chars with their high - * bits set. If it is not defined, roll your own version. - */ -#define HAS_SANE_MEMCMP /**/ - -/* HAS_SIGACTION: - * This symbol, if defined, indicates that Vr4's sigaction() routine - * is available. - */ -/*#define HAS_SIGACTION /**/ - -/* HAS_SIGSETJMP: - * This variable indicates to the C program that the sigsetjmp() - * routine is available to save the calling process's registers - * and stack environment for later use by siglongjmp(), and - * to optionally save the process's signal mask. See - * Sigjmp_buf, Sigsetjmp, and Siglongjmp. - */ -/* Sigjmp_buf: - * This is the buffer type to be used with Sigsetjmp and Siglongjmp. - */ -/* Sigsetjmp: - * This macro is used in the same way as sigsetjmp(), but will invoke - * traditional setjmp() if sigsetjmp isn't available. - * See HAS_SIGSETJMP. - */ -/* Siglongjmp: - * This macro is used in the same way as siglongjmp(), but will invoke - * traditional longjmp() if siglongjmp isn't available. - * See HAS_SIGSETJMP. - */ -/*#define HAS_SIGSETJMP /**/ -#ifdef HAS_SIGSETJMP -#define Sigjmp_buf sigjmp_buf -#define Sigsetjmp(buf,save_mask) sigsetjmp((buf),(save_mask)) -#define Siglongjmp(buf,retval) siglongjmp((buf),(retval)) -#else -#define Sigjmp_buf jmp_buf -#define Sigsetjmp(buf,save_mask) setjmp((buf)) -#define Siglongjmp(buf,retval) longjmp((buf),(retval)) -#endif - -/* USE_STDIO_PTR: - * This symbol is defined if the _ptr and _cnt fields (or similar) - * of the stdio FILE structure can be used to access the stdio buffer - * for a file handle. If this is defined, then the FILE_ptr(fp) - * and FILE_cnt(fp) macros will also be defined and should be used - * to access these fields. - */ -/* FILE_ptr: - * This macro is used to access the _ptr field (or equivalent) of the - * FILE structure pointed to by its argument. This macro will always be - * defined if USE_STDIO_PTR is defined. - */ -/* STDIO_PTR_LVALUE: - * This symbol is defined if the FILE_ptr macro can be used as an - * lvalue. - */ -/* FILE_cnt: - * This macro is used to access the _cnt field (or equivalent) of the - * FILE structure pointed to by its argument. This macro will always be - * defined if USE_STDIO_PTR is defined. - */ -/* STDIO_CNT_LVALUE: - * This symbol is defined if the FILE_cnt macro can be used as an - * lvalue. - */ -#define USE_STDIO_PTR /**/ -#ifdef USE_STDIO_PTR -#define FILE_ptr(fp) ((fp)->curp) -#define STDIO_PTR_LVALUE /**/ -#define FILE_cnt(fp) ((fp)->level) -#define STDIO_CNT_LVALUE /**/ -#endif - -/* USE_STDIO_BASE: - * This symbol is defined if the _base field (or similar) of the - * stdio FILE structure can be used to access the stdio buffer for - * a file handle. If this is defined, then the FILE_base(fp) macro - * will also be defined and should be used to access this field. - * Also, the FILE_bufsiz(fp) macro will be defined and should be used - * to determine the number of bytes in the buffer. USE_STDIO_BASE - * will never be defined unless USE_STDIO_PTR is. - */ -/* FILE_base: - * This macro is used to access the _base field (or equivalent) of the - * FILE structure pointed to by its argument. This macro will always be - * defined if USE_STDIO_BASE is defined. - */ -/* FILE_bufsiz: - * This macro is used to determine the number of bytes in the I/O - * buffer pointed to by _base field (or equivalent) of the FILE - * structure pointed to its argument. This macro will always be defined - * if USE_STDIO_BASE is defined. - */ -#define USE_STDIO_BASE /**/ -#ifdef USE_STDIO_BASE -#define FILE_base(fp) ((fp)->buffer) -#define FILE_bufsiz(fp) ((fp)->level + (fp)->curp - (fp)->buffer) -#endif - -/* HAS_VPRINTF: - * This symbol, if defined, indicates that the vprintf routine is available - * to printf with a pointer to an argument list. If unavailable, you - * may need to write your own, probably in terms of _doprnt(). - */ -/* USE_CHAR_VSPRINTF: - * This symbol is defined if this system has vsprintf() returning type - * (char*). The trend seems to be to declare it as "int vsprintf()". It - * is up to the package author to declare vsprintf correctly based on the - * symbol. - */ -#define HAS_VPRINTF /**/ -/*#define USE_CHAR_VSPRINTF /**/ - -/* DOUBLESIZE: - * This symbol contains the size of a double, so that the C preprocessor - * can make decisions based on it. - */ -#define DOUBLESIZE 8 /**/ - -/* I_TIME: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -/* I_SYS_TIME: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -/* I_SYS_TIME_KERNEL: - * This symbol, if defined, indicates to the C program that it should - * include with KERNEL defined. - */ -#define I_TIME /**/ -/*#define I_SYS_TIME /**/ -/*#define I_SYS_TIME_KERNEL /**/ - -/* VAL_O_NONBLOCK: - * This symbol is to be used during open() or fcntl(F_SETFL) to turn on - * non-blocking I/O for the file descriptor. Note that there is no way - * back, i.e. you cannot turn it blocking again this way. If you wish to - * alternatively switch between blocking and non-blocking, use the - * ioctl(FIOSNBIO) call instead, but that is not supported by all devices. - */ -/* VAL_EAGAIN: - * This symbol holds the errno error code set by read() when no data was - * present on the non-blocking file descriptor. - */ -/* RD_NODATA: - * This symbol holds the return code from read() when no data is present - * on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is - * not defined, then you can't distinguish between no data and EOF by - * issuing a read(). You'll have to find another way to tell for sure! - */ -/* EOF_NONBLOCK: - * This symbol, if defined, indicates to the C program that a read() on - * a non-blocking file descriptor will return 0 on EOF, and not the value - * held in RD_NODATA (-1 usually, in that case!). - */ -#define VAL_O_NONBLOCK O_NONBLOCK -#define VAL_EAGAIN EAGAIN -#define RD_NODATA -1 -#define EOF_NONBLOCK - -/* PTRSIZE: - * This symbol contains the size of a pointer, so that the C preprocessor - * can make decisions based on it. It will be sizeof(void *) if - * the compiler supports (void *); otherwise it will be - * sizeof(char *). - */ -#define PTRSIZE 4 /**/ - -/* Drand01: - * This macro is to be used to generate uniformly distributed - * random numbers over the range [0., 1.[. You may have to supply - * an 'extern double drand48();' in your program since SunOS 4.1.3 - * doesn't provide you with anything relevant in it's headers. - * See HAS_DRAND48_PROTO. - */ -/* Rand_seed_t: - * This symbol defines the type of the argument of the - * random seed function. - */ -/* seedDrand01: - * This symbol defines the macro to be used in seeding the - * random number generator (see Drand01). - */ -/* RANDBITS: - * This symbol indicates how many bits are produced by the - * function used to generate normalized random numbers. - * Values include 15, 16, 31, and 48. - */ -#define Drand01() (rand()/(double)((unsigned)1< or - * to get any typedef'ed information. - * We will pick a type such that sizeof(SSize_t) == sizeof(Size_t). - */ -#define SSize_t int /* signed count of bytes */ - -/* EBCDIC: - * This symbol, if defined, indicates that this system uses - * EBCDIC encoding. - */ -/*#define EBCDIC /**/ - -/* ARCHLIB: - * This variable, if defined, holds the name of the directory in - * which the user wants to put architecture-dependent public - * library files for perl5. It is most often a local directory - * such as /usr/local/lib. Programs using this variable must be - * prepared to deal with filename expansion. If ARCHLIB is the - * same as PRIVLIB, it is not defined, since presumably the - * program already searches PRIVLIB. - */ -/* ARCHLIB_EXP: - * This symbol contains the ~name expanded version of ARCHLIB, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -#define ARCHLIB "c:\\perl\\5.00561\\lib\\MSWin32-x86" /**/ -/*#define ARCHLIB_EXP "" /**/ - -/* BIN: - * This symbol holds the path of the bin directory where the package will - * be installed. Program must be prepared to deal with ~name substitution. - */ -/* BIN_EXP: - * This symbol is the filename expanded version of the BIN symbol, for - * programs that do not want to deal with that at run-time. - */ -#define BIN "c:\\perl\\5.00561\\bin\\MSWin32-x86" /**/ -#define BIN_EXP "c:\\perl\\5.00561\\bin\\MSWin32-x86" /**/ - -/* INSTALL_USR_BIN_PERL: - * This symbol, if defined, indicates that Perl is to be installed - * also as /usr/bin/perl. - */ -/*#define INSTALL_USR_BIN_PERL /**/ - -/* PRIVLIB: - * This symbol contains the name of the private library for this package. - * The library is private in the sense that it needn't be in anyone's - * execution path, but it should be accessible by the world. The program - * should be prepared to do ~ expansion. - */ -/* PRIVLIB_EXP: - * This symbol contains the ~name expanded version of PRIVLIB, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -#define PRIVLIB "c:\\perl\\5.00561\\lib" /**/ -#define PRIVLIB_EXP (win32_get_privlib("5.00561")) /**/ - -/* SITEARCH: - * This symbol contains the name of the private library for this package. - * The library is private in the sense that it needn't be in anyone's - * execution path, but it should be accessible by the world. The program - * should be prepared to do ~ expansion. - * The standard distribution will put nothing in this directory. - * Individual sites may place their own extensions and modules in - * this directory. - */ -/* SITEARCH_EXP: - * This symbol contains the ~name expanded version of SITEARCH, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -#define SITEARCH "c:\\perl\\site\\5.00561\\lib\\MSWin32-x86" /**/ -/*#define SITEARCH_EXP "" /**/ - -/* SITELIB: - * This symbol contains the name of the private library for this package. - * The library is private in the sense that it needn't be in anyone's - * execution path, but it should be accessible by the world. The program - * should be prepared to do ~ expansion. - * The standard distribution will put nothing in this directory. - * Individual sites may place their own extensions and modules in - * this directory. - */ -/* SITELIB_EXP: - * This symbol contains the ~name expanded version of SITELIB, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -#define SITELIB "c:\\perl\\site\\5.00561\\lib" /**/ -#define SITELIB_EXP (win32_get_sitelib("5.00561")) /**/ - -/* PERL_VENDORLIB_EXP: - * This symbol contains the ~name expanded version of VENDORLIB, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -/*#define PERL_VENDORLIB_EXP "undef" /**/ - -/* OSNAME: - * This symbol contains the name of the operating system, as determined - * by Configure. You shouldn't rely on it too much; the specific - * feature tests from Configure are generally more reliable. - */ -#define OSNAME "MSWin32" /**/ - -/* CAT2: - * This macro catenates 2 tokens together. - */ -/* STRINGIFY: - * This macro surrounds its token with double quotes. - */ -#if 42 == 1 -#define CAT2(a,b)a/**/b -#define STRINGIFY(a)"a" - /* If you can get stringification with catify, tell me how! */ -#endif -#if 42 == 42 -#define CAT2(a,b)a ## b -#define StGiFy(a)# a -#define STRINGIFY(a)StGiFy(a) -#endif -#if 42 != 1 && 42 != 42 -#include "Bletch: How does this C preprocessor catenate tokens?" -#endif - -/* CPPSTDIN: - * This symbol contains the first part of the string which will invoke - * the C preprocessor on the standard input and produce to standard - * output. Typical value of "cc -E" or "/lib/cpp", but it can also - * call a wrapper. See CPPRUN. - */ -/* CPPMINUS: - * This symbol contains the second part of the string which will invoke - * the C preprocessor on the standard input and produce to standard - * output. This symbol will have the value "-" if CPPSTDIN needs a minus - * to specify standard input, otherwise the value is "". - */ -/* CPPRUN: - * This symbol contains the string which will invoke a C preprocessor on - * the standard input and produce to standard output. It needs to end - * with CPPLAST, after all other preprocessor flags have been specified. - * The main difference with CPPSTDIN is that this program will never be a - * pointer to a shell wrapper, i.e. it will be empty if no preprocessor is - * available directly to the user. Note that it may well be different from - * the preprocessor used to compile the C program. - */ -#define CPPSTDIN "cpp32 -oCON" -#define CPPMINUS "" -#define CPPRUN "cpp32 -oCON" - -/* HAS_ACCESS: - * This manifest constant lets the C program know that the access() - * system call is available to check for accessibility using real UID/GID. - * (always present on UNIX.) - */ -#define HAS_ACCESS /**/ - -/* HAS_CSH: - * This symbol, if defined, indicates that the C-shell exists. - */ -/* CSH: - * This symbol, if defined, contains the full pathname of csh. - */ -/*#define HAS_CSH /**/ -#ifdef HAS_CSH -#define CSH "" /**/ -#endif - -/* HAS_ENDGRENT: - * This symbol, if defined, indicates that the getgrent routine is - * available for finalizing sequential access of the group database. - */ -/*#define HAS_ENDGRENT /**/ - -/* HAS_ENDHOSTENT: - * This symbol, if defined, indicates that the endhostent() routine is - * available to close whatever was being used for host queries. - */ -/*#define HAS_ENDHOSTENT /**/ - -/* HAS_ENDNETENT: - * This symbol, if defined, indicates that the endnetent() routine is - * available to close whatever was being used for network queries. - */ -/*#define HAS_ENDNETENT /**/ - -/* HAS_ENDPROTOENT: - * This symbol, if defined, indicates that the endprotoent() routine is - * available to close whatever was being used for protocol queries. - */ -/*#define HAS_ENDPROTOENT /**/ - -/* HAS_ENDPWENT: - * This symbol, if defined, indicates that the getgrent routine is - * available for finalizing sequential access of the passwd database. - */ -/*#define HAS_ENDPWENT /**/ - -/* HAS_ENDSERVENT: - * This symbol, if defined, indicates that the endservent() routine is - * available to close whatever was being used for service queries. - */ -/*#define HAS_ENDSERVENT /**/ - /* HAS_GETGRENT: * This symbol, if defined, indicates that the getgrent routine is * available for sequential access of the group database. @@ -1644,6 +1409,26 @@ #define PHOSTNAME "" /* How to get the host name */ #endif +/* HAS_GETHOST_PROTOS: + * This symbol, if defined, indicates that includes + * prototypes for gethostent(), gethostbyname(), and + * gethostbyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +#define HAS_GETHOST_PROTOS /**/ + +/* HAS_GETMNT: + * This symbol, if defined, indicates that the getmnt routine is + * available to get filesystem mount info by filename. + */ +/*#define HAS_GETMNT /**/ + +/* HAS_GETMNTENT: + * This symbol, if defined, indicates that the getmntent routine is + * available to iterate through mounted file systems to get their info. + */ +/*#define HAS_GETMNTENT /**/ + /* HAS_GETNETBYADDR: * This symbol, if defined, indicates that the getnetbyaddr() routine is * available to look up networks by their IP addresses. @@ -1662,6 +1447,14 @@ */ /*#define HAS_GETNETENT /**/ +/* HAS_GETNET_PROTOS: + * This symbol, if defined, indicates that includes + * prototypes for getnetent(), getnetbyname(), and + * getnetbyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +/*#define HAS_GETNET_PROTOS /**/ + /* HAS_GETPROTOENT: * This symbol, if defined, indicates that the getprotoent() routine is * available to look up protocols in some data base or another. @@ -1679,6 +1472,14 @@ #define HAS_GETPROTOBYNAME /**/ #define HAS_GETPROTOBYNUMBER /**/ +/* HAS_GETPROTO_PROTOS: + * This symbol, if defined, indicates that includes + * prototypes for getprotoent(), getprotobyname(), and + * getprotobyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +#define HAS_GETPROTO_PROTOS /**/ + /* HAS_GETPWENT: * This symbol, if defined, indicates that the getpwent routine is * available for sequential access of the passwd database. @@ -1692,6 +1493,26 @@ */ /*#define HAS_GETSERVENT /**/ +/* HAS_GETSERV_PROTOS: + * This symbol, if defined, indicates that includes + * prototypes for getservent(), getservbyname(), and + * getservbyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +#define HAS_GETSERV_PROTOS /**/ + +/* HAS_GETSPENT: + * This symbol, if defined, indicates that the getspent system call is + * available to retrieve SysV shadow password entries sequentially. + */ +/*#define HAS_GETSPENT /**/ + +/* HAS_GETSPNAM: + * This symbol, if defined, indicates that the getspnam system call is + * available to retrieve SysV shadow password entries by name. + */ +/*#define HAS_GETSPNAM /**/ + /* HAS_GETSERVBYNAME: * This symbol, if defined, indicates that the getservbyname() * routine is available to look up services by their name. @@ -1703,6 +1524,17 @@ #define HAS_GETSERVBYNAME /**/ #define HAS_GETSERVBYPORT /**/ +/* HAS_GNULIBC: + * This symbol, if defined, indicates to the C program that + * the GNU C library is being used. + */ +/*#define HAS_GNULIBC /**/ +/* HAS_HASMNTOPT: + * This symbol, if defined, indicates that the hasmntopt routine is + * available to query the mount options of file systems. + */ +/*#define HAS_HASMNTOPT /**/ + /* HAS_HTONL: * This symbol, if defined, indicates that the htonl() routine (and * friends htons() ntohl() ntohs()) are available to do network @@ -1728,6 +1560,27 @@ #define HAS_NTOHL /**/ #define HAS_NTOHS /**/ +/* HAS_ISASCII: + * This manifest constant lets the C program know that isascii + * is available. + */ +#define HAS_ISASCII /**/ + +/* HAS_LCHOWN: + * This symbol, if defined, indicates that the lchown routine is + * available to operate on a symbolic link (instead of following the + * link). + */ +/*#define HAS_LCHOWN /**/ + +/* HAS_LDBL_DIG: + * This symbol, if defined, indicates that this system's + * or defines the symbol LDBL_DIG, which is the number + * of significant digits in a long double precision number. Unlike + * for DBL_DIG, there's no good guess for LDBL_DIG if it is undefined. + */ +#define HAS_LDBL_DIG /**/ + /* HAS_LONG_DOUBLE: * This symbol will be defined if the C compiler supports long * doubles. @@ -1750,34 +1603,80 @@ * C preprocessor can make decisions based on it. It is only * defined if the system supports long long. */ -/*#define HAS_LONG_LONG /**/ -#ifdef HAS_LONG_LONG -#define LONGLONGSIZE 8 /**/ -#endif - -/* HAS_MEMCHR: - * This symbol, if defined, indicates that the memchr routine is available - * to locate characters within a C string. +/*#define HAS_LONG_LONG /**/ +#ifdef HAS_LONG_LONG +#define LONGLONGSIZE 8 /**/ +#endif + +/* HAS_MEMCHR: + * This symbol, if defined, indicates that the memchr routine is available + * to locate characters within a C string. + */ +#define HAS_MEMCHR /**/ + +/* HAS_MSG: + * This symbol, if defined, indicates that the entire msg*(2) library is + * supported (IPC mechanism based on message queues). + */ +/*#define HAS_MSG /**/ + +/* HAS_OPEN3: + * This manifest constant lets the C program know that the three + * argument form of open(2) is available. + */ +/*#define HAS_OPEN3 /**/ + +/* OLD_PTHREAD_CREATE_JOINABLE: + * This symbol, if defined, indicates how to create pthread + * in joinable (aka undetached) state. NOTE: not defined + * if pthread.h already has defined PTHREAD_CREATE_JOINABLE + * (the new version of the constant). + * If defined, known values are PTHREAD_CREATE_UNDETACHED + * and __UNDETACHED. + */ +/*#define OLD_PTHREAD_CREATE_JOINABLE /**/ + +/* HAS_PTHREAD_YIELD: + * This symbol, if defined, indicates that the pthread_yield + * routine is available to yield the execution of the current + * thread. sched_yield is preferable to pthread_yield. + */ +/* SCHED_YIELD: + * This symbol defines the way to yield the execution of + * the current thread. Known ways are sched_yield, + * pthread_yield, and pthread_yield with NULL. + */ +/* HAS_SCHED_YIELD: + * This symbol, if defined, indicates that the sched_yield + * routine is available to yield the execution of the current + * thread. sched_yield is preferable to pthread_yield. */ -/*#define HAS_MEMCHR /**/ +/*#define HAS_PTHREAD_YIELD /**/ +#define SCHED_YIELD /**/ +/*#define HAS_SCHED_YIELD /**/ -/* HAS_MMAP: - * This symbol, if defined, indicates that the mmap system call is - * available to map a file into memory. +/* HAS_SAFE_BCOPY: + * This symbol, if defined, indicates that the bcopy routine is available + * to copy potentially overlapping memory blocks. Otherwise you should + * probably use memmove() or memcpy(). If neither is defined, roll your + * own version. */ -/* Mmap_t: - * This symbol holds the return type of the mmap() system call - * (and simultaneously the type of the first argument). - * Usually set to 'void *' or 'cadd_t'. +/*#define HAS_SAFE_BCOPY /**/ + +/* HAS_SAFE_MEMCPY: + * This symbol, if defined, indicates that the memcpy routine is available + * to copy potentially overlapping memory blocks. Otherwise you should + * probably use memmove() or memcpy(). If neither is defined, roll your + * own version. */ -/*#define HAS_MMAP /**/ -#define Mmap_t void * /**/ +/*#define HAS_SAFE_MEMCPY /**/ -/* HAS_MSG: - * This symbol, if defined, indicates that the entire msg*(2) library is - * supported (IPC mechanism based on message queues). +/* HAS_SANE_MEMCMP: + * This symbol, if defined, indicates that the memcmp routine is available + * and can be used to compare relative magnitudes of chars with their high + * bits set. If it is not defined, roll your own version. */ -/*#define HAS_MSG /**/ +#define HAS_SANE_MEMCMP /**/ /* HAS_SEM: * This symbol, if defined, indicates that the entire sem*(2) library is @@ -1828,6 +1727,12 @@ */ /*#define HAS_SETSERVENT /**/ +/* HAS_SETSPENT: + * This symbol, if defined, indicates that the setspent system call is + * available to initialize the scan of SysV shadow password entries. + */ +/*#define HAS_SETSPENT /**/ + /* HAS_SETVBUF: * This symbol, if defined, indicates that the setvbuf routine is * available to change buffering on an open stdio stream. @@ -1835,12 +1740,55 @@ */ #define HAS_SETVBUF /**/ +/* USE_SFIO: + * This symbol, if defined, indicates that sfio should + * be used. + */ +/*#define USE_SFIO /**/ + /* HAS_SHM: * This symbol, if defined, indicates that the entire shm*(2) library is * supported. */ /*#define HAS_SHM /**/ +/* HAS_SIGACTION: + * This symbol, if defined, indicates that Vr4's sigaction() routine + * is available. + */ +/*#define HAS_SIGACTION /**/ + +/* HAS_SIGSETJMP: + * This variable indicates to the C program that the sigsetjmp() + * routine is available to save the calling process's registers + * and stack environment for later use by siglongjmp(), and + * to optionally save the process's signal mask. See + * Sigjmp_buf, Sigsetjmp, and Siglongjmp. + */ +/* Sigjmp_buf: + * This is the buffer type to be used with Sigsetjmp and Siglongjmp. + */ +/* Sigsetjmp: + * This macro is used in the same way as sigsetjmp(), but will invoke + * traditional setjmp() if sigsetjmp isn't available. + * See HAS_SIGSETJMP. + */ +/* Siglongjmp: + * This macro is used in the same way as siglongjmp(), but will invoke + * traditional longjmp() if siglongjmp isn't available. + * See HAS_SIGSETJMP. + */ +/*#define HAS_SIGSETJMP /**/ +#ifdef HAS_SIGSETJMP +#define Sigjmp_buf sigjmp_buf +#define Sigsetjmp(buf,save_mask) sigsetjmp((buf),(save_mask)) +#define Siglongjmp(buf,retval) siglongjmp((buf),(retval)) +#else +#define Sigjmp_buf jmp_buf +#define Sigsetjmp(buf,save_mask) setjmp((buf)) +#define Siglongjmp(buf,retval) longjmp((buf),(retval)) +#endif + /* HAS_SOCKET: * This symbol, if defined, indicates that the BSD socket interface is * supported. @@ -1879,26 +1827,6 @@ * Checking just with #ifdef might not be enough because this symbol * has been known to be an enum. */ -/* HAS_SENDMSG: - * This symbol, if defined, indicates that the sendmsg is supported - * to send messages between sockets. You will also need struct - * iovec from , HAS_STRUCT_IOVEC and I_SYSUIO. - */ -/* HAS_RECVMSG: - * This symbol, if defined, indicates that the recvmsg is supported - * to send messages between sockets. You will also need struct - * iovec from , HAS_STRUCT_IOVEC and I_SYSUIO. - */ -/* HAS_STRUCT_MSGHDR: - * This symbol, if defined, indicates that the struct msghdr - * (BSD 4.3 or 4.4) is supported. You will also need struct - * iovec from , HAS_STRUCT_IOVEC and I_SYSUIO. - */ -/* HAS_STRUCT_CMSGHDR: - * This symbol, if defined, indicates that the struct cmsghdr - * (BSD 4.4) is supported. You will also need struct - * iovec from , HAS_STRUCT_IOVEC and I_SYSUIO. - */ #define HAS_SOCKET /**/ /*#define HAS_SOCKETPAIR /**/ /*#define HAS_MSG_CTRUNC /**/ @@ -1907,16 +1835,102 @@ /*#define HAS_MSG_PEEK /**/ /*#define HAS_MSG_PROXY /**/ /*#define HAS_SCM_RIGHTS /**/ -/*#define HAS_SENDMSG /**/ -/*#define HAS_RECVMSG /**/ -/*#define HAS_STRUCT_MSGHDR /**/ -/*#define HAS_STRUCT_CMSGHDR /**/ + +/* HAS_SQRTL: + * This symbol, if defined, indicates that the sqrtl routine is + * available to do long double square roots. + */ +/*#define HAS_SQRTL /**/ /* USE_STAT_BLOCKS: * This symbol is defined if this system has a stat structure declaring * st_blksize and st_blocks. */ +#ifndef USE_STAT_BLOCKS /*#define USE_STAT_BLOCKS /**/ +#endif + +/* HAS_STRUCT_STATFS_F_FLAGS: + * This symbol, if defined, indicates that the struct statfs + * does have the f_flags member containing the mount flags of + * the filesystem containing the file. + * This kind of struct statfs is coming from (BSD 4.3), + * not from (SYSV). Older BSDs (like Ultrix) do not + * have statfs() and struct statfs, they have ustat() and getmnt() + * with struct ustat and struct fs_data. + */ +/*#define HAS_STRUCT_STATFS_F_FLAGS /**/ + +/* HAS_STRUCT_STATFS: + * This symbol, if defined, indicates that the struct statfs + * to do statfs() is supported. + */ +/*#define HAS_STRUCT_STATFS /**/ + +/* HAS_FSTATVFS: + * This symbol, if defined, indicates that the fstatvfs routine is + * available to stat filesystems by file descriptors. + */ +/*#define HAS_FSTATVFS /**/ + +/* USE_STDIO_PTR: + * This symbol is defined if the _ptr and _cnt fields (or similar) + * of the stdio FILE structure can be used to access the stdio buffer + * for a file handle. If this is defined, then the FILE_ptr(fp) + * and FILE_cnt(fp) macros will also be defined and should be used + * to access these fields. + */ +/* FILE_ptr: + * This macro is used to access the _ptr field (or equivalent) of the + * FILE structure pointed to by its argument. This macro will always be + * defined if USE_STDIO_PTR is defined. + */ +/* STDIO_PTR_LVALUE: + * This symbol is defined if the FILE_ptr macro can be used as an + * lvalue. + */ +/* FILE_cnt: + * This macro is used to access the _cnt field (or equivalent) of the + * FILE structure pointed to by its argument. This macro will always be + * defined if USE_STDIO_PTR is defined. + */ +/* STDIO_CNT_LVALUE: + * This symbol is defined if the FILE_cnt macro can be used as an + * lvalue. + */ +#define USE_STDIO_PTR /**/ +#ifdef USE_STDIO_PTR +#define FILE_ptr(fp) ((fp)->curp) +#define STDIO_PTR_LVALUE /**/ +#define FILE_cnt(fp) ((fp)->level) +#define STDIO_CNT_LVALUE /**/ +#endif + +/* USE_STDIO_BASE: + * This symbol is defined if the _base field (or similar) of the + * stdio FILE structure can be used to access the stdio buffer for + * a file handle. If this is defined, then the FILE_base(fp) macro + * will also be defined and should be used to access this field. + * Also, the FILE_bufsiz(fp) macro will be defined and should be used + * to determine the number of bytes in the buffer. USE_STDIO_BASE + * will never be defined unless USE_STDIO_PTR is. + */ +/* FILE_base: + * This macro is used to access the _base field (or equivalent) of the + * FILE structure pointed to by its argument. This macro will always be + * defined if USE_STDIO_BASE is defined. + */ +/* FILE_bufsiz: + * This macro is used to determine the number of bytes in the I/O + * buffer pointed to by _base field (or equivalent) of the FILE + * structure pointed to its argument. This macro will always be defined + * if USE_STDIO_BASE is defined. + */ +#define USE_STDIO_BASE /**/ +#ifdef USE_STDIO_BASE +#define FILE_base(fp) ((fp)->buffer) +#define FILE_bufsiz(fp) ((fp)->level + (fp)->curp - (fp)->buffer) +#endif /* HAS_STRERROR: * This symbol, if defined, indicates that the strerror routine is @@ -1937,6 +1951,52 @@ #define HAS_SYS_ERRLIST /**/ #define Strerror(e) strerror(e) +/* HAS_STRTOLD: + * This symbol, if defined, indicates that the strtold routine is + * available to convert strings to long doubles. + */ +/*#define HAS_STRTOLD /**/ + +/* HAS_STRTOLL: + * This symbol, if defined, indicates that the strtoll routine is + * available to convert strings to long longs. + */ +/*#define HAS_STRTOLL /**/ + +/* HAS_STRTOULL: + * This symbol, if defined, indicates that the strtoull routine is + * available to convert strings to unsigned long longs. + */ +/*#define HAS_STRTOULL /**/ + +/* HAS_STRTOUQ: + * This symbol, if defined, indicates that the strtouq routine is + * available to convert strings to unsigned long longs (quads). + */ +/*#define HAS_STRTOUQ /**/ + +/* HAS_TELLDIR_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the telldir() function. Otherwise, it is up + * to the program to supply one. A good guess is + * extern long telldir _((DIR*)); + */ +#define HAS_TELLDIR_PROTO /**/ + +/* Time_t: + * This symbol holds the type returned by time(). It can be long, + * or time_t on BSD sites (in which case should be + * included). + */ +#define Time_t time_t /* Time type */ + +/* HAS_TIMES: + * This symbol, if defined, indicates that the times() routine exists. + * Note that this became obsolete on some systems (SUNOS), which now + * use getrusage(). It may be necessary to include . + */ +#define HAS_TIMES /**/ + /* HAS_UNION_SEMUN: * This symbol, if defined, indicates that the union semun is * defined by including . If not, the user code @@ -1959,6 +2019,12 @@ /*#define USE_SEMCTL_SEMUN /**/ /*#define USE_SEMCTL_SEMID_DS /**/ +/* HAS_USTAT: + * This symbol, if defined, indicates that the ustat system call is + * available to query file system statistics by dev_t. + */ +/*#define HAS_USTAT /**/ + /* HAS_VFORK: * This symbol, if defined, indicates that vfork() exists. */ @@ -1970,7 +2036,79 @@ * a signal handler using "Signal_t (*handler)()", and define the * handler using "Signal_t handler(sig)". */ -#define Signal_t void /* Signal handler's return type */ +#define Signal_t void /* Signal handler's return type */ + +/* HAS_VPRINTF: + * This symbol, if defined, indicates that the vprintf routine is available + * to printf with a pointer to an argument list. If unavailable, you + * may need to write your own, probably in terms of _doprnt(). + */ +/* USE_CHAR_VSPRINTF: + * This symbol is defined if this system has vsprintf() returning type + * (char*). The trend seems to be to declare it as "int vsprintf()". It + * is up to the package author to declare vsprintf correctly based on the + * symbol. + */ +#define HAS_VPRINTF /**/ +/*#define USE_CHAR_VSPRINTF /**/ + +/* USE_DYNAMIC_LOADING: + * This symbol, if defined, indicates that dynamic loading of + * some sort is available. + */ +#define USE_DYNAMIC_LOADING /**/ + +/* DOUBLESIZE: + * This symbol contains the size of a double, so that the C preprocessor + * can make decisions based on it. + */ +#define DOUBLESIZE 8 /**/ + +/* EBCDIC: + * This symbol, if defined, indicates that this system uses + * EBCDIC encoding. + */ +/*#define EBCDIC /**/ + +/* FFLUSH_NULL: + * This symbol, if defined, tells that fflush(NULL) does flush + * all pending stdio output. + */ +/* FFLUSH_ALL: + * This symbol, if defined, tells that to flush + * all pending stdio output one must loop through all + * the stdio file handles stored in an array and fflush them. + * Note that if fflushNULL is defined, fflushall will not + * even be probed for and will be left undefined. + */ +#define FFLUSH_NULL /**/ +/*#define FFLUSH_ALL /**/ + +/* Fpos_t: + * This symbol holds the type used to declare file positions in libc. + * It can be fpos_t, long, uint, etc... It may be necessary to include + * to get any typedef'ed information. + */ +#define Fpos_t fpos_t /* File position type */ + +/* Gid_t_f: + * This symbol defines the format string used for printing a Gid_t. + */ +#define Gid_t_f "d" /**/ + +/* Gid_t_size: + * This symbol holds the size of a Gid_t in bytes. + */ +#define Gid_t_size 4 /* GID size */ + +/* Gid_t: + * This symbol holds the return type of getgid() and the type of + * argument to setrgid() and related functions. Typically, + * it is the type of group ids in the kernel. It can be int, ushort, + * uid_t, etc... It may be necessary to include to get + * any typedef'ed information. + */ +#define Gid_t gid_t /* Type for getgid(), etc... */ /* Groups_t: * This symbol holds the type used for the second argument to @@ -1985,6 +2123,19 @@ #define Groups_t gid_t /* Type for 2nd arg to [sg]etgroups() */ #endif +/* DB_Prefix_t: + * This symbol contains the type of the prefix structure element + * in the header file. In older versions of DB, it was + * int, while in newer ones it is u_int32_t. + */ +/* DB_Hash_t: + * This symbol contains the type of the prefix structure element + * in the header file. In older versions of DB, it was + * int, while in newer ones it is size_t. + */ +#define DB_Hash_t int /**/ +#define DB_Prefix_t int /**/ + /* I_GRP: * This symbol, if defined, indicates to the C program that it should * include . @@ -1996,12 +2147,48 @@ /*#define I_GRP /**/ /*#define GRPASSWD /**/ +/* I_INTTYPES: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +/*#define I_INTTYPES /**/ + +/* I_MACH_CTHREADS: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +/*#define I_MACH_CTHREADS /**/ + +/* I_MNTENT: + * This symbol, if defined, indicates that exists and + * should be included. + */ +/*#define I_MNTENT /**/ + /* I_NETDB: * This symbol, if defined, indicates that exists and * should be included. */ /*#define I_NETDB /**/ +/* I_NETINET_TCP: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +/*#define I_NETINET_TCP /**/ + +/* I_POLL: + * This symbol, if defined, indicates that exists and + * should be included. + */ +/*#define I_POLL /**/ + +/* I_PTHREAD: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +/*#define I_PTHREAD /**/ + /* I_PWD: * This symbol, if defined, indicates to the C program that it should * include . @@ -2048,12 +2235,113 @@ /*#define PWGECOS /**/ /*#define PWPASSWD /**/ +/* I_SHADOW: + * This symbol, if defined, indicates that exists and + * should be included. + */ +/*#define I_SHADOW /**/ + +/* I_SOCKS: + * This symbol, if defined, indicates that exists and + * should be included. + */ +/*#define I_SOCKS /**/ + +/* I_SYS_MOUNT: + * This symbol, if defined, indicates that exists and + * should be included. + */ +/*#define I_SYS_MOUNT /**/ + +/* I_SYS_STATFS: + * This symbol, if defined, indicates that exists. + */ +/*#define I_SYS_STATFS /**/ + +/* I_SYS_STATVFS: + * This symbol, if defined, indicates that exists and + * should be included. + */ +/*#define I_SYS_STATVFS /**/ + /* I_SYSUIO: * This symbol, if defined, indicates that exists and * should be included. */ /*#define I_SYSUIO /**/ +/* I_SYS_VFS: + * This symbol, if defined, indicates that exists and + * should be included. + */ +/*#define I_SYS_VFS /**/ + +/* I_TIME: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +/* I_SYS_TIME: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +/* I_SYS_TIME_KERNEL: + * This symbol, if defined, indicates to the C program that it should + * include with KERNEL defined. + */ +#define I_TIME /**/ +/*#define I_SYS_TIME /**/ +/*#define I_SYS_TIME_KERNEL /**/ + +/* I_USTAT: + * This symbol, if defined, indicates that exists and + * should be included. + */ +/*#define I_USTAT /**/ + +/* PERL_INC_VERSION_LIST: + * This variable specifies the list of subdirectories in over + * which perl.c:incpush() and lib/lib.pm will automatically + * search when adding directories to @INC, in a format suitable + * for a C initialization string. See the inc_version_list entry + * in Porting/Glossary for more details. + */ +#define PERL_INC_VERSION_LIST /**/ + +/* HAS_OFF64_T: + * This symbol will be defined if the C compiler supports off64_t. + */ +/* HAS_FPOS64_T: + * This symbol will be defined if the C compiler supports fpos64_t. + */ +/*#define HAS_OFF64_T /**/ +/*#define HAS_FPOS64_T /**/ + +/* PERL_PRIfldbl: + * This symbol, if defined, contains the string used by stdio to + * format long doubles (format 'f') for output. + */ +/* PERL_PRIgldbl: + * This symbol, if defined, contains the string used by stdio to + * format long doubles (format 'g') for output. + */ +/*#define PERL_PRIfldbl "f" /**/ +/*#define PERL_PRIgldbl "g" /**/ + +/* Off_t: + * This symbol holds the type used to declare offsets in the kernel. + * It can be int, long, off_t, etc... It may be necessary to include + * to get any typedef'ed information. + */ +/* LSEEKSIZE: + * This symbol holds the number of bytes used by the Off_t. + */ +/* Off_t_size: + * This symbol holds the number of bytes used by the Off_t. + */ +#define Off_t off_t /* type */ +#define LSEEKSIZE 4 /* size */ +#define Off_t_size 4 /* size */ + /* Free_t: * This variable contains the return type of free(). It is usually * void, but occasionally int. @@ -2069,347 +2357,326 @@ */ /*#define MYMALLOC /**/ -/* SIG_NAME: - * This symbol contains a list of signal names in order of - * signal number. This is intended - * to be used as a static array initialization, like this: - * char *sig_name[] = { SIG_NAME }; - * The signals in the list are separated with commas, and each signal - * is surrounded by double quotes. There is no leading SIG in the signal - * name, i.e. SIGQUIT is known as "QUIT". - * Gaps in the signal numbers (up to NSIG) are filled in with NUMnn, - * etc., where nn is the actual signal number (e.g. NUM37). - * The signal number for sig_name[i] is stored in sig_num[i]. - * The last element is 0 to terminate the list with a NULL. This - * corresponds to the 0 at the end of the sig_num list. - */ -/* SIG_NUM: - * This symbol contains a list of signal numbers, in the same order as the - * SIG_NAME list. It is suitable for static array initialization, as in: - * int sig_num[] = { SIG_NUM }; - * The signals in the list are separated with commas, and the indices - * within that list and the SIG_NAME list match, so it's easy to compute - * the signal name from a number or vice versa at the price of a small - * dynamic linear lookup. - * Duplicates are allowed, but are moved to the end of the list. - * The signal number corresponding to sig_name[i] is sig_number[i]. - * if (i < NSIG) then sig_number[i] == i. - * The last element is 0, corresponding to the 0 at the end of - * the sig_name list. +/* Mode_t: + * This symbol holds the type used to declare file modes + * for systems calls. It is usually mode_t, but may be + * int or unsigned short. It may be necessary to include + * to get any typedef'ed information. */ -#define SIG_NAME "ZERO", "NUM01", "INT", "QUIT", "ILL", "NUM05", "NUM06", "NUM07", "FPE", "KILL", "NUM10", "SEGV", "NUM12", "PIPE", "ALRM", "TERM", "USR1", "USR2", "CHLD", "NUM19", "USR3", "BREAK", "ABRT", "STOP", "NUM24", "CONT", "CLD", 0 /**/ -#define SIG_NUM 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 18, 0 /**/ +#define Mode_t mode_t /* file mode parameter for system calls */ -/* VOIDFLAGS: - * This symbol indicates how much support of the void type is given by this - * compiler. What various bits mean: - * - * 1 = supports declaration of void - * 2 = supports arrays of pointers to functions returning void - * 4 = supports comparisons between pointers to void functions and - * addresses of void functions - * 8 = suports declaration of generic void pointers - * - * The package designer should define VOIDUSED to indicate the requirements - * of the package. This can be done either by #defining VOIDUSED before - * including config.h, or by defining defvoidused in Myinit.U. If the - * latter approach is taken, only those flags will be tested. If the - * level of void support necessary is not present, defines void to int. +/* VAL_O_NONBLOCK: + * This symbol is to be used during open() or fcntl(F_SETFL) to turn on + * non-blocking I/O for the file descriptor. Note that there is no way + * back, i.e. you cannot turn it blocking again this way. If you wish to + * alternatively switch between blocking and non-blocking, use the + * ioctl(FIOSNBIO) call instead, but that is not supported by all devices. */ -#ifndef VOIDUSED -#define VOIDUSED 15 -#endif -#define VOIDFLAGS 15 -#if (VOIDFLAGS & VOIDUSED) != VOIDUSED -#define void int /* is void to be avoided? */ -#define M_VOID /* Xenix strikes again */ -#endif - -/* HAS_ATOLF: - * This symbol, if defined, indicates that the atolf routine is - * available to convert strings into long doubles. +/* VAL_EAGAIN: + * This symbol holds the errno error code set by read() when no data was + * present on the non-blocking file descriptor. */ -/*#define HAS_ATOLF /**/ - -/* HAS_ATOLL: - * This symbol, if defined, indicates that the atoll routine is - * available to convert strings into long longs. +/* RD_NODATA: + * This symbol holds the return code from read() when no data is present + * on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is + * not defined, then you can't distinguish between no data and EOF by + * issuing a read(). You'll have to find another way to tell for sure! */ -/*#define HAS_ATOLL /**/ - -/* PERL_BINCOMPAT_5005: - * This symbol, if defined, indicates that Perl 5.006 should be - * binary-compatible with Perl 5.005. This is impossible for builds - * that use features like threads and multiplicity it is always undef - * for those versions. +/* EOF_NONBLOCK: + * This symbol, if defined, indicates to the C program that a read() on + * a non-blocking file descriptor will return 0 on EOF, and not the value + * held in RD_NODATA (-1 usually, in that case!). */ -/*#define PERL_BINCOMPAT_5005 /**/ +#define VAL_O_NONBLOCK O_NONBLOCK +#define VAL_EAGAIN EAGAIN +#define RD_NODATA -1 +#define EOF_NONBLOCK -/* DLSYM_NEEDS_UNDERSCORE: - * This symbol, if defined, indicates that we need to prepend an - * underscore to the symbol name before calling dlsym(). This only - * makes sense if you *have* dlsym, which we will presume is the - * case if you're using dl_dlopen.xs. +/* Netdb_host_t: + * This symbol holds the type used for the 1st argument + * to gethostbyaddr(). */ -/*#define DLSYM_NEEDS_UNDERSCORE /**/ - -/* HAS_ENDSPENT: - * This symbol, if defined, indicates that the endspent system call is - * available to finalize the scan of SysV shadow password entries. +/* Netdb_hlen_t: + * This symbol holds the type used for the 2nd argument + * to gethostbyaddr(). + */ +/* Netdb_name_t: + * This symbol holds the type used for the argument to + * gethostbyname(). + */ +/* Netdb_net_t: + * This symbol holds the type used for the 1st argument to + * getnetbyaddr(). */ -/*#define HAS_ENDSPENT /**/ +#define Netdb_host_t char * /**/ +#define Netdb_hlen_t int /**/ +#define Netdb_name_t char * /**/ +#define Netdb_net_t long /**/ -/* HAS_FSEEKO: - * This symbol, if defined, indicates that the fseeko routine is - * available to fseek beyond 32 bits (useful for ILP32 hosts). +/* IVTYPE: + * This symbol defines the C type used for Perl's IV. */ -/*#define HAS_FSEEKO /**/ - -/* HAS_FTELLO: - * This symbol, if defined, indicates that the ftello routine is - * available to ftell beyond 32 bits (useful for ILP32 hosts). +/* UVTYPE: + * This symbol defines the C type used for Perl's UV. */ -/*#define HAS_FTELLO /**/ - -/* HAS_GETMNTENT: - * This symbol, if defined, indicates that the getmntent routine is - * available to iterate through mounted file systems. +/* I8TYPE: + * This symbol defines the C type used for Perl's I8. */ -/*#define HAS_GETMNTENT /**/ - -/* HAS_GETSPENT: - * This symbol, if defined, indicates that the getspent system call is - * available to retrieve SysV shadow password entries sequentially. +/* U8TYPE: + * This symbol defines the C type used for Perl's U8. */ -/*#define HAS_GETSPENT /**/ - -/* HAS_GETSPNAM: - * This symbol, if defined, indicates that the getspnam system call is - * available to retrieve SysV shadow password entries by name. +/* I16TYPE: + * This symbol defines the C type used for Perl's I16. */ -/*#define HAS_GETSPNAM /**/ - -/* HAS_HASMNTOPT: - * This symbol, if defined, indicates that the hasmntopt routine is - * available to query the mount options of file systems. +/* U16TYPE: + * This symbol defines the C type used for Perl's U16. */ -/*#define HAS_HASMNTOPT /**/ - -/* HAS_LDBL_DIG: - * This symbol, if defined, indicates that this system's - * or defines the symbol LDBL_DIG, which is the number - * of significant digits in a long double precision number. Unlike - * for DBL_DIG, there's no good guess for LDBL_DIG if it is undefined. +/* I32TYPE: + * This symbol defines the C type used for Perl's I32. */ -#define HAS_LDBL_DIG /**/ - -/* HAS_MADVISE: - * This symbol, if defined, indicates that the madvise system call is - * available to map a file into memory. +/* U32TYPE: + * This symbol defines the C type used for Perl's U32. */ -/*#define HAS_MADVISE /**/ - -/* HAS_MPROTECT: - * This symbol, if defined, indicates that the mprotect system call is - * available to modify the access protection of a memory mapped file. +/* I64TYPE: + * This symbol defines the C type used for Perl's I64. */ -/*#define HAS_MPROTECT /**/ - -/* HAS_READV: - * This symbol, if defined, indicates that the readv routine is - * available to do gather reads. You will also need - * and there I_SYSUIO. +/* U64TYPE: + * This symbol defines the C type used for Perl's U64. */ -/*#define HAS_READV /**/ - -/* HAS_SETSPENT: - * This symbol, if defined, indicates that the setspent system call is - * available to initialize the scan of SysV shadow password entries. +/* NVTYPE: + * This symbol defines the C type used for Perl's NV. */ -/*#define HAS_SETSPENT /**/ - -/* USE_SFIO: - * This symbol, if defined, indicates that sfio should - * be used. +/* IVSIZE: + * This symbol contains the sizeof(IV). */ -/*#define USE_SFIO /**/ - -/* HAS_FSTATFS: - * This symbol, if defined, indicates that the fstatfs routine is - * available to stat filesystems of file descriptors. +/* UVSIZE: + * This symbol contains the sizeof(UV). */ -/* HAS_STRUCT_STATFS_FLAGS: - * This symbol, if defined, indicates that the struct statfs - * does have the f_flags member containing the mount flags of - * the filesystem holding the file. - * This kind of struct statfs is coming from sys/mount.h (BSD), - * not from sys/statfs.h (SYSV). +/* I8SIZE: + * This symbol contains the sizeof(I8). */ -/*#define HAS_FSTATFS /**/ -/*#define HAS_STRUCT_STATFS_FLAGS /**/ - -/* HAS_FSTATVFS: - * This symbol, if defined, indicates that the fstatvfs routine is - * available to stat filesystems of file descriptors. +/* U8SIZE: + * This symbol contains the sizeof(U8). */ -/*#define HAS_FSTATVFS /**/ - -/* HAS_TELLDIR_PROTO: - * This symbol, if defined, indicates that the system provides - * a prototype for the telldir() function. Otherwise, it is up - * to the program to supply one. A good guess is - * extern long telldir _((DIR*)); +/* I16SIZE: + * This symbol contains the sizeof(I16). */ -#define HAS_TELLDIR_PROTO /**/ - -/* HAS_WRITEV: - * This symbol, if defined, indicates that the writev routine is - * available to do scatter writes. +/* U16SIZE: + * This symbol contains the sizeof(U16). */ -/*#define HAS_WRITEV /**/ - -/* USE_DYNAMIC_LOADING: - * This symbol, if defined, indicates that dynamic loading of - * some sort is available. +/* I32SIZE: + * This symbol contains the sizeof(I32). */ -#define USE_DYNAMIC_LOADING /**/ - -/* FFLUSH_NULL: - * This symbol, if defined, tells that fflush(NULL) does flush - * all pending stdio output. +/* U32SIZE: + * This symbol contains the sizeof(U32). */ -/* FFLUSH_ALL: - * This symbol, if defined, tells that to flush - * all pending stdio output one must loop through all - * the stdio file handles stored in an array and fflush them. - * Note that if fflushNULL is defined, fflushall will not - * even be probed for and will be left undefined. +/* I64SIZE: + * This symbol contains the sizeof(I64). */ -#define FFLUSH_NULL /**/ -/*#define FFLUSH_ALL /**/ +/* U64SIZE: + * This symbol contains the sizeof(U64). + */ +#define IVTYPE long /**/ +#define UVTYPE unsigned long /**/ +#define I8TYPE char /**/ +#define U8TYPE unsigned char /**/ +#define I16TYPE short /**/ +#define U16TYPE unsigned short /**/ +#define I32TYPE long /**/ +#define U32TYPE unsigned long /**/ +#ifdef HAS_QUAD +#define I64TYPE __int64 /**/ +#define U64TYPE unsigned __int64 /**/ +#endif +#define NVTYPE double /**/ +#define IVSIZE 4 /**/ +#define UVSIZE 4 /**/ +#define I8SIZE 1 /**/ +#define U8SIZE 1 /**/ +#define I16SIZE 2 /**/ +#define U16SIZE 2 /**/ +#define I32SIZE 4 /**/ +#define U32SIZE 4 /**/ +#ifdef HAS_QUAD +#define I64SIZE 8 /**/ +#define U64SIZE 8 /**/ +#endif -/* DB_Prefix_t: - * This symbol contains the type of the prefix structure element - * in the header file. In older versions of DB, it was - * int, while in newer ones it is u_int32_t. +/* IVdf: + * This symbol defines the format string used for printing a Perl IV + * as a signed decimal integer. */ -/* DB_Hash_t: - * This symbol contains the type of the prefix structure element - * in the header file. In older versions of DB, it was - * int, while in newer ones it is size_t. +/* UVuf: + * This symbol defines the format string used for printing a Perl UV + * as an unsigned decimal integer. */ -#define DB_Hash_t int /**/ -#define DB_Prefix_t int /**/ - -/* I_INTTYPES: - * This symbol, if defined, indicates to the C program that it should - * include . +/* UVof: + * This symbol defines the format string used for printing a Perl UV + * as an unsigned octal integer. */ -/* HAS_INT64_T: - * This symbol will defined if the C compiler supports int64_t. - * Usually the needs to be included, but sometimes - * is enough. +/* UVxf: + * This symbol defines the format string used for printing a Perl UV + * as an unsigned hexadecimal integer. */ -/*#define I_INTTYPES /**/ -/*#define HAS_INT64_T /**/ +#define IVdf "ld" /**/ +#define UVuf "lu" /**/ +#define UVof "lo" /**/ +#define UVxf "lx" /**/ -/* I_MNTENT: - * This symbol, if defined, indicates that exists and - * should be included. +/* Pid_t: + * This symbol holds the type used to declare process ids in the kernel. + * It can be int, uint, pid_t, etc... It may be necessary to include + * to get any typedef'ed information. */ -/*#define I_MNTENT /**/ +#define Pid_t int /* PID type */ -/* I_NETINET_TCP: - * This symbol, if defined, indicates to the C program that it should - * include . +/* PRIVLIB: + * This symbol contains the name of the private library for this package. + * The library is private in the sense that it needn't be in anyone's + * execution path, but it should be accessible by the world. The program + * should be prepared to do ~ expansion. */ -/*#define I_NETINET_TCP /**/ - -/* I_POLL: - * This symbol, if defined, indicates that exists and - * should be included. +/* PRIVLIB_EXP: + * This symbol contains the ~name expanded version of PRIVLIB, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. */ -/*#define I_POLL /**/ +#define PRIVLIB "c:\\perl\\5.5.640\\lib" /**/ +#define PRIVLIB_EXP (win32_get_privlib("5.5.640")) /**/ -/* I_SHADOW: - * This symbol, if defined, indicates that exists and - * should be included. +/* PTRSIZE: + * This symbol contains the size of a pointer, so that the C preprocessor + * can make decisions based on it. It will be sizeof(void *) if + * the compiler supports (void *); otherwise it will be + * sizeof(char *). */ -/*#define I_SHADOW /**/ +#define PTRSIZE 4 /**/ -/* I_SOCKS: - * This symbol, if defined, indicates that exists and - * should be included. +/* Drand01: + * This macro is to be used to generate uniformly distributed + * random numbers over the range [0., 1.[. You may have to supply + * an 'extern double drand48();' in your program since SunOS 4.1.3 + * doesn't provide you with anything relevant in it's headers. + * See HAS_DRAND48_PROTO. */ -/*#define I_SOCKS /**/ - -/* I_SYS_MMAN: - * This symbol, if defined, indicates that exists and - * should be included. +/* Rand_seed_t: + * This symbol defines the type of the argument of the + * random seed function. */ -/*#define I_SYS_MMAN /**/ +/* seedDrand01: + * This symbol defines the macro to be used in seeding the + * random number generator (see Drand01). + */ +/* RANDBITS: + * This symbol indicates how many bits are produced by the + * function used to generate normalized random numbers. + * Values include 15, 16, 31, and 48. + */ +#define Drand01() (rand()/(double)((unsigned)1< exists and - * should be included. +/* SELECT_MIN_BITS: + * This symbol holds the minimum number of bits operated by select. + * That is, if you do select(n, ...), how many bits at least will be + * cleared in the masks if some activity is detected. Usually this + * is either n or 32*ceil(n/32), especially many little-endians do + * the latter. This is only useful if you have select(), naturally. */ -/*#define I_SYS_MOUNT /**/ +#define SELECT_MIN_BITS 32 /**/ -/* I_SYS_STATVFS: - * This symbol, if defined, indicates that exists and - * should be included. +/* Select_fd_set_t: + * This symbol holds the type used for the 2nd, 3rd, and 4th + * arguments to select. Usually, this is 'fd_set *', if HAS_FD_SET + * is defined, and 'int *' otherwise. This is only useful if you + * have select(), of course. */ -/*#define I_SYS_STATVFS /**/ +#define Select_fd_set_t Perl_fd_set * /**/ -/* HAS_OFF64_T: - * This symbol will be defined if the C compiler supports off64_t. +/* SIG_NAME: + * This symbol contains a list of signal names in order of + * signal number. This is intended + * to be used as a static array initialization, like this: + * char *sig_name[] = { SIG_NAME }; + * The signals in the list are separated with commas, and each signal + * is surrounded by double quotes. There is no leading SIG in the signal + * name, i.e. SIGQUIT is known as "QUIT". + * Gaps in the signal numbers (up to NSIG) are filled in with NUMnn, + * etc., where nn is the actual signal number (e.g. NUM37). + * The signal number for sig_name[i] is stored in sig_num[i]. + * The last element is 0 to terminate the list with a NULL. This + * corresponds to the 0 at the end of the sig_num list. */ -/* HAS_FPOS64_T: - * This symbol will be defined if the C compiler supports fpos64_t. +/* SIG_NUM: + * This symbol contains a list of signal numbers, in the same order as the + * SIG_NAME list. It is suitable for static array initialization, as in: + * int sig_num[] = { SIG_NUM }; + * The signals in the list are separated with commas, and the indices + * within that list and the SIG_NAME list match, so it's easy to compute + * the signal name from a number or vice versa at the price of a small + * dynamic linear lookup. + * Duplicates are allowed, but are moved to the end of the list. + * The signal number corresponding to sig_name[i] is sig_number[i]. + * if (i < NSIG) then sig_number[i] == i. + * The last element is 0, corresponding to the 0 at the end of + * the sig_name list. */ -/*#define HAS_OFF64_T /**/ -/*#define HAS_FPOS64_T /**/ +#define SIG_NAME "ZERO", "NUM01", "INT", "QUIT", "ILL", "NUM05", "NUM06", "NUM07", "FPE", "KILL", "NUM10", "SEGV", "NUM12", "PIPE", "ALRM", "TERM", "USR1", "USR2", "CHLD", "NUM19", "USR3", "BREAK", "ABRT", "STOP", "NUM24", "CONT", "CLD", 0 /**/ +#define SIG_NUM 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 18, 0 /**/ -/* PERL_PRIfldbl: - * This symbol, if defined, contains the string used by stdio to - * format long doubles (format 'f') for output. +/* SITEARCH: + * This symbol contains the name of the private library for this package. + * The library is private in the sense that it needn't be in anyone's + * execution path, but it should be accessible by the world. The program + * should be prepared to do ~ expansion. + * The standard distribution will put nothing in this directory. + * After perl has been installed, users may install their own local + * architecture-dependent modules in this directory with + * MakeMaker Makefile.PL + * or equivalent. See INSTALL for details. */ -/* PERL_PRIgldbl: - * This symbol, if defined, contains the string used by stdio to - * format long doubles (format 'g') for output. +/* SITEARCH_EXP: + * This symbol contains the ~name expanded version of SITEARCH, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. */ -/*#define PERL_PRIfldbl undef /**/ -/*#define PERL_PRIgldbl undef /**/ +#define SITEARCH "c:\\perl\\site\\5.5.640\\lib\\MSWin32-x86" /**/ +/*#define SITEARCH_EXP "" /**/ -/* PERL_PRId64: - * This symbol, if defined, contains the string used by stdio to - * format 64-bit decimal numbers (format 'd') for output. - */ -/* PERL_PRIu64: - * This symbol, if defined, contains the string used by stdio to - * format 64-bit unsigned decimal numbers (format 'u') for output. +/* SITELIB: + * This symbol contains the name of the private library for this package. + * The library is private in the sense that it needn't be in anyone's + * execution path, but it should be accessible by the world. The program + * should be prepared to do ~ expansion. + * The standard distribution will put nothing in this directory. + * After perl has been installed, users may install their own local + * architecture-independent modules in this directory with + * MakeMaker Makefile.PL + * or equivalent. See INSTALL for details. */ -/* PERL_PRIo64: - * This symbol, if defined, contains the string used by stdio to - * format 64-bit octal numbers (format 'o') for output. +/* SITELIB_EXP: + * This symbol contains the ~name expanded version of SITELIB, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. */ -/* PERL_PRIx64: - * This symbol, if defined, contains the string used by stdio to - * format 64-bit hexadecimal numbers (format 'x') for output. +#define SITELIB "c:\\perl\\site\\5.5.640\\lib" /**/ +#define SITELIB_EXP (win32_get_sitelib("5.5.640")) /**/ + +/* Size_t: + * This symbol holds the type used to declare length parameters + * for string functions. It is usually size_t, but may be + * unsigned long, int, etc. It may be necessary to include + * to get any typedef'ed information. */ -/*#define PERL_PRId64 undef /**/ -/*#define PERL_PRIu64 undef /**/ -/*#define PERL_PRIo64 undef /**/ -/*#define PERL_PRIx64 undef /**/ +#define Size_t size_t /* length paramater for string functions */ -/* SELECT_MIN_BITS: - * This symbol holds the minimum number of bits operated by select. - * That is, if you do select(n, ...), how many bits at least will be - * cleared in the masks if some activity is detected. Usually this - * is either n or 32*ceil(n/32), especially many little-endians do - * the latter. This is only useful if you have select(), naturally. +/* SSize_t: + * This symbol holds the type used by functions that return + * a count of bytes or an error condition. It must be a signed type. + * It is usually ssize_t, but may be long or int, etc. + * It may be necessary to include or + * to get any typedef'ed information. + * We will pick a type such that sizeof(SSize_t) == sizeof(Size_t). */ -#define SELECT_MIN_BITS 32 /**/ +#define SSize_t int /* signed count of bytes */ /* STARTPERL: * This variable contains the string to put in front of a perl @@ -2427,238 +2694,136 @@ * Usual values include _iob, __iob, and __sF. */ /*#define HAS_STDIO_STREAM_ARRAY /**/ -#define STDIO_STREAM_ARRAY undef +#define STDIO_STREAM_ARRAY -/* HAS_STRTOULL: - * This symbol, if defined, indicates that the strtoull routine is - * available to convert strings into unsigned long longs. +/* Uid_t_f: + * This symbol defines the format string used for printing a Uid_t. */ -/*#define HAS_STRTOULL /**/ +#define Uid_t_f "d" /**/ + +/* Uid_t_size: + * This symbol holds the size of a Uid_t in bytes. + */ +#define Uid_t_size 4 /* UID size */ + +/* Uid_t: + * This symbol holds the type used to declare user ids in the kernel. + * It can be int, ushort, uid_t, etc... It may be necessary to include + * to get any typedef'ed information. + */ +#define Uid_t uid_t /* UID type */ /* USE_64_BITS: - * This symbol, if defined, indicates that 64-bit interfaces should - * be used when available. If not defined, the native default interfaces + * This symbol, if defined, indicates that 64-bit integers should + * be used when available. If not defined, the native integers * will be used (be they 32 or 64 bits). */ +#ifndef USE_64_BITS /*#define USE_64_BITS /**/ +#endif + +/* USE_LARGE_FILES: + * This symbol, if defined, indicates that large file support + * should be used when available. The USE_64_BITS symbol will + * also be turned on if necessary. + */ +#ifndef USE_LARGE_FILES +/*#define USE_LARGE_FILES /**/ +#endif /* USE_LONG_DOUBLE: * This symbol, if defined, indicates that long doubles should * be used when available. */ +#ifndef USE_LONG_DOUBLE /*#define USE_LONG_DOUBLE /**/ +#endif + +/* USE_LONG_LONG: + * This symbol, if defined, indicates that long longs should + * be used when available. + */ +#ifndef USE_LONG_LONG +/*#define USE_LONG_LONG /**/ +#endif + +#ifndef USE_MORE_BITS +/*#define USE_MORE_BITS /**/ +#endif /* MULTIPLICITY: * This symbol, if defined, indicates that Perl should * be built to use multiplicity. */ +#ifndef MULTIPLICTY /*#define MULTIPLICITY /**/ +#endif /* USE_PERLIO: * This symbol, if defined, indicates that the PerlIO abstraction should * be used throughout. If not defined, stdio should be * used in a fully backward compatible manner. */ +#ifndef USE_PERLIO /*#define USE_PERLIO /**/ +#endif /* USE_SOCKS: * This symbol, if defined, indicates that Perl should * be built to use socks. */ +#ifndef USE_SOCKS /*#define USE_SOCKS /**/ +#endif -/* HAS_DRAND48_PROTO: - * This symbol, if defined, indicates that the system provides - * a prototype for the drand48() function. Otherwise, it is up - * to the program to supply one. A good guess is - * extern double drand48 _((void)); - */ -/*#define HAS_DRAND48_PROTO /**/ - -/* HAS_GETHOST_PROTOS: - * This symbol, if defined, indicates that includes - * prototypes for gethostent(), gethostbyname(), and - * gethostbyaddr(). Otherwise, it is up to the program to guess - * them. See netdbtype.U for probing for various Netdb_xxx_t types. - */ -#define HAS_GETHOST_PROTOS /**/ - -/* HAS_GETNET_PROTOS: - * This symbol, if defined, indicates that includes - * prototypes for getnetent(), getnetbyname(), and - * getnetbyaddr(). Otherwise, it is up to the program to guess - * them. See netdbtype.U for probing for various Netdb_xxx_t types. - */ -/*#define HAS_GETNET_PROTOS /**/ - -/* HAS_GETPROTO_PROTOS: - * This symbol, if defined, indicates that includes - * prototypes for getprotoent(), getprotobyname(), and - * getprotobyaddr(). Otherwise, it is up to the program to guess - * them. See netdbtype.U for probing for various Netdb_xxx_t types. - */ -#define HAS_GETPROTO_PROTOS /**/ - -/* HAS_GETSERV_PROTOS: - * This symbol, if defined, indicates that includes - * prototypes for getservent(), getservbyname(), and - * getservbyaddr(). Otherwise, it is up to the program to guess - * them. See netdbtype.U for probing for various Netdb_xxx_t types. - */ -#define HAS_GETSERV_PROTOS /**/ - -/* Netdb_host_t: - * This symbol holds the type used for the 1st argument - * to gethostbyaddr(). - */ -/* Netdb_hlen_t: - * This symbol holds the type used for the 2nd argument - * to gethostbyaddr(). - */ -/* Netdb_name_t: - * This symbol holds the type used for the argument to - * gethostbyname(). - */ -/* Netdb_net_t: - * This symbol holds the type used for the 1st argument to - * getnetbyaddr(). - */ -#define Netdb_host_t char * /**/ -#define Netdb_hlen_t int /**/ -#define Netdb_name_t char * /**/ -#define Netdb_net_t long /**/ - -/* Select_fd_set_t: - * This symbol holds the type used for the 2nd, 3rd, and 4th - * arguments to select. Usually, this is 'fd_set *', if HAS_FD_SET - * is defined, and 'int *' otherwise. This is only useful if you - * have select(), of course. - */ -#define Select_fd_set_t Perl_fd_set * /**/ - -/* ARCHNAME: - * This symbol holds a string representing the architecture name. - * It may be used to construct an architecture-dependant pathname - * where library files may be held under a private library, for - * instance. - */ -#define ARCHNAME "MSWin32-x86" /**/ - -/* OLD_PTHREAD_CREATE_JOINABLE: - * This symbol, if defined, indicates how to create pthread - * in joinable (aka undetached) state. NOTE: not defined - * if pthread.h already has defined PTHREAD_CREATE_JOINABLE - * (the new version of the constant). - * If defined, known values are PTHREAD_CREATE_UNDETACHED - * and __UNDETACHED. - */ -/*#define OLD_PTHREAD_CREATE_JOINABLE /**/ - -/* HAS_PTHREAD_YIELD: - * This symbol, if defined, indicates that the pthread_yield - * routine is available to yield the execution of the current - * thread. sched_yield is preferable to pthread_yield. - */ -/* SCHED_YIELD: - * This symbol defines the way to yield the execution of - * the current thread. Known ways are sched_yield, - * pthread_yield, and pthread_yield with NULL. - */ -/* HAS_SCHED_YIELD: - * This symbol, if defined, indicates that the sched_yield - * routine is available to yield the execution of the current - * thread. sched_yield is preferable to pthread_yield. - */ -/*#define HAS_PTHREAD_YIELD /**/ -#define SCHED_YIELD /**/ -/*#define HAS_SCHED_YIELD /**/ - -/* I_MACH_CTHREADS: - * This symbol, if defined, indicates to the C program that it should - * include . +/* USE_ITHREADS: + * This symbol, if defined, indicates that Perl should be built to + * use the interpreter-based threading implementation. */ -/*#define I_MACH_CTHREADS /**/ - -/* USE_THREADS: - * This symbol, if defined, indicates that Perl should - * be built to use threads. +/* USE_5005THREADS: + * This symbol, if defined, indicates that Perl should be built to + * use the 5.005-based threading implementation. */ /* OLD_PTHREADS_API: * This symbol, if defined, indicates that Perl should * be built to use the old draft POSIX threads API. */ -/*#define USE_THREADS /**/ +/*#define USE_5005THREADS /**/ +/*#define USE_ITHREADS /**/ +#if defined(USE_5005THREADS) && !defined(USE_ITHREADS) +#define USE_THREADS /* until src is revised*/ +#endif /*#define OLD_PTHREADS_API /**/ -/* Time_t: - * This symbol holds the type returned by time(). It can be long, - * or time_t on BSD sites (in which case should be - * included). - */ -#define Time_t time_t /* Time type */ - -/* HAS_TIMES: - * This symbol, if defined, indicates that the times() routine exists. - * Note that this became obsolete on some systems (SUNOS), which now - * use getrusage(). It may be necessary to include . - */ -#define HAS_TIMES /**/ - -/* Fpos_t: - * This symbol holds the type used to declare file positions in libc. - * It can be fpos_t, long, uint, etc... It may be necessary to include - * to get any typedef'ed information. - */ -#define Fpos_t fpos_t /* File position type */ - -/* Gid_t: - * This symbol holds the return type of getgid() and the type of - * argument to setrgid() and related functions. Typically, - * it is the type of group ids in the kernel. It can be int, ushort, - * uid_t, etc... It may be necessary to include to get - * any typedef'ed information. - */ -#define Gid_t gid_t /* Type for getgid(), etc... */ - -/* Off_t: - * This symbol holds the type used to declare offsets in the kernel. - * It can be int, long, off_t, etc... It may be necessary to include - * to get any typedef'ed information. - */ -/* LSEEKSIZE: - * This symbol holds the number of bytes used by the Off_t. - */ -#define Off_t off_t /* type */ -#define LSEEKSIZE 4 /* size */ - -/* Mode_t: - * This symbol holds the type used to declare file modes - * for systems calls. It is usually mode_t, but may be - * int or unsigned short. It may be necessary to include - * to get any typedef'ed information. - */ -#define Mode_t mode_t /* file mode parameter for system calls */ - -/* Pid_t: - * This symbol holds the type used to declare process ids in the kernel. - * It can be int, uint, pid_t, etc... It may be necessary to include - * to get any typedef'ed information. - */ -#define Pid_t int /* PID type */ - -/* Size_t: - * This symbol holds the type used to declare length parameters - * for string functions. It is usually size_t, but may be - * unsigned long, int, etc. It may be necessary to include - * to get any typedef'ed information. +/* PERL_VENDORLIB_EXP: + * This symbol contains the ~name expanded version of VENDORLIB, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define Size_t size_t /* length paramater for string functions */ +/*#define PERL_VENDORLIB_EXP "" /**/ -/* Uid_t: - * This symbol holds the type used to declare user ids in the kernel. - * It can be int, ushort, uid_t, etc... It may be necessary to include - * to get any typedef'ed information. +/* VOIDFLAGS: + * This symbol indicates how much support of the void type is given by this + * compiler. What various bits mean: + * + * 1 = supports declaration of void + * 2 = supports arrays of pointers to functions returning void + * 4 = supports comparisons between pointers to void functions and + * addresses of void functions + * 8 = suports declaration of generic void pointers + * + * The package designer should define VOIDUSED to indicate the requirements + * of the package. This can be done either by #defining VOIDUSED before + * including config.h, or by defining defvoidused in Myinit.U. If the + * latter approach is taken, only those flags will be tested. If the + * level of void support necessary is not present, defines void to int. */ -#define Uid_t uid_t /* UID type */ +#ifndef VOIDUSED +#define VOIDUSED 15 +#endif +#define VOIDFLAGS 15 +#if (VOIDFLAGS & VOIDUSED) != VOIDUSED +#define void int /* is void to be avoided? */ +#define M_VOID /* Xenix strikes again */ +#endif #endif diff --git a/win32/config_H.gc b/win32/config_H.gc index e0101f1..9575e43 100644 --- a/win32/config_H.gc +++ b/win32/config_H.gc @@ -13,7 +13,7 @@ /* * Package name : perl5 * Source directory : - * Configuration time: undef + * Configuration time: Tue Jan 18 21:02:23 2000 * Configured by : gsar * Target system : */ @@ -273,7 +273,7 @@ * This symbol, if defined, indicates that the link routine is * available to create hard links. */ -/*#define HAS_LINK /**/ +#define HAS_LINK /**/ /* HAS_LOCALECONV: * This symbol, if defined, indicates that the localeconv routine is @@ -358,18 +358,6 @@ */ #define HAS_MKTIME /**/ -/* HAS_MSYNC: - * This symbol, if defined, indicates that the msync system call is - * available to synchronize a mapped file. - */ -/*#define HAS_MSYNC /**/ - -/* HAS_MUNMAP: - * This symbol, if defined, indicates that the munmap system call is - * available to unmap a region, usually mapped by mmap(). - */ -/*#define HAS_MUNMAP /**/ - /* HAS_NICE: * This symbol, if defined, indicates that the nice routine is * available. @@ -668,7 +656,7 @@ * This symbol, if defined, indicates that the tzname[] array is * available to access timezone names. */ -/*#define HAS_TZNAME /**/ +#define HAS_TZNAME /**/ /* HAS_UMASK: * This symbol, if defined, indicates that the umask routine is @@ -992,30 +980,6 @@ */ #define STDCHAR char /**/ -/* HAS_ACCESSX: - * This symbol, if defined, indicates that the accessx routine is - * available to do extended access checks. - */ -/*#define HAS_ACCESSX /**/ - -/* HAS_EACCESS: - * This symbol, if defined, indicates that the eaccess routine is - * available to do extended access checks. - */ -/*#define HAS_EACCESS /**/ - -/* I_SYS_ACCESS: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -/*#define I_SYS_ACCESS /**/ - -/* I_SYS_SECURITY: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -/*#define I_SYS_SECURITY /**/ - /* CROSSCOMPILE: * This symbol, if defined, signifies that we our * build process is a cross-compilation. @@ -1047,6 +1011,53 @@ */ /*#define MULTIARCH /**/ +/* HAS_QUAD: + * This symbol, if defined, tells that there's a 64-bit integer type, + * Quad_t, and its unsigned counterpar, Uquad_t. QUADKIND will be one + * of QUAD_IS_INT, QUAD_IS_LONG, QUAD_IS_LONG_LONG, or QUAD_IS_INT64_T. + */ +/*#define HAS_QUAD /**/ +#ifdef HAS_QUAD +# define Quad_t long long /**/ +# define Uquad_t unsigned long long /**/ +# define QUADKIND undef /**/ +# define QUAD_IS_INT 1 +# define QUAD_IS_LONG 2 +# define QUAD_IS_LONG_LONG 3 +# define QUAD_IS_INT64_T 4 +#endif + +/* HAS_ACCESSX: + * This symbol, if defined, indicates that the accessx routine is + * available to do extended access checks. + */ +/*#define HAS_ACCESSX /**/ + +/* HAS_EACCESS: + * This symbol, if defined, indicates that the eaccess routine is + * available to do extended access checks. + */ +/*#define HAS_EACCESS /**/ + +/* I_SYS_ACCESS: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +/*#define I_SYS_ACCESS /**/ + +/* I_SYS_SECURITY: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +/*#define I_SYS_SECURITY /**/ + +/* OSNAME: + * This symbol contains the name of the operating system, as determined + * by Configure. You shouldn't rely on it too much; the specific + * feature tests from Configure are generally more reliable. + */ +#define OSNAME "MSWin32" /**/ + /* MEM_ALIGNBYTES: * This symbol contains the number of bytes required to align a * double. Usual values are 2, 4 and 8. The default is eight, @@ -1058,6 +1069,61 @@ #define MEM_ALIGNBYTES 8 #endif +/* ARCHLIB: + * This variable, if defined, holds the name of the directory in + * which the user wants to put architecture-dependent public + * library files for perl5. It is most often a local directory + * such as /usr/local/lib. Programs using this variable must be + * prepared to deal with filename expansion. If ARCHLIB is the + * same as PRIVLIB, it is not defined, since presumably the + * program already searches PRIVLIB. + */ +/* ARCHLIB_EXP: + * This symbol contains the ~name expanded version of ARCHLIB, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. + */ +#define ARCHLIB "c:\\perl\\5.5.640\\lib\\MSWin32-x86" /**/ +/*#define ARCHLIB_EXP "" /**/ + +/* ARCHNAME: + * This symbol holds a string representing the architecture name. + * It may be used to construct an architecture-dependant pathname + * where library files may be held under a private library, for + * instance. + */ +#define ARCHNAME "MSWin32-x86" /**/ + +/* HAS_ATOLF: + * This symbol, if defined, indicates that the atolf routine is + * available to convert strings into long doubles. + */ +/*#define HAS_ATOLF /**/ + +/* HAS_ATOLL: + * This symbol, if defined, indicates that the atoll routine is + * available to convert strings into long longs. + */ +/*#define HAS_ATOLL /**/ + +/* BIN: + * This symbol holds the path of the bin directory where the package will + * be installed. Program must be prepared to deal with ~name substitution. + */ +/* BIN_EXP: + * This symbol is the filename expanded version of the BIN symbol, for + * programs that do not want to deal with that at run-time. + */ +#define BIN "c:\\perl\\5.5.640\\bin\\MSWin32-x86" /**/ +#define BIN_EXP "c:\\perl\\5.5.640\\bin\\MSWin32-x86" /**/ + +/* PERL_BINCOMPAT_5005: + * This symbol, if defined, indicates that Perl 5.006 should be + * binary-compatible with Perl 5.005. This is impossible for builds + * that use features like threads and multiplicity it is always undef + * for those versions. + */ +/*#define PERL_BINCOMPAT_5005 /**/ + /* BYTEORDER: * This symbol holds the hexadecimal constant defined in byteorder, * i.e. 0x1234 or 0x4321, etc... @@ -1101,6 +1167,58 @@ #define BYTEORDER 0x1234 /* large digits for MSB */ #endif /* NeXT */ +/* CAT2: + * This macro catenates 2 tokens together. + */ +/* STRINGIFY: + * This macro surrounds its token with double quotes. + */ +#if 42 == 1 +#define CAT2(a,b)a/**/b +#define STRINGIFY(a)"a" + /* If you can get stringification with catify, tell me how! */ +#endif +#if 42 == 42 +#define CAT2(a,b)a ## b +#define StGiFy(a)# a +#define STRINGIFY(a)StGiFy(a) +#endif +#if 42 != 1 && 42 != 42 +#include "Bletch: How does this C preprocessor catenate tokens?" +#endif + +/* CPPSTDIN: + * This symbol contains the first part of the string which will invoke + * the C preprocessor on the standard input and produce to standard + * output. Typical value of "cc -E" or "/lib/cpp", but it can also + * call a wrapper. See CPPRUN. + */ +/* CPPMINUS: + * This symbol contains the second part of the string which will invoke + * the C preprocessor on the standard input and produce to standard + * output. This symbol will have the value "-" if CPPSTDIN needs a minus + * to specify standard input, otherwise the value is "". + */ +/* CPPRUN: + * This symbol contains the string which will invoke a C preprocessor on + * the standard input and produce to standard output. It needs to end + * with CPPLAST, after all other preprocessor flags have been specified. + * The main difference with CPPSTDIN is that this program will never be a + * pointer to a shell wrapper, i.e. it will be empty if no preprocessor is + * available directly to the user. Note that it may well be different from + * the preprocessor used to compile the C program. + */ +#define CPPSTDIN "gcc -E" +#define CPPMINUS "-" +#define CPPRUN "gcc -E" + +/* HAS_ACCESS: + * This manifest constant lets the C program know that the access() + * system call is available to check for accessibility using real UID/GID. + * (always present on UNIX.) + */ +#define HAS_ACCESS /**/ + /* CASTI32: * This symbol is defined if the C compiler can cast negative * or large floating point numbers to 32-bit ints. @@ -1128,12 +1246,104 @@ */ /*#define VOID_CLOSEDIR /**/ +/* HAS_CSH: + * This symbol, if defined, indicates that the C-shell exists. + */ +/* CSH: + * This symbol, if defined, contains the full pathname of csh. + */ +/*#define HAS_CSH /**/ +#ifdef HAS_CSH +#define CSH "" /**/ +#endif + +/* DLSYM_NEEDS_UNDERSCORE: + * This symbol, if defined, indicates that we need to prepend an + * underscore to the symbol name before calling dlsym(). This only + * makes sense if you *have* dlsym, which we will presume is the + * case if you're using dl_dlopen.xs. + */ +/*#define DLSYM_NEEDS_UNDERSCORE /**/ + +/* HAS_DRAND48_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the drand48() function. Otherwise, it is up + * to the program to supply one. A good guess is + * extern double drand48 _((void)); + */ +/*#define HAS_DRAND48_PROTO /**/ + +/* HAS_ENDGRENT: + * This symbol, if defined, indicates that the getgrent routine is + * available for finalizing sequential access of the group database. + */ +/*#define HAS_ENDGRENT /**/ + +/* HAS_ENDHOSTENT: + * This symbol, if defined, indicates that the endhostent() routine is + * available to close whatever was being used for host queries. + */ +/*#define HAS_ENDHOSTENT /**/ + +/* HAS_ENDNETENT: + * This symbol, if defined, indicates that the endnetent() routine is + * available to close whatever was being used for network queries. + */ +/*#define HAS_ENDNETENT /**/ + +/* HAS_ENDPROTOENT: + * This symbol, if defined, indicates that the endprotoent() routine is + * available to close whatever was being used for protocol queries. + */ +/*#define HAS_ENDPROTOENT /**/ + +/* HAS_ENDPWENT: + * This symbol, if defined, indicates that the getgrent routine is + * available for finalizing sequential access of the passwd database. + */ +/*#define HAS_ENDPWENT /**/ + +/* HAS_ENDSERVENT: + * This symbol, if defined, indicates that the endservent() routine is + * available to close whatever was being used for service queries. + */ +/*#define HAS_ENDSERVENT /**/ + +/* HAS_ENDSPENT: + * This symbol, if defined, indicates that the endspent system call is + * available to finalize the scan of SysV shadow password entries. + */ +/*#define HAS_ENDSPENT /**/ + /* HAS_FD_SET: * This symbol, when defined, indicates presence of the fd_set typedef * in */ #define HAS_FD_SET /**/ +/* HAS_STRUCT_FS_DATA: + * This symbol, if defined, indicates that the struct fs_data + * to do statfs() is supported. + */ +/*#define HAS_STRUCT_FS_DATA /**/ + +/* HAS_FSEEKO: + * This symbol, if defined, indicates that the fseeko routine is + * available to fseek beyond 32 bits (useful for ILP32 hosts). + */ +/*#define HAS_FSEEKO /**/ + +/* HAS_FSTATFS: + * This symbol, if defined, indicates that the fstatfs routine is + * available to stat filesystems by file descriptors. + */ +/*#define HAS_FSTATFS /**/ +/* HAS_FTELLO: + * This symbol, if defined, indicates that the ftello routine is + * available to ftell beyond 32 bits (useful for ILP32 hosts). + */ +/*#define HAS_FTELLO /**/ + /* Gconvert: * This preprocessor macro is defined to convert a floating point * number to a string without a trailing decimal point. This @@ -1151,451 +1361,6 @@ */ #define Gconvert(x,n,t,b) sprintf((b),"%.*g",(n),(x)) -/* HAS_GNULIBC: - * This symbol, if defined, indicates to the C program that - * the GNU C library is being used. - */ -/*#define HAS_GNULIBC /**/ -/* HAS_ISASCII: - * This manifest constant lets the C program know that isascii - * is available. - */ -#define HAS_ISASCII /**/ - -/* HAS_LCHOWN: - * This symbol, if defined, indicates that the lchown routine is - * available to operate on a symbolic link (instead of following the - * link). - */ -/*#define HAS_LCHOWN /**/ - -/* HAS_OPEN3: - * This manifest constant lets the C program know that the three - * argument form of open(2) is available. - */ -/*#define HAS_OPEN3 /**/ - -/* HAS_SAFE_BCOPY: - * This symbol, if defined, indicates that the bcopy routine is available - * to copy potentially overlapping memory blocks. Otherwise you should - * probably use memmove() or memcpy(). If neither is defined, roll your - * own version. - */ -/*#define HAS_SAFE_BCOPY /**/ - -/* HAS_SAFE_MEMCPY: - * This symbol, if defined, indicates that the memcpy routine is available - * to copy potentially overlapping memory blocks. Otherwise you should - * probably use memmove() or memcpy(). If neither is defined, roll your - * own version. - */ -/*#define HAS_SAFE_MEMCPY /**/ - -/* HAS_SANE_MEMCMP: - * This symbol, if defined, indicates that the memcmp routine is available - * and can be used to compare relative magnitudes of chars with their high - * bits set. If it is not defined, roll your own version. - */ -#define HAS_SANE_MEMCMP /**/ - -/* HAS_SIGACTION: - * This symbol, if defined, indicates that Vr4's sigaction() routine - * is available. - */ -/*#define HAS_SIGACTION /**/ - -/* HAS_SIGSETJMP: - * This variable indicates to the C program that the sigsetjmp() - * routine is available to save the calling process's registers - * and stack environment for later use by siglongjmp(), and - * to optionally save the process's signal mask. See - * Sigjmp_buf, Sigsetjmp, and Siglongjmp. - */ -/* Sigjmp_buf: - * This is the buffer type to be used with Sigsetjmp and Siglongjmp. - */ -/* Sigsetjmp: - * This macro is used in the same way as sigsetjmp(), but will invoke - * traditional setjmp() if sigsetjmp isn't available. - * See HAS_SIGSETJMP. - */ -/* Siglongjmp: - * This macro is used in the same way as siglongjmp(), but will invoke - * traditional longjmp() if siglongjmp isn't available. - * See HAS_SIGSETJMP. - */ -/*#define HAS_SIGSETJMP /**/ -#ifdef HAS_SIGSETJMP -#define Sigjmp_buf sigjmp_buf -#define Sigsetjmp(buf,save_mask) sigsetjmp((buf),(save_mask)) -#define Siglongjmp(buf,retval) siglongjmp((buf),(retval)) -#else -#define Sigjmp_buf jmp_buf -#define Sigsetjmp(buf,save_mask) setjmp((buf)) -#define Siglongjmp(buf,retval) longjmp((buf),(retval)) -#endif - -/* USE_STDIO_PTR: - * This symbol is defined if the _ptr and _cnt fields (or similar) - * of the stdio FILE structure can be used to access the stdio buffer - * for a file handle. If this is defined, then the FILE_ptr(fp) - * and FILE_cnt(fp) macros will also be defined and should be used - * to access these fields. - */ -/* FILE_ptr: - * This macro is used to access the _ptr field (or equivalent) of the - * FILE structure pointed to by its argument. This macro will always be - * defined if USE_STDIO_PTR is defined. - */ -/* STDIO_PTR_LVALUE: - * This symbol is defined if the FILE_ptr macro can be used as an - * lvalue. - */ -/* FILE_cnt: - * This macro is used to access the _cnt field (or equivalent) of the - * FILE structure pointed to by its argument. This macro will always be - * defined if USE_STDIO_PTR is defined. - */ -/* STDIO_CNT_LVALUE: - * This symbol is defined if the FILE_cnt macro can be used as an - * lvalue. - */ -/*#define USE_STDIO_PTR /**/ -#ifdef USE_STDIO_PTR -#define FILE_ptr(fp) ((fp)->_ptr) -#define STDIO_PTR_LVALUE /**/ -#define FILE_cnt(fp) ((fp)->_cnt) -#define STDIO_CNT_LVALUE /**/ -#endif - -/* USE_STDIO_BASE: - * This symbol is defined if the _base field (or similar) of the - * stdio FILE structure can be used to access the stdio buffer for - * a file handle. If this is defined, then the FILE_base(fp) macro - * will also be defined and should be used to access this field. - * Also, the FILE_bufsiz(fp) macro will be defined and should be used - * to determine the number of bytes in the buffer. USE_STDIO_BASE - * will never be defined unless USE_STDIO_PTR is. - */ -/* FILE_base: - * This macro is used to access the _base field (or equivalent) of the - * FILE structure pointed to by its argument. This macro will always be - * defined if USE_STDIO_BASE is defined. - */ -/* FILE_bufsiz: - * This macro is used to determine the number of bytes in the I/O - * buffer pointed to by _base field (or equivalent) of the FILE - * structure pointed to its argument. This macro will always be defined - * if USE_STDIO_BASE is defined. - */ -/*#define USE_STDIO_BASE /**/ -#ifdef USE_STDIO_BASE -#define FILE_base(fp) ((fp)->_base) -#define FILE_bufsiz(fp) ((fp)->_cnt + (fp)->_ptr - (fp)->_base) -#endif - -/* HAS_VPRINTF: - * This symbol, if defined, indicates that the vprintf routine is available - * to printf with a pointer to an argument list. If unavailable, you - * may need to write your own, probably in terms of _doprnt(). - */ -/* USE_CHAR_VSPRINTF: - * This symbol is defined if this system has vsprintf() returning type - * (char*). The trend seems to be to declare it as "int vsprintf()". It - * is up to the package author to declare vsprintf correctly based on the - * symbol. - */ -#define HAS_VPRINTF /**/ -/*#define USE_CHAR_VSPRINTF /**/ - -/* DOUBLESIZE: - * This symbol contains the size of a double, so that the C preprocessor - * can make decisions based on it. - */ -#define DOUBLESIZE 8 /**/ - -/* I_TIME: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -/* I_SYS_TIME: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -/* I_SYS_TIME_KERNEL: - * This symbol, if defined, indicates to the C program that it should - * include with KERNEL defined. - */ -#define I_TIME /**/ -/*#define I_SYS_TIME /**/ -/*#define I_SYS_TIME_KERNEL /**/ - -/* VAL_O_NONBLOCK: - * This symbol is to be used during open() or fcntl(F_SETFL) to turn on - * non-blocking I/O for the file descriptor. Note that there is no way - * back, i.e. you cannot turn it blocking again this way. If you wish to - * alternatively switch between blocking and non-blocking, use the - * ioctl(FIOSNBIO) call instead, but that is not supported by all devices. - */ -/* VAL_EAGAIN: - * This symbol holds the errno error code set by read() when no data was - * present on the non-blocking file descriptor. - */ -/* RD_NODATA: - * This symbol holds the return code from read() when no data is present - * on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is - * not defined, then you can't distinguish between no data and EOF by - * issuing a read(). You'll have to find another way to tell for sure! - */ -/* EOF_NONBLOCK: - * This symbol, if defined, indicates to the C program that a read() on - * a non-blocking file descriptor will return 0 on EOF, and not the value - * held in RD_NODATA (-1 usually, in that case!). - */ -#define VAL_O_NONBLOCK O_NONBLOCK -#define VAL_EAGAIN EAGAIN -#define RD_NODATA -1 -#define EOF_NONBLOCK - -/* PTRSIZE: - * This symbol contains the size of a pointer, so that the C preprocessor - * can make decisions based on it. It will be sizeof(void *) if - * the compiler supports (void *); otherwise it will be - * sizeof(char *). - */ -#define PTRSIZE 4 /**/ - -/* Drand01: - * This macro is to be used to generate uniformly distributed - * random numbers over the range [0., 1.[. You may have to supply - * an 'extern double drand48();' in your program since SunOS 4.1.3 - * doesn't provide you with anything relevant in it's headers. - * See HAS_DRAND48_PROTO. - */ -/* Rand_seed_t: - * This symbol defines the type of the argument of the - * random seed function. - */ -/* seedDrand01: - * This symbol defines the macro to be used in seeding the - * random number generator (see Drand01). - */ -/* RANDBITS: - * This symbol indicates how many bits are produced by the - * function used to generate normalized random numbers. - * Values include 15, 16, 31, and 48. - */ -#define Drand01() (rand()/(double)((unsigned)1< or - * to get any typedef'ed information. - * We will pick a type such that sizeof(SSize_t) == sizeof(Size_t). - */ -#define SSize_t int /* signed count of bytes */ - -/* EBCDIC: - * This symbol, if defined, indicates that this system uses - * EBCDIC encoding. - */ -/*#define EBCDIC /**/ - -/* ARCHLIB: - * This variable, if defined, holds the name of the directory in - * which the user wants to put architecture-dependent public - * library files for perl5. It is most often a local directory - * such as /usr/local/lib. Programs using this variable must be - * prepared to deal with filename expansion. If ARCHLIB is the - * same as PRIVLIB, it is not defined, since presumably the - * program already searches PRIVLIB. - */ -/* ARCHLIB_EXP: - * This symbol contains the ~name expanded version of ARCHLIB, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -#define ARCHLIB "c:\\perl\\5.00561\\lib\\MSWin32-x86" /**/ -/*#define ARCHLIB_EXP "" /**/ - -/* BIN: - * This symbol holds the path of the bin directory where the package will - * be installed. Program must be prepared to deal with ~name substitution. - */ -/* BIN_EXP: - * This symbol is the filename expanded version of the BIN symbol, for - * programs that do not want to deal with that at run-time. - */ -#define BIN "c:\\perl\\5.00561\\bin\\MSWin32-x86" /**/ -#define BIN_EXP "c:\\perl\\5.00561\\bin\\MSWin32-x86" /**/ - -/* INSTALL_USR_BIN_PERL: - * This symbol, if defined, indicates that Perl is to be installed - * also as /usr/bin/perl. - */ -/*#define INSTALL_USR_BIN_PERL /**/ - -/* PRIVLIB: - * This symbol contains the name of the private library for this package. - * The library is private in the sense that it needn't be in anyone's - * execution path, but it should be accessible by the world. The program - * should be prepared to do ~ expansion. - */ -/* PRIVLIB_EXP: - * This symbol contains the ~name expanded version of PRIVLIB, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -#define PRIVLIB "c:\\perl\\5.00561\\lib" /**/ -#define PRIVLIB_EXP (win32_get_privlib("5.00561")) /**/ - -/* SITEARCH: - * This symbol contains the name of the private library for this package. - * The library is private in the sense that it needn't be in anyone's - * execution path, but it should be accessible by the world. The program - * should be prepared to do ~ expansion. - * The standard distribution will put nothing in this directory. - * Individual sites may place their own extensions and modules in - * this directory. - */ -/* SITEARCH_EXP: - * This symbol contains the ~name expanded version of SITEARCH, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -#define SITEARCH "c:\\perl\\site\\5.00561\\lib\\MSWin32-x86" /**/ -/*#define SITEARCH_EXP "" /**/ - -/* SITELIB: - * This symbol contains the name of the private library for this package. - * The library is private in the sense that it needn't be in anyone's - * execution path, but it should be accessible by the world. The program - * should be prepared to do ~ expansion. - * The standard distribution will put nothing in this directory. - * Individual sites may place their own extensions and modules in - * this directory. - */ -/* SITELIB_EXP: - * This symbol contains the ~name expanded version of SITELIB, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -#define SITELIB "c:\\perl\\site\\5.00561\\lib" /**/ -#define SITELIB_EXP (win32_get_sitelib("5.00561")) /**/ - -/* PERL_VENDORLIB_EXP: - * This symbol contains the ~name expanded version of VENDORLIB, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -/*#define PERL_VENDORLIB_EXP "undef" /**/ - -/* OSNAME: - * This symbol contains the name of the operating system, as determined - * by Configure. You shouldn't rely on it too much; the specific - * feature tests from Configure are generally more reliable. - */ -#define OSNAME "MSWin32" /**/ - -/* CAT2: - * This macro catenates 2 tokens together. - */ -/* STRINGIFY: - * This macro surrounds its token with double quotes. - */ -#if 42 == 1 -#define CAT2(a,b)a/**/b -#define STRINGIFY(a)"a" - /* If you can get stringification with catify, tell me how! */ -#endif -#if 42 == 42 -#define CAT2(a,b)a ## b -#define StGiFy(a)# a -#define STRINGIFY(a)StGiFy(a) -#endif -#if 42 != 1 && 42 != 42 -#include "Bletch: How does this C preprocessor catenate tokens?" -#endif - -/* CPPSTDIN: - * This symbol contains the first part of the string which will invoke - * the C preprocessor on the standard input and produce to standard - * output. Typical value of "cc -E" or "/lib/cpp", but it can also - * call a wrapper. See CPPRUN. - */ -/* CPPMINUS: - * This symbol contains the second part of the string which will invoke - * the C preprocessor on the standard input and produce to standard - * output. This symbol will have the value "-" if CPPSTDIN needs a minus - * to specify standard input, otherwise the value is "". - */ -/* CPPRUN: - * This symbol contains the string which will invoke a C preprocessor on - * the standard input and produce to standard output. It needs to end - * with CPPLAST, after all other preprocessor flags have been specified. - * The main difference with CPPSTDIN is that this program will never be a - * pointer to a shell wrapper, i.e. it will be empty if no preprocessor is - * available directly to the user. Note that it may well be different from - * the preprocessor used to compile the C program. - */ -#define CPPSTDIN "gcc -E" -#define CPPMINUS "-" -#define CPPRUN "gcc -E" - -/* HAS_ACCESS: - * This manifest constant lets the C program know that the access() - * system call is available to check for accessibility using real UID/GID. - * (always present on UNIX.) - */ -#define HAS_ACCESS /**/ - -/* HAS_CSH: - * This symbol, if defined, indicates that the C-shell exists. - */ -/* CSH: - * This symbol, if defined, contains the full pathname of csh. - */ -/*#define HAS_CSH /**/ -#ifdef HAS_CSH -#define CSH "" /**/ -#endif - -/* HAS_ENDGRENT: - * This symbol, if defined, indicates that the getgrent routine is - * available for finalizing sequential access of the group database. - */ -/*#define HAS_ENDGRENT /**/ - -/* HAS_ENDHOSTENT: - * This symbol, if defined, indicates that the endhostent() routine is - * available to close whatever was being used for host queries. - */ -/*#define HAS_ENDHOSTENT /**/ - -/* HAS_ENDNETENT: - * This symbol, if defined, indicates that the endnetent() routine is - * available to close whatever was being used for network queries. - */ -/*#define HAS_ENDNETENT /**/ - -/* HAS_ENDPROTOENT: - * This symbol, if defined, indicates that the endprotoent() routine is - * available to close whatever was being used for protocol queries. - */ -/*#define HAS_ENDPROTOENT /**/ - -/* HAS_ENDPWENT: - * This symbol, if defined, indicates that the getgrent routine is - * available for finalizing sequential access of the passwd database. - */ -/*#define HAS_ENDPWENT /**/ - -/* HAS_ENDSERVENT: - * This symbol, if defined, indicates that the endservent() routine is - * available to close whatever was being used for service queries. - */ -/*#define HAS_ENDSERVENT /**/ - /* HAS_GETGRENT: * This symbol, if defined, indicates that the getgrent routine is * available for sequential access of the group database. @@ -1644,6 +1409,26 @@ #define PHOSTNAME "" /* How to get the host name */ #endif +/* HAS_GETHOST_PROTOS: + * This symbol, if defined, indicates that includes + * prototypes for gethostent(), gethostbyname(), and + * gethostbyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +#define HAS_GETHOST_PROTOS /**/ + +/* HAS_GETMNT: + * This symbol, if defined, indicates that the getmnt routine is + * available to get filesystem mount info by filename. + */ +/*#define HAS_GETMNT /**/ + +/* HAS_GETMNTENT: + * This symbol, if defined, indicates that the getmntent routine is + * available to iterate through mounted file systems to get their info. + */ +/*#define HAS_GETMNTENT /**/ + /* HAS_GETNETBYADDR: * This symbol, if defined, indicates that the getnetbyaddr() routine is * available to look up networks by their IP addresses. @@ -1662,6 +1447,14 @@ */ /*#define HAS_GETNETENT /**/ +/* HAS_GETNET_PROTOS: + * This symbol, if defined, indicates that includes + * prototypes for getnetent(), getnetbyname(), and + * getnetbyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +/*#define HAS_GETNET_PROTOS /**/ + /* HAS_GETPROTOENT: * This symbol, if defined, indicates that the getprotoent() routine is * available to look up protocols in some data base or another. @@ -1679,6 +1472,14 @@ #define HAS_GETPROTOBYNAME /**/ #define HAS_GETPROTOBYNUMBER /**/ +/* HAS_GETPROTO_PROTOS: + * This symbol, if defined, indicates that includes + * prototypes for getprotoent(), getprotobyname(), and + * getprotobyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +#define HAS_GETPROTO_PROTOS /**/ + /* HAS_GETPWENT: * This symbol, if defined, indicates that the getpwent routine is * available for sequential access of the passwd database. @@ -1692,6 +1493,26 @@ */ /*#define HAS_GETSERVENT /**/ +/* HAS_GETSERV_PROTOS: + * This symbol, if defined, indicates that includes + * prototypes for getservent(), getservbyname(), and + * getservbyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +#define HAS_GETSERV_PROTOS /**/ + +/* HAS_GETSPENT: + * This symbol, if defined, indicates that the getspent system call is + * available to retrieve SysV shadow password entries sequentially. + */ +/*#define HAS_GETSPENT /**/ + +/* HAS_GETSPNAM: + * This symbol, if defined, indicates that the getspnam system call is + * available to retrieve SysV shadow password entries by name. + */ +/*#define HAS_GETSPNAM /**/ + /* HAS_GETSERVBYNAME: * This symbol, if defined, indicates that the getservbyname() * routine is available to look up services by their name. @@ -1703,6 +1524,17 @@ #define HAS_GETSERVBYNAME /**/ #define HAS_GETSERVBYPORT /**/ +/* HAS_GNULIBC: + * This symbol, if defined, indicates to the C program that + * the GNU C library is being used. + */ +/*#define HAS_GNULIBC /**/ +/* HAS_HASMNTOPT: + * This symbol, if defined, indicates that the hasmntopt routine is + * available to query the mount options of file systems. + */ +/*#define HAS_HASMNTOPT /**/ + /* HAS_HTONL: * This symbol, if defined, indicates that the htonl() routine (and * friends htons() ntohl() ntohs()) are available to do network @@ -1728,6 +1560,27 @@ #define HAS_NTOHL /**/ #define HAS_NTOHS /**/ +/* HAS_ISASCII: + * This manifest constant lets the C program know that isascii + * is available. + */ +#define HAS_ISASCII /**/ + +/* HAS_LCHOWN: + * This symbol, if defined, indicates that the lchown routine is + * available to operate on a symbolic link (instead of following the + * link). + */ +/*#define HAS_LCHOWN /**/ + +/* HAS_LDBL_DIG: + * This symbol, if defined, indicates that this system's + * or defines the symbol LDBL_DIG, which is the number + * of significant digits in a long double precision number. Unlike + * for DBL_DIG, there's no good guess for LDBL_DIG if it is undefined. + */ +#define HAS_LDBL_DIG /**/ + /* HAS_LONG_DOUBLE: * This symbol will be defined if the C compiler supports long * doubles. @@ -1750,34 +1603,80 @@ * C preprocessor can make decisions based on it. It is only * defined if the system supports long long. */ -/*#define HAS_LONG_LONG /**/ -#ifdef HAS_LONG_LONG -#define LONGLONGSIZE 8 /**/ -#endif - -/* HAS_MEMCHR: - * This symbol, if defined, indicates that the memchr routine is available - * to locate characters within a C string. +/*#define HAS_LONG_LONG /**/ +#ifdef HAS_LONG_LONG +#define LONGLONGSIZE 8 /**/ +#endif + +/* HAS_MEMCHR: + * This symbol, if defined, indicates that the memchr routine is available + * to locate characters within a C string. + */ +#define HAS_MEMCHR /**/ + +/* HAS_MSG: + * This symbol, if defined, indicates that the entire msg*(2) library is + * supported (IPC mechanism based on message queues). + */ +/*#define HAS_MSG /**/ + +/* HAS_OPEN3: + * This manifest constant lets the C program know that the three + * argument form of open(2) is available. + */ +/*#define HAS_OPEN3 /**/ + +/* OLD_PTHREAD_CREATE_JOINABLE: + * This symbol, if defined, indicates how to create pthread + * in joinable (aka undetached) state. NOTE: not defined + * if pthread.h already has defined PTHREAD_CREATE_JOINABLE + * (the new version of the constant). + * If defined, known values are PTHREAD_CREATE_UNDETACHED + * and __UNDETACHED. + */ +/*#define OLD_PTHREAD_CREATE_JOINABLE /**/ + +/* HAS_PTHREAD_YIELD: + * This symbol, if defined, indicates that the pthread_yield + * routine is available to yield the execution of the current + * thread. sched_yield is preferable to pthread_yield. + */ +/* SCHED_YIELD: + * This symbol defines the way to yield the execution of + * the current thread. Known ways are sched_yield, + * pthread_yield, and pthread_yield with NULL. + */ +/* HAS_SCHED_YIELD: + * This symbol, if defined, indicates that the sched_yield + * routine is available to yield the execution of the current + * thread. sched_yield is preferable to pthread_yield. */ -/*#define HAS_MEMCHR /**/ +/*#define HAS_PTHREAD_YIELD /**/ +#define SCHED_YIELD /**/ +/*#define HAS_SCHED_YIELD /**/ -/* HAS_MMAP: - * This symbol, if defined, indicates that the mmap system call is - * available to map a file into memory. +/* HAS_SAFE_BCOPY: + * This symbol, if defined, indicates that the bcopy routine is available + * to copy potentially overlapping memory blocks. Otherwise you should + * probably use memmove() or memcpy(). If neither is defined, roll your + * own version. */ -/* Mmap_t: - * This symbol holds the return type of the mmap() system call - * (and simultaneously the type of the first argument). - * Usually set to 'void *' or 'cadd_t'. +/*#define HAS_SAFE_BCOPY /**/ + +/* HAS_SAFE_MEMCPY: + * This symbol, if defined, indicates that the memcpy routine is available + * to copy potentially overlapping memory blocks. Otherwise you should + * probably use memmove() or memcpy(). If neither is defined, roll your + * own version. */ -/*#define HAS_MMAP /**/ -#define Mmap_t void * /**/ +/*#define HAS_SAFE_MEMCPY /**/ -/* HAS_MSG: - * This symbol, if defined, indicates that the entire msg*(2) library is - * supported (IPC mechanism based on message queues). +/* HAS_SANE_MEMCMP: + * This symbol, if defined, indicates that the memcmp routine is available + * and can be used to compare relative magnitudes of chars with their high + * bits set. If it is not defined, roll your own version. */ -/*#define HAS_MSG /**/ +#define HAS_SANE_MEMCMP /**/ /* HAS_SEM: * This symbol, if defined, indicates that the entire sem*(2) library is @@ -1828,6 +1727,12 @@ */ /*#define HAS_SETSERVENT /**/ +/* HAS_SETSPENT: + * This symbol, if defined, indicates that the setspent system call is + * available to initialize the scan of SysV shadow password entries. + */ +/*#define HAS_SETSPENT /**/ + /* HAS_SETVBUF: * This symbol, if defined, indicates that the setvbuf routine is * available to change buffering on an open stdio stream. @@ -1835,12 +1740,55 @@ */ #define HAS_SETVBUF /**/ +/* USE_SFIO: + * This symbol, if defined, indicates that sfio should + * be used. + */ +/*#define USE_SFIO /**/ + /* HAS_SHM: * This symbol, if defined, indicates that the entire shm*(2) library is * supported. */ /*#define HAS_SHM /**/ +/* HAS_SIGACTION: + * This symbol, if defined, indicates that Vr4's sigaction() routine + * is available. + */ +/*#define HAS_SIGACTION /**/ + +/* HAS_SIGSETJMP: + * This variable indicates to the C program that the sigsetjmp() + * routine is available to save the calling process's registers + * and stack environment for later use by siglongjmp(), and + * to optionally save the process's signal mask. See + * Sigjmp_buf, Sigsetjmp, and Siglongjmp. + */ +/* Sigjmp_buf: + * This is the buffer type to be used with Sigsetjmp and Siglongjmp. + */ +/* Sigsetjmp: + * This macro is used in the same way as sigsetjmp(), but will invoke + * traditional setjmp() if sigsetjmp isn't available. + * See HAS_SIGSETJMP. + */ +/* Siglongjmp: + * This macro is used in the same way as siglongjmp(), but will invoke + * traditional longjmp() if siglongjmp isn't available. + * See HAS_SIGSETJMP. + */ +/*#define HAS_SIGSETJMP /**/ +#ifdef HAS_SIGSETJMP +#define Sigjmp_buf sigjmp_buf +#define Sigsetjmp(buf,save_mask) sigsetjmp((buf),(save_mask)) +#define Siglongjmp(buf,retval) siglongjmp((buf),(retval)) +#else +#define Sigjmp_buf jmp_buf +#define Sigsetjmp(buf,save_mask) setjmp((buf)) +#define Siglongjmp(buf,retval) longjmp((buf),(retval)) +#endif + /* HAS_SOCKET: * This symbol, if defined, indicates that the BSD socket interface is * supported. @@ -1879,26 +1827,6 @@ * Checking just with #ifdef might not be enough because this symbol * has been known to be an enum. */ -/* HAS_SENDMSG: - * This symbol, if defined, indicates that the sendmsg is supported - * to send messages between sockets. You will also need struct - * iovec from , HAS_STRUCT_IOVEC and I_SYSUIO. - */ -/* HAS_RECVMSG: - * This symbol, if defined, indicates that the recvmsg is supported - * to send messages between sockets. You will also need struct - * iovec from , HAS_STRUCT_IOVEC and I_SYSUIO. - */ -/* HAS_STRUCT_MSGHDR: - * This symbol, if defined, indicates that the struct msghdr - * (BSD 4.3 or 4.4) is supported. You will also need struct - * iovec from , HAS_STRUCT_IOVEC and I_SYSUIO. - */ -/* HAS_STRUCT_CMSGHDR: - * This symbol, if defined, indicates that the struct cmsghdr - * (BSD 4.4) is supported. You will also need struct - * iovec from , HAS_STRUCT_IOVEC and I_SYSUIO. - */ #define HAS_SOCKET /**/ /*#define HAS_SOCKETPAIR /**/ /*#define HAS_MSG_CTRUNC /**/ @@ -1907,16 +1835,102 @@ /*#define HAS_MSG_PEEK /**/ /*#define HAS_MSG_PROXY /**/ /*#define HAS_SCM_RIGHTS /**/ -/*#define HAS_SENDMSG /**/ -/*#define HAS_RECVMSG /**/ -/*#define HAS_STRUCT_MSGHDR /**/ -/*#define HAS_STRUCT_CMSGHDR /**/ + +/* HAS_SQRTL: + * This symbol, if defined, indicates that the sqrtl routine is + * available to do long double square roots. + */ +/*#define HAS_SQRTL /**/ /* USE_STAT_BLOCKS: * This symbol is defined if this system has a stat structure declaring * st_blksize and st_blocks. */ +#ifndef USE_STAT_BLOCKS /*#define USE_STAT_BLOCKS /**/ +#endif + +/* HAS_STRUCT_STATFS_F_FLAGS: + * This symbol, if defined, indicates that the struct statfs + * does have the f_flags member containing the mount flags of + * the filesystem containing the file. + * This kind of struct statfs is coming from (BSD 4.3), + * not from (SYSV). Older BSDs (like Ultrix) do not + * have statfs() and struct statfs, they have ustat() and getmnt() + * with struct ustat and struct fs_data. + */ +/*#define HAS_STRUCT_STATFS_F_FLAGS /**/ + +/* HAS_STRUCT_STATFS: + * This symbol, if defined, indicates that the struct statfs + * to do statfs() is supported. + */ +/*#define HAS_STRUCT_STATFS /**/ + +/* HAS_FSTATVFS: + * This symbol, if defined, indicates that the fstatvfs routine is + * available to stat filesystems by file descriptors. + */ +/*#define HAS_FSTATVFS /**/ + +/* USE_STDIO_PTR: + * This symbol is defined if the _ptr and _cnt fields (or similar) + * of the stdio FILE structure can be used to access the stdio buffer + * for a file handle. If this is defined, then the FILE_ptr(fp) + * and FILE_cnt(fp) macros will also be defined and should be used + * to access these fields. + */ +/* FILE_ptr: + * This macro is used to access the _ptr field (or equivalent) of the + * FILE structure pointed to by its argument. This macro will always be + * defined if USE_STDIO_PTR is defined. + */ +/* STDIO_PTR_LVALUE: + * This symbol is defined if the FILE_ptr macro can be used as an + * lvalue. + */ +/* FILE_cnt: + * This macro is used to access the _cnt field (or equivalent) of the + * FILE structure pointed to by its argument. This macro will always be + * defined if USE_STDIO_PTR is defined. + */ +/* STDIO_CNT_LVALUE: + * This symbol is defined if the FILE_cnt macro can be used as an + * lvalue. + */ +#define USE_STDIO_PTR /**/ +#ifdef USE_STDIO_PTR +#define FILE_ptr(fp) ((fp)->_ptr) +#define STDIO_PTR_LVALUE /**/ +#define FILE_cnt(fp) ((fp)->_cnt) +#define STDIO_CNT_LVALUE /**/ +#endif + +/* USE_STDIO_BASE: + * This symbol is defined if the _base field (or similar) of the + * stdio FILE structure can be used to access the stdio buffer for + * a file handle. If this is defined, then the FILE_base(fp) macro + * will also be defined and should be used to access this field. + * Also, the FILE_bufsiz(fp) macro will be defined and should be used + * to determine the number of bytes in the buffer. USE_STDIO_BASE + * will never be defined unless USE_STDIO_PTR is. + */ +/* FILE_base: + * This macro is used to access the _base field (or equivalent) of the + * FILE structure pointed to by its argument. This macro will always be + * defined if USE_STDIO_BASE is defined. + */ +/* FILE_bufsiz: + * This macro is used to determine the number of bytes in the I/O + * buffer pointed to by _base field (or equivalent) of the FILE + * structure pointed to its argument. This macro will always be defined + * if USE_STDIO_BASE is defined. + */ +#define USE_STDIO_BASE /**/ +#ifdef USE_STDIO_BASE +#define FILE_base(fp) ((fp)->_base) +#define FILE_bufsiz(fp) ((fp)->_cnt + (fp)->_ptr - (fp)->_base) +#endif /* HAS_STRERROR: * This symbol, if defined, indicates that the strerror routine is @@ -1937,6 +1951,52 @@ #define HAS_SYS_ERRLIST /**/ #define Strerror(e) strerror(e) +/* HAS_STRTOLD: + * This symbol, if defined, indicates that the strtold routine is + * available to convert strings to long doubles. + */ +/*#define HAS_STRTOLD /**/ + +/* HAS_STRTOLL: + * This symbol, if defined, indicates that the strtoll routine is + * available to convert strings to long longs. + */ +/*#define HAS_STRTOLL /**/ + +/* HAS_STRTOULL: + * This symbol, if defined, indicates that the strtoull routine is + * available to convert strings to unsigned long longs. + */ +/*#define HAS_STRTOULL /**/ + +/* HAS_STRTOUQ: + * This symbol, if defined, indicates that the strtouq routine is + * available to convert strings to unsigned long longs (quads). + */ +/*#define HAS_STRTOUQ /**/ + +/* HAS_TELLDIR_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the telldir() function. Otherwise, it is up + * to the program to supply one. A good guess is + * extern long telldir _((DIR*)); + */ +#define HAS_TELLDIR_PROTO /**/ + +/* Time_t: + * This symbol holds the type returned by time(). It can be long, + * or time_t on BSD sites (in which case should be + * included). + */ +#define Time_t time_t /* Time type */ + +/* HAS_TIMES: + * This symbol, if defined, indicates that the times() routine exists. + * Note that this became obsolete on some systems (SUNOS), which now + * use getrusage(). It may be necessary to include . + */ +#define HAS_TIMES /**/ + /* HAS_UNION_SEMUN: * This symbol, if defined, indicates that the union semun is * defined by including . If not, the user code @@ -1959,6 +2019,12 @@ /*#define USE_SEMCTL_SEMUN /**/ /*#define USE_SEMCTL_SEMID_DS /**/ +/* HAS_USTAT: + * This symbol, if defined, indicates that the ustat system call is + * available to query file system statistics by dev_t. + */ +/*#define HAS_USTAT /**/ + /* HAS_VFORK: * This symbol, if defined, indicates that vfork() exists. */ @@ -1970,7 +2036,79 @@ * a signal handler using "Signal_t (*handler)()", and define the * handler using "Signal_t handler(sig)". */ -#define Signal_t void /* Signal handler's return type */ +#define Signal_t void /* Signal handler's return type */ + +/* HAS_VPRINTF: + * This symbol, if defined, indicates that the vprintf routine is available + * to printf with a pointer to an argument list. If unavailable, you + * may need to write your own, probably in terms of _doprnt(). + */ +/* USE_CHAR_VSPRINTF: + * This symbol is defined if this system has vsprintf() returning type + * (char*). The trend seems to be to declare it as "int vsprintf()". It + * is up to the package author to declare vsprintf correctly based on the + * symbol. + */ +#define HAS_VPRINTF /**/ +/*#define USE_CHAR_VSPRINTF /**/ + +/* USE_DYNAMIC_LOADING: + * This symbol, if defined, indicates that dynamic loading of + * some sort is available. + */ +#define USE_DYNAMIC_LOADING /**/ + +/* DOUBLESIZE: + * This symbol contains the size of a double, so that the C preprocessor + * can make decisions based on it. + */ +#define DOUBLESIZE 8 /**/ + +/* EBCDIC: + * This symbol, if defined, indicates that this system uses + * EBCDIC encoding. + */ +/*#define EBCDIC /**/ + +/* FFLUSH_NULL: + * This symbol, if defined, tells that fflush(NULL) does flush + * all pending stdio output. + */ +/* FFLUSH_ALL: + * This symbol, if defined, tells that to flush + * all pending stdio output one must loop through all + * the stdio file handles stored in an array and fflush them. + * Note that if fflushNULL is defined, fflushall will not + * even be probed for and will be left undefined. + */ +#define FFLUSH_NULL /**/ +/*#define FFLUSH_ALL /**/ + +/* Fpos_t: + * This symbol holds the type used to declare file positions in libc. + * It can be fpos_t, long, uint, etc... It may be necessary to include + * to get any typedef'ed information. + */ +#define Fpos_t fpos_t /* File position type */ + +/* Gid_t_f: + * This symbol defines the format string used for printing a Gid_t. + */ +#define Gid_t_f "ld" /**/ + +/* Gid_t_size: + * This symbol holds the size of a Gid_t in bytes. + */ +#define Gid_t_size 4 /* GID size */ + +/* Gid_t: + * This symbol holds the return type of getgid() and the type of + * argument to setrgid() and related functions. Typically, + * it is the type of group ids in the kernel. It can be int, ushort, + * uid_t, etc... It may be necessary to include to get + * any typedef'ed information. + */ +#define Gid_t gid_t /* Type for getgid(), etc... */ /* Groups_t: * This symbol holds the type used for the second argument to @@ -1985,6 +2123,19 @@ #define Groups_t gid_t /* Type for 2nd arg to [sg]etgroups() */ #endif +/* DB_Prefix_t: + * This symbol contains the type of the prefix structure element + * in the header file. In older versions of DB, it was + * int, while in newer ones it is u_int32_t. + */ +/* DB_Hash_t: + * This symbol contains the type of the prefix structure element + * in the header file. In older versions of DB, it was + * int, while in newer ones it is size_t. + */ +#define DB_Hash_t int /**/ +#define DB_Prefix_t int /**/ + /* I_GRP: * This symbol, if defined, indicates to the C program that it should * include . @@ -1996,12 +2147,48 @@ /*#define I_GRP /**/ /*#define GRPASSWD /**/ +/* I_INTTYPES: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +/*#define I_INTTYPES /**/ + +/* I_MACH_CTHREADS: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +/*#define I_MACH_CTHREADS /**/ + +/* I_MNTENT: + * This symbol, if defined, indicates that exists and + * should be included. + */ +/*#define I_MNTENT /**/ + /* I_NETDB: * This symbol, if defined, indicates that exists and * should be included. */ /*#define I_NETDB /**/ +/* I_NETINET_TCP: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +/*#define I_NETINET_TCP /**/ + +/* I_POLL: + * This symbol, if defined, indicates that exists and + * should be included. + */ +/*#define I_POLL /**/ + +/* I_PTHREAD: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +/*#define I_PTHREAD /**/ + /* I_PWD: * This symbol, if defined, indicates to the C program that it should * include . @@ -2048,12 +2235,113 @@ /*#define PWGECOS /**/ /*#define PWPASSWD /**/ +/* I_SHADOW: + * This symbol, if defined, indicates that exists and + * should be included. + */ +/*#define I_SHADOW /**/ + +/* I_SOCKS: + * This symbol, if defined, indicates that exists and + * should be included. + */ +/*#define I_SOCKS /**/ + +/* I_SYS_MOUNT: + * This symbol, if defined, indicates that exists and + * should be included. + */ +/*#define I_SYS_MOUNT /**/ + +/* I_SYS_STATFS: + * This symbol, if defined, indicates that exists. + */ +/*#define I_SYS_STATFS /**/ + +/* I_SYS_STATVFS: + * This symbol, if defined, indicates that exists and + * should be included. + */ +/*#define I_SYS_STATVFS /**/ + /* I_SYSUIO: * This symbol, if defined, indicates that exists and * should be included. */ /*#define I_SYSUIO /**/ +/* I_SYS_VFS: + * This symbol, if defined, indicates that exists and + * should be included. + */ +/*#define I_SYS_VFS /**/ + +/* I_TIME: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +/* I_SYS_TIME: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +/* I_SYS_TIME_KERNEL: + * This symbol, if defined, indicates to the C program that it should + * include with KERNEL defined. + */ +#define I_TIME /**/ +/*#define I_SYS_TIME /**/ +/*#define I_SYS_TIME_KERNEL /**/ + +/* I_USTAT: + * This symbol, if defined, indicates that exists and + * should be included. + */ +/*#define I_USTAT /**/ + +/* PERL_INC_VERSION_LIST: + * This variable specifies the list of subdirectories in over + * which perl.c:incpush() and lib/lib.pm will automatically + * search when adding directories to @INC, in a format suitable + * for a C initialization string. See the inc_version_list entry + * in Porting/Glossary for more details. + */ +#define PERL_INC_VERSION_LIST /**/ + +/* HAS_OFF64_T: + * This symbol will be defined if the C compiler supports off64_t. + */ +/* HAS_FPOS64_T: + * This symbol will be defined if the C compiler supports fpos64_t. + */ +/*#define HAS_OFF64_T /**/ +/*#define HAS_FPOS64_T /**/ + +/* PERL_PRIfldbl: + * This symbol, if defined, contains the string used by stdio to + * format long doubles (format 'f') for output. + */ +/* PERL_PRIgldbl: + * This symbol, if defined, contains the string used by stdio to + * format long doubles (format 'g') for output. + */ +/*#define PERL_PRIfldbl "f" /**/ +/*#define PERL_PRIgldbl "g" /**/ + +/* Off_t: + * This symbol holds the type used to declare offsets in the kernel. + * It can be int, long, off_t, etc... It may be necessary to include + * to get any typedef'ed information. + */ +/* LSEEKSIZE: + * This symbol holds the number of bytes used by the Off_t. + */ +/* Off_t_size: + * This symbol holds the number of bytes used by the Off_t. + */ +#define Off_t off_t /* type */ +#define LSEEKSIZE 4 /* size */ +#define Off_t_size 4 /* size */ + /* Free_t: * This variable contains the return type of free(). It is usually * void, but occasionally int. @@ -2069,347 +2357,326 @@ */ /*#define MYMALLOC /**/ -/* SIG_NAME: - * This symbol contains a list of signal names in order of - * signal number. This is intended - * to be used as a static array initialization, like this: - * char *sig_name[] = { SIG_NAME }; - * The signals in the list are separated with commas, and each signal - * is surrounded by double quotes. There is no leading SIG in the signal - * name, i.e. SIGQUIT is known as "QUIT". - * Gaps in the signal numbers (up to NSIG) are filled in with NUMnn, - * etc., where nn is the actual signal number (e.g. NUM37). - * The signal number for sig_name[i] is stored in sig_num[i]. - * The last element is 0 to terminate the list with a NULL. This - * corresponds to the 0 at the end of the sig_num list. - */ -/* SIG_NUM: - * This symbol contains a list of signal numbers, in the same order as the - * SIG_NAME list. It is suitable for static array initialization, as in: - * int sig_num[] = { SIG_NUM }; - * The signals in the list are separated with commas, and the indices - * within that list and the SIG_NAME list match, so it's easy to compute - * the signal name from a number or vice versa at the price of a small - * dynamic linear lookup. - * Duplicates are allowed, but are moved to the end of the list. - * The signal number corresponding to sig_name[i] is sig_number[i]. - * if (i < NSIG) then sig_number[i] == i. - * The last element is 0, corresponding to the 0 at the end of - * the sig_name list. +/* Mode_t: + * This symbol holds the type used to declare file modes + * for systems calls. It is usually mode_t, but may be + * int or unsigned short. It may be necessary to include + * to get any typedef'ed information. */ -#define SIG_NAME "ZERO", "NUM01", "INT", "QUIT", "ILL", "NUM05", "NUM06", "NUM07", "FPE", "KILL", "NUM10", "SEGV", "NUM12", "PIPE", "ALRM", "TERM", "NUM16", "NUM17", "NUM18", "NUM19", "CHLD", "BREAK", "ABRT", "STOP", "NUM24", "CONT", "CLD", 0 /**/ -#define SIG_NUM 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 20, 0 /**/ +#define Mode_t mode_t /* file mode parameter for system calls */ -/* VOIDFLAGS: - * This symbol indicates how much support of the void type is given by this - * compiler. What various bits mean: - * - * 1 = supports declaration of void - * 2 = supports arrays of pointers to functions returning void - * 4 = supports comparisons between pointers to void functions and - * addresses of void functions - * 8 = suports declaration of generic void pointers - * - * The package designer should define VOIDUSED to indicate the requirements - * of the package. This can be done either by #defining VOIDUSED before - * including config.h, or by defining defvoidused in Myinit.U. If the - * latter approach is taken, only those flags will be tested. If the - * level of void support necessary is not present, defines void to int. +/* VAL_O_NONBLOCK: + * This symbol is to be used during open() or fcntl(F_SETFL) to turn on + * non-blocking I/O for the file descriptor. Note that there is no way + * back, i.e. you cannot turn it blocking again this way. If you wish to + * alternatively switch between blocking and non-blocking, use the + * ioctl(FIOSNBIO) call instead, but that is not supported by all devices. */ -#ifndef VOIDUSED -#define VOIDUSED 15 -#endif -#define VOIDFLAGS 15 -#if (VOIDFLAGS & VOIDUSED) != VOIDUSED -#define void int /* is void to be avoided? */ -#define M_VOID /* Xenix strikes again */ -#endif - -/* HAS_ATOLF: - * This symbol, if defined, indicates that the atolf routine is - * available to convert strings into long doubles. +/* VAL_EAGAIN: + * This symbol holds the errno error code set by read() when no data was + * present on the non-blocking file descriptor. */ -/*#define HAS_ATOLF /**/ - -/* HAS_ATOLL: - * This symbol, if defined, indicates that the atoll routine is - * available to convert strings into long longs. +/* RD_NODATA: + * This symbol holds the return code from read() when no data is present + * on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is + * not defined, then you can't distinguish between no data and EOF by + * issuing a read(). You'll have to find another way to tell for sure! */ -/*#define HAS_ATOLL /**/ - -/* PERL_BINCOMPAT_5005: - * This symbol, if defined, indicates that Perl 5.006 should be - * binary-compatible with Perl 5.005. This is impossible for builds - * that use features like threads and multiplicity it is always undef - * for those versions. +/* EOF_NONBLOCK: + * This symbol, if defined, indicates to the C program that a read() on + * a non-blocking file descriptor will return 0 on EOF, and not the value + * held in RD_NODATA (-1 usually, in that case!). */ -/*#define PERL_BINCOMPAT_5005 /**/ +#define VAL_O_NONBLOCK O_NONBLOCK +#define VAL_EAGAIN EAGAIN +#define RD_NODATA -1 +#define EOF_NONBLOCK -/* DLSYM_NEEDS_UNDERSCORE: - * This symbol, if defined, indicates that we need to prepend an - * underscore to the symbol name before calling dlsym(). This only - * makes sense if you *have* dlsym, which we will presume is the - * case if you're using dl_dlopen.xs. +/* Netdb_host_t: + * This symbol holds the type used for the 1st argument + * to gethostbyaddr(). */ -/*#define DLSYM_NEEDS_UNDERSCORE /**/ - -/* HAS_ENDSPENT: - * This symbol, if defined, indicates that the endspent system call is - * available to finalize the scan of SysV shadow password entries. +/* Netdb_hlen_t: + * This symbol holds the type used for the 2nd argument + * to gethostbyaddr(). + */ +/* Netdb_name_t: + * This symbol holds the type used for the argument to + * gethostbyname(). + */ +/* Netdb_net_t: + * This symbol holds the type used for the 1st argument to + * getnetbyaddr(). */ -/*#define HAS_ENDSPENT /**/ +#define Netdb_host_t char * /**/ +#define Netdb_hlen_t int /**/ +#define Netdb_name_t char * /**/ +#define Netdb_net_t long /**/ -/* HAS_FSEEKO: - * This symbol, if defined, indicates that the fseeko routine is - * available to fseek beyond 32 bits (useful for ILP32 hosts). +/* IVTYPE: + * This symbol defines the C type used for Perl's IV. */ -/*#define HAS_FSEEKO /**/ - -/* HAS_FTELLO: - * This symbol, if defined, indicates that the ftello routine is - * available to ftell beyond 32 bits (useful for ILP32 hosts). +/* UVTYPE: + * This symbol defines the C type used for Perl's UV. */ -/*#define HAS_FTELLO /**/ - -/* HAS_GETMNTENT: - * This symbol, if defined, indicates that the getmntent routine is - * available to iterate through mounted file systems. +/* I8TYPE: + * This symbol defines the C type used for Perl's I8. */ -/*#define HAS_GETMNTENT /**/ - -/* HAS_GETSPENT: - * This symbol, if defined, indicates that the getspent system call is - * available to retrieve SysV shadow password entries sequentially. +/* U8TYPE: + * This symbol defines the C type used for Perl's U8. */ -/*#define HAS_GETSPENT /**/ - -/* HAS_GETSPNAM: - * This symbol, if defined, indicates that the getspnam system call is - * available to retrieve SysV shadow password entries by name. +/* I16TYPE: + * This symbol defines the C type used for Perl's I16. */ -/*#define HAS_GETSPNAM /**/ - -/* HAS_HASMNTOPT: - * This symbol, if defined, indicates that the hasmntopt routine is - * available to query the mount options of file systems. +/* U16TYPE: + * This symbol defines the C type used for Perl's U16. */ -/*#define HAS_HASMNTOPT /**/ - -/* HAS_LDBL_DIG: - * This symbol, if defined, indicates that this system's - * or defines the symbol LDBL_DIG, which is the number - * of significant digits in a long double precision number. Unlike - * for DBL_DIG, there's no good guess for LDBL_DIG if it is undefined. +/* I32TYPE: + * This symbol defines the C type used for Perl's I32. */ -#define HAS_LDBL_DIG /**/ - -/* HAS_MADVISE: - * This symbol, if defined, indicates that the madvise system call is - * available to map a file into memory. +/* U32TYPE: + * This symbol defines the C type used for Perl's U32. */ -/*#define HAS_MADVISE /**/ - -/* HAS_MPROTECT: - * This symbol, if defined, indicates that the mprotect system call is - * available to modify the access protection of a memory mapped file. +/* I64TYPE: + * This symbol defines the C type used for Perl's I64. */ -/*#define HAS_MPROTECT /**/ - -/* HAS_READV: - * This symbol, if defined, indicates that the readv routine is - * available to do gather reads. You will also need - * and there I_SYSUIO. +/* U64TYPE: + * This symbol defines the C type used for Perl's U64. */ -/*#define HAS_READV /**/ - -/* HAS_SETSPENT: - * This symbol, if defined, indicates that the setspent system call is - * available to initialize the scan of SysV shadow password entries. +/* NVTYPE: + * This symbol defines the C type used for Perl's NV. */ -/*#define HAS_SETSPENT /**/ - -/* USE_SFIO: - * This symbol, if defined, indicates that sfio should - * be used. +/* IVSIZE: + * This symbol contains the sizeof(IV). */ -/*#define USE_SFIO /**/ - -/* HAS_FSTATFS: - * This symbol, if defined, indicates that the fstatfs routine is - * available to stat filesystems of file descriptors. +/* UVSIZE: + * This symbol contains the sizeof(UV). */ -/* HAS_STRUCT_STATFS_FLAGS: - * This symbol, if defined, indicates that the struct statfs - * does have the f_flags member containing the mount flags of - * the filesystem holding the file. - * This kind of struct statfs is coming from sys/mount.h (BSD), - * not from sys/statfs.h (SYSV). +/* I8SIZE: + * This symbol contains the sizeof(I8). */ -/*#define HAS_FSTATFS /**/ -/*#define HAS_STRUCT_STATFS_FLAGS /**/ - -/* HAS_FSTATVFS: - * This symbol, if defined, indicates that the fstatvfs routine is - * available to stat filesystems of file descriptors. +/* U8SIZE: + * This symbol contains the sizeof(U8). */ -/*#define HAS_FSTATVFS /**/ - -/* HAS_TELLDIR_PROTO: - * This symbol, if defined, indicates that the system provides - * a prototype for the telldir() function. Otherwise, it is up - * to the program to supply one. A good guess is - * extern long telldir _((DIR*)); +/* I16SIZE: + * This symbol contains the sizeof(I16). */ -#define HAS_TELLDIR_PROTO /**/ - -/* HAS_WRITEV: - * This symbol, if defined, indicates that the writev routine is - * available to do scatter writes. +/* U16SIZE: + * This symbol contains the sizeof(U16). */ -/*#define HAS_WRITEV /**/ - -/* USE_DYNAMIC_LOADING: - * This symbol, if defined, indicates that dynamic loading of - * some sort is available. +/* I32SIZE: + * This symbol contains the sizeof(I32). */ -#define USE_DYNAMIC_LOADING /**/ - -/* FFLUSH_NULL: - * This symbol, if defined, tells that fflush(NULL) does flush - * all pending stdio output. +/* U32SIZE: + * This symbol contains the sizeof(U32). */ -/* FFLUSH_ALL: - * This symbol, if defined, tells that to flush - * all pending stdio output one must loop through all - * the stdio file handles stored in an array and fflush them. - * Note that if fflushNULL is defined, fflushall will not - * even be probed for and will be left undefined. +/* I64SIZE: + * This symbol contains the sizeof(I64). */ -#define FFLUSH_NULL /**/ -/*#define FFLUSH_ALL /**/ +/* U64SIZE: + * This symbol contains the sizeof(U64). + */ +#define IVTYPE long /**/ +#define UVTYPE unsigned long /**/ +#define I8TYPE char /**/ +#define U8TYPE unsigned char /**/ +#define I16TYPE short /**/ +#define U16TYPE unsigned short /**/ +#define I32TYPE long /**/ +#define U32TYPE unsigned long /**/ +#ifdef HAS_QUAD +#define I64TYPE long long /**/ +#define U64TYPE unsigned long long /**/ +#endif +#define NVTYPE double /**/ +#define IVSIZE 4 /**/ +#define UVSIZE 4 /**/ +#define I8SIZE 1 /**/ +#define U8SIZE 1 /**/ +#define I16SIZE 2 /**/ +#define U16SIZE 2 /**/ +#define I32SIZE 4 /**/ +#define U32SIZE 4 /**/ +#ifdef HAS_QUAD +#define I64SIZE 8 /**/ +#define U64SIZE 8 /**/ +#endif -/* DB_Prefix_t: - * This symbol contains the type of the prefix structure element - * in the header file. In older versions of DB, it was - * int, while in newer ones it is u_int32_t. +/* IVdf: + * This symbol defines the format string used for printing a Perl IV + * as a signed decimal integer. */ -/* DB_Hash_t: - * This symbol contains the type of the prefix structure element - * in the header file. In older versions of DB, it was - * int, while in newer ones it is size_t. +/* UVuf: + * This symbol defines the format string used for printing a Perl UV + * as an unsigned decimal integer. */ -#define DB_Hash_t int /**/ -#define DB_Prefix_t int /**/ - -/* I_INTTYPES: - * This symbol, if defined, indicates to the C program that it should - * include . +/* UVof: + * This symbol defines the format string used for printing a Perl UV + * as an unsigned octal integer. */ -/* HAS_INT64_T: - * This symbol will defined if the C compiler supports int64_t. - * Usually the needs to be included, but sometimes - * is enough. +/* UVxf: + * This symbol defines the format string used for printing a Perl UV + * as an unsigned hexadecimal integer. */ -/*#define I_INTTYPES /**/ -/*#define HAS_INT64_T /**/ +#define IVdf "ld" /**/ +#define UVuf "lu" /**/ +#define UVof "lo" /**/ +#define UVxf "lx" /**/ -/* I_MNTENT: - * This symbol, if defined, indicates that exists and - * should be included. +/* Pid_t: + * This symbol holds the type used to declare process ids in the kernel. + * It can be int, uint, pid_t, etc... It may be necessary to include + * to get any typedef'ed information. */ -/*#define I_MNTENT /**/ +#define Pid_t int /* PID type */ -/* I_NETINET_TCP: - * This symbol, if defined, indicates to the C program that it should - * include . +/* PRIVLIB: + * This symbol contains the name of the private library for this package. + * The library is private in the sense that it needn't be in anyone's + * execution path, but it should be accessible by the world. The program + * should be prepared to do ~ expansion. */ -/*#define I_NETINET_TCP /**/ - -/* I_POLL: - * This symbol, if defined, indicates that exists and - * should be included. +/* PRIVLIB_EXP: + * This symbol contains the ~name expanded version of PRIVLIB, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. */ -/*#define I_POLL /**/ +#define PRIVLIB "c:\\perl\\5.5.640\\lib" /**/ +#define PRIVLIB_EXP (win32_get_privlib("5.5.640")) /**/ -/* I_SHADOW: - * This symbol, if defined, indicates that exists and - * should be included. +/* PTRSIZE: + * This symbol contains the size of a pointer, so that the C preprocessor + * can make decisions based on it. It will be sizeof(void *) if + * the compiler supports (void *); otherwise it will be + * sizeof(char *). */ -/*#define I_SHADOW /**/ +#define PTRSIZE 4 /**/ -/* I_SOCKS: - * This symbol, if defined, indicates that exists and - * should be included. +/* Drand01: + * This macro is to be used to generate uniformly distributed + * random numbers over the range [0., 1.[. You may have to supply + * an 'extern double drand48();' in your program since SunOS 4.1.3 + * doesn't provide you with anything relevant in it's headers. + * See HAS_DRAND48_PROTO. */ -/*#define I_SOCKS /**/ - -/* I_SYS_MMAN: - * This symbol, if defined, indicates that exists and - * should be included. +/* Rand_seed_t: + * This symbol defines the type of the argument of the + * random seed function. */ -/*#define I_SYS_MMAN /**/ +/* seedDrand01: + * This symbol defines the macro to be used in seeding the + * random number generator (see Drand01). + */ +/* RANDBITS: + * This symbol indicates how many bits are produced by the + * function used to generate normalized random numbers. + * Values include 15, 16, 31, and 48. + */ +#define Drand01() (rand()/(double)((unsigned)1< exists and - * should be included. +/* SELECT_MIN_BITS: + * This symbol holds the minimum number of bits operated by select. + * That is, if you do select(n, ...), how many bits at least will be + * cleared in the masks if some activity is detected. Usually this + * is either n or 32*ceil(n/32), especially many little-endians do + * the latter. This is only useful if you have select(), naturally. */ -/*#define I_SYS_MOUNT /**/ +#define SELECT_MIN_BITS 32 /**/ -/* I_SYS_STATVFS: - * This symbol, if defined, indicates that exists and - * should be included. +/* Select_fd_set_t: + * This symbol holds the type used for the 2nd, 3rd, and 4th + * arguments to select. Usually, this is 'fd_set *', if HAS_FD_SET + * is defined, and 'int *' otherwise. This is only useful if you + * have select(), of course. */ -/*#define I_SYS_STATVFS /**/ +#define Select_fd_set_t Perl_fd_set * /**/ -/* HAS_OFF64_T: - * This symbol will be defined if the C compiler supports off64_t. +/* SIG_NAME: + * This symbol contains a list of signal names in order of + * signal number. This is intended + * to be used as a static array initialization, like this: + * char *sig_name[] = { SIG_NAME }; + * The signals in the list are separated with commas, and each signal + * is surrounded by double quotes. There is no leading SIG in the signal + * name, i.e. SIGQUIT is known as "QUIT". + * Gaps in the signal numbers (up to NSIG) are filled in with NUMnn, + * etc., where nn is the actual signal number (e.g. NUM37). + * The signal number for sig_name[i] is stored in sig_num[i]. + * The last element is 0 to terminate the list with a NULL. This + * corresponds to the 0 at the end of the sig_num list. */ -/* HAS_FPOS64_T: - * This symbol will be defined if the C compiler supports fpos64_t. +/* SIG_NUM: + * This symbol contains a list of signal numbers, in the same order as the + * SIG_NAME list. It is suitable for static array initialization, as in: + * int sig_num[] = { SIG_NUM }; + * The signals in the list are separated with commas, and the indices + * within that list and the SIG_NAME list match, so it's easy to compute + * the signal name from a number or vice versa at the price of a small + * dynamic linear lookup. + * Duplicates are allowed, but are moved to the end of the list. + * The signal number corresponding to sig_name[i] is sig_number[i]. + * if (i < NSIG) then sig_number[i] == i. + * The last element is 0, corresponding to the 0 at the end of + * the sig_name list. */ -/*#define HAS_OFF64_T /**/ -/*#define HAS_FPOS64_T /**/ +#define SIG_NAME "ZERO", "NUM01", "INT", "QUIT", "ILL", "NUM05", "NUM06", "NUM07", "FPE", "KILL", "NUM10", "SEGV", "NUM12", "PIPE", "ALRM", "TERM", "NUM16", "NUM17", "NUM18", "NUM19", "CHLD", "BREAK", "ABRT", "STOP", "NUM24", "CONT", "CLD", 0 /**/ +#define SIG_NUM 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 20, 0 /**/ -/* PERL_PRIfldbl: - * This symbol, if defined, contains the string used by stdio to - * format long doubles (format 'f') for output. +/* SITEARCH: + * This symbol contains the name of the private library for this package. + * The library is private in the sense that it needn't be in anyone's + * execution path, but it should be accessible by the world. The program + * should be prepared to do ~ expansion. + * The standard distribution will put nothing in this directory. + * After perl has been installed, users may install their own local + * architecture-dependent modules in this directory with + * MakeMaker Makefile.PL + * or equivalent. See INSTALL for details. */ -/* PERL_PRIgldbl: - * This symbol, if defined, contains the string used by stdio to - * format long doubles (format 'g') for output. +/* SITEARCH_EXP: + * This symbol contains the ~name expanded version of SITEARCH, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. */ -/*#define PERL_PRIfldbl undef /**/ -/*#define PERL_PRIgldbl undef /**/ +#define SITEARCH "c:\\perl\\site\\5.5.640\\lib\\MSWin32-x86" /**/ +/*#define SITEARCH_EXP "" /**/ -/* PERL_PRId64: - * This symbol, if defined, contains the string used by stdio to - * format 64-bit decimal numbers (format 'd') for output. - */ -/* PERL_PRIu64: - * This symbol, if defined, contains the string used by stdio to - * format 64-bit unsigned decimal numbers (format 'u') for output. +/* SITELIB: + * This symbol contains the name of the private library for this package. + * The library is private in the sense that it needn't be in anyone's + * execution path, but it should be accessible by the world. The program + * should be prepared to do ~ expansion. + * The standard distribution will put nothing in this directory. + * After perl has been installed, users may install their own local + * architecture-independent modules in this directory with + * MakeMaker Makefile.PL + * or equivalent. See INSTALL for details. */ -/* PERL_PRIo64: - * This symbol, if defined, contains the string used by stdio to - * format 64-bit octal numbers (format 'o') for output. +/* SITELIB_EXP: + * This symbol contains the ~name expanded version of SITELIB, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. */ -/* PERL_PRIx64: - * This symbol, if defined, contains the string used by stdio to - * format 64-bit hexadecimal numbers (format 'x') for output. +#define SITELIB "c:\\perl\\site\\5.5.640\\lib" /**/ +#define SITELIB_EXP (win32_get_sitelib("5.5.640")) /**/ + +/* Size_t: + * This symbol holds the type used to declare length parameters + * for string functions. It is usually size_t, but may be + * unsigned long, int, etc. It may be necessary to include + * to get any typedef'ed information. */ -/*#define PERL_PRId64 undef /**/ -/*#define PERL_PRIu64 undef /**/ -/*#define PERL_PRIo64 undef /**/ -/*#define PERL_PRIx64 undef /**/ +#define Size_t size_t /* length paramater for string functions */ -/* SELECT_MIN_BITS: - * This symbol holds the minimum number of bits operated by select. - * That is, if you do select(n, ...), how many bits at least will be - * cleared in the masks if some activity is detected. Usually this - * is either n or 32*ceil(n/32), especially many little-endians do - * the latter. This is only useful if you have select(), naturally. +/* SSize_t: + * This symbol holds the type used by functions that return + * a count of bytes or an error condition. It must be a signed type. + * It is usually ssize_t, but may be long or int, etc. + * It may be necessary to include or + * to get any typedef'ed information. + * We will pick a type such that sizeof(SSize_t) == sizeof(Size_t). */ -#define SELECT_MIN_BITS 32 /**/ +#define SSize_t int /* signed count of bytes */ /* STARTPERL: * This variable contains the string to put in front of a perl @@ -2427,238 +2694,136 @@ * Usual values include _iob, __iob, and __sF. */ /*#define HAS_STDIO_STREAM_ARRAY /**/ -#define STDIO_STREAM_ARRAY undef +#define STDIO_STREAM_ARRAY -/* HAS_STRTOULL: - * This symbol, if defined, indicates that the strtoull routine is - * available to convert strings into unsigned long longs. +/* Uid_t_f: + * This symbol defines the format string used for printing a Uid_t. */ -/*#define HAS_STRTOULL /**/ +#define Uid_t_f "ld" /**/ + +/* Uid_t_size: + * This symbol holds the size of a Uid_t in bytes. + */ +#define Uid_t_size 4 /* UID size */ + +/* Uid_t: + * This symbol holds the type used to declare user ids in the kernel. + * It can be int, ushort, uid_t, etc... It may be necessary to include + * to get any typedef'ed information. + */ +#define Uid_t uid_t /* UID type */ /* USE_64_BITS: - * This symbol, if defined, indicates that 64-bit interfaces should - * be used when available. If not defined, the native default interfaces + * This symbol, if defined, indicates that 64-bit integers should + * be used when available. If not defined, the native integers * will be used (be they 32 or 64 bits). */ +#ifndef USE_64_BITS /*#define USE_64_BITS /**/ +#endif + +/* USE_LARGE_FILES: + * This symbol, if defined, indicates that large file support + * should be used when available. The USE_64_BITS symbol will + * also be turned on if necessary. + */ +#ifndef USE_LARGE_FILES +/*#define USE_LARGE_FILES /**/ +#endif /* USE_LONG_DOUBLE: * This symbol, if defined, indicates that long doubles should * be used when available. */ +#ifndef USE_LONG_DOUBLE /*#define USE_LONG_DOUBLE /**/ +#endif + +/* USE_LONG_LONG: + * This symbol, if defined, indicates that long longs should + * be used when available. + */ +#ifndef USE_LONG_LONG +/*#define USE_LONG_LONG /**/ +#endif + +#ifndef USE_MORE_BITS +/*#define USE_MORE_BITS /**/ +#endif /* MULTIPLICITY: * This symbol, if defined, indicates that Perl should * be built to use multiplicity. */ +#ifndef MULTIPLICTY /*#define MULTIPLICITY /**/ +#endif /* USE_PERLIO: * This symbol, if defined, indicates that the PerlIO abstraction should * be used throughout. If not defined, stdio should be * used in a fully backward compatible manner. */ +#ifndef USE_PERLIO /*#define USE_PERLIO /**/ +#endif /* USE_SOCKS: * This symbol, if defined, indicates that Perl should * be built to use socks. */ +#ifndef USE_SOCKS /*#define USE_SOCKS /**/ +#endif -/* HAS_DRAND48_PROTO: - * This symbol, if defined, indicates that the system provides - * a prototype for the drand48() function. Otherwise, it is up - * to the program to supply one. A good guess is - * extern double drand48 _((void)); - */ -/*#define HAS_DRAND48_PROTO /**/ - -/* HAS_GETHOST_PROTOS: - * This symbol, if defined, indicates that includes - * prototypes for gethostent(), gethostbyname(), and - * gethostbyaddr(). Otherwise, it is up to the program to guess - * them. See netdbtype.U for probing for various Netdb_xxx_t types. - */ -#define HAS_GETHOST_PROTOS /**/ - -/* HAS_GETNET_PROTOS: - * This symbol, if defined, indicates that includes - * prototypes for getnetent(), getnetbyname(), and - * getnetbyaddr(). Otherwise, it is up to the program to guess - * them. See netdbtype.U for probing for various Netdb_xxx_t types. - */ -/*#define HAS_GETNET_PROTOS /**/ - -/* HAS_GETPROTO_PROTOS: - * This symbol, if defined, indicates that includes - * prototypes for getprotoent(), getprotobyname(), and - * getprotobyaddr(). Otherwise, it is up to the program to guess - * them. See netdbtype.U for probing for various Netdb_xxx_t types. - */ -#define HAS_GETPROTO_PROTOS /**/ - -/* HAS_GETSERV_PROTOS: - * This symbol, if defined, indicates that includes - * prototypes for getservent(), getservbyname(), and - * getservbyaddr(). Otherwise, it is up to the program to guess - * them. See netdbtype.U for probing for various Netdb_xxx_t types. - */ -#define HAS_GETSERV_PROTOS /**/ - -/* Netdb_host_t: - * This symbol holds the type used for the 1st argument - * to gethostbyaddr(). - */ -/* Netdb_hlen_t: - * This symbol holds the type used for the 2nd argument - * to gethostbyaddr(). - */ -/* Netdb_name_t: - * This symbol holds the type used for the argument to - * gethostbyname(). - */ -/* Netdb_net_t: - * This symbol holds the type used for the 1st argument to - * getnetbyaddr(). - */ -#define Netdb_host_t char * /**/ -#define Netdb_hlen_t int /**/ -#define Netdb_name_t char * /**/ -#define Netdb_net_t long /**/ - -/* Select_fd_set_t: - * This symbol holds the type used for the 2nd, 3rd, and 4th - * arguments to select. Usually, this is 'fd_set *', if HAS_FD_SET - * is defined, and 'int *' otherwise. This is only useful if you - * have select(), of course. - */ -#define Select_fd_set_t Perl_fd_set * /**/ - -/* ARCHNAME: - * This symbol holds a string representing the architecture name. - * It may be used to construct an architecture-dependant pathname - * where library files may be held under a private library, for - * instance. - */ -#define ARCHNAME "MSWin32-x86" /**/ - -/* OLD_PTHREAD_CREATE_JOINABLE: - * This symbol, if defined, indicates how to create pthread - * in joinable (aka undetached) state. NOTE: not defined - * if pthread.h already has defined PTHREAD_CREATE_JOINABLE - * (the new version of the constant). - * If defined, known values are PTHREAD_CREATE_UNDETACHED - * and __UNDETACHED. - */ -/*#define OLD_PTHREAD_CREATE_JOINABLE /**/ - -/* HAS_PTHREAD_YIELD: - * This symbol, if defined, indicates that the pthread_yield - * routine is available to yield the execution of the current - * thread. sched_yield is preferable to pthread_yield. - */ -/* SCHED_YIELD: - * This symbol defines the way to yield the execution of - * the current thread. Known ways are sched_yield, - * pthread_yield, and pthread_yield with NULL. - */ -/* HAS_SCHED_YIELD: - * This symbol, if defined, indicates that the sched_yield - * routine is available to yield the execution of the current - * thread. sched_yield is preferable to pthread_yield. - */ -/*#define HAS_PTHREAD_YIELD /**/ -#define SCHED_YIELD /**/ -/*#define HAS_SCHED_YIELD /**/ - -/* I_MACH_CTHREADS: - * This symbol, if defined, indicates to the C program that it should - * include . +/* USE_ITHREADS: + * This symbol, if defined, indicates that Perl should be built to + * use the interpreter-based threading implementation. */ -/*#define I_MACH_CTHREADS /**/ - -/* USE_THREADS: - * This symbol, if defined, indicates that Perl should - * be built to use threads. +/* USE_5005THREADS: + * This symbol, if defined, indicates that Perl should be built to + * use the 5.005-based threading implementation. */ /* OLD_PTHREADS_API: * This symbol, if defined, indicates that Perl should * be built to use the old draft POSIX threads API. */ -/*#define USE_THREADS /**/ +/*#define USE_5005THREADS /**/ +/*#define USE_ITHREADS /**/ +#if defined(USE_5005THREADS) && !defined(USE_ITHREADS) +#define USE_THREADS /* until src is revised*/ +#endif /*#define OLD_PTHREADS_API /**/ -/* Time_t: - * This symbol holds the type returned by time(). It can be long, - * or time_t on BSD sites (in which case should be - * included). - */ -#define Time_t time_t /* Time type */ - -/* HAS_TIMES: - * This symbol, if defined, indicates that the times() routine exists. - * Note that this became obsolete on some systems (SUNOS), which now - * use getrusage(). It may be necessary to include . - */ -#define HAS_TIMES /**/ - -/* Fpos_t: - * This symbol holds the type used to declare file positions in libc. - * It can be fpos_t, long, uint, etc... It may be necessary to include - * to get any typedef'ed information. - */ -#define Fpos_t fpos_t /* File position type */ - -/* Gid_t: - * This symbol holds the return type of getgid() and the type of - * argument to setrgid() and related functions. Typically, - * it is the type of group ids in the kernel. It can be int, ushort, - * uid_t, etc... It may be necessary to include to get - * any typedef'ed information. - */ -#define Gid_t gid_t /* Type for getgid(), etc... */ - -/* Off_t: - * This symbol holds the type used to declare offsets in the kernel. - * It can be int, long, off_t, etc... It may be necessary to include - * to get any typedef'ed information. - */ -/* LSEEKSIZE: - * This symbol holds the number of bytes used by the Off_t. - */ -#define Off_t off_t /* type */ -#define LSEEKSIZE 4 /* size */ - -/* Mode_t: - * This symbol holds the type used to declare file modes - * for systems calls. It is usually mode_t, but may be - * int or unsigned short. It may be necessary to include - * to get any typedef'ed information. - */ -#define Mode_t mode_t /* file mode parameter for system calls */ - -/* Pid_t: - * This symbol holds the type used to declare process ids in the kernel. - * It can be int, uint, pid_t, etc... It may be necessary to include - * to get any typedef'ed information. - */ -#define Pid_t int /* PID type */ - -/* Size_t: - * This symbol holds the type used to declare length parameters - * for string functions. It is usually size_t, but may be - * unsigned long, int, etc. It may be necessary to include - * to get any typedef'ed information. +/* PERL_VENDORLIB_EXP: + * This symbol contains the ~name expanded version of VENDORLIB, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define Size_t size_t /* length paramater for string functions */ +/*#define PERL_VENDORLIB_EXP "" /**/ -/* Uid_t: - * This symbol holds the type used to declare user ids in the kernel. - * It can be int, ushort, uid_t, etc... It may be necessary to include - * to get any typedef'ed information. +/* VOIDFLAGS: + * This symbol indicates how much support of the void type is given by this + * compiler. What various bits mean: + * + * 1 = supports declaration of void + * 2 = supports arrays of pointers to functions returning void + * 4 = supports comparisons between pointers to void functions and + * addresses of void functions + * 8 = suports declaration of generic void pointers + * + * The package designer should define VOIDUSED to indicate the requirements + * of the package. This can be done either by #defining VOIDUSED before + * including config.h, or by defining defvoidused in Myinit.U. If the + * latter approach is taken, only those flags will be tested. If the + * level of void support necessary is not present, defines void to int. */ -#define Uid_t uid_t /* UID type */ +#ifndef VOIDUSED +#define VOIDUSED 15 +#endif +#define VOIDFLAGS 15 +#if (VOIDFLAGS & VOIDUSED) != VOIDUSED +#define void int /* is void to be avoided? */ +#define M_VOID /* Xenix strikes again */ +#endif #endif diff --git a/win32/config_H.vc b/win32/config_H.vc index 2c070a4..dc01999 100644 --- a/win32/config_H.vc +++ b/win32/config_H.vc @@ -13,7 +13,7 @@ /* * Package name : perl5 * Source directory : - * Configuration time: undef + * Configuration time: Tue Jan 18 21:02:27 2000 * Configured by : gsar * Target system : */ @@ -273,7 +273,7 @@ * This symbol, if defined, indicates that the link routine is * available to create hard links. */ -/*#define HAS_LINK /**/ +#define HAS_LINK /**/ /* HAS_LOCALECONV: * This symbol, if defined, indicates that the localeconv routine is @@ -358,18 +358,6 @@ */ #define HAS_MKTIME /**/ -/* HAS_MSYNC: - * This symbol, if defined, indicates that the msync system call is - * available to synchronize a mapped file. - */ -/*#define HAS_MSYNC /**/ - -/* HAS_MUNMAP: - * This symbol, if defined, indicates that the munmap system call is - * available to unmap a region, usually mapped by mmap(). - */ -/*#define HAS_MUNMAP /**/ - /* HAS_NICE: * This symbol, if defined, indicates that the nice routine is * available. @@ -992,30 +980,6 @@ */ #define STDCHAR char /**/ -/* HAS_ACCESSX: - * This symbol, if defined, indicates that the accessx routine is - * available to do extended access checks. - */ -/*#define HAS_ACCESSX /**/ - -/* HAS_EACCESS: - * This symbol, if defined, indicates that the eaccess routine is - * available to do extended access checks. - */ -/*#define HAS_EACCESS /**/ - -/* I_SYS_ACCESS: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -/*#define I_SYS_ACCESS /**/ - -/* I_SYS_SECURITY: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -/*#define I_SYS_SECURITY /**/ - /* CROSSCOMPILE: * This symbol, if defined, signifies that we our * build process is a cross-compilation. @@ -1047,6 +1011,53 @@ */ /*#define MULTIARCH /**/ +/* HAS_QUAD: + * This symbol, if defined, tells that there's a 64-bit integer type, + * Quad_t, and its unsigned counterpar, Uquad_t. QUADKIND will be one + * of QUAD_IS_INT, QUAD_IS_LONG, QUAD_IS_LONG_LONG, or QUAD_IS_INT64_T. + */ +/*#define HAS_QUAD /**/ +#ifdef HAS_QUAD +# define Quad_t __int64 /**/ +# define Uquad_t unsigned __int64 /**/ +# define QUADKIND undef /**/ +# define QUAD_IS_INT 1 +# define QUAD_IS_LONG 2 +# define QUAD_IS_LONG_LONG 3 +# define QUAD_IS_INT64_T 4 +#endif + +/* HAS_ACCESSX: + * This symbol, if defined, indicates that the accessx routine is + * available to do extended access checks. + */ +/*#define HAS_ACCESSX /**/ + +/* HAS_EACCESS: + * This symbol, if defined, indicates that the eaccess routine is + * available to do extended access checks. + */ +/*#define HAS_EACCESS /**/ + +/* I_SYS_ACCESS: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +/*#define I_SYS_ACCESS /**/ + +/* I_SYS_SECURITY: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +/*#define I_SYS_SECURITY /**/ + +/* OSNAME: + * This symbol contains the name of the operating system, as determined + * by Configure. You shouldn't rely on it too much; the specific + * feature tests from Configure are generally more reliable. + */ +#define OSNAME "MSWin32" /**/ + /* MEM_ALIGNBYTES: * This symbol contains the number of bytes required to align a * double. Usual values are 2, 4 and 8. The default is eight, @@ -1058,6 +1069,61 @@ #define MEM_ALIGNBYTES 8 #endif +/* ARCHLIB: + * This variable, if defined, holds the name of the directory in + * which the user wants to put architecture-dependent public + * library files for perl5. It is most often a local directory + * such as /usr/local/lib. Programs using this variable must be + * prepared to deal with filename expansion. If ARCHLIB is the + * same as PRIVLIB, it is not defined, since presumably the + * program already searches PRIVLIB. + */ +/* ARCHLIB_EXP: + * This symbol contains the ~name expanded version of ARCHLIB, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. + */ +#define ARCHLIB "c:\\perl\\5.5.640\\lib\\MSWin32-x86" /**/ +/*#define ARCHLIB_EXP "" /**/ + +/* ARCHNAME: + * This symbol holds a string representing the architecture name. + * It may be used to construct an architecture-dependant pathname + * where library files may be held under a private library, for + * instance. + */ +#define ARCHNAME "MSWin32-x86" /**/ + +/* HAS_ATOLF: + * This symbol, if defined, indicates that the atolf routine is + * available to convert strings into long doubles. + */ +/*#define HAS_ATOLF /**/ + +/* HAS_ATOLL: + * This symbol, if defined, indicates that the atoll routine is + * available to convert strings into long longs. + */ +/*#define HAS_ATOLL /**/ + +/* BIN: + * This symbol holds the path of the bin directory where the package will + * be installed. Program must be prepared to deal with ~name substitution. + */ +/* BIN_EXP: + * This symbol is the filename expanded version of the BIN symbol, for + * programs that do not want to deal with that at run-time. + */ +#define BIN "c:\\perl\\5.5.640\\bin\\MSWin32-x86" /**/ +#define BIN_EXP "c:\\perl\\5.5.640\\bin\\MSWin32-x86" /**/ + +/* PERL_BINCOMPAT_5005: + * This symbol, if defined, indicates that Perl 5.006 should be + * binary-compatible with Perl 5.005. This is impossible for builds + * that use features like threads and multiplicity it is always undef + * for those versions. + */ +/*#define PERL_BINCOMPAT_5005 /**/ + /* BYTEORDER: * This symbol holds the hexadecimal constant defined in byteorder, * i.e. 0x1234 or 0x4321, etc... @@ -1101,6 +1167,58 @@ #define BYTEORDER 0x1234 /* large digits for MSB */ #endif /* NeXT */ +/* CAT2: + * This macro catenates 2 tokens together. + */ +/* STRINGIFY: + * This macro surrounds its token with double quotes. + */ +#if 42 == 1 +#define CAT2(a,b)a/**/b +#define STRINGIFY(a)"a" + /* If you can get stringification with catify, tell me how! */ +#endif +#if 42 == 42 +#define CAT2(a,b)a ## b +#define StGiFy(a)# a +#define STRINGIFY(a)StGiFy(a) +#endif +#if 42 != 1 && 42 != 42 +#include "Bletch: How does this C preprocessor catenate tokens?" +#endif + +/* CPPSTDIN: + * This symbol contains the first part of the string which will invoke + * the C preprocessor on the standard input and produce to standard + * output. Typical value of "cc -E" or "/lib/cpp", but it can also + * call a wrapper. See CPPRUN. + */ +/* CPPMINUS: + * This symbol contains the second part of the string which will invoke + * the C preprocessor on the standard input and produce to standard + * output. This symbol will have the value "-" if CPPSTDIN needs a minus + * to specify standard input, otherwise the value is "". + */ +/* CPPRUN: + * This symbol contains the string which will invoke a C preprocessor on + * the standard input and produce to standard output. It needs to end + * with CPPLAST, after all other preprocessor flags have been specified. + * The main difference with CPPSTDIN is that this program will never be a + * pointer to a shell wrapper, i.e. it will be empty if no preprocessor is + * available directly to the user. Note that it may well be different from + * the preprocessor used to compile the C program. + */ +#define CPPSTDIN "cl -nologo -E" +#define CPPMINUS "" +#define CPPRUN "cl -nologo -E" + +/* HAS_ACCESS: + * This manifest constant lets the C program know that the access() + * system call is available to check for accessibility using real UID/GID. + * (always present on UNIX.) + */ +#define HAS_ACCESS /**/ + /* CASTI32: * This symbol is defined if the C compiler can cast negative * or large floating point numbers to 32-bit ints. @@ -1128,12 +1246,104 @@ */ /*#define VOID_CLOSEDIR /**/ +/* HAS_CSH: + * This symbol, if defined, indicates that the C-shell exists. + */ +/* CSH: + * This symbol, if defined, contains the full pathname of csh. + */ +/*#define HAS_CSH /**/ +#ifdef HAS_CSH +#define CSH "" /**/ +#endif + +/* DLSYM_NEEDS_UNDERSCORE: + * This symbol, if defined, indicates that we need to prepend an + * underscore to the symbol name before calling dlsym(). This only + * makes sense if you *have* dlsym, which we will presume is the + * case if you're using dl_dlopen.xs. + */ +/*#define DLSYM_NEEDS_UNDERSCORE /**/ + +/* HAS_DRAND48_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the drand48() function. Otherwise, it is up + * to the program to supply one. A good guess is + * extern double drand48 _((void)); + */ +/*#define HAS_DRAND48_PROTO /**/ + +/* HAS_ENDGRENT: + * This symbol, if defined, indicates that the getgrent routine is + * available for finalizing sequential access of the group database. + */ +/*#define HAS_ENDGRENT /**/ + +/* HAS_ENDHOSTENT: + * This symbol, if defined, indicates that the endhostent() routine is + * available to close whatever was being used for host queries. + */ +/*#define HAS_ENDHOSTENT /**/ + +/* HAS_ENDNETENT: + * This symbol, if defined, indicates that the endnetent() routine is + * available to close whatever was being used for network queries. + */ +/*#define HAS_ENDNETENT /**/ + +/* HAS_ENDPROTOENT: + * This symbol, if defined, indicates that the endprotoent() routine is + * available to close whatever was being used for protocol queries. + */ +/*#define HAS_ENDPROTOENT /**/ + +/* HAS_ENDPWENT: + * This symbol, if defined, indicates that the getgrent routine is + * available for finalizing sequential access of the passwd database. + */ +/*#define HAS_ENDPWENT /**/ + +/* HAS_ENDSERVENT: + * This symbol, if defined, indicates that the endservent() routine is + * available to close whatever was being used for service queries. + */ +/*#define HAS_ENDSERVENT /**/ + +/* HAS_ENDSPENT: + * This symbol, if defined, indicates that the endspent system call is + * available to finalize the scan of SysV shadow password entries. + */ +/*#define HAS_ENDSPENT /**/ + /* HAS_FD_SET: * This symbol, when defined, indicates presence of the fd_set typedef * in */ #define HAS_FD_SET /**/ +/* HAS_STRUCT_FS_DATA: + * This symbol, if defined, indicates that the struct fs_data + * to do statfs() is supported. + */ +/*#define HAS_STRUCT_FS_DATA /**/ + +/* HAS_FSEEKO: + * This symbol, if defined, indicates that the fseeko routine is + * available to fseek beyond 32 bits (useful for ILP32 hosts). + */ +/*#define HAS_FSEEKO /**/ + +/* HAS_FSTATFS: + * This symbol, if defined, indicates that the fstatfs routine is + * available to stat filesystems by file descriptors. + */ +/*#define HAS_FSTATFS /**/ +/* HAS_FTELLO: + * This symbol, if defined, indicates that the ftello routine is + * available to ftell beyond 32 bits (useful for ILP32 hosts). + */ +/*#define HAS_FTELLO /**/ + /* Gconvert: * This preprocessor macro is defined to convert a floating point * number to a string without a trailing decimal point. This @@ -1151,451 +1361,6 @@ */ #define Gconvert(x,n,t,b) sprintf((b),"%.*g",(n),(x)) -/* HAS_GNULIBC: - * This symbol, if defined, indicates to the C program that - * the GNU C library is being used. - */ -/*#define HAS_GNULIBC /**/ -/* HAS_ISASCII: - * This manifest constant lets the C program know that isascii - * is available. - */ -#define HAS_ISASCII /**/ - -/* HAS_LCHOWN: - * This symbol, if defined, indicates that the lchown routine is - * available to operate on a symbolic link (instead of following the - * link). - */ -/*#define HAS_LCHOWN /**/ - -/* HAS_OPEN3: - * This manifest constant lets the C program know that the three - * argument form of open(2) is available. - */ -/*#define HAS_OPEN3 /**/ - -/* HAS_SAFE_BCOPY: - * This symbol, if defined, indicates that the bcopy routine is available - * to copy potentially overlapping memory blocks. Otherwise you should - * probably use memmove() or memcpy(). If neither is defined, roll your - * own version. - */ -/*#define HAS_SAFE_BCOPY /**/ - -/* HAS_SAFE_MEMCPY: - * This symbol, if defined, indicates that the memcpy routine is available - * to copy potentially overlapping memory blocks. Otherwise you should - * probably use memmove() or memcpy(). If neither is defined, roll your - * own version. - */ -/*#define HAS_SAFE_MEMCPY /**/ - -/* HAS_SANE_MEMCMP: - * This symbol, if defined, indicates that the memcmp routine is available - * and can be used to compare relative magnitudes of chars with their high - * bits set. If it is not defined, roll your own version. - */ -#define HAS_SANE_MEMCMP /**/ - -/* HAS_SIGACTION: - * This symbol, if defined, indicates that Vr4's sigaction() routine - * is available. - */ -/*#define HAS_SIGACTION /**/ - -/* HAS_SIGSETJMP: - * This variable indicates to the C program that the sigsetjmp() - * routine is available to save the calling process's registers - * and stack environment for later use by siglongjmp(), and - * to optionally save the process's signal mask. See - * Sigjmp_buf, Sigsetjmp, and Siglongjmp. - */ -/* Sigjmp_buf: - * This is the buffer type to be used with Sigsetjmp and Siglongjmp. - */ -/* Sigsetjmp: - * This macro is used in the same way as sigsetjmp(), but will invoke - * traditional setjmp() if sigsetjmp isn't available. - * See HAS_SIGSETJMP. - */ -/* Siglongjmp: - * This macro is used in the same way as siglongjmp(), but will invoke - * traditional longjmp() if siglongjmp isn't available. - * See HAS_SIGSETJMP. - */ -/*#define HAS_SIGSETJMP /**/ -#ifdef HAS_SIGSETJMP -#define Sigjmp_buf sigjmp_buf -#define Sigsetjmp(buf,save_mask) sigsetjmp((buf),(save_mask)) -#define Siglongjmp(buf,retval) siglongjmp((buf),(retval)) -#else -#define Sigjmp_buf jmp_buf -#define Sigsetjmp(buf,save_mask) setjmp((buf)) -#define Siglongjmp(buf,retval) longjmp((buf),(retval)) -#endif - -/* USE_STDIO_PTR: - * This symbol is defined if the _ptr and _cnt fields (or similar) - * of the stdio FILE structure can be used to access the stdio buffer - * for a file handle. If this is defined, then the FILE_ptr(fp) - * and FILE_cnt(fp) macros will also be defined and should be used - * to access these fields. - */ -/* FILE_ptr: - * This macro is used to access the _ptr field (or equivalent) of the - * FILE structure pointed to by its argument. This macro will always be - * defined if USE_STDIO_PTR is defined. - */ -/* STDIO_PTR_LVALUE: - * This symbol is defined if the FILE_ptr macro can be used as an - * lvalue. - */ -/* FILE_cnt: - * This macro is used to access the _cnt field (or equivalent) of the - * FILE structure pointed to by its argument. This macro will always be - * defined if USE_STDIO_PTR is defined. - */ -/* STDIO_CNT_LVALUE: - * This symbol is defined if the FILE_cnt macro can be used as an - * lvalue. - */ -#define USE_STDIO_PTR /**/ -#ifdef USE_STDIO_PTR -#define FILE_ptr(fp) ((fp)->_ptr) -#define STDIO_PTR_LVALUE /**/ -#define FILE_cnt(fp) ((fp)->_cnt) -#define STDIO_CNT_LVALUE /**/ -#endif - -/* USE_STDIO_BASE: - * This symbol is defined if the _base field (or similar) of the - * stdio FILE structure can be used to access the stdio buffer for - * a file handle. If this is defined, then the FILE_base(fp) macro - * will also be defined and should be used to access this field. - * Also, the FILE_bufsiz(fp) macro will be defined and should be used - * to determine the number of bytes in the buffer. USE_STDIO_BASE - * will never be defined unless USE_STDIO_PTR is. - */ -/* FILE_base: - * This macro is used to access the _base field (or equivalent) of the - * FILE structure pointed to by its argument. This macro will always be - * defined if USE_STDIO_BASE is defined. - */ -/* FILE_bufsiz: - * This macro is used to determine the number of bytes in the I/O - * buffer pointed to by _base field (or equivalent) of the FILE - * structure pointed to its argument. This macro will always be defined - * if USE_STDIO_BASE is defined. - */ -#define USE_STDIO_BASE /**/ -#ifdef USE_STDIO_BASE -#define FILE_base(fp) ((fp)->_base) -#define FILE_bufsiz(fp) ((fp)->_cnt + (fp)->_ptr - (fp)->_base) -#endif - -/* HAS_VPRINTF: - * This symbol, if defined, indicates that the vprintf routine is available - * to printf with a pointer to an argument list. If unavailable, you - * may need to write your own, probably in terms of _doprnt(). - */ -/* USE_CHAR_VSPRINTF: - * This symbol is defined if this system has vsprintf() returning type - * (char*). The trend seems to be to declare it as "int vsprintf()". It - * is up to the package author to declare vsprintf correctly based on the - * symbol. - */ -#define HAS_VPRINTF /**/ -/*#define USE_CHAR_VSPRINTF /**/ - -/* DOUBLESIZE: - * This symbol contains the size of a double, so that the C preprocessor - * can make decisions based on it. - */ -#define DOUBLESIZE 8 /**/ - -/* I_TIME: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -/* I_SYS_TIME: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -/* I_SYS_TIME_KERNEL: - * This symbol, if defined, indicates to the C program that it should - * include with KERNEL defined. - */ -#define I_TIME /**/ -/*#define I_SYS_TIME /**/ -/*#define I_SYS_TIME_KERNEL /**/ - -/* VAL_O_NONBLOCK: - * This symbol is to be used during open() or fcntl(F_SETFL) to turn on - * non-blocking I/O for the file descriptor. Note that there is no way - * back, i.e. you cannot turn it blocking again this way. If you wish to - * alternatively switch between blocking and non-blocking, use the - * ioctl(FIOSNBIO) call instead, but that is not supported by all devices. - */ -/* VAL_EAGAIN: - * This symbol holds the errno error code set by read() when no data was - * present on the non-blocking file descriptor. - */ -/* RD_NODATA: - * This symbol holds the return code from read() when no data is present - * on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is - * not defined, then you can't distinguish between no data and EOF by - * issuing a read(). You'll have to find another way to tell for sure! - */ -/* EOF_NONBLOCK: - * This symbol, if defined, indicates to the C program that a read() on - * a non-blocking file descriptor will return 0 on EOF, and not the value - * held in RD_NODATA (-1 usually, in that case!). - */ -#define VAL_O_NONBLOCK O_NONBLOCK -#define VAL_EAGAIN EAGAIN -#define RD_NODATA -1 -#define EOF_NONBLOCK - -/* PTRSIZE: - * This symbol contains the size of a pointer, so that the C preprocessor - * can make decisions based on it. It will be sizeof(void *) if - * the compiler supports (void *); otherwise it will be - * sizeof(char *). - */ -#define PTRSIZE 4 /**/ - -/* Drand01: - * This macro is to be used to generate uniformly distributed - * random numbers over the range [0., 1.[. You may have to supply - * an 'extern double drand48();' in your program since SunOS 4.1.3 - * doesn't provide you with anything relevant in it's headers. - * See HAS_DRAND48_PROTO. - */ -/* Rand_seed_t: - * This symbol defines the type of the argument of the - * random seed function. - */ -/* seedDrand01: - * This symbol defines the macro to be used in seeding the - * random number generator (see Drand01). - */ -/* RANDBITS: - * This symbol indicates how many bits are produced by the - * function used to generate normalized random numbers. - * Values include 15, 16, 31, and 48. - */ -#define Drand01() (rand()/(double)((unsigned)1< or - * to get any typedef'ed information. - * We will pick a type such that sizeof(SSize_t) == sizeof(Size_t). - */ -#define SSize_t int /* signed count of bytes */ - -/* EBCDIC: - * This symbol, if defined, indicates that this system uses - * EBCDIC encoding. - */ -/*#define EBCDIC /**/ - -/* ARCHLIB: - * This variable, if defined, holds the name of the directory in - * which the user wants to put architecture-dependent public - * library files for perl5. It is most often a local directory - * such as /usr/local/lib. Programs using this variable must be - * prepared to deal with filename expansion. If ARCHLIB is the - * same as PRIVLIB, it is not defined, since presumably the - * program already searches PRIVLIB. - */ -/* ARCHLIB_EXP: - * This symbol contains the ~name expanded version of ARCHLIB, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -#define ARCHLIB "c:\\perl\\5.00561\\lib\\MSWin32-x86" /**/ -/*#define ARCHLIB_EXP "" /**/ - -/* BIN: - * This symbol holds the path of the bin directory where the package will - * be installed. Program must be prepared to deal with ~name substitution. - */ -/* BIN_EXP: - * This symbol is the filename expanded version of the BIN symbol, for - * programs that do not want to deal with that at run-time. - */ -#define BIN "c:\\perl\\5.00561\\bin\\MSWin32-x86" /**/ -#define BIN_EXP "c:\\perl\\5.00561\\bin\\MSWin32-x86" /**/ - -/* INSTALL_USR_BIN_PERL: - * This symbol, if defined, indicates that Perl is to be installed - * also as /usr/bin/perl. - */ -/*#define INSTALL_USR_BIN_PERL /**/ - -/* PRIVLIB: - * This symbol contains the name of the private library for this package. - * The library is private in the sense that it needn't be in anyone's - * execution path, but it should be accessible by the world. The program - * should be prepared to do ~ expansion. - */ -/* PRIVLIB_EXP: - * This symbol contains the ~name expanded version of PRIVLIB, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -#define PRIVLIB "c:\\perl\\5.00561\\lib" /**/ -#define PRIVLIB_EXP (win32_get_privlib("5.00561")) /**/ - -/* SITEARCH: - * This symbol contains the name of the private library for this package. - * The library is private in the sense that it needn't be in anyone's - * execution path, but it should be accessible by the world. The program - * should be prepared to do ~ expansion. - * The standard distribution will put nothing in this directory. - * Individual sites may place their own extensions and modules in - * this directory. - */ -/* SITEARCH_EXP: - * This symbol contains the ~name expanded version of SITEARCH, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -#define SITEARCH "c:\\perl\\site\\5.00561\\lib\\MSWin32-x86" /**/ -/*#define SITEARCH_EXP "" /**/ - -/* SITELIB: - * This symbol contains the name of the private library for this package. - * The library is private in the sense that it needn't be in anyone's - * execution path, but it should be accessible by the world. The program - * should be prepared to do ~ expansion. - * The standard distribution will put nothing in this directory. - * Individual sites may place their own extensions and modules in - * this directory. - */ -/* SITELIB_EXP: - * This symbol contains the ~name expanded version of SITELIB, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -#define SITELIB "c:\\perl\\site\\5.00561\\lib" /**/ -#define SITELIB_EXP (win32_get_sitelib("5.00561")) /**/ - -/* PERL_VENDORLIB_EXP: - * This symbol contains the ~name expanded version of VENDORLIB, to be used - * in programs that are not prepared to deal with ~ expansion at run-time. - */ -/*#define PERL_VENDORLIB_EXP "undef" /**/ - -/* OSNAME: - * This symbol contains the name of the operating system, as determined - * by Configure. You shouldn't rely on it too much; the specific - * feature tests from Configure are generally more reliable. - */ -#define OSNAME "MSWin32" /**/ - -/* CAT2: - * This macro catenates 2 tokens together. - */ -/* STRINGIFY: - * This macro surrounds its token with double quotes. - */ -#if 42 == 1 -#define CAT2(a,b)a/**/b -#define STRINGIFY(a)"a" - /* If you can get stringification with catify, tell me how! */ -#endif -#if 42 == 42 -#define CAT2(a,b)a ## b -#define StGiFy(a)# a -#define STRINGIFY(a)StGiFy(a) -#endif -#if 42 != 1 && 42 != 42 -#include "Bletch: How does this C preprocessor catenate tokens?" -#endif - -/* CPPSTDIN: - * This symbol contains the first part of the string which will invoke - * the C preprocessor on the standard input and produce to standard - * output. Typical value of "cc -E" or "/lib/cpp", but it can also - * call a wrapper. See CPPRUN. - */ -/* CPPMINUS: - * This symbol contains the second part of the string which will invoke - * the C preprocessor on the standard input and produce to standard - * output. This symbol will have the value "-" if CPPSTDIN needs a minus - * to specify standard input, otherwise the value is "". - */ -/* CPPRUN: - * This symbol contains the string which will invoke a C preprocessor on - * the standard input and produce to standard output. It needs to end - * with CPPLAST, after all other preprocessor flags have been specified. - * The main difference with CPPSTDIN is that this program will never be a - * pointer to a shell wrapper, i.e. it will be empty if no preprocessor is - * available directly to the user. Note that it may well be different from - * the preprocessor used to compile the C program. - */ -#define CPPSTDIN "cl -nologo -E" -#define CPPMINUS "" -#define CPPRUN "cl -nologo -E" - -/* HAS_ACCESS: - * This manifest constant lets the C program know that the access() - * system call is available to check for accessibility using real UID/GID. - * (always present on UNIX.) - */ -#define HAS_ACCESS /**/ - -/* HAS_CSH: - * This symbol, if defined, indicates that the C-shell exists. - */ -/* CSH: - * This symbol, if defined, contains the full pathname of csh. - */ -/*#define HAS_CSH /**/ -#ifdef HAS_CSH -#define CSH "" /**/ -#endif - -/* HAS_ENDGRENT: - * This symbol, if defined, indicates that the getgrent routine is - * available for finalizing sequential access of the group database. - */ -/*#define HAS_ENDGRENT /**/ - -/* HAS_ENDHOSTENT: - * This symbol, if defined, indicates that the endhostent() routine is - * available to close whatever was being used for host queries. - */ -/*#define HAS_ENDHOSTENT /**/ - -/* HAS_ENDNETENT: - * This symbol, if defined, indicates that the endnetent() routine is - * available to close whatever was being used for network queries. - */ -/*#define HAS_ENDNETENT /**/ - -/* HAS_ENDPROTOENT: - * This symbol, if defined, indicates that the endprotoent() routine is - * available to close whatever was being used for protocol queries. - */ -/*#define HAS_ENDPROTOENT /**/ - -/* HAS_ENDPWENT: - * This symbol, if defined, indicates that the getgrent routine is - * available for finalizing sequential access of the passwd database. - */ -/*#define HAS_ENDPWENT /**/ - -/* HAS_ENDSERVENT: - * This symbol, if defined, indicates that the endservent() routine is - * available to close whatever was being used for service queries. - */ -/*#define HAS_ENDSERVENT /**/ - /* HAS_GETGRENT: * This symbol, if defined, indicates that the getgrent routine is * available for sequential access of the group database. @@ -1644,6 +1409,26 @@ #define PHOSTNAME "" /* How to get the host name */ #endif +/* HAS_GETHOST_PROTOS: + * This symbol, if defined, indicates that includes + * prototypes for gethostent(), gethostbyname(), and + * gethostbyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +#define HAS_GETHOST_PROTOS /**/ + +/* HAS_GETMNT: + * This symbol, if defined, indicates that the getmnt routine is + * available to get filesystem mount info by filename. + */ +/*#define HAS_GETMNT /**/ + +/* HAS_GETMNTENT: + * This symbol, if defined, indicates that the getmntent routine is + * available to iterate through mounted file systems to get their info. + */ +/*#define HAS_GETMNTENT /**/ + /* HAS_GETNETBYADDR: * This symbol, if defined, indicates that the getnetbyaddr() routine is * available to look up networks by their IP addresses. @@ -1662,6 +1447,14 @@ */ /*#define HAS_GETNETENT /**/ +/* HAS_GETNET_PROTOS: + * This symbol, if defined, indicates that includes + * prototypes for getnetent(), getnetbyname(), and + * getnetbyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +/*#define HAS_GETNET_PROTOS /**/ + /* HAS_GETPROTOENT: * This symbol, if defined, indicates that the getprotoent() routine is * available to look up protocols in some data base or another. @@ -1679,6 +1472,14 @@ #define HAS_GETPROTOBYNAME /**/ #define HAS_GETPROTOBYNUMBER /**/ +/* HAS_GETPROTO_PROTOS: + * This symbol, if defined, indicates that includes + * prototypes for getprotoent(), getprotobyname(), and + * getprotobyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +#define HAS_GETPROTO_PROTOS /**/ + /* HAS_GETPWENT: * This symbol, if defined, indicates that the getpwent routine is * available for sequential access of the passwd database. @@ -1692,6 +1493,26 @@ */ /*#define HAS_GETSERVENT /**/ +/* HAS_GETSERV_PROTOS: + * This symbol, if defined, indicates that includes + * prototypes for getservent(), getservbyname(), and + * getservbyaddr(). Otherwise, it is up to the program to guess + * them. See netdbtype.U for probing for various Netdb_xxx_t types. + */ +#define HAS_GETSERV_PROTOS /**/ + +/* HAS_GETSPENT: + * This symbol, if defined, indicates that the getspent system call is + * available to retrieve SysV shadow password entries sequentially. + */ +/*#define HAS_GETSPENT /**/ + +/* HAS_GETSPNAM: + * This symbol, if defined, indicates that the getspnam system call is + * available to retrieve SysV shadow password entries by name. + */ +/*#define HAS_GETSPNAM /**/ + /* HAS_GETSERVBYNAME: * This symbol, if defined, indicates that the getservbyname() * routine is available to look up services by their name. @@ -1703,6 +1524,17 @@ #define HAS_GETSERVBYNAME /**/ #define HAS_GETSERVBYPORT /**/ +/* HAS_GNULIBC: + * This symbol, if defined, indicates to the C program that + * the GNU C library is being used. + */ +/*#define HAS_GNULIBC /**/ +/* HAS_HASMNTOPT: + * This symbol, if defined, indicates that the hasmntopt routine is + * available to query the mount options of file systems. + */ +/*#define HAS_HASMNTOPT /**/ + /* HAS_HTONL: * This symbol, if defined, indicates that the htonl() routine (and * friends htons() ntohl() ntohs()) are available to do network @@ -1728,6 +1560,27 @@ #define HAS_NTOHL /**/ #define HAS_NTOHS /**/ +/* HAS_ISASCII: + * This manifest constant lets the C program know that isascii + * is available. + */ +#define HAS_ISASCII /**/ + +/* HAS_LCHOWN: + * This symbol, if defined, indicates that the lchown routine is + * available to operate on a symbolic link (instead of following the + * link). + */ +/*#define HAS_LCHOWN /**/ + +/* HAS_LDBL_DIG: + * This symbol, if defined, indicates that this system's + * or defines the symbol LDBL_DIG, which is the number + * of significant digits in a long double precision number. Unlike + * for DBL_DIG, there's no good guess for LDBL_DIG if it is undefined. + */ +#define HAS_LDBL_DIG /**/ + /* HAS_LONG_DOUBLE: * This symbol will be defined if the C compiler supports long * doubles. @@ -1750,34 +1603,80 @@ * C preprocessor can make decisions based on it. It is only * defined if the system supports long long. */ -/*#define HAS_LONG_LONG /**/ -#ifdef HAS_LONG_LONG -#define LONGLONGSIZE 8 /**/ -#endif - -/* HAS_MEMCHR: - * This symbol, if defined, indicates that the memchr routine is available - * to locate characters within a C string. +/*#define HAS_LONG_LONG /**/ +#ifdef HAS_LONG_LONG +#define LONGLONGSIZE 8 /**/ +#endif + +/* HAS_MEMCHR: + * This symbol, if defined, indicates that the memchr routine is available + * to locate characters within a C string. + */ +#define HAS_MEMCHR /**/ + +/* HAS_MSG: + * This symbol, if defined, indicates that the entire msg*(2) library is + * supported (IPC mechanism based on message queues). + */ +/*#define HAS_MSG /**/ + +/* HAS_OPEN3: + * This manifest constant lets the C program know that the three + * argument form of open(2) is available. + */ +/*#define HAS_OPEN3 /**/ + +/* OLD_PTHREAD_CREATE_JOINABLE: + * This symbol, if defined, indicates how to create pthread + * in joinable (aka undetached) state. NOTE: not defined + * if pthread.h already has defined PTHREAD_CREATE_JOINABLE + * (the new version of the constant). + * If defined, known values are PTHREAD_CREATE_UNDETACHED + * and __UNDETACHED. + */ +/*#define OLD_PTHREAD_CREATE_JOINABLE /**/ + +/* HAS_PTHREAD_YIELD: + * This symbol, if defined, indicates that the pthread_yield + * routine is available to yield the execution of the current + * thread. sched_yield is preferable to pthread_yield. + */ +/* SCHED_YIELD: + * This symbol defines the way to yield the execution of + * the current thread. Known ways are sched_yield, + * pthread_yield, and pthread_yield with NULL. + */ +/* HAS_SCHED_YIELD: + * This symbol, if defined, indicates that the sched_yield + * routine is available to yield the execution of the current + * thread. sched_yield is preferable to pthread_yield. */ -/*#define HAS_MEMCHR /**/ +/*#define HAS_PTHREAD_YIELD /**/ +#define SCHED_YIELD /**/ +/*#define HAS_SCHED_YIELD /**/ -/* HAS_MMAP: - * This symbol, if defined, indicates that the mmap system call is - * available to map a file into memory. +/* HAS_SAFE_BCOPY: + * This symbol, if defined, indicates that the bcopy routine is available + * to copy potentially overlapping memory blocks. Otherwise you should + * probably use memmove() or memcpy(). If neither is defined, roll your + * own version. */ -/* Mmap_t: - * This symbol holds the return type of the mmap() system call - * (and simultaneously the type of the first argument). - * Usually set to 'void *' or 'cadd_t'. +/*#define HAS_SAFE_BCOPY /**/ + +/* HAS_SAFE_MEMCPY: + * This symbol, if defined, indicates that the memcpy routine is available + * to copy potentially overlapping memory blocks. Otherwise you should + * probably use memmove() or memcpy(). If neither is defined, roll your + * own version. */ -/*#define HAS_MMAP /**/ -#define Mmap_t void * /**/ +/*#define HAS_SAFE_MEMCPY /**/ -/* HAS_MSG: - * This symbol, if defined, indicates that the entire msg*(2) library is - * supported (IPC mechanism based on message queues). +/* HAS_SANE_MEMCMP: + * This symbol, if defined, indicates that the memcmp routine is available + * and can be used to compare relative magnitudes of chars with their high + * bits set. If it is not defined, roll your own version. */ -/*#define HAS_MSG /**/ +#define HAS_SANE_MEMCMP /**/ /* HAS_SEM: * This symbol, if defined, indicates that the entire sem*(2) library is @@ -1828,6 +1727,12 @@ */ /*#define HAS_SETSERVENT /**/ +/* HAS_SETSPENT: + * This symbol, if defined, indicates that the setspent system call is + * available to initialize the scan of SysV shadow password entries. + */ +/*#define HAS_SETSPENT /**/ + /* HAS_SETVBUF: * This symbol, if defined, indicates that the setvbuf routine is * available to change buffering on an open stdio stream. @@ -1835,12 +1740,55 @@ */ #define HAS_SETVBUF /**/ +/* USE_SFIO: + * This symbol, if defined, indicates that sfio should + * be used. + */ +/*#define USE_SFIO /**/ + /* HAS_SHM: * This symbol, if defined, indicates that the entire shm*(2) library is * supported. */ /*#define HAS_SHM /**/ +/* HAS_SIGACTION: + * This symbol, if defined, indicates that Vr4's sigaction() routine + * is available. + */ +/*#define HAS_SIGACTION /**/ + +/* HAS_SIGSETJMP: + * This variable indicates to the C program that the sigsetjmp() + * routine is available to save the calling process's registers + * and stack environment for later use by siglongjmp(), and + * to optionally save the process's signal mask. See + * Sigjmp_buf, Sigsetjmp, and Siglongjmp. + */ +/* Sigjmp_buf: + * This is the buffer type to be used with Sigsetjmp and Siglongjmp. + */ +/* Sigsetjmp: + * This macro is used in the same way as sigsetjmp(), but will invoke + * traditional setjmp() if sigsetjmp isn't available. + * See HAS_SIGSETJMP. + */ +/* Siglongjmp: + * This macro is used in the same way as siglongjmp(), but will invoke + * traditional longjmp() if siglongjmp isn't available. + * See HAS_SIGSETJMP. + */ +/*#define HAS_SIGSETJMP /**/ +#ifdef HAS_SIGSETJMP +#define Sigjmp_buf sigjmp_buf +#define Sigsetjmp(buf,save_mask) sigsetjmp((buf),(save_mask)) +#define Siglongjmp(buf,retval) siglongjmp((buf),(retval)) +#else +#define Sigjmp_buf jmp_buf +#define Sigsetjmp(buf,save_mask) setjmp((buf)) +#define Siglongjmp(buf,retval) longjmp((buf),(retval)) +#endif + /* HAS_SOCKET: * This symbol, if defined, indicates that the BSD socket interface is * supported. @@ -1879,26 +1827,6 @@ * Checking just with #ifdef might not be enough because this symbol * has been known to be an enum. */ -/* HAS_SENDMSG: - * This symbol, if defined, indicates that the sendmsg is supported - * to send messages between sockets. You will also need struct - * iovec from , HAS_STRUCT_IOVEC and I_SYSUIO. - */ -/* HAS_RECVMSG: - * This symbol, if defined, indicates that the recvmsg is supported - * to send messages between sockets. You will also need struct - * iovec from , HAS_STRUCT_IOVEC and I_SYSUIO. - */ -/* HAS_STRUCT_MSGHDR: - * This symbol, if defined, indicates that the struct msghdr - * (BSD 4.3 or 4.4) is supported. You will also need struct - * iovec from , HAS_STRUCT_IOVEC and I_SYSUIO. - */ -/* HAS_STRUCT_CMSGHDR: - * This symbol, if defined, indicates that the struct cmsghdr - * (BSD 4.4) is supported. You will also need struct - * iovec from , HAS_STRUCT_IOVEC and I_SYSUIO. - */ #define HAS_SOCKET /**/ /*#define HAS_SOCKETPAIR /**/ /*#define HAS_MSG_CTRUNC /**/ @@ -1907,16 +1835,102 @@ /*#define HAS_MSG_PEEK /**/ /*#define HAS_MSG_PROXY /**/ /*#define HAS_SCM_RIGHTS /**/ -/*#define HAS_SENDMSG /**/ -/*#define HAS_RECVMSG /**/ -/*#define HAS_STRUCT_MSGHDR /**/ -/*#define HAS_STRUCT_CMSGHDR /**/ + +/* HAS_SQRTL: + * This symbol, if defined, indicates that the sqrtl routine is + * available to do long double square roots. + */ +/*#define HAS_SQRTL /**/ /* USE_STAT_BLOCKS: * This symbol is defined if this system has a stat structure declaring * st_blksize and st_blocks. */ +#ifndef USE_STAT_BLOCKS /*#define USE_STAT_BLOCKS /**/ +#endif + +/* HAS_STRUCT_STATFS_F_FLAGS: + * This symbol, if defined, indicates that the struct statfs + * does have the f_flags member containing the mount flags of + * the filesystem containing the file. + * This kind of struct statfs is coming from (BSD 4.3), + * not from (SYSV). Older BSDs (like Ultrix) do not + * have statfs() and struct statfs, they have ustat() and getmnt() + * with struct ustat and struct fs_data. + */ +/*#define HAS_STRUCT_STATFS_F_FLAGS /**/ + +/* HAS_STRUCT_STATFS: + * This symbol, if defined, indicates that the struct statfs + * to do statfs() is supported. + */ +/*#define HAS_STRUCT_STATFS /**/ + +/* HAS_FSTATVFS: + * This symbol, if defined, indicates that the fstatvfs routine is + * available to stat filesystems by file descriptors. + */ +/*#define HAS_FSTATVFS /**/ + +/* USE_STDIO_PTR: + * This symbol is defined if the _ptr and _cnt fields (or similar) + * of the stdio FILE structure can be used to access the stdio buffer + * for a file handle. If this is defined, then the FILE_ptr(fp) + * and FILE_cnt(fp) macros will also be defined and should be used + * to access these fields. + */ +/* FILE_ptr: + * This macro is used to access the _ptr field (or equivalent) of the + * FILE structure pointed to by its argument. This macro will always be + * defined if USE_STDIO_PTR is defined. + */ +/* STDIO_PTR_LVALUE: + * This symbol is defined if the FILE_ptr macro can be used as an + * lvalue. + */ +/* FILE_cnt: + * This macro is used to access the _cnt field (or equivalent) of the + * FILE structure pointed to by its argument. This macro will always be + * defined if USE_STDIO_PTR is defined. + */ +/* STDIO_CNT_LVALUE: + * This symbol is defined if the FILE_cnt macro can be used as an + * lvalue. + */ +#define USE_STDIO_PTR /**/ +#ifdef USE_STDIO_PTR +#define FILE_ptr(fp) ((fp)->_ptr) +#define STDIO_PTR_LVALUE /**/ +#define FILE_cnt(fp) ((fp)->_cnt) +#define STDIO_CNT_LVALUE /**/ +#endif + +/* USE_STDIO_BASE: + * This symbol is defined if the _base field (or similar) of the + * stdio FILE structure can be used to access the stdio buffer for + * a file handle. If this is defined, then the FILE_base(fp) macro + * will also be defined and should be used to access this field. + * Also, the FILE_bufsiz(fp) macro will be defined and should be used + * to determine the number of bytes in the buffer. USE_STDIO_BASE + * will never be defined unless USE_STDIO_PTR is. + */ +/* FILE_base: + * This macro is used to access the _base field (or equivalent) of the + * FILE structure pointed to by its argument. This macro will always be + * defined if USE_STDIO_BASE is defined. + */ +/* FILE_bufsiz: + * This macro is used to determine the number of bytes in the I/O + * buffer pointed to by _base field (or equivalent) of the FILE + * structure pointed to its argument. This macro will always be defined + * if USE_STDIO_BASE is defined. + */ +#define USE_STDIO_BASE /**/ +#ifdef USE_STDIO_BASE +#define FILE_base(fp) ((fp)->_base) +#define FILE_bufsiz(fp) ((fp)->_cnt + (fp)->_ptr - (fp)->_base) +#endif /* HAS_STRERROR: * This symbol, if defined, indicates that the strerror routine is @@ -1937,6 +1951,52 @@ #define HAS_SYS_ERRLIST /**/ #define Strerror(e) strerror(e) +/* HAS_STRTOLD: + * This symbol, if defined, indicates that the strtold routine is + * available to convert strings to long doubles. + */ +/*#define HAS_STRTOLD /**/ + +/* HAS_STRTOLL: + * This symbol, if defined, indicates that the strtoll routine is + * available to convert strings to long longs. + */ +/*#define HAS_STRTOLL /**/ + +/* HAS_STRTOULL: + * This symbol, if defined, indicates that the strtoull routine is + * available to convert strings to unsigned long longs. + */ +/*#define HAS_STRTOULL /**/ + +/* HAS_STRTOUQ: + * This symbol, if defined, indicates that the strtouq routine is + * available to convert strings to unsigned long longs (quads). + */ +/*#define HAS_STRTOUQ /**/ + +/* HAS_TELLDIR_PROTO: + * This symbol, if defined, indicates that the system provides + * a prototype for the telldir() function. Otherwise, it is up + * to the program to supply one. A good guess is + * extern long telldir _((DIR*)); + */ +#define HAS_TELLDIR_PROTO /**/ + +/* Time_t: + * This symbol holds the type returned by time(). It can be long, + * or time_t on BSD sites (in which case should be + * included). + */ +#define Time_t time_t /* Time type */ + +/* HAS_TIMES: + * This symbol, if defined, indicates that the times() routine exists. + * Note that this became obsolete on some systems (SUNOS), which now + * use getrusage(). It may be necessary to include . + */ +#define HAS_TIMES /**/ + /* HAS_UNION_SEMUN: * This symbol, if defined, indicates that the union semun is * defined by including . If not, the user code @@ -1959,6 +2019,12 @@ /*#define USE_SEMCTL_SEMUN /**/ /*#define USE_SEMCTL_SEMID_DS /**/ +/* HAS_USTAT: + * This symbol, if defined, indicates that the ustat system call is + * available to query file system statistics by dev_t. + */ +/*#define HAS_USTAT /**/ + /* HAS_VFORK: * This symbol, if defined, indicates that vfork() exists. */ @@ -1970,7 +2036,79 @@ * a signal handler using "Signal_t (*handler)()", and define the * handler using "Signal_t handler(sig)". */ -#define Signal_t void /* Signal handler's return type */ +#define Signal_t void /* Signal handler's return type */ + +/* HAS_VPRINTF: + * This symbol, if defined, indicates that the vprintf routine is available + * to printf with a pointer to an argument list. If unavailable, you + * may need to write your own, probably in terms of _doprnt(). + */ +/* USE_CHAR_VSPRINTF: + * This symbol is defined if this system has vsprintf() returning type + * (char*). The trend seems to be to declare it as "int vsprintf()". It + * is up to the package author to declare vsprintf correctly based on the + * symbol. + */ +#define HAS_VPRINTF /**/ +/*#define USE_CHAR_VSPRINTF /**/ + +/* USE_DYNAMIC_LOADING: + * This symbol, if defined, indicates that dynamic loading of + * some sort is available. + */ +#define USE_DYNAMIC_LOADING /**/ + +/* DOUBLESIZE: + * This symbol contains the size of a double, so that the C preprocessor + * can make decisions based on it. + */ +#define DOUBLESIZE 8 /**/ + +/* EBCDIC: + * This symbol, if defined, indicates that this system uses + * EBCDIC encoding. + */ +/*#define EBCDIC /**/ + +/* FFLUSH_NULL: + * This symbol, if defined, tells that fflush(NULL) does flush + * all pending stdio output. + */ +/* FFLUSH_ALL: + * This symbol, if defined, tells that to flush + * all pending stdio output one must loop through all + * the stdio file handles stored in an array and fflush them. + * Note that if fflushNULL is defined, fflushall will not + * even be probed for and will be left undefined. + */ +#define FFLUSH_NULL /**/ +/*#define FFLUSH_ALL /**/ + +/* Fpos_t: + * This symbol holds the type used to declare file positions in libc. + * It can be fpos_t, long, uint, etc... It may be necessary to include + * to get any typedef'ed information. + */ +#define Fpos_t fpos_t /* File position type */ + +/* Gid_t_f: + * This symbol defines the format string used for printing a Gid_t. + */ +#define Gid_t_f "ld" /**/ + +/* Gid_t_size: + * This symbol holds the size of a Gid_t in bytes. + */ +#define Gid_t_size 4 /* GID size */ + +/* Gid_t: + * This symbol holds the return type of getgid() and the type of + * argument to setrgid() and related functions. Typically, + * it is the type of group ids in the kernel. It can be int, ushort, + * uid_t, etc... It may be necessary to include to get + * any typedef'ed information. + */ +#define Gid_t gid_t /* Type for getgid(), etc... */ /* Groups_t: * This symbol holds the type used for the second argument to @@ -1985,6 +2123,19 @@ #define Groups_t gid_t /* Type for 2nd arg to [sg]etgroups() */ #endif +/* DB_Prefix_t: + * This symbol contains the type of the prefix structure element + * in the header file. In older versions of DB, it was + * int, while in newer ones it is u_int32_t. + */ +/* DB_Hash_t: + * This symbol contains the type of the prefix structure element + * in the header file. In older versions of DB, it was + * int, while in newer ones it is size_t. + */ +#define DB_Hash_t int /**/ +#define DB_Prefix_t int /**/ + /* I_GRP: * This symbol, if defined, indicates to the C program that it should * include . @@ -1996,12 +2147,48 @@ /*#define I_GRP /**/ /*#define GRPASSWD /**/ +/* I_INTTYPES: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +/*#define I_INTTYPES /**/ + +/* I_MACH_CTHREADS: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +/*#define I_MACH_CTHREADS /**/ + +/* I_MNTENT: + * This symbol, if defined, indicates that exists and + * should be included. + */ +/*#define I_MNTENT /**/ + /* I_NETDB: * This symbol, if defined, indicates that exists and * should be included. */ /*#define I_NETDB /**/ +/* I_NETINET_TCP: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +/*#define I_NETINET_TCP /**/ + +/* I_POLL: + * This symbol, if defined, indicates that exists and + * should be included. + */ +/*#define I_POLL /**/ + +/* I_PTHREAD: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +/*#define I_PTHREAD /**/ + /* I_PWD: * This symbol, if defined, indicates to the C program that it should * include . @@ -2048,12 +2235,113 @@ /*#define PWGECOS /**/ /*#define PWPASSWD /**/ +/* I_SHADOW: + * This symbol, if defined, indicates that exists and + * should be included. + */ +/*#define I_SHADOW /**/ + +/* I_SOCKS: + * This symbol, if defined, indicates that exists and + * should be included. + */ +/*#define I_SOCKS /**/ + +/* I_SYS_MOUNT: + * This symbol, if defined, indicates that exists and + * should be included. + */ +/*#define I_SYS_MOUNT /**/ + +/* I_SYS_STATFS: + * This symbol, if defined, indicates that exists. + */ +/*#define I_SYS_STATFS /**/ + +/* I_SYS_STATVFS: + * This symbol, if defined, indicates that exists and + * should be included. + */ +/*#define I_SYS_STATVFS /**/ + /* I_SYSUIO: * This symbol, if defined, indicates that exists and * should be included. */ /*#define I_SYSUIO /**/ +/* I_SYS_VFS: + * This symbol, if defined, indicates that exists and + * should be included. + */ +/*#define I_SYS_VFS /**/ + +/* I_TIME: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +/* I_SYS_TIME: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +/* I_SYS_TIME_KERNEL: + * This symbol, if defined, indicates to the C program that it should + * include with KERNEL defined. + */ +#define I_TIME /**/ +/*#define I_SYS_TIME /**/ +/*#define I_SYS_TIME_KERNEL /**/ + +/* I_USTAT: + * This symbol, if defined, indicates that exists and + * should be included. + */ +/*#define I_USTAT /**/ + +/* PERL_INC_VERSION_LIST: + * This variable specifies the list of subdirectories in over + * which perl.c:incpush() and lib/lib.pm will automatically + * search when adding directories to @INC, in a format suitable + * for a C initialization string. See the inc_version_list entry + * in Porting/Glossary for more details. + */ +#define PERL_INC_VERSION_LIST /**/ + +/* HAS_OFF64_T: + * This symbol will be defined if the C compiler supports off64_t. + */ +/* HAS_FPOS64_T: + * This symbol will be defined if the C compiler supports fpos64_t. + */ +/*#define HAS_OFF64_T /**/ +/*#define HAS_FPOS64_T /**/ + +/* PERL_PRIfldbl: + * This symbol, if defined, contains the string used by stdio to + * format long doubles (format 'f') for output. + */ +/* PERL_PRIgldbl: + * This symbol, if defined, contains the string used by stdio to + * format long doubles (format 'g') for output. + */ +/*#define PERL_PRIfldbl "f" /**/ +/*#define PERL_PRIgldbl "g" /**/ + +/* Off_t: + * This symbol holds the type used to declare offsets in the kernel. + * It can be int, long, off_t, etc... It may be necessary to include + * to get any typedef'ed information. + */ +/* LSEEKSIZE: + * This symbol holds the number of bytes used by the Off_t. + */ +/* Off_t_size: + * This symbol holds the number of bytes used by the Off_t. + */ +#define Off_t off_t /* type */ +#define LSEEKSIZE 4 /* size */ +#define Off_t_size 4 /* size */ + /* Free_t: * This variable contains the return type of free(). It is usually * void, but occasionally int. @@ -2069,347 +2357,326 @@ */ /*#define MYMALLOC /**/ -/* SIG_NAME: - * This symbol contains a list of signal names in order of - * signal number. This is intended - * to be used as a static array initialization, like this: - * char *sig_name[] = { SIG_NAME }; - * The signals in the list are separated with commas, and each signal - * is surrounded by double quotes. There is no leading SIG in the signal - * name, i.e. SIGQUIT is known as "QUIT". - * Gaps in the signal numbers (up to NSIG) are filled in with NUMnn, - * etc., where nn is the actual signal number (e.g. NUM37). - * The signal number for sig_name[i] is stored in sig_num[i]. - * The last element is 0 to terminate the list with a NULL. This - * corresponds to the 0 at the end of the sig_num list. - */ -/* SIG_NUM: - * This symbol contains a list of signal numbers, in the same order as the - * SIG_NAME list. It is suitable for static array initialization, as in: - * int sig_num[] = { SIG_NUM }; - * The signals in the list are separated with commas, and the indices - * within that list and the SIG_NAME list match, so it's easy to compute - * the signal name from a number or vice versa at the price of a small - * dynamic linear lookup. - * Duplicates are allowed, but are moved to the end of the list. - * The signal number corresponding to sig_name[i] is sig_number[i]. - * if (i < NSIG) then sig_number[i] == i. - * The last element is 0, corresponding to the 0 at the end of - * the sig_name list. +/* Mode_t: + * This symbol holds the type used to declare file modes + * for systems calls. It is usually mode_t, but may be + * int or unsigned short. It may be necessary to include + * to get any typedef'ed information. */ -#define SIG_NAME "ZERO", "NUM01", "INT", "QUIT", "ILL", "NUM05", "NUM06", "NUM07", "FPE", "KILL", "NUM10", "SEGV", "NUM12", "PIPE", "ALRM", "TERM", "NUM16", "NUM17", "NUM18", "NUM19", "CHLD", "BREAK", "ABRT", "STOP", "NUM24", "CONT", "CLD", 0 /**/ -#define SIG_NUM 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 20, 0 /**/ +#define Mode_t mode_t /* file mode parameter for system calls */ -/* VOIDFLAGS: - * This symbol indicates how much support of the void type is given by this - * compiler. What various bits mean: - * - * 1 = supports declaration of void - * 2 = supports arrays of pointers to functions returning void - * 4 = supports comparisons between pointers to void functions and - * addresses of void functions - * 8 = suports declaration of generic void pointers - * - * The package designer should define VOIDUSED to indicate the requirements - * of the package. This can be done either by #defining VOIDUSED before - * including config.h, or by defining defvoidused in Myinit.U. If the - * latter approach is taken, only those flags will be tested. If the - * level of void support necessary is not present, defines void to int. +/* VAL_O_NONBLOCK: + * This symbol is to be used during open() or fcntl(F_SETFL) to turn on + * non-blocking I/O for the file descriptor. Note that there is no way + * back, i.e. you cannot turn it blocking again this way. If you wish to + * alternatively switch between blocking and non-blocking, use the + * ioctl(FIOSNBIO) call instead, but that is not supported by all devices. */ -#ifndef VOIDUSED -#define VOIDUSED 15 -#endif -#define VOIDFLAGS 15 -#if (VOIDFLAGS & VOIDUSED) != VOIDUSED -#define void int /* is void to be avoided? */ -#define M_VOID /* Xenix strikes again */ -#endif - -/* HAS_ATOLF: - * This symbol, if defined, indicates that the atolf routine is - * available to convert strings into long doubles. +/* VAL_EAGAIN: + * This symbol holds the errno error code set by read() when no data was + * present on the non-blocking file descriptor. */ -/*#define HAS_ATOLF /**/ - -/* HAS_ATOLL: - * This symbol, if defined, indicates that the atoll routine is - * available to convert strings into long longs. +/* RD_NODATA: + * This symbol holds the return code from read() when no data is present + * on the non-blocking file descriptor. Be careful! If EOF_NONBLOCK is + * not defined, then you can't distinguish between no data and EOF by + * issuing a read(). You'll have to find another way to tell for sure! */ -/*#define HAS_ATOLL /**/ - -/* PERL_BINCOMPAT_5005: - * This symbol, if defined, indicates that Perl 5.006 should be - * binary-compatible with Perl 5.005. This is impossible for builds - * that use features like threads and multiplicity it is always undef - * for those versions. +/* EOF_NONBLOCK: + * This symbol, if defined, indicates to the C program that a read() on + * a non-blocking file descriptor will return 0 on EOF, and not the value + * held in RD_NODATA (-1 usually, in that case!). */ -/*#define PERL_BINCOMPAT_5005 /**/ +#define VAL_O_NONBLOCK O_NONBLOCK +#define VAL_EAGAIN EAGAIN +#define RD_NODATA -1 +#define EOF_NONBLOCK -/* DLSYM_NEEDS_UNDERSCORE: - * This symbol, if defined, indicates that we need to prepend an - * underscore to the symbol name before calling dlsym(). This only - * makes sense if you *have* dlsym, which we will presume is the - * case if you're using dl_dlopen.xs. +/* Netdb_host_t: + * This symbol holds the type used for the 1st argument + * to gethostbyaddr(). */ -/*#define DLSYM_NEEDS_UNDERSCORE /**/ - -/* HAS_ENDSPENT: - * This symbol, if defined, indicates that the endspent system call is - * available to finalize the scan of SysV shadow password entries. +/* Netdb_hlen_t: + * This symbol holds the type used for the 2nd argument + * to gethostbyaddr(). + */ +/* Netdb_name_t: + * This symbol holds the type used for the argument to + * gethostbyname(). + */ +/* Netdb_net_t: + * This symbol holds the type used for the 1st argument to + * getnetbyaddr(). */ -/*#define HAS_ENDSPENT /**/ +#define Netdb_host_t char * /**/ +#define Netdb_hlen_t int /**/ +#define Netdb_name_t char * /**/ +#define Netdb_net_t long /**/ -/* HAS_FSEEKO: - * This symbol, if defined, indicates that the fseeko routine is - * available to fseek beyond 32 bits (useful for ILP32 hosts). +/* IVTYPE: + * This symbol defines the C type used for Perl's IV. */ -/*#define HAS_FSEEKO /**/ - -/* HAS_FTELLO: - * This symbol, if defined, indicates that the ftello routine is - * available to ftell beyond 32 bits (useful for ILP32 hosts). +/* UVTYPE: + * This symbol defines the C type used for Perl's UV. */ -/*#define HAS_FTELLO /**/ - -/* HAS_GETMNTENT: - * This symbol, if defined, indicates that the getmntent routine is - * available to iterate through mounted file systems. +/* I8TYPE: + * This symbol defines the C type used for Perl's I8. */ -/*#define HAS_GETMNTENT /**/ - -/* HAS_GETSPENT: - * This symbol, if defined, indicates that the getspent system call is - * available to retrieve SysV shadow password entries sequentially. +/* U8TYPE: + * This symbol defines the C type used for Perl's U8. */ -/*#define HAS_GETSPENT /**/ - -/* HAS_GETSPNAM: - * This symbol, if defined, indicates that the getspnam system call is - * available to retrieve SysV shadow password entries by name. +/* I16TYPE: + * This symbol defines the C type used for Perl's I16. */ -/*#define HAS_GETSPNAM /**/ - -/* HAS_HASMNTOPT: - * This symbol, if defined, indicates that the hasmntopt routine is - * available to query the mount options of file systems. +/* U16TYPE: + * This symbol defines the C type used for Perl's U16. */ -/*#define HAS_HASMNTOPT /**/ - -/* HAS_LDBL_DIG: - * This symbol, if defined, indicates that this system's - * or defines the symbol LDBL_DIG, which is the number - * of significant digits in a long double precision number. Unlike - * for DBL_DIG, there's no good guess for LDBL_DIG if it is undefined. +/* I32TYPE: + * This symbol defines the C type used for Perl's I32. */ -#define HAS_LDBL_DIG /**/ - -/* HAS_MADVISE: - * This symbol, if defined, indicates that the madvise system call is - * available to map a file into memory. +/* U32TYPE: + * This symbol defines the C type used for Perl's U32. */ -/*#define HAS_MADVISE /**/ - -/* HAS_MPROTECT: - * This symbol, if defined, indicates that the mprotect system call is - * available to modify the access protection of a memory mapped file. +/* I64TYPE: + * This symbol defines the C type used for Perl's I64. */ -/*#define HAS_MPROTECT /**/ - -/* HAS_READV: - * This symbol, if defined, indicates that the readv routine is - * available to do gather reads. You will also need - * and there I_SYSUIO. +/* U64TYPE: + * This symbol defines the C type used for Perl's U64. */ -/*#define HAS_READV /**/ - -/* HAS_SETSPENT: - * This symbol, if defined, indicates that the setspent system call is - * available to initialize the scan of SysV shadow password entries. +/* NVTYPE: + * This symbol defines the C type used for Perl's NV. */ -/*#define HAS_SETSPENT /**/ - -/* USE_SFIO: - * This symbol, if defined, indicates that sfio should - * be used. +/* IVSIZE: + * This symbol contains the sizeof(IV). */ -/*#define USE_SFIO /**/ - -/* HAS_FSTATFS: - * This symbol, if defined, indicates that the fstatfs routine is - * available to stat filesystems of file descriptors. +/* UVSIZE: + * This symbol contains the sizeof(UV). */ -/* HAS_STRUCT_STATFS_FLAGS: - * This symbol, if defined, indicates that the struct statfs - * does have the f_flags member containing the mount flags of - * the filesystem holding the file. - * This kind of struct statfs is coming from sys/mount.h (BSD), - * not from sys/statfs.h (SYSV). +/* I8SIZE: + * This symbol contains the sizeof(I8). */ -/*#define HAS_FSTATFS /**/ -/*#define HAS_STRUCT_STATFS_FLAGS /**/ - -/* HAS_FSTATVFS: - * This symbol, if defined, indicates that the fstatvfs routine is - * available to stat filesystems of file descriptors. +/* U8SIZE: + * This symbol contains the sizeof(U8). */ -/*#define HAS_FSTATVFS /**/ - -/* HAS_TELLDIR_PROTO: - * This symbol, if defined, indicates that the system provides - * a prototype for the telldir() function. Otherwise, it is up - * to the program to supply one. A good guess is - * extern long telldir _((DIR*)); +/* I16SIZE: + * This symbol contains the sizeof(I16). */ -#define HAS_TELLDIR_PROTO /**/ - -/* HAS_WRITEV: - * This symbol, if defined, indicates that the writev routine is - * available to do scatter writes. +/* U16SIZE: + * This symbol contains the sizeof(U16). */ -/*#define HAS_WRITEV /**/ - -/* USE_DYNAMIC_LOADING: - * This symbol, if defined, indicates that dynamic loading of - * some sort is available. +/* I32SIZE: + * This symbol contains the sizeof(I32). */ -#define USE_DYNAMIC_LOADING /**/ - -/* FFLUSH_NULL: - * This symbol, if defined, tells that fflush(NULL) does flush - * all pending stdio output. +/* U32SIZE: + * This symbol contains the sizeof(U32). */ -/* FFLUSH_ALL: - * This symbol, if defined, tells that to flush - * all pending stdio output one must loop through all - * the stdio file handles stored in an array and fflush them. - * Note that if fflushNULL is defined, fflushall will not - * even be probed for and will be left undefined. +/* I64SIZE: + * This symbol contains the sizeof(I64). */ -#define FFLUSH_NULL /**/ -/*#define FFLUSH_ALL /**/ +/* U64SIZE: + * This symbol contains the sizeof(U64). + */ +#define IVTYPE long /**/ +#define UVTYPE unsigned long /**/ +#define I8TYPE char /**/ +#define U8TYPE unsigned char /**/ +#define I16TYPE short /**/ +#define U16TYPE unsigned short /**/ +#define I32TYPE long /**/ +#define U32TYPE unsigned long /**/ +#ifdef HAS_QUAD +#define I64TYPE __int64 /**/ +#define U64TYPE unsigned __int64 /**/ +#endif +#define NVTYPE double /**/ +#define IVSIZE 4 /**/ +#define UVSIZE 4 /**/ +#define I8SIZE 1 /**/ +#define U8SIZE 1 /**/ +#define I16SIZE 2 /**/ +#define U16SIZE 2 /**/ +#define I32SIZE 4 /**/ +#define U32SIZE 4 /**/ +#ifdef HAS_QUAD +#define I64SIZE 8 /**/ +#define U64SIZE 8 /**/ +#endif -/* DB_Prefix_t: - * This symbol contains the type of the prefix structure element - * in the header file. In older versions of DB, it was - * int, while in newer ones it is u_int32_t. +/* IVdf: + * This symbol defines the format string used for printing a Perl IV + * as a signed decimal integer. */ -/* DB_Hash_t: - * This symbol contains the type of the prefix structure element - * in the header file. In older versions of DB, it was - * int, while in newer ones it is size_t. +/* UVuf: + * This symbol defines the format string used for printing a Perl UV + * as an unsigned decimal integer. */ -#define DB_Hash_t int /**/ -#define DB_Prefix_t int /**/ - -/* I_INTTYPES: - * This symbol, if defined, indicates to the C program that it should - * include . +/* UVof: + * This symbol defines the format string used for printing a Perl UV + * as an unsigned octal integer. */ -/* HAS_INT64_T: - * This symbol will defined if the C compiler supports int64_t. - * Usually the needs to be included, but sometimes - * is enough. +/* UVxf: + * This symbol defines the format string used for printing a Perl UV + * as an unsigned hexadecimal integer. */ -/*#define I_INTTYPES /**/ -/*#define HAS_INT64_T /**/ +#define IVdf "ld" /**/ +#define UVuf "lu" /**/ +#define UVof "lo" /**/ +#define UVxf "lx" /**/ -/* I_MNTENT: - * This symbol, if defined, indicates that exists and - * should be included. +/* Pid_t: + * This symbol holds the type used to declare process ids in the kernel. + * It can be int, uint, pid_t, etc... It may be necessary to include + * to get any typedef'ed information. */ -/*#define I_MNTENT /**/ +#define Pid_t int /* PID type */ -/* I_NETINET_TCP: - * This symbol, if defined, indicates to the C program that it should - * include . +/* PRIVLIB: + * This symbol contains the name of the private library for this package. + * The library is private in the sense that it needn't be in anyone's + * execution path, but it should be accessible by the world. The program + * should be prepared to do ~ expansion. */ -/*#define I_NETINET_TCP /**/ - -/* I_POLL: - * This symbol, if defined, indicates that exists and - * should be included. +/* PRIVLIB_EXP: + * This symbol contains the ~name expanded version of PRIVLIB, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. */ -/*#define I_POLL /**/ +#define PRIVLIB "c:\\perl\\5.5.640\\lib" /**/ +#define PRIVLIB_EXP (win32_get_privlib("5.5.640")) /**/ -/* I_SHADOW: - * This symbol, if defined, indicates that exists and - * should be included. +/* PTRSIZE: + * This symbol contains the size of a pointer, so that the C preprocessor + * can make decisions based on it. It will be sizeof(void *) if + * the compiler supports (void *); otherwise it will be + * sizeof(char *). */ -/*#define I_SHADOW /**/ +#define PTRSIZE 4 /**/ -/* I_SOCKS: - * This symbol, if defined, indicates that exists and - * should be included. +/* Drand01: + * This macro is to be used to generate uniformly distributed + * random numbers over the range [0., 1.[. You may have to supply + * an 'extern double drand48();' in your program since SunOS 4.1.3 + * doesn't provide you with anything relevant in it's headers. + * See HAS_DRAND48_PROTO. */ -/*#define I_SOCKS /**/ - -/* I_SYS_MMAN: - * This symbol, if defined, indicates that exists and - * should be included. +/* Rand_seed_t: + * This symbol defines the type of the argument of the + * random seed function. */ -/*#define I_SYS_MMAN /**/ +/* seedDrand01: + * This symbol defines the macro to be used in seeding the + * random number generator (see Drand01). + */ +/* RANDBITS: + * This symbol indicates how many bits are produced by the + * function used to generate normalized random numbers. + * Values include 15, 16, 31, and 48. + */ +#define Drand01() (rand()/(double)((unsigned)1< exists and - * should be included. +/* SELECT_MIN_BITS: + * This symbol holds the minimum number of bits operated by select. + * That is, if you do select(n, ...), how many bits at least will be + * cleared in the masks if some activity is detected. Usually this + * is either n or 32*ceil(n/32), especially many little-endians do + * the latter. This is only useful if you have select(), naturally. */ -/*#define I_SYS_MOUNT /**/ +#define SELECT_MIN_BITS 32 /**/ -/* I_SYS_STATVFS: - * This symbol, if defined, indicates that exists and - * should be included. +/* Select_fd_set_t: + * This symbol holds the type used for the 2nd, 3rd, and 4th + * arguments to select. Usually, this is 'fd_set *', if HAS_FD_SET + * is defined, and 'int *' otherwise. This is only useful if you + * have select(), of course. */ -/*#define I_SYS_STATVFS /**/ +#define Select_fd_set_t Perl_fd_set * /**/ -/* HAS_OFF64_T: - * This symbol will be defined if the C compiler supports off64_t. +/* SIG_NAME: + * This symbol contains a list of signal names in order of + * signal number. This is intended + * to be used as a static array initialization, like this: + * char *sig_name[] = { SIG_NAME }; + * The signals in the list are separated with commas, and each signal + * is surrounded by double quotes. There is no leading SIG in the signal + * name, i.e. SIGQUIT is known as "QUIT". + * Gaps in the signal numbers (up to NSIG) are filled in with NUMnn, + * etc., where nn is the actual signal number (e.g. NUM37). + * The signal number for sig_name[i] is stored in sig_num[i]. + * The last element is 0 to terminate the list with a NULL. This + * corresponds to the 0 at the end of the sig_num list. */ -/* HAS_FPOS64_T: - * This symbol will be defined if the C compiler supports fpos64_t. +/* SIG_NUM: + * This symbol contains a list of signal numbers, in the same order as the + * SIG_NAME list. It is suitable for static array initialization, as in: + * int sig_num[] = { SIG_NUM }; + * The signals in the list are separated with commas, and the indices + * within that list and the SIG_NAME list match, so it's easy to compute + * the signal name from a number or vice versa at the price of a small + * dynamic linear lookup. + * Duplicates are allowed, but are moved to the end of the list. + * The signal number corresponding to sig_name[i] is sig_number[i]. + * if (i < NSIG) then sig_number[i] == i. + * The last element is 0, corresponding to the 0 at the end of + * the sig_name list. */ -/*#define HAS_OFF64_T /**/ -/*#define HAS_FPOS64_T /**/ +#define SIG_NAME "ZERO", "NUM01", "INT", "QUIT", "ILL", "NUM05", "NUM06", "NUM07", "FPE", "KILL", "NUM10", "SEGV", "NUM12", "PIPE", "ALRM", "TERM", "NUM16", "NUM17", "NUM18", "NUM19", "CHLD", "BREAK", "ABRT", "STOP", "NUM24", "CONT", "CLD", 0 /**/ +#define SIG_NUM 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 20, 0 /**/ -/* PERL_PRIfldbl: - * This symbol, if defined, contains the string used by stdio to - * format long doubles (format 'f') for output. +/* SITEARCH: + * This symbol contains the name of the private library for this package. + * The library is private in the sense that it needn't be in anyone's + * execution path, but it should be accessible by the world. The program + * should be prepared to do ~ expansion. + * The standard distribution will put nothing in this directory. + * After perl has been installed, users may install their own local + * architecture-dependent modules in this directory with + * MakeMaker Makefile.PL + * or equivalent. See INSTALL for details. */ -/* PERL_PRIgldbl: - * This symbol, if defined, contains the string used by stdio to - * format long doubles (format 'g') for output. +/* SITEARCH_EXP: + * This symbol contains the ~name expanded version of SITEARCH, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. */ -/*#define PERL_PRIfldbl undef /**/ -/*#define PERL_PRIgldbl undef /**/ +#define SITEARCH "c:\\perl\\site\\5.5.640\\lib\\MSWin32-x86" /**/ +/*#define SITEARCH_EXP "" /**/ -/* PERL_PRId64: - * This symbol, if defined, contains the string used by stdio to - * format 64-bit decimal numbers (format 'd') for output. - */ -/* PERL_PRIu64: - * This symbol, if defined, contains the string used by stdio to - * format 64-bit unsigned decimal numbers (format 'u') for output. +/* SITELIB: + * This symbol contains the name of the private library for this package. + * The library is private in the sense that it needn't be in anyone's + * execution path, but it should be accessible by the world. The program + * should be prepared to do ~ expansion. + * The standard distribution will put nothing in this directory. + * After perl has been installed, users may install their own local + * architecture-independent modules in this directory with + * MakeMaker Makefile.PL + * or equivalent. See INSTALL for details. */ -/* PERL_PRIo64: - * This symbol, if defined, contains the string used by stdio to - * format 64-bit octal numbers (format 'o') for output. +/* SITELIB_EXP: + * This symbol contains the ~name expanded version of SITELIB, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. */ -/* PERL_PRIx64: - * This symbol, if defined, contains the string used by stdio to - * format 64-bit hexadecimal numbers (format 'x') for output. +#define SITELIB "c:\\perl\\site\\5.5.640\\lib" /**/ +#define SITELIB_EXP (win32_get_sitelib("5.5.640")) /**/ + +/* Size_t: + * This symbol holds the type used to declare length parameters + * for string functions. It is usually size_t, but may be + * unsigned long, int, etc. It may be necessary to include + * to get any typedef'ed information. */ -/*#define PERL_PRId64 undef /**/ -/*#define PERL_PRIu64 undef /**/ -/*#define PERL_PRIo64 undef /**/ -/*#define PERL_PRIx64 undef /**/ +#define Size_t size_t /* length paramater for string functions */ -/* SELECT_MIN_BITS: - * This symbol holds the minimum number of bits operated by select. - * That is, if you do select(n, ...), how many bits at least will be - * cleared in the masks if some activity is detected. Usually this - * is either n or 32*ceil(n/32), especially many little-endians do - * the latter. This is only useful if you have select(), naturally. +/* SSize_t: + * This symbol holds the type used by functions that return + * a count of bytes or an error condition. It must be a signed type. + * It is usually ssize_t, but may be long or int, etc. + * It may be necessary to include or + * to get any typedef'ed information. + * We will pick a type such that sizeof(SSize_t) == sizeof(Size_t). */ -#define SELECT_MIN_BITS 32 /**/ +#define SSize_t int /* signed count of bytes */ /* STARTPERL: * This variable contains the string to put in front of a perl @@ -2427,238 +2694,136 @@ * Usual values include _iob, __iob, and __sF. */ /*#define HAS_STDIO_STREAM_ARRAY /**/ -#define STDIO_STREAM_ARRAY undef +#define STDIO_STREAM_ARRAY -/* HAS_STRTOULL: - * This symbol, if defined, indicates that the strtoull routine is - * available to convert strings into unsigned long longs. +/* Uid_t_f: + * This symbol defines the format string used for printing a Uid_t. */ -/*#define HAS_STRTOULL /**/ +#define Uid_t_f "ld" /**/ + +/* Uid_t_size: + * This symbol holds the size of a Uid_t in bytes. + */ +#define Uid_t_size 4 /* UID size */ + +/* Uid_t: + * This symbol holds the type used to declare user ids in the kernel. + * It can be int, ushort, uid_t, etc... It may be necessary to include + * to get any typedef'ed information. + */ +#define Uid_t uid_t /* UID type */ /* USE_64_BITS: - * This symbol, if defined, indicates that 64-bit interfaces should - * be used when available. If not defined, the native default interfaces + * This symbol, if defined, indicates that 64-bit integers should + * be used when available. If not defined, the native integers * will be used (be they 32 or 64 bits). */ +#ifndef USE_64_BITS /*#define USE_64_BITS /**/ +#endif + +/* USE_LARGE_FILES: + * This symbol, if defined, indicates that large file support + * should be used when available. The USE_64_BITS symbol will + * also be turned on if necessary. + */ +#ifndef USE_LARGE_FILES +/*#define USE_LARGE_FILES /**/ +#endif /* USE_LONG_DOUBLE: * This symbol, if defined, indicates that long doubles should * be used when available. */ +#ifndef USE_LONG_DOUBLE /*#define USE_LONG_DOUBLE /**/ +#endif + +/* USE_LONG_LONG: + * This symbol, if defined, indicates that long longs should + * be used when available. + */ +#ifndef USE_LONG_LONG +/*#define USE_LONG_LONG /**/ +#endif + +#ifndef USE_MORE_BITS +/*#define USE_MORE_BITS /**/ +#endif /* MULTIPLICITY: * This symbol, if defined, indicates that Perl should * be built to use multiplicity. */ +#ifndef MULTIPLICTY /*#define MULTIPLICITY /**/ +#endif /* USE_PERLIO: * This symbol, if defined, indicates that the PerlIO abstraction should * be used throughout. If not defined, stdio should be * used in a fully backward compatible manner. */ +#ifndef USE_PERLIO /*#define USE_PERLIO /**/ +#endif /* USE_SOCKS: * This symbol, if defined, indicates that Perl should * be built to use socks. */ +#ifndef USE_SOCKS /*#define USE_SOCKS /**/ +#endif -/* HAS_DRAND48_PROTO: - * This symbol, if defined, indicates that the system provides - * a prototype for the drand48() function. Otherwise, it is up - * to the program to supply one. A good guess is - * extern double drand48 _((void)); - */ -/*#define HAS_DRAND48_PROTO /**/ - -/* HAS_GETHOST_PROTOS: - * This symbol, if defined, indicates that includes - * prototypes for gethostent(), gethostbyname(), and - * gethostbyaddr(). Otherwise, it is up to the program to guess - * them. See netdbtype.U for probing for various Netdb_xxx_t types. - */ -#define HAS_GETHOST_PROTOS /**/ - -/* HAS_GETNET_PROTOS: - * This symbol, if defined, indicates that includes - * prototypes for getnetent(), getnetbyname(), and - * getnetbyaddr(). Otherwise, it is up to the program to guess - * them. See netdbtype.U for probing for various Netdb_xxx_t types. - */ -/*#define HAS_GETNET_PROTOS /**/ - -/* HAS_GETPROTO_PROTOS: - * This symbol, if defined, indicates that includes - * prototypes for getprotoent(), getprotobyname(), and - * getprotobyaddr(). Otherwise, it is up to the program to guess - * them. See netdbtype.U for probing for various Netdb_xxx_t types. - */ -#define HAS_GETPROTO_PROTOS /**/ - -/* HAS_GETSERV_PROTOS: - * This symbol, if defined, indicates that includes - * prototypes for getservent(), getservbyname(), and - * getservbyaddr(). Otherwise, it is up to the program to guess - * them. See netdbtype.U for probing for various Netdb_xxx_t types. - */ -#define HAS_GETSERV_PROTOS /**/ - -/* Netdb_host_t: - * This symbol holds the type used for the 1st argument - * to gethostbyaddr(). - */ -/* Netdb_hlen_t: - * This symbol holds the type used for the 2nd argument - * to gethostbyaddr(). - */ -/* Netdb_name_t: - * This symbol holds the type used for the argument to - * gethostbyname(). - */ -/* Netdb_net_t: - * This symbol holds the type used for the 1st argument to - * getnetbyaddr(). - */ -#define Netdb_host_t char * /**/ -#define Netdb_hlen_t int /**/ -#define Netdb_name_t char * /**/ -#define Netdb_net_t long /**/ - -/* Select_fd_set_t: - * This symbol holds the type used for the 2nd, 3rd, and 4th - * arguments to select. Usually, this is 'fd_set *', if HAS_FD_SET - * is defined, and 'int *' otherwise. This is only useful if you - * have select(), of course. - */ -#define Select_fd_set_t Perl_fd_set * /**/ - -/* ARCHNAME: - * This symbol holds a string representing the architecture name. - * It may be used to construct an architecture-dependant pathname - * where library files may be held under a private library, for - * instance. - */ -#define ARCHNAME "MSWin32-x86" /**/ - -/* OLD_PTHREAD_CREATE_JOINABLE: - * This symbol, if defined, indicates how to create pthread - * in joinable (aka undetached) state. NOTE: not defined - * if pthread.h already has defined PTHREAD_CREATE_JOINABLE - * (the new version of the constant). - * If defined, known values are PTHREAD_CREATE_UNDETACHED - * and __UNDETACHED. - */ -/*#define OLD_PTHREAD_CREATE_JOINABLE /**/ - -/* HAS_PTHREAD_YIELD: - * This symbol, if defined, indicates that the pthread_yield - * routine is available to yield the execution of the current - * thread. sched_yield is preferable to pthread_yield. - */ -/* SCHED_YIELD: - * This symbol defines the way to yield the execution of - * the current thread. Known ways are sched_yield, - * pthread_yield, and pthread_yield with NULL. - */ -/* HAS_SCHED_YIELD: - * This symbol, if defined, indicates that the sched_yield - * routine is available to yield the execution of the current - * thread. sched_yield is preferable to pthread_yield. - */ -/*#define HAS_PTHREAD_YIELD /**/ -#define SCHED_YIELD /**/ -/*#define HAS_SCHED_YIELD /**/ - -/* I_MACH_CTHREADS: - * This symbol, if defined, indicates to the C program that it should - * include . +/* USE_ITHREADS: + * This symbol, if defined, indicates that Perl should be built to + * use the interpreter-based threading implementation. */ -/*#define I_MACH_CTHREADS /**/ - -/* USE_THREADS: - * This symbol, if defined, indicates that Perl should - * be built to use threads. +/* USE_5005THREADS: + * This symbol, if defined, indicates that Perl should be built to + * use the 5.005-based threading implementation. */ /* OLD_PTHREADS_API: * This symbol, if defined, indicates that Perl should * be built to use the old draft POSIX threads API. */ -/*#define USE_THREADS /**/ +/*#define USE_5005THREADS /**/ +/*#define USE_ITHREADS /**/ +#if defined(USE_5005THREADS) && !defined(USE_ITHREADS) +#define USE_THREADS /* until src is revised*/ +#endif /*#define OLD_PTHREADS_API /**/ -/* Time_t: - * This symbol holds the type returned by time(). It can be long, - * or time_t on BSD sites (in which case should be - * included). - */ -#define Time_t time_t /* Time type */ - -/* HAS_TIMES: - * This symbol, if defined, indicates that the times() routine exists. - * Note that this became obsolete on some systems (SUNOS), which now - * use getrusage(). It may be necessary to include . - */ -#define HAS_TIMES /**/ - -/* Fpos_t: - * This symbol holds the type used to declare file positions in libc. - * It can be fpos_t, long, uint, etc... It may be necessary to include - * to get any typedef'ed information. - */ -#define Fpos_t fpos_t /* File position type */ - -/* Gid_t: - * This symbol holds the return type of getgid() and the type of - * argument to setrgid() and related functions. Typically, - * it is the type of group ids in the kernel. It can be int, ushort, - * uid_t, etc... It may be necessary to include to get - * any typedef'ed information. - */ -#define Gid_t gid_t /* Type for getgid(), etc... */ - -/* Off_t: - * This symbol holds the type used to declare offsets in the kernel. - * It can be int, long, off_t, etc... It may be necessary to include - * to get any typedef'ed information. - */ -/* LSEEKSIZE: - * This symbol holds the number of bytes used by the Off_t. - */ -#define Off_t off_t /* type */ -#define LSEEKSIZE 4 /* size */ - -/* Mode_t: - * This symbol holds the type used to declare file modes - * for systems calls. It is usually mode_t, but may be - * int or unsigned short. It may be necessary to include - * to get any typedef'ed information. - */ -#define Mode_t mode_t /* file mode parameter for system calls */ - -/* Pid_t: - * This symbol holds the type used to declare process ids in the kernel. - * It can be int, uint, pid_t, etc... It may be necessary to include - * to get any typedef'ed information. - */ -#define Pid_t int /* PID type */ - -/* Size_t: - * This symbol holds the type used to declare length parameters - * for string functions. It is usually size_t, but may be - * unsigned long, int, etc. It may be necessary to include - * to get any typedef'ed information. +/* PERL_VENDORLIB_EXP: + * This symbol contains the ~name expanded version of VENDORLIB, to be used + * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define Size_t size_t /* length paramater for string functions */ +/*#define PERL_VENDORLIB_EXP "" /**/ -/* Uid_t: - * This symbol holds the type used to declare user ids in the kernel. - * It can be int, ushort, uid_t, etc... It may be necessary to include - * to get any typedef'ed information. +/* VOIDFLAGS: + * This symbol indicates how much support of the void type is given by this + * compiler. What various bits mean: + * + * 1 = supports declaration of void + * 2 = supports arrays of pointers to functions returning void + * 4 = supports comparisons between pointers to void functions and + * addresses of void functions + * 8 = suports declaration of generic void pointers + * + * The package designer should define VOIDUSED to indicate the requirements + * of the package. This can be done either by #defining VOIDUSED before + * including config.h, or by defining defvoidused in Myinit.U. If the + * latter approach is taken, only those flags will be tested. If the + * level of void support necessary is not present, defines void to int. */ -#define Uid_t uid_t /* UID type */ +#ifndef VOIDUSED +#define VOIDUSED 15 +#endif +#define VOIDFLAGS 15 +#if (VOIDFLAGS & VOIDUSED) != VOIDUSED +#define void int /* is void to be avoided? */ +#define M_VOID /* Xenix strikes again */ +#endif #endif diff --git a/win32/config_h.PL b/win32/config_h.PL index 16e467e..17f3fc2 100644 --- a/win32/config_h.PL +++ b/win32/config_h.PL @@ -13,8 +13,8 @@ while (@ARGV && $ARGV[0] =~ /^([\w_]+)=(.*)$/) } my $patchlevel = $opt{INST_VER}; $patchlevel =~ s|^[\\/]||; -$patchlevel =~ s|~VERSION~|$]|g; -$patchlevel ||= $]; +$patchlevel =~ s|~VERSION~|$Config{version}|g; +$patchlevel ||= $Config{version}; $patchlevel = qq["$patchlevel"]; open(SH,"<$name") || die "Cannot open $name:$!"; diff --git a/win32/config_sh.PL b/win32/config_sh.PL index 3edc20b..0e1d351 100644 --- a/win32/config_sh.PL +++ b/win32/config_sh.PL @@ -10,20 +10,53 @@ sub mungepath { return join(' ', @p); } +# generate an array of option strings from command-line args +# or an option file +# -- added by BKS, 10-17-1999 to fix command-line overflow problems +sub loadopts { + if ($ARGV[0] =~ /--cfgsh-option-file/) { + shift @ARGV; + my $optfile = shift @ARGV; + local (*F); + open OPTF, $optfile or die "Can't open $optfile: $!\n"; + my @opts; + chomp(my $line = ); + my @vars = split(/\t+~\t+/, $line); + for (@vars) { + push(@opts, $_) unless (/^\s*$/); + } + close OPTF; + return \@opts; + } + else { + return \@ARGV; + } +} + my %opt; -while (@ARGV && $ARGV[0] =~ /^([\w_]+)=(.*)$/) - { - $opt{$1}=$2; - shift(@ARGV); - } - -$opt{VERSION} = $]; -$opt{INST_VER} =~ s|~VERSION~|$]|g; -if ($] =~ /\.(\d\d\d)?(\d\d)?$/) { # should always be true - $opt{PERL_VERSION} = int($1 || 0); - $opt{PERL_SUBVERSION} = $2 || '00'; +my $optref = loadopts(); +while (@{$optref} && $optref->[0] =~ /^([\w_]+)=(.*)$/) { + $opt{$1}=$2; + shift(@{$optref}); } +my $pl_h = '../patchlevel.h'; + +if (-e $pl_h) { + open PL, "<$pl_h" or die "Can't open $pl_h: $!"; + while () { + if (/^#\s*define\s+(PERL_\w+)\s+([\d.]+)/) { + $opt{$1} = $2; + } + } + close PL; +} +else { + die "Can't find $pl_h: $!"; +} +$opt{VERSION} = "$opt{PERL_REVISION}.$opt{PERL_VERSION}.$opt{PERL_SUBVERSION}"; +$opt{INST_VER} =~ s|~VERSION~|$opt{VERSION}|g; + $opt{'cf_by'} = $ENV{USERNAME} unless $opt{'cf_by'}; $opt{'cf_email'} = $opt{'cf_by'} . '@' . (gethostbyname('localhost'))[0] unless $opt{'cf_email'}; @@ -32,19 +65,19 @@ $opt{'usemymalloc'} = 'y' if $opt{'d_mymalloc'} eq 'define'; $opt{libpth} = mungepath($opt{libpth}) if exists $opt{libpth}; $opt{incpath} = mungepath($opt{incpath}) if exists $opt{incpath}; -while (<>) - { - s/~([\w_]+)~/$opt{$1}/g; - if (/^([\w_]+)=(.*)$/) { - my($k,$v) = ($1,$2); - # this depends on cf_time being empty in the template (or we'll get a loop) - if ($k eq 'cf_time') { - $_ = "$k='" . localtime(time) . "'\n" if $v =~ /^\s*'\s*'/; +while (<>) { + s/~([\w_]+)~/$opt{$1}/g; + if (/^([\w_]+)=(.*)$/) { + my($k,$v) = ($1,$2); + # this depends on cf_time being empty in the template (or we'll + # get a loop) + if ($k eq 'cf_time') { + $_ = "$k='" . localtime(time) . "'\n" if $v =~ /^\s*'\s*'/; + } + elsif (exists $opt{$k}) { + $_ = "$k='$opt{$k}'\n"; + } } - elsif (exists $opt{$k}) { - $_ = "$k='$opt{$k}'\n"; - } - } - print; - } + print; +} diff --git a/win32/dl_win32.xs b/win32/dl_win32.xs index 34dbb4e..d959fbd 100644 --- a/win32/dl_win32.xs +++ b/win32/dl_win32.xs @@ -105,13 +105,13 @@ dl_load_file(filename,flags=0) PREINIT: CODE: { - DLDEBUG(1,PerlIO_printf(PerlIO_stderr(),"dl_load_file(%s):\n", filename)); + DLDEBUG(1,PerlIO_printf(Perl_debug_log,"dl_load_file(%s):\n", filename)); if (dl_static_linked(filename) == 0) { RETVAL = PerlProc_DynaLoad(filename); } else RETVAL = (void*) GetModuleHandle(NULL); - DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," libref=%x\n", RETVAL)); + DLDEBUG(2,PerlIO_printf(Perl_debug_log," libref=%x\n", RETVAL)); ST(0) = sv_newmortal() ; if (RETVAL == NULL) SaveError(aTHXo_ "load_file:%s", @@ -125,10 +125,10 @@ dl_find_symbol(libhandle, symbolname) void * libhandle char * symbolname CODE: - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_find_symbol(handle=%x, symbol=%s)\n", + DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_find_symbol(handle=%x, symbol=%s)\n", libhandle, symbolname)); RETVAL = (void*) GetProcAddress((HINSTANCE) libhandle, symbolname); - DLDEBUG(2,PerlIO_printf(PerlIO_stderr()," symbolref = %x\n", RETVAL)); + DLDEBUG(2,PerlIO_printf(Perl_debug_log," symbolref = %x\n", RETVAL)); ST(0) = sv_newmortal() ; if (RETVAL == NULL) SaveError(aTHXo_ "find_symbol:%s", @@ -151,7 +151,7 @@ dl_install_xsub(perl_name, symref, filename="$Package") void * symref char * filename CODE: - DLDEBUG(2,PerlIO_printf(PerlIO_stderr(),"dl_install_xsub(name=%s, symref=%x)\n", + DLDEBUG(2,PerlIO_printf(Perl_debug_log,"dl_install_xsub(name=%s, symref=%x)\n", perl_name, symref)); ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)(pTHXo_ CV *))symref, diff --git a/win32/genmk95.pl b/win32/genmk95.pl new file mode 100644 index 0000000..8fe4f86 --- /dev/null +++ b/win32/genmk95.pl @@ -0,0 +1,85 @@ +# genmk95.pl - uses miniperl to generate a makefile that command.com will +# understand given one that cmd.exe will understand + +# Author: Benjamin K. Stuhl +# Date: 10-16-1999 + +# how it works: +# dmake supports an alternative form for its recipes, called "group +# recipes", in which all elements of a recipe are run with only one shell. +# This program converts the standard dmake makefile.mk to one using group +# recipes. This is done so that lines using && or || (which command.com +# doesn't understand) may be split into two lines that will still be run +# with one shell. + +my ($filein, $fileout) = @ARGV; + +open my $in, $filein or die "Error opening input file: $!\n"; +open my $out, "> $fileout" or die "Error opening output file: $!\n"; + +print $out <<_EOH_; +# *** Warning: this file is autogenerated from $filein by $0 *** +# *** Do not edit this file - edit $filein instead *** + +_HOME_DIR := \$(PWD) + +_EOH_ + +my $inrec = 0; + +while (<$in>) +{ + chomp; + if (/^[^#.\t][^#=]*?:(?:[^=]|$)/) + { + if (! $inrec) + { + print $out "$_\n"; + while (/\\\s*$/) + { + chomp($_ = <$in>); + print $out "$_\n"; + } + print $out "@[\n"; + $inrec = 1; + next; + } + else { + if (!/^\t/) { + seek ($out, -4, 2); # no recipe, so back up and undo grouping + # should be -3, but MS has its CR/LF thing... + $inrec = 0; + } + print $out "$_\n"; + next; + } + } + if ((/^\s*$/ || /^[^#.\t][^#=]*?:/) && $inrec) + { + print $out "]\n"; + print $out "$_\n"; + $inrec = 0; + next; + } + if (/^(.*?)(&&|\|\|)(.*)$/) # two commands separated by && or || + { + my ($one, $sep, $two) = ($1, $2, $3); +LINE_CONT: + if ($two =~ /\\\s*$/) + { + chomp ($two .= "\n" . scalar <$in>); + goto LINE_CONT; + } + s/^\s*// for ($one, $two); + print $out "\t$one\n\t$two\n" if ($sep eq "&&"); + print $out "\t$one\n\tif errorlevel 1 $two\n" if ($sep eq "||"); + print $out "\tcd \$(_HOME_DIR)\n"; + next; + } + # fall through - no need for special handling + print $out "$_\n"; +} +print $out "]\n" if ($inrec); + +close $in or warn "Error closing \$in: $!\n"; +close $out or warn "Error closing \$out: $!\n"; diff --git a/win32/include/dirent.h b/win32/include/dirent.h index d2ef6d5..a669012 100644 --- a/win32/include/dirent.h +++ b/win32/include/dirent.h @@ -1,41 +1,44 @@ -// dirent.h +/* dirent.h */ -// djl -// Provide UNIX compatibility +/* djl + * Provide UNIX compatibility + */ #ifndef _INC_DIRENT #define _INC_DIRENT -// -// NT versions of readdir(), etc -// From the MSDOS implementation -// +/* + * NT versions of readdir(), etc + * From the MSDOS implementation + */ -// Directory entry size +/* Directory entry size */ #ifdef DIRSIZ #undef DIRSIZ #endif #define DIRSIZ(rp) (sizeof(struct direct)) -// needed to compile directory stuff +/* needed to compile directory stuff */ #define DIRENT direct -// structure of a directory entry +/* structure of a directory entry */ typedef struct direct { - long d_ino; // inode number (not used by MS-DOS) - int d_namlen; // Name length - char d_name[257]; // file name + long d_ino; /* inode number (not used by MS-DOS) */ + long d_namlen; /* name length */ + char d_name[257]; /* file name */ } _DIRECT; -// structure for dir operations +/* structure for dir operations */ typedef struct _dir_struc { - char *start; // Starting position - char *curr; // Current position - long size; // Size of string table - long nfiles; // number if filenames in table - struct direct dirstr; // Directory structure to return + char *start; /* starting position */ + char *curr; /* current position */ + long size; /* allocated size of string table */ + long nfiles; /* number of filenames in table */ + struct direct dirstr; /* directory structure to return */ + void* handle; /* system handle */ + char *end; /* position after last filename */ } DIR; #if 0 /* these have moved to win32iop.h */ @@ -47,4 +50,4 @@ void win32_rewinddir(DIR *dirp); int win32_closedir(DIR *dirp); #endif -#endif //_INC_DIRENT +#endif /* _INC_DIRENT */ diff --git a/win32/makefile.mk b/win32/makefile.mk index 034ae3d..e6ed176 100644 --- a/win32/makefile.mk +++ b/win32/makefile.mk @@ -1,9 +1,9 @@ # # Makefile to build perl on Windows NT using DMAKE. # Supported compilers: -# Visual C++ 2.0 thro 5.0 +# Visual C++ 2.0 thro 6.0 # Borland C++ 5.02 -# Mingw32 with gcc-2.8.1 or egcs-1.0.2 **experimental** +# Mingw32 with gcc-2.95.2 or better **experimental** # # This is set up to build a perl.exe that runs off a shared library # (perl.dll). Also makes individual DLLs for the XS extensions. @@ -18,7 +18,7 @@ ## # -# Set these to wherever you want "nmake install" to put your +# Set these to wherever you want "dmake install" to put your # newly built perl. # INST_DRV *= c: @@ -33,7 +33,7 @@ INST_TOP *= $(INST_DRV)\perl # versioned installation can be obtained by setting INST_TOP above to a # path that includes an arbitrary version string. # -INST_VER *= \5.00561 +INST_VER *= \5.5.640 # # Comment this out if you DON'T want your perl installation to have @@ -51,7 +51,7 @@ INST_ARCH *= \$(ARCHNAME) # # uncomment to enable threads-capabilities # -#USE_THREADS *= define +#USE_5005THREADS *= define # # XXX WARNING! This option currently undergoing changes. May be broken. @@ -70,6 +70,22 @@ INST_ARCH *= \$(ARCHNAME) #USE_OBJECT *= define # +# XXX WARNING! This option currently undergoing changes. May be broken. +# +# Beginnings of interpreter cloning/threads: still rather rough, fails +# tests. This should be enabled to get the fork() emulation. Do not +# enable unless you know what you're doing! +# +#USE_ITHREADS *= define + +# +# uncomment to enable the implicit "host" layer for all system calls +# made by perl. This is needed and auto-enabled by USE_OBJECT above. +# This is also needed to get fork(). +# +#USE_IMP_SYS *= define + +# # uncomment exactly one of the following # # Visual C++ 2.x @@ -80,10 +96,15 @@ INST_ARCH *= \$(ARCHNAME) #CCTYPE *= MSVC60 # Borland 5.02 or later CCTYPE *= BORLAND -# mingw32/egcs or mingw32/gcc +# mingw32/gcc-2.95.2 or better #CCTYPE *= GCC # +# uncomment this if you are compiling under Windows 95/98 and command.com +# (not needed if you're running under 4DOS/NT 6.01 or later) +#IS_WIN95 *= define + +# # uncomment next line if you want debug version of perl (big,slow) # If not enabled, we automatically try to use maximum optimization # with all compilers that are known to have a working optimizer. @@ -92,11 +113,13 @@ CCTYPE *= BORLAND # # uncomment to enable use of PerlCRT.DLL when using the Visual C compiler. -# Highly recommended. It has patches that fix known bugs in MSVCRT.DLL. +# It has patches that fix known bugs in older versions of MSVCRT.DLL. # This currently requires VC 5.0 with Service Pack 3 or later. # Get it from CPAN at http://www.perl.com/CPAN/authors/id/D/DO/DOUGL/ # and follow the directions in the package to install. # +# Not recommended if you have VC 6.x and you're not running Windows 9x. +# #USE_PERLCRT *= define # @@ -138,24 +161,43 @@ CCTYPE *= BORLAND # so you may have to set CCHOME explicitly (spaces in the path name should # not be quoted) # -CCHOME *= d:\bc5 +CCHOME *= c:\bc5 #CCHOME *= $(MSVCDIR) #CCHOME *= D:\packages\mingw32 CCINCDIR *= $(CCHOME)\include CCLIBDIR *= $(CCHOME)\lib # -# additional compiler flags can be specified here. +# Additional compiler flags can be specified here. +# + # -# Adding -DPERL_POLLUTE enables support for old symbols, at the expense of -# extreme pollution. You most probably want this if you're compiling modules -# from CPAN, or other such serious uses of this experimental perl release. -# We don't enable this by default because we want the modules to get fixed -# instead of clinging to shortcuts like this one. +# This should normally be disabled. Adding -DPERL_POLLUTE enables support +# for old symbols by default, at the expense of extreme pollution. You most +# probably just want to build modules that won't compile with +# perl Makefile.PL POLLUTE=1 +# instead of enabling this. Please report such modules to the respective +# authors. # #BUILDOPT += -DPERL_POLLUTE # +# This should normally be disabled. Enabling it will disable the File::Glob +# implementation of CORE::glob. +# +#BUILDOPT += -DPERL_EXTERNAL_GLOB + +# +# This should normally be disabled. Enabling it causes perl to read scripts +# in text mode (which is the 5.005 behavior) and will break ByteLoader. +#BUILDOPT += -DPERL_TEXTMODE_SCRIPTS + +# +# This should normally be disabled. Enabling it runs a cloned toplevel +# interpreter (*EXPERIMENTAL*, fails tests) +#BUILDOPT += -DTOP_CLONE + +# # specify semicolon-separated list of extra directories that modules will # look for libraries (spaces in path names need not be quoted) # @@ -188,20 +230,32 @@ CRYPT_FLAG = -DHAVE_DES_FCRYPT .IF "$(USE_OBJECT)" == "define" PERL_MALLOC != undef -USE_THREADS != undef +USE_5005THREADS != undef USE_MULTI != undef +USE_IMP_SYS != define .ENDIF PERL_MALLOC *= undef -USE_THREADS *= undef +USE_5005THREADS *= undef + +.IF "$(USE_5005THREADS)" == "define" +USE_ITHREADS != undef +.ENDIF + USE_MULTI *= undef USE_OBJECT *= undef +USE_ITHREADS *= undef +USE_IMP_SYS *= undef +USE_PERLCRT *= undef -.IF "$(USE_MULTI)$(USE_THREADS)$(USE_OBJECT)" != "undefundefundef" +.IF "$(USE_MULTI)$(USE_5005THREADS)$(USE_OBJECT)" != "undefundefundef" BUILDOPT += -DPERL_IMPLICIT_CONTEXT .ENDIF +.IF "$(USE_IMP_SYS)" != "undef" +BUILDOPT += -DPERL_IMPLICIT_SYS +.ENDIF .IMPORT .IGNORE : PROCESSOR_ARCHITECTURE @@ -209,7 +263,7 @@ PROCESSOR_ARCHITECTURE *= x86 .IF "$(USE_OBJECT)" == "define" ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE)-object -.ELIF "$(USE_THREADS)" == "define" +.ELIF "$(USE_5005THREADS)" == "define" ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE)-thread .ELIF "$(USE_MULTI)" == "define" ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE)-multi @@ -217,6 +271,10 @@ ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE)-multi ARCHNAME = MSWin32-$(PROCESSOR_ARCHITECTURE) .ENDIF +.IF "$(USE_OBJECT)" == "define" +ARCHNAME = $(ARCHNAME)-thread +.ENDIF + # Visual Studio 98 specific .IF "$(CCTYPE)" == "MSVC60" @@ -258,6 +316,7 @@ CC = bcc32 LINK32 = tlink32 LIB32 = tlib /P128 IMPLIB = implib -c +RSC = rc # # Options @@ -294,6 +353,7 @@ CC = gcc LINK32 = gcc LIB32 = ar rc IMPLIB = dlltool +RSC = rc o = .o a = .a @@ -301,6 +361,7 @@ a = .a # # Options # + RUNTIME = INCLUDES = -I$(COREDIR) -I.\include -I. -I.. DEFINES = -DWIN32 $(CRYPT_FLAG) @@ -308,12 +369,17 @@ LOCDEFS = -DPERLDLL -DPERL_CORE SUBSYS = console CXX_FLAG = -xc++ -LIBC = -lcrtdll -LIBFILES = $(CRYPT_LIB) -ladvapi32 -luser32 -lnetapi32 -lwsock32 \ - -lmingw32 -lgcc -lmoldname $(LIBC) -lkernel32 +LIBC = -lmsvcrt + +# same libs as MSVC +LIBFILES = $(CRYPT_LIB) $(LIBC) \ + -lmoldname -lkernel32 -luser32 -lgdi32 \ + -lwinspool -lcomdlg32 -ladvapi32 -lshell32 -lole32 \ + -loleaut32 -lnetapi32 -luuid -lwsock32 -lmpr \ + -lwinmm -lversion -lodbc32 .IF "$(CFG)" == "Debug" -OPTIMIZE = -g -O2 $(RUNTIME) -DDEBUGGING +OPTIMIZE = -g $(RUNTIME) -DDEBUGGING LINK_DBG = -g .ELSE OPTIMIZE = -g -O2 $(RUNTIME) @@ -331,6 +397,7 @@ LIBOUT_FLAG = CC = cl LINK32 = link LIB32 = $(LINK32) -lib +RSC = rc # # Options @@ -344,7 +411,7 @@ LOCDEFS = -DPERLDLL -DPERL_CORE SUBSYS = console CXX_FLAG = -TP -GX -.IF "$(USE_PERLCRT)" == "" +.IF "$(USE_PERLCRT)" != "define" .IF "$(CFG)" == "Debug" PERLCRTLIBC = msvcrtd.lib .ELSE @@ -358,6 +425,9 @@ PERLCRTLIBC = PerlCRT.lib .ENDIF .ENDIF +PERLEXE_RES = +PERLDLL_RES = + .IF "$(RUNTIME)" == "-MD" LIBC = $(PERLCRTLIBC) .ELSE @@ -383,9 +453,9 @@ LINK_DBG = -release .ENDIF LIBBASEFILES = $(DELAYLOAD) $(CRYPT_LIB) \ - oldnames.lib kernel32.lib user32.lib gdi32.lib \ - winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib \ - oleaut32.lib netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib \ + oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib \ + comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib \ + netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib \ version.lib odbc32.lib odbccp32.lib # we add LIBC here, since we may be using PerlCRT.dll @@ -400,6 +470,10 @@ OBJOUT_FLAG = -Fo EXEOUT_FLAG = -Fe LIBOUT_FLAG = /out: +.IF "$(USE_PERLCRT)" != "define" +BUILDOPT += -DPERL_MSVCRT_READFIX +.ENDIF + .ENDIF .IF "$(USE_OBJECT)" == "define" @@ -409,6 +483,12 @@ BUILDOPT += -DPERL_OBJECT CFLAGS_O = $(CFLAGS) $(BUILDOPT) +# used to allow local linking flags that are not propogated into Config.pm, +# currently unused +# -- BKS, 12-12-1999 +PRIV_LINK_FLAGS *= +BLINK_FLAGS = $(PRIV_LINK_FLAGS) $(LINK_FLAGS) + #################### do not edit below this line ####################### ############# NO USER-SERVICEABLE PARTS BEYOND THIS POINT ############## @@ -422,7 +502,7 @@ LKPOST = ) # Rules # -.SUFFIXES : .c $(o) .dll $(a) .exe +.SUFFIXES : .c $(o) .dll $(a) .exe .rc .res .c$(o): $(CC) -c $(null,$(<:d) $(NULL) -I$(<:d)) $(CFLAGS_O) $(OBJOUT_FLAG)$@ $< @@ -432,21 +512,25 @@ LKPOST = ) $(o).dll: .IF "$(CCTYPE)" == "BORLAND" - $(LINK32) -Tpd -ap $(LINK_FLAGS) c0d32$(o) $<,$@,,$(LIBFILES),$(*B).def + $(LINK32) -Tpd -ap $(BLINK_FLAGS) c0d32$(o) $<,$@,,$(LIBFILES),$(*B).def $(IMPLIB) $(*B).lib $@ .ELIF "$(CCTYPE)" == "GCC" - $(LINK32) -o $@ $(LINK_FLAGS) $< $(LIBFILES) - $(IMPLIB) -def $(*B).def $(*B).a $@ + $(LINK32) -o $@ $(BLINK_FLAGS) $< $(LIBFILES) + $(IMPLIB) --input-def $(*B).def --output-lib $(*B).a $@ .ELSE $(LINK32) -dll -subsystem:windows -implib:$(*B).lib -def:$(*B).def \ - -out:$@ $(LINK_FLAGS) $(LIBFILES) $< $(LIBPERL) + -out:$@ $(BLINK_FLAGS) $(LIBFILES) $< $(LIBPERL) .ENDIF +.rc.res: + $(RSC) $< + # # various targets MINIPERL = ..\miniperl.exe MINIDIR = .\mini PERLEXE = ..\perl.exe +WPERLEXE = ..\wperl.exe GLOBEXE = ..\perlglob.exe CONFIGPM = ..\lib\Config.pm MINIMOD = ..\lib\ExtUtils\Miniperl.pm @@ -464,7 +548,6 @@ UTILS = \ ..\utils\c2ph \ ..\utils\h2xs \ ..\utils\perldoc \ - ..\utils\pstruct \ ..\utils\perlcc \ ..\pod\checkpods \ ..\pod\pod2html \ @@ -500,7 +583,7 @@ PERLIMPLIB = ..\libperl$(a) CFGSH_TMPL = config.vc CFGH_TMPL = config_H.vc -.IF "$(USE_PERLCRT)" == "" +.IF "$(USE_PERLCRT)" != "define" PERL95EXE = ..\perl95.exe .ENDIF @@ -568,7 +651,7 @@ WIN32_SRC = \ .\win32.c \ .\win32sck.c -.IF "$(USE_THREADS)" == "define" +.IF "$(USE_5005THREADS)" == "define" WIN32_SRC += .\win32thread.c .ENDIF @@ -632,7 +715,10 @@ CORE_NOCFG_H = \ .\include\dirent.h \ .\include\netdb.h \ .\include\sys\socket.h \ - .\win32.h + .\win32.h \ + .\perlhost.h \ + .\vdir.h \ + .\vmem.h CORE_H = $(CORE_NOCFG_H) .\config.h @@ -656,7 +742,7 @@ SETARGV_OBJ = setargv$(o) .ENDIF DYNAMIC_EXT = Socket IO Fcntl Opcode SDBM_File POSIX attrs Thread B re \ - Data/Dumper Devel/Peek ByteLoader Devel/DProf + Data/Dumper Devel/Peek ByteLoader Devel/DProf File/Glob STATIC_EXT = DynaLoader NONXS_EXT = Errno @@ -676,6 +762,7 @@ ERRNO = $(EXTDIR)\Errno\Errno PEEK = $(EXTDIR)\Devel\Peek\Peek BYTELOADER = $(EXTDIR)\ByteLoader\ByteLoader DPROF = $(EXTDIR)\Devel\DProf\DProf +GLOB = $(EXTDIR)\File\Glob\Glob SOCKET_DLL = $(AUTODIR)\Socket\Socket.dll FCNTL_DLL = $(AUTODIR)\Fcntl\Fcntl.dll @@ -691,6 +778,7 @@ PEEK_DLL = $(AUTODIR)\Devel\Peek\Peek.dll RE_DLL = $(AUTODIR)\re\re.dll BYTELOADER_DLL = $(AUTODIR)\ByteLoader\ByteLoader.dll DPROF_DLL = $(AUTODIR)\Devel\DProf\DProf.dll +GLOB_DLL = $(AUTODIR)\File\Glob\Glob.dll ERRNO_PM = $(LIBDIR)\Errno.pm @@ -708,7 +796,8 @@ EXTENSION_C = \ $(PEEK).c \ $(B).c \ $(BYTELOADER).c \ - $(DPROF).c + $(DPROF).c \ + $(GLOB).c EXTENSION_DLL = \ $(SOCKET_DLL) \ @@ -724,7 +813,8 @@ EXTENSION_DLL = \ $(RE_DLL) \ $(THREAD_DLL) \ $(BYTELOADER_DLL) \ - $(DPROF_DLL) + $(DPROF_DLL) \ + $(GLOB_DLL) EXTENSION_PM = \ $(ERRNO_PM) @@ -734,53 +824,119 @@ POD2MAN = $(PODDIR)\pod2man POD2LATEX = $(PODDIR)\pod2latex POD2TEXT = $(PODDIR)\pod2text +# vars must be separated by "\t+~\t+", since we're using the tempfile +# version of config_sh.pl (we were overflowing someone's buffer by +# trying to fit them all on the command line) +# -- BKS 10-17-1999 CFG_VARS = \ - "INST_DRV=$(INST_DRV)" \ - "INST_TOP=$(INST_TOP)" \ - "INST_VER=$(INST_VER)" \ - "INST_ARCH=$(INST_ARCH)" \ - "archname=$(ARCHNAME)" \ - "cc=$(CC)" \ - "ccflags=$(OPTIMIZE:s/"/\"/) $(DEFINES) $(BUILDOPT)" \ - "cf_email=$(EMAIL)" \ - "d_crypt=$(D_CRYPT)" \ - "d_mymalloc=$(PERL_MALLOC)" \ - "libs=$(LIBFILES:f)" \ - "incpath=$(CCINCDIR:s/"/\"/)" \ - "libperl=$(PERLIMPLIB:f)" \ - "libpth=$(CCLIBDIR:s/"/\"/);$(EXTRALIBDIRS:s/"/\"/)" \ - "libc=$(LIBC)" \ - "make=dmake" \ - "_o=$(o)" "obj_ext=$(o)" \ - "_a=$(a)" "lib_ext=$(a)" \ - "static_ext=$(STATIC_EXT)" \ - "dynamic_ext=$(DYNAMIC_EXT)" \ - "nonxs_ext=$(NONXS_EXT)" \ - "usethreads=$(USE_THREADS)" \ - "usemultiplicity=$(USE_MULTI)" \ - "LINK_FLAGS=$(LINK_FLAGS:s/"/\"/)" \ - "optimize=$(OPTIMIZE:s/"/\"/)" + INST_DRV=$(INST_DRV) ~ \ + INST_TOP=$(INST_TOP) ~ \ + INST_VER=$(INST_VER:s/\/\\/) ~ \ + INST_ARCH=$(INST_ARCH) ~ \ + archname=$(ARCHNAME) ~ \ + cc=$(CC) ~ \ + ccflags=$(OPTIMIZE) $(DEFINES) $(BUILDOPT) ~ \ + cf_email=$(EMAIL) ~ \ + d_crypt=$(D_CRYPT) ~ \ + d_mymalloc=$(PERL_MALLOC) ~ \ + libs=$(LIBFILES:f) ~ \ + incpath=$(CCINCDIR) ~ \ + libperl=$(PERLIMPLIB:f) ~ \ + libpth=$(CCLIBDIR);$(EXTRALIBDIRS) ~ \ + libc=$(LIBC) ~ \ + make=dmake ~ \ + _o=$(o) obj_ext=$(o) ~ \ + _a=$(a) lib_ext=$(a) ~ \ + static_ext=$(STATIC_EXT) ~ \ + dynamic_ext=$(DYNAMIC_EXT) ~ \ + nonxs_ext=$(NONXS_EXT) ~ \ + use5005threads=$(USE_5005THREADS) ~ \ + useithreads=$(USE_ITHREADS) ~ \ + usethreads=$(USE_5005THREADS) ~ \ + usemultiplicity=$(USE_MULTI) ~ \ + LINK_FLAGS=$(LINK_FLAGS:s/\/\\/) ~ \ + optimize=$(OPTIMIZE) + +# +# set up targets varying between Win95 and WinNT builds +# + +.IF "$(IS_WIN95)" == "define" +MK2 = .\makefile.95 +RIGHTMAKE = __switch_makefiles +NOOP = @rem +.ELSE +MK2 = __not_needed +RIGHTMAKE = __not_needed +.ENDIF # # Top targets # -all : .\config.h $(GLOBEXE) $(MINIMOD) $(CONFIGPM) $(PERLEXE) $(PERL95EXE) \ +all : .\config.h $(GLOBEXE) $(MINIPERL) $(MK2) \ + $(RIGHTMAKE) $(MINIMOD) $(CONFIGPM) $(PERLEXE) $(PERL95EXE) \ $(X2P) $(EXTENSION_DLL) $(EXTENSION_PM) $(DYNALOADER)$(o) : $(DYNALOADER).c $(CORE_H) $(EXTDIR)\DynaLoader\dlutils.c -#------------------------------------------------------------ +#---------------------------------------------------------------- + +#-------------------- BEGIN Win95 SPECIFIC ---------------------- + +# this target is a jump-off point for Win95 +# 1. it switches to the Win95-specific makefile if it exists +# (__do_switch_makefiles) +# 2. it prints a message when the Win95-specific one finishes (__done) +# 3. it then kills this makefile by trying to make __no_such_target + +__switch_makefiles: __do_switch_makefiles __done __no_such_target + +__do_switch_makefiles: +.IF "$(NOTFIRST)" != "true" + if exist $(MK2) $(MAKE:s/-S//) -f $(MK2) $(MAKETARGETS) NOTFIRST=true +.ELSE + $(NOOP) +.ENDIF + +.IF "$(NOTFIRST)" != "true" +__done: + @echo Build process complete. Ignore any errors after this message. + @echo Run "dmake test" to test and "dmake install" to install + +.ELSE +# dummy targets for Win95-specific makefile + +__done: + $(NOOP) + +__no_such_target: + $(NOOP) + +.ENDIF + +# This target is used to generate the new makefile (.\makefile.95) for Win95 + +.\makefile.95: .\makefile.mk + $(MINIPERL) genmk95.pl makefile.mk $(MK2) + +#--------------------- END Win95 SPECIFIC --------------------- + +# a blank target for when builds don't need to do certain things +# this target added for Win95 port but used to keep the WinNT port able to +# use this file +__not_needed: + $(NOOP) $(GLOBEXE) : perlglob$(o) .IF "$(CCTYPE)" == "BORLAND" $(CC) -c -w -v -tWM -I"$(CCINCDIR)" perlglob.c - $(LINK32) -Tpe -ap $(LINK_FLAGS) c0x32$(o) perlglob$(o) \ + $(LINK32) -Tpe -ap $(BLINK_FLAGS) c0x32$(o) perlglob$(o) \ "$(CCLIBDIR)\32BIT\wildargs$(o)",$@,,import32.lib cw32mt.lib, .ELIF "$(CCTYPE)" == "GCC" - $(LINK32) $(LINK_FLAGS) -o $@ perlglob$(o) $(LIBFILES) + $(LINK32) $(BLINK_FLAGS) -mconsole -o $@ perlglob$(o) $(LIBFILES) .ELSE - $(LINK32) $(LINK_FLAGS) $(LIBFILES) -out:$@ -subsystem:$(SUBSYS) \ + $(LINK32) $(BLINK_FLAGS) $(LIBFILES) -out:$@ -subsystem:$(SUBSYS) \ perlglob$(o) setargv$(o) .ENDIF @@ -794,13 +950,15 @@ config.w32 : $(CFGSH_TMPL) copy $(CFGH_TMPL) config.h ..\config.sh : config.w32 $(MINIPERL) config_sh.PL - $(MINIPERL) -I..\lib config_sh.PL $(CFG_VARS) config.w32 > ..\config.sh + $(MINIPERL) -I..\lib config_sh.PL --cfgsh-option-file \ + $(mktmp $(CFG_VARS)) config.w32 > ..\config.sh # this target is for when changes to the main config.sh happen # edit config.{b,v,g}c and make this target once for each supported # compiler (e.g. `dmake CCTYPE=BORLAND regen_config_h`) regen_config_h: - perl config_sh.PL $(CFG_VARS) $(CFGSH_TMPL) > ..\config.sh + perl config_sh.PL --cfgsh-option-file $(mktmp $(CFG_VARS)) \ + $(CFGSH_TMPL) > ..\config.sh -cd .. && del /f perl.exe cd .. && perl configpm -del /f $(CFGH_TMPL) @@ -816,29 +974,39 @@ $(CONFIGPM) : $(MINIPERL) ..\config.sh config_h.PL ..\minimod.pl $(XCOPY) ..\ext\re\re.pm $(LIBDIR)\*.* $(RCOPY) include $(COREDIR)\*.* $(MINIPERL) -I..\lib config_h.PL "INST_VER=$(INST_VER)" \ - || $(MAKE) $(MAKEMACROS) $(CONFIGPM) + || $(MAKE) $(MAKEMACROS) $(CONFIGPM) $(MAKEFILE) -$(MINIPERL) : $(MINIDIR) $(MINI_OBJ) +$(MINIPERL) : $(MINIDIR) $(MINI_OBJ) $(CRTIPMLIBS) .IF "$(CCTYPE)" == "BORLAND" - $(LINK32) -Tpe -ap $(LINK_FLAGS) \ + $(LINK32) -Tpe -ap $(BLINK_FLAGS) \ @$(mktmp c0x32$(o) $(MINI_OBJ:s,\,\\),$(@:s,\,\\),,$(LIBFILES),) .ELIF "$(CCTYPE)" == "GCC" - $(LINK32) -v -o $@ $(LINK_FLAGS) \ - $(mktmp $(LKPRE) $(MINI_OBJ:s,\,\\) $(LIBFILES) $(LKPOST)) + $(LINK32) -v -mconsole -o $@ $(BLINK_FLAGS) \ + $(mktmp $(LKPRE) $(MINI_OBJ:s,\,\\) $(LIBFILES) $(LKPOST)) .ELSE $(LINK32) -subsystem:console -out:$@ \ - @$(mktmp $(LINK_FLAGS) $(LIBFILES) $(MINI_OBJ:s,\,\\)) + @$(mktmp $(BLINK_FLAGS) $(LIBFILES) $(MINI_OBJ:s,\,\\)) .ENDIF $(MINIDIR) : if not exist "$(MINIDIR)" mkdir "$(MINIDIR)" $(MINICORE_OBJ) : $(CORE_NOCFG_H) - $(CC) -c $(CFLAGS) $(OBJOUT_FLAG)$@ ..\$(*B).c + $(CC) -c $(CFLAGS) -DPERL_EXTERNAL_GLOB $(OBJOUT_FLAG)$@ ..\$(*B).c $(MINIWIN32_OBJ) : $(CORE_NOCFG_H) $(CC) -c $(CFLAGS) $(OBJOUT_FLAG)$@ $(*B).c +# -DPERL_IMPLICIT_SYS needs C++ for perllib.c +# rules wrapped in .IFs break Win9X build (we end up with unbalanced []s unless +# unless the .IF is true), so instead we use a .ELSE with the default +perllib$(o) : perllib.c +.IF "$(USE_IMP_SYS)$(USE_OBJECT)" == "defineundef" + $(CC) -c -I. $(CFLAGS_O) $(CXX_FLAG) $(OBJOUT_FLAG)$@ perllib.c +.ELSE + $(CC) -c -I. $(CFLAGS_O) $(OBJOUT_FLAG)$@ perllib.c +.ENDIF + # 1. we don't want to rebuild miniperl.exe when config.h changes # 2. we don't want to rebuild miniperl.exe with non-default config.h $(MINI_OBJ) : $(CORE_NOCFG_H) @@ -850,31 +1018,31 @@ $(PERL95_OBJ) : $(CORE_H) $(X2P_OBJ) : $(CORE_H) perldll.def : $(MINIPERL) $(CONFIGPM) ..\global.sym ..\pp.sym ..\makedef.pl - $(MINIPERL) -w ..\makedef.pl PLATFORM=win32 $(OPTIMIZE) $(DEFINES) $(BUILDOPT) \ - CCTYPE=$(CCTYPE) > perldll.def + $(MINIPERL) -w ..\makedef.pl PLATFORM=win32 $(OPTIMIZE) $(DEFINES) \ + $(BUILDOPT) CCTYPE=$(CCTYPE) > perldll.def -$(PERLDLL): perldll.def $(PERLDLL_OBJ) +$(PERLDLL): perldll.def $(PERLDLL_OBJ) $(PERLDLL_RES) .IF "$(CCTYPE)" == "BORLAND" - $(LINK32) -Tpd -ap $(LINK_FLAGS) \ + $(LINK32) -Tpd -ap $(BLINK_FLAGS) \ @$(mktmp c0d32$(o) $(PERLDLL_OBJ:s,\,\\)\n \ $@,\n \ $(LIBFILES)\n \ perldll.def\n) $(IMPLIB) $*.lib $@ .ELIF "$(CCTYPE)" == "GCC" - $(LINK32) -mdll -o $@ -Wl,--base-file -Wl,perl.base $(LINK_FLAGS) \ + $(LINK32) -mdll -o $@ -Wl,--base-file -Wl,perl.base $(BLINK_FLAGS) \ $(mktmp $(LKPRE) $(PERLDLL_OBJ:s,\,\\) $(LIBFILES) $(LKPOST)) dlltool --output-lib $(PERLIMPLIB) \ - --dllname perl.dll \ - --def perldll.def \ - --base-file perl.base \ - --output-exp perl.exp - $(LINK32) -mdll -o $@ $(LINK_FLAGS) \ + --dllname $(PERLDLL:b).dll \ + --def perldll.def \ + --base-file perl.base \ + --output-exp perl.exp + $(LINK32) -mdll -o $@ $(BLINK_FLAGS) \ $(mktmp $(LKPRE) $(PERLDLL_OBJ:s,\,\\) $(LIBFILES) \ perl.exp $(LKPOST)) .ELSE $(LINK32) -dll -def:perldll.def -out:$@ \ - @$(mktmp $(LINK_FLAGS) $(LIBFILES) $(PERLDLL_OBJ:s,\,\\)) + @$(mktmp $(BLINK_FLAGS) $(LIBFILES) $(PERLDLL_RES) $(PERLDLL_OBJ:s,\,\\)) .ENDIF $(XCOPY) $(PERLIMPLIB) $(COREDIR) @@ -900,14 +1068,14 @@ $(X2P) : $(MINIPERL) $(X2P_OBJ) $(MINIPERL) ..\x2p\find2perl.PL $(MINIPERL) ..\x2p\s2p.PL .IF "$(CCTYPE)" == "BORLAND" - $(LINK32) -Tpe -ap $(LINK_FLAGS) \ + $(LINK32) -Tpe -ap $(BLINK_FLAGS) \ @$(mktmp c0x32$(o) $(X2P_OBJ:s,\,\\),$(@:s,\,\\),,$(LIBFILES),) .ELIF "$(CCTYPE)" == "GCC" - $(LINK32) -v -o $@ $(LINK_FLAGS) \ + $(LINK32) -v -o $@ $(BLINK_FLAGS) \ $(mktmp $(LKPRE) $(X2P_OBJ:s,\,\\) $(LIBFILES) $(LKPOST)) .ELSE $(LINK32) -subsystem:console -out:$@ \ - @$(mktmp $(LINK_FLAGS) $(LIBFILES) $(X2P_OBJ:s,\,\\)) + @$(mktmp $(BLINK_FLAGS) $(LIBFILES) $(X2P_OBJ:s,\,\\)) .ENDIF perlmain.c : runperl.c @@ -916,25 +1084,27 @@ perlmain.c : runperl.c perlmain$(o) : perlmain.c $(CC) $(CFLAGS_O) -UPERLDLL $(OBJOUT_FLAG)$@ -c perlmain.c -$(PERLEXE): $(PERLDLL) $(CONFIGPM) $(PERLEXE_OBJ) +$(PERLEXE): $(PERLDLL) $(CONFIGPM) $(PERLEXE_OBJ) $(PERLEXE_RES) .IF "$(CCTYPE)" == "BORLAND" - $(LINK32) -Tpe -ap $(LINK_FLAGS) \ + $(LINK32) -Tpe -ap $(BLINK_FLAGS) \ @$(mktmp c0x32$(o) $(PERLEXE_OBJ:s,\,\\)\n \ $(@:s,\,\\),\n \ $(PERLIMPLIB) $(LIBFILES)\n) .ELIF "$(CCTYPE)" == "GCC" - $(LINK32) -o $@ $(LINK_FLAGS) \ + $(LINK32) -mconsole -o $@ $(BLINK_FLAGS) \ $(PERLEXE_OBJ) $(PERLIMPLIB) $(LIBFILES) .ELSE - $(LINK32) -subsystem:console -out:$@ $(LINK_FLAGS) $(LIBFILES) \ - $(PERLEXE_OBJ) $(SETARGV_OBJ) $(PERLIMPLIB) + $(LINK32) -subsystem:console -out:$@ $(BLINK_FLAGS) $(LIBFILES) \ + $(PERLEXE_OBJ) $(SETARGV_OBJ) $(PERLIMPLIB) $(PERLEXE_RES) + copy $(PERLEXE) $(WPERLEXE) + editbin /subsystem:windows $(WPERLEXE) .ENDIF copy splittree.pl .. $(MINIPERL) -I..\lib ..\splittree.pl "../LIB" $(AUTODIR) .IF "$(CCTYPE)" != "BORLAND" .IF "$(CCTYPE)" != "GCC" -.IF "$(USE_PERLCRT)" == "" +.IF "$(USE_PERLCRT)" != "define" perl95.c : runperl.c copy runperl.c perl95.c @@ -955,7 +1125,7 @@ DynaLoadmt$(o) : $(DYNALOADER).c $(OBJOUT_FLAG)DynaLoadmt$(o) $(DYNALOADER).c $(PERL95EXE): $(PERLDLL) $(CONFIGPM) $(PERL95_OBJ) - $(LINK32) -subsystem:console -nodefaultlib -out:$@ $(LINK_FLAGS) \ + $(LINK32) -subsystem:console -nodefaultlib -out:$@ $(BLINK_FLAGS) \ $(LIBBASEFILES) $(PERL95_OBJ) $(SETARGV_OBJ) $(PERLIMPLIB) \ libcmt.lib @@ -966,7 +1136,9 @@ $(PERL95EXE): $(PERLDLL) $(CONFIGPM) $(PERL95_OBJ) $(DYNALOADER).c: $(MINIPERL) $(EXTDIR)\DynaLoader\dl_win32.xs $(CONFIGPM) if not exist $(AUTODIR) mkdir $(AUTODIR) cd $(EXTDIR)\$(*B) && ..\$(MINIPERL) -I..\..\lib $(*B)_pm.PL + cd $(EXTDIR)\$(*B) && ..\$(MINIPERL) -I..\..\lib XSLoader_pm.PL $(XCOPY) $(EXTDIR)\$(*B)\$(*B).pm $(LIBDIR)\$(NULL) + $(XCOPY) $(EXTDIR)\$(*B)\XSLoader.pm $(LIBDIR)\$(NULL) cd $(EXTDIR)\$(*B) && $(XSUBPP) dl_win32.xs > $(*B).c $(XCOPY) $(EXTDIR)\$(*B)\dlutils.c . @@ -983,6 +1155,11 @@ $(DPROF_DLL): $(PERLEXE) $(DPROF).xs ..\..\..\miniperl -I..\..\..\lib Makefile.PL INSTALLDIRS=perl cd $(EXTDIR)\Devel\$(*B) && $(MAKE) +$(GLOB_DLL): $(PERLEXE) $(GLOB).xs + cd $(EXTDIR)\File\$(*B) && \ + ..\..\..\miniperl -I..\..\..\lib Makefile.PL INSTALLDIRS=perl + cd $(EXTDIR)\File\$(*B) && $(MAKE) + $(PEEK_DLL): $(PERLEXE) $(PEEK).xs cd $(EXTDIR)\Devel\$(*B) && \ ..\..\..\miniperl -I..\..\..\lib Makefile.PL INSTALLDIRS=perl @@ -1067,12 +1244,14 @@ distclean: clean -del /f $(EXTENSION_C) $(DYNALOADER).c $(ERRNO).pm -del /f $(EXTDIR)\DynaLoader\dl_win32.xs -del /f $(LIBDIR)\.exists $(LIBDIR)\attrs.pm $(LIBDIR)\DynaLoader.pm + -del /f $(LIBDIR)\XSLoader.pm -del /f $(LIBDIR)\Fcntl.pm $(LIBDIR)\IO.pm $(LIBDIR)\Opcode.pm -del /f $(LIBDIR)\ops.pm $(LIBDIR)\Safe.pm $(LIBDIR)\Thread.pm -del /f $(LIBDIR)\SDBM_File.pm $(LIBDIR)\Socket.pm $(LIBDIR)\POSIX.pm -del /f $(LIBDIR)\B.pm $(LIBDIR)\O.pm $(LIBDIR)\re.pm -del /f $(LIBDIR)\Data\Dumper.pm $(LIBDIR)\ByteLoader.pm -del /f $(LIBDIR)\Devel\Peek.pm $(LIBDIR)\Devel\DProf.pm + -del /f $(LIBDIR)\File\Glob.pm -rmdir /s /q $(LIBDIR)\IO || rmdir /s $(LIBDIR)\IO -rmdir /s /q $(LIBDIR)\Thread || rmdir /s $(LIBDIR)\Thread -rmdir /s /q $(LIBDIR)\B || rmdir /s $(LIBDIR)\B @@ -1080,7 +1259,7 @@ distclean: clean -del /f $(PODDIR)\*.html -del /f $(PODDIR)\*.bat -cd ..\utils && del /f h2ph splain perlbug pl2pm c2ph h2xs perldoc \ - dprofpp pstruct *.bat + dprofpp *.bat -cd ..\x2p && del /f find2perl s2p *.bat -del /f ..\config.sh ..\splittree.pl perlmain.c dlutils.c config.h.new -del /f $(CONFIGPM) @@ -1095,11 +1274,12 @@ distclean: clean install : all installbare installhtml -installbare : utils +installbare : $(RIGHTMAKE) utils $(PERLEXE) ..\installperl .IF "$(PERL95EXE)" != "" $(XCOPY) $(PERL95EXE) $(INST_BIN)\*.* .ENDIF + if exist $(WPERLEXE) $(XCOPY) $(WPERLEXE) $(INST_BIN)\*.* $(XCOPY) $(GLOBEXE) $(INST_BIN)\*.* $(XCOPY) bin\*.bat $(INST_SCRIPT)\*.* @@ -1132,7 +1312,7 @@ test-prep : all utils $(XCOPY) $(GLOBEXE) ..\t\$(NULL) .ENDIF -test : test-prep +test : $(RIGHTMAKE) test-prep cd ..\t && $(PERLEXE) -I..\lib harness test-notty : test-prep @@ -1148,6 +1328,7 @@ clean : -@erase /f config.h -@erase $(GLOBEXE) -@erase $(PERLEXE) + -@erase $(WPERLEXE) -@erase $(PERLDLL) -@erase $(CORE_OBJ) -rmdir /s /q $(MINIDIR) || rmdir /s $(MINIDIR) diff --git a/win32/perlhost.h b/win32/perlhost.h new file mode 100644 index 0000000..93cb458 --- /dev/null +++ b/win32/perlhost.h @@ -0,0 +1,2307 @@ +/* perlhost.h + * + * (c) 1999 Microsoft Corporation. All rights reserved. + * Portions (c) 1999 ActiveState Tool Corp, http://www.ActiveState.com/ + * + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. + */ + +#ifndef ___PerlHost_H___ +#define ___PerlHost_H___ + +#include "iperlsys.h" +#include "vmem.h" +#include "vdir.h" + +#if !defined(PERL_OBJECT) +START_EXTERN_C +#endif +extern char * g_win32_get_privlib(char *pl); +extern char * g_win32_get_sitelib(char *pl); +extern char * g_getlogin(void); +extern int do_spawn2(char *cmd, int exectype); +#if !defined(PERL_OBJECT) +END_EXTERN_C +#endif + +#ifdef PERL_OBJECT +extern int g_do_aspawn(void *vreally, void **vmark, void **vsp); +#define do_aspawn g_do_aspawn +#endif + +class CPerlHost +{ +public: + CPerlHost(void); + CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared, + struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv, + struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO, + struct IPerlDir** ppDir, struct IPerlSock** ppSock, + struct IPerlProc** ppProc); + CPerlHost(CPerlHost& host); + ~CPerlHost(void); + + static CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl); + static CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl); + static CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl); + static CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl); + static CPerlHost* IPerlStdIO2Host(struct IPerlStdIO* piPerl); + static CPerlHost* IPerlLIO2Host(struct IPerlLIO* piPerl); + static CPerlHost* IPerlDir2Host(struct IPerlDir* piPerl); + static CPerlHost* IPerlSock2Host(struct IPerlSock* piPerl); + static CPerlHost* IPerlProc2Host(struct IPerlProc* piPerl); + + BOOL PerlCreate(void); + int PerlParse(int argc, char** argv, char** env); + int PerlRun(void); + void PerlDestroy(void); + +/* IPerlMem */ + inline void* Malloc(size_t size) { return m_pVMem->Malloc(size); }; + inline void* Realloc(void* ptr, size_t size) { return m_pVMem->Realloc(ptr, size); }; + inline void Free(void* ptr) { m_pVMem->Free(ptr); }; + inline void* Calloc(size_t num, size_t size) + { + size_t count = num*size; + void* lpVoid = Malloc(count); + if (lpVoid) + ZeroMemory(lpVoid, count); + return lpVoid; + }; + inline void GetLock(void) { m_pVMem->GetLock(); }; + inline void FreeLock(void) { m_pVMem->FreeLock(); }; + inline int IsLocked(void) { return m_pVMem->IsLocked(); }; + +/* IPerlMemShared */ + inline void* MallocShared(size_t size) + { + return m_pVMemShared->Malloc(size); + }; + inline void* ReallocShared(void* ptr, size_t size) { return m_pVMemShared->Realloc(ptr, size); }; + inline void FreeShared(void* ptr) { m_pVMemShared->Free(ptr); }; + inline void* CallocShared(size_t num, size_t size) + { + size_t count = num*size; + void* lpVoid = MallocShared(count); + if (lpVoid) + ZeroMemory(lpVoid, count); + return lpVoid; + }; + inline void GetLockShared(void) { m_pVMem->GetLock(); }; + inline void FreeLockShared(void) { m_pVMem->FreeLock(); }; + inline int IsLockedShared(void) { return m_pVMem->IsLocked(); }; + +/* IPerlMemParse */ + inline void* MallocParse(size_t size) { return m_pVMemParse->Malloc(size); }; + inline void* ReallocParse(void* ptr, size_t size) { return m_pVMemParse->Realloc(ptr, size); }; + inline void FreeParse(void* ptr) { m_pVMemParse->Free(ptr); }; + inline void* CallocParse(size_t num, size_t size) + { + size_t count = num*size; + void* lpVoid = MallocParse(count); + if (lpVoid) + ZeroMemory(lpVoid, count); + return lpVoid; + }; + inline void GetLockParse(void) { m_pVMem->GetLock(); }; + inline void FreeLockParse(void) { m_pVMem->FreeLock(); }; + inline int IsLockedParse(void) { return m_pVMem->IsLocked(); }; + +/* IPerlEnv */ + char *Getenv(const char *varname); + int Putenv(const char *envstring); + inline char *Getenv(const char *varname, unsigned long *len) + { + *len = 0; + char *e = Getenv(varname); + if (e) + *len = strlen(e); + return e; + } + void* CreateChildEnv(void) { return CreateLocalEnvironmentStrings(*m_pvDir); }; + void FreeChildEnv(void* pStr) { FreeLocalEnvironmentStrings((char*)pStr); }; + char* GetChildDir(void); + void FreeChildDir(char* pStr); + void Reset(void); + void Clearenv(void); + + inline LPSTR GetIndex(DWORD &dwIndex) + { + if(dwIndex < m_dwEnvCount) + { + ++dwIndex; + return m_lppEnvList[dwIndex-1]; + } + return NULL; + }; + +protected: + LPSTR Find(LPCSTR lpStr); + void Add(LPCSTR lpStr); + + LPSTR CreateLocalEnvironmentStrings(VDir &vDir); + void FreeLocalEnvironmentStrings(LPSTR lpStr); + LPSTR* Lookup(LPCSTR lpStr); + DWORD CalculateEnvironmentSpace(void); + +public: + +/* IPerlDIR */ + virtual int Chdir(const char *dirname); + +/* IPerllProc */ + void Abort(void); + void Exit(int status); + void _Exit(int status); + int Execl(const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3); + int Execv(const char *cmdname, const char *const *argv); + int Execvp(const char *cmdname, const char *const *argv); + + inline VMem* GetMemShared(void) { m_pVMemShared->AddRef(); return m_pVMemShared; }; + inline VMem* GetMemParse(void) { m_pVMemParse->AddRef(); return m_pVMemParse; }; + inline VDir* GetDir(void) { return m_pvDir; }; + +public: + + struct IPerlMem m_hostperlMem; + struct IPerlMem m_hostperlMemShared; + struct IPerlMem m_hostperlMemParse; + struct IPerlEnv m_hostperlEnv; + struct IPerlStdIO m_hostperlStdIO; + struct IPerlLIO m_hostperlLIO; + struct IPerlDir m_hostperlDir; + struct IPerlSock m_hostperlSock; + struct IPerlProc m_hostperlProc; + + struct IPerlMem* m_pHostperlMem; + struct IPerlMem* m_pHostperlMemShared; + struct IPerlMem* m_pHostperlMemParse; + struct IPerlEnv* m_pHostperlEnv; + struct IPerlStdIO* m_pHostperlStdIO; + struct IPerlLIO* m_pHostperlLIO; + struct IPerlDir* m_pHostperlDir; + struct IPerlSock* m_pHostperlSock; + struct IPerlProc* m_pHostperlProc; + + inline char* MapPathA(const char *pInName) { return m_pvDir->MapPathA(pInName); }; + inline WCHAR* MapPathW(const WCHAR *pInName) { return m_pvDir->MapPathW(pInName); }; +protected: + + VDir* m_pvDir; + VMem* m_pVMem; + VMem* m_pVMemShared; + VMem* m_pVMemParse; + + DWORD m_dwEnvCount; + LPSTR* m_lppEnvList; +}; + + +#define STRUCT2PTR(x, y) (CPerlHost*)(((LPBYTE)x)-offsetof(CPerlHost, y)) + +inline CPerlHost* IPerlMem2Host(struct IPerlMem* piPerl) +{ + return STRUCT2PTR(piPerl, m_hostperlMem); +} + +inline CPerlHost* IPerlMemShared2Host(struct IPerlMem* piPerl) +{ + return STRUCT2PTR(piPerl, m_hostperlMemShared); +} + +inline CPerlHost* IPerlMemParse2Host(struct IPerlMem* piPerl) +{ + return STRUCT2PTR(piPerl, m_hostperlMemParse); +} + +inline CPerlHost* IPerlEnv2Host(struct IPerlEnv* piPerl) +{ + return STRUCT2PTR(piPerl, m_hostperlEnv); +} + +inline CPerlHost* IPerlStdIO2Host(struct IPerlStdIO* piPerl) +{ + return STRUCT2PTR(piPerl, m_hostperlStdIO); +} + +inline CPerlHost* IPerlLIO2Host(struct IPerlLIO* piPerl) +{ + return STRUCT2PTR(piPerl, m_hostperlLIO); +} + +inline CPerlHost* IPerlDir2Host(struct IPerlDir* piPerl) +{ + return STRUCT2PTR(piPerl, m_hostperlDir); +} + +inline CPerlHost* IPerlSock2Host(struct IPerlSock* piPerl) +{ + return STRUCT2PTR(piPerl, m_hostperlSock); +} + +inline CPerlHost* IPerlProc2Host(struct IPerlProc* piPerl) +{ + return STRUCT2PTR(piPerl, m_hostperlProc); +} + + + +#undef IPERL2HOST +#define IPERL2HOST(x) IPerlMem2Host(x) + +/* IPerlMem */ +void* +PerlMemMalloc(struct IPerlMem* piPerl, size_t size) +{ + return IPERL2HOST(piPerl)->Malloc(size); +} +void* +PerlMemRealloc(struct IPerlMem* piPerl, void* ptr, size_t size) +{ + return IPERL2HOST(piPerl)->Realloc(ptr, size); +} +void +PerlMemFree(struct IPerlMem* piPerl, void* ptr) +{ + IPERL2HOST(piPerl)->Free(ptr); +} +void* +PerlMemCalloc(struct IPerlMem* piPerl, size_t num, size_t size) +{ + return IPERL2HOST(piPerl)->Calloc(num, size); +} + +void +PerlMemGetLock(struct IPerlMem* piPerl) +{ + IPERL2HOST(piPerl)->GetLock(); +} + +void +PerlMemFreeLock(struct IPerlMem* piPerl) +{ + IPERL2HOST(piPerl)->FreeLock(); +} + +int +PerlMemIsLocked(struct IPerlMem* piPerl) +{ + return IPERL2HOST(piPerl)->IsLocked(); +} + +struct IPerlMem perlMem = +{ + PerlMemMalloc, + PerlMemRealloc, + PerlMemFree, + PerlMemCalloc, + PerlMemGetLock, + PerlMemFreeLock, + PerlMemIsLocked, +}; + +#undef IPERL2HOST +#define IPERL2HOST(x) IPerlMemShared2Host(x) + +/* IPerlMemShared */ +void* +PerlMemSharedMalloc(struct IPerlMem* piPerl, size_t size) +{ + return IPERL2HOST(piPerl)->MallocShared(size); +} +void* +PerlMemSharedRealloc(struct IPerlMem* piPerl, void* ptr, size_t size) +{ + return IPERL2HOST(piPerl)->ReallocShared(ptr, size); +} +void +PerlMemSharedFree(struct IPerlMem* piPerl, void* ptr) +{ + IPERL2HOST(piPerl)->FreeShared(ptr); +} +void* +PerlMemSharedCalloc(struct IPerlMem* piPerl, size_t num, size_t size) +{ + return IPERL2HOST(piPerl)->CallocShared(num, size); +} + +void +PerlMemSharedGetLock(struct IPerlMem* piPerl) +{ + IPERL2HOST(piPerl)->GetLockShared(); +} + +void +PerlMemSharedFreeLock(struct IPerlMem* piPerl) +{ + IPERL2HOST(piPerl)->FreeLockShared(); +} + +int +PerlMemSharedIsLocked(struct IPerlMem* piPerl) +{ + return IPERL2HOST(piPerl)->IsLockedShared(); +} + +struct IPerlMem perlMemShared = +{ + PerlMemSharedMalloc, + PerlMemSharedRealloc, + PerlMemSharedFree, + PerlMemSharedCalloc, + PerlMemSharedGetLock, + PerlMemSharedFreeLock, + PerlMemSharedIsLocked, +}; + +#undef IPERL2HOST +#define IPERL2HOST(x) IPerlMemParse2Host(x) + +/* IPerlMemParse */ +void* +PerlMemParseMalloc(struct IPerlMem* piPerl, size_t size) +{ + return IPERL2HOST(piPerl)->MallocParse(size); +} +void* +PerlMemParseRealloc(struct IPerlMem* piPerl, void* ptr, size_t size) +{ + return IPERL2HOST(piPerl)->ReallocParse(ptr, size); +} +void +PerlMemParseFree(struct IPerlMem* piPerl, void* ptr) +{ + IPERL2HOST(piPerl)->FreeParse(ptr); +} +void* +PerlMemParseCalloc(struct IPerlMem* piPerl, size_t num, size_t size) +{ + return IPERL2HOST(piPerl)->CallocParse(num, size); +} + +void +PerlMemParseGetLock(struct IPerlMem* piPerl) +{ + IPERL2HOST(piPerl)->GetLockParse(); +} + +void +PerlMemParseFreeLock(struct IPerlMem* piPerl) +{ + IPERL2HOST(piPerl)->FreeLockParse(); +} + +int +PerlMemParseIsLocked(struct IPerlMem* piPerl) +{ + return IPERL2HOST(piPerl)->IsLockedParse(); +} + +struct IPerlMem perlMemParse = +{ + PerlMemParseMalloc, + PerlMemParseRealloc, + PerlMemParseFree, + PerlMemParseCalloc, + PerlMemParseGetLock, + PerlMemParseFreeLock, + PerlMemParseIsLocked, +}; + + +#undef IPERL2HOST +#define IPERL2HOST(x) IPerlEnv2Host(x) + +/* IPerlEnv */ +char* +PerlEnvGetenv(struct IPerlEnv* piPerl, const char *varname) +{ + return IPERL2HOST(piPerl)->Getenv(varname); +}; + +int +PerlEnvPutenv(struct IPerlEnv* piPerl, const char *envstring) +{ + return IPERL2HOST(piPerl)->Putenv(envstring); +}; + +char* +PerlEnvGetenv_len(struct IPerlEnv* piPerl, const char* varname, unsigned long* len) +{ + return IPERL2HOST(piPerl)->Getenv(varname, len); +} + +int +PerlEnvUname(struct IPerlEnv* piPerl, struct utsname *name) +{ + return win32_uname(name); +} + +void +PerlEnvClearenv(struct IPerlEnv* piPerl) +{ + IPERL2HOST(piPerl)->Clearenv(); +} + +void* +PerlEnvGetChildenv(struct IPerlEnv* piPerl) +{ + return IPERL2HOST(piPerl)->CreateChildEnv(); +} + +void +PerlEnvFreeChildenv(struct IPerlEnv* piPerl, void* childEnv) +{ + IPERL2HOST(piPerl)->FreeChildEnv(childEnv); +} + +char* +PerlEnvGetChilddir(struct IPerlEnv* piPerl) +{ + return IPERL2HOST(piPerl)->GetChildDir(); +} + +void +PerlEnvFreeChilddir(struct IPerlEnv* piPerl, char* childDir) +{ + IPERL2HOST(piPerl)->FreeChildDir(childDir); +} + +unsigned long +PerlEnvOsId(struct IPerlEnv* piPerl) +{ + return win32_os_id(); +} + +char* +PerlEnvLibPath(struct IPerlEnv* piPerl, char *pl) +{ + return g_win32_get_privlib(pl); +} + +char* +PerlEnvSiteLibPath(struct IPerlEnv* piPerl, char *pl) +{ + return g_win32_get_sitelib(pl); +} + +struct IPerlEnv perlEnv = +{ + PerlEnvGetenv, + PerlEnvPutenv, + PerlEnvGetenv_len, + PerlEnvUname, + PerlEnvClearenv, + PerlEnvGetChildenv, + PerlEnvFreeChildenv, + PerlEnvGetChilddir, + PerlEnvFreeChilddir, + PerlEnvOsId, + PerlEnvLibPath, + PerlEnvSiteLibPath, +}; + +#undef IPERL2HOST +#define IPERL2HOST(x) IPerlStdIO2Host(x) + +/* PerlStdIO */ +PerlIO* +PerlStdIOStdin(struct IPerlStdIO* piPerl) +{ + return (PerlIO*)win32_stdin(); +} + +PerlIO* +PerlStdIOStdout(struct IPerlStdIO* piPerl) +{ + return (PerlIO*)win32_stdout(); +} + +PerlIO* +PerlStdIOStderr(struct IPerlStdIO* piPerl) +{ + return (PerlIO*)win32_stderr(); +} + +PerlIO* +PerlStdIOOpen(struct IPerlStdIO* piPerl, const char *path, const char *mode) +{ + return (PerlIO*)win32_fopen(path, mode); +} + +int +PerlStdIOClose(struct IPerlStdIO* piPerl, PerlIO* pf) +{ + return win32_fclose(((FILE*)pf)); +} + +int +PerlStdIOEof(struct IPerlStdIO* piPerl, PerlIO* pf) +{ + return win32_feof((FILE*)pf); +} + +int +PerlStdIOError(struct IPerlStdIO* piPerl, PerlIO* pf) +{ + return win32_ferror((FILE*)pf); +} + +void +PerlStdIOClearerr(struct IPerlStdIO* piPerl, PerlIO* pf) +{ + win32_clearerr((FILE*)pf); +} + +int +PerlStdIOGetc(struct IPerlStdIO* piPerl, PerlIO* pf) +{ + return win32_getc((FILE*)pf); +} + +char* +PerlStdIOGetBase(struct IPerlStdIO* piPerl, PerlIO* pf) +{ +#ifdef FILE_base + FILE *f = (FILE*)pf; + return FILE_base(f); +#else + return Nullch; +#endif +} + +int +PerlStdIOGetBufsiz(struct IPerlStdIO* piPerl, PerlIO* pf) +{ +#ifdef FILE_bufsiz + FILE *f = (FILE*)pf; + return FILE_bufsiz(f); +#else + return (-1); +#endif +} + +int +PerlStdIOGetCnt(struct IPerlStdIO* piPerl, PerlIO* pf) +{ +#ifdef USE_STDIO_PTR + FILE *f = (FILE*)pf; + return FILE_cnt(f); +#else + return (-1); +#endif +} + +char* +PerlStdIOGetPtr(struct IPerlStdIO* piPerl, PerlIO* pf) +{ +#ifdef USE_STDIO_PTR + FILE *f = (FILE*)pf; + return FILE_ptr(f); +#else + return Nullch; +#endif +} + +char* +PerlStdIOGets(struct IPerlStdIO* piPerl, PerlIO* pf, char* s, int n) +{ + return win32_fgets(s, n, (FILE*)pf); +} + +int +PerlStdIOPutc(struct IPerlStdIO* piPerl, PerlIO* pf, int c) +{ + return win32_fputc(c, (FILE*)pf); +} + +int +PerlStdIOPuts(struct IPerlStdIO* piPerl, PerlIO* pf, const char *s) +{ + return win32_fputs(s, (FILE*)pf); +} + +int +PerlStdIOFlush(struct IPerlStdIO* piPerl, PerlIO* pf) +{ + return win32_fflush((FILE*)pf); +} + +int +PerlStdIOUngetc(struct IPerlStdIO* piPerl, PerlIO* pf,int c) +{ + return win32_ungetc(c, (FILE*)pf); +} + +int +PerlStdIOFileno(struct IPerlStdIO* piPerl, PerlIO* pf) +{ + return win32_fileno((FILE*)pf); +} + +PerlIO* +PerlStdIOFdopen(struct IPerlStdIO* piPerl, int fd, const char *mode) +{ + return (PerlIO*)win32_fdopen(fd, mode); +} + +PerlIO* +PerlStdIOReopen(struct IPerlStdIO* piPerl, const char*path, const char*mode, PerlIO* pf) +{ + return (PerlIO*)win32_freopen(path, mode, (FILE*)pf); +} + +SSize_t +PerlStdIORead(struct IPerlStdIO* piPerl, PerlIO* pf, void *buffer, Size_t size) +{ + return win32_fread(buffer, 1, size, (FILE*)pf); +} + +SSize_t +PerlStdIOWrite(struct IPerlStdIO* piPerl, PerlIO* pf, const void *buffer, Size_t size) +{ + return win32_fwrite(buffer, 1, size, (FILE*)pf); +} + +void +PerlStdIOSetBuf(struct IPerlStdIO* piPerl, PerlIO* pf, char* buffer) +{ + win32_setbuf((FILE*)pf, buffer); +} + +int +PerlStdIOSetVBuf(struct IPerlStdIO* piPerl, PerlIO* pf, char* buffer, int type, Size_t size) +{ + return win32_setvbuf((FILE*)pf, buffer, type, size); +} + +void +PerlStdIOSetCnt(struct IPerlStdIO* piPerl, PerlIO* pf, int n) +{ +#ifdef STDIO_CNT_LVALUE + FILE *f = (FILE*)pf; + FILE_cnt(f) = n; +#endif +} + +void +PerlStdIOSetPtrCnt(struct IPerlStdIO* piPerl, PerlIO* pf, char * ptr, int n) +{ +#ifdef STDIO_PTR_LVALUE + FILE *f = (FILE*)pf; + FILE_ptr(f) = ptr; + FILE_cnt(f) = n; +#endif +} + +void +PerlStdIOSetlinebuf(struct IPerlStdIO* piPerl, PerlIO* pf) +{ + win32_setvbuf((FILE*)pf, NULL, _IOLBF, 0); +} + +int +PerlStdIOPrintf(struct IPerlStdIO* piPerl, PerlIO* pf, const char *format,...) +{ + va_list(arglist); + va_start(arglist, format); + return win32_vfprintf((FILE*)pf, format, arglist); +} + +int +PerlStdIOVprintf(struct IPerlStdIO* piPerl, PerlIO* pf, const char *format, va_list arglist) +{ + return win32_vfprintf((FILE*)pf, format, arglist); +} + +long +PerlStdIOTell(struct IPerlStdIO* piPerl, PerlIO* pf) +{ + return win32_ftell((FILE*)pf); +} + +int +PerlStdIOSeek(struct IPerlStdIO* piPerl, PerlIO* pf, off_t offset, int origin) +{ + return win32_fseek((FILE*)pf, offset, origin); +} + +void +PerlStdIORewind(struct IPerlStdIO* piPerl, PerlIO* pf) +{ + win32_rewind((FILE*)pf); +} + +PerlIO* +PerlStdIOTmpfile(struct IPerlStdIO* piPerl) +{ + return (PerlIO*)win32_tmpfile(); +} + +int +PerlStdIOGetpos(struct IPerlStdIO* piPerl, PerlIO* pf, Fpos_t *p) +{ + return win32_fgetpos((FILE*)pf, p); +} + +int +PerlStdIOSetpos(struct IPerlStdIO* piPerl, PerlIO* pf, const Fpos_t *p) +{ + return win32_fsetpos((FILE*)pf, p); +} +void +PerlStdIOInit(struct IPerlStdIO* piPerl) +{ +} + +void +PerlStdIOInitOSExtras(struct IPerlStdIO* piPerl) +{ + Perl_init_os_extras(); +} + +int +PerlStdIOOpenOSfhandle(struct IPerlStdIO* piPerl, long osfhandle, int flags) +{ + return win32_open_osfhandle(osfhandle, flags); +} + +int +PerlStdIOGetOSfhandle(struct IPerlStdIO* piPerl, int filenum) +{ + return win32_get_osfhandle(filenum); +} + +PerlIO* +PerlStdIOFdupopen(struct IPerlStdIO* piPerl, PerlIO* pf) +{ + PerlIO* pfdup; + fpos_t pos; + char mode[3]; + int fileno = win32_dup(win32_fileno((FILE*)pf)); + + /* open the file in the same mode */ +#ifdef __BORLANDC__ + if(((FILE*)pf)->flags & _F_READ) { + mode[0] = 'r'; + mode[1] = 0; + } + else if(((FILE*)pf)->flags & _F_WRIT) { + mode[0] = 'a'; + mode[1] = 0; + } + else if(((FILE*)pf)->flags & _F_RDWR) { + mode[0] = 'r'; + mode[1] = '+'; + mode[2] = 0; + } +#else + if(((FILE*)pf)->_flag & _IOREAD) { + mode[0] = 'r'; + mode[1] = 0; + } + else if(((FILE*)pf)->_flag & _IOWRT) { + mode[0] = 'a'; + mode[1] = 0; + } + else if(((FILE*)pf)->_flag & _IORW) { + mode[0] = 'r'; + mode[1] = '+'; + mode[2] = 0; + } +#endif + + /* it appears that the binmode is attached to the + * file descriptor so binmode files will be handled + * correctly + */ + pfdup = (PerlIO*)win32_fdopen(fileno, mode); + + /* move the file pointer to the same position */ + if (!fgetpos((FILE*)pf, &pos)) { + fsetpos((FILE*)pfdup, &pos); + } + return pfdup; +} + +struct IPerlStdIO perlStdIO = +{ + PerlStdIOStdin, + PerlStdIOStdout, + PerlStdIOStderr, + PerlStdIOOpen, + PerlStdIOClose, + PerlStdIOEof, + PerlStdIOError, + PerlStdIOClearerr, + PerlStdIOGetc, + PerlStdIOGetBase, + PerlStdIOGetBufsiz, + PerlStdIOGetCnt, + PerlStdIOGetPtr, + PerlStdIOGets, + PerlStdIOPutc, + PerlStdIOPuts, + PerlStdIOFlush, + PerlStdIOUngetc, + PerlStdIOFileno, + PerlStdIOFdopen, + PerlStdIOReopen, + PerlStdIORead, + PerlStdIOWrite, + PerlStdIOSetBuf, + PerlStdIOSetVBuf, + PerlStdIOSetCnt, + PerlStdIOSetPtrCnt, + PerlStdIOSetlinebuf, + PerlStdIOPrintf, + PerlStdIOVprintf, + PerlStdIOTell, + PerlStdIOSeek, + PerlStdIORewind, + PerlStdIOTmpfile, + PerlStdIOGetpos, + PerlStdIOSetpos, + PerlStdIOInit, + PerlStdIOInitOSExtras, + PerlStdIOFdupopen, +}; + + +#undef IPERL2HOST +#define IPERL2HOST(x) IPerlLIO2Host(x) + +/* IPerlLIO */ +int +PerlLIOAccess(struct IPerlLIO* piPerl, const char *path, int mode) +{ + return win32_access(path, mode); +} + +int +PerlLIOChmod(struct IPerlLIO* piPerl, const char *filename, int pmode) +{ + return win32_chmod(filename, pmode); +} + +int +PerlLIOChown(struct IPerlLIO* piPerl, const char *filename, uid_t owner, gid_t group) +{ + return chown(filename, owner, group); +} + +int +PerlLIOChsize(struct IPerlLIO* piPerl, int handle, long size) +{ + return chsize(handle, size); +} + +int +PerlLIOClose(struct IPerlLIO* piPerl, int handle) +{ + return win32_close(handle); +} + +int +PerlLIODup(struct IPerlLIO* piPerl, int handle) +{ + return win32_dup(handle); +} + +int +PerlLIODup2(struct IPerlLIO* piPerl, int handle1, int handle2) +{ + return win32_dup2(handle1, handle2); +} + +int +PerlLIOFlock(struct IPerlLIO* piPerl, int fd, int oper) +{ + return win32_flock(fd, oper); +} + +int +PerlLIOFileStat(struct IPerlLIO* piPerl, int handle, struct stat *buffer) +{ + return fstat(handle, buffer); +} + +int +PerlLIOIOCtl(struct IPerlLIO* piPerl, int i, unsigned int u, char *data) +{ + return win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data); +} + +int +PerlLIOIsatty(struct IPerlLIO* piPerl, int fd) +{ + return isatty(fd); +} + +int +PerlLIOLink(struct IPerlLIO* piPerl, const char*oldname, const char *newname) +{ + return win32_link(oldname, newname); +} + +long +PerlLIOLseek(struct IPerlLIO* piPerl, int handle, long offset, int origin) +{ + return win32_lseek(handle, offset, origin); +} + +int +PerlLIOLstat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer) +{ + return win32_stat(path, buffer); +} + +char* +PerlLIOMktemp(struct IPerlLIO* piPerl, char *Template) +{ + return mktemp(Template); +} + +int +PerlLIOOpen(struct IPerlLIO* piPerl, const char *filename, int oflag) +{ + return win32_open(filename, oflag); +} + +int +PerlLIOOpen3(struct IPerlLIO* piPerl, const char *filename, int oflag, int pmode) +{ + return win32_open(filename, oflag, pmode); +} + +int +PerlLIORead(struct IPerlLIO* piPerl, int handle, void *buffer, unsigned int count) +{ + return win32_read(handle, buffer, count); +} + +int +PerlLIORename(struct IPerlLIO* piPerl, const char *OldFileName, const char *newname) +{ + return win32_rename(OldFileName, newname); +} + +int +PerlLIOSetmode(struct IPerlLIO* piPerl, int handle, int mode) +{ + return win32_setmode(handle, mode); +} + +int +PerlLIONameStat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer) +{ + return win32_stat(path, buffer); +} + +char* +PerlLIOTmpnam(struct IPerlLIO* piPerl, char *string) +{ + return tmpnam(string); +} + +int +PerlLIOUmask(struct IPerlLIO* piPerl, int pmode) +{ + return umask(pmode); +} + +int +PerlLIOUnlink(struct IPerlLIO* piPerl, const char *filename) +{ + return win32_unlink(filename); +} + +int +PerlLIOUtime(struct IPerlLIO* piPerl, char *filename, struct utimbuf *times) +{ + return win32_utime(filename, times); +} + +int +PerlLIOWrite(struct IPerlLIO* piPerl, int handle, const void *buffer, unsigned int count) +{ + return win32_write(handle, buffer, count); +} + +struct IPerlLIO perlLIO = +{ + PerlLIOAccess, + PerlLIOChmod, + PerlLIOChown, + PerlLIOChsize, + PerlLIOClose, + PerlLIODup, + PerlLIODup2, + PerlLIOFlock, + PerlLIOFileStat, + PerlLIOIOCtl, + PerlLIOIsatty, + PerlLIOLink, + PerlLIOLseek, + PerlLIOLstat, + PerlLIOMktemp, + PerlLIOOpen, + PerlLIOOpen3, + PerlLIORead, + PerlLIORename, + PerlLIOSetmode, + PerlLIONameStat, + PerlLIOTmpnam, + PerlLIOUmask, + PerlLIOUnlink, + PerlLIOUtime, + PerlLIOWrite, +}; + + +#undef IPERL2HOST +#define IPERL2HOST(x) IPerlDir2Host(x) + +/* IPerlDIR */ +int +PerlDirMakedir(struct IPerlDir* piPerl, const char *dirname, int mode) +{ + return win32_mkdir(dirname, mode); +} + +int +PerlDirChdir(struct IPerlDir* piPerl, const char *dirname) +{ + return IPERL2HOST(piPerl)->Chdir(dirname); +} + +int +PerlDirRmdir(struct IPerlDir* piPerl, const char *dirname) +{ + return win32_rmdir(dirname); +} + +int +PerlDirClose(struct IPerlDir* piPerl, DIR *dirp) +{ + return win32_closedir(dirp); +} + +DIR* +PerlDirOpen(struct IPerlDir* piPerl, char *filename) +{ + return win32_opendir(filename); +} + +struct direct * +PerlDirRead(struct IPerlDir* piPerl, DIR *dirp) +{ + return win32_readdir(dirp); +} + +void +PerlDirRewind(struct IPerlDir* piPerl, DIR *dirp) +{ + win32_rewinddir(dirp); +} + +void +PerlDirSeek(struct IPerlDir* piPerl, DIR *dirp, long loc) +{ + win32_seekdir(dirp, loc); +} + +long +PerlDirTell(struct IPerlDir* piPerl, DIR *dirp) +{ + return win32_telldir(dirp); +} + +char* +PerlDirMapPathA(struct IPerlDir* piPerl, const char* path) +{ + return IPERL2HOST(piPerl)->MapPathA(path); +} + +WCHAR* +PerlDirMapPathW(struct IPerlDir* piPerl, const WCHAR* path) +{ + return IPERL2HOST(piPerl)->MapPathW(path); +} + +struct IPerlDir perlDir = +{ + PerlDirMakedir, + PerlDirChdir, + PerlDirRmdir, + PerlDirClose, + PerlDirOpen, + PerlDirRead, + PerlDirRewind, + PerlDirSeek, + PerlDirTell, + PerlDirMapPathA, + PerlDirMapPathW, +}; + + +/* IPerlSock */ +u_long +PerlSockHtonl(struct IPerlSock* piPerl, u_long hostlong) +{ + return win32_htonl(hostlong); +} + +u_short +PerlSockHtons(struct IPerlSock* piPerl, u_short hostshort) +{ + return win32_htons(hostshort); +} + +u_long +PerlSockNtohl(struct IPerlSock* piPerl, u_long netlong) +{ + return win32_ntohl(netlong); +} + +u_short +PerlSockNtohs(struct IPerlSock* piPerl, u_short netshort) +{ + return win32_ntohs(netshort); +} + +SOCKET PerlSockAccept(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* addr, int* addrlen) +{ + return win32_accept(s, addr, addrlen); +} + +int +PerlSockBind(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen) +{ + return win32_bind(s, name, namelen); +} + +int +PerlSockConnect(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen) +{ + return win32_connect(s, name, namelen); +} + +void +PerlSockEndhostent(struct IPerlSock* piPerl) +{ + win32_endhostent(); +} + +void +PerlSockEndnetent(struct IPerlSock* piPerl) +{ + win32_endnetent(); +} + +void +PerlSockEndprotoent(struct IPerlSock* piPerl) +{ + win32_endprotoent(); +} + +void +PerlSockEndservent(struct IPerlSock* piPerl) +{ + win32_endservent(); +} + +struct hostent* +PerlSockGethostbyaddr(struct IPerlSock* piPerl, const char* addr, int len, int type) +{ + return win32_gethostbyaddr(addr, len, type); +} + +struct hostent* +PerlSockGethostbyname(struct IPerlSock* piPerl, const char* name) +{ + return win32_gethostbyname(name); +} + +struct hostent* +PerlSockGethostent(struct IPerlSock* piPerl) +{ + dTHXo; + Perl_croak(aTHX_ "gethostent not implemented!\n"); + return NULL; +} + +int +PerlSockGethostname(struct IPerlSock* piPerl, char* name, int namelen) +{ + return win32_gethostname(name, namelen); +} + +struct netent * +PerlSockGetnetbyaddr(struct IPerlSock* piPerl, long net, int type) +{ + return win32_getnetbyaddr(net, type); +} + +struct netent * +PerlSockGetnetbyname(struct IPerlSock* piPerl, const char *name) +{ + return win32_getnetbyname((char*)name); +} + +struct netent * +PerlSockGetnetent(struct IPerlSock* piPerl) +{ + return win32_getnetent(); +} + +int PerlSockGetpeername(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen) +{ + return win32_getpeername(s, name, namelen); +} + +struct protoent* +PerlSockGetprotobyname(struct IPerlSock* piPerl, const char* name) +{ + return win32_getprotobyname(name); +} + +struct protoent* +PerlSockGetprotobynumber(struct IPerlSock* piPerl, int number) +{ + return win32_getprotobynumber(number); +} + +struct protoent* +PerlSockGetprotoent(struct IPerlSock* piPerl) +{ + return win32_getprotoent(); +} + +struct servent* +PerlSockGetservbyname(struct IPerlSock* piPerl, const char* name, const char* proto) +{ + return win32_getservbyname(name, proto); +} + +struct servent* +PerlSockGetservbyport(struct IPerlSock* piPerl, int port, const char* proto) +{ + return win32_getservbyport(port, proto); +} + +struct servent* +PerlSockGetservent(struct IPerlSock* piPerl) +{ + return win32_getservent(); +} + +int +PerlSockGetsockname(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen) +{ + return win32_getsockname(s, name, namelen); +} + +int +PerlSockGetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, char* optval, int* optlen) +{ + return win32_getsockopt(s, level, optname, optval, optlen); +} + +unsigned long +PerlSockInetAddr(struct IPerlSock* piPerl, const char* cp) +{ + return win32_inet_addr(cp); +} + +char* +PerlSockInetNtoa(struct IPerlSock* piPerl, struct in_addr in) +{ + return win32_inet_ntoa(in); +} + +int +PerlSockListen(struct IPerlSock* piPerl, SOCKET s, int backlog) +{ + return win32_listen(s, backlog); +} + +int +PerlSockRecv(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags) +{ + return win32_recv(s, buffer, len, flags); +} + +int +PerlSockRecvfrom(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen) +{ + return win32_recvfrom(s, buffer, len, flags, from, fromlen); +} + +int +PerlSockSelect(struct IPerlSock* piPerl, int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout) +{ + return win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout); +} + +int +PerlSockSend(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags) +{ + return win32_send(s, buffer, len, flags); +} + +int +PerlSockSendto(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen) +{ + return win32_sendto(s, buffer, len, flags, to, tolen); +} + +void +PerlSockSethostent(struct IPerlSock* piPerl, int stayopen) +{ + win32_sethostent(stayopen); +} + +void +PerlSockSetnetent(struct IPerlSock* piPerl, int stayopen) +{ + win32_setnetent(stayopen); +} + +void +PerlSockSetprotoent(struct IPerlSock* piPerl, int stayopen) +{ + win32_setprotoent(stayopen); +} + +void +PerlSockSetservent(struct IPerlSock* piPerl, int stayopen) +{ + win32_setservent(stayopen); +} + +int +PerlSockSetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, const char* optval, int optlen) +{ + return win32_setsockopt(s, level, optname, optval, optlen); +} + +int +PerlSockShutdown(struct IPerlSock* piPerl, SOCKET s, int how) +{ + return win32_shutdown(s, how); +} + +SOCKET +PerlSockSocket(struct IPerlSock* piPerl, int af, int type, int protocol) +{ + return win32_socket(af, type, protocol); +} + +int +PerlSockSocketpair(struct IPerlSock* piPerl, int domain, int type, int protocol, int* fds) +{ + dTHXo; + Perl_croak(aTHX_ "socketpair not implemented!\n"); + return 0; +} + +int +PerlSockClosesocket(struct IPerlSock* piPerl, SOCKET s) +{ + return win32_closesocket(s); +} + +int +PerlSockIoctlsocket(struct IPerlSock* piPerl, SOCKET s, long cmd, u_long *argp) +{ + return win32_ioctlsocket(s, cmd, argp); +} + +struct IPerlSock perlSock = +{ + PerlSockHtonl, + PerlSockHtons, + PerlSockNtohl, + PerlSockNtohs, + PerlSockAccept, + PerlSockBind, + PerlSockConnect, + PerlSockEndhostent, + PerlSockEndnetent, + PerlSockEndprotoent, + PerlSockEndservent, + PerlSockGethostname, + PerlSockGetpeername, + PerlSockGethostbyaddr, + PerlSockGethostbyname, + PerlSockGethostent, + PerlSockGetnetbyaddr, + PerlSockGetnetbyname, + PerlSockGetnetent, + PerlSockGetprotobyname, + PerlSockGetprotobynumber, + PerlSockGetprotoent, + PerlSockGetservbyname, + PerlSockGetservbyport, + PerlSockGetservent, + PerlSockGetsockname, + PerlSockGetsockopt, + PerlSockInetAddr, + PerlSockInetNtoa, + PerlSockListen, + PerlSockRecv, + PerlSockRecvfrom, + PerlSockSelect, + PerlSockSend, + PerlSockSendto, + PerlSockSethostent, + PerlSockSetnetent, + PerlSockSetprotoent, + PerlSockSetservent, + PerlSockSetsockopt, + PerlSockShutdown, + PerlSockSocket, + PerlSockSocketpair, + PerlSockClosesocket, +}; + + +/* IPerlProc */ + +#define EXECF_EXEC 1 +#define EXECF_SPAWN 2 + +void +PerlProcAbort(struct IPerlProc* piPerl) +{ + win32_abort(); +} + +char * +PerlProcCrypt(struct IPerlProc* piPerl, const char* clear, const char* salt) +{ + return win32_crypt(clear, salt); +} + +void +PerlProcExit(struct IPerlProc* piPerl, int status) +{ + exit(status); +} + +void +PerlProc_Exit(struct IPerlProc* piPerl, int status) +{ + _exit(status); +} + +int +PerlProcExecl(struct IPerlProc* piPerl, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3) +{ + return execl(cmdname, arg0, arg1, arg2, arg3); +} + +int +PerlProcExecv(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv) +{ + return win32_execvp(cmdname, argv); +} + +int +PerlProcExecvp(struct IPerlProc* piPerl, const char *cmdname, const char *const *argv) +{ + return win32_execvp(cmdname, argv); +} + +uid_t +PerlProcGetuid(struct IPerlProc* piPerl) +{ + return getuid(); +} + +uid_t +PerlProcGeteuid(struct IPerlProc* piPerl) +{ + return geteuid(); +} + +gid_t +PerlProcGetgid(struct IPerlProc* piPerl) +{ + return getgid(); +} + +gid_t +PerlProcGetegid(struct IPerlProc* piPerl) +{ + return getegid(); +} + +char * +PerlProcGetlogin(struct IPerlProc* piPerl) +{ + return g_getlogin(); +} + +int +PerlProcKill(struct IPerlProc* piPerl, int pid, int sig) +{ + return win32_kill(pid, sig); +} + +int +PerlProcKillpg(struct IPerlProc* piPerl, int pid, int sig) +{ + dTHXo; + Perl_croak(aTHX_ "killpg not implemented!\n"); + return 0; +} + +int +PerlProcPauseProc(struct IPerlProc* piPerl) +{ + return win32_sleep((32767L << 16) + 32767); +} + +PerlIO* +PerlProcPopen(struct IPerlProc* piPerl, const char *command, const char *mode) +{ + dTHXo; + PERL_FLUSHALL_FOR_CHILD; + return (PerlIO*)win32_popen(command, mode); +} + +int +PerlProcPclose(struct IPerlProc* piPerl, PerlIO *stream) +{ + return win32_pclose((FILE*)stream); +} + +int +PerlProcPipe(struct IPerlProc* piPerl, int *phandles) +{ + return win32_pipe(phandles, 512, O_BINARY); +} + +int +PerlProcSetuid(struct IPerlProc* piPerl, uid_t u) +{ + return setuid(u); +} + +int +PerlProcSetgid(struct IPerlProc* piPerl, gid_t g) +{ + return setgid(g); +} + +int +PerlProcSleep(struct IPerlProc* piPerl, unsigned int s) +{ + return win32_sleep(s); +} + +int +PerlProcTimes(struct IPerlProc* piPerl, struct tms *timebuf) +{ + return win32_times(timebuf); +} + +int +PerlProcWait(struct IPerlProc* piPerl, int *status) +{ + return win32_wait(status); +} + +int +PerlProcWaitpid(struct IPerlProc* piPerl, int pid, int *status, int flags) +{ + return win32_waitpid(pid, status, flags); +} + +Sighandler_t +PerlProcSignal(struct IPerlProc* piPerl, int sig, Sighandler_t subcode) +{ + return 0; +} + +#ifdef USE_ITHREADS +static DWORD WINAPI +win32_start_child(LPVOID arg) +{ + PerlInterpreter *my_perl = (PerlInterpreter*)arg; + GV *tmpgv; + int status; +#ifdef PERL_OBJECT + CPerlObj *pPerl = (CPerlObj*)my_perl; +#endif +#ifdef PERL_SYNC_FORK + static long sync_fork_id = 0; + long id = ++sync_fork_id; +#endif + + + PERL_SET_INTERP(my_perl); + + /* set $$ to pseudo id */ +#ifdef PERL_SYNC_FORK + w32_pseudo_id = id; +#else + w32_pseudo_id = GetCurrentThreadId(); +#endif + if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV)) + sv_setiv(GvSV(tmpgv), -(IV)w32_pseudo_id); + hv_clear(PL_pidstatus); + + /* push a zero on the stack (we are the child) */ + { + djSP; + dTARGET; + PUSHi(0); + PUTBACK; + } + + /* continue from next op */ + PL_op = PL_op->op_next; + + { + dJMPENV; + volatile int oldscope = PL_scopestack_ix; + +restart: + JMPENV_PUSH(status); + switch (status) { + case 0: + CALLRUNOPS(aTHX); + status = 0; + break; + case 2: + while (PL_scopestack_ix > oldscope) + LEAVE; + FREETMPS; + PL_curstash = PL_defstash; + if (PL_endav && !PL_minus_c) + call_list(oldscope, PL_endav); + status = STATUS_NATIVE_EXPORT; + break; + case 3: + if (PL_restartop) { + POPSTACK_TO(PL_mainstack); + PL_op = PL_restartop; + PL_restartop = Nullop; + goto restart; + } + PerlIO_printf(Perl_error_log, "panic: restartop\n"); + FREETMPS; + status = 1; + break; + } + JMPENV_POP; + + /* XXX hack to avoid perl_destruct() freeing optree */ + PL_main_root = Nullop; + } + + /* destroy everything (waits for any pseudo-forked children) */ + perl_destruct(my_perl); + perl_free(my_perl); + +#ifdef PERL_SYNC_FORK + return id; +#else + return (DWORD)status; +#endif +} +#endif /* USE_ITHREADS */ + +int +PerlProcFork(struct IPerlProc* piPerl) +{ + dTHXo; +#ifdef USE_ITHREADS + DWORD id; + HANDLE handle; + CPerlHost *h = new CPerlHost(*(CPerlHost*)w32_internal_host); + PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHXo, 1, + h->m_pHostperlMem, + h->m_pHostperlMemShared, + h->m_pHostperlMemParse, + h->m_pHostperlEnv, + h->m_pHostperlStdIO, + h->m_pHostperlLIO, + h->m_pHostperlDir, + h->m_pHostperlSock, + h->m_pHostperlProc + ); + new_perl->Isys_intern.internal_host = h; +# ifdef PERL_SYNC_FORK + id = win32_start_child((LPVOID)new_perl); + PERL_SET_INTERP(aTHXo); +# else + handle = CreateThread(NULL, 0, win32_start_child, + (LPVOID)new_perl, 0, &id); + PERL_SET_INTERP(aTHXo); + if (!handle) + Perl_croak(aTHX_ "panic: pseudo fork() failed"); + w32_pseudo_child_handles[w32_num_pseudo_children] = handle; + w32_pseudo_child_pids[w32_num_pseudo_children] = id; + ++w32_num_pseudo_children; +# endif + return -(int)id; +#else + Perl_croak(aTHX_ "fork() not implemented!\n"); + return -1; +#endif /* USE_ITHREADS */ +} + +int +PerlProcGetpid(struct IPerlProc* piPerl) +{ + return win32_getpid(); +} + +void* +PerlProcDynaLoader(struct IPerlProc* piPerl, const char* filename) +{ + return win32_dynaload(filename); +} + +void +PerlProcGetOSError(struct IPerlProc* piPerl, SV* sv, DWORD dwErr) +{ + win32_str_os_error(sv, dwErr); +} + +BOOL +PerlProcDoCmd(struct IPerlProc* piPerl, char *cmd) +{ + do_spawn2(cmd, EXECF_EXEC); + return FALSE; +} + +int +PerlProcSpawn(struct IPerlProc* piPerl, char* cmds) +{ + return do_spawn2(cmds, EXECF_SPAWN); +} + +int +PerlProcSpawnvp(struct IPerlProc* piPerl, int mode, const char *cmdname, const char *const *argv) +{ + return win32_spawnvp(mode, cmdname, argv); +} + +int +PerlProcASpawn(struct IPerlProc* piPerl, void *vreally, void **vmark, void **vsp) +{ + return do_aspawn(vreally, vmark, vsp); +} + +struct IPerlProc perlProc = +{ + PerlProcAbort, + PerlProcCrypt, + PerlProcExit, + PerlProc_Exit, + PerlProcExecl, + PerlProcExecv, + PerlProcExecvp, + PerlProcGetuid, + PerlProcGeteuid, + PerlProcGetgid, + PerlProcGetegid, + PerlProcGetlogin, + PerlProcKill, + PerlProcKillpg, + PerlProcPauseProc, + PerlProcPopen, + PerlProcPclose, + PerlProcPipe, + PerlProcSetuid, + PerlProcSetgid, + PerlProcSleep, + PerlProcTimes, + PerlProcWait, + PerlProcWaitpid, + PerlProcSignal, + PerlProcFork, + PerlProcGetpid, + PerlProcDynaLoader, + PerlProcGetOSError, + PerlProcDoCmd, + PerlProcSpawn, + PerlProcSpawnvp, + PerlProcASpawn, +}; + + +/* + * CPerlHost + */ + +CPerlHost::CPerlHost(void) +{ + m_pvDir = new VDir(); + m_pVMem = new VMem(); + m_pVMemShared = new VMem(); + m_pVMemParse = new VMem(); + + m_pvDir->Init(NULL, m_pVMem); + + m_dwEnvCount = 0; + m_lppEnvList = NULL; + + CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem)); + CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared)); + CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse)); + CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv)); + CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO)); + CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO)); + CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir)); + CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock)); + CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc)); + + m_pHostperlMem = &m_hostperlMem; + m_pHostperlMemShared = &m_hostperlMemShared; + m_pHostperlMemParse = &m_hostperlMemParse; + m_pHostperlEnv = &m_hostperlEnv; + m_pHostperlStdIO = &m_hostperlStdIO; + m_pHostperlLIO = &m_hostperlLIO; + m_pHostperlDir = &m_hostperlDir; + m_pHostperlSock = &m_hostperlSock; + m_pHostperlProc = &m_hostperlProc; +} + +#define SETUPEXCHANGE(xptr, iptr, table) \ + STMT_START { \ + if (xptr) { \ + iptr = *xptr; \ + *xptr = &table; \ + } \ + else { \ + iptr = &table; \ + } \ + } STMT_END + +CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared, + struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv, + struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO, + struct IPerlDir** ppDir, struct IPerlSock** ppSock, + struct IPerlProc** ppProc) +{ + m_pvDir = new VDir(0); + m_pVMem = new VMem(); + m_pVMemShared = new VMem(); + m_pVMemParse = new VMem(); + + m_pvDir->Init(NULL, m_pVMem); + + m_dwEnvCount = 0; + m_lppEnvList = NULL; + + CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem)); + CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared)); + CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse)); + CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv)); + CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO)); + CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO)); + CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir)); + CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock)); + CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc)); + + SETUPEXCHANGE(ppMem, m_pHostperlMem, m_hostperlMem); + SETUPEXCHANGE(ppMemShared, m_pHostperlMemShared, m_hostperlMemShared); + SETUPEXCHANGE(ppMemParse, m_pHostperlMemParse, m_hostperlMemParse); + SETUPEXCHANGE(ppEnv, m_pHostperlEnv, m_hostperlEnv); + SETUPEXCHANGE(ppStdIO, m_pHostperlStdIO, m_hostperlStdIO); + SETUPEXCHANGE(ppLIO, m_pHostperlLIO, m_hostperlLIO); + SETUPEXCHANGE(ppDir, m_pHostperlDir, m_hostperlDir); + SETUPEXCHANGE(ppSock, m_pHostperlSock, m_hostperlSock); + SETUPEXCHANGE(ppProc, m_pHostperlProc, m_hostperlProc); +} +#undef SETUPEXCHANGE + +CPerlHost::CPerlHost(CPerlHost& host) +{ + m_pVMem = new VMem(); + m_pVMemShared = host.GetMemShared(); + m_pVMemParse = host.GetMemParse(); + + /* duplicate directory info */ + m_pvDir = new VDir(0); + m_pvDir->Init(host.GetDir(), m_pVMem); + + CopyMemory(&m_hostperlMem, &perlMem, sizeof(perlMem)); + CopyMemory(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared)); + CopyMemory(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse)); + CopyMemory(&m_hostperlEnv, &perlEnv, sizeof(perlEnv)); + CopyMemory(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO)); + CopyMemory(&m_hostperlLIO, &perlLIO, sizeof(perlLIO)); + CopyMemory(&m_hostperlDir, &perlDir, sizeof(perlDir)); + CopyMemory(&m_hostperlSock, &perlSock, sizeof(perlSock)); + CopyMemory(&m_hostperlProc, &perlProc, sizeof(perlProc)); + m_pHostperlMem = &m_hostperlMem; + m_pHostperlMemShared = &m_hostperlMemShared; + m_pHostperlMemParse = &m_hostperlMemParse; + m_pHostperlEnv = &m_hostperlEnv; + m_pHostperlStdIO = &m_hostperlStdIO; + m_pHostperlLIO = &m_hostperlLIO; + m_pHostperlDir = &m_hostperlDir; + m_pHostperlSock = &m_hostperlSock; + m_pHostperlProc = &m_hostperlProc; + + m_dwEnvCount = 0; + m_lppEnvList = NULL; + + /* duplicate environment info */ + LPSTR lpPtr; + DWORD dwIndex = 0; + while(lpPtr = host.GetIndex(dwIndex)) + Add(lpPtr); +} + +CPerlHost::~CPerlHost(void) +{ +// Reset(); + delete m_pvDir; + m_pVMemParse->Release(); + m_pVMemShared->Release(); + m_pVMem->Release(); +} + +LPSTR +CPerlHost::Find(LPCSTR lpStr) +{ + LPSTR lpPtr; + LPSTR* lppPtr = Lookup(lpStr); + if(lppPtr != NULL) { + for(lpPtr = *lppPtr; *lpPtr != '\0' && *lpPtr != '='; ++lpPtr) + ; + + if(*lpPtr == '=') + ++lpPtr; + + return lpPtr; + } + return NULL; +} + +int +lookup(const void *arg1, const void *arg2) +{ // Compare strings + char*ptr1, *ptr2; + char c1,c2; + + ptr1 = *(char**)arg1; + ptr2 = *(char**)arg2; + for(;;) { + c1 = *ptr1++; + c2 = *ptr2++; + if(c1 == '\0' || c1 == '=') { + if(c2 == '\0' || c2 == '=') + break; + + return -1; // string 1 < string 2 + } + else if(c2 == '\0' || c2 == '=') + return 1; // string 1 > string 2 + else if(c1 != c2) { + c1 = toupper(c1); + c2 = toupper(c2); + if(c1 != c2) { + if(c1 < c2) + return -1; // string 1 < string 2 + + return 1; // string 1 > string 2 + } + } + } + return 0; +} + +LPSTR* +CPerlHost::Lookup(LPCSTR lpStr) +{ + return (LPSTR*)bsearch(&lpStr, m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), lookup); +} + +int +compare(const void *arg1, const void *arg2) +{ // Compare strings + char*ptr1, *ptr2; + char c1,c2; + + ptr1 = *(char**)arg1; + ptr2 = *(char**)arg2; + for(;;) { + c1 = *ptr1++; + c2 = *ptr2++; + if(c1 == '\0' || c1 == '=') { + if(c1 == c2) + break; + + return -1; // string 1 < string 2 + } + else if(c2 == '\0' || c2 == '=') + return 1; // string 1 > string 2 + else if(c1 != c2) { + c1 = toupper(c1); + c2 = toupper(c2); + if(c1 != c2) { + if(c1 < c2) + return -1; // string 1 < string 2 + + return 1; // string 1 > string 2 + } + } + } + return 0; +} + +void +CPerlHost::Add(LPCSTR lpStr) +{ + dTHXo; + char szBuffer[1024]; + LPSTR *lpPtr; + int index, length = strlen(lpStr)+1; + + for(index = 0; lpStr[index] != '\0' && lpStr[index] != '='; ++index) + szBuffer[index] = lpStr[index]; + + szBuffer[index] = '\0'; + + // replacing ? + lpPtr = Lookup(szBuffer); + if(lpPtr != NULL) { + Renew(*lpPtr, length, char); + strcpy(*lpPtr, lpStr); + } + else { + ++m_dwEnvCount; + Renew(m_lppEnvList, m_dwEnvCount, LPSTR); + New(1, m_lppEnvList[m_dwEnvCount-1], length, char); + if(m_lppEnvList[m_dwEnvCount-1] != NULL) { + strcpy(m_lppEnvList[m_dwEnvCount-1], lpStr); + qsort(m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), compare); + } + else + --m_dwEnvCount; + } +} + +DWORD +CPerlHost::CalculateEnvironmentSpace(void) +{ + DWORD index; + DWORD dwSize = 0; + for(index = 0; index < m_dwEnvCount; ++index) + dwSize += strlen(m_lppEnvList[index]) + 1; + + return dwSize; +} + +void +CPerlHost::FreeLocalEnvironmentStrings(LPSTR lpStr) +{ + dTHXo; + Safefree(lpStr); +} + +char* +CPerlHost::GetChildDir(void) +{ + dTHXo; + int length; + char* ptr; + New(0, ptr, MAX_PATH+1, char); + if(ptr) { + m_pvDir->GetCurrentDirectoryA(MAX_PATH+1, ptr); + length = strlen(ptr)-1; + if(length > 0) { + if((ptr[length] == '\\') || (ptr[length] == '/')) + ptr[length] = 0; + } + } + return ptr; +} + +void +CPerlHost::FreeChildDir(char* pStr) +{ + dTHXo; + Safefree(pStr); +} + +LPSTR +CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir) +{ + dTHXo; + LPSTR lpStr, lpPtr, lpEnvPtr, lpTmp, lpLocalEnv, lpAllocPtr; + DWORD dwSize, dwEnvIndex; + int nLength, compVal; + + // get the process environment strings + lpAllocPtr = lpTmp = (LPSTR)GetEnvironmentStrings(); + + // step over current directory stuff + while(*lpTmp == '=') + lpTmp += strlen(lpTmp) + 1; + + // save the start of the environment strings + lpEnvPtr = lpTmp; + for(dwSize = 1; *lpTmp != '\0'; lpTmp += strlen(lpTmp) + 1) { + // calculate the size of the environment strings + dwSize += strlen(lpTmp) + 1; + } + + // add the size of current directories + dwSize += vDir.CalculateEnvironmentSpace(); + + // add the additional space used by changes made to the environment + dwSize += CalculateEnvironmentSpace(); + + New(1, lpStr, dwSize, char); + lpPtr = lpStr; + if(lpStr != NULL) { + // build the local environment + lpStr = vDir.BuildEnvironmentSpace(lpStr); + + dwEnvIndex = 0; + lpLocalEnv = GetIndex(dwEnvIndex); + while(*lpEnvPtr != '\0') { + if(lpLocalEnv == NULL) { + // all environment overrides have been added + // so copy string into place + strcpy(lpStr, lpEnvPtr); + nLength = strlen(lpEnvPtr) + 1; + lpStr += nLength; + lpEnvPtr += nLength; + } + else { + // determine which string to copy next + compVal = compare(&lpEnvPtr, &lpLocalEnv); + if(compVal < 0) { + strcpy(lpStr, lpEnvPtr); + nLength = strlen(lpEnvPtr) + 1; + lpStr += nLength; + lpEnvPtr += nLength; + } + else { + char *ptr = strchr(lpLocalEnv, '='); + if(ptr && ptr[1]) { + strcpy(lpStr, lpLocalEnv); + lpStr += strlen(lpLocalEnv) + 1; + } + lpLocalEnv = GetIndex(dwEnvIndex); + if(compVal == 0) { + // this string was replaced + lpEnvPtr += strlen(lpEnvPtr) + 1; + } + } + } + } + + // add final NULL + *lpStr = '\0'; + } + + // release the process environment strings + FreeEnvironmentStrings(lpAllocPtr); + + return lpPtr; +} + +void +CPerlHost::Reset(void) +{ + dTHXo; + if(m_lppEnvList != NULL) { + for(DWORD index = 0; index < m_dwEnvCount; ++index) { + Safefree(m_lppEnvList[index]); + m_lppEnvList[index] = NULL; + } + } + m_dwEnvCount = 0; +} + +void +CPerlHost::Clearenv(void) +{ + char ch; + LPSTR lpPtr, lpStr, lpEnvPtr; + if(m_lppEnvList != NULL) { + /* set every entry to an empty string */ + for(DWORD index = 0; index < m_dwEnvCount; ++index) { + char* ptr = strchr(m_lppEnvList[index], '='); + if(ptr) { + *++ptr = 0; + } + } + } + + /* get the process environment strings */ + lpStr = lpEnvPtr = (LPSTR)GetEnvironmentStrings(); + + /* step over current directory stuff */ + while(*lpStr == '=') + lpStr += strlen(lpStr) + 1; + + while(*lpStr) { + lpPtr = strchr(lpStr, '='); + if(lpPtr) { + ch = *++lpPtr; + *lpPtr = 0; + Add(lpStr); + *lpPtr = ch; + } + lpStr += strlen(lpStr) + 1; + } + + FreeEnvironmentStrings(lpEnvPtr); +} + + +char* +CPerlHost::Getenv(const char *varname) +{ + char* pEnv = Find(varname); + if(pEnv == NULL) { + pEnv = win32_getenv(varname); + } + else { + if(!*pEnv) + pEnv = 0; + } + + return pEnv; +} + +int +CPerlHost::Putenv(const char *envstring) +{ + Add(envstring); + return 0; +} + +int +CPerlHost::Chdir(const char *dirname) +{ + dTHXo; + int ret; + if (USING_WIDE()) { + WCHAR wBuffer[MAX_PATH]; + A2WHELPER(dirname, wBuffer, sizeof(wBuffer)); + ret = m_pvDir->SetCurrentDirectoryW(wBuffer); + } + else + ret = m_pvDir->SetCurrentDirectoryA((char*)dirname); + if(ret < 0) { + errno = ENOENT; + } + return ret; +} + +#endif /* ___PerlHost_H___ */ diff --git a/win32/perllib.c b/win32/perllib.c index 10b252a..9ccf5a0 100644 --- a/win32/perllib.c +++ b/win32/perllib.c @@ -12,1473 +12,286 @@ #include "XSUB.h" -#ifdef PERL_OBJECT -#include "win32iop.h" -#include -#endif - - -/* Register any extra external extensions */ -char *staticlinkmodules[] = { - "DynaLoader", - NULL, -}; - -EXTERN_C void boot_DynaLoader (pTHXo_ CV* cv); - -static void -xs_init(pTHXo) -{ - char *file = __FILE__; - dXSUB_SYS; - newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file); -} - -#ifdef PERL_OBJECT -// IPerlMem -void* -PerlMemMalloc(struct IPerlMem*, size_t size) -{ - return win32_malloc(size); -} -void* -PerlMemRealloc(struct IPerlMem*, void* ptr, size_t size) -{ - return win32_realloc(ptr, size); -} -void -PerlMemFree(struct IPerlMem*, void* ptr) -{ - win32_free(ptr); -} - -struct IPerlMem perlMem = -{ - PerlMemMalloc, - PerlMemRealloc, - PerlMemFree, -}; - - -// IPerlEnv -extern char * g_win32_get_privlib(char *pl); -extern char * g_win32_get_sitelib(char *pl); - - -char* -PerlEnvGetenv(struct IPerlEnv*, const char *varname) -{ - return win32_getenv(varname); -}; -int -PerlEnvPutenv(struct IPerlEnv*, const char *envstring) -{ - return win32_putenv(envstring); -}; - -char* -PerlEnvGetenv_len(struct IPerlEnv*, const char* varname, unsigned long* len) -{ - char *e = win32_getenv(varname); - if (e) - *len = strlen(e); - return e; -} - -int -PerlEnvUname(struct IPerlEnv*, struct utsname *name) -{ - return win32_uname(name); -} - -void -PerlEnvClearenv(struct IPerlEnv*) -{ - dTHXo; - char *envv = GetEnvironmentStrings(); - char *cur = envv; - STRLEN len; - while (*cur) { - char *end = strchr(cur,'='); - if (end && end != cur) { - *end = '\0'; - my_setenv(cur,Nullch); - *end = '='; - cur = end + strlen(end+1)+2; - } - else if ((len = strlen(cur))) - cur += len+1; - } - FreeEnvironmentStrings(envv); -} - -void* -PerlEnvGetChildEnv(struct IPerlEnv*) -{ - return NULL; -} - -void -PerlEnvFreeChildEnv(struct IPerlEnv*, void* env) -{ -} - -char* -PerlEnvGetChildDir(struct IPerlEnv*) -{ - return NULL; -} - -void -PerlEnvFreeChildDir(struct IPerlEnv*, char* dir) -{ -} - -unsigned long -PerlEnvOsId(struct IPerlEnv*) -{ - return win32_os_id(); -} - -char* -PerlEnvLibPath(struct IPerlEnv*, char *pl) -{ - return g_win32_get_privlib(pl); -} - -char* -PerlEnvSiteLibPath(struct IPerlEnv*, char *pl) -{ - return g_win32_get_sitelib(pl); -} - -struct IPerlEnv perlEnv = -{ - PerlEnvGetenv, - PerlEnvPutenv, - PerlEnvGetenv_len, - PerlEnvUname, - PerlEnvClearenv, - PerlEnvGetChildEnv, - PerlEnvFreeChildEnv, - PerlEnvGetChildDir, - PerlEnvFreeChildDir, - PerlEnvOsId, - PerlEnvLibPath, - PerlEnvSiteLibPath, -}; - - -// PerlStdIO -PerlIO* -PerlStdIOStdin(struct IPerlStdIO*) -{ - return (PerlIO*)win32_stdin(); -} - -PerlIO* -PerlStdIOStdout(struct IPerlStdIO*) -{ - return (PerlIO*)win32_stdout(); -} - -PerlIO* -PerlStdIOStderr(struct IPerlStdIO*) -{ - return (PerlIO*)win32_stderr(); -} - -PerlIO* -PerlStdIOOpen(struct IPerlStdIO*, const char *path, const char *mode) -{ - return (PerlIO*)win32_fopen(path, mode); -} - -int -PerlStdIOClose(struct IPerlStdIO*, PerlIO* pf) -{ - return win32_fclose(((FILE*)pf)); -} - -int -PerlStdIOEof(struct IPerlStdIO*, PerlIO* pf) -{ - return win32_feof((FILE*)pf); -} - -int -PerlStdIOError(struct IPerlStdIO*, PerlIO* pf) -{ - return win32_ferror((FILE*)pf); -} - -void -PerlStdIOClearerr(struct IPerlStdIO*, PerlIO* pf) -{ - win32_clearerr((FILE*)pf); -} - -int -PerlStdIOGetc(struct IPerlStdIO*, PerlIO* pf) -{ - return win32_getc((FILE*)pf); -} - -char* -PerlStdIOGetBase(struct IPerlStdIO*, PerlIO* pf) -{ -#ifdef FILE_base - FILE *f = (FILE*)pf; - return FILE_base(f); -#else - return Nullch; -#endif -} - -int -PerlStdIOGetBufsiz(struct IPerlStdIO*, PerlIO* pf) -{ -#ifdef FILE_bufsiz - FILE *f = (FILE*)pf; - return FILE_bufsiz(f); -#else - return (-1); -#endif -} - -int -PerlStdIOGetCnt(struct IPerlStdIO*, PerlIO* pf) -{ -#ifdef USE_STDIO_PTR - FILE *f = (FILE*)pf; - return FILE_cnt(f); -#else - return (-1); -#endif -} - -char* -PerlStdIOGetPtr(struct IPerlStdIO*, PerlIO* pf) -{ -#ifdef USE_STDIO_PTR - FILE *f = (FILE*)pf; - return FILE_ptr(f); -#else - return Nullch; -#endif -} - -char* -PerlStdIOGets(struct IPerlStdIO*, PerlIO* pf, char* s, int n) -{ - return win32_fgets(s, n, (FILE*)pf); -} - -int -PerlStdIOPutc(struct IPerlStdIO*, PerlIO* pf, int c) -{ - return win32_fputc(c, (FILE*)pf); -} - -int -PerlStdIOPuts(struct IPerlStdIO*, PerlIO* pf, const char *s) -{ - return win32_fputs(s, (FILE*)pf); -} - -int -PerlStdIOFlush(struct IPerlStdIO*, PerlIO* pf) -{ - return win32_fflush((FILE*)pf); -} - -int -PerlStdIOUngetc(struct IPerlStdIO*, PerlIO* pf,int c) -{ - return win32_ungetc(c, (FILE*)pf); -} - -int -PerlStdIOFileno(struct IPerlStdIO*, PerlIO* pf) -{ - return win32_fileno((FILE*)pf); -} - -PerlIO* -PerlStdIOFdopen(struct IPerlStdIO*, int fd, const char *mode) -{ - return (PerlIO*)win32_fdopen(fd, mode); -} - -PerlIO* -PerlStdIOReopen(struct IPerlStdIO*, const char*path, const char*mode, PerlIO* pf) -{ - return (PerlIO*)win32_freopen(path, mode, (FILE*)pf); -} - -SSize_t -PerlStdIORead(struct IPerlStdIO*, PerlIO* pf, void *buffer, Size_t size) -{ - return win32_fread(buffer, 1, size, (FILE*)pf); -} - -SSize_t -PerlStdIOWrite(struct IPerlStdIO*, PerlIO* pf, const void *buffer, Size_t size) -{ - return win32_fwrite(buffer, 1, size, (FILE*)pf); -} - -void -PerlStdIOSetBuf(struct IPerlStdIO*, PerlIO* pf, char* buffer) -{ - win32_setbuf((FILE*)pf, buffer); -} - -int -PerlStdIOSetVBuf(struct IPerlStdIO*, PerlIO* pf, char* buffer, int type, Size_t size) -{ - return win32_setvbuf((FILE*)pf, buffer, type, size); -} - -void -PerlStdIOSetCnt(struct IPerlStdIO*, PerlIO* pf, int n) -{ -#ifdef STDIO_CNT_LVALUE - FILE *f = (FILE*)pf; - FILE_cnt(f) = n; -#endif -} - -void -PerlStdIOSetPtrCnt(struct IPerlStdIO*, PerlIO* pf, char * ptr, int n) -{ -#ifdef STDIO_PTR_LVALUE - FILE *f = (FILE*)pf; - FILE_ptr(f) = ptr; - FILE_cnt(f) = n; -#endif -} - -void -PerlStdIOSetlinebuf(struct IPerlStdIO*, PerlIO* pf) -{ - win32_setvbuf((FILE*)pf, NULL, _IOLBF, 0); -} - -int -PerlStdIOPrintf(struct IPerlStdIO*, PerlIO* pf, const char *format,...) -{ - va_list(arglist); - va_start(arglist, format); - return win32_vfprintf((FILE*)pf, format, arglist); -} - -int -PerlStdIOVprintf(struct IPerlStdIO*, PerlIO* pf, const char *format, va_list arglist) -{ - return win32_vfprintf((FILE*)pf, format, arglist); -} - -long -PerlStdIOTell(struct IPerlStdIO*, PerlIO* pf) -{ - return win32_ftell((FILE*)pf); -} - -int -PerlStdIOSeek(struct IPerlStdIO*, PerlIO* pf, off_t offset, int origin) -{ - return win32_fseek((FILE*)pf, offset, origin); -} - -void -PerlStdIORewind(struct IPerlStdIO*, PerlIO* pf) -{ - win32_rewind((FILE*)pf); -} - -PerlIO* -PerlStdIOTmpfile(struct IPerlStdIO*) -{ - return (PerlIO*)win32_tmpfile(); -} - -int -PerlStdIOGetpos(struct IPerlStdIO*, PerlIO* pf, Fpos_t *p) -{ - return win32_fgetpos((FILE*)pf, p); -} - -int -PerlStdIOSetpos(struct IPerlStdIO*, PerlIO* pf, const Fpos_t *p) -{ - return win32_fsetpos((FILE*)pf, p); -} -void -PerlStdIOInit(struct IPerlStdIO*) -{ -} - -void -PerlStdIOInitOSExtras(struct IPerlStdIO*) -{ - dTHXo; - xs_init(pPerl); - Perl_init_os_extras(); -} - -int -PerlStdIOOpenOSfhandle(struct IPerlStdIO*, long osfhandle, int flags) -{ - return win32_open_osfhandle(osfhandle, flags); -} - -int -PerlStdIOGetOSfhandle(struct IPerlStdIO*, int filenum) -{ - return win32_get_osfhandle(filenum); -} - - -struct IPerlStdIO perlStdIO = -{ - PerlStdIOStdin, - PerlStdIOStdout, - PerlStdIOStderr, - PerlStdIOOpen, - PerlStdIOClose, - PerlStdIOEof, - PerlStdIOError, - PerlStdIOClearerr, - PerlStdIOGetc, - PerlStdIOGetBase, - PerlStdIOGetBufsiz, - PerlStdIOGetCnt, - PerlStdIOGetPtr, - PerlStdIOGets, - PerlStdIOPutc, - PerlStdIOPuts, - PerlStdIOFlush, - PerlStdIOUngetc, - PerlStdIOFileno, - PerlStdIOFdopen, - PerlStdIOReopen, - PerlStdIORead, - PerlStdIOWrite, - PerlStdIOSetBuf, - PerlStdIOSetVBuf, - PerlStdIOSetCnt, - PerlStdIOSetPtrCnt, - PerlStdIOSetlinebuf, - PerlStdIOPrintf, - PerlStdIOVprintf, - PerlStdIOTell, - PerlStdIOSeek, - PerlStdIORewind, - PerlStdIOTmpfile, - PerlStdIOGetpos, - PerlStdIOSetpos, - PerlStdIOInit, - PerlStdIOInitOSExtras, -}; - - -// IPerlLIO -int -PerlLIOAccess(struct IPerlLIO*, const char *path, int mode) -{ - return access(path, mode); -} - -int -PerlLIOChmod(struct IPerlLIO*, const char *filename, int pmode) -{ - return chmod(filename, pmode); -} - -int -PerlLIOChown(struct IPerlLIO*, const char *filename, uid_t owner, gid_t group) -{ - return chown(filename, owner, group); -} - -int -PerlLIOChsize(struct IPerlLIO*, int handle, long size) -{ - return chsize(handle, size); -} - -int -PerlLIOClose(struct IPerlLIO*, int handle) -{ - return win32_close(handle); -} - -int -PerlLIODup(struct IPerlLIO*, int handle) -{ - return win32_dup(handle); -} - -int -PerlLIODup2(struct IPerlLIO*, int handle1, int handle2) -{ - return win32_dup2(handle1, handle2); -} - -int -PerlLIOFlock(struct IPerlLIO*, int fd, int oper) -{ - return win32_flock(fd, oper); -} - -int -PerlLIOFileStat(struct IPerlLIO*, int handle, struct stat *buffer) -{ - return fstat(handle, buffer); -} - -int -PerlLIOIOCtl(struct IPerlLIO*, int i, unsigned int u, char *data) -{ - return win32_ioctlsocket((SOCKET)i, (long)u, (u_long*)data); -} - -int -PerlLIOIsatty(struct IPerlLIO*, int fd) -{ - return isatty(fd); -} - -long -PerlLIOLseek(struct IPerlLIO*, int handle, long offset, int origin) -{ - return win32_lseek(handle, offset, origin); -} - -int -PerlLIOLstat(struct IPerlLIO* p, const char *path, struct stat *buffer) -{ - return win32_stat(path, buffer); -} - -char* -PerlLIOMktemp(struct IPerlLIO*, char *Template) -{ - return mktemp(Template); -} - -int -PerlLIOOpen(struct IPerlLIO*, const char *filename, int oflag) -{ - return win32_open(filename, oflag); -} - -int -PerlLIOOpen3(struct IPerlLIO*, const char *filename, int oflag, int pmode) -{ - int ret; - if(stricmp(filename, "/dev/null") == 0) - ret = open("NUL", oflag, pmode); - else - ret = open(filename, oflag, pmode); - - return ret; -} - -int -PerlLIORead(struct IPerlLIO*, int handle, void *buffer, unsigned int count) -{ - return win32_read(handle, buffer, count); -} - -int -PerlLIORename(struct IPerlLIO*, const char *OldFileName, const char *newname) -{ - return win32_rename(OldFileName, newname); -} - -int -PerlLIOSetmode(struct IPerlLIO*, int handle, int mode) -{ - return win32_setmode(handle, mode); -} - -int -PerlLIONameStat(struct IPerlLIO*, const char *path, struct stat *buffer) -{ - return win32_stat(path, buffer); -} - -char* -PerlLIOTmpnam(struct IPerlLIO*, char *string) -{ - return tmpnam(string); -} - -int -PerlLIOUmask(struct IPerlLIO*, int pmode) -{ - return umask(pmode); -} - -int -PerlLIOUnlink(struct IPerlLIO*, const char *filename) -{ - chmod(filename, S_IREAD | S_IWRITE); - return unlink(filename); -} - -int -PerlLIOUtime(struct IPerlLIO*, char *filename, struct utimbuf *times) -{ - return win32_utime(filename, times); -} - -int -PerlLIOWrite(struct IPerlLIO*, int handle, const void *buffer, unsigned int count) -{ - return win32_write(handle, buffer, count); -} - -struct IPerlLIO perlLIO = -{ - PerlLIOAccess, - PerlLIOChmod, - PerlLIOChown, - PerlLIOChsize, - PerlLIOClose, - PerlLIODup, - PerlLIODup2, - PerlLIOFlock, - PerlLIOFileStat, - PerlLIOIOCtl, - PerlLIOIsatty, - PerlLIOLseek, - PerlLIOLstat, - PerlLIOMktemp, - PerlLIOOpen, - PerlLIOOpen3, - PerlLIORead, - PerlLIORename, - PerlLIOSetmode, - PerlLIONameStat, - PerlLIOTmpnam, - PerlLIOUmask, - PerlLIOUnlink, - PerlLIOUtime, - PerlLIOWrite, -}; - -// IPerlDIR -int -PerlDirMakedir(struct IPerlDir*, const char *dirname, int mode) -{ - return win32_mkdir(dirname, mode); -} - -int -PerlDirChdir(struct IPerlDir*, const char *dirname) -{ - return win32_chdir(dirname); -} - -int -PerlDirRmdir(struct IPerlDir*, const char *dirname) -{ - return win32_rmdir(dirname); -} - -int -PerlDirClose(struct IPerlDir*, DIR *dirp) -{ - return win32_closedir(dirp); -} - -DIR* -PerlDirOpen(struct IPerlDir*, char *filename) -{ - return win32_opendir(filename); -} - -struct direct * -PerlDirRead(struct IPerlDir*, DIR *dirp) -{ - return win32_readdir(dirp); -} - -void -PerlDirRewind(struct IPerlDir*, DIR *dirp) -{ - win32_rewinddir(dirp); -} - -void -PerlDirSeek(struct IPerlDir*, DIR *dirp, long loc) -{ - win32_seekdir(dirp, loc); -} - -long -PerlDirTell(struct IPerlDir*, DIR *dirp) -{ - return win32_telldir(dirp); -} - -struct IPerlDir perlDir = -{ - PerlDirMakedir, - PerlDirChdir, - PerlDirRmdir, - PerlDirClose, - PerlDirOpen, - PerlDirRead, - PerlDirRewind, - PerlDirSeek, - PerlDirTell, -}; - - -// IPerlSock -u_long -PerlSockHtonl(struct IPerlSock*, u_long hostlong) -{ - return win32_htonl(hostlong); -} - -u_short -PerlSockHtons(struct IPerlSock*, u_short hostshort) -{ - return win32_htons(hostshort); -} - -u_long -PerlSockNtohl(struct IPerlSock*, u_long netlong) -{ - return win32_ntohl(netlong); -} - -u_short -PerlSockNtohs(struct IPerlSock*, u_short netshort) -{ - return win32_ntohs(netshort); -} - -SOCKET PerlSockAccept(struct IPerlSock*, SOCKET s, struct sockaddr* addr, int* addrlen) -{ - return win32_accept(s, addr, addrlen); -} - -int -PerlSockBind(struct IPerlSock*, SOCKET s, const struct sockaddr* name, int namelen) -{ - return win32_bind(s, name, namelen); -} - -int -PerlSockConnect(struct IPerlSock*, SOCKET s, const struct sockaddr* name, int namelen) -{ - return win32_connect(s, name, namelen); -} - -void -PerlSockEndhostent(struct IPerlSock*) -{ - win32_endhostent(); -} - -void -PerlSockEndnetent(struct IPerlSock*) -{ - win32_endnetent(); -} - -void -PerlSockEndprotoent(struct IPerlSock*) -{ - win32_endprotoent(); -} - -void -PerlSockEndservent(struct IPerlSock*) -{ - win32_endservent(); -} - -struct hostent* -PerlSockGethostbyaddr(struct IPerlSock*, const char* addr, int len, int type) -{ - return win32_gethostbyaddr(addr, len, type); -} - -struct hostent* -PerlSockGethostbyname(struct IPerlSock*, const char* name) -{ - return win32_gethostbyname(name); -} - -struct hostent* -PerlSockGethostent(struct IPerlSock*) -{ - dTHXo; - croak("gethostent not implemented!\n"); - return NULL; -} - -int -PerlSockGethostname(struct IPerlSock*, char* name, int namelen) -{ - return win32_gethostname(name, namelen); -} - -struct netent * -PerlSockGetnetbyaddr(struct IPerlSock*, long net, int type) -{ - return win32_getnetbyaddr(net, type); -} - -struct netent * -PerlSockGetnetbyname(struct IPerlSock*, const char *name) -{ - return win32_getnetbyname((char*)name); -} - -struct netent * -PerlSockGetnetent(struct IPerlSock*) -{ - return win32_getnetent(); -} - -int PerlSockGetpeername(struct IPerlSock*, SOCKET s, struct sockaddr* name, int* namelen) -{ - return win32_getpeername(s, name, namelen); -} - -struct protoent* -PerlSockGetprotobyname(struct IPerlSock*, const char* name) -{ - return win32_getprotobyname(name); -} - -struct protoent* -PerlSockGetprotobynumber(struct IPerlSock*, int number) -{ - return win32_getprotobynumber(number); -} - -struct protoent* -PerlSockGetprotoent(struct IPerlSock*) -{ - return win32_getprotoent(); -} - -struct servent* -PerlSockGetservbyname(struct IPerlSock*, const char* name, const char* proto) -{ - return win32_getservbyname(name, proto); -} - -struct servent* -PerlSockGetservbyport(struct IPerlSock*, int port, const char* proto) -{ - return win32_getservbyport(port, proto); -} - -struct servent* -PerlSockGetservent(struct IPerlSock*) -{ - return win32_getservent(); -} - -int -PerlSockGetsockname(struct IPerlSock*, SOCKET s, struct sockaddr* name, int* namelen) -{ - return win32_getsockname(s, name, namelen); -} - -int -PerlSockGetsockopt(struct IPerlSock*, SOCKET s, int level, int optname, char* optval, int* optlen) -{ - return win32_getsockopt(s, level, optname, optval, optlen); -} - -unsigned long -PerlSockInetAddr(struct IPerlSock*, const char* cp) -{ - return win32_inet_addr(cp); -} - -char* -PerlSockInetNtoa(struct IPerlSock*, struct in_addr in) -{ - return win32_inet_ntoa(in); -} - -int -PerlSockListen(struct IPerlSock*, SOCKET s, int backlog) -{ - return win32_listen(s, backlog); -} - -int -PerlSockRecv(struct IPerlSock*, SOCKET s, char* buffer, int len, int flags) -{ - return win32_recv(s, buffer, len, flags); -} - -int -PerlSockRecvfrom(struct IPerlSock*, SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen) -{ - return win32_recvfrom(s, buffer, len, flags, from, fromlen); -} - -int -PerlSockSelect(struct IPerlSock*, int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout) -{ - return win32_select(nfds, (Perl_fd_set*)readfds, (Perl_fd_set*)writefds, (Perl_fd_set*)exceptfds, timeout); -} - -int -PerlSockSend(struct IPerlSock*, SOCKET s, const char* buffer, int len, int flags) -{ - return win32_send(s, buffer, len, flags); -} - -int -PerlSockSendto(struct IPerlSock*, SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen) -{ - return win32_sendto(s, buffer, len, flags, to, tolen); -} - -void -PerlSockSethostent(struct IPerlSock*, int stayopen) -{ - win32_sethostent(stayopen); -} - -void -PerlSockSetnetent(struct IPerlSock*, int stayopen) -{ - win32_setnetent(stayopen); -} - -void -PerlSockSetprotoent(struct IPerlSock*, int stayopen) -{ - win32_setprotoent(stayopen); -} - -void -PerlSockSetservent(struct IPerlSock*, int stayopen) -{ - win32_setservent(stayopen); -} - -int -PerlSockSetsockopt(struct IPerlSock*, SOCKET s, int level, int optname, const char* optval, int optlen) -{ - return win32_setsockopt(s, level, optname, optval, optlen); -} - -int -PerlSockShutdown(struct IPerlSock*, SOCKET s, int how) -{ - return win32_shutdown(s, how); -} - -SOCKET -PerlSockSocket(struct IPerlSock*, int af, int type, int protocol) -{ - return win32_socket(af, type, protocol); -} - -int -PerlSockSocketpair(struct IPerlSock*, int domain, int type, int protocol, int* fds) -{ - dTHXo; - croak("socketpair not implemented!\n"); - return 0; -} - -int -PerlSockClosesocket(struct IPerlSock*, SOCKET s) -{ - return win32_closesocket(s); -} +#ifdef PERL_IMPLICIT_SYS +#include "win32iop.h" +#include +#endif /* PERL_IMPLICIT_SYS */ -int -PerlSockIoctlsocket(struct IPerlSock*, SOCKET s, long cmd, u_long *argp) -{ - return win32_ioctlsocket(s, cmd, argp); -} -struct IPerlSock perlSock = -{ - PerlSockHtonl, - PerlSockHtons, - PerlSockNtohl, - PerlSockNtohs, - PerlSockAccept, - PerlSockBind, - PerlSockConnect, - PerlSockEndhostent, - PerlSockEndnetent, - PerlSockEndprotoent, - PerlSockEndservent, - PerlSockGethostname, - PerlSockGetpeername, - PerlSockGethostbyaddr, - PerlSockGethostbyname, - PerlSockGethostent, - PerlSockGetnetbyaddr, - PerlSockGetnetbyname, - PerlSockGetnetent, - PerlSockGetprotobyname, - PerlSockGetprotobynumber, - PerlSockGetprotoent, - PerlSockGetservbyname, - PerlSockGetservbyport, - PerlSockGetservent, - PerlSockGetsockname, - PerlSockGetsockopt, - PerlSockInetAddr, - PerlSockInetNtoa, - PerlSockListen, - PerlSockRecv, - PerlSockRecvfrom, - PerlSockSelect, - PerlSockSend, - PerlSockSendto, - PerlSockSethostent, - PerlSockSetnetent, - PerlSockSetprotoent, - PerlSockSetservent, - PerlSockSetsockopt, - PerlSockShutdown, - PerlSockSocket, - PerlSockSocketpair, - PerlSockClosesocket, +/* Register any extra external extensions */ +char *staticlinkmodules[] = { + "DynaLoader", + NULL, }; +EXTERN_C void boot_DynaLoader (pTHXo_ CV* cv); -// IPerlProc - -#define EXECF_EXEC 1 -#define EXECF_SPAWN 2 - -extern char * g_getlogin(void); -extern int do_spawn2(char *cmd, int exectype); -extern int g_do_aspawn(void *vreally, void **vmark, void **vsp); - -void -PerlProcAbort(struct IPerlProc*) -{ - win32_abort(); -} - -char * -PerlProcCrypt(struct IPerlProc*, const char* clear, const char* salt) -{ - return win32_crypt(clear, salt); -} - -void -PerlProcExit(struct IPerlProc*, int status) -{ - exit(status); -} - -void -PerlProc_Exit(struct IPerlProc*, int status) -{ - _exit(status); -} - -int -PerlProcExecl(struct IPerlProc*, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3) -{ - return execl(cmdname, arg0, arg1, arg2, arg3); -} - -int -PerlProcExecv(struct IPerlProc*, const char *cmdname, const char *const *argv) -{ - return win32_execvp(cmdname, argv); -} - -int -PerlProcExecvp(struct IPerlProc*, const char *cmdname, const char *const *argv) -{ - return win32_execvp(cmdname, argv); -} - -uid_t -PerlProcGetuid(struct IPerlProc*) -{ - return getuid(); -} - -uid_t -PerlProcGeteuid(struct IPerlProc*) -{ - return geteuid(); -} - -gid_t -PerlProcGetgid(struct IPerlProc*) -{ - return getgid(); -} - -gid_t -PerlProcGetegid(struct IPerlProc*) -{ - return getegid(); -} - -char * -PerlProcGetlogin(struct IPerlProc*) -{ - return g_getlogin(); -} - -int -PerlProcKill(struct IPerlProc*, int pid, int sig) -{ - return win32_kill(pid, sig); -} - -int -PerlProcKillpg(struct IPerlProc*, int pid, int sig) -{ - dTHXo; - croak("killpg not implemented!\n"); - return 0; -} - -int -PerlProcPauseProc(struct IPerlProc*) -{ - return win32_sleep((32767L << 16) + 32767); -} - -PerlIO* -PerlProcPopen(struct IPerlProc*, const char *command, const char *mode) -{ - win32_fflush(stdout); - win32_fflush(stderr); - return (PerlIO*)win32_popen(command, mode); -} - -int -PerlProcPclose(struct IPerlProc*, PerlIO *stream) -{ - return win32_pclose((FILE*)stream); -} - -int -PerlProcPipe(struct IPerlProc*, int *phandles) -{ - return win32_pipe(phandles, 512, O_BINARY); -} - -int -PerlProcSetuid(struct IPerlProc*, uid_t u) -{ - return setuid(u); -} - -int -PerlProcSetgid(struct IPerlProc*, gid_t g) -{ - return setgid(g); -} - -int -PerlProcSleep(struct IPerlProc*, unsigned int s) -{ - return win32_sleep(s); -} - -int -PerlProcTimes(struct IPerlProc*, struct tms *timebuf) -{ - return win32_times(timebuf); -} - -int -PerlProcWait(struct IPerlProc*, int *status) -{ - return win32_wait(status); -} - -int -PerlProcWaitpid(struct IPerlProc*, int pid, int *status, int flags) -{ - return win32_waitpid(pid, status, flags); -} - -Sighandler_t -PerlProcSignal(struct IPerlProc*, int sig, Sighandler_t subcode) -{ - return 0; -} - -void* -PerlProcDynaLoader(struct IPerlProc*, const char* filename) -{ - return win32_dynaload(filename); -} - -void -PerlProcGetOSError(struct IPerlProc*, SV* sv, DWORD dwErr) -{ - win32_str_os_error(aTHX_ sv, dwErr); -} - -BOOL -PerlProcDoCmd(struct IPerlProc*, char *cmd) -{ - do_spawn2(cmd, EXECF_EXEC); - return FALSE; -} - -int -PerlProcSpawn(struct IPerlProc*, char* cmds) -{ - return do_spawn2(cmds, EXECF_SPAWN); -} - -int -PerlProcSpawnvp(struct IPerlProc*, int mode, const char *cmdname, const char *const *argv) -{ - return win32_spawnvp(mode, cmdname, argv); -} - -int -PerlProcASpawn(struct IPerlProc*, void *vreally, void **vmark, void **vsp) +static void +xs_init(pTHXo) { - return g_do_aspawn(vreally, vmark, vsp); + char *file = __FILE__; + dXSUB_SYS; + newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file); } -struct IPerlProc perlProc = -{ - PerlProcAbort, - PerlProcCrypt, - PerlProcExit, - PerlProc_Exit, - PerlProcExecl, - PerlProcExecv, - PerlProcExecvp, - PerlProcGetuid, - PerlProcGeteuid, - PerlProcGetgid, - PerlProcGetegid, - PerlProcGetlogin, - PerlProcKill, - PerlProcKillpg, - PerlProcPauseProc, - PerlProcPopen, - PerlProcPclose, - PerlProcPipe, - PerlProcSetuid, - PerlProcSetgid, - PerlProcSleep, - PerlProcTimes, - PerlProcWait, - PerlProcWaitpid, - PerlProcSignal, - PerlProcDynaLoader, - PerlProcGetOSError, - PerlProcDoCmd, - PerlProcSpawn, - PerlProcSpawnvp, - PerlProcASpawn, -}; - -//#include "perlhost.h" +#ifdef PERL_IMPLICIT_SYS +#include "perlhost.h" -EXTERN_C void perl_get_host_info(IPerlMemInfo* perlMemInfo, - IPerlEnvInfo* perlEnvInfo, IPerlStdIOInfo* perlStdIOInfo, - IPerlLIOInfo* perlLIOInfo, IPerlDirInfo* perlDirInfo, - IPerlSockInfo* perlSockInfo, IPerlProcInfo* perlProcInfo) +EXTERN_C void +perl_get_host_info(struct IPerlMemInfo* perlMemInfo, + struct IPerlMemInfo* perlMemSharedInfo, + struct IPerlMemInfo* perlMemParseInfo, + struct IPerlEnvInfo* perlEnvInfo, + struct IPerlStdIOInfo* perlStdIOInfo, + struct IPerlLIOInfo* perlLIOInfo, + struct IPerlDirInfo* perlDirInfo, + struct IPerlSockInfo* perlSockInfo, + struct IPerlProcInfo* perlProcInfo) { - if(perlMemInfo) { + if (perlMemInfo) { Copy(&perlMem, &perlMemInfo->perlMemList, perlMemInfo->nCount, void*); perlMemInfo->nCount = (sizeof(struct IPerlMem)/sizeof(void*)); } - if(perlEnvInfo) { + if (perlMemSharedInfo) { + Copy(&perlMem, &perlMemSharedInfo->perlMemList, perlMemSharedInfo->nCount, void*); + perlMemSharedInfo->nCount = (sizeof(struct IPerlMem)/sizeof(void*)); + } + if (perlMemParseInfo) { + Copy(&perlMem, &perlMemParseInfo->perlMemList, perlMemParseInfo->nCount, void*); + perlMemParseInfo->nCount = (sizeof(struct IPerlMem)/sizeof(void*)); + } + if (perlEnvInfo) { Copy(&perlEnv, &perlEnvInfo->perlEnvList, perlEnvInfo->nCount, void*); perlEnvInfo->nCount = (sizeof(struct IPerlEnv)/sizeof(void*)); } - if(perlStdIOInfo) { + if (perlStdIOInfo) { Copy(&perlStdIO, &perlStdIOInfo->perlStdIOList, perlStdIOInfo->nCount, void*); perlStdIOInfo->nCount = (sizeof(struct IPerlStdIO)/sizeof(void*)); } - if(perlLIOInfo) { + if (perlLIOInfo) { Copy(&perlLIO, &perlLIOInfo->perlLIOList, perlLIOInfo->nCount, void*); perlLIOInfo->nCount = (sizeof(struct IPerlLIO)/sizeof(void*)); } - if(perlDirInfo) { + if (perlDirInfo) { Copy(&perlDir, &perlDirInfo->perlDirList, perlDirInfo->nCount, void*); perlDirInfo->nCount = (sizeof(struct IPerlDir)/sizeof(void*)); } - if(perlSockInfo) { + if (perlSockInfo) { Copy(&perlSock, &perlSockInfo->perlSockList, perlSockInfo->nCount, void*); perlSockInfo->nCount = (sizeof(struct IPerlSock)/sizeof(void*)); } - if(perlProcInfo) { + if (perlProcInfo) { Copy(&perlProc, &perlProcInfo->perlProcList, perlProcInfo->nCount, void*); perlProcInfo->nCount = (sizeof(struct IPerlProc)/sizeof(void*)); } } -EXTERN_C PerlInterpreter* perl_alloc_using(IPerlMem* pMem, - IPerlEnv* pEnv, IPerlStdIO* pStdIO, - IPerlLIO* pLIO, IPerlDir* pDir, - IPerlSock* pSock, IPerlProc* pProc) +#ifdef PERL_OBJECT + +EXTERN_C PerlInterpreter* +perl_alloc_override(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared, + struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv, + struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO, + struct IPerlDir** ppDir, struct IPerlSock** ppSock, + struct IPerlProc** ppProc) { - CPerlObj* pPerl = NULL; + PerlInterpreter *my_perl = NULL; try { - pPerl = Perl_alloc(pMem, pEnv, pStdIO, pLIO, pDir, pSock, pProc); + CPerlHost* pHost = new CPerlHost(ppMem, ppMemShared, ppMemParse, ppEnv, + ppStdIO, ppLIO, ppDir, ppSock, ppProc); + + if (pHost) { + my_perl = perl_alloc_using(pHost->m_pHostperlMem, + pHost->m_pHostperlMemShared, + pHost->m_pHostperlMemParse, + pHost->m_pHostperlEnv, + pHost->m_pHostperlStdIO, + pHost->m_pHostperlLIO, + pHost->m_pHostperlDir, + pHost->m_pHostperlSock, + pHost->m_pHostperlProc); + if (my_perl) { + CPerlObj* pPerl = (CPerlObj*)my_perl; + w32_internal_host = pHost; + } + } } catch(...) { win32_fprintf(stderr, "%s\n", "Error: Unable to allocate memory"); - pPerl = NULL; - } - if(pPerl) - { - SetPerlInterpreter(pPerl); - return (PerlInterpreter*)pPerl; + my_perl = NULL; } - SetPerlInterpreter(NULL); - return NULL; + + return my_perl; } -#undef perl_alloc -#undef perl_construct -#undef perl_destruct -#undef perl_free -#undef perl_run -#undef perl_parse -EXTERN_C PerlInterpreter* perl_alloc(void) +EXTERN_C PerlInterpreter* +perl_alloc(void) { - CPerlObj* pPerl = NULL; + PerlInterpreter* my_perl = NULL; try { - pPerl = Perl_alloc(&perlMem, &perlEnv, &perlStdIO, &perlLIO, - &perlDir, &perlSock, &perlProc); + CPerlHost* pHost = new CPerlHost(); + if (pHost) { + my_perl = perl_alloc_using(pHost->m_pHostperlMem, + pHost->m_pHostperlMemShared, + pHost->m_pHostperlMemParse, + pHost->m_pHostperlEnv, + pHost->m_pHostperlStdIO, + pHost->m_pHostperlLIO, + pHost->m_pHostperlDir, + pHost->m_pHostperlSock, + pHost->m_pHostperlProc); + if (my_perl) { + CPerlObj* pPerl = (CPerlObj*)my_perl; + w32_internal_host = pHost; + } + } } catch(...) { win32_fprintf(stderr, "%s\n", "Error: Unable to allocate memory"); - pPerl = NULL; + my_perl = NULL; } - if(pPerl) - { - SetPerlInterpreter(pPerl); - return (PerlInterpreter*)pPerl; - } - SetPerlInterpreter(NULL); - return NULL; + + return my_perl; } -EXTERN_C void perl_construct(PerlInterpreter* sv_interp) +EXTERN_C void +perl_construct(PerlInterpreter* my_perl) { - CPerlObj* pPerl = (CPerlObj*)sv_interp; + CPerlObj* pPerl = (CPerlObj*)my_perl; try { - pPerl->perl_construct(); + Perl_construct(); } catch(...) { win32_fprintf(stderr, "%s\n", "Error: Unable to construct data structures"); - pPerl->perl_free(); + CPerlHost* pHost = (CPerlHost*)w32_internal_host; + Perl_free(); + delete pHost; SetPerlInterpreter(NULL); } } -EXTERN_C void perl_destruct(PerlInterpreter* sv_interp) +EXTERN_C void +perl_destruct(PerlInterpreter* my_perl) { - CPerlObj* pPerl = (CPerlObj*)sv_interp; + CPerlObj* pPerl = (CPerlObj*)my_perl; +#ifdef DEBUGGING + Perl_destruct(); +#else try { - pPerl->perl_destruct(); + Perl_destruct(); } catch(...) { } +#endif } -EXTERN_C void perl_free(PerlInterpreter* sv_interp) +EXTERN_C void +perl_free(PerlInterpreter* my_perl) { - CPerlObj* pPerl = (CPerlObj*)sv_interp; + CPerlObj* pPerl = (CPerlObj*)my_perl; +#ifdef DEBUGGING + CPerlHost* pHost = (CPerlHost*)w32_internal_host; + Perl_free(); + delete pHost; +#else try { - pPerl->perl_free(); + CPerlHost* pHost = (CPerlHost*)w32_internal_host; + Perl_free(); + delete pHost; } catch(...) { } +#endif SetPerlInterpreter(NULL); } -EXTERN_C int perl_run(PerlInterpreter* sv_interp) +EXTERN_C int +perl_run(PerlInterpreter* my_perl) { - CPerlObj* pPerl = (CPerlObj*)sv_interp; + CPerlObj* pPerl = (CPerlObj*)my_perl; +#ifdef DEBUGGING + return Perl_run(); +#else int retVal; try { - retVal = pPerl->perl_run(); - } -/* - catch(int x) - { - // this is where exit() should arrive - retVal = x; + retVal = Perl_run(); } -*/ catch(...) { win32_fprintf(stderr, "Error: Runtime exception\n"); retVal = -1; } return retVal; +#endif } -EXTERN_C int perl_parse(PerlInterpreter* sv_interp, void (*xsinit)(CPerlObj*), int argc, char** argv, char** env) +EXTERN_C int +perl_parse(PerlInterpreter* my_perl, void (*xsinit)(CPerlObj*), int argc, char** argv, char** env) { int retVal; - CPerlObj* pPerl = (CPerlObj*)sv_interp; + CPerlObj* pPerl = (CPerlObj*)my_perl; +#ifdef DEBUGGING + retVal = Perl_parse(xsinit, argc, argv, env); +#else try { - retVal = pPerl->perl_parse(xsinit, argc, argv, env); - } -/* - catch(int x) - { - // this is where exit() should arrive - retVal = x; + retVal = Perl_parse(xsinit, argc, argv, env); } -*/ catch(...) { win32_fprintf(stderr, "Error: Parse exception\n"); retVal = -1; } +#endif *win32_errno() = 0; return retVal; } #undef PL_perl_destruct_level #define PL_perl_destruct_level int dummy + +#else /* !PERL_OBJECT */ + +EXTERN_C PerlInterpreter* +perl_alloc(void) +{ + PerlInterpreter *my_perl = NULL; + CPerlHost* pHost = new CPerlHost(); + if (pHost) { + my_perl = perl_alloc_using(pHost->m_pHostperlMem, + pHost->m_pHostperlMemShared, + pHost->m_pHostperlMemParse, + pHost->m_pHostperlEnv, + pHost->m_pHostperlStdIO, + pHost->m_pHostperlLIO, + pHost->m_pHostperlDir, + pHost->m_pHostperlSock, + pHost->m_pHostperlProc); + if (my_perl) { + w32_internal_host = pHost; + } + } + return my_perl; +} + #endif /* PERL_OBJECT */ +#endif /* PERL_IMPLICIT_SYS */ + +EXTERN_C HANDLE w32_perldll_handle; -extern HANDLE w32_perldll_handle; static DWORD g_TlsAllocIndex; EXTERN_C DllExport bool @@ -1497,7 +310,7 @@ EXTERN_C DllExport int RunPerl(int argc, char **argv, char **env) { int exitstatus; - PerlInterpreter *my_perl; + PerlInterpreter *my_perl, *new_perl = NULL; struct perl_thread *thr; #ifndef __BORLANDC__ @@ -1531,18 +344,42 @@ RunPerl(int argc, char **argv, char **env) perl_construct( my_perl ); PL_perl_destruct_level = 0; -#ifdef PERL_OBJECT - /* PERL_OBJECT build sets Dynaloader in PerlStdIOInitOSExtras */ - exitstatus = perl_parse(my_perl, NULL, argc, argv, env); -#else exitstatus = perl_parse(my_perl, xs_init, argc, argv, env); -#endif if (!exitstatus) { +#if defined(TOP_CLONE) && defined(USE_ITHREADS) /* XXXXXX testing */ +# ifdef PERL_OBJECT + CPerlHost *h = new CPerlHost(); + new_perl = perl_clone_using(my_perl, 1, + h->m_pHostperlMem, + h->m_pHostperlMemShared, + h->m_pHostperlMemParse, + h->m_pHostperlEnv, + h->m_pHostperlStdIO, + h->m_pHostperlLIO, + h->m_pHostperlDir, + h->m_pHostperlSock, + h->m_pHostperlProc + ); + CPerlObj *pPerl = (CPerlObj*)new_perl; +# else + new_perl = perl_clone(my_perl, 1); +# endif + exitstatus = perl_run( new_perl ); + SetPerlInterpreter(my_perl); +#else exitstatus = perl_run( my_perl ); +#endif } perl_destruct( my_perl ); perl_free( my_perl ); +#ifdef USE_ITHREADS + if (new_perl) { + SetPerlInterpreter(new_perl); + perl_destruct(new_perl); + perl_free(new_perl); + } +#endif PERL_SYS_TERM(); @@ -1567,7 +404,7 @@ DllMain(HANDLE hModule, /* DLL module handle */ _fmode = O_BINARY; #endif g_TlsAllocIndex = TlsAlloc(); - DisableThreadLibraryCalls(hModule); + DisableThreadLibraryCalls((HMODULE)hModule); w32_perldll_handle = hModule; break; @@ -1591,4 +428,3 @@ DllMain(HANDLE hModule, /* DLL module handle */ } return TRUE; } - diff --git a/win32/runperl.c b/win32/runperl.c index 8e6b249..85fd831 100644 --- a/win32/runperl.c +++ b/win32/runperl.c @@ -2,10 +2,6 @@ #include "perl.h" #ifdef __GNUC__ -/* - * GNU C does not do __declspec() - */ -#define __declspec(foo) /* Mingw32 defaults to globing command line * This is inconsistent with other Win32 ports and diff --git a/win32/vdir.h b/win32/vdir.h new file mode 100644 index 0000000..50822a7 --- /dev/null +++ b/win32/vdir.h @@ -0,0 +1,505 @@ +/* vdir.h + * + * (c) 1999 Microsoft Corporation. All rights reserved. + * Portions (c) 1999 ActiveState Tool Corp, http://www.ActiveState.com/ + * + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. + */ + +#ifndef ___VDir_H___ +#define ___VDir_H___ + +const int driveCount = 30; + +class VDir +{ +public: + VDir(int bManageDir = 1); + ~VDir() {}; + + void Init(VDir* pDir, VMem *pMem); + void SetDefaultA(char const *pDefault); + void SetDefaultW(WCHAR const *pDefault); + char* MapPathA(const char *pInName); + WCHAR* MapPathW(const WCHAR *pInName); + int SetCurrentDirectoryA(char *lpBuffer); + int SetCurrentDirectoryW(WCHAR *lpBuffer); + inline const char *GetDirA(int index) + { + return dirTableA[index]; + }; + inline const WCHAR *GetDirW(int index) + { + return dirTableW[index]; + }; + inline int GetDefault(void) { return nDefault; }; + + inline char* GetCurrentDirectoryA(int dwBufSize, char *lpBuffer) + { + char* ptr = dirTableA[nDefault]; + while (dwBufSize--) + { + if ((*lpBuffer++ = *ptr++) == '\0') + break; + } + return lpBuffer; + }; + inline WCHAR* GetCurrentDirectoryW(int dwBufSize, WCHAR *lpBuffer) + { + WCHAR* ptr = dirTableW[nDefault]; + while (dwBufSize--) + { + if ((*lpBuffer++ = *ptr++) == '\0') + break; + } + return lpBuffer; + }; + + + DWORD CalculateEnvironmentSpace(void); + LPSTR BuildEnvironmentSpace(LPSTR lpStr); + +protected: + int SetDirA(char const *pPath, int index); + void FromEnvA(char *pEnv, int index); + inline const char *GetDefaultDirA(void) + { + return dirTableA[nDefault]; + }; + + inline void SetDefaultDirA(char const *pPath, int index) + { + SetDirA(pPath, index); + nDefault = index; + }; + int SetDirW(WCHAR const *pPath, int index); + inline const WCHAR *GetDefaultDirW(void) + { + return dirTableW[nDefault]; + }; + + inline void SetDefaultDirW(WCHAR const *pPath, int index) + { + SetDirW(pPath, index); + nDefault = index; + }; + + inline int DriveIndex(char chr) + { + return (chr | 0x20)-'a'; + }; + + VMem *pMem; + int nDefault, bManageDirectory; + char *dirTableA[driveCount]; + char szLocalBufferA[MAX_PATH+1]; + WCHAR *dirTableW[driveCount]; + WCHAR szLocalBufferW[MAX_PATH+1]; +}; + + +VDir::VDir(int bManageDir /* = 1 */) +{ + nDefault = 0; + bManageDirectory = bManageDir; + memset(dirTableA, 0, sizeof(dirTableA)); + memset(dirTableW, 0, sizeof(dirTableW)); +} + +void VDir::Init(VDir* pDir, VMem *p) +{ + int index; + DWORD driveBits; + int nSave; + char szBuffer[MAX_PATH*driveCount]; + + pMem = p; + if (pDir) { + for (index = 0; index < driveCount; ++index) { + SetDirW(pDir->GetDirW(index), index); + } + nDefault = pDir->GetDefault(); + } + else { + nSave = bManageDirectory; + bManageDirectory = 0; + driveBits = GetLogicalDrives(); + if (GetLogicalDriveStrings(sizeof(szBuffer), szBuffer)) { + char* pEnv = GetEnvironmentStrings(); + char* ptr = szBuffer; + for (index = 0; index < driveCount; ++index) { + if (driveBits & (1<Free(dirTableA[index]); + ptr = dirTableA[index] = (char*)pMem->Malloc(length+2); + if (ptr != NULL) { + strcpy(ptr, pPath); + ptr += length-1; + chr = *ptr++; + if (chr != '\\' && chr != '/') { + *ptr++ = '\\'; + *ptr = '\0'; + } + MultiByteToWideChar(CP_ACP, 0, dirTableA[index], -1, + wBuffer, (sizeof(wBuffer)/sizeof(WCHAR))); + length = wcslen(wBuffer); + pMem->Free(dirTableW[index]); + dirTableW[index] = (WCHAR*)pMem->Malloc((length+1)*2); + if (dirTableW[index] != NULL) { + wcscpy(dirTableW[index], wBuffer); + } + } + } + + if(bManageDirectory) + ::SetCurrentDirectoryA(pPath); + + return length; +} + +void VDir::FromEnvA(char *pEnv, int index) +{ /* gets the directory for index from the environment variable. */ + while (*pEnv != '\0') { + if ((pEnv[0] == '=') && (DriveIndex(pEnv[1]) == index)) { + SetDirA(&pEnv[4], index); + break; + } + else + pEnv += strlen(pEnv)+1; + } +} + +void VDir::SetDefaultA(char const *pDefault) +{ + char szBuffer[MAX_PATH+1]; + char *pPtr; + + if (GetFullPathNameA(pDefault, sizeof(szBuffer), szBuffer, &pPtr)) { + if (*pDefault != '.' && pPtr != NULL) + *pPtr = '\0'; + + SetDefaultDirA(szBuffer, DriveIndex(szBuffer[0])); + } +} + +int VDir::SetDirW(WCHAR const *pPath, int index) +{ + WCHAR chr, *ptr; + char szBuffer[MAX_PATH+1]; + int length = 0; + if (index < driveCount && pPath != NULL) { + length = wcslen(pPath); + pMem->Free(dirTableW[index]); + ptr = dirTableW[index] = (WCHAR*)pMem->Malloc((length+2)*2); + if (ptr != NULL) { + wcscpy(ptr, pPath); + ptr += length-1; + chr = *ptr++; + if (chr != '\\' && chr != '/') { + *ptr++ = '\\'; + *ptr = '\0'; + } + WideCharToMultiByte(CP_ACP, 0, dirTableW[index], -1, szBuffer, sizeof(szBuffer), NULL, NULL); + length = strlen(szBuffer); + pMem->Free(dirTableA[index]); + dirTableA[index] = (char*)pMem->Malloc(length+1); + if (dirTableA[index] != NULL) { + strcpy(dirTableA[index], szBuffer); + } + } + } + + if(bManageDirectory) + ::SetCurrentDirectoryW(pPath); + + return length; +} + +void VDir::SetDefaultW(WCHAR const *pDefault) +{ + WCHAR szBuffer[MAX_PATH+1]; + WCHAR *pPtr; + + if (GetFullPathNameW(pDefault, (sizeof(szBuffer)/sizeof(WCHAR)), szBuffer, &pPtr)) { + if (*pDefault != '.' && pPtr != NULL) + *pPtr = '\0'; + + SetDefaultDirW(szBuffer, DriveIndex((char)szBuffer[0])); + } +} + +inline BOOL IsPathSep(char ch) +{ + return (ch == '\\' || ch == '/'); +} + +inline void DoGetFullPathNameA(char* lpBuffer, DWORD dwSize, char* Dest) +{ + char *pPtr; + + /* + * On WinNT GetFullPathName does not fail, (or at least always + * succeeds when the drive is valid) WinNT does set *Dest to Nullch + * On Win98 GetFullPathName will set last error if it fails, but + * does not touch *Dest + */ + *Dest = '\0'; + GetFullPathNameA(lpBuffer, dwSize, Dest, &pPtr); +} + +char *VDir::MapPathA(const char *pInName) +{ /* + * possiblities -- relative path or absolute path with or without drive letter + * OR UNC name + */ + char szBuffer[(MAX_PATH+1)*2]; + char szlBuf[MAX_PATH+1]; + + if (strlen(pInName) > MAX_PATH) { + strncpy(szlBuf, pInName, MAX_PATH); + if (IsPathSep(pInName[0]) && !IsPathSep(pInName[1])) { + /* absolute path - reduce length by 2 for drive specifier */ + szlBuf[MAX_PATH-2] = '\0'; + } + else + szlBuf[MAX_PATH] = '\0'; + pInName = szlBuf; + } + /* strlen(pInName) is now <= MAX_PATH */ + + if (pInName[1] == ':') { + /* has drive letter */ + if (IsPathSep(pInName[2])) { + /* absolute with drive letter */ + strcpy(szLocalBufferA, pInName); + } + else { + /* relative path with drive letter */ + strcpy(szBuffer, GetDirA(DriveIndex(*pInName))); + strcat(szBuffer, &pInName[2]); + if(strlen(szBuffer) > MAX_PATH) + szBuffer[MAX_PATH] = '\0'; + + DoGetFullPathNameA(szBuffer, sizeof(szLocalBufferA), szLocalBufferA); + } + } + else { + /* no drive letter */ + if (IsPathSep(pInName[1]) && IsPathSep(pInName[0])) { + /* UNC name */ + strcpy(szLocalBufferA, pInName); + } + else { + strcpy(szBuffer, GetDefaultDirA()); + if (IsPathSep(pInName[0])) { + /* absolute path */ + szLocalBufferA[0] = szBuffer[0]; + szLocalBufferA[1] = szBuffer[1]; + strcpy(&szLocalBufferA[2], pInName); + } + else { + /* relative path */ + strcat(szBuffer, pInName); + if (strlen(szBuffer) > MAX_PATH) + szBuffer[MAX_PATH] = '\0'; + + DoGetFullPathNameA(szBuffer, sizeof(szLocalBufferA), szLocalBufferA); + } + } + } + + return szLocalBufferA; +} + +int VDir::SetCurrentDirectoryA(char *lpBuffer) +{ + HANDLE hHandle; + WIN32_FIND_DATA win32FD; + char szBuffer[MAX_PATH+1], *pPtr; + int length, nRet = -1; + + GetFullPathNameA(MapPathA(lpBuffer), sizeof(szBuffer), szBuffer, &pPtr); + /* if the last char is a '\\' or a '/' then add + * an '*' before calling FindFirstFile + */ + length = strlen(szBuffer); + if(length > 0 && IsPathSep(szBuffer[length-1])) { + szBuffer[length] = '*'; + szBuffer[length+1] = '\0'; + } + + hHandle = FindFirstFileA(szBuffer, &win32FD); + if (hHandle != INVALID_HANDLE_VALUE) { + FindClose(hHandle); + + /* if an '*' was added remove it */ + if(szBuffer[length] == '*') + szBuffer[length] = '\0'; + + SetDefaultDirA(szBuffer, DriveIndex(szBuffer[0])); + nRet = 0; + } + return nRet; +} + +DWORD VDir::CalculateEnvironmentSpace(void) +{ /* the current directory environment strings are stored as '=d=d:\path' */ + int index; + DWORD dwSize = 0; + for (index = 0; index < driveCount; ++index) { + if (dirTableA[index] != NULL) { + dwSize += strlen(dirTableA[index]) + 4; /* add 1 for trailing NULL and 3 for '=d=' */ + } + } + return dwSize; +} + +LPSTR VDir::BuildEnvironmentSpace(LPSTR lpStr) +{ /* store the current directory environment strings as '=d=d:\path' */ + int index; + LPSTR lpDirStr; + for (index = 0; index < driveCount; ++index) { + lpDirStr = dirTableA[index]; + if (lpDirStr != NULL) { + lpStr[0] = '='; + lpStr[1] = lpDirStr[0]; + lpStr[2] = '='; + strcpy(&lpStr[3], lpDirStr); + lpStr += strlen(lpDirStr) + 4; /* add 1 for trailing NULL and 3 for '=d=' */ + } + } + return lpStr; +} + +inline BOOL IsPathSep(WCHAR ch) +{ + return (ch == '\\' || ch == '/'); +} + +inline void DoGetFullPathNameW(WCHAR* lpBuffer, DWORD dwSize, WCHAR* Dest) +{ + WCHAR *pPtr; + + /* + * On WinNT GetFullPathName does not fail, (or at least always + * succeeds when the drive is valid) WinNT does set *Dest to Nullch + * On Win98 GetFullPathName will set last error if it fails, but + * does not touch *Dest + */ + *Dest = '\0'; + GetFullPathNameW(lpBuffer, dwSize, Dest, &pPtr); +} + +WCHAR* VDir::MapPathW(const WCHAR *pInName) +{ /* + * possiblities -- relative path or absolute path with or without drive letter + * OR UNC name + */ + WCHAR szBuffer[(MAX_PATH+1)*2]; + WCHAR szlBuf[MAX_PATH+1]; + + if (wcslen(pInName) > MAX_PATH) { + wcsncpy(szlBuf, pInName, MAX_PATH); + if (IsPathSep(pInName[0]) && !IsPathSep(pInName[1])) { + /* absolute path - reduce length by 2 for drive specifier */ + szlBuf[MAX_PATH-2] = '\0'; + } + else + szlBuf[MAX_PATH] = '\0'; + pInName = szlBuf; + } + /* strlen(pInName) is now <= MAX_PATH */ + + if (pInName[1] == ':') { + /* has drive letter */ + if (IsPathSep(pInName[2])) { + /* absolute with drive letter */ + wcscpy(szLocalBufferW, pInName); + } + else { + /* relative path with drive letter */ + wcscpy(szBuffer, GetDirW(DriveIndex((char)*pInName))); + wcscat(szBuffer, &pInName[2]); + if(wcslen(szBuffer) > MAX_PATH) + szBuffer[MAX_PATH] = '\0'; + + DoGetFullPathNameW(szBuffer, (sizeof(szLocalBufferW)/sizeof(WCHAR)), szLocalBufferW); + } + } + else { + /* no drive letter */ + if (IsPathSep(pInName[1]) && IsPathSep(pInName[0])) { + /* UNC name */ + wcscpy(szLocalBufferW, pInName); + } + else { + wcscpy(szBuffer, GetDefaultDirW()); + if (IsPathSep(pInName[0])) { + /* absolute path */ + szLocalBufferW[0] = szBuffer[0]; + szLocalBufferW[1] = szBuffer[1]; + wcscpy(&szLocalBufferW[2], pInName); + } + else { + /* relative path */ + wcscat(szBuffer, pInName); + if (wcslen(szBuffer) > MAX_PATH) + szBuffer[MAX_PATH] = '\0'; + + DoGetFullPathNameW(szBuffer, (sizeof(szLocalBufferW)/sizeof(WCHAR)), szLocalBufferW); + } + } + } + return szLocalBufferW; +} + +int VDir::SetCurrentDirectoryW(WCHAR *lpBuffer) +{ + HANDLE hHandle; + WIN32_FIND_DATAW win32FD; + WCHAR szBuffer[MAX_PATH+1], *pPtr; + int length, nRet = -1; + + GetFullPathNameW(MapPathW(lpBuffer), (sizeof(szBuffer)/sizeof(WCHAR)), szBuffer, &pPtr); + /* if the last char is a '\\' or a '/' then add + * an '*' before calling FindFirstFile + */ + length = wcslen(szBuffer); + if(length > 0 && IsPathSep(szBuffer[length-1])) { + szBuffer[length] = '*'; + szBuffer[length+1] = '\0'; + } + + hHandle = FindFirstFileW(szBuffer, &win32FD); + if (hHandle != INVALID_HANDLE_VALUE) { + FindClose(hHandle); + + /* if an '*' was added remove it */ + if(szBuffer[length] == '*') + szBuffer[length] = '\0'; + + SetDefaultDirW(szBuffer, DriveIndex((char)szBuffer[0])); + nRet = 0; + } + return nRet; +} + +#endif /* ___VDir_H___ */ diff --git a/win32/vmem.h b/win32/vmem.h new file mode 100644 index 0000000..cf3f502 --- /dev/null +++ b/win32/vmem.h @@ -0,0 +1,703 @@ +/* vmem.h + * + * (c) 1999 Microsoft Corporation. All rights reserved. + * Portions (c) 1999 ActiveState Tool Corp, http://www.ActiveState.com/ + * + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. + * + * + * Knuth's boundary tag algorithm Vol #1, Page 440. + * + * Each block in the heap has tag words before and after it, + * TAG + * block + * TAG + * The size is stored in these tags as a long word, and includes the 8 bytes + * of overhead that the boundary tags consume. Blocks are allocated on long + * word boundaries, so the size is always multiples of long words. When the + * block is allocated, bit 0, (the tag bit), of the size is set to 1. When + * a block is freed, it is merged with adjacent free blocks, and the tag bit + * is set to 0. + * + * A linked list is used to manage the free list. The first two long words of + * the block contain double links. These links are only valid when the block + * is freed, therefore space needs to be reserved for them. Thus, the minimum + * block size (not counting the tags) is 8 bytes. + * + * Since memory allocation may occur on a single threaded, explict locks are + * provided. + * + */ + +#ifndef ___VMEM_H_INC___ +#define ___VMEM_H_INC___ + +const long lAllocStart = 0x00010000; /* start at 64K */ +const long minBlockSize = sizeof(void*)*2; +const long sizeofTag = sizeof(long); +const long blockOverhead = sizeofTag*2; +const long minAllocSize = minBlockSize+blockOverhead; + +typedef BYTE* PBLOCK; /* pointer to a memory block */ + +/* + * Macros for accessing hidden fields in a memory block: + * + * SIZE size of this block (tag bit 0 is 1 if block is allocated) + * PSIZE size of previous physical block + */ + +#define SIZE(block) (*(ULONG*)(((PBLOCK)(block))-sizeofTag)) +#define PSIZE(block) (*(ULONG*)(((PBLOCK)(block))-(sizeofTag*2))) +inline void SetTags(PBLOCK block, long size) +{ + SIZE(block) = size; + PSIZE(block+(size&~1)) = size; +} + +/* + * Free list pointers + * PREV pointer to previous block + * NEXT pointer to next block + */ + +#define PREV(block) (*(PBLOCK*)(block)) +#define NEXT(block) (*(PBLOCK*)((block)+sizeof(PBLOCK))) +inline void SetLink(PBLOCK block, PBLOCK prev, PBLOCK next) +{ + PREV(block) = prev; + NEXT(block) = next; +} +inline void Unlink(PBLOCK p) +{ + PBLOCK next = NEXT(p); + PBLOCK prev = PREV(p); + NEXT(prev) = next; + PREV(next) = prev; +} +inline void AddToFreeList(PBLOCK block, PBLOCK pInList) +{ + PBLOCK next = NEXT(pInList); + NEXT(pInList) = block; + SetLink(block, pInList, next); + PREV(next) = block; +} + + +/* Macro for rounding up to the next sizeof(long) */ +#define ROUND_UP(n) (((ULONG)(n)+sizeof(long)-1)&~(sizeof(long)-1)) +#define ROUND_UP64K(n) (((ULONG)(n)+0x10000-1)&~(0x10000-1)) +#define ROUND_DOWN(n) ((ULONG)(n)&~(sizeof(long)-1)) + +/* + * HeapRec - a list of all non-contiguous heap areas + * + * Each record in this array contains information about a non-contiguous heap area. + */ + +const int maxHeaps = 64; +const long lAllocMax = 0x80000000; /* max size of allocation */ + +typedef struct _HeapRec +{ + PBLOCK base; /* base of heap area */ + ULONG len; /* size of heap area */ +} HeapRec; + + +class VMem +{ +public: + VMem(); + ~VMem(); + virtual void* Malloc(size_t size); + virtual void* Realloc(void* pMem, size_t size); + virtual void Free(void* pMem); + virtual void GetLock(void); + virtual void FreeLock(void); + virtual int IsLocked(void); + virtual long Release(void); + virtual long AddRef(void); + + inline BOOL CreateOk(void) + { + return m_hHeap != NULL; + }; + + void ReInit(void); + +protected: + void Init(void); + int Getmem(size_t size); + int HeapAdd(void* ptr, size_t size); + void* Expand(void* block, size_t size); + void WalkHeap(void); + + HANDLE m_hHeap; // memory heap for this script + char m_FreeDummy[minAllocSize]; // dummy free block + PBLOCK m_pFreeList; // pointer to first block on free list + PBLOCK m_pRover; // roving pointer into the free list + HeapRec m_heaps[maxHeaps]; // list of all non-contiguous heap areas + int m_nHeaps; // no. of heaps in m_heaps + long m_lAllocSize; // current alloc size + long m_lRefCount; // number of current users + CRITICAL_SECTION m_cs; // access lock +}; + +// #define _DEBUG_MEM +#ifdef _DEBUG_MEM +#define ASSERT(f) if(!(f)) DebugBreak(); + +inline void MEMODS(char *str) +{ + OutputDebugString(str); + OutputDebugString("\n"); +} + +inline void MEMODSlx(char *str, long x) +{ + char szBuffer[512]; + sprintf(szBuffer, "%s %lx\n", str, x); + OutputDebugString(szBuffer); +} + +#define WALKHEAP() WalkHeap() +#define WALKHEAPTRACE() m_pRover = NULL; WalkHeap() + +#else + +#define ASSERT(f) +#define MEMODS(x) +#define MEMODSlx(x, y) +#define WALKHEAP() +#define WALKHEAPTRACE() + +#endif + + +VMem::VMem() +{ + m_lRefCount = 1; + BOOL bRet = (NULL != (m_hHeap = HeapCreate(HEAP_NO_SERIALIZE, + lAllocStart, /* initial size of heap */ + 0))); /* no upper limit on size of heap */ + ASSERT(bRet); + + InitializeCriticalSection(&m_cs); + + Init(); +} + +VMem::~VMem(void) +{ + ASSERT(HeapValidate(m_hHeap, HEAP_NO_SERIALIZE, NULL)); + WALKHEAPTRACE(); + DeleteCriticalSection(&m_cs); + BOOL bRet = HeapDestroy(m_hHeap); + ASSERT(bRet); +} + +void VMem::ReInit(void) +{ + for(int index = 0; index < m_nHeaps; ++index) + HeapFree(m_hHeap, HEAP_NO_SERIALIZE, m_heaps[index].base); + + Init(); +} + +void VMem::Init(void) +{ /* + * Initialize the free list by placing a dummy zero-length block on it. + * Set the number of non-contiguous heaps to zero. + */ + m_pFreeList = m_pRover = (PBLOCK)(&m_FreeDummy[minBlockSize]); + PSIZE(m_pFreeList) = SIZE(m_pFreeList) = 0; + PREV(m_pFreeList) = NEXT(m_pFreeList) = m_pFreeList; + + m_nHeaps = 0; + m_lAllocSize = lAllocStart; +} + +void* VMem::Malloc(size_t size) +{ + WALKHEAP(); + + /* + * Adjust the real size of the block to be a multiple of sizeof(long), and add + * the overhead for the boundary tags. Disallow negative or zero sizes. + */ + size_t realsize = (size < blockOverhead) ? minAllocSize : (size_t)ROUND_UP(size) + minBlockSize; + if((int)realsize < minAllocSize || size == 0) + return NULL; + + /* + * Start searching the free list at the rover. If we arrive back at rover without + * finding anything, allocate some memory from the heap and try again. + */ + PBLOCK ptr = m_pRover; /* start searching at rover */ + int loops = 2; /* allow two times through the loop */ + for(;;) { + size_t lsize = SIZE(ptr); + ASSERT((lsize&1)==0); + /* is block big enough? */ + if(lsize >= realsize) { + /* if the remainder is too small, don't bother splitting the block. */ + size_t rem = lsize - realsize; + if(rem < minAllocSize) { + if(m_pRover == ptr) + m_pRover = NEXT(ptr); + + /* Unlink the block from the free list. */ + Unlink(ptr); + } + else { + /* + * split the block + * The remainder is big enough to split off into a new block. + * Use the end of the block, resize the beginning of the block + * no need to change the free list. + */ + SetTags(ptr, rem); + ptr += SIZE(ptr); + lsize = realsize; + } + /* Set the boundary tags to mark it as allocated. */ + SetTags(ptr, lsize | 1); + return ((void *)ptr); + } + + /* + * This block was unsuitable. If we've gone through this list once already without + * finding anything, allocate some new memory from the heap and try again. + */ + ptr = NEXT(ptr); + if(ptr == m_pRover) { + if(!(loops-- && Getmem(realsize))) { + return NULL; + } + ptr = m_pRover; + } + } +} + +void* VMem::Realloc(void* block, size_t size) +{ + WALKHEAP(); + + /* if size is zero, free the block. */ + if(size == 0) { + Free(block); + return (NULL); + } + + /* if block pointer is NULL, do a Malloc(). */ + if(block == NULL) + return Malloc(size); + + /* + * Grow or shrink the block in place. + * if the block grows then the next block will be used if free + */ + if(Expand(block, size) != NULL) + return block; + + /* + * adjust the real size of the block to be a multiple of sizeof(long), and add the + * overhead for the boundary tags. Disallow negative or zero sizes. + */ + size_t realsize = (size < blockOverhead) ? minAllocSize : (size_t)ROUND_UP(size) + minBlockSize; + if((int)realsize < minAllocSize) + return NULL; + + /* + * see if the previous block is free, and is it big enough to cover the new size + * if merged with the current block. + */ + PBLOCK ptr = (PBLOCK)block; + size_t cursize = SIZE(ptr) & ~1; + size_t psize = PSIZE(ptr); + if((psize&1) == 0 && (psize + cursize) >= realsize) { + PBLOCK prev = ptr - psize; + if(m_pRover == prev) + m_pRover = NEXT(prev); + + /* Unlink the next block from the free list. */ + Unlink(prev); + + /* Copy contents of old block to new location, make it the current block. */ + memmove(prev, ptr, cursize); + cursize += psize; /* combine sizes */ + ptr = prev; + + size_t rem = cursize - realsize; + if(rem >= minAllocSize) { + /* + * The remainder is big enough to be a new block. Set boundary + * tags for the resized block and the new block. + */ + prev = ptr + realsize; + /* + * add the new block to the free list. + * next block cannot be free + */ + SetTags(prev, rem); + AddToFreeList(prev, m_pFreeList); + cursize = realsize; + } + /* Set the boundary tags to mark it as allocated. */ + SetTags(ptr, cursize | 1); + return ((void *)ptr); + } + + /* Allocate a new block, copy the old to the new, and free the old. */ + if((ptr = (PBLOCK)Malloc(size)) != NULL) { + memmove(ptr, block, cursize-minBlockSize); + Free(block); + } + return ((void *)ptr); +} + +void VMem::Free(void* p) +{ + WALKHEAP(); + + /* Ignore null pointer. */ + if(p == NULL) + return; + + PBLOCK ptr = (PBLOCK)p; + + /* Check for attempt to free a block that's already free. */ + size_t size = SIZE(ptr); + if((size&1) == 0) { + MEMODSlx("Attempt to free previously freed block", (long)p); + return; + } + size &= ~1; /* remove allocated tag */ + + /* if previous block is free, add this block to it. */ + int linked = FALSE; + size_t psize = PSIZE(ptr); + if((psize&1) == 0) { + ptr -= psize; /* point to previous block */ + size += psize; /* merge the sizes of the two blocks */ + linked = TRUE; /* it's already on the free list */ + } + + /* if the next physical block is free, merge it with this block. */ + PBLOCK next = ptr + size; /* point to next physical block */ + size_t nsize = SIZE(next); + if((nsize&1) == 0) { + /* block is free move rover if needed */ + if(m_pRover == next) + m_pRover = NEXT(next); + + /* unlink the next block from the free list. */ + Unlink(next); + + /* merge the sizes of this block and the next block. */ + size += nsize; + } + + /* Set the boundary tags for the block; */ + SetTags(ptr, size); + + /* Link the block to the head of the free list. */ + if(!linked) { + AddToFreeList(ptr, m_pFreeList); + } +} + +void VMem::GetLock(void) +{ + EnterCriticalSection(&m_cs); +} + +void VMem::FreeLock(void) +{ + LeaveCriticalSection(&m_cs); +} + +int VMem::IsLocked(void) +{ + BOOL bAccessed = TryEnterCriticalSection(&m_cs); + if(bAccessed) { + LeaveCriticalSection(&m_cs); + } + return !bAccessed; +} + + +long VMem::Release(void) +{ + long lCount = InterlockedDecrement(&m_lRefCount); + if(!lCount) + delete this; + return lCount; +} + +long VMem::AddRef(void) +{ + long lCount = InterlockedIncrement(&m_lRefCount); + return lCount; +} + + +int VMem::Getmem(size_t requestSize) +{ /* returns -1 is successful 0 if not */ + void *ptr; + + /* Round up size to next multiple of 64K. */ + size_t size = (size_t)ROUND_UP64K(requestSize); + + /* + * if the size requested is smaller than our current allocation size + * adjust up + */ + if(size < (unsigned long)m_lAllocSize) + size = m_lAllocSize; + + /* Update the size to allocate on the next request */ + if(m_lAllocSize != lAllocMax) + m_lAllocSize <<= 1; + + if(m_nHeaps != 0) { + /* Expand the last allocated heap */ + ptr = HeapReAlloc(m_hHeap, HEAP_REALLOC_IN_PLACE_ONLY|HEAP_ZERO_MEMORY|HEAP_NO_SERIALIZE, + m_heaps[m_nHeaps-1].base, + m_heaps[m_nHeaps-1].len + size); + if(ptr != 0) { + HeapAdd(((char*)ptr) + m_heaps[m_nHeaps-1].len, size); + return -1; + } + } + + /* + * if we didn't expand a block to cover the requested size + * allocate a new Heap + * the size of this block must include the additional dummy tags at either end + * the above ROUND_UP64K may not have added any memory to include this. + */ + if(size == requestSize) + size = (size_t)ROUND_UP64K(requestSize+(sizeofTag*2)); + + ptr = HeapAlloc(m_hHeap, HEAP_ZERO_MEMORY|HEAP_NO_SERIALIZE, size); + if(ptr == 0) { + MEMODSlx("HeapAlloc failed on size!!!", size); + return 0; + } + + HeapAdd(ptr, size); + return -1; +} + +int VMem::HeapAdd(void *p, size_t size) +{ /* if the block can be succesfully added to the heap, returns 0; otherwise -1. */ + int index; + + /* Check size, then round size down to next long word boundary. */ + if(size < minAllocSize) + return -1; + + size = (size_t)ROUND_DOWN(size); + PBLOCK ptr = (PBLOCK)p; + + /* + * Search for another heap area that's contiguous with the bottom of this new area. + * (It should be extremely unusual to find one that's contiguous with the top). + */ + for(index = 0; index < m_nHeaps; ++index) { + if(ptr == m_heaps[index].base + (int)m_heaps[index].len) { + /* + * The new block is contiguous with a previously allocated heap area. Add its + * length to that of the previous heap. Merge it with the the dummy end-of-heap + * area marker of the previous heap. + */ + m_heaps[index].len += size; + break; + } + } + + if(index == m_nHeaps) { + /* The new block is not contiguous. Add it to the heap list. */ + if(m_nHeaps == maxHeaps) { + return -1; /* too many non-contiguous heaps */ + } + m_heaps[m_nHeaps].base = ptr; + m_heaps[m_nHeaps].len = size; + m_nHeaps++; + + /* + * Reserve the first LONG in the block for the ending boundary tag of a dummy + * block at the start of the heap area. + */ + size -= minBlockSize; + ptr += minBlockSize; + PSIZE(ptr) = 1; /* mark the dummy previous block as allocated */ + } + + /* + * Convert the heap to one large block. Set up its boundary tags, and those of + * marker block after it. The marker block before the heap will already have + * been set up if this heap is not contiguous with the end of another heap. + */ + SetTags(ptr, size | 1); + PBLOCK next = ptr + size; /* point to dummy end block */ + SIZE(next) = 1; /* mark the dummy end block as allocated */ + + /* + * Link the block to the start of the free list by calling free(). + * This will merge the block with any adjacent free blocks. + */ + Free(ptr); + return 0; +} + + +void* VMem::Expand(void* block, size_t size) +{ + /* + * Adjust the size of the block to be a multiple of sizeof(long), and add the + * overhead for the boundary tags. Disallow negative or zero sizes. + */ + size_t realsize = (size < blockOverhead) ? minAllocSize : (size_t)ROUND_UP(size) + minBlockSize; + if((int)realsize < minAllocSize || size == 0) + return NULL; + + PBLOCK ptr = (PBLOCK)block; + + /* if the current size is the same as requested, do nothing. */ + size_t cursize = SIZE(ptr) & ~1; + if(cursize == realsize) { + return block; + } + + /* if the block is being shrunk, convert the remainder of the block into a new free block. */ + if(realsize <= cursize) { + size_t nextsize = cursize - realsize; /* size of new remainder block */ + if(nextsize >= minAllocSize) { + /* + * Split the block + * Set boundary tags for the resized block and the new block. + */ + SetTags(ptr, realsize | 1); + ptr += realsize; + + /* + * add the new block to the free list. + * call Free to merge this block with next block if free + */ + SetTags(ptr, nextsize | 1); + Free(ptr); + } + + return block; + } + + PBLOCK next = ptr + cursize; + size_t nextsize = SIZE(next); + + /* Check the next block for consistency.*/ + if((nextsize&1) == 0 && (nextsize + cursize) >= realsize) { + /* + * The next block is free and big enough. Add the part that's needed + * to our block, and split the remainder off into a new block. + */ + if(m_pRover == next) + m_pRover = NEXT(next); + + /* Unlink the next block from the free list. */ + Unlink(next); + cursize += nextsize; /* combine sizes */ + + size_t rem = cursize - realsize; /* size of remainder */ + if(rem >= minAllocSize) { + /* + * The remainder is big enough to be a new block. + * Set boundary tags for the resized block and the new block. + */ + next = ptr + realsize; + /* + * add the new block to the free list. + * next block cannot be free + */ + SetTags(next, rem); + AddToFreeList(next, m_pFreeList); + cursize = realsize; + } + /* Set the boundary tags to mark it as allocated. */ + SetTags(ptr, cursize | 1); + return ((void *)ptr); + } + return NULL; +} + +#ifdef _DEBUG_MEM +#define LOG_FILENAME "P:\\Apps\\Perl\\Result.txt" + +void MemoryUsageMessage(char *str, long x, long y, int c) +{ + static FILE* fp = NULL; + char szBuffer[512]; + if(str) { + if(!fp) + fp = fopen(LOG_FILENAME, "w"); + sprintf(szBuffer, str, x, y, c); + fputs(szBuffer, fp); + } + else { + fflush(fp); + fclose(fp); + } +} + +void VMem::WalkHeap(void) +{ + if(!m_pRover) { + MemoryUsageMessage("VMem heaps used %d\n", m_nHeaps, 0, 0); + } + + /* Walk all the heaps - verify structures */ + for(int index = 0; index < m_nHeaps; ++index) { + PBLOCK ptr = m_heaps[index].base; + size_t size = m_heaps[index].len; + ASSERT(HeapValidate(m_hHeap, HEAP_NO_SERIALIZE, p)); + + /* set over reserved header block */ + size -= minBlockSize; + ptr += minBlockSize; + PBLOCK pLast = ptr + size; + ASSERT(PSIZE(ptr) == 1); /* dummy previous block is allocated */ + ASSERT(SIZE(pLast) == 1); /* dummy next block is allocated */ + while(ptr < pLast) { + ASSERT(ptr > m_heaps[index].base); + size_t cursize = SIZE(ptr) & ~1; + ASSERT((PSIZE(ptr+cursize) & ~1) == cursize); + if(!m_pRover) { + MemoryUsageMessage("Memory Block %08x: Size %08x %c\n", (long)ptr, cursize, (SIZE(p)&1) ? 'x' : ' '); + } + if(!(SIZE(ptr)&1)) { + /* this block is on the free list */ + PBLOCK tmp = NEXT(ptr); + while(tmp != ptr) { + ASSERT((SIZE(tmp)&1)==0); + if(tmp == m_pFreeList) + break; + ASSERT(NEXT(tmp)); + tmp = NEXT(tmp); + } + if(tmp == ptr) { + MemoryUsageMessage("Memory Block %08x: Size %08x free but not in free list\n", (long)ptr, cursize, 0); + } + } + ptr += cursize; + } + } + if(!m_pRover) { + MemoryUsageMessage(NULL, 0, 0, 0); + } +} +#endif + +#endif /* ___VMEM_H_INC___ */ diff --git a/win32/win32.c b/win32/win32.c index 1d61eb7..78955fc 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -15,18 +15,8 @@ #define Win32_Winsock #endif #include - -#ifndef __MINGW32__ -#include -#include -/* ugliness to work around a buggy struct definition in lmwksta.h */ -#undef LPTSTR -#define LPTSTR LPWSTR -#include -#undef LPTSTR -#define LPTSTR LPSTR -#include -#endif /* __MINGW32__ */ +#include +#include /* #include "config.h" */ @@ -66,7 +56,11 @@ int _CRT_glob = 0; #endif -#ifdef __BORLANDC__ +#if defined(__MINGW32__) +# define _stat stat +#endif + +#if defined(__BORLANDC__) # define _stat stat # define _utimbuf utimbuf #endif @@ -75,23 +69,26 @@ int _CRT_glob = 0; #define EXECF_SPAWN 2 #define EXECF_SPAWN_NOWAIT 3 +#if defined(PERL_IMPLICIT_SYS) +# undef win32_get_privlib +# define win32_get_privlib g_win32_get_privlib +# undef win32_get_sitelib +# define win32_get_sitelib g_win32_get_sitelib +# undef do_spawn +# define do_spawn g_do_spawn +# undef getlogin +# define getlogin g_getlogin +#endif + #if defined(PERL_OBJECT) -#undef win32_get_privlib -#define win32_get_privlib g_win32_get_privlib -#undef win32_get_sitelib -#define win32_get_sitelib g_win32_get_sitelib -#undef do_aspawn -#define do_aspawn g_do_aspawn -#undef do_spawn -#define do_spawn g_do_spawn -#undef Perl_do_exec -#define Perl_do_exec g_do_exec -#undef getlogin -#define getlogin g_getlogin +# undef do_aspawn +# define do_aspawn g_do_aspawn +# undef Perl_do_exec +# define Perl_do_exec g_do_exec #endif static void get_shell(void); -static long tokenize(char *str, char **dest, char ***destv); +static long tokenize(const char *str, char **dest, char ***destv); int do_spawn2(char *cmd, int exectype); static BOOL has_shell_metachars(char *ptr); static long filetime_to_clock(PFILETIME ft); @@ -100,33 +97,19 @@ static char * get_emd_part(SV **leading, char *trailing, ...); static void remove_dead_process(long deceased); static long find_pid(int pid); static char * qualified_path(const char *cmd); +#ifdef USE_ITHREADS +static void remove_dead_pseudo_process(long child); +static long find_pseudo_pid(int pid); +#endif +START_EXTERN_C HANDLE w32_perldll_handle = INVALID_HANDLE_VALUE; char w32_module_name[MAX_PATH+1]; +END_EXTERN_C + static DWORD w32_platform = (DWORD)-1; -#ifdef USE_THREADS -# ifdef USE_DECLSPEC_THREAD -__declspec(thread) char strerror_buffer[512]; -__declspec(thread) char getlogin_buffer[128]; -__declspec(thread) char w32_perllib_root[MAX_PATH+1]; -# ifdef HAVE_DES_FCRYPT -__declspec(thread) char crypt_buffer[30]; -# endif -# else -# define strerror_buffer (thr->i.Wstrerror_buffer) -# define getlogin_buffer (thr->i.Wgetlogin_buffer) -# define w32_perllib_root (thr->i.Ww32_perllib_root) -# define crypt_buffer (thr->i.Wcrypt_buffer) -# endif -#else -static char strerror_buffer[512]; -static char getlogin_buffer[128]; -static char w32_perllib_root[MAX_PATH+1]; -# ifdef HAVE_DES_FCRYPT -static char crypt_buffer[30]; -# endif -#endif +#define ONE_K_BUFSIZE 1024 int IsWin95(void) @@ -193,12 +176,13 @@ get_emd_part(SV **prev_pathp, char *trailing_path, ...) char *optr; char *strip; int oldsize, newsize; + STRLEN baselen; va_start(ap, trailing_path); strip = va_arg(ap, char *); - sprintf(base, "%5.3f", - (double)PERL_REVISION + ((double)PERL_VERSION / (double)1000)); + sprintf(base, "%d.%d", (int)PERL_REVISION, (int)PERL_VERSION); + baselen = strlen(base); if (!*w32_module_name) { GetModuleFileName((HMODULE)((w32_perldll_handle == INVALID_HANDLE_VALUE) @@ -208,9 +192,9 @@ get_emd_part(SV **prev_pathp, char *trailing_path, ...) /* try to get full path to binary (which may be mangled when perl is * run from a 16-bit app) */ - /*PerlIO_printf(PerlIO_stderr(), "Before %s\n", w32_module_name);*/ + /*PerlIO_printf(Perl_debug_log, "Before %s\n", w32_module_name);*/ (void)win32_longpath(w32_module_name); - /*PerlIO_printf(PerlIO_stderr(), "After %s\n", w32_module_name);*/ + /*PerlIO_printf(Perl_debug_log, "After %s\n", w32_module_name);*/ /* normalize to forward slashes */ ptr = w32_module_name; @@ -230,10 +214,10 @@ get_emd_part(SV **prev_pathp, char *trailing_path, ...) /* avoid stripping component if there is no slash, * or it doesn't match ... */ if (!ptr || stricmp(ptr+1, strip) != 0) { - /* ... but not if component matches 5.00X* */ + /* ... but not if component matches m|5\.$patchlevel.*| */ if (!ptr || !(*strip == '5' && *(ptr+1) == '5' - && strncmp(strip, base, 5) == 0 - && strncmp(ptr+1, base, 5) == 0)) + && strncmp(strip, base, baselen) == 0 + && strncmp(ptr+1, base, baselen) == 0)) { *optr = '/'; ptr = optr; @@ -300,12 +284,6 @@ win32_get_sitelib(char *pl) * ";$EMD/" . ((-d $EMD/../../../$]) ? "../../.." : "../.."). "/site/$]/lib"; */ sprintf(pathstr, "site/%s/lib", pl); (void)get_emd_part(&sv1, pathstr, ARCHNAME, "bin", pl, Nullch); - if (!sv1 && strlen(pl) == 7) { - /* pl may have been SUBVERSION-specific; try again without - * SUBVERSION */ - sprintf(pathstr, "site/%.5s/lib", pl); - (void)get_emd_part(&sv1, pathstr, ARCHNAME, "bin", pl, Nullch); - } /* $HKCU{'sitelib'} || $HKLM{'sitelib'} . ---; */ (void)get_regstr(sitelib, &sv2); @@ -369,7 +347,7 @@ has_shell_metachars(char *ptr) return FALSE; } -#if !defined(PERL_OBJECT) +#if !defined(PERL_IMPLICIT_SYS) /* since the current process environment is being updated in util.c * the library functions will get the correct environment */ @@ -377,17 +355,17 @@ PerlIO * Perl_my_popen(pTHX_ char *cmd, char *mode) { #ifdef FIXCMD -#define fixcmd(x) { \ - char *pspace = strchr((x),' '); \ - if (pspace) { \ - char *p = (x); \ - while (p < pspace) { \ - if (*p == '/') \ - *p = '\\'; \ - p++; \ - } \ - } \ - } +#define fixcmd(x) { \ + char *pspace = strchr((x),' '); \ + if (pspace) { \ + char *p = (x); \ + while (p < pspace) { \ + if (*p == '/') \ + *p = '\\'; \ + p++; \ + } \ + } \ + } #else #define fixcmd(x) #endif @@ -417,6 +395,17 @@ win32_os_id(void) return (unsigned long)w32_platform; } +DllExport int +win32_getpid(void) +{ +#ifdef USE_ITHREADS + dTHXo; + if (w32_pseudo_id) + return -((int)w32_pseudo_id); +#endif + return _getpid(); +} + /* Tokenize a string. Words are null-separated, and the list * ends with a doubled null. Any character (except null and * including backslash) may be escaped by preceding it with a @@ -424,7 +413,7 @@ win32_os_id(void) * Returns number of words in result buffer. */ static long -tokenize(char *str, char **dest, char ***destv) +tokenize(const char *str, char **dest, char ***destv) { char *retstart = Nullch; char **retvstart = 0; @@ -482,8 +471,9 @@ get_shell(void) * interactive use (which is what most programs look in COMSPEC * for). */ - char* defaultshell = (IsWinNT() ? "cmd.exe /x/c" : "command.com /c"); - char *usershell = getenv("PERL5SHELL"); + const char* defaultshell = (IsWinNT() + ? "cmd.exe /x/c" : "command.com /c"); + const char *usershell = getenv("PERL5SHELL"); w32_perlshell_items = tokenize(usershell ? usershell : defaultshell, &w32_perlshell_tokens, &w32_perlshell_vec); @@ -672,7 +662,7 @@ DllExport DIR * win32_opendir(char *filename) { dTHXo; - DIR *p; + DIR *dirp; long len; long idx; char scanname[MAX_PATH+3]; @@ -682,7 +672,7 @@ win32_opendir(char *filename) HANDLE fh; char buffer[MAX_PATH*2]; WCHAR wbuffer[MAX_PATH]; - char* ptr; + char* ptr; len = strlen(filename); if (len > MAX_PATH) @@ -693,9 +683,7 @@ win32_opendir(char *filename) return NULL; /* Get us a DIR structure */ - Newz(1303, p, 1, DIR); - if (p == NULL) - return NULL; + Newz(1303, dirp, 1, DIR); /* Create the search pattern */ strcpy(scanname, filename); @@ -714,16 +702,30 @@ win32_opendir(char *filename) /* do the FindFirstFile call */ if (USING_WIDE()) { A2WHELPER(scanname, wbuffer, sizeof(wbuffer)); - fh = FindFirstFileW(wbuffer, &wFindData); + fh = FindFirstFileW(PerlDir_mapW(wbuffer), &wFindData); } else { - fh = FindFirstFileA(scanname, &aFindData); + fh = FindFirstFileA(PerlDir_mapA(scanname), &aFindData); } + dirp->handle = fh; if (fh == INVALID_HANDLE_VALUE) { + DWORD err = GetLastError(); /* FindFirstFile() fails on empty drives! */ - if (GetLastError() == ERROR_FILE_NOT_FOUND) - return p; - Safefree( p); + switch (err) { + case ERROR_FILE_NOT_FOUND: + return dirp; + case ERROR_NO_MORE_FILES: + case ERROR_PATH_NOT_FOUND: + errno = ENOENT; + break; + case ERROR_NOT_ENOUGH_MEMORY: + errno = ENOMEM; + break; + default: + errno = EINVAL; + break; + } + Safefree(dirp); return NULL; } @@ -738,39 +740,16 @@ win32_opendir(char *filename) ptr = aFindData.cFileName; } idx = strlen(ptr)+1; - New(1304, p->start, idx, char); - if (p->start == NULL) - Perl_croak_nocontext("opendir: malloc failed!\n"); - strcpy(p->start, ptr); - p->nfiles++; - - /* loop finding all the files that match the wildcard - * (which should be all of them in this directory!). - * the variable idx should point one past the null terminator - * of the previous string found. - */ - while (USING_WIDE() - ? FindNextFileW(fh, &wFindData) - : FindNextFileA(fh, &aFindData)) { - if (USING_WIDE()) { - W2AHELPER(wFindData.cFileName, buffer, sizeof(buffer)); - } - /* ptr is set above to the correct area */ - len = strlen(ptr); - /* bump the string table size by enough for the - * new name and it's null terminator - */ - Renew(p->start, idx+len+1, char); - if (p->start == NULL) - Perl_croak_nocontext("opendir: malloc failed!\n"); - strcpy(&p->start[idx], ptr); - p->nfiles++; - idx += len+1; - } - FindClose(fh); - p->size = idx; - p->curr = p->start; - return p; + if (idx < 256) + dirp->size = 128; + else + dirp->size = idx; + New(1304, dirp->start, dirp->size, char); + strcpy(dirp->start, ptr); + dirp->nfiles++; + dirp->end = dirp->curr = dirp->start; + dirp->end += idx; + return dirp; } @@ -780,8 +759,7 @@ win32_opendir(char *filename) DllExport struct direct * win32_readdir(DIR *dirp) { - int len; - static int dummy = 0; + long len; if (dirp->curr) { /* first set up the structure to return */ @@ -790,14 +768,51 @@ win32_readdir(DIR *dirp) dirp->dirstr.d_namlen = len; /* Fake an inode */ - dirp->dirstr.d_ino = dummy++; + dirp->dirstr.d_ino = dirp->curr - dirp->start; - /* Now set up for the nDllExport call to readdir */ + /* Now set up for the next call to readdir */ dirp->curr += len + 1; - if (dirp->curr >= (dirp->start + dirp->size)) { - dirp->curr = NULL; + if (dirp->curr >= dirp->end) { + dTHXo; + char* ptr; + BOOL res; + WIN32_FIND_DATAW wFindData; + WIN32_FIND_DATAA aFindData; + char buffer[MAX_PATH*2]; + + /* finding the next file that matches the wildcard + * (which should be all of them in this directory!). + */ + if (USING_WIDE()) { + res = FindNextFileW(dirp->handle, &wFindData); + if (res) { + W2AHELPER(wFindData.cFileName, buffer, sizeof(buffer)); + ptr = buffer; + } + } + else { + res = FindNextFileA(dirp->handle, &aFindData); + if (res) + ptr = aFindData.cFileName; + } + if (res) { + long endpos = dirp->end - dirp->start; + long newsize = endpos + strlen(ptr) + 1; + /* bump the string table size by enough for the + * new name and it's null terminator */ + while (newsize > dirp->size) { + long curpos = dirp->curr - dirp->start; + dirp->size *= 2; + Renew(dirp->start, dirp->size, char); + dirp->curr = dirp->start + curpos; + } + strcpy(dirp->start + endpos, ptr); + dirp->end = dirp->start + newsize; + dirp->nfiles++; + } + else + dirp->curr = NULL; } - return &(dirp->dirstr); } else @@ -808,17 +823,17 @@ win32_readdir(DIR *dirp) DllExport long win32_telldir(DIR *dirp) { - return (long) dirp->curr; + return (dirp->curr - dirp->start); } /* Seekdir moves the string pointer to a previously saved position - *(Saved by telldir). + * (returned by telldir). */ DllExport void win32_seekdir(DIR *dirp, long loc) { - dirp->curr = (char *)loc; + dirp->curr = dirp->start + loc; } /* Rewinddir resets the string pointer to the start */ @@ -833,6 +848,8 @@ DllExport int win32_closedir(DIR *dirp) { dTHXo; + if (dirp->handle != INVALID_HANDLE_VALUE) + FindClose(dirp->handle); Safefree(dirp->start); Safefree(dirp); return 1; @@ -893,8 +910,8 @@ char * getlogin(void) { dTHXo; - char *buf = getlogin_buffer; - DWORD size = sizeof(getlogin_buffer); + char *buf = w32_getlogin_buffer; + DWORD size = sizeof(w32_getlogin_buffer); if (GetUserName(buf,&size)) return buf; return (char*)NULL; @@ -911,8 +928,8 @@ static long find_pid(int pid) { dTHXo; - long child; - for (child = 0 ; child < w32_num_children ; ++child) { + long child = w32_num_children; + while (--child >= 0) { if (w32_child_pids[child] == pid) return child; } @@ -933,18 +950,72 @@ remove_dead_process(long child) } } +#ifdef USE_ITHREADS +static long +find_pseudo_pid(int pid) +{ + dTHXo; + long child = w32_num_pseudo_children; + while (--child >= 0) { + if (w32_pseudo_child_pids[child] == pid) + return child; + } + return -1; +} + +static void +remove_dead_pseudo_process(long child) +{ + if (child >= 0) { + dTHXo; + CloseHandle(w32_pseudo_child_handles[child]); + Copy(&w32_pseudo_child_handles[child+1], &w32_pseudo_child_handles[child], + (w32_num_pseudo_children-child-1), HANDLE); + Copy(&w32_pseudo_child_pids[child+1], &w32_pseudo_child_pids[child], + (w32_num_pseudo_children-child-1), DWORD); + w32_num_pseudo_children--; + } +} +#endif + DllExport int win32_kill(int pid, int sig) { + dTHXo; HANDLE hProcess; - hProcess = OpenProcess(PROCESS_ALL_ACCESS, TRUE, pid); - if (hProcess && TerminateProcess(hProcess, sig)) - CloseHandle(hProcess); - else { - errno = EINVAL; - return -1; +#ifdef USE_ITHREADS + if (pid < 0) { + /* it is a pseudo-forked child */ + long child = find_pseudo_pid(-pid); + if (child >= 0) { + hProcess = w32_pseudo_child_handles[child]; + if (TerminateThread(hProcess, sig)) { + remove_dead_pseudo_process(child); + return 0; + } + } } - return 0; + else +#endif + { + long child = find_pid(pid); + if (child >= 0) { + hProcess = w32_child_handles[child]; + if (TerminateProcess(hProcess, sig)) { + remove_dead_process(child); + return 0; + } + } + else { + hProcess = OpenProcess(PROCESS_ALL_ACCESS, TRUE, pid); + if (hProcess && TerminateProcess(hProcess, sig)) { + CloseHandle(hProcess); + return 0; + } + } + } + errno = EINVAL; + return -1; } /* @@ -966,6 +1037,8 @@ win32_stat(const char *path, struct stat *buffer) int l = strlen(path); int res; WCHAR wbuffer[MAX_PATH]; + HANDLE handle; + int nlink = 1; if (l > 1) { switch(path[l - 1]) { @@ -987,13 +1060,35 @@ win32_stat(const char *path, struct stat *buffer) break; } } + + /* We *must* open & close the file once; otherwise file attribute changes */ + /* might not yet have propagated to "other" hard links of the same file. */ + /* This also gives us an opportunity to determine the number of links. */ if (USING_WIDE()) { A2WHELPER(path, wbuffer, sizeof(wbuffer)); + wcscpy(wbuffer, PerlDir_mapW(wbuffer)); + handle = CreateFileW(wbuffer, 0, 0, NULL, OPEN_EXISTING, 0, NULL); + } + else { + path = PerlDir_mapA(path); + handle = CreateFileA(path, 0, 0, NULL, OPEN_EXISTING, 0, NULL); + } + if (handle != INVALID_HANDLE_VALUE) { + BY_HANDLE_FILE_INFORMATION bhi; + if (GetFileInformationByHandle(handle, &bhi)) + nlink = bhi.nNumberOfLinks; + CloseHandle(handle); + } + + /* wbuffer or path will be mapped correctly above */ + if (USING_WIDE()) { res = _wstat(wbuffer, (struct _stat *)buffer); } else { res = stat(path, buffer); } + buffer->st_nlink = nlink; + if (res < 0) { /* CRT is buggy on sharenames, so make sure it really isn't. * XXX using GetFileAttributesEx() will enable us to set @@ -1118,7 +1213,7 @@ win32_longpath(char *path) } else { /* failed a step, just return without side effects */ - /*PerlIO_printf(PerlIO_stderr(), "Failed to find %s\n", path);*/ + /*PerlIO_printf(Perl_debug_log, "Failed to find %s\n", path);*/ *start = sep; return Nullch; } @@ -1194,9 +1289,9 @@ win32_putenv(const char *name) New(1309,wCuritem,length,WCHAR); A2WHELPER(name, wCuritem, length*sizeof(WCHAR)); wVal = wcschr(wCuritem, '='); - if(wVal) { + if (wVal) { *wVal++ = '\0'; - if(SetEnvironmentVariableW(wCuritem, *wVal ? wVal : NULL)) + if (SetEnvironmentVariableW(wCuritem, *wVal ? wVal : NULL)) relval = 0; } Safefree(wCuritem); @@ -1205,7 +1300,7 @@ win32_putenv(const char *name) New(1309,curitem,strlen(name)+1,char); strcpy(curitem, name); val = strchr(curitem, '='); - if(val) { + if (val) { /* The sane way to deal with the environment. * Has these advantages over putenv() & co.: * * enables us to store a truly empty value in the @@ -1221,7 +1316,7 @@ win32_putenv(const char *name) * GSAR 97-06-07 */ *val++ = '\0'; - if(SetEnvironmentVariableA(curitem, *val ? val : NULL)) + if (SetEnvironmentVariableA(curitem, *val ? val : NULL)) relval = 0; } Safefree(curitem); @@ -1235,11 +1330,11 @@ win32_putenv(const char *name) static long filetime_to_clock(PFILETIME ft) { - __int64 qw = ft->dwHighDateTime; - qw <<= 32; - qw |= ft->dwLowDateTime; - qw /= 10000; /* File time ticks at 0.1uS, clock at 1mS */ - return (long) qw; + __int64 qw = ft->dwHighDateTime; + qw <<= 32; + qw |= ft->dwLowDateTime; + qw /= 10000; /* File time ticks at 0.1uS, clock at 1mS */ + return (long) qw; } DllExport int @@ -1266,14 +1361,13 @@ win32_times(struct tms *timebuf) return 0; } -/* fix utime() so it works on directories in NT - * thanks to Jan Dubois - */ +/* fix utime() so it works on directories in NT */ static BOOL filetime_from_time(PFILETIME pFileTime, time_t Time) { - struct tm *pTM = gmtime(&Time); + struct tm *pTM = localtime(&Time); SYSTEMTIME SystemTime; + FILETIME LocalTime; if (pTM == NULL) return FALSE; @@ -1286,7 +1380,45 @@ filetime_from_time(PFILETIME pFileTime, time_t Time) SystemTime.wSecond = pTM->tm_sec; SystemTime.wMilliseconds = 0; - return SystemTimeToFileTime(&SystemTime, pFileTime); + return SystemTimeToFileTime(&SystemTime, &LocalTime) && + LocalFileTimeToFileTime(&LocalTime, pFileTime); +} + +DllExport int +win32_unlink(const char *filename) +{ + dTHXo; + int ret; + DWORD attrs; + + if (USING_WIDE()) { + WCHAR wBuffer[MAX_PATH]; + + A2WHELPER(filename, wBuffer, sizeof(wBuffer)); + wcscpy(wBuffer, PerlDir_mapW(wBuffer)); + attrs = GetFileAttributesW(wBuffer); + if (attrs & FILE_ATTRIBUTE_READONLY) { + (void)SetFileAttributesW(wBuffer, attrs & ~FILE_ATTRIBUTE_READONLY); + ret = _wunlink(wBuffer); + if (ret == -1) + (void)SetFileAttributesW(wBuffer, attrs); + } + else + ret = _wunlink(wBuffer); + } + else { + filename = PerlDir_mapA(filename); + attrs = GetFileAttributesA(filename); + if (attrs & FILE_ATTRIBUTE_READONLY) { + (void)SetFileAttributesA(filename, attrs & ~FILE_ATTRIBUTE_READONLY); + ret = unlink(filename); + if (ret == -1) + (void)SetFileAttributesA(filename, attrs); + } + else + ret = unlink(filename); + } + return ret; } DllExport int @@ -1303,9 +1435,11 @@ win32_utime(const char *filename, struct utimbuf *times) int rc; if (USING_WIDE()) { A2WHELPER(filename, wbuffer, sizeof(wbuffer)); + wcscpy(wbuffer, PerlDir_mapW(wbuffer)); rc = _wutime(wbuffer, (struct _utimbuf*)times); } else { + filename = PerlDir_mapA(filename); rc = utime(filename, times); } /* EACCES: path specifies directory or readonly file */ @@ -1439,8 +1573,27 @@ win32_waitpid(int pid, int *status, int flags) { dTHXo; int retval = -1; - if (pid == -1) + if (pid == -1) /* XXX threadid == 1 ? */ return win32_wait(status); +#ifdef USE_ITHREADS + else if (pid < 0) { + long child = find_pseudo_pid(-pid); + if (child >= 0) { + HANDLE hThread = w32_pseudo_child_handles[child]; + DWORD waitcode = WaitForSingleObject(hThread, INFINITE); + if (waitcode != WAIT_FAILED) { + if (GetExitCodeThread(hThread, &waitcode)) { + *status = (int)((waitcode & 0xff) << 8); + retval = (int)w32_pseudo_child_pids[child]; + remove_dead_pseudo_process(child); + return retval; + } + } + else + errno = ECHILD; + } + } +#endif else { long child = find_pid(pid); if (child >= 0) { @@ -1479,6 +1632,28 @@ win32_wait(int *status) int i, retval; DWORD exitcode, waitcode; +#ifdef USE_ITHREADS + if (w32_num_pseudo_children) { + waitcode = WaitForMultipleObjects(w32_num_pseudo_children, + w32_pseudo_child_handles, + FALSE, + INFINITE); + if (waitcode != WAIT_FAILED) { + if (waitcode >= WAIT_ABANDONED_0 + && waitcode < WAIT_ABANDONED_0 + w32_num_pseudo_children) + i = waitcode - WAIT_ABANDONED_0; + else + i = waitcode - WAIT_OBJECT_0; + if (GetExitCodeThread(w32_pseudo_child_handles[i], &exitcode)) { + *status = (int)((exitcode & 0xff) << 8); + retval = (int)w32_pseudo_child_pids[i]; + remove_dead_pseudo_process(i); + return retval; + } + } + } +#endif + if (!w32_num_children) { errno = ECHILD; return -1; @@ -1548,7 +1723,6 @@ win32_alarm(unsigned int sec) return 0; } -#if defined(HAVE_DES_FCRYPT) || defined(PERL_OBJECT) #ifdef HAVE_DES_FCRYPT extern char * des_fcrypt(const char *txt, const char *salt, char *cbuf); #endif @@ -1559,13 +1733,12 @@ win32_crypt(const char *txt, const char *salt) dTHXo; #ifdef HAVE_DES_FCRYPT dTHR; - return des_fcrypt(txt, salt, crypt_buffer); + return des_fcrypt(txt, salt, w32_crypt_buffer); #else - die("The crypt() function is unimplemented due to excessive paranoia."); + Perl_croak(aTHX_ "The crypt() function is unimplemented due to excessive paranoia."); return Nullch; #endif } -#endif #ifdef USE_FIXED_OSFHANDLE @@ -1785,10 +1958,11 @@ win32_strerror(int e) e = GetLastError(); if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, &source, e, 0, - strerror_buffer, sizeof(strerror_buffer), NULL) == 0) - strcpy(strerror_buffer, "Unknown Error"); + w32_strerror_buffer, + sizeof(w32_strerror_buffer), NULL) == 0) + strcpy(w32_strerror_buffer, "Unknown Error"); - return strerror_buffer; + return w32_strerror_buffer; } return strerror(e); } @@ -1885,9 +2059,9 @@ win32_fopen(const char *filename, const char *mode) if (USING_WIDE()) { A2WHELPER(mode, wMode, sizeof(wMode)); A2WHELPER(filename, wBuffer, sizeof(wBuffer)); - return _wfopen(wBuffer, wMode); + return _wfopen(PerlDir_mapW(wBuffer), wMode); } - return fopen(filename, mode); + return fopen(PerlDir_mapA(filename), mode); } #ifndef USE_SOCKETS_AS_HANDLES @@ -1918,9 +2092,9 @@ win32_freopen(const char *path, const char *mode, FILE *stream) if (USING_WIDE()) { A2WHELPER(mode, wMode, sizeof(wMode)); A2WHELPER(path, wBuffer, sizeof(wBuffer)); - return _wfreopen(wBuffer, wMode, stream); + return _wfreopen(PerlDir_mapW(wBuffer), wMode, stream); } - return freopen(path, mode, stream); + return freopen(PerlDir_mapA(path), mode, stream); } DllExport int @@ -2155,11 +2329,97 @@ win32_pclose(FILE *pf) #endif /* USE_RTL_POPEN */ } +static BOOL WINAPI +Nt4CreateHardLinkW( + LPCWSTR lpFileName, + LPCWSTR lpExistingFileName, + LPSECURITY_ATTRIBUTES lpSecurityAttributes) +{ + HANDLE handle; + WCHAR wFullName[MAX_PATH+1]; + LPVOID lpContext = NULL; + WIN32_STREAM_ID StreamId; + DWORD dwSize = (char*)&StreamId.cStreamName - (char*)&StreamId; + DWORD dwWritten; + DWORD dwLen; + BOOL bSuccess; + + BOOL (__stdcall *pfnBackupWrite)(HANDLE, LPBYTE, DWORD, LPDWORD, + BOOL, BOOL, LPVOID*) = + (BOOL (__stdcall *)(HANDLE, LPBYTE, DWORD, LPDWORD, + BOOL, BOOL, LPVOID*)) + GetProcAddress(GetModuleHandle("kernel32.dll"), "BackupWrite"); + if (pfnBackupWrite == NULL) + return 0; + + dwLen = GetFullPathNameW(lpFileName, MAX_PATH, wFullName, NULL); + if (dwLen == 0) + return 0; + dwLen = (dwLen+1)*sizeof(WCHAR); + + handle = CreateFileW(lpExistingFileName, FILE_WRITE_ATTRIBUTES, + FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE, + NULL, OPEN_EXISTING, 0, NULL); + if (handle == INVALID_HANDLE_VALUE) + return 0; + + StreamId.dwStreamId = BACKUP_LINK; + StreamId.dwStreamAttributes = 0; + StreamId.dwStreamNameSize = 0; +#if defined(__BORLANDC__) || defined(__MINGW32__) + StreamId.Size.u.HighPart = 0; + StreamId.Size.u.LowPart = dwLen; +#else + StreamId.Size.HighPart = 0; + StreamId.Size.LowPart = dwLen; +#endif + + bSuccess = pfnBackupWrite(handle, (LPBYTE)&StreamId, dwSize, &dwWritten, + FALSE, FALSE, &lpContext); + if (bSuccess) { + bSuccess = pfnBackupWrite(handle, (LPBYTE)wFullName, dwLen, &dwWritten, + FALSE, FALSE, &lpContext); + pfnBackupWrite(handle, NULL, 0, &dwWritten, TRUE, FALSE, &lpContext); + } + + CloseHandle(handle); + return bSuccess; +} + +DllExport int +win32_link(const char *oldname, const char *newname) +{ + dTHXo; + BOOL (__stdcall *pfnCreateHardLinkW)(LPCWSTR,LPCWSTR,LPSECURITY_ATTRIBUTES); + WCHAR wOldName[MAX_PATH]; + WCHAR wNewName[MAX_PATH]; + + if (IsWin95()) + Perl_die(aTHX_ PL_no_func, "link"); + + pfnCreateHardLinkW = + (BOOL (__stdcall *)(LPCWSTR, LPCWSTR, LPSECURITY_ATTRIBUTES)) + GetProcAddress(GetModuleHandle("kernel32.dll"), "CreateHardLinkW"); + if (pfnCreateHardLinkW == NULL) + pfnCreateHardLinkW = Nt4CreateHardLinkW; + + if ((A2WHELPER(oldname, wOldName, sizeof(wOldName))) && + (A2WHELPER(newname, wNewName, sizeof(wNewName))) && + (wcscpy(wOldName, PerlDir_mapW(wOldName)), + pfnCreateHardLinkW(PerlDir_mapW(wNewName), wOldName, NULL))) + { + return 0; + } + errno = (GetLastError() == ERROR_FILE_NOT_FOUND) ? ENOENT : EINVAL; + return -1; +} + DllExport int win32_rename(const char *oname, const char *newname) { WCHAR wOldName[MAX_PATH]; WCHAR wNewName[MAX_PATH]; + char szOldName[MAX_PATH]; BOOL bResult; /* XXX despite what the documentation says about MoveFileEx(), * it doesn't work under Windows95! @@ -2169,11 +2429,13 @@ win32_rename(const char *oname, const char *newname) if (USING_WIDE()) { A2WHELPER(oname, wOldName, sizeof(wOldName)); A2WHELPER(newname, wNewName, sizeof(wNewName)); - bResult = MoveFileExW(wOldName,wNewName, + wcscpy(wOldName, PerlDir_mapW(wOldName)); + bResult = MoveFileExW(wOldName,PerlDir_mapW(wNewName), MOVEFILE_COPY_ALLOWED|MOVEFILE_REPLACE_EXISTING); } else { - bResult = MoveFileExA(oname,newname, + strcpy(szOldName, PerlDir_mapA(szOldName)); + bResult = MoveFileExA(szOldName,PerlDir_mapA(newname), MOVEFILE_COPY_ALLOWED|MOVEFILE_REPLACE_EXISTING); } if (!bResult) { @@ -2304,9 +2566,9 @@ win32_open(const char *path, int flag, ...) if (USING_WIDE()) { A2WHELPER(path, wBuffer, sizeof(wBuffer)); - return _wopen(wBuffer, flag, pmode); + return _wopen(PerlDir_mapW(wBuffer), flag, pmode); } - return open(path,flag,pmode); + return open(PerlDir_mapA(path), flag, pmode); } DllExport int @@ -2333,10 +2595,240 @@ win32_dup2(int fd1,int fd2) return dup2(fd1,fd2); } +#ifdef PERL_MSVCRT_READFIX + +#define LF 10 /* line feed */ +#define CR 13 /* carriage return */ +#define CTRLZ 26 /* ctrl-z means eof for text */ +#define FOPEN 0x01 /* file handle open */ +#define FEOFLAG 0x02 /* end of file has been encountered */ +#define FCRLF 0x04 /* CR-LF across read buffer (in text mode) */ +#define FPIPE 0x08 /* file handle refers to a pipe */ +#define FAPPEND 0x20 /* file handle opened O_APPEND */ +#define FDEV 0x40 /* file handle refers to device */ +#define FTEXT 0x80 /* file handle is in text mode */ +#define MAX_DESCRIPTOR_COUNT (64*32) /* this is the maximun that MSVCRT can handle */ + +/* + * Control structure for lowio file handles + */ +typedef struct { + long osfhnd; /* underlying OS file HANDLE */ + char osfile; /* attributes of file (e.g., open in text mode?) */ + char pipech; /* one char buffer for handles opened on pipes */ + int lockinitflag; + CRITICAL_SECTION lock; +} ioinfo; + + +/* + * Array of arrays of control structures for lowio files. + */ +EXTERN_C _CRTIMP ioinfo* __pioinfo[]; + +/* + * Definition of IOINFO_L2E, the log base 2 of the number of elements in each + * array of ioinfo structs. + */ +#define IOINFO_L2E 5 + +/* + * Definition of IOINFO_ARRAY_ELTS, the number of elements in ioinfo array + */ +#define IOINFO_ARRAY_ELTS (1 << IOINFO_L2E) + +/* + * Access macros for getting at an ioinfo struct and its fields from a + * file handle + */ +#define _pioinfo(i) (__pioinfo[(i) >> IOINFO_L2E] + ((i) & (IOINFO_ARRAY_ELTS - 1))) +#define _osfhnd(i) (_pioinfo(i)->osfhnd) +#define _osfile(i) (_pioinfo(i)->osfile) +#define _pipech(i) (_pioinfo(i)->pipech) + +int __cdecl _fixed_read(int fh, void *buf, unsigned cnt) +{ + int bytes_read; /* number of bytes read */ + char *buffer; /* buffer to read to */ + int os_read; /* bytes read on OS call */ + char *p, *q; /* pointers into buffer */ + char peekchr; /* peek-ahead character */ + ULONG filepos; /* file position after seek */ + ULONG dosretval; /* o.s. return value */ + + /* validate handle */ + if (((unsigned)fh >= (unsigned)MAX_DESCRIPTOR_COUNT) || + !(_osfile(fh) & FOPEN)) + { + /* out of range -- return error */ + errno = EBADF; + _doserrno = 0; /* not o.s. error */ + return -1; + } + + EnterCriticalSection(&(_pioinfo(fh)->lock)); /* lock file */ + + bytes_read = 0; /* nothing read yet */ + buffer = (char*)buf; + + if (cnt == 0 || (_osfile(fh) & FEOFLAG)) { + /* nothing to read or at EOF, so return 0 read */ + goto functionexit; + } + + if ((_osfile(fh) & (FPIPE|FDEV)) && _pipech(fh) != LF) { + /* a pipe/device and pipe lookahead non-empty: read the lookahead + * char */ + *buffer++ = _pipech(fh); + ++bytes_read; + --cnt; + _pipech(fh) = LF; /* mark as empty */ + } + + /* read the data */ + + if (!ReadFile((HANDLE)_osfhnd(fh), buffer, cnt, (LPDWORD)&os_read, NULL)) + { + /* ReadFile has reported an error. recognize two special cases. + * + * 1. map ERROR_ACCESS_DENIED to EBADF + * + * 2. just return 0 if ERROR_BROKEN_PIPE has occurred. it + * means the handle is a read-handle on a pipe for which + * all write-handles have been closed and all data has been + * read. */ + + if ((dosretval = GetLastError()) == ERROR_ACCESS_DENIED) { + /* wrong read/write mode should return EBADF, not EACCES */ + errno = EBADF; + _doserrno = dosretval; + bytes_read = -1; + goto functionexit; + } + else if (dosretval == ERROR_BROKEN_PIPE) { + bytes_read = 0; + goto functionexit; + } + else { + bytes_read = -1; + goto functionexit; + } + } + + bytes_read += os_read; /* update bytes read */ + + if (_osfile(fh) & FTEXT) { + /* now must translate CR-LFs to LFs in the buffer */ + + /* set CRLF flag to indicate LF at beginning of buffer */ + /* if ((os_read != 0) && (*(char *)buf == LF)) */ + /* _osfile(fh) |= FCRLF; */ + /* else */ + /* _osfile(fh) &= ~FCRLF; */ + + _osfile(fh) &= ~FCRLF; + + /* convert chars in the buffer: p is src, q is dest */ + p = q = (char*)buf; + while (p < (char *)buf + bytes_read) { + if (*p == CTRLZ) { + /* if fh is not a device, set ctrl-z flag */ + if (!(_osfile(fh) & FDEV)) + _osfile(fh) |= FEOFLAG; + break; /* stop translating */ + } + else if (*p != CR) + *q++ = *p++; + else { + /* *p is CR, so must check next char for LF */ + if (p < (char *)buf + bytes_read - 1) { + if (*(p+1) == LF) { + p += 2; + *q++ = LF; /* convert CR-LF to LF */ + } + else + *q++ = *p++; /* store char normally */ + } + else { + /* This is the hard part. We found a CR at end of + buffer. We must peek ahead to see if next char + is an LF. */ + ++p; + + dosretval = 0; + if (!ReadFile((HANDLE)_osfhnd(fh), &peekchr, 1, + (LPDWORD)&os_read, NULL)) + dosretval = GetLastError(); + + if (dosretval != 0 || os_read == 0) { + /* couldn't read ahead, store CR */ + *q++ = CR; + } + else { + /* peekchr now has the extra character -- we now + have several possibilities: + 1. disk file and char is not LF; just seek back + and copy CR + 2. disk file and char is LF; store LF, don't seek back + 3. pipe/device and char is LF; store LF. + 4. pipe/device and char isn't LF, store CR and + put char in pipe lookahead buffer. */ + if (_osfile(fh) & (FDEV|FPIPE)) { + /* non-seekable device */ + if (peekchr == LF) + *q++ = LF; + else { + *q++ = CR; + _pipech(fh) = peekchr; + } + } + else { + /* disk file */ + if (peekchr == LF) { + /* nothing read yet; must make some + progress */ + *q++ = LF; + /* turn on this flag for tell routine */ + _osfile(fh) |= FCRLF; + } + else { + HANDLE osHandle; /* o.s. handle value */ + /* seek back */ + if ((osHandle = (HANDLE)_get_osfhandle(fh)) != (HANDLE)-1) + { + if ((filepos = SetFilePointer(osHandle, -1, NULL, FILE_CURRENT)) == -1) + dosretval = GetLastError(); + } + if (peekchr != LF) + *q++ = CR; + } + } + } + } + } + } + + /* we now change bytes_read to reflect the true number of chars + in the buffer */ + bytes_read = q - (char *)buf; + } + +functionexit: + LeaveCriticalSection(&(_pioinfo(fh)->lock)); /* unlock file */ + + return bytes_read; +} + +#endif /* PERL_MSVCRT_READFIX */ + DllExport int win32_read(int fd, void *buf, unsigned int cnt) { +#ifdef PERL_MSVCRT_READFIX + return _fixed_read(fd, buf, cnt); +#else return read(fd, buf, cnt); +#endif } DllExport int @@ -2348,21 +2840,64 @@ win32_write(int fd, const void *buf, unsigned int cnt) DllExport int win32_mkdir(const char *dir, int mode) { - return mkdir(dir); /* just ignore mode */ + dTHXo; + if (USING_WIDE()) { + WCHAR wBuffer[MAX_PATH]; + A2WHELPER(dir, wBuffer, sizeof(wBuffer)); + return _wmkdir(PerlDir_mapW(wBuffer)); + } + return mkdir(PerlDir_mapA(dir)); /* just ignore mode */ } DllExport int win32_rmdir(const char *dir) { - return rmdir(dir); + dTHXo; + if (USING_WIDE()) { + WCHAR wBuffer[MAX_PATH]; + A2WHELPER(dir, wBuffer, sizeof(wBuffer)); + return _wrmdir(PerlDir_mapW(wBuffer)); + } + return rmdir(PerlDir_mapA(dir)); } DllExport int win32_chdir(const char *dir) { + dTHXo; + if (USING_WIDE()) { + WCHAR wBuffer[MAX_PATH]; + A2WHELPER(dir, wBuffer, sizeof(wBuffer)); + return _wchdir(wBuffer); + } return chdir(dir); } +DllExport int +win32_access(const char *path, int mode) +{ + dTHXo; + if (USING_WIDE()) { + WCHAR wBuffer[MAX_PATH]; + A2WHELPER(path, wBuffer, sizeof(wBuffer)); + return _waccess(PerlDir_mapW(wBuffer), mode); + } + return access(PerlDir_mapA(path), mode); +} + +DllExport int +win32_chmod(const char *path, int mode) +{ + dTHXo; + if (USING_WIDE()) { + WCHAR wBuffer[MAX_PATH]; + A2WHELPER(path, wBuffer, sizeof(wBuffer)); + return _wchmod(PerlDir_mapW(wBuffer), mode); + } + return chmod(PerlDir_mapA(path), mode); +} + + static char * create_command_line(const char* command, const char * const *args) { @@ -2495,12 +3030,28 @@ free_childenv(void* d) char* get_childdir(void) { - return NULL; + dTHXo; + char* ptr; + char szfilename[(MAX_PATH+1)*2]; + if (USING_WIDE()) { + WCHAR wfilename[MAX_PATH+1]; + GetCurrentDirectoryW(MAX_PATH+1, wfilename); + W2AHELPER(wfilename, szfilename, sizeof(szfilename)); + } + else { + GetCurrentDirectoryA(MAX_PATH+1, szfilename); + } + + New(0, ptr, strlen(szfilename)+1, char); + strcpy(ptr, szfilename); + return ptr; } void free_childdir(char* d) { + dTHXo; + Safefree(d); } @@ -2522,7 +3073,7 @@ win32_spawnvp(int mode, const char *cmdname, const char *const *argv) return spawnvp(mode, cmdname, (char * const *)argv); #else dTHXo; - DWORD ret; + int ret; void* env; char* dir; STARTUPINFO StartupInfo; @@ -2599,12 +3150,15 @@ RETRY: if (mode == P_NOWAIT) { /* asynchronous spawn -- store handle, return PID */ w32_child_handles[w32_num_children] = ProcessInformation.hProcess; - ret = w32_child_pids[w32_num_children] = ProcessInformation.dwProcessId; + w32_child_pids[w32_num_children] = ProcessInformation.dwProcessId; + ret = (int)ProcessInformation.dwProcessId; ++w32_num_children; } else { + DWORD status; WaitForSingleObject(ProcessInformation.hProcess, INFINITE); - GetExitCodeProcess(ProcessInformation.hProcess, &ret); + GetExitCodeProcess(ProcessInformation.hProcess, &status); + ret = (int)status; CloseHandle(ProcessInformation.hProcess); } @@ -2615,19 +3169,33 @@ RETVAL: PerlEnv_free_childdir(dir); Safefree(cmd); Safefree(fullcmd); - return (int)ret; + return ret; #endif } DllExport int win32_execv(const char *cmdname, const char *const *argv) { +#ifdef USE_ITHREADS + dTHXo; + /* if this is a pseudo-forked child, we just want to spawn + * the new program, and return */ + if (w32_pseudo_id) + return spawnv(P_WAIT, cmdname, (char *const *)argv); +#endif return execv(cmdname, (char *const *)argv); } DllExport int win32_execvp(const char *cmdname, const char *const *argv) { +#ifdef USE_ITHREADS + dTHXo; + /* if this is a pseudo-forked child, we just want to spawn + * the new program, and return */ + if (w32_pseudo_id) + return win32_spawnvp(P_WAIT, cmdname, (char *const *)argv); +#endif return execvp(cmdname, (char *const *)argv); } @@ -2827,44 +3395,14 @@ win32_dynaload(const char* filename) if (USING_WIDE()) { WCHAR wfilename[MAX_PATH]; A2WHELPER(filename, wfilename, sizeof(wfilename)); - hModule = LoadLibraryExW(wfilename, NULL, LOAD_WITH_ALTERED_SEARCH_PATH); + hModule = LoadLibraryExW(PerlDir_mapW(wfilename), NULL, LOAD_WITH_ALTERED_SEARCH_PATH); } else { - hModule = LoadLibraryExA(filename, NULL, LOAD_WITH_ALTERED_SEARCH_PATH); + hModule = LoadLibraryExA(PerlDir_mapA(filename), NULL, LOAD_WITH_ALTERED_SEARCH_PATH); } return hModule; } -DllExport int -win32_add_host(char *nameId, void *data) -{ - /* - * This must be called before the script is parsed, - * therefore no locking of threads is needed - */ - dTHXo; - struct host_link *link; - New(1314, link, 1, struct host_link); - link->host_data = data; - link->nameId = nameId; - link->next = w32_host_link; - w32_host_link = link; - return 1; -} - -DllExport void * -win32_get_host_data(char *nameId) -{ - dTHXo; - struct host_link *link = w32_host_link; - while(link) { - if(strEQ(link->nameId, nameId)) - return link->host_data; - link = link->next; - } - return Nullch; -} - /* * Extras. */ @@ -2873,19 +3411,19 @@ static XS(w32_GetCwd) { dXSARGS; - SV *sv = sv_newmortal(); - /* Make one call with zero size - return value is required size */ - DWORD len = GetCurrentDirectory((DWORD)0,NULL); - SvUPGRADE(sv,SVt_PV); - SvGROW(sv,len); - SvCUR(sv) = GetCurrentDirectory((DWORD) SvLEN(sv), SvPVX(sv)); + /* Make the host for current directory */ + char* ptr = PerlEnv_get_childdir(); /* - * If result != 0 + * If ptr != Nullch * then it worked, set PV valid, - * else leave it 'undef' + * else return 'undef' */ - EXTEND(SP,1); - if (SvCUR(sv)) { + if (ptr) { + SV *sv = sv_newmortal(); + sv_setpv(sv, ptr); + PerlEnv_free_childdir(ptr); + + EXTEND(SP,1); SvPOK_on(sv); ST(0) = sv; XSRETURN(1); @@ -2899,7 +3437,7 @@ XS(w32_SetCwd) dXSARGS; if (items != 1) Perl_croak(aTHX_ "usage: Win32::SetCurrentDirectory($cwd)"); - if (SetCurrentDirectory(SvPV_nolen(ST(0)))) + if (!PerlDir_chdir(SvPV_nolen(ST(0)))) XSRETURN_YES; XSRETURN_NO; @@ -2945,8 +3483,8 @@ static XS(w32_LoginName) { dXSARGS; - char *name = getlogin_buffer; - DWORD size = sizeof(getlogin_buffer); + char *name = w32_getlogin_buffer; + DWORD size = sizeof(w32_getlogin_buffer); EXTEND(SP,1); if (GetUserName(name,&size)) { /* size includes NULL */ @@ -2976,43 +3514,63 @@ static XS(w32_DomainName) { dXSARGS; -#ifndef HAS_NETWKSTAGETINFO - /* mingw32 (and Win95) don't have NetWksta*(), so do it the old way */ - char name[256]; - DWORD size = sizeof(name); + HINSTANCE hNetApi32 = LoadLibrary("netapi32.dll"); + DWORD (__stdcall *pfnNetApiBufferFree)(LPVOID Buffer); + DWORD (__stdcall *pfnNetWkstaGetInfo)(LPWSTR servername, DWORD level, + void *bufptr); + + if (hNetApi32) { + pfnNetApiBufferFree = (DWORD (__stdcall *)(void *)) + GetProcAddress(hNetApi32, "NetApiBufferFree"); + pfnNetWkstaGetInfo = (DWORD (__stdcall *)(LPWSTR, DWORD, void *)) + GetProcAddress(hNetApi32, "NetWkstaGetInfo"); + } EXTEND(SP,1); - if (GetUserName(name,&size)) { - char sid[1024]; - DWORD sidlen = sizeof(sid); + if (hNetApi32 && pfnNetWkstaGetInfo && pfnNetApiBufferFree) { + /* this way is more reliable, in case user has a local account. */ char dname[256]; DWORD dnamelen = sizeof(dname); - SID_NAME_USE snu; - if (LookupAccountName(NULL, name, (PSID)&sid, &sidlen, - dname, &dnamelen, &snu)) { - XSRETURN_PV(dname); /* all that for this */ + struct { + DWORD wki100_platform_id; + LPWSTR wki100_computername; + LPWSTR wki100_langroup; + DWORD wki100_ver_major; + DWORD wki100_ver_minor; + } *pwi; + /* NERR_Success *is* 0*/ + if (0 == pfnNetWkstaGetInfo(NULL, 100, &pwi)) { + if (pwi->wki100_langroup && *(pwi->wki100_langroup)) { + WideCharToMultiByte(CP_ACP, NULL, pwi->wki100_langroup, + -1, (LPSTR)dname, dnamelen, NULL, NULL); + } + else { + WideCharToMultiByte(CP_ACP, NULL, pwi->wki100_computername, + -1, (LPSTR)dname, dnamelen, NULL, NULL); + } + pfnNetApiBufferFree(pwi); + FreeLibrary(hNetApi32); + XSRETURN_PV(dname); } + FreeLibrary(hNetApi32); } -#else - /* this way is more reliable, in case user has a local account. - * XXX need dynamic binding of netapi32.dll symbols or this will fail on - * Win95. Probably makes more sense to move it into libwin32. */ - char dname[256]; - DWORD dnamelen = sizeof(dname); - PWKSTA_INFO_100 pwi; - EXTEND(SP,1); - if (NERR_Success == NetWkstaGetInfo(NULL, 100, (LPBYTE*)&pwi)) { - if (pwi->wki100_langroup && *(pwi->wki100_langroup)) { - WideCharToMultiByte(CP_ACP, NULL, pwi->wki100_langroup, - -1, (LPSTR)dname, dnamelen, NULL, NULL); - } - else { - WideCharToMultiByte(CP_ACP, NULL, pwi->wki100_computername, - -1, (LPSTR)dname, dnamelen, NULL, NULL); + else { + /* Win95 doesn't have NetWksta*(), so do it the old way */ + char name[256]; + DWORD size = sizeof(name); + if (hNetApi32) + FreeLibrary(hNetApi32); + if (GetUserName(name,&size)) { + char sid[ONE_K_BUFSIZE]; + DWORD sidlen = sizeof(sid); + char dname[256]; + DWORD dnamelen = sizeof(dname); + SID_NAME_USE snu; + if (LookupAccountName(NULL, name, (PSID)&sid, &sidlen, + dname, &dnamelen, &snu)) { + XSRETURN_PV(dname); /* all that for this */ + } } - NetApiBufferFree(pwi); - XSRETURN_PV(dname); } -#endif XSRETURN_UNDEF; } @@ -3041,19 +3599,34 @@ static XS(w32_GetOSVersion) { dXSARGS; - OSVERSIONINFO osver; + OSVERSIONINFOA osver; - osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFO); - if (GetVersionEx(&osver)) { + if (USING_WIDE()) { + OSVERSIONINFOW osverw; + char szCSDVersion[sizeof(osverw.szCSDVersion)]; + osverw.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW); + if (!GetVersionExW(&osverw)) { + XSRETURN_EMPTY; + } + W2AHELPER(osverw.szCSDVersion, szCSDVersion, sizeof(szCSDVersion)); + XPUSHs(newSVpvn(szCSDVersion, strlen(szCSDVersion))); + osver.dwMajorVersion = osverw.dwMajorVersion; + osver.dwMinorVersion = osverw.dwMinorVersion; + osver.dwBuildNumber = osverw.dwBuildNumber; + osver.dwPlatformId = osverw.dwPlatformId; + } + else { + osver.dwOSVersionInfoSize = sizeof(OSVERSIONINFOA); + if (!GetVersionExA(&osver)) { + XSRETURN_EMPTY; + } XPUSHs(newSVpvn(osver.szCSDVersion, strlen(osver.szCSDVersion))); - XPUSHs(newSViv(osver.dwMajorVersion)); - XPUSHs(newSViv(osver.dwMinorVersion)); - XPUSHs(newSViv(osver.dwBuildNumber)); - XPUSHs(newSViv(osver.dwPlatformId)); - PUTBACK; - return; } - XSRETURN_EMPTY; + XPUSHs(newSViv(osver.dwMajorVersion)); + XPUSHs(newSViv(osver.dwMinorVersion)); + XPUSHs(newSViv(osver.dwBuildNumber)); + XPUSHs(newSViv(osver.dwPlatformId)); + PUTBACK; } static @@ -3077,15 +3650,27 @@ XS(w32_FormatMessage) { dXSARGS; DWORD source = 0; - char msgbuf[1024]; + char msgbuf[ONE_K_BUFSIZE]; if (items != 1) Perl_croak(aTHX_ "usage: Win32::FormatMessage($errno)"); - if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, - &source, SvIV(ST(0)), 0, - msgbuf, sizeof(msgbuf)-1, NULL)) - XSRETURN_PV(msgbuf); + if (USING_WIDE()) { + WCHAR wmsgbuf[ONE_K_BUFSIZE]; + if (FormatMessageW(FORMAT_MESSAGE_FROM_SYSTEM, + &source, SvIV(ST(0)), 0, + wmsgbuf, ONE_K_BUFSIZE-1, NULL)) + { + W2AHELPER(wmsgbuf, msgbuf, sizeof(msgbuf)); + XSRETURN_PV(msgbuf); + } + } + else { + if (FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM, + &source, SvIV(ST(0)), 0, + msgbuf, sizeof(msgbuf)-1, NULL)) + XSRETURN_PV(msgbuf); + } XSRETURN_UNDEF; } @@ -3238,9 +3823,24 @@ static XS(w32_CopyFile) { dXSARGS; + BOOL bResult; if (items != 3) Perl_croak(aTHX_ "usage: Win32::CopyFile($from, $to, $overwrite)"); - if (CopyFile(SvPV_nolen(ST(0)), SvPV_nolen(ST(1)), !SvTRUE(ST(2)))) + if (USING_WIDE()) { + WCHAR wSourceFile[MAX_PATH]; + WCHAR wDestFile[MAX_PATH]; + A2WHELPER(SvPV_nolen(ST(0)), wSourceFile, sizeof(wSourceFile)); + wcscpy(wSourceFile, PerlDir_mapW(wSourceFile)); + A2WHELPER(SvPV_nolen(ST(1)), wDestFile, sizeof(wDestFile)); + bResult = CopyFileW(wSourceFile, PerlDir_mapW(wDestFile), !SvTRUE(ST(2))); + } + else { + char szSourceFile[MAX_PATH]; + strcpy(szSourceFile, PerlDir_mapA(SvPV_nolen(ST(0)))); + bResult = CopyFileA(szSourceFile, PerlDir_mapA(SvPV_nolen(ST(1))), !SvTRUE(ST(2))); + } + + if (bResult) XSRETURN_YES; XSRETURN_NO; } @@ -3257,6 +3857,12 @@ Perl_init_os_extras(void) w32_fdpid = newAV(); /* XXX needs to be in Perl_win32_init()? */ New(1313, w32_children, 1, child_tab); w32_num_children = 0; + w32_init_socktype = 0; +#ifdef USE_ITHREADS + w32_pseudo_id = 0; + New(1313, w32_pseudo_children, 1, child_tab); + w32_num_pseudo_children = 0; +#endif /* these names are Activeware compatible */ newXS("Win32::GetCwd", w32_GetCwd, file); @@ -3307,28 +3913,26 @@ Perl_win32_init(int *argcp, char ***argvp) MALLOC_INIT; } -#ifdef USE_BINMODE_SCRIPTS +#ifdef USE_ITHREADS + +# ifdef PERL_OBJECT +# undef Perl_sys_intern_dup +# define Perl_sys_intern_dup CPerlObj::Perl_sys_intern_dup +# define pPerl this +# endif void -win32_strip_return(SV *sv) -{ - char *s = SvPVX(sv); - char *e = s+SvCUR(sv); - char *d = s; - while (s < e) - { - if (*s == '\r' && s[1] == '\n') - { - *d++ = '\n'; - s += 2; - } - else - { - *d++ = *s++; - } - } - SvCUR_set(sv,d-SvPVX(sv)); +Perl_sys_intern_dup(pTHX_ struct interp_intern *src, struct interp_intern *dst) +{ + dst->perlshell_tokens = Nullch; + dst->perlshell_vec = (char**)NULL; + dst->perlshell_items = 0; + dst->fdpid = newAV(); + Newz(1313, dst->children, 1, child_tab); + Newz(1313, dst->pseudo_children, 1, child_tab); + dst->pseudo_id = 0; + dst->children->num = 0; + dst->thr_intern.Winit_socktype = src->thr_intern.Winit_socktype; } - #endif diff --git a/win32/win32.h b/win32/win32.h index 79926ac..9d56578 100644 --- a/win32/win32.h +++ b/win32/win32.h @@ -9,7 +9,11 @@ #ifndef _INC_WIN32_PERL5 #define _INC_WIN32_PERL5 -#if defined(PERL_OBJECT) || defined(PERL_CAPI) +#ifndef _WIN32_WINNT +# define _WIN32_WINNT 0x0400 /* needed for TryEnterCriticalSection() etc. */ +#endif + +#if defined(PERL_OBJECT) || defined(PERL_IMPLICIT_SYS) || defined(PERL_CAPI) # define DYNAMIC_ENV_FETCH # define ENV_HV_NAME "___ENV_HV_NAME___" # define HAS_GETENV_LEN @@ -17,7 +21,7 @@ # define WIN32IO_IS_STDIO /* don't pull in custom stdio layer */ # define WIN32SCK_IS_STDSCK /* don't pull in custom wsock layer */ # ifdef PERL_GLOBAL_STRUCT -# error PERL_GLOBAL_STRUCT cannot be defined with PERL_OBJECT +# error PERL_GLOBAL_STRUCT cannot be defined with PERL_IMPLICIT_SYS # endif # define win32_get_privlib PerlEnv_lib_path # define win32_get_sitelib PerlEnv_sitelib_path @@ -29,20 +33,10 @@ #endif #ifdef __GNUC__ -typedef long long __int64; -# define Win32_Winsock -/* GCC does not do __declspec() - render it a nop - * and turn on options to avoid importing data - */ -#ifndef __declspec -# define __declspec(x) -#endif -# ifndef PERL_OBJECT -# define PERL_GLOBAL_STRUCT -# ifndef MULTIPLICITY -# define MULTIPLICITY -# endif +# ifndef __int64 /* some versions seem to #define it already */ +# define __int64 long long # endif +# define Win32_Winsock #endif /* Define DllExport akin to perl's EXT, @@ -51,6 +45,8 @@ typedef long long __int64; * otherwise import it. */ +/* now even GCC supports __declspec() */ + #if defined(PERL_OBJECT) #define DllExport #else @@ -163,6 +159,7 @@ struct utsname { #define _access access #define _chdir chdir +#define _getpid getpid #include #ifndef DllMain @@ -185,6 +182,9 @@ struct utsname { # define MEMBER_TO_FPTR(name) &(name) #endif +/* Borland C thinks that a pointer to a member variable is 12 bytes in size. */ +#define PERL_MEMBER_PTR_SIZE 12 + #endif #ifdef _MSC_VER /* Microsoft Visual C++ */ @@ -194,45 +194,8 @@ typedef long gid_t; typedef unsigned short mode_t; #pragma warning(disable: 4018 4035 4101 4102 4244 4245 4761) -#ifndef PERL_OBJECT - /* Visual C thinks that a pointer to a member variable is 16 bytes in size. */ -#define STRUCT_MGVTBL_DEFINITION \ -struct mgvtbl { \ - union { \ - int (CPERLscope(*svt_get))(pTHX_ SV *sv, MAGIC* mg); \ - char handle_VC_problem1[16]; \ - }; \ - union { \ - int (CPERLscope(*svt_set))(pTHX_ SV *sv, MAGIC* mg); \ - char handle_VC_problem2[16]; \ - }; \ - union { \ - U32 (CPERLscope(*svt_len))(pTHX_ SV *sv, MAGIC* mg); \ - char handle_VC_problem3[16]; \ - }; \ - union { \ - int (CPERLscope(*svt_clear))(pTHX_ SV *sv, MAGIC* mg); \ - char handle_VC_problem4[16]; \ - }; \ - union { \ - int (CPERLscope(*svt_free))(pTHX_ SV *sv, MAGIC* mg); \ - char handle_VC_problem5[16]; \ - }; \ -} - -#define BASEOP_DEFINITION \ - OP* op_next; \ - OP* op_sibling; \ - OP* (CPERLscope(*op_ppaddr))(pTHX); \ - char handle_VC_problem[12]; \ - PADOFFSET op_targ; \ - OPCODE op_type; \ - U16 op_seq; \ - U8 op_flags; \ - U8 op_private; - -#endif /* PERL_OBJECT */ +#define PERL_MEMBER_PTR_SIZE 16 #endif /* _MSC_VER */ @@ -246,15 +209,12 @@ typedef long gid_t; #define flushall _flushall #define fcloseall _fcloseall -#ifdef PERL_OBJECT -# define MEMBER_TO_FPTR(name) &(name) +#ifndef CP_UTF8 +# define CP_UTF8 65001 #endif -#ifndef _O_NOINHERIT -# define _O_NOINHERIT 0x0080 -# ifndef _NO_OLDNAMES -# define O_NOINHERIT _O_NOINHERIT -# endif +#ifdef PERL_OBJECT +# define MEMBER_TO_FPTR(name) &(name) #endif #ifndef _O_NOINHERIT @@ -269,6 +229,45 @@ typedef long gid_t; /* compatibility stuff for other compilers goes here */ +#if !defined(PERL_OBJECT) && defined(PERL_MEMBER_PTR_SIZE) +# define STRUCT_MGVTBL_DEFINITION \ +struct mgvtbl { \ + union { \ + int (CPERLscope(*svt_get))(pTHX_ SV *sv, MAGIC* mg); \ + char handle_VC_problem1[PERL_MEMBER_PTR_SIZE]; \ + }; \ + union { \ + int (CPERLscope(*svt_set))(pTHX_ SV *sv, MAGIC* mg); \ + char handle_VC_problem2[PERL_MEMBER_PTR_SIZE]; \ + }; \ + union { \ + U32 (CPERLscope(*svt_len))(pTHX_ SV *sv, MAGIC* mg); \ + char handle_VC_problem3[PERL_MEMBER_PTR_SIZE]; \ + }; \ + union { \ + int (CPERLscope(*svt_clear))(pTHX_ SV *sv, MAGIC* mg); \ + char handle_VC_problem4[PERL_MEMBER_PTR_SIZE]; \ + }; \ + union { \ + int (CPERLscope(*svt_free))(pTHX_ SV *sv, MAGIC* mg); \ + char handle_VC_problem5[PERL_MEMBER_PTR_SIZE]; \ + }; \ +} + +# define BASEOP_DEFINITION \ + OP* op_next; \ + OP* op_sibling; \ + OP* (CPERLscope(*op_ppaddr))(pTHX); \ + char handle_VC_problem[PERL_MEMBER_PTR_SIZE-sizeof(OP*)]; \ + PADOFFSET op_targ; \ + OPCODE op_type; \ + U16 op_seq; \ + U8 op_flags; \ + U8 op_private; + +#endif /* !PERL_OBJECT && PERL_MEMBER_PTR_SIZE */ + + START_EXTERN_C /* For UNIX compatibility. */ @@ -331,34 +330,59 @@ typedef char * caddr_t; /* In malloc.c (core address). */ #define PERL_CORE #endif -#ifdef USE_BINMODE_SCRIPTS -#define PERL_SCRIPT_MODE "rb" -EXT void win32_strip_return(struct sv *sv); +#ifdef PERL_TEXTMODE_SCRIPTS +# define PERL_SCRIPT_MODE "r" #else -#define PERL_SCRIPT_MODE "r" -#define win32_strip_return(sv) NOOP +# define PERL_SCRIPT_MODE "rb" #endif +/* + * Now Win32 specific per-thread data stuff + */ + +struct thread_intern { + /* XXX can probably use one buffer instead of several */ + char Wstrerror_buffer[512]; + struct servent Wservent; + char Wgetlogin_buffer[128]; +# ifdef USE_SOCKETS_AS_HANDLES + int Winit_socktype; +# endif +# ifdef HAVE_DES_FCRYPT + char Wcrypt_buffer[30]; +# endif +# ifdef USE_RTL_THREAD_API + void * retv; /* slot for thread return value */ +# endif +}; + +#ifdef USE_THREADS +# ifndef USE_DECLSPEC_THREAD +# define HAVE_THREAD_INTERN +# endif /* !USE_DECLSPEC_THREAD */ +#endif /* USE_THREADS */ + #define HAVE_INTERP_INTERN typedef struct { long num; DWORD pids[MAXIMUM_WAIT_OBJECTS]; + HANDLE handles[MAXIMUM_WAIT_OBJECTS]; } child_tab; -struct host_link { - char * nameId; - void * host_data; - struct host_link * next; -}; - struct interp_intern { char * perlshell_tokens; char ** perlshell_vec; long perlshell_items; struct av * fdpid; child_tab * children; - HANDLE child_handles[MAXIMUM_WAIT_OBJECTS]; - struct host_link * hostlist; +#ifdef USE_ITHREADS + DWORD pseudo_id; + child_tab * pseudo_children; +#endif + void * internal_host; +#ifndef USE_THREADS + struct thread_intern thr_intern; +#endif }; @@ -369,34 +393,25 @@ struct interp_intern { #define w32_children (PL_sys_intern.children) #define w32_num_children (w32_children->num) #define w32_child_pids (w32_children->pids) -#define w32_child_handles (PL_sys_intern.child_handles) -#define w32_host_link (PL_sys_intern.hostlist) - -/* - * Now Win32 specific per-thread data stuff - */ - +#define w32_child_handles (w32_children->handles) +#define w32_pseudo_id (PL_sys_intern.pseudo_id) +#define w32_pseudo_children (PL_sys_intern.pseudo_children) +#define w32_num_pseudo_children (w32_pseudo_children->num) +#define w32_pseudo_child_pids (w32_pseudo_children->pids) +#define w32_pseudo_child_handles (w32_pseudo_children->handles) +#define w32_internal_host (PL_sys_intern.internal_host) #ifdef USE_THREADS -# ifndef USE_DECLSPEC_THREAD -# define HAVE_THREAD_INTERN - -struct thread_intern { - /* XXX can probably use one buffer instead of several */ - char Wstrerror_buffer[512]; - struct servent Wservent; - char Wgetlogin_buffer[128]; - char Ww32_perllib_root[MAX_PATH+1]; -# ifdef USE_SOCKETS_AS_HANDLES - int Winit_socktype; -# endif -# ifdef HAVE_DES_FCRYPT - char Wcrypt_buffer[30]; -# endif -# ifdef USE_RTL_THREAD_API - void * retv; /* slot for thread return value */ -# endif -}; -# endif /* !USE_DECLSPEC_THREAD */ +# define w32_strerror_buffer (thr->i.Wstrerror_buffer) +# define w32_getlogin_buffer (thr->i.Wgetlogin_buffer) +# define w32_crypt_buffer (thr->i.Wcrypt_buffer) +# define w32_servent (thr->i.Wservent) +# define w32_init_socktype (thr->i.Winit_socktype) +#else +# define w32_strerror_buffer (PL_sys_intern.thr_intern.Wstrerror_buffer) +# define w32_getlogin_buffer (PL_sys_intern.thr_intern.Wgetlogin_buffer) +# define w32_crypt_buffer (PL_sys_intern.thr_intern.Wcrypt_buffer) +# define w32_servent (PL_sys_intern.thr_intern.Wservent) +# define w32_init_socktype (PL_sys_intern.thr_intern.Winit_socktype) #endif /* USE_THREADS */ /* UNICODE<>ANSI translation helpers */ @@ -411,6 +426,20 @@ struct thread_intern { #define USING_WIDE() (PerlEnv_os_id() == VER_PLATFORM_WIN32_NT) +#ifdef USE_ITHREADS +# define PERL_WAIT_FOR_CHILDREN \ + STMT_START { \ + if (w32_pseudo_children && w32_num_pseudo_children) { \ + long children = w32_num_pseudo_children; \ + WaitForMultipleObjects(children, \ + w32_pseudo_child_handles, \ + TRUE, INFINITE); \ + while (children) \ + CloseHandle(w32_pseudo_child_handles[--children]); \ + } \ + } STMT_END +#endif + /* * This provides a layer of functions and macros to ensure extensions will * get to use the same RTL functions as the core. diff --git a/win32/win32iop.h b/win32/win32iop.h index 9abb05f..d7c2ac4 100644 --- a/win32/win32iop.h +++ b/win32/win32iop.h @@ -131,6 +131,8 @@ DllExport unsigned win32_alarm(unsigned int sec); DllExport int win32_stat(const char *path, struct stat *buf); DllExport char* win32_longpath(char *path); DllExport int win32_ioctl(int i, unsigned int u, char *data); +DllExport int win32_link(const char *oldname, const char *newname); +DllExport int win32_unlink(const char *f); DllExport int win32_utime(const char *f, struct utimbuf *t); DllExport int win32_uname(struct utsname *n); DllExport int win32_wait(int *status); @@ -138,10 +140,11 @@ DllExport int win32_waitpid(int pid, int *status, int flags); DllExport int win32_kill(int pid, int sig); DllExport unsigned long win32_os_id(void); DllExport void* win32_dynaload(const char*filename); +DllExport int win32_access(const char *path, int mode); +DllExport int win32_chmod(const char *path, int mode); +DllExport int win32_getpid(void); -#if defined(HAVE_DES_FCRYPT) || defined(PERL_OBJECT) DllExport char * win32_crypt(const char *txt, const char *salt); -#endif END_EXTERN_C @@ -163,6 +166,7 @@ END_EXTERN_C #undef times #undef alarm #undef ioctl +#undef unlink #undef utime #undef uname #undef wait @@ -255,6 +259,9 @@ END_EXTERN_C #define getchar win32_getchar #undef putchar #define putchar win32_putchar +#define access(p,m) win32_access(p,m) +#define chmod(p,m) win32_chmod(p,m) + #if !defined(MYMALLOC) || !defined(PERL_CORE) #undef malloc @@ -273,6 +280,8 @@ END_EXTERN_C #define times win32_times #define alarm win32_alarm #define ioctl win32_ioctl +#define link win32_link +#define unlink win32_unlink #define utime win32_utime #define uname win32_uname #define wait win32_wait @@ -286,11 +295,10 @@ END_EXTERN_C #define rewinddir win32_rewinddir #define closedir win32_closedir #define os_id win32_os_id +#define getpid win32_getpid -#ifdef HAVE_DES_FCRYPT #undef crypt -#define crypt win32_crypt -#endif +#define crypt(t,s) win32_crypt(t,s) #ifndef USE_WIN32_RTL_ENV #undef getenv diff --git a/win32/win32sck.c b/win32/win32sck.c index 49d38f3..93d501e 100644 --- a/win32/win32sck.c +++ b/win32/win32sck.c @@ -75,18 +75,6 @@ static struct servent* win32_savecopyservent(struct servent*d, struct servent*s, const char *proto); -#ifdef USE_THREADS -#ifdef USE_DECLSPEC_THREAD -__declspec(thread) struct servent myservent; -__declspec(thread) int init_socktype; -#else -#define myservent (thr->i.Wservent) -#define init_socktype (thr->i.Winit_socktype) -#endif -#else -static struct servent myservent; -#endif - static int wsock_started = 0; void @@ -117,16 +105,16 @@ set_socktype(void) #ifdef USE_SOCKETS_AS_HANDLES #ifdef USE_THREADS dTHX; - if(!init_socktype) { + if (!w32_init_socktype) { #endif - int iSockOpt = SO_SYNCHRONOUS_NONALERT; - /* - * Enable the use of sockets as filehandles - */ - setsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE, - (char *)&iSockOpt, sizeof(iSockOpt)); + int iSockOpt = SO_SYNCHRONOUS_NONALERT; + /* + * Enable the use of sockets as filehandles + */ + setsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE, + (char *)&iSockOpt, sizeof(iSockOpt)); #ifdef USE_THREADS - init_socktype = 1; + w32_init_socktype = 1; } #endif #endif /* USE_SOCKETS_AS_HANDLES */ @@ -500,7 +488,7 @@ win32_getservbyname(const char *name, const char *proto) SOCKET_TEST(r = getservbyname(name, proto), NULL); if (r) { - r = win32_savecopyservent(&myservent, r, proto); + r = win32_savecopyservent(&w32_servent, r, proto); } return r; } @@ -513,7 +501,7 @@ win32_getservbyport(int port, const char *proto) SOCKET_TEST(r = getservbyport(port, proto), NULL); if (r) { - r = win32_savecopyservent(&myservent, r, proto); + r = win32_savecopyservent(&w32_servent, r, proto); } return r; } diff --git a/win32/win32thread.c b/win32/win32thread.c index 543fc13..1bca3c3 100644 --- a/win32/win32thread.c +++ b/win32/win32thread.c @@ -92,7 +92,7 @@ Perl_thread_create(struct perl_thread *thr, thread_func_t *fn) DWORD junk; unsigned long th; - DEBUG_S(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: create OS thread\n", thr)); #ifdef USE_RTL_THREAD_API /* See comment about USE_RTL_THREAD_API in win32thread.h */ @@ -123,7 +123,7 @@ Perl_thread_create(struct perl_thread *thr, thread_func_t *fn) #else /* !USE_RTL_THREAD_API */ thr->self = CreateThread(NULL, 0, fn, (void*)thr, 0, &junk); #endif /* !USE_RTL_THREAD_API */ - DEBUG_S(PerlIO_printf(PerlIO_stderr(), + DEBUG_S(PerlIO_printf(Perl_debug_log, "%p: OS thread = %p, id=%ld\n", thr, thr->self, junk)); return thr->self ? 0 : -1; } diff --git a/win32/win32thread.h b/win32/win32thread.h index 4fa3e2f..d4f8ee4 100644 --- a/win32/win32thread.h +++ b/win32/win32thread.h @@ -1,8 +1,7 @@ #ifndef _WIN32THREAD_H #define _WIN32THREAD_H -#define WIN32_LEAN_AND_MEAN -#include +#include "win32.h" typedef struct win32_cond { LONG waiters; HANDLE sem; } perl_cond; typedef DWORD perl_key; @@ -193,7 +192,7 @@ END_EXTERN_C if ((WaitForSingleObject((t)->self,INFINITE) == WAIT_FAILED) \ || (GetExitCodeThread((t)->self,(LPDWORD)(avp)) == 0) \ || (CloseHandle((t)->self) == 0)) \ - Perl_croak(aTHX_ "panic: JOIN"); \ + Perl_croak(aTHX_ "panic: JOIN"); \ } STMT_END #endif /* !USE_RTL_THREAD_API || _MSC_VER */ diff --git a/x2p/walk.c b/x2p/walk.c index 34361ab..3344688 100644 --- a/x2p/walk.c +++ b/x2p/walk.c @@ -863,7 +863,7 @@ sub Pick {\n\ str_scat(tmp3str,tmp2str); str_cat(tmp3str,").'\"') =~ s/&/\\$&/g, "); str_set(tmp2str,"eval $s_"); - s = (*s == 'g' ? "ge" : "e"); + s = (char*)(*s == 'g' ? "ge" : "e"); i++; } type = ops[ops[node+1].ival].ival; @@ -1219,7 +1219,7 @@ sub Pick {\n\ } tmpstr = walk(1+(type==OPRINT),level,ops[node+1].ival,&numarg,P_MIN); if (!*tmpstr->str_ptr && lval_field) { - t = saw_OFS ? "$," : "' '"; + t = (char*)(saw_OFS ? "$," : "' '"); if (split_to_array) { sprintf(tokenbuf,"join(%s,@Fld)",t); str_cat(tmpstr,tokenbuf); @@ -1295,7 +1295,7 @@ sub Pick {\n\ tmpstr = str_new(0); if (!tmpstr->str_ptr || !*tmpstr->str_ptr) { if (lval_field) { - t = saw_OFS ? "$," : "' '"; + t = (char*)(saw_OFS ? "$," : "' '"); if (split_to_array) { sprintf(tokenbuf,"join(%s,@Fld)",t); str_cat(tmpstr,tokenbuf); diff --git a/xsutils.c b/xsutils.c index ea717d9..f9d5e0d 100644 --- a/xsutils.c +++ b/xsutils.c @@ -35,10 +35,6 @@ Perl_boot_core_xsutils(pTHX) newXS("attributes::bootstrap", XS_attributes_bootstrap, file); } -#ifdef PERL_OBJECT -#define NO_XSLOCKS -#endif /* PERL_OBJECT */ - #include "XSUB.h" static int -- 2.7.4