From: Larry Wall Date: Mon, 17 Oct 1994 23:00:00 +0000 (+0000) Subject: perl 5.000 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a0d0e21ea6ea90a22318550944fe6cb09ae10cda;p=p5sagit%2Fp5-mst-13.2.git perl 5.000 [editor's note: this commit combines approximate 4 months of furious releases of Andy Dougherty and Larry Wall - see pod/perlhist.pod for details. Andy notes that; Alas neither my "Irwin AccuTrack" nor my DC 600A quarter-inch cartridge backup tapes from that era seem to be readable anymore. I guess 13 years exceeds the shelf life for that backup technology :-(. ] --- diff --git a/ext/dbm/SDBM_File.c b/.dotest/last similarity index 100% rename from ext/dbm/SDBM_File.c rename to .dotest/last diff --git a/.package b/.package deleted file mode 100644 index 223efc5..0000000 --- a/.package +++ /dev/null @@ -1,16 +0,0 @@ -: basic variables -package=perl5 -baserev=5.0 -patchbranch=1 -mydiff='diff -c' -maintname='Larry Wall' -maintloc='lwall@netlabs.com' -ftpsite='' -orgname='NetLabs, Inc.' -newsgroups='comp.lang.perl' -recipients='' -ftpdir='' - -: derivative variables--do not change -revbranch="$baserev.$patchbranch" -packver='1' diff --git a/Bugs/delocalglob b/Bugs/delocalglob deleted file mode 100755 index 0a97695..0000000 --- a/Bugs/delocalglob +++ /dev/null @@ -1,8 +0,0 @@ -#!./perl -$foo = GOOD; -{ - local(*foo) = \$bar; - $bar = BAR; - print $foo; -} -print $foo; diff --git a/Bugs/localenv b/Bugs/localenv deleted file mode 100644 index 6ab1930..0000000 --- a/Bugs/localenv +++ /dev/null @@ -1,6 +0,0 @@ -{ - local(%ENV); - $ENV{OOPS} = OOPS; - system 'echo NOT $OOPS'; -} -system 'echo $OOPS'; diff --git a/Changes b/Changes index aa0fec0..ac5349f 100644 --- a/Changes +++ b/Changes @@ -47,8 +47,6 @@ New things Lexical scoping available via "my". eval can see the current lexical variables. - Saying "package;" requires explicit package name on global symbols. - The preferred package delimiter is now :: rather than '. tie/untie are now preferred to dbmopen/dbmclose. Multiple DBM @@ -58,10 +56,8 @@ New things New "and" and "or" operators work just like && and || but with a precedence lower than comma, so they work better with list operators. - New functions include: abs(), chr(), uc(), ucfirst(), lc(), lcfirst() - - require with a bare word now does an immediate require at compile time. - So "require POSIX" is equivalent to "BEGIN { require 'POSIX.pm' }". + New functions include: abs(), chr(), uc(), ucfirst(), lc(), lcfirst(), + chomp(), glob() require with a number checks to see that the version of Perl that is currently running is at least that number. @@ -86,15 +82,53 @@ New things routine, which will be called if a non-existent subroutine is called in that package. - There is now a pragma mechanism, using the keywords "aver" and "deny". - Current pragmas are "integer" and "strict". Unrecognized pragmas - are ignored. + Several previously added features have been subsumed under the new + keywords "use" and "no". Saying "use Module LIST" is short for + BEGIN { require Module; import Module LIST; } + The "no" keyword is identical except that it calls "unimport" instead. + The earlier pragma mechanism now uses this mechanism, and two new + modules have been added to the library to implement "use integer" + and variations of "use strict vars, refs, subs". + + Variables may now be interpolated literally into a pattern by prefixing + them with \Q, which works just like \U, but backwhacks non-alphanumerics + instead. There is also a corresponding quotemeta function. + + Any quantifier in a regular expression may now be followed by a ? to + indicate that the pattern is supposed to match as little as possible. + + Pattern matches may now be followed by an m or s modifier to explicitly + request multiline or singleline semantics. An s modifier makes . match + newline. + + Patterns may now contain \A to match only at the beginning of the string, + and \Z to match only at the end. These differ from ^ and $ in that + they ignore multiline semantics. In addition, \G matches where the + last interation of m//g or s///g left off. + + Non-backreference-producing parens of various sorts may now be + indicated by placing a ? directly after the opening parenthesis, + followed by a character that indicates the purpose of the parens. + An :, for instance, indicates simple grouping. (?:a|b|c) will + match any of a, b or c without producing a backreference. It does + "eat" the input. There are also assertions which do not eat the + input but do lookahead for you. (?=stuff) indicates that the next + thing must be "stuff". (?!nonsense) indicates that the next thing + must not be "nonsense". + + The negation operator now treats non-numeric strings specially. + A -"text" is turned into "-text", so that -bareword is the same + as "-bareword". If the string already begins with a + or -, it + is flipped to the other sign. Incompatibilities ----------------- @ now always interpolates an array in double-quotish strings. Some programs may now need to use backslash to protect any @ that shouldn't interpolate. + Ordinary variables starting with underscore are no longer forced into + package main. + s'$lhs'$rhs' now does no interpolation on either side. It used to interplolate $lhs but not $rhs. @@ -111,7 +145,7 @@ Incompatibilities You can't do a goto into a block that is optimized away. Darn. It is no longer syntactically legal to use whitespace as the name - of a variable. + of a variable, or as a delimiter for any kind of quote construct. Some error messages will be different. @@ -135,3 +169,13 @@ Incompatibilities The comma operator in a scalar context is now guaranteed to give a scalar context to its arguments. + + The ** operator now binds more tightly than unary minus. + + Setting $#array lower now discards array elements so that destructors + work reasonably. + + delete is not guaranteed to return the old value for tied arrays, + since this capability may be onerous for some modules to implement. + + Attempts to set $1 through $9 now result in a run-time error. diff --git a/Configure b/Configure index 38e554c..10dd65d 100755 --- a/Configure +++ b/Configure @@ -18,9 +18,9 @@ # archive site. Check with Archie if you don't know where that can be.) # -# $Id: Head.U,v 3.0.1.3 1993/12/15 08:15:07 ram Exp $ +# $Id: Head.U,v 3.0.1.5 1994/08/29 16:03:44 ram Exp $ # -# Generated on Wed May 4 14:59:36 EDT 1994 [metaconfig 3.0 PL22] +# Generated on Tue Oct 11 22:49:31 EDT 1994 [metaconfig 3.0 PL35] cat >/tmp/c1$$ </dev/null` + test "$me" || me=$0 + ;; +esac + + +: Proper PATH setting +paths='/bin /usr/bin /usr/local/bin /usr/ucb /usr/local /usr/lbin' +paths=$paths:'/usr/5bin /etc /usr/gnu/bin /usr/new /usr/new/bin /usr/nbin' +paths=$paths:'/sys5.3/bin /sys5.3/usr/bin /bsd4.3/bin /bsd4.3/usr/ucb' +paths=$paths:'/bsd4.3/usr/bin /usr/bsd /bsd43/bin /usr/ccs/bin' +paths=$paths:'/etc /usr/lib /usr/ucblib /lib /usr/ccs/lib' +paths=$paths:'/sbin /usr/sbin /usr/libexec' + +for p in $paths +do + case ":$PATH:" in + *:$p:*) ;; + *) test -d $p && PATH=$PATH:$p ;; + esac +done + +PATH=.:$PATH export PATH +: Sanity checks if test ! -t 0; then - echo "Say 'sh Configure', not 'sh /dev/null 2>&1 && \ - cat <<'EOM' -(I see you are using the Korn shell. Some ksh's blow up on Configure, + cat <extract <<'EOS' CONFIG=true echo "Doing variable substitutions on .SH files..." if test -f MANIFEST; then - set x `awk '{print $1}' options.awk <<'EOF' BEGIN { - optstr = "deEf:hrsSV"; # getopt-style specification + optstr = "deEf:hrsSD:U:V"; # getopt-style specification len = length(optstr); for (i = 1; i <= len; i++) { @@ -521,6 +622,7 @@ alldone='' error='' silent='' extractsh='' +optdef='optdef.sh' : option parsing while test $# -gt 0; do @@ -533,7 +635,7 @@ while test $# -gt 0; do if test -r "$1"; then config_sh="$1" else - echo "Configure: cannot read config file $1." >&2 + echo "$me: cannot read config file $1." >&2 error=true fi cd UU @@ -543,10 +645,34 @@ while test $# -gt 0; do -s) shift; silent=true;; -E) shift; alldone=exit;; -S) shift; extractsh=true;; - -V) echo "Configure generated by metaconfig 3.0 PL22." >&2 + -D) + shift + case "$1" in + *=) + echo "$me: use '-U symbol=', not '-D symbol='." >&2 + echo "$me: ignoring -D $1" >&2 + ;; + *=*) echo "$1" >> $optdef;; + *) echo "$1='define'" >> $optdef;; + esac + shift + ;; + -U) + shift + case "$1" in + *=) echo "$1" >> $optdef;; + *=*) + echo "$me: use '-D symbol=val', not '-U symbol=val'." >&2 + echo "$me: ignoring -U $1" >&2 + ;; + *) echo "$1='undef'" >> $optdef;; + esac + shift + ;; + -V) echo "$me generated by metaconfig 3.0 PL35." >&2 exit 0;; --) break;; - -*) echo "Configure: unknown option $1" >&2; shift; error=true;; + -*) echo "$me: unknown option $1" >&2; shift; error=true;; *) break;; esac done @@ -554,15 +680,22 @@ done case "$error" in true) cat >&2 </dev/null;; esac +: run the defines and the undefines, if any +touch $optdef +. ./$optdef +rm -f $optdef + case "$extractsh" in true) case "$config_sh" in @@ -618,48 +756,103 @@ if test -f /etc/unixtovms.exe; then fi : list of known cpp symbols -attrlist="__alpha __bsdi__ BSD_NET2 DGUX M_I186 M_I286 M_I386" -attrlist="$attrlist M_I8086 M_XENIX UTS __DGUX__" -attrlist="$attrlist _AIX __STDC__ __m88k__ ansi bsd4_2 gcos gimpel" -attrlist="$attrlist hp9000s300 hp9000s400 hp9000s500 hp9000s700" -attrlist="$attrlist hp9000s800 hpux" -attrlist="$attrlist i186 i386 i486 i8086 iAPX286 ibm interdata" -attrlist="$attrlist m88k mc300 mc500 mc68000 mc68k mc700 mert" -attrlist="$attrlist mips NeXT ns16000 ns32000 nsc32000 os" -attrlist="$attrlist __osf__ pdp11 posix" -attrlist="$attrlist pyr sinix sony sparc sun tower tower32 tower32_600" -attrlist="$attrlist tower32_800 tss u3b2 u3b20 u3b200 u3b5 ultrix unix" -attrlist="$attrlist __unix__ vax venix xenix z8000" +al="AMIX BIT_MSF BSD BSD4_3 BSD_NET2 CRAY DGUX DOLPHIN DPX2" +al="$al GO32 HP700 I386 I80960 I960 Lynx M68000 M68K MACH" +al="$al MIPSEB MIPSEL MSDOS MTXINU MVS" +al="$al M_COFF M_I186 M_I286 M_I386 M_I8086 M_I86 M_I86SM" +al="$al M_SYS3 M_SYS5 M_SYSIII M_SYSV M_UNIX M_XENIX" +al="$al NeXT OCS88 OSF1 PARISC PC532 PORTAR POSIX" +al="$al PWB R3000 SVR3 SVR4" +al="$al SYSTYPE_BSD SYSTYPE_SVR4 SYSTYPE_SYSV" +al="$al UTEK UTS UTek UnicomPBB UnicomPBD Utek VMS" +al="$al _AIX _AIX32 _AM29000 _COFF _CRAY _EPI _IBMR2" +al="$al _MIPSEB _MIPSEL _M_COFF _M_I86 _M_I86SM _M_SYS3" +al="$al _M_SYS5 _M_SYSIII _M_SYSV _M_UNIX _M_XENIX _R3000" +al="$al _SYSTYPE_BSD _SYSTYPE_BSD43 _SYSTYPE_SVR4" +al="$al _SYSTYPE_SYSV _SYSV3 _UNICOS" +al="$al __386BSD__ __BIG_ENDIAN __BIG_ENDIAN__ __BSD_4_4__" +al="$al __DGUX__ __DPX2__ __H3050R __H3050RX" +al="$al __LITTLE_ENDIAN __LITTLE_ENDIAN__ __MACH__" +al="$al __MIPSEB __MIPSEB__ __MIPSEL __MIPSEL__" +al="$al __Next__ __OSF1__ __PARAGON__ __PWB __STDC__" +al="$al ____386BSD____ __alpha __alpha__ __amiga" +al="$al __bsd4_2 __bsd4_2__ __bsdi__ __convex__" +al="$al __host_mips__" +al="$al __hp9000s200 __hp9000s300 __hp9000s400 __hp9000s500" +al="$al __hp9000s500 __hp9000s700 __hp9000s800" +al="$al __hppa __hpux __i286 __i286__ __i386 __i386__" +al="$al __i486 __i486__ __i860 __i860__" +al="$al __m68k __m68k__ __m88100__ __m88k __m88k__" +al="$al __mc68000 __mc68000__ __mc68020 __mc68020__" +al="$al __mc68030 __mc68030__ __mc68040 __mc68040__" +al="$al __mc88100 __mc88100__ __mips __mips__" +al="$al __motorola__ __osf__ __pa_risc __sparc__ __stdc__" +al="$al __sun __sun__ __svr3__ __svr4__ __ultrix __ultrix__" +al="$al __unix __unix__ __vax __vax__" +al="$al _host_mips _mips _unix" +al="$al a29k aegis alliant am29000 amiga ansi" +al="$al bsd bsd43 bsd4_2 bsd4_3 bsd4_4 bull" +al="$al convex cray ctix encore gcos gimpel" +al="$al hcx host_mips hp200 hp300 hp700 hp800" +al="$al hp9000 hp9000s300 hp9000s400 hp9000s500" +al="$al hp9000s700 hp9000s800 hp9k8 hpux" +al="$al i186 i286 i386 i486 i8086" +al="$al i80960 i860 iAPX286 ibm interdata is68k" +al="$al linux luna luna88k m68k m88100 m88k" +al="$al mc300 mc500 mc68000 mc68010 mc68020 mc68030" +al="$al mc68040 mc68060 mc68k mc68k32 mc700" +al="$al mc88000 mc88100 merlin mert mips mvs n16" +al="$al ncl_el ncl_mr" +al="$al news1500 news1700 news1800 news1900 news3700" +al="$al news700 news800 news900 ns16000 ns32000" +al="$al ns32016 ns32332 ns32k nsc32000 os osf" +al="$al parisc pc532 pdp11 plexus posix pyr" +al="$al riscix riscos sequent sgi sinix sony sony_news" +al="$al sonyrisc sparc sparclite spectrum stratos" +al="$al sun sun3 sun386 svr4 sysV68 sysV88" +al="$al tower tower32 tower32_200 tower32_600 tower32_700" +al="$al tower32_800 tower32_850 tss u3b u3b2 u3b20 u3b200" +al="$al u3b5 ultrix unix unixpc unos vax venix vms" +al="$al xenix z8000" i_whoami='' -: List of extensions we want: -extensions='' -gccversion='' -: no include file wanted by default -inclwanted='' - -: File to use for dynamic loading -usedl='' -gidtype='' -groupstype='' : change the next line if compiling for Xenix/286 on Xenix/386 xlibpth='/usr/lib/386 /lib/386' : general looking path for locating libraries -libpth="/usr/lib/large /lib /usr/lib $xlibpth /lib/large" -libpth="$libpth /usr/lib/small /lib/small" -libpth="$libpth /usr/ccs/lib /usr/ucblib /usr/local/lib" +glibpth="/lib/pa1.1 /usr/lib/large /lib /usr/lib $xlibpth" +glibpth="$glibpth /lib/large /usr/lib/small /lib/small" +glibpth="$glibpth /usr/ccs/lib /usr/ucblib /usr/local/lib /usr/shlib" : Private path used by Configure to find libraries. Its value -: is prepend to libpth. This variable takes care of special +: is prepended to libpth. This variable takes care of special : machines, like the mips. Usually, it should be empty. plibpth='' -libswanted=" net socket inet nsl nm sdbm gdbm ndbm dbm malloc dl dld sun m c_s posix cposix ndir dir ucb bsd BSD PW x " - : full support for void wanted by default defvoidused=15 +: set useposix=false in your hint file to disable the POSIX extension. +useposix=true +gccversion='' +: no include file wanted by default +inclwanted='' + +groupstype='' +: default library list +libswanted='' +: List of libraries we want. +libswanted='net socket inet nsl nm ndbm gdbm dbm db malloc dl' +libswanted="$libswanted dld ld sun m c cposix posix ndir dir crypt" +libswanted="$libswanted ucb bsd BSD PW x" +: We want to search /usr/shlib before most other libraries. +: This is only used by ext/util/extliblist +glibpth=`echo " $glibpth " | sed -e 's! /usr/shlib ! !'` +glibpth="/usr/shlib $glibpth" +: Do not use vfork unless overridden by a hint file. +usevfork=false +: We can look for titanos too. +al="$al ardent titan" : Some greps do not return status, grrr. echo "grimblepritz" >grimble @@ -861,7 +1054,7 @@ if $needman; then cat </dev/null 2>&1 ; then spitshell=cat echo " " echo "Okay, let's see if #! works on this system..." - echo "#!/bin/cat" >try + xcat=/bin/cat + test -r $xcat || xcat=/usr/bin/cat + echo "#!$xcat" >try $eunicefix try chmod +x try ./try > today @@ -937,7 +1132,7 @@ if sh -c '#' >/dev/null 2>&1 ; then echo "It does." sharpbang='#!' else - echo "#! /bin/cat" > try + echo "#! $xcat" > try $eunicefix try chmod +x try ./try > today @@ -952,10 +1147,12 @@ if sh -c '#' >/dev/null 2>&1 ; then else echo "Your sh doesn't grok # comments--I will strip them later on." shsharp=false + cd .. echo "exec grep -v '^[ ]*#'" >spitshell chmod +x spitshell $eunicefix spitshell spitshell=`pwd`/spitshell + cd UU echo "I presume that if # doesn't work, #! won't work either!" sharpbang=': use ' fi @@ -1005,8 +1202,11 @@ for dir in \$*; do fi ;; *) - if test -f \$dir/\$thing; then - echo \$dir/\$thing + for thisthing in \$dir/\$thing; do + : Just loop through to pick last element + done + if test -f \$thisthing; then + echo \$thisthing exit 0 elif test -f \$dir/\$thing.exe; then : on Eunice apparently @@ -1027,10 +1227,11 @@ cat cp echo expr +find grep ln +ls mkdir -mv rm sed sort @@ -1046,7 +1247,6 @@ cpp csh date egrep -find line nroff perl @@ -1134,16 +1334,26 @@ FOO ;; esac +: determine whether symbolic links are supported +echo " " +$touch blurfl +if $ln -s blurfl sym > /dev/null 2>&1 ; then + echo "Symbolic links are supported." >&4 + lns="$ln -s" +else + echo "Symbolic links are NOT supported." >&4 + lns="$ln" +fi +$rm -f blurfl sym + : Try to determine whether config.sh was made on this system case "$config_sh" in '') myuname=`( ($uname -a) 2>/dev/null || hostname) 2>&1` -myuname=`echo $myuname | $sed -e 's/^[^=]*=//' | \ +myuname=`echo $myuname | $sed -e 's/^[^=]*=//' -e 's/\///g' | \ tr '[A-Z]' '[a-z]' | tr '\012' ' '` dflt=n -if test "$fastread" = yes; then - dflt=y -elif test -f ../config.sh; then +if test -f ../config.sh; then oldmyuname='' if $contains myuname= ../config.sh >/dev/null 2>&1; then eval "old`grep myuname= ../config.sh`" @@ -1185,19 +1395,20 @@ EOM : Half the following guesses are probably wrong... If you have better : tests or hints, please send them to lwall@netlabs.com : The metaconfig authors would also appreciate a copy... - $test -f /irix && osname=sgi + $test -f /irix && osname=irix $test -f /xenix && osname=sco_xenix $test -f /dynix && osname=dynix $test -f /dnix && osname=dnix + $test -f /unicos && osname=unicos && osvers=`$uname -r` $test -f /bin/mips && /bin/mips && osname=mips - $test -d /NextApps && test -f /usr/adm/software_version && osname=next + $test -d /NextApps && set X `hostinfo | grep 'NeXT Mach.*:' | sed -e 's/://' -e 's/\./_/'` && osname=next && osvers=$4 + $test -d /usr/apollo/bin && osname=apollo + $test -f /etc/saf/_sactab && osname=svr4 $test -d /usr/include/minix && osname=minix if $test -f $uname; then set X $myuname shift - $test -f $5.sh && dflt="$dflt $5" - case "$5" in fps*) osname=fps ;; mips*) @@ -1210,35 +1421,86 @@ EOM news*) osname=news ;; i386*) if $test -f /etc/kconfig; then osname=isc - if $contains _SYSV3 /usr/include/stdio.h > /dev/null 2>&1 ; then - osvers=3.2.3 + if test "$lns" = "ln -s"; then + osvers=4 + elif $contains _SYSV3 /usr/include/stdio.h > /dev/null 2>&1 ; then + osvers=3 elif $contains _POSIX_SOURCE /usr/include/stdio.h > /dev/null 2>&1 ; then - osvers=3.2.2 + osvers=2 fi fi ;; esac case "$1" in - aix) osname=aix_rs ;; + aix) osname=aix + tmp=`( (oslevel) 2>/dev/null || echo "not found") 2>&1` + case "$tmp" in + 'not found') osvers=3.2.0 ;; + '<3240'|'<>3240') osvers=3.2.0 ;; + '=3240'|'>3240'|'<3250'|'<>3250') osvers=3.2.4 ;; + '=3250'|'>3250') osvers=3.2.5 ;; + *) osvers='' ;; + esac + ;; + dnix) osname=dnix + osvers="$3" + ;; + domainos) osname=apollo + osvers="$3" + ;; + dgux) osname=dgux + osvers="$3" + ;; + freebsd) osname=freebsd + osvers="$3" ;; + genix) osname=genix ;; + hp*) osname=hpux + case "$3" in + *.08.*) osvers=9 ;; + *.09.*) osvers=9 ;; + *.10.*) osvers=10 ;; + esac + ;; + irix) osname=irix + case "$3" in + 4*) osvers=4 ;; + 5*) osvers=5 ;; + esac + ;; + linux) osname=linux + case "$3" in + 1*) osvers=1 ;; + *) osvers="$3" ;; + esac + ;; + netbsd*) osname=netbsd + osvers="$3" + ;; + bsd386) osname=bsd386 + osvers=`$uname -r` + ;; + next*) osname=next ;; + solaris) osname=solaris + case "$3" in + 5*) osvers=`echo $3 | $sed 's/^5/2/g'` ;; + esac + ;; sunos) osname=sunos case "$3" in - [34]*) osvers=$3 ;; 5*) osname=solaris osvers=`echo $3 | $sed 's/^5/2/g'` ;; + *) osvers="$3" ;; esac ;; - solaris) osname=solaris + titanos) osname=titanos case "$3" in - 5*) osvers=`echo $3 | $sed 's/^5/2/g'` ;; + 1*) osvers=1 ;; + 2*) osvers=2 ;; + 3*) osvers=3 ;; + 4*) osvers=4 ;; esac ;; - dnix) osname=dnix ;; - dgux) osname=dgux ;; - genix) osname=genix ;; - hp*ux) osname=hpux ;; - next) osname=next ;; - irix) osname=sgi ;; ultrix) osname=ultrix case "$3" in 1*) osvers=1 ;; @@ -1257,16 +1519,41 @@ EOM ;; hp*) osname=hp_osf1 ;; # TR mips) osname=mips_osf1 ;; # TR - # TR = Technology Releases: (un^N)supported + # TR = Technology Releases: unsupported esac ;; - uts) osname=uts ;; + uts) osname=uts + osvers="$3" + ;; $2) case "$osname" in *isc*) ;; + *freebsd*) ;; + svr*) + : svr4.x or possibly later + case "svr$3" in + ${osname}*) + osname=svr$3 + osvers=$4 + ;; + esac + case "$osname" in + svr4.0) + : Check for ESIX + if test -f /stand/boot ; then + eval `grep '^INITPROG=[a-z/0-9]*$' /stand/boot` + if test -n $INITPROG -a -f $INITPROG; then + isesix=`strings -a $INITPROG|grep 'ESIX SYSTEM V/386 Release 4.0'` + if test -n $isesix; then + osname=esix4 + fi + fi + fi + ;; + esac + ;; *) if test -f /etc/systemid; then - osname=sco - : Does anyone know if these next gyrations are needed - set `echo $3 | $sed 's/\./ /g'` $4 + osname=sco + set `echo $3 | $sed 's/\./ /g'` $4 if $test -f sco_$1_$2_$3.sh; then osvers=$1.$2.$3 elif $test -f sco_$1_$2.sh; then @@ -1274,10 +1561,24 @@ EOM elif $test -f sco_$1.sh; then osvers=$1 fi + else + case "$osname" in + '') : Still unknown. Probably a generic Sys V. + osname="sysv" + osvers="$3" + ;; + esac fi ;; esac ;; + *) case "$osname" in + '') : Still unknown. Probably a generic BSD. + osname="$1" + osvers="$3" + ;; + esac + ;; esac else if test -f /vmunix -a -f news_os.sh; then @@ -1289,23 +1590,44 @@ EOM fi fi - : Now look for a hint file osname_osvers - file=`echo "${osname}_${osvers}" | sed -e 's@\.@_@g' -e 's@_$@@'` - case "$file" in - '') dflt=none ;; - *) case "$osvers" in - '') dflt=$file - ;; - *) if $test -f $file.sh ; then - dflt=$file - elif $test -f "${osname}.sh" ; then - dflt="${osname}" - else - dflt=none - fi + : Now look for a hint file osname_osvers, unless one has been + : specified already. + case "$hintfile" in + ''|' ') + file=`echo "${osname}_${osvers}" | sed -e 's@\.@_@g' -e 's@_$@@'` + : Also try without trailing minor version numbers. + xfile=`echo $file | sed -e 's@_[^_]*$@@'` + xxfile=`echo $xfile | sed -e 's@_[^_]*$@@'` + xxxfile=`echo $xxfile | sed -e 's@_[^_]*$@@'` + xxxxfile=`echo $xxxfile | sed -e 's@_[^_]*$@@'` + case "$file" in + '') dflt=none ;; + *) case "$osvers" in + '') dflt=$file + ;; + *) if $test -f $file.sh ; then + dflt=$file + elif $test -f $xfile.sh ; then + dflt=$xfile + elif $test -f $xxfile.sh ; then + dflt=$xxfile + elif $test -f $xxxfile.sh ; then + dflt=$xxxfile + elif $test -f $xxxxfile.sh ; then + dflt=$xxxxfile + elif $test -f "${osname}.sh" ; then + dflt="${osname}" + else + dflt=none + fi + ;; + esac ;; esac ;; + *) + dflt=`echo $hintfile | sed 's/\.sh$//'` + ;; esac $cat <&1` -cf_by=`( (logname) 2>/dev/null || whoami) 2>&1` +(logname > .temp) >/dev/null 2>&1 +$test -s .temp || (whoami > .temp) >/dev/null 2>&1 +$test -s .temp || echo unknown > .temp +cf_by=`$cat .temp` +$rm -f .temp : determine where manual pages are on this system echo " " case "$sysman" in '') - syspath='/usr/man/man1 /usr/man/man1 /usr/man/mann' - syspath="$syspath /usr/man/manl /usr/man/local/man1" + syspath='/usr/man/man1 /usr/man/mann /usr/man/manl /usr/man/local/man1' syspath="$syspath /usr/man/u_man/man1 /usr/share/man/man1" syspath="$syspath /usr/catman/u_man/man1 /usr/man/l_man/man1" syspath="$syspath /usr/local/man/u_man/man1 /usr/local/man/l_man/man1" - syspath="$syspath /usr/man/man.L /local/man/man1" - sysman=`./loc . $syspath` + syspath="$syspath /usr/man/man.L /local/man/man1 /usr/local/man/man1" + sysman=`./loc . /usr/man/man1 $syspath` ;; esac if $test -d "$sysman"; then @@ -1698,45 +2008,34 @@ else . ./myread cc="$ans" fi -case "$cc" in -gcc*) echo "Checking out which version of gcc" +echo "Checking if you are using GNU cc ..." >&4 $cat >gccvers.c < -int main() -{ -char *v; -v = "unknown"; -#ifdef __GNUC__ -# ifdef __VERSION__ - v = __VERSION__; -# endif -#endif -switch((int) v[0]) - { - case '1': printf("1\n"); break; - case '2': printf("2\n"); break; - case '3': printf("3\n"); break; - default: break; - } +int main() { #ifdef __GNUC__ -return 0; +#ifdef __VERSION__ +printf("%s\n", __VERSION__); #else -return 1; +printf("%s\n", "1"); #endif +#endif +return 0; } EOM - if $cc -o gccvers gccvers.c >/dev/null 2>&1; then - gccversion=`./gccvers` - echo "You appear to have version $gccversion." - else - echo "Doesn't appear to be GNU cc." - fi - $rm -f gccvers* - if $test "$gccversion" = '1'; then - cpp=`./loc gcc-cpp $cpp $pth` - fi - ;; +if $cc -o gccvers gccvers.c >/dev/null 2>&1; then + gccversion=`./gccvers` + case "$gccversion" in + '') echo "You are not using GNU cc." ;; + *) echo "You are using GNU cc $gccversion." ;; + esac +else + echo "I can't compile the test program. I'll assume it's not GNU cc." +fi +$rm -f gccvers* +case "$gccversion" in +1*) cpp=`./loc gcc-cpp $cpp $pth` ;; esac + : decide how portable to be case "$d_portable" in "$define") dflt=y;; @@ -1776,7 +2075,7 @@ case "\$1" in ~*) if $test -f /bin/csh; then /bin/csh -f -c "glob \$1" - failed=$? + failed=\$? echo "" exit \$failed else @@ -1813,10 +2112,18 @@ already='' skip='' none_ok='' exp_file='' +nopath_ok='' orig_rp="$rp" orig_dflt="$dflt" case "$fn" in +*:*) + loc_file=`expr $fn : '.*:\(.*\)'` + fn=`expr $fn : '\(.*\):.*'` + ;; +esac + +case "$fn" in *~*) tilde=true;; esac case "$fn" in @@ -1831,11 +2138,14 @@ esac case "$fn" in *e*) exp_file=true;; esac +case "$fn" in +*p*) nopath_ok=true;; +esac case "$fn" in *f*) type='File';; *d*) type='Directory';; -*l*) type='Locate'; fn=`expr $fn : '.*:\(.*\)'`;; +*l*) type='Locate';; esac what="$type" @@ -1932,12 +2242,21 @@ while test "$type"; do ;; Locate) if test -d "$value"; then - echo "(Looking for $fn in directory $value.)" - value="$value/$fn" + echo "(Looking for $loc_file in directory $value.)" + value="$value/$loc_file" fi if test -f "$value"; then type='' fi + case "$nopath_ok" in + true) case "$value" in + */*) ;; + *) echo "Assuming $value will be in people's path." + type='' + ;; + esac + ;; + esac ;; esac @@ -1976,10 +2295,7 @@ EOSC : What should the include directory be ? echo " " $echo $n "Hmm... $c" -case "$usrinc" in -'') dflt='/usr/include';; -*) dflt=$usrinc;; -esac +dflt='/usr/include' incpath='' mips_type='' if $test -f /bin/mips && /bin/mips; then @@ -2005,94 +2321,235 @@ else $eunicefix mips fi echo " " +case "$usrinc" in +'') ;; +*) dflt="$usrinc";; +esac fn=d/ rp='Where are the include files you want to use?' . ./getfile usrinc="$ans" -: determine optimize, if desired, or use for debug flag also -case "$optimize" in -' ') dflt="none";; -'') dflt="-g";; -*) dflt="$optimize";; -esac -$cat <&4 +cat <<'EOT' >testcpp.c +#define ABC abc +#define XYZ xyz +ABC.XYZ +EOT +cd .. +echo 'cat >.$$.c; '"$cc"' -E ${1+"$@"} .$$.c; rm .$$.c' >cppstdin +chmod 755 cppstdin +wrapper=`pwd`/cppstdin +ok='false' +cd UU -dflt='' -case "$ccflags" in -'') case "$cc" in - *gcc*) if $test "$gccversion" = "1"; then - dflt='-fpcc-struct-return' - fi ;; - esac - case "$optimize" in - *-g*) dflt="$dflt -DDEBUGGING";; - esac - case "$cc" in - *gcc*) if test -d /etc/conf/kconfig.d && - $contains _POSIX_VERSION $usrinc/sys/unistd.h >/dev/null 2>&1 +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 then - dflt="$dflt -posix" + 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 - ;; -esac - -case "$mips_type" in -*BSD*) ;; -'') ;; -*) inclwanted="$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 -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' - -if ./osf1; then - set signal.h __LANGUAGE_C__; eval $inctest else - set signal.h LANGUAGE_C; eval $inctest + case "$cppstdin" in + '') ;; + *) + echo "Good old $cppstdin $cppminus does not seem to be of any help..." + ;; + esac fi -set signal.h NO_PROTOTYPE; eval $inctest -set signal.h _NO_PROTO; eval $inctest -case "$dflt" in -'') dflt=none;; +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 + else +echo "Sorry, I can't get that to work. Go find one and rerun Configure." >&4 + exit 1 + fi +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 + ;; + esac + case "$cpprun" in + "$wrapper") + cpprun='' + cpplast='' + ;; + esac + ;; +esac + +case "$cppstdin" in +"$wrapper") ;; +*) $rm -f $wrapper;; +esac +$rm -f testcpp.c testcpp.out + +: determine optimize, if desired, or use for debug flag also +case "$optimize" in +' ') dflt='none';; +'') dflt='-O';; +*) dflt="$optimize";; +esac +$cat </dev/null 2>&1 + then + dflt="$dflt -posix" + fi + ;; + esac + ;; +esac + +case "$mips_type" in +*BSD*) ;; +'') ;; +*) inclwanted="$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 +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' + +if ./osf1; then + set signal.h __LANGUAGE_C__; eval $inctest +else + set signal.h LANGUAGE_C; eval $inctest +fi +set signal.h NO_PROTOTYPE; eval $inctest +set signal.h _NO_PROTO; eval $inctest + +case "$dflt" in +'') dflt=none;; esac case "$ccflags" in '') ;; @@ -2104,10 +2561,11 @@ Your C compiler may want other flags. For this question you should include -I/whatever and -DWHATEVER flags and any other flags used by the C compiler, but you should NOT include libraries or ld flags like -lwhatever. If you want $package to honor its debug switch, you should include -DDEBUGGING here. +Your C compiler might also need additional flags, such as -D_POSIX_SOURCE, +-DHIDEMYMALLOC or -DCRIPPLED_CC. + To use no flags, specify the word "none". -Your C compiler might also need additional flags, such as -DJMPCLOBBER, --DHIDEMYMALLOC or -DCRIPPLED_CC. EOH set X $dflt shift @@ -2121,11 +2579,8 @@ esac : the following weeds options from ccflags that are of no interest to cpp cppflags="$ccflags" -case "$cc" in -*gcc*) case "$gccversion" in - 1) cppflags="$cppflags -D__GNUC__" ;; - esac - ;; +case "$gccversion" in +1*) cppflags="$cppflags -D__GNUC__" esac case "$mips_type" in '');; @@ -2133,17 +2588,44 @@ case "$mips_type" in esac case "$cppflags" in '');; -*) set X $cppflags +*) + echo " " + echo "Let me guess what the preprocessor flags are..." >&4 + set X $cppflags + shift cppflags='' - for flag + $cat >cpp.c <<'EOM' +#define BLURFL foo + +BLURFL xx LFRULB +EOM + previous='' + for flag in $* do - case $flag in - -D*|-I*|-traditional|-ansi|-nostdinc|-posix|-Xp) cppflags="$cppflags $flag";; + case "$flag" in + -*) ftry="$flag";; + *) ftry="$previous $flag";; esac + if $cppstdin -DLFRULB=bar $ftry $cppminus cpp1.out 2>/dev/null && \ + $cpprun -DLFRULB=bar $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 "(C preprocessor flags: $cppflags)";; + *-*) echo "They appear to be: $cppflags";; esac + $rm -f cpp.c cpp?.out ;; esac @@ -2152,8 +2634,14 @@ case "$ldflags" in '') if venix; then dflt='-i -z' else - dflt='none' + dflt='' fi + case "$ccflags" in + *-posix*) dflt="$dflt -posix" ;; + esac + case "$dflt" in + '') dflt='none' ;; + esac ;; *) dflt="$ldflags";; esac @@ -2166,41 +2654,72 @@ none) ldflags='';; esac rmlist="$rmlist pdp11" -: Initialize h_fcntl -h_fcntl=false - -: Initialize h_sysfile -h_sysfile=false - : Set private lib path case "$plibpth" in '') if mips; then plibpth="$incpath/usr/lib /usr/local/lib /usr/ccs/lib" fi;; esac -libpth="$plibpth $libpth" -: Now check and see which directories actually exist. -xxx='' -for yyy in $libpth +case "$libpth" in +' ') dlist='';; +'') dlist="$plibpth $glibpth";; +*) dlist="$libpth";; +esac + +: Now check and see which directories actually exist, avoiding duplicates +libpth='' +for xxx in $dlist do - if $test -d $yyy; then - xxx="$xxx $yyy" + if $test -d $xxx; then + case " $libpth " in + *" $xxx "*) ;; + *) libpth="$libpth $xxx";; + esac fi done -libpth="$xxx" -$cat <&4 @@ -2212,50 +2731,39 @@ case "$libswanted" in '') libswanted='c_s';; esac for thislib in $libswanted; do - case "$thislib" in - dbm) thatlib=ndbm;; - *_s) thatlib=NONE;; - *) thatlib=${thislib}_s;; - esac - xxx=`./loc lib$thislib.a X $libpth` - yyy=`./loc lib$thatlib.a X $libpth` - zzz=`./loc lib$thislib.so.[0-9]'*' X $libpth` - if $test -f $xxx; then + + if xxx=`./loc lib$thislib.$so.[0-9]'*' 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.$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 "*|*-l$thislib|*"-l$thatlib "*|*-l$thatlib) ;; + case " $dflt " in + *"-l$thislib "*);; *) dflt="$dflt -l$thislib";; esac - elif $test -f $yyy; then - echo "Found -l$thatlib." - case "$dflt" in - *"-l$thatlib "*|*-l$thatlib) ;; - *) dflt="$dflt -l$thatlib";; + 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 $test -f $zzz; then - echo "Found -$thislib." - case "$dflt" in - *"-l$thislib "*|*-l$thislib) ;; + 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 - xxx=`./loc Slib$thislib.a X $xlibpth` - yyy=`./loc Slib$thatlib.a X $xlibpth` - if $test -f $xxx; then - echo "Found -l$thislib." - case "$dflt" in - *"-l$thislib "*|*-l$thislib|*"-l$thatlib "*|*-l$thatlib) ;; - *) dflt="$dflt -l$thislib";; - esac - elif $test -f $yyy; then - echo "Found -l$thatlib." - case "$dflt" in - *"-l$thatlib "*|*-l$thatlib) ;; - *) dflt="$dflt -l$thatlib";; - esac - else - echo "No -l$thislib." - fi + echo "No -l$thislib." fi done set X $dflt @@ -2353,29 +2861,30 @@ case "$libc" in esac ;; esac -libpth="$plibpth $libpth" libnames=''; case "$libs" in '') ;; *) for thislib in $libs; do case "$thislib" in + -lc|-lc_s) + : Handle C library specially below. + ;; -l*) - thislib=`expr X$thislib : 'X-l\(.*\)'` - try=`./loc lib$thislib.a blurfl/dyick $libpth` - if test ! -f $try; then - try=`./loc lib$thislib blurfl/dyick $libpth` - if test ! -f $try; then - try=`./loc lib$thislib.so.'*' blurfl/dyick $libpth` - if test ! -f $try; then - try=`./loc $thislib blurfl/dyick $libpth` - if test ! -f $try; then - try=`./loc Slib$thislib.a blurfl/dyick $xlibpth` - if test ! -f $try; then - try='' - fi - fi - fi - fi + thislib=`echo X$thislib | $sed -e 's/^X//' -e 's/^-l//'` + if try=`./loc lib$thislib.$so.'*' X $libpth`; $test -f "$try"; then + : + elif try=`./loc lib$thislib.$so X $libpth`; $test -f "$try"; then + : + elif try=`./loc lib$thislib.a X $libpth`; $test -f "$try"; then + : + elif try=`./loc lib$thislib X $libpth`; $test -f "$try"; then + : + elif try=`./loc $thislib X $libpth`; $test -f "$try"; then + : + elif try=`./loc Slib$thislib.a X $xlibpth`; $test -f "$try"; then + : + else + try='' fi libnames="$libnames $try" ;; @@ -2387,10 +2896,11 @@ esac xxx=normal case "$libc" in unknown) - set /usr/ccs/lib/libc.so - $test -r $1 || set /usr/lib/libc.so - $test -r $1 || set /usr/shlib/libc.so - $test -r $1 || set /usr/lib/libc.so.[0-9]* + set /usr/ccs/lib/libc.$so + $test -r $1 || set /usr/lib/libc.$so + $test -r $1 || set /usr/shlib/libc.$so + $test -r $1 || set /usr/lib/libc.$so.[0-9]* + $test -r $1 || set /lib/libc.$so $test -r $1 || set /lib/libsys_s.a eval set \$$# ;; @@ -2476,13 +2986,12 @@ echo " " $sed 's/^/ /' libnames >&4 echo " " $echo $n "This may take a while...$c" >&4 - nm $nm_opt $* 2>/dev/null >libc.tmp $echo $n ".$c" $grep fprintf libc.tmp > libc.ptf xscan='eval "libc.list"; $echo $n ".$c" >&4' xrun='eval "libc.list"; echo "done" >&4' -if com="$sed -n -e 's/^.* [ADTS] *_[_.]*//p' -e 's/^.* [ADTS] //p'";\ +if com="$sed -n -e 's/^.* [ADTSI] *_[_.]*//p' -e 's/^.* [ADTSI] //p'";\ eval $xscan;\ $contains '^fprintf$' libc.list >/dev/null 2>&1; then eval $xrun @@ -2519,6 +3028,10 @@ elif com="$sed -n -e 's/^__//' -e '/|Undef/d' -e '/|Proc/s/ .*//p'";\ eval $xscan;\ $contains '^fprintf$' libc.list >/dev/null 2>&1; then eval $xrun +elif com="$sed -n -e '/Def. Text/s/.* \([^ ]*\)\$/\1/p'";\ + eval $xscan;\ + $contains '^fprintf$' libc.list >/dev/null 2>&1; then + eval $xrun else nm -p $* 2>/dev/null >libc.tmp com="$sed -n -e 's/^.* [ADTS] *_[_.]*//p' -e 's/^.* [ADTS] //p'";\ @@ -2639,143 +3152,65 @@ yes) esac;; 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 .. -echo 'cat >.$$.c; '"$cc"' -E ${1+"$@"} .$$.c; rm .$$.c' >cppstdin -chmod 755 cppstdin -wrapper=`pwd`/cppstdin -ok='false' -cd UU - -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 - 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 - case "$cppstdin" in - '') ;; - *) - echo "Good old $cppstdin $cppminus does not seem to be of any help..." - ;; - esac -fi +: see if gconvert exists +set gconvert d_gconvert +eval $inlibc -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 - else -echo "Sorry, I can't get that to work. Go find one and rerun Configure." >&4 - exit 1 - fi -fi +case "$d_gconvert" in +$define) + d_Gconvert="gconvert((x),(n),(t),(b))" + ;; +*) + : Maybe we can emulate it with gcvt. + set gcvt d_gcvt + eval $inlibc -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=''; + case "$d_gcvt" in + $define) + : Test whether gcvt drops a trailing decimal point + cat >try.c <<'EOP' +main() { +char buf[64]; +gcvt(1.0, 8, buf); +if (buf[0] != '1' || buf[1] != '\0') + return 1; +gcvt(0.0, 8, buf); +if (buf[0] != '0' || buf[1] != '\0') + return 1; +gcvt(-1.0, 8, buf); +if (buf[0] != '-' || buf[1] != '1' || buf[2] != '\0') + return 1; +return 0; +} +EOP + if $cc $ccflags $ldflags -o try try.c $libs > /dev/null 2>&1; then + if ./try; then + echo "Good, your gcvt() drops a trailing decimal point." + d_Gconvert="gcvt((x),(n),(b))" + else + echo "But your gcvt() keeps a trailing decimal point". + d_Gconvert='' + fi else - echo "Nope, we'll have to live without it..." + echo "Hmm. I can't compile the gcvt test program." + d_Gconvert='' fi + $rm -f try.c try ;; esac - case "$cpprun" in - "$wrapper") - cpprun='' - cpplast='' + case "$d_Gconvert" in + '') + echo "I'll use sprintf instead." >&4 + d_Gconvert='sprintf((b),"%.*g",(n),(x))' ;; esac - ;; esac -case "$cppstdin" in -"$wrapper") ;; -*) $rm -f $wrapper;; -esac -$rm -f testcpp.c testcpp.out +: Initialize h_fcntl +h_fcntl=false + +: Initialize h_sysfile +h_sysfile=false : determine filename position in cpp output echo " " @@ -2783,7 +3218,7 @@ echo "Computing filename position in cpp output for #include directives..." >&4 echo '#include ' > foo.c $cat >fieldn </dev/null | \ +$cppstdin $cppflags $cppminus /dev/null | \ $grep '^[ ]*#.*stdio\.h' | \ while read cline; do pos=1 @@ -2879,45 +3314,140 @@ EOCP esac $rm -f access* -: see if bcmp exists -set bcmp d_bcmp +: see if alarm exists +set alarm d_alarm eval $inlibc -: see if bcopy exists -set bcopy d_bcopy -eval $inlibc +: is AFS running? +echo " " +if test -d /afs; then + echo "AFS may be running... I'll be extra cautious then..." >&4 + afs=true +else + echo "AFS does not seem to be running..." >&4 + afs=false +fi -: see if bzero exists -set bzero d_bzero -eval $inlibc +: 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 <&4 - $cat >try.c <<'EOCP' -#include -main() -{ - printf("%d\n", sizeof(int)); -} -EOCP - if $cc $ccflags try.c -o try >/dev/null 2>&1 ; then - dflt=`./try` + dflt=$prefix/lib/$package + ;; +*) dflt="$privlib" + ;; +esac +$cat <&4 -if $test "$intsize" -eq 4; then - xxx=int -else - xxx=long -fi - -$cat >try.c <&4 +$cat >attrib.c <<'EOCP' +void croak (char* pat,...) __attribute__((format(printf,1,2),noreturn)); +EOCP +if $cc $ccflags -c attrib.c >attrib.out 2>&1 ; then + if $contains 'warning' attrib.out >/dev/null 2>&1; then + echo "Your C compiler doesn't fully support __attribute__. ." + val="$undef" + else + echo "Your C compiler supports __attribute__. ." + val="$define" + fi +else + echo "Your C compiler doesn't seem to understand __attribute__. ." + val="$undef" +fi +set d_attrib +eval $setvar +$rm -f attrib* + +: see if bcmp exists +set bcmp d_bcmp +eval $inlibc + +: see if bcopy exists +set bcopy d_bcopy +eval $inlibc + +: see if setpgrp exists +set setpgrp d_setpgrp +eval $inlibc + +: see which flavor of setpgrp is in use +case "$d_setpgrp" in +"$define") + echo " " + $cat >set.c </dev/null 2>&1; then + ./set 2>/dev/null + case $? in + 0) echo "You have to use setpgrp() instead of setpgrp(pid, pgrp)." >&4 + val="$undef";; + *) echo "You have to use setpgrp(pid, pgrp) instead of setpgrp()." >&4 + val="$define";; + esac + else + if usg; then + xxx="USG one, i.e. you use setpgrp()." + val="$undef" + else + xxx="BSD one, i.e. you use setpgrp(pid, pgrp)." + val="$define" + fi + echo "Assuming your setpgrp is a $xxx" >&4 + fi + ;; +*) val="$undef";; +esac +set d_bsdpgrp +eval $setvar +$rm -f set set.c + +: see if bzero exists +set bzero d_bzero +eval $inlibc + +: check for length of integer +echo " " +case "$intsize" in +'') + echo "Checking to see how big your integers are..." >&4 + $cat >try.c <<'EOCP' +#include +main() +{ + printf("%d\n", sizeof(int)); +} +EOCP + if $cc $ccflags try.c -o try >/dev/null 2>&1 ; then + dflt=`./try` + else + dflt='4' + echo "(I can't seem to compile the test program. Guessing...)" + fi + ;; +*) + dflt="$intsize" + ;; +esac +rp="What is the size of an integer (in bytes)?" +. ./myread +intsize="$ans" +$rm -f try.c try + +: check for ability to cast large floats to 32-bit ints. +echo " " +echo 'Checking whether your C compiler can cast large floats to int32.' >&4 +if $test "$intsize" -eq 4; then + xxx=int +else + xxx=long +fi +$cat >try.c < #include blech() { exit(3); } main() { - $xxx i32; + $xxx i32; double f; int result = 0; signal(SIGFPE, blech); f = (double) 0x7fffffff; f = 10 * f; - i32 = ( $xxx )f; + i32 = ($xxx) f; - if (i32 != ( $xxx )f) + if (i32 != ($xxx) f) result |= 1; exit(result); } @@ -2960,6 +3596,7 @@ if $cc -o try $ccflags try.c >/dev/null 2>&1; then ./try yyy=$? else + echo "(I can't seem to compile the test program--assuming it can't)" yyy=1 fi case "$yyy" in @@ -2973,6 +3610,7 @@ esac set d_casti32 eval $setvar $rm -f try try.* + : check for ability to cast negative floats to unsigned echo " " echo 'Checking whether your C compiler can cast negative float to unsigned.' >&4 @@ -3094,6 +3732,14 @@ 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 @@ -3160,135 +3806,8 @@ esac set d_csh eval $setvar -: see if this is a dirent system -echo " " -if xinc=`./findhdr dirent.h`; $test "$xinc"; then - val="$define" - echo " found." >&4 -else - val="$undef" - if xinc=`./findhdr sys/dir.h`; $test "$xinc"; then - echo " found." >&4 - echo " " - else - xinc=`./findhdr sys/ndir.h` - fi - echo " NOT found." >&4 -fi -set i_dirent -eval $setvar - -: see if the directory entry stores field length -echo " " -if $contains 'd_namlen' $xinc >/dev/null 2>&1; then - echo "Good, your directory entry keeps length information in d_namlen." >&4 - val="$define" -else - echo "Your directory entry does not know about the d_namlen field." >&4 - val="$undef" -fi -set d_dirnamlen -eval $setvar - -: now see if they want to do setuid emulation -case "$d_dosuid" in -'') dflt=n;; -"$undef") dflt=n;; -*) dflt=y;; -esac -cat <$first) 2>/dev/null; then - if $test -f 123456789abcde; then - echo 'You cannot have filenames longer than 14 characters. Sigh.' >&4 - val="$undef" - else - if (echo hi >$second) 2>/dev/null; then - if $test -f /tmp/cf$$/123456789abcde; then - $cat <<'EOM' -That's peculiar... You can have filenames longer than 14 characters, but only -on some of the filesystems. Maybe you are using NFS. Anyway, to avoid problems -I shall consider your system cannot support long filenames at all. -EOM - val="$undef" - else - echo 'You can have filenames longer than 14 characters.' >&4 - val="$define" - fi - else - $cat <<'EOM' -How confusing! Some of your filesystems are sane enough to allow filenames -longer than 14 characters but some others like /tmp can't even think about them. -So, for now on, I shall assume your kernel does not allow them at all. -EOM - val="$undef" - fi - fi -else - $cat <<'EOM' -You can't have filenames longer than 14 chars. You can't even think about them! -EOM - val="$undef" -fi -set d_flexfnam -eval $setvar -$rm -rf /tmp/cf$$ 123456789abcde* - -: see if flock exists -set flock d_flock -eval $inlibc - -: see if gethostent exists -set gethostent d_gethent -eval $inlibc - -: see if getpgrp exists -set getpgrp d_getpgrp -eval $inlibc - -: see if getpgrp2 exists -set getpgrp2 d_getpgrp2 -eval $inlibc - -: see if getpriority exists -set getpriority d_getprior +: see if cuserid exists +set cuserid d_cuserid eval $inlibc : define an alternate in-header-list? function @@ -3321,85 +3840,802 @@ do set $yyy; var=$2; eval "was=\$$2"; set $yyy; shift; shift; yyy=$@; done' -: see if this is a netinet/in.h or sys/in.h system -set netinet/in.h i_niin sys/in.h i_sysin +: see if this is a limits.h system +set limits.h i_limits eval $inhdr -: see if htonl --and friends-- exists -set htonl d_htonl -eval $inlibc -: Maybe they are macros. -case "$d_htonl" in -'define') ;; -*) cat > try.c < -#include -#$i_niin I_NETINET_IN -#$i_sysin I_SYS_IN -#ifdef I_NETINET_IN -# include +: see if this is a float.h system +set float.h i_float +eval $inhdr + +: See if number of significant digits in a double precision number is known +echo " " +$cat >dbl_dig.c < #endif -#ifdef I_SYS_IN -# include +#ifdef I_FLOAT +#include +#endif +#ifdef DBL_DIG +printf("Contains DBL_DIG"); #endif -int main() -{ - int x; - printf("x = ", htonl(7)); -} EOM - if $cc $ccflags -c try.c >/dev/null 2>&1; then - d_htonl="$define" - echo "But it seems to be defined as a macro." - fi - $rm -f try.* try - ;; -esac -: Look for isascii -echo " " -$cat >isascii.c <<'EOCP' -#include -#include -main() { - int c = 'A'; - if (isascii(c)) - exit(0); - else - exit(1); -} -EOCP -if $cc $cppflags -o isascii isascii.c >/dev/null 2>&1 ; then - echo "isascii() found." - val="$define" +$cppstdin $cppflags $cppminus < dbl_dig.c >dbl_dig.E 2>/dev/null +if $contains 'DBL_DIG' dbl_dig.E >/dev/null 2>&1; then + echo "DBL_DIG found." >&4 + val="$define" else - echo "isascii() NOT found." - val="$undef" + echo "DBL_DIG NOT found." >&4 + val="$undef" fi -set d_isascii +$rm -f dbl_dig.? +set d_dbl_dig eval $setvar -$rm -f isascii* -: see if killpg exists -set killpg d_killpg -eval $inlibc -: see if link exists -set link d_link -eval $inlibc - -: see if lstat exists -set lstat d_lstat -eval $inlibc - -: see if memcmp exists -set memcmp d_memcmp -eval $inlibc - -: see if memcpy exists -set memcpy d_memcpy +: see if difftime exists +set difftime d_difftime eval $inlibc -: see if memmove exists -set memmove d_memmove +: see if this is a dirent system +echo " " +if xinc=`./findhdr dirent.h`; $test "$xinc"; then + val="$define" + echo " found." >&4 +else + val="$undef" + if xinc=`./findhdr sys/dir.h`; $test "$xinc"; then + echo " found." >&4 + echo " " + else + xinc=`./findhdr sys/ndir.h` + fi + echo " NOT found." >&4 +fi +set i_dirent +eval $setvar + +: Look for type of directory structure. +echo " " +$cppstdin $cppflags $cppminus < "$xinc" > try.c + +case "$direntrytype" in +''|' ') + case "$i_dirent" in + $define) guess1='struct dirent' ;; + *) guess1='struct direct' ;; + esac + ;; +*) guess1="$direntrytype" + ;; +esac + +case "$guess1" in +'struct dirent') guess2='struct direct' ;; +*) guess2='struct dirent' ;; +esac + +if $contains "$guess1" try.c >/dev/null 2>&1; then + direntrytype="$guess1" + echo "Your directory entries are $direntrytype." >&4 +elif $contains "$guess2" try.c >/dev/null 2>&1; then + direntrytype="$guess2" + echo "Your directory entries seem to be $direntrytype." >&4 +else + echo "I don't recognize your system's directory entries." >&4 + rp="What type is used for directory entries on this system?" + dflt="$guess1" + . ./myread + direntrytype="$ans" +fi +$rm -f try.c + + +: see if the directory entry stores field length +echo " " +if $contains 'd_namlen' $xinc >/dev/null 2>&1; then + echo "Good, your directory entry keeps length information in d_namlen." >&4 + val="$define" +else + echo "Your directory entry does not know about the d_namlen field." >&4 + val="$undef" +fi +set d_dirnamlen +eval $setvar + +: see if dlerror exists +set dlerror d_dlerror +eval $inlibc + +: see if dld is available +set dld.h i_dld +eval $inhdr + +: see if dlopen exists +set dlopen d_dlopen +eval $inlibc + +: determine which dynamic loading, if any, to compile in +echo " " +dldir="ext/DynaLoader" +case "$usedl" in +$define|y|true) + dflt='y' + usedl="$define" + ;; +$undef|n|false) + dflt='n' + usedl="$undef" + ;; +*) + dflt='n' + case "$d_dlopen" in + define) dflt='y' ;; + esac + case "$i_dld" in + define) dflt='y' ;; + esac + : Does a dl_xxx.xs file exist for this operating system + $test -f ../$dldir/dl_${osname}.xs && dflt='y' + ;; +esac +rp="Do you wish to use dynamic loading?" +. ./myread +usedl="$ans" +case "$ans" in +y*) usedl="$define" + case "$dlsrc" in + '') + if $test -f ../$dldir/dl_${osname}.xs ; then + dflt="$dldir/dl_${osname}.xs" + elif $test "$d_dlopen" = "$define" ; then + dflt="$dldir/dl_dlopen.xs" + elif $test "$i_dld" = "$define" ; then + dflt="$dldir/dl_dld.xs" + else + dflt='' + fi + ;; + *) dflt="$dldir/$dlsrc" + ;; + esac + echo "The following dynamic loading files are available:" + : Can not go over to $dldir because getfile has path hard-coded in. + cd ..; ls -C $dldir/dl*.xs; cd UU + rp="Source file to use for dynamic loading" + fn="fne~" + . ./getfile + usedl="$define" + : emulate basename + dlsrc=`echo $ans | $sed -e 's@.*/\([^/]*\)$@\1@'` + $cat << EOM + +Some systems may require passing special flags to $cc -c to +compile modules that will be used to create a shared library. +To use no flags, say "none". + +EOM + case "$cccdlflags" in + ''|' ') case "$osname" in + hpux) dflt='+z' ;; + next) dflt='none' ;; + sunos) + case "$cc" in + *gcc*) dflt='-fpic' ;; + *) dflt='-pic' ;; + esac + ;; + solaris) + case "$cc" in + *gcc*) dflt='-fpic' ;; + *) dflt='-K pic' ;; + esac + ;; + *) dflt='none' ;; + esac + ;; + *) dflt="$cccdlflags" ;; + esac + rp="Any special flags to pass to $cc -c to compile shared library modules?" + . ./myread + case "$ans" in + none) cccdlflags='' ;; + *) cccdlflags="$ans" ;; + esac + + cat << 'EOM' + +Some systems may require passing special flags to ld to create a shared +library. If your ld flags include -L/local/path options to locate libraries +outside your loader's normal search path, you may need to specify those +-L options here as well. +To use no flags, say "none". + +EOM + case "$lddlflags" in + ''|' ') case "$osname" in + hpux) dflt='-b' ;; + next) dflt='none' ;; + solaris) dflt='-G' ;; + sunos) dflt='none' ;; + *) dflt='none' ;; + esac + ;; + *) dflt="$lddlflags" ;; + esac + rp="Any special flags to pass to ld to create a shared library?" + . ./myread + case "$ans" in + none) lddlflags='' ;; + *) lddlflags="$ans" ;; + esac + + cat <&4 + $cat >dyna.c <<'EOM' +fred () { } +EOM + +$cat >fred.c< +#$i_dlfcn I_DLFCN +#ifdef I_DLFCN +#include /* the dynamic linker include file for Sunos/Solaris */ +#else +#include +#include +#include +#endif + +extern int fred() ; + +main() +{ + void * handle ; + void * symbol ; +#ifndef RTLD_LAZY + int mode = 1 ; +#else + int mode = RTLD_LAZY ; +#endif + handle = dlopen("./dyna.$dlext", mode) ; + if (handle == NULL) { + printf ("1\n") ; + exit(0); + } + symbol = dlsym(handle, "fred") ; + if (symbol == NULL) { + /* try putting a leading underscore */ + symbol = dlsym(handle, "_fred") ; + if (symbol == NULL) { + printf ("2\n") ; + exit(0); + } + printf ("3\n") ; + } + else + printf ("4\n") ; + exit(0); +} +EOM + if $cc $ccflags $cccdlflags -c dyna.c > /dev/null 2>&1 && + ld $lddlflags -o dyna.$dlext dyna.o > /dev/null 2>&1 && + $cc $ccflags $ldflags $cccdlflags $ccdlflags fred.c -o fred $libs > /dev/null 2>&1; then + xxx=`./fred` + case $xxx in + 1) echo "Test program failed using dlopen." >&4 + echo "Perhaps you should not use dynamic loading." >&4;; + 2) echo "Test program failed using dlsym." >&4 + echo "Perhaps you should not use dynamic loading." >&4;; + 3) echo "dlsym needs a leading underscore" >&4 + val="$define" ;; + 4) echo "dlsym doesn't need a leading underscore." >&4;; + esac + else + echo "I can't compile and run the test program." >&4 + fi + ;; +esac + +$rm -f fred fred.? dyna.$dlext dyna.? + +set d_dlsymun +eval $setvar + +: see if setuid scripts can be secure +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 + ;; + esac + rp='Does your kernel have *secure* setuid scripts?' + . ./myread + case "$ans" in + [yY]*) val="$define";; + *) val="$undef";; + esac + fi +else + echo "I don't think setuid scripts are secure (no /dev/fd directory)." >&4 + val="$undef" +fi +set d_suidsafe +eval $setvar + +$rm -f reflect flect + +: now see if they want to do setuid emulation +cat <& 4 + ;; +*) + case "$d_dosuid" in + "$define") dflt=y ;; + *) dflt=n ;; + esac + rp="Do you want to do setuid/setgid emulation?" + . ./myread + case "$ans" in + [yY]*) val="$define";; + *) val="$undef";; + esac + ;; +esac +set d_dosuid +eval $setvar + +: see if drem exists +set drem d_drem +eval $inlibc + +: see if dup2 exists +set dup2 d_dup2 +eval $inlibc + +: see if fchmod exists +set fchmod d_fchmod +eval $inlibc + +: see if fchown exists +set fchown d_fchown +eval $inlibc + +: see if this is an fcntl system +set fcntl d_fcntl +eval $inlibc + +: see if fgetpos exists +set fgetpos d_fgetpos +eval $inlibc + +: see if we can have long filenames +echo " " +rmlist="$rmlist /tmp/cf$$" +$test -d /tmp/cf$$ || mkdir /tmp/cf$$ +first=123456789abcdef +second=/tmp/cf$$/$first +$rm -f $first $second +if (echo hi >$first) 2>/dev/null; then + if $test -f 123456789abcde; then + echo 'You cannot have filenames longer than 14 characters. Sigh.' >&4 + val="$undef" + else + if (echo hi >$second) 2>/dev/null; then + if $test -f /tmp/cf$$/123456789abcde; then + $cat <<'EOM' +That's peculiar... You can have filenames longer than 14 characters, but only +on some of the filesystems. Maybe you are using NFS. Anyway, to avoid problems +I shall consider your system cannot support long filenames at all. +EOM + val="$undef" + else + echo 'You can have filenames longer than 14 characters.' >&4 + val="$define" + fi + else + $cat <<'EOM' +How confusing! Some of your filesystems are sane enough to allow filenames +longer than 14 characters but some others like /tmp can't even think about them. +So, for now on, I shall assume your kernel does not allow them at all. +EOM + val="$undef" + fi + fi +else + $cat <<'EOM' +You can't have filenames longer than 14 chars. You can't even think about them! +EOM + val="$undef" +fi +set d_flexfnam +eval $setvar +$rm -rf /tmp/cf$$ 123456789abcde* + +: see if flock exists +set flock d_flock +eval $inlibc + +: see if fmod exists +set fmod d_fmod +eval $inlibc + +: see if fork exists +set fork d_fork +eval $inlibc + +: see if pathconf exists +set pathconf d_pathconf +eval $inlibc + +: see if fpathconf exists +set fpathconf d_fpathconf +eval $inlibc + +: see if fsetpos exists +set fsetpos d_fsetpos +eval $inlibc + +: see if gethostent exists +set gethostent d_gethent +eval $inlibc + +: see if getlogin exists +set getlogin d_getlogin +eval $inlibc + +: see if getpgrp exists +set getpgrp d_getpgrp +eval $inlibc + +: see if getpgrp2 exists +set getpgrp2 d_getpgrp2 +eval $inlibc + +: see if getppid exists +set getppid d_getppid +eval $inlibc + +: see if getpriority exists +set getpriority d_getprior +eval $inlibc + +: see if group exists +set group d_group +eval $inlibc + +: see if this is a netinet/in.h or sys/in.h system +set netinet/in.h i_niin sys/in.h i_sysin +eval $inhdr + +: see if htonl --and friends-- exists +val='' +set htonl val +eval $inlibc + +: Maybe they are macros. +case "$val" in +$undef) + $cat >htonl.c < +#include +#$i_niin I_NETINET_IN +#$i_sysin I_SYS_IN +#ifdef I_NETINET_IN +#include +#endif +#ifdef I_SYS_IN +#include +#endif +#ifdef htonl +printf("Defined as a macro."); +#endif +EOM + $cppstdin $cppflags $cppminus < htonl.c >htonl.E 2>/dev/null + if $contains 'Defined as a macro' htonl.E >/dev/null 2>&1; then + val="$define" + echo "But it seems to be defined as a macro." >&4 + fi + $rm -f htonl.? + ;; +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 + if set strchr val -f d_strchr; eval $csym; $val; then + if $contains strchr "$strings" >/dev/null 2>&1 ; then + val="$define" + vali="$undef" + echo "strchr() found." >&4 + else + val="$undef" + vali="$define" + echo "index() found." >&4 + fi + else + val="$undef" + vali="$define" + echo "index() found." >&4 + fi +else + if set strchr val -f d_strchr; eval $csym; $val; then + val="$define" + vali="$undef" + echo "strchr() found." >&4 + else + echo "No index() or strchr() found!" >&4 + val="$undef" + vali="$undef" + fi +fi +set d_strchr; eval $setvar +val="$vali" +set d_index; eval $setvar + +: Look for isascii +echo " " +$cat >isascii.c <<'EOCP' +#include +#include +main() { + int c = 'A'; + if (isascii(c)) + exit(0); + else + exit(1); +} +EOCP +if $cc $ccflags $ldflags -o isascii isascii.c $libs >/dev/null 2>&1 ; then + echo "isascii() found." >&4 + val="$define" +else + echo "isascii() NOT found." >&4 + val="$undef" +fi +set d_isascii +eval $setvar +$rm -f isascii* + +: see if killpg exists +set killpg d_killpg +eval $inlibc + +: see if link exists +set link d_link +eval $inlibc + +: see if stdio is really std +echo " " +xxx=`./findhdr stdio.h` +if $contains 'char.*_ptr;' "$xxx" >/dev/null 2>&1 ; then + if $contains '_cnt;' "$xxx" >/dev/null 2>&1 ; then + echo "Your stdio is pretty std." >&4 + val="$define" + else + echo "Your stdio isn't very std." >&4 + val="$undef" + fi +else + echo "Your stdio isn't very std." >&4 + val="$undef" +fi +set d_stdstdio +eval $setvar + +: see if stdio is like that in linux +case "$d_stdstdio" in +"$undef") + echo " " + xxx=`./findhdr stdio.h` + $cppstdin $cppflags $cppminus < "$xxx" > stdio.E + if $contains 'char.*_IO_read_base' stdio.E >/dev/null 2>&1 && \ + $contains '_IO_read_ptr' stdio.E >/dev/null 2>&1 && \ + $contains '_IO_read_end' stdio.E >/dev/null 2>&1 ; then + echo "Your stdio looks like linux." >&4 + val="$define" + else + echo "You don't have linux stdio, either." >&4 + val="$undef" + fi + $rm -f stdio.E + ;; +*) val="$undef" ;; +esac + +set d_linuxstd +eval $setvar + +: see if localeconv exists +set localeconv d_locconv +eval $inlibc + +: see if lockf exists +set lockf d_lockf +eval $inlibc + +: see if lstat exists +set lstat d_lstat +eval $inlibc + +: see if mblen exists +set mblen d_mblen +eval $inlibc + +: see if mbstowcs exists +set mbstowcs d_mbstowcs +eval $inlibc + +: see if mbtowc exists +set mbtowc d_mbtowc +eval $inlibc + +: see if memcmp exists +set memcmp d_memcmp +eval $inlibc + +: see if memcpy exists +set memcpy d_memcpy +eval $inlibc + +: see if memmove exists +set memmove d_memmove eval $inlibc : see if memset exists @@ -3410,6 +4646,14 @@ eval $inlibc set mkdir d_mkdir eval $inlibc +: see if mkfifo exists +set mkfifo d_mkfifo +eval $inlibc + +: see if mktime exists +set mktime d_mktime +eval $inlibc + : see if msgctl exists set msgctl d_msgctl eval $inlibc @@ -3443,43 +4687,56 @@ fi set d_msg eval $setvar +: see if this is a malloc.h system +set malloc.h i_malloc +eval $inhdr + : determine which malloc to compile in -: Old versions had dflt='y' only for bsd or v7. echo " " case "$usemymalloc" in -'') - if bsd || v7; then - dflt='y' - else - dflt='y' - fi - ;; -*) dflt="$usemymalloc" - ;; +''|y*|true) dflt='y' ;; +n*|false) dflt='n' ;; +*) dflt="$usemymalloc" ;; esac rp="Do you wish to attempt to use the malloc that comes with $package?" . ./myread usemymalloc="$ans" case "$ans" in -y*) mallocsrc='malloc.c' - mallocobj='malloc.o' - d_mymalloc="$define" - ;; -*) mallocsrc='' - mallocobj='' - d_mymalloc="$undef" - ;; +y*|true) + usemymalloc='y' + mallocsrc='malloc.c' + mallocobj='malloc.o' + d_mymalloc="$define" + case "$libs" in + *-lmalloc*) + : Remove malloc from list of libraries to use + echo "Removing unneeded -lmalloc from library list" >&4 + set `echo X $libs | $sed -e 's/-lmalloc / /' -e 's/-lmalloc$//'` + shift + libs="$*" + echo "libs = $libs" >&4 + ;; + esac + ;; +*) + usemymalloc='n' + mallocsrc='' + mallocobj='' + d_mymalloc="$undef" + ;; esac : compute the type returned by malloc echo " " case "$malloctype" in '') - if $test `./findhdr malloc.h`; then - echo "#include " > malloc.c - fi + $cat >malloc.c < +#include +#ifdef I_MALLOC #include - $cat >>malloc.c <<'END' +#endif void *malloc(); END if $cc $ccflags -c malloc.c >/dev/null 2>&1; then @@ -3492,57 +4749,8 @@ END esac echo "Your system wants malloc to return '$malloctype', it would seem." >&4 -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 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 -f /usr/lib/libnet.a; then - ( (nm $nm_opt /usr/lib/libnet.a | eval $nm_extract) || \ - ar t /usr/lib/libnet.a) 2>/dev/null >> libc.list - if $contains socket libc.list >/dev/null 2>&1; then - echo "...but the Wollongong group seems to have hacked it in." >&4 - socketlib="-lnet" - sockethdr="-I/usr/netinclude" - d_socket="$define" - if $contains setsockopt libc.list >/dev/null 2>&1; then - d_oldsock="$undef" - else - echo "...using the old 4.1c interface, rather than 4.2" >&4 - d_oldsock="$define" - fi - else - echo "or even in libnet.a, which is peculiar." >&4 - d_socket="$undef" - d_oldsock="$undef" - fi - else - echo "or anywhere else I see." >&4 - d_socket="$undef" - d_oldsock="$undef" - fi - fi -fi - -: see if socketpair exists -set socketpair d_sockpair +: see if nice exists +set nice d_nice eval $inlibc : Locate the flags for 'open()' @@ -3595,6 +4803,18 @@ set d_open3 eval $setvar $rm -f open3* +: see if passwd exists +set passwd d_passwd +eval $inlibc + +: see if pause exists +set pause d_pause +eval $inlibc + +: see if pipe exists +set pipe d_pipe +eval $inlibc + : see if this is a pwd system echo " " xxx=`./findhdr pwd.h` @@ -3654,6 +4874,10 @@ eval $inlibc set rewinddir d_rewinddir eval $inlibc +: see if readlink exists +set readlink d_readlink +eval $inlibc + : see if rename exists set rename d_rename eval $inlibc @@ -3676,6 +4900,7 @@ char *b; int len; int off; int align; + bcopy("abcdefghijklmnopqrstuvwxyz0123456789", abc, 36); for (align = 7; align >= 0; align--) { @@ -3693,7 +4918,7 @@ for (align = 7; align >= 0; align--) { exit(0); } EOCP - if $cc foo.c -o safebcpy $ccflags $libs >/dev/null 2>&1 ; then + if $cc foo.c -o safebcpy $ccflags $ldflags $libs >/dev/null 2>&1 ; then if ./safebcpy 2>/dev/null; then echo "Yes, it can." val="$define" @@ -3741,7 +4966,7 @@ for (align = 7; align >= 0; align--) { exit(0); } EOCP - if $cc foo.c -o safemcpy $ccflags $libs >/dev/null 2>&1 ; then + if $cc foo.c -o safemcpy $ccflags $ldflags $libs >/dev/null 2>&1 ; then if ./safemcpy 2>/dev/null; then echo "Yes, it can." val="$define" @@ -3798,17 +5023,18 @@ eval $inlibc set seteuid d_seteuid eval $inlibc +: see if setlinebuf exists +set setlinebuf d_setlinebuf +eval $inlibc + : see if setlocale exists set setlocale d_setlocale eval $inlibc + : see if setpgid exists set setpgid d_setpgid eval $inlibc -: see if setpgrp exists -set setpgrp d_setpgrp -eval $inlibc - : see if setpgrp2 exists set setpgrp2 d_setpgrp2 eval $inlibc @@ -3849,43 +5075,112 @@ eval $inlibc set shmget d_shmget eval $inlibc -: see if shmat exists -set shmat d_shmat -eval $inlibc -: see what shmat returns -d_voidshmat="$undef" -case "$d_shmat" in -define) - $cppstdin $cppflags $cppminus < $usrinc/sys/shm.h >voidshmat.txt 2>/dev/null - if $contains "void.*shmat" voidshmat.txt >/dev/null 2>&1; then - echo "and shmat returns (void*)" - d_voidshmat="$define" - else - echo "and shmat returns (char*)" - fi - ;; -esac -: see if shmdt exists -set shmdt d_shmdt +: see if shmat exists +set shmat d_shmat +eval $inlibc +: see what shmat returns +case "$d_shmat" in +"$define") + $cat >shmat.c <<'END' +#include +void *shmat(); +END + if $cc $ccflags -c shmat.c >/dev/null 2>&1; then + shmattype='void *' + else + shmattype='char *' + fi + echo "and it returns ($shmattype)." >&4 + : see if a prototype for shmat is available + $cppstdin $cppflags $cppminus < $usrinc/sys/shm.h > shmat.c 2>/dev/null + if $contains 'shmat.*(' shmat.c >/dev/null 2>&1; then + val="$define" + else + val="$undef" + fi + $rm -f shmat.[co] + ;; +*) + val="$undef" + ;; +esac +set d_shmatprototype +eval $setvar + +: see if shmdt exists +set shmdt d_shmdt +eval $inlibc + +: see how much of the 'shm*(2)' library is present. +h_shm=true +echo " " +case "$d_shmctl$d_shmget$d_shmat$d_shmdt" in +*"$undef"*) h_shm=false;; +esac +: we could also check for sys/ipc.h ... +if $h_shm && $test `./findhdr sys/shm.h`; then + echo "You have the full shm*(2) library." >&4 + val="$define" +else + echo "You don't have the full shm*(2) library." >&4 + val="$undef" +fi +set d_shm +eval $setvar + +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 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 -f /usr/lib/libnet.a; then + ( (nm $nm_opt /usr/lib/libnet.a | eval $nm_extract) || \ + ar t /usr/lib/libnet.a) 2>/dev/null >> libc.list + if $contains socket libc.list >/dev/null 2>&1; then + echo "...but the Wollongong group seems to have hacked it in." >&4 + socketlib="-lnet" + sockethdr="-I/usr/netinclude" + d_socket="$define" + if $contains setsockopt libc.list >/dev/null 2>&1; then + d_oldsock="$undef" + else + echo "...using the old 4.1c interface, rather than 4.2" >&4 + d_oldsock="$define" + fi + else + echo "or even in libnet.a, which is peculiar." >&4 + d_socket="$undef" + d_oldsock="$undef" + fi + else + echo "or anywhere else I see." >&4 + d_socket="$undef" + d_oldsock="$undef" + fi + fi +fi + +: see if socketpair exists +set socketpair d_sockpair eval $inlibc -: see how much of the 'shm*(2)' library is present. -h_shm=true -echo " " -case "$d_shmctl$d_shmget$d_shmat$d_shmdt" in -*"$undef"*) h_shm=false;; -esac -: we could also check for sys/ipc.h ... -if $h_shm && $test `./findhdr sys/shm.h`; then - echo "You have the full shm*(2) library." >&4 - val="$define" -else - echo "You don't have the full shm*(2) library." >&4 - val="$undef" -fi -set d_shm -eval $setvar - : see if stat knows about block sizes echo " " xxx=`./findhdr sys/stat.h` @@ -3904,78 +5199,9 @@ fi set d_statblks eval $setvar -: see if stdio is really std -echo " " -xxx=`./findhdr stdio.h` -if $contains 'char.*_ptr;' "$xxx" >/dev/null 2>&1 ; then - if $contains '_cnt;' "$xxx" >/dev/null 2>&1 ; then - echo "Your stdio is pretty std." >&4 - val="$define" - else - echo "Your stdio isn't very std." >&4 - val="$undef" - fi -else - echo "Your stdio isn't very std." >&4 - val="$undef" -fi -set d_stdstdio -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 - if set strchr val -f d_strchr; eval $csym; $val; then - if $contains strchr "$strings" >/dev/null 2>&1 ; then - val="$define" - vali="$undef" - echo "strchr() found." >&4 - else - val="$undef" - vali="$define" - echo "index() found." >&4 - fi - else - val="$undef" - vali="$define" - echo "index() found." >&4 - fi -else - if set strchr val -f d_strchr; eval $csym; $val; then - val="$define" - vali="$undef" - echo "strchr() found." >&4 - else - echo "No index() or strchr() found!" >&4 - val="$undef" - vali="$undef" - fi -fi -set d_strchr; eval $setvar -val="$vali" -set d_index; eval $setvar +: see if strcoll exists +set strcoll d_strcoll +eval $inlibc : check for structure copying echo " " @@ -4006,7 +5232,7 @@ echo " " if set strerror val -f d_strerror; eval $csym; $val; then echo 'strerror() found.' >&4 d_strerror="$define" - d_strerrm="$undef" + d_strerrm='strerror(e)' if set sys_errlist val -a d_syserrlst; eval $csym; $val; then echo "(You also have sys_errlist[], so we could roll our own strerror.)" d_syserrlst="$define" @@ -4018,7 +5244,7 @@ elif xxx=`./findhdr string.h`; test "$xxx" || xxx=`./findhdr strings.h`; \ $contains '#[ ]*define.*strerror' "$xxx" >/dev/null 2>&1; then echo 'strerror() found in string header.' >&4 d_strerror="$define" - d_strerrm="$undef" + d_strerrm='strerror(e)' if set sys_errlist val -a d_syserrlst; eval $csym; $val; then echo "(Most probably, strerror() uses sys_errlist[] for descriptions.)" d_syserrlst="$define" @@ -4030,14 +5256,18 @@ elif set sys_errlist val -a d_syserrlst; eval $csym; $val; then echo "strerror() not found, but you have sys_errlist[] so we'll use that." >&4 d_strerror="$undef" d_syserrlst="$define" - d_strerrm="$define" + d_strerrm='((e)<0||(e)>=sys_nerr?"unknown":sys_errlist[e])' else echo 'strerror() and sys_errlist[] NOT found.' >&4 d_strerror="$undef" d_syserrlst="$undef" - d_strerrm="$undef" + d_strerrm='"unknown"' fi +: see if strxfrm exists +set strxfrm d_strxfrm +eval $inlibc + : see if symlink exists set symlink d_symlink eval $inlibc @@ -4046,34 +5276,66 @@ eval $inlibc set syscall d_syscall eval $inlibc +: see if sysconf exists +set sysconf d_sysconf +eval $inlibc + : see if system exists set system d_system eval $inlibc +: see if tcgetpgrp exists +set tcgetpgrp d_tcgetpgrp +eval $inlibc + +: see if tcsetpgrp exists +set tcsetpgrp d_tcsetpgrp +eval $inlibc + +: 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 "val=\$$var"; +case "$val" in +"") + $rm -f temp.c; + for inc in $inclist; do + echo "#include <$inc>" >>temp.c; + done; + $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=$val";; +esac' + +: see if this is a sys/times.h system +set sys/times.h i_systimes +eval $inhdr + : see if times exists echo " " if set times val -f d_times; eval $csym; $val; then echo 'times() found.' >&4 d_times="$define" - case "$clocktype" in - '') - if $contains 'clock_t;' `./findhdr sys/types.h` >/dev/null 2>&1 ; then - dflt='clock_t'; - elif $contains 'clock_t;' `./findhdr sys/times.h` >/dev/null 2>&1; then - dflt='clock_t'; - else - dflt='long'; - fi - ;; - *) dflt="$clocktype" - ;; + inc='' + case "$i_systimes" in + "$define") inc='sys/times.h';; esac + set clock_t clocktype long stdio.h sys/types.h $inc + eval $typedef + dflt="$clocktype" echo " " rp="What type is returned by times() on this sytem?" . ./myread clocktype="$ans" else - echo 'times() not found, hope that will do.' >&4 + echo 'times() NOT found, hope that will do.' >&4 d_times="$undef" clocktype='int' fi @@ -4082,6 +5344,22 @@ fi set truncate d_truncate eval $inlibc +: see if tzname[] exists +echo " " +if set tzname val -a d_tzname; eval $csym; $val; then + val="$define" + echo 'tzname[] found.' >&4 +else + val="$undef" + echo 'tzname[] NOT found.' >&4 +fi +set d_tzname +eval $setvar + +: see if umask exists +set umask d_umask +eval $inlibc + : see if we have to deal with yellow pages, now NIS. if $test -d /usr/etc/yp || $test -d /etc/yp; then if $test -f /usr/etc/nibindd; then @@ -4185,8 +5463,8 @@ myhostname=$1 : translate upper to lower if necessary case "$myhostname" in *[A-Z]*) - myhostname=`echo $myhostname | tr '[A-Z]' '[a-z]'` echo "(Normalizing case in your host name)" + myhostname=`echo $myhostname | tr '[A-Z]' '[a-z]'` ;; esac @@ -4213,7 +5491,7 @@ done case "$phostname" in '') ;; *) - case `$phostname` in + case `$phostname | tr '[A-Z]' '[a-z]'` in $myhostname$mydomain|$myhostname) ;; *) case "$phostname" in @@ -4266,24 +5544,104 @@ case "$d_phostname" in '') d_phostname="$undef";; esac +: backward compatibility for d_hvfork +if test X$d_hvfork != X; then + d_vfork="$d_hvfork" + d_hvfork='' +fi : see if there is a vfork -set vfork d_vfork +val='' +set vfork val eval $inlibc -: But do we want to use it. vfork is reportedly unreliable in -: perl in Solaris 2.x, and probably elsewhere. + +: Ok, but do we want to use it. vfork is reportedly unreliable in +: perl on Solaris 2.x, and probably elsewhere. +case "$val" in +$define) + echo " " + case "$usevfork" in + false) dflt='n';; + *) dflt='y';; + esac + rp="Some systems have problems with vfork(). Do you want to use it?" + . ./myread + case "$ans" in + y|Y) ;; + *) + echo "Ok, we won't use vfork()." + val="$undef" + ;; + esac + ;; +esac +set d_vfork +eval $setvar case "$d_vfork" in -define) - dflt='n' - rp="Some systems have problems with vork. Do you want to use it?" - . ./myread - case "$ans" in - y|Y) ;; - *) echo "Ok, we won't use vfork." - d_vfork="$undef" - ;; - esac - ;; +$define) usevfork='true';; +*) usevfork='false';; +esac + +: see if this is an sysdir system +set sys/dir.h i_sysdir +eval $inhdr + +: see if this is an sysndir system +set sys/ndir.h i_sysndir +eval $inhdr + +: see if closedir exists +set closedir d_closedir +eval $inlibc + +case "$d_closedir" in +"$define") + echo " " + echo "Checking whether closedir() returns a status..." >&4 + cat > closedir.c < +#if defined(NeXT) && defined(I_SYS_DIR) /* NeXT needs dirent + sys/dir.h */ +#include +#endif +#else +#ifdef I_SYS_NDIR +#include +#else +#ifdef I_SYS_DIR +#ifdef hp9000s500 +#include /* may be wrong in the future */ +#else +#include +#endif +#endif +#endif +#endif +int main() { return closedir(opendir(".")); } +EOM + if $cc $ccflags $ldflags -o closedir closedir.c $libs > /dev/null 2>&1; then + if ./closedir > /dev/null 2>&1 ; then + echo "Yes, it does." + val="$undef" + else + echo "No, it doesn't." + val="$define" + fi + else + echo "(I can't seem to compile the test program--assuming it doesn't)" + val="$define" + fi + ;; +*) + val="$undef"; + ;; esac +set d_void_closedir +eval $setvar +$rm -f closedir* : see if signal is declared as pointer to function returning int or void echo " " xxx=`./findhdr signal.h` @@ -4291,31 +5649,35 @@ $test "$xxx" && $cppstdin $cppminus $cppflags < $xxx >$$.tmp 2>/dev/null if $contains 'int.*\*[ ]*signal' $$.tmp >/dev/null 2>&1 ; then echo "You have int (*signal())() instead of void." >&4 val="$undef" - signal_t="int" elif $contains 'void.*\*[ ]*signal' $$.tmp >/dev/null 2>&1 ; then echo "You have void (*signal())() instead of int." >&4 val="$define" - signal_t="void" elif $contains 'extern[ ]*[(\*]*signal' $$.tmp >/dev/null 2>&1 ; then echo "You have int (*signal())() instead of void." >&4 val="$undef" - signal_t="int" else case "$d_voidsig" in '') echo "I can't determine whether signal handler returns void or int..." >&4 dflt=void - rp="What type does your signal handler returns?" + rp="What type does your signal handler return?" . ./myread case "$ans" in - void) val="$define"; signal_t="void";; - *) val="$undef"; signal_t="int";; + v*) val="$define";; + *) val="$undef";; esac;; - *) echo "As you already told me, signal handler returns $signal_t." >&4;; + "$define") + echo "As you already told me, signal handler returns void." >&4;; + *) + echo "As you already told me, signal handler returns int." >&4;; esac fi set d_voidsig eval $setvar +case "$d_voidsig" in +"$define") signal_t="void";; +*) signal_t="int";; +esac $rm -f $$.tmp : check for volatile keyword @@ -4357,6 +5719,14 @@ eval $inlibc set waitpid d_waitpid eval $inlibc +: see if wcstombs exists +set wcstombs d_wcstombs +eval $inlibc + +: see if wctomb exists +set wctomb d_wctomb +eval $inlibc + : preserve RCS keywords in files with variable substitution, grrr Date='$Date' Id='$Id' @@ -4364,21 +5734,40 @@ Log='$Log' RCSfile='$RCSfile' Revision='$Revision' -: is AFS running? +: check for alignment requirements echo " " -if test -d /afs; then - echo "AFS may be running... I'll be extra cautious then..." >&4 - afs=true -else - echo "AFS does not seem to be running..." >&4 - afs=false -fi +case "$alignbytes" in +'') echo "Checking alignment constraints..." >&4 + $cat >try.c <<'EOCP' +struct foobar { + char foo; + double bar; +} try; +main() +{ + printf("%d\n", (char *)&try.bar - (char *)&try.foo); +} +EOCP + if $cc $ccflags try.c -o try >/dev/null 2>&1; then + dflt=`./try` + else + dflt='8' + echo"(I can't seem to compile the test program...)" + fi + ;; +*) dflt="$alignbytes" + ;; +esac +rp="Doubles must be aligned on a how-many-byte boundary?" +. ./myread +alignbytes="$ans" +$rm -f try.c try : determine where public executables go echo " " case "$bin" in '') - dflt=`./loc . /bin /usr/local/bin /usr/lbin /usr/local /usr/bin` + dflt="$prefix/bin" ;; *) dflt="$bin" @@ -4449,174 +5838,140 @@ EOCP else dflt='4321' cat <<'EOM' -(I can't seem to compile the test program. Guessing big-endian...) -EOM - fi - ;; -*) - echo " " - dflt="$byteorder" - ;; -esac -rp="What is the order of bytes in a long?" -. ./myread -byteorder="$ans" -$rm -f try.c try - -: see if dlfcn is available -set dlfcn.h i_dlfcn -eval $inhdr -: determine which dynamic loading, if any, to compile in -echo " " -case "$usedl" in -'') case "$i_dlfcn" in - define) dflt='y' ;; - *) dflt='n' ;; - esac - : Does a dl.c file exist for this operating system - $test -f ../ext/dl/dl_${osname}.c && dflt='y' - ;; -define|y|true) dflt='y' - usedl="$define" - ;; -*) dflt='n' - ;; +(I can't seem to compile the test program. Guessing big-endian...) +EOM + fi + ;; +*) + echo " " + dflt="$byteorder" + ;; esac -rp="Do you wish to attempt to use dynamic loading?" +rp="What is the order of bytes in a long?" . ./myread -usedl="$ans" -case "$ans" in -y*) usedl="$define" - if $test -f ../ext/dl/dl_${osname}.c ; then - dflt="ext/dl/dl_${osname}.c" - else - dflt='ext/dl/dl.c' - fi - echo "The following dynamic loading files are available:" - cd ..; ls -C ext/dl/dl*.c; cd UU - rp="Source file to use for dynamic loading" - fn="fne~" - . ./getfile - : emulate basename and dirname - xxx=`echo $ans | $sed -e 's@.*/\([^/]*\)$@\1@' -e 's@\.c$@@'` - dlobj=$xxx.o - dlsrc=$xxx.c - dldir=`echo $ans | $sed 's@\(.*\)/[^/]*$@\1@'` - case "$dldir" in - '') dldir="." ;; - *) ;; - esac - if $test -f ../$dldir/$dlsrc; then - usedl="$define" - else - echo "File $dlsrc does not exist -- ignored" - usedl="$undef" - fi - - cat << EOM +byteorder="$ans" +$rm -f try.c try -Some systems may require passing special flags to $cc -c to -compile modules that will be used to create a shared library. -To use no flags, say "none". +: how do we catenate cpp tokens here? +echo " " +echo "Checking to see how your cpp does stuff like catenate tokens..." >&4 +$cat >cpp_stuff.c <<'EOCP' +#define RCAT(a,b)a/**/b +#define ACAT(a,b)a ## b +RCAT(Rei,ser) +ACAT(Cir,cus) +EOCP +$cppstdin $cppflags $cppminus < cpp_stuff.c >cpp_stuff.out 2>&1 +if $contains 'Circus' cpp_stuff.out >/dev/null 2>&1; then + echo "Oh! Smells like ANSI's been here." + echo "We can catify or stringify, separately or together!" + cpp_stuff=42 +elif $contains 'Reiser' cpp_stuff.out >/dev/null 2>&1; then + echo "Ah, yes! The good old days!" + echo "However, in the good old days we don't know how to stringify and" + echo "catify at the same time." + cpp_stuff=1 +else + $cat >&4 <&4 <try.c <<'EOCP' +#if TRY & 1 +void main() { +#else +main() { +#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 -EOM - case "$shlibsuffix" in - '') - case "$osname" in - hpux) dflt='.sl' ;; - next) dflt='.so' ;; - sunos) dflt='.so' ;; - *) dflt='.so' ;; - esac - ;; - *) dflt="$shlibsuffix" - ;; - esac - rp="What is the suffix used for shared libraries?" - . ./myread - case "$ans" in - none) shlibsuffix='' ;; - *) shlibsuffix="$ans" ;; - esac - ;; -*) usedl="$undef" - : These are currently not used. - dlsrc='' - dlobj='' - dldir='' - lddlflags='' - ccdlflags='' - shlibsuffix='.o' - ;; +#if TRY & 4 + if(goo == moo) { + exit(0); + } +#endif + exit(0); +} +EOCP + if $cc -c -DTRY=$defvoidused try.c >.out 2>&1 ; then + voidflags=$defvoidused + echo "It appears to support void to the level $package wants ($defvoidused)." + 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 -c -DTRY=1 try.c >/dev/null 2>&1 ; then + echo "It supports 1..." + if $cc -c -DTRY=3 try.c >/dev/null 2>&1 ; then + echo "It also supports 2..." + if $cc -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 -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 -c -DTRY=13 try.c >/dev/null 2>&1 ; then + voidflags=13 + echo "But it supports 4 and 8." + else + if $cc -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 +dflt="$voidflags"; +rp="Your void support flags add up to what?" +. ./myread +voidflags="$ans" +$rm -f try.* .out + +: see if this is a db.h system +set db.h i_db +eval $inhdr + : see if we have the old dbm set dbm.h i_dbm eval $inhdr @@ -4629,185 +5984,192 @@ eval $inhdr set gdbm.h i_gdbm eval $inhdr -: see if sdbm.h is wanted echo " " -echo "$package includes an implementation of sdbm in ext/dbm/sdbm." -case "$i_sdbm" in - ''|' ') val="$define" ;; - *) val="$i_sdbm" ;; -esac -set i_sdbm -eval $setvar -case "$extensions" in -' '|'') echo "Looking for extensions..." - case "$find" in - *find*) - cd .. - extensions=`$find ext -type f -name \*.xs -print` - set X $extensions - shift - extensions="$*" - cd UU - ;; - *) extensions='ext/dbm/NDBM_File.xs ext/dbm/ODBM_File.xs ext/dbm/GDBM_File.xs ext/dbm/SDBM_File.xs ext/posix/POSIX.xs' - ;; - esac - ;; -none) extensions='' ;; -*) ;; -esac +echo "Looking for extensions..." >&4 +cd ../ext +known_extensions='' +for xxx in * ; do + if $test -f $xxx/$xxx.xs; then + known_extensions="$known_extensions $xxx" + fi +done +set X $known_extensions +shift +known_extensions="$*" +cd ../UU + : Now see which are supported on this system. -dflt="" -for xxx in $extensions ; do +avail_ext='' +for xxx in $known_extensions ; do case "$xxx" in - *ODBM*) case "$i_dbm" in - define) dflt="$dflt $xxx" ;; - *) ;; + DB_File) case "$i_db" in + $define) avail_ext="$avail_ext $xxx" ;; + esac + ;; + GDBM_File) case "$i_gdbm" in + $define) avail_ext="$avail_ext $xxx" ;; + esac + ;; + NDBM_File) case "$i_ndbm" in + $define) avail_ext="$avail_ext $xxx" ;; esac ;; - *NDBM*) case "$i_ndbm" in - define) dflt="$dflt $xxx" ;; - *) ;; + ODBM_File) case "$i_dbm" in + $define) avail_ext="$avail_ext $xxx" ;; esac ;; - *GDBM*) case "$i_gdbm" in - define) dflt="$dflt $xxx" ;; - *) ;; + POSIX) case "$useposix" in + true|define|y) avail_ext="$avail_ext $xxx" ;; esac ;; - *SDBM*) case "$i_sdbm" in - define) dflt="$dflt $xxx" ;; - *) ;; + Socket) case "$d_socket" in + $define) avail_ext="$avail_ext $xxx" ;; esac ;; - *) dflt="$dflt $xxx" + *) avail_ext="$avail_ext $xxx" ;; esac done -rp="What extensions do you wish to include?" +set X $avail_ext +shift +avail_ext="$*" + +case $usedl in +$define) + $cat </dev/null 2>&1 ; then - dflt='gid_t'; - else - 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 - fi +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";; +*) dflt="$gidtype";; esac echo " " rp="What is the type for group ids returned by getgid()?" . ./myread -val="$ans" -set gidtype -eval $setvar +gidtype="$ans" + : see if getgroups exists set getgroups d_getgrps eval $inlibc +: Find type of 2nd arg to getgroups +echo " " case "$d_getgrps" in 'define') - case "$groupstype" in + case "$groupstype" in '') dflt="$gidtype" ;; *) dflt="$groupstype" ;; - esac - echo " " - $cat < /dev/null 2>&1 ; then - lns="$ln -s" -else - lns="$ln" -fi -rm -f blurfl sym : see what type lseek is declared as in the kernel -case "$lseektype" in -'') - if $contains 'off_t;' `./findhdr sys/types.h` >/dev/null 2>&1 ; then - dflt='off_t'; - else - dflt='long'; - fi - ;; -*) dflt="$lseektype" - ;; -esac +set off_t lseektype long stdio.h sys/types.h +eval $typedef echo " " +dflt="$lseektype" rp="What type is lseek's offset on this system declared as?" . ./myread lseektype="$ans" @@ -4827,11 +6189,12 @@ esac echo "If you don't want the manual sources installed, answer 'none'." case "$mansrc" in '') - lookpath='/usr/local/man/man1 /usr/local/man/man1 /usr/man/manl' + lookpath="$prefix/man/man1 $prefix/man/u_man/man1 $prefix/man/l_man/man1" + lookpath="$lookpath /usr/local/man/man1 /usr/local/man/man1 /usr/man/manl" lookpath="$lookpath /usr/man/local/man1 /usr/man/l_man/man1" lookpath="$lookpath /usr/local/man/u_man/man1 /usr/local/man/l_man/man1" lookpath="$lookpath /usr/man/man.L" - mansrc=`./loc . $lookpath` + mansrc=`./loc . $prefix/man/man1 $lookpath` if $test -d "$mansrc"; then dflt="$mansrc" else @@ -4880,34 +6243,14 @@ case "$mansrc" in *) manext=1;; esac -: check for alignment requirements +: see what type is used for mode_t +set mode_t modetype int stdio.h sys/types.h +eval $typedef +dflt="$modetype" echo " " -case "$memalignbytes" in -'') echo "Checking alignment constraints..." >&4 - $cat >try.c <<'EOCP' -struct foobar { - char foo; - double bar; -} try; -main() -{ - printf("%d\n", (char *)&try.bar - (char *)&try.foo); -} -EOCP - if $cc $ccflags try.c -o try >/dev/null 2>&1; then - dflt=`./try` - else - dflt='8' - echo"(I can't seem to compile the test program...)" - fi - ;; -*) dflt="$memalignbytes" - ;; -esac -rp="Doubles must be aligned on a how-many-byte boundary?" +rp="What type is used for file modes?" . ./myread -memalignbytes="$ans" -$rm -f try.c try +modetype="$ans" : Cruising for prototypes echo " " @@ -4916,7 +6259,7 @@ $cat >prototype.c <<'EOCP' main(int argc, char *argv[]) { exit(0);} EOCP -if $cc -c prototype.c >prototype.out 2>&1 ; then +if $cc $ccflags -c prototype.c >prototype.out 2>&1 ; then echo "Your C compiler appears to support function prototypes." val="$define" else @@ -4927,34 +6270,6 @@ set prototype eval $setvar $rm -f prototype* -: check for length of pointer -echo " " -case "$ptrsize" in -'') - echo "Checking to see how big your pointers are..." >&4 - $cat >try.c <<'EOCP' -#include -main() -{ - printf("%d\n", sizeof(char *)); -} -EOCP - if $cc $ccflags try.c -o try >/dev/null 2>&1 ; then - dflt=`./try` - else - dflt='4' - echo "(I can't seem to compile the test program. Guessing...)" - fi - ;; -*) - dflt="$ptrsize" - ;; -esac -rp="What is the size of a pointer (in bytes)?" -. ./myread -ptrsize="$ans" -$rm -f try.c try - : check for size of random number generator echo " " case "$randbits" in @@ -4988,96 +6303,330 @@ EOCP dflt="$randbits" ;; esac -rp='How many bits does your rand() function produce?' -. ./myread -randbits="$ans" +rp='How many bits does your rand() function produce?' +. ./myread +randbits="$ans" +$rm -f try.c try + +: see if ar generates random libraries by itself +echo " " +echo "Checking how to generate random libraries on your machine..." >&4 +echo 'int bar1() { return bar2(); }' > bar1.c +echo 'int bar2() { return 2; }' > bar2.c +$cat > foo.c <<'EOP' +main() { printf("%d\n", bar1()); exit(0); } +EOP +$cc $ccflags -c bar1.c >/dev/null 2>&1 +$cc $ccflags -c bar2.c >/dev/null 2>&1 +$cc $ccflags -c foo.c >/dev/null 2>&1 +ar rc bar.a bar2.o bar1.o >/dev/null 2>&1 +if $cc $ccflags $ldflags -o foobar foo.o bar.a $libs > /dev/null 2>&1 && + ./foobar >/dev/null 2>&1; then + echo "ar appears to generate random libraries itself." + orderlib=false + ranlib=":" +elif ar ts bar.a >/dev/null 2>&1 && + $cc $ccflags $ldflags -o foobar foo.o bar.a $libs > /dev/null 2>&1 && + ./foobar >/dev/null 2>&1; then + echo "a table of contents needs to be added with 'ar ts'." + orderlib=false + ranlib="ar ts" +else + if $test -f /usr/bin/ranlib; then + ranlib=/usr/bin/ranlib + elif $test -f /bin/ranlib; then + ranlib=/bin/ranlib + elif $test -f /usr/local/bin/ranlib; then + ranlib=/usr/local/bin/ranlib + fi + + if $test -n "$ranlib"; then + echo "your system has $ranlib; we'll use that." + orderlib=false + else + echo "your system doesn't seem to support random libraries" + echo "so we'll use lorder and tsort to order the libraries." + orderlib=true + ranlib=":" + fi +fi +$rm -f foo* bar* + +: determine where public executable scripts go +case "$scriptdir" in +'') + dflt="$bin" + : guess some guesses + $test -d /usr/share/scripts && dflt=/usr/share/scripts + $test -d /usr/share/bin && dflt=/usr/share/bin + $test -d /usr/local/script && dflt=/usr/local/script + $test -d $prefix/script && dflt=$prefix/script + ;; +*) dflt="$scriptdir" + ;; +esac +$cat <, or both." >&4 +$echo $n "I'm now running the test program...$c" +$cat >try.c <<'EOCP' +#include +#ifdef I_TIME +#include +#endif +#ifdef I_SYSTIME +#ifdef SYSTIMEKERNEL +#define KERNEL +#endif +#include +#endif +#ifdef I_SYSSELECT +#include +#endif +main() +{ + struct tm foo; +#ifdef S_TIMEVAL + struct timeval bar; +#endif +#ifdef S_TIMEZONE + struct timezone tzp; +#endif + if (foo.tm_sec == foo.tm_sec) + exit(0); +#ifdef S_TIMEVAL + if (bar.tv_sec == bar.tv_sec) + exit(0); +#endif + exit(1); +} +EOCP +flags='' +s_timezone='' +sysselect='' +for s_timeval in '-DS_TIMEVAL' ''; do +for i_systimek in '' '-DSYSTIMEKERNEL'; do +for i_time in '' '-DI_TIME'; do +for i_systime in '-DI_SYSTIME' ''; do + case "$flags" in + '') $echo $n ".$c" + if $cc $ccflags \ + $i_time $i_systime $i_systimek $sysselect $s_timeval $s_timezone \ + try.c -o try >/dev/null 2>&1 ; then + set X $i_time $i_systime $i_systimek $sysselect $s_timeval + shift + flags="$*" + echo " " + $echo $n "Succeeded with $flags$c" + fi + ;; + esac +done +done +done +done +timeincl='' +echo " " +case "$flags" in +*SYSTIMEKERNEL*) i_systimek="$define" + timeincl=`./findhdr sys/time.h` + echo "We'll include with KERNEL defined." >&4;; +*) i_systimek="$undef";; +esac +case "$flags" in +*I_TIME*) i_time="$define" + timeincl=`./findhdr time.h`" $timeincl" + echo "We'll include ." >&4;; +*) i_time="$undef";; +esac +case "$flags" in +*I_SYSTIME*) i_systime="$define" + timeincl=`./findhdr sys/time.h`" $timeincl" + echo "We'll include ." >&4;; +*) i_systime="$undef";; +esac $rm -f try.c try -: see if ar generates random libraries by itself -echo " " -echo "Checking how to generate random libraries on your machine..." >&4 -$cat >a.c </dev/null 2>&1 -ar rc ran.a a.o >/dev/null 2>&1 -$cat >b.c </dev/null 2>&1; then - if $cc -o b b.c lib.a >/dev/null 2>&1; then - echo "ar appears to generate random libraries itself." - orderlib=false - ranlib=":" +: check for fd_set items +$cat <fd_set.c < +#ifdef HAS_SOCKET +#include /* Might include */ +#endif +#ifdef I_SYS_TIME +#include +#else +#ifdef I_SYS_SELECT +#include +#endif +#endif +main() { + fd_set fds; + +#ifdef TRYBITS + if(fds.fds_bits); +#endif + +#if defined(FD_SET) && defined(FD_CLR) && defined(FD_ISSET) && defined(FD_ZERO) + exit(0); +#else + exit(1); +#endif +} +EOCP +if $cc $ccflags -DTRYBITS fd_set.c -o fd_set >fd_set.out 2>&1 ; then + d_fds_bits="$define" + d_fd_set="$define" + echo "Well, your system knows about the normal fd_set typedef..." >&4 + if ./fd_set; then + echo "and you have the normal fd_set macros (just as I'd expect)." >&4 + d_fd_macros="$define" else - echo "a table of contents needs to be added with 'ar ts'." - orderlib=false - ranlib="ar ts" + $cat >&4 <<'EOM' +but not the normal fd_set macros! Gaaack! I'll have to cover for you. +EOM + d_fd_macros="$undef" fi else - if $test -f /usr/bin/ranlib; then - ranlib=/usr/bin/ranlib - elif $test -f /bin/ranlib; then - ranlib=/bin/ranlib - fi - - if $test -n "$ranlib"; then - echo "your system has $ranlib; we'll use that." - orderlib=false + $cat <<'EOM' +Hmm, your compiler has some difficulty with fd_set. Checking further... +EOM + if $cc $ccflags fd_set.c -o fd_set >fd_set.out 2>&1 ; then + d_fds_bits="$undef" + d_fd_set="$define" + echo "Well, your system has some sort of fd_set available..." >&4 + if ./fd_set; then + echo "and you have the normal fd_set macros." >&4 + d_fd_macros="$define" + else + $cat <<'EOM' +but not the normal fd_set macros! Gross! More work for me... +EOM + d_fd_macros="$undef" + fi else - echo "your system doesn't seem to support random libraries" - echo "so we'll use lorder and tsort to order the libraries." - orderlib=true - ranlib=":" + echo "Well, you got zip. That's OK, I can roll my own fd_set stuff." >&4 + d_fd_set="$undef" + d_fds_bits="$undef" + d_fd_macros="$undef" fi fi -$rm -f a.* b.c b.o b ran.a lib.a +$rm -f fd_set* + + +: check for type of arguments to select. This will only really +: work if the system supports prototypes and provides one for +: select. +case "$d_select" in +$define) + : Make initial guess + case "$selecttype" in + ''|' ') + case "$d_fd_set" in + $define) xxx='fd_set *' ;; + *) xxx='int *' ;; + esac + ;; + *) xxx="$selecttype" + ;; + esac + : backup guess + case "$xxx" in + 'fd_set *') yyy='int *' ;; + 'int *') yyy='fd_set *' ;; + esac -: determine where public executables go -case "$scriptdir" in -'') - dflt="$bin" - : guess some guesses - $test -d /usr/share/scripts && dflt=/usr/share/scripts - $test -d /usr/share/bin && dflt=/usr/share/bin - $test -d /usr/local/script && dflt=/usr/local/script - ;; -*) dflt="$scriptdir" - ;; -esac -$cat <try.c < +#ifdef HAS_SOCKET +#include /* Might include */ +#endif +#ifdef I_SYS_TIME +#include +#else +#ifdef I_SYS_SELECT +#include +#endif +#endif +main() +{ + int width; + Select_fd_set_t readfds; + Select_fd_set_t writefds; + Select_fd_set_t exceptfds; + struct timeval timeout; + select(width, readfds, writefds, exceptfds, &timeout); + exit(0); +} +EOCP + if $cc $ccflags -c -DSelect_fd_set_t="$xxx" try.c >/dev/null 2>&1 ; then + selecttype="$xxx" + echo "Your system uses $xxx for the arguments to select." >&4 + elif $cc $ccflags -c -DSelect_fd_set_t="$yyy" try.c >/dev/null 2>&1 ; then + selecttype="$yyy" + echo "Your system uses $yyy for the arguments to select." >&4 + else + rp='What is the type for the 2nd, 3rd, and 4th arguments to select?' + dflt="$xxx" + . ./myread + selecttype="$ans" + fi + $rm -f try.[co] + ;; +*) selecttype = 'int *' + ;; +esac : generate list of signal names echo " " @@ -5119,168 +6668,120 @@ END { ;; esac sig_name="ZERO $*" - ;; -esac -echo "The following signals are available:" -echo $sig_name | - $awk 'BEGIN { linelen = 0 } - { for (i = 1; i < NF; i++) - { - name = "SIG" $i " " - linelen = linelen + length(name) - if (linelen > 70) - { - printf "\n" - linelen = length(name) - } - printf "%s", name } }' -: see what type of char stdio uses. -echo " " -if $contains 'unsigned.*char.*_ptr;' `./findhdr stdio.h` >/dev/null 2>&1 ; then - echo "Your stdio uses unsigned chars." >&4 - stdchar="unsigned char" -else - echo "Your stdio uses signed chars." >&4 - stdchar="char" -fi - -: see if time exists -echo " " -if set time val -f d_time; eval $csym; $val; then - echo 'time() found.' >&4 - val="$define" - case "$timetype" in - '') - if $contains 'time_t;' `./findhdr sys/types.h` >/dev/null 2>&1 ; then - dflt='time_t'; - else - dflt='long'; - fi - ;; - *) dflt="$timetype" - ;; - esac - echo " " - rp="What type is returned by time() on this sytem?" - . ./myread - timetype="$ans" -else - echo 'time() not found, hope that will do.' >&4 - val="$undef" - timetype='int'; -fi -set d_time -eval $setvar - -: see what type uids are declared as in the kernel -case "$uidtype" in -'') - if $contains 'uid_t;' `./findhdr sys/types.h` >/dev/null 2>&1 ; then - dflt='uid_t'; - else - xxx=`./findhdr sys/user.h` - set `grep '_ruid;' "$xxx" 2>/dev/null` unsigned short - case $1 in - unsigned) dflt="$1 $2" ;; - *) dflt="$1" ;; - esac - fi - ;; -*) dflt="$uidtype";; -esac -echo " " -rp="What type are user ids on this system declared as?" -. ./myread -uidtype="$ans" - -: check for void type -echo " " -$cat >&4 <try.c <<'EOCP' -#if TRY & 1 -void main() { -#else -main() { -#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); -} -EOCP - if $cc -c -DTRY=$defvoidused try.c >.out 2>&1 ; then - voidflags=$defvoidused - echo "It appears to support void to the level $package wants ($defvoidused)." - 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 -c -DTRY=1 try.c >/dev/null 2>&1 ; then - echo "It supports 1..." - if $cc -c -DTRY=3 try.c >/dev/null 2>&1 ; then - echo "It also supports 2..." - if $cc -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 -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 -c -DTRY=13 try.c >/dev/null 2>&1 ; then - voidflags=13 - echo "But it supports 4 and 8." - else - if $cc -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 -dflt="$voidflags"; -rp="Your void support flags add up to what?" +echo "The following signals are available:" +echo " " +echo $sig_name | $awk \ +'BEGIN { linelen = 0 } +{ + for (i = 1; i < NF; i++) { + name = "SIG" $i " " + linelen = linelen + length(name) + if (linelen > 70) { + printf "\n" + linelen = length(name) + } + printf "%s", name + } +}' +echo " " + +: see what type is used for size_t +set size_t sizetype 'unsigned int' stdio.h sys/types.h +eval $typedef +dflt="$sizetype" +echo " " +rp="What type is used for the length parameter for string functions?" . ./myread -voidflags="$ans" -$rm -f try.* .out +sizetype="$ans" + +: see what type is used for signed size_t +set ssize_t ssizetype int stdio.h sys/types.h +eval $typedef +dflt="$ssizetype" +$cat > ssize.c < +#include +#define Size_t $sizetype +#define SSize_t $dflt +main() +{ + if (sizeof(Size_t) == sizeof(SSize_t)) + printf("$dflt\n"); + else if (sizeof(Size_t) == sizeof(int)) + printf("int\n"); + else + printf("long\n"); +} +EOM +echo " " +if $cc $ccflags $ldflags -o ssize ssize.c $libs > /dev/null 2>&1 ; then + ssizetype=`./ssize` + echo "I'll be using $ssizetype for functions returning a byte count." >&4 +else + echo "(I can't compile the test program--please enlighten me!)" + $cat </dev/null 2>&1 ; then + echo "Your stdio uses unsigned chars." >&4 + stdchar="unsigned char" +else + echo "Your stdio uses signed chars." >&4 + stdchar="char" +fi + +: see if time exists +echo " " +if set time tval -f d_time; eval $csym; $tval; then + echo 'time() found.' >&4 + tval="$define" + set time_t timetype long stdio.h sys/types.h + eval $typedef + dflt="$timetype" + echo " " + rp="What type is returned by time() on this sytem?" + . ./myread + timetype="$ans" +else + echo 'time() not found, hope that will do.' >&4 + tval="$undef" + timetype='int'; +fi +val=$tval +set d_time +eval $setvar + +: see what type uids are declared as in the kernel +set uid_t uidtype xxx stdio.h sys/types.h +eval $typedef +case "$uidtype" in +xxx) + xxx=`./findhdr sys/user.h` + set `grep '_ruid;' "$xxx" 2>/dev/null` unsigned short + case $1 in + unsigned) dflt="$1 $2" ;; + *) dflt="$1" ;; + esac + ;; +*) dflt="$uidtype";; +esac +echo " " +rp="What is the type for user ids returned by getuid()?" +. ./myread +uidtype="$ans" : determine compiler compiler case "$yacc" in @@ -5290,18 +6791,15 @@ case "$yacc" in dflt="$yacc";; esac echo " " -rp="yacc" +comp='yacc' if $test -f "$byacc"; then dflt="$byacc" - rp="byacc or $rp" + comp="byacc or $comp" fi if $test -f "$bison"; then - rp="$rp or bison -y" + comp="$comp or bison -y" fi -$cat < mem.h - if $contains 'memcpy' mem.h >/dev/null 2>&1; then - echo "We won't be including " - i_memory="$undef" - fi - rm -f mem.h - ;; - esac +case "$val" in +$define) + case "$strings" in + '') ;; + *) + $cppstdin $cppflags $cppminus < $strings > mem.h + if $contains 'memcpy' mem.h >/dev/null 2>&1; then + echo " " + echo "We won't be including ." + val="$undef" + fi + $rm -f mem.h + ;; + esac esac -: see if there are directory access routines out there -echo " " -if $test `./findhdr ndir.h` && \ - ( $test -r /usr/lib/libndir.a || $test -r /usr/local/lib/libndir.a ); then - echo "Ndir library found." >&4 - if $test -r /usr/lib/libndir.a; then - ndirlib='-lndir' - else - ndirlib="/usr/local/lib/libndir.a" - fi - i_ndir="$define" - d_usendir="$undef" - ndirc='' - ndiro='' -else - ndirlib='' - i_ndir="$undef" - if set readdir val -f; eval $csym; $val; then - echo "No ndir library found, but you have readdir() so we'll use that." >&4 - d_usendir="$undef" - ndirc='' - ndiro='' - else - echo "No ndir library found--using ./ndir.c." >&4 - d_usendir="$define" - ndirc='ndir.c' - ndiro='ndir.o' - fi -fi +set i_memory +eval $setvar : see if net/errno.h is available -set net/errno.h i_neterrno +val='' +set net/errno.h val eval $inhdr + : Unfortunately, it causes problems on some systems. Arrgh. -case '$i_neterrno' in -'define') echo " found." - cat > try.c <<'EOM' +case "$val" in +$define) + cat > try.c <<'EOM' #include #include #include int func() { -int x; -x = ENOTSOCK; -return x; + return ENOTSOCK; } EOM - if $cc $ccflags -c try.c >/dev/null 2>&1; then - i_neterrno="$define" - else - echo "But it causes problems, so we won't include it" - i_neterrno="$undef" - fi - $rm -f try.* try - ;; + if $cc $ccflags -c try.c >/dev/null 2>&1; then + echo "We'll be including ." >&4 + else + echo "We won't be including ." >&4 + val="$undef" + fi + $rm -f try.* try + ;; esac -: see if stdarg is available -set stdarg.h i_stdarg -eval $inhdr - -: see if stddef is available -set stddef.h i_stddef -eval $inhdr - -: see if this is an sysdir system -set sys/dir.h i_sysdir -eval $inhdr +set i_neterrno +eval $setvar : get C preprocessor symbols handy echo " " -echo $attrlist | $tr ' ' '\012' >Cppsym.know +echo $al | $tr ' ' '\012' >Cppsym.know $cat <Cppsym $startsh case "\$1" in @@ -5507,7 +6977,7 @@ EOSS chmod +x Cppsym $eunicefix Cppsym echo "Your C preprocessor defines the following symbols:" -Cppsym -l $attrlist >Cppsym.true +Cppsym -l $al >Cppsym.true $cat Cppsym.true : see if this is a termio system @@ -5565,130 +7035,23 @@ set i_termio; eval $setvar val=$val2; set i_sgtty; eval $setvar val=$val3; set i_termios; eval $setvar -: see if ioctl defs are in sgtty/termio or sys/ioctl +: see if stdarg is available echo " " -if $test `./findhdr sys/ioctl.h`; then - val="$define" - echo " found." >&4 +if $test `./findhdr stdarg.h`; then + echo " found." >&4 + valstd="$define" else - val="$undef" - $test $i_termio = "$define" && xxx="termio.h" - $test $i_termios = "$define" && xxx="termios.h" - $test $i_sgtty = "$define" && xxx="sgtty.h" -echo "No found, assuming ioctl args are defined in <$xxx>." >&4 + echo " NOT found." >&4 + valstd="$undef" fi -set i_sysioctl -eval $setvar - -: see if this is an sysndir system -set sys/ndir.h i_sysndir -eval $inhdr - -: see if sys/select.h has to be included -set sys/select.h i_sysselct -eval $inhdr - -: see if we should include time.h, sys/time.h, or both -echo " " -echo "Testing to see if we should include , or both." >&4 -$echo $n "I'm now running the test program...$c" -$cat >try.c <<'EOCP' -#include -#ifdef I_TIME -#include -#endif -#ifdef I_SYSTIME -#ifdef SYSTIMEKERNEL -#define KERNEL -#endif -#include -#endif -#ifdef I_SYSSELECT -#include -#endif -main() -{ - struct tm foo; -#ifdef S_TIMEVAL - struct timeval bar; -#endif -#ifdef S_TIMEZONE - struct timezone tzp; -#endif - if (foo.tm_sec == foo.tm_sec) - exit(0); -#ifdef S_TIMEVAL - if (bar.tv_sec == bar.tv_sec) - exit(0); -#endif - exit(1); -} -EOCP -flags='' -s_timezone='' -sysselect='' -for s_timeval in '-DS_TIMEVAL' ''; do -for i_systimek in '' '-DSYSTIMEKERNEL'; do -for i_time in '' '-DI_TIME'; do -for i_systime in '-DI_SYSTIME' ''; do - case "$flags" in - '') $echo $n ".$c" - if $cc $ccflags \ - $i_time $i_systime $i_systimek $sysselect $s_timeval $s_timezone \ - try.c -o try >/dev/null 2>&1 ; then - set X $i_time $i_systime $i_systimek $sysselect $s_timeval - shift - flags="$*" - echo " " - $echo $n "Succeeded with $flags$c" - fi - ;; - esac -done -done -done -done -timeincl='' -echo " " -case "$flags" in -*SYSTIMEKERNEL*) i_systimek="$define" - timeincl=`./findhdr sys/time.h` - echo "We'll include with KERNEL defined." >&4;; -*) i_systimek="$undef";; -esac -case "$flags" in -*I_TIME*) i_time="$define" - timeincl=`./findhdr time.h`" $timeincl" - echo "We'll include ." >&4;; -*) i_time="$undef";; -esac -case "$flags" in -*I_SYSTIME*) i_systime="$define" - timeincl=`./findhdr sys/time.h`" $timeincl" - echo "We'll include ." >&4;; -*) i_systime="$undef";; -esac -$rm -f try.c try - -: see if this is a unistd.h system -set unistd.h i_unistd -eval $inhdr -: see if this is an utime system -set utime.h i_utime -eval $inhdr - -: see if this is a varargs system +: see if varags is available echo " " if $test `./findhdr varargs.h`; then - val="$define" echo " found." >&4 else - val="$undef" echo " NOT found, but that's ok (I hope)." >&4 fi -set i_varargs -eval $setvar : set up the varargs testing programs $cat > varargs.c <&4 + val="$undef"; set i_stdarg; eval $setvar + val="$undef"; set i_varargs; eval $setvar ;; -*) echo "We'll include <$i_varhdr> to get va_dcl definition." >&4;; +*) + set i_varhdr + eval $setvar + case "$i_varhdr" in + stdarg.h) + val="$define"; set i_stdarg; eval $setvar + val="$undef"; set i_varargs; eval $setvar + ;; + varargs.h) + val="$undef"; set i_stdarg; eval $setvar + val="$define"; set i_varargs; eval $setvar + ;; + esac + echo "We'll include <$i_varhdr> to get va_dcl definition." >&4;; esac $rm -f varargs* +: see if stddef is available +set stddef.h i_stddef +eval $inhdr + +: see if stdlib is available +set stdlib.h i_stdlib +eval $inhdr + +: see if ioctl defs are in sgtty, termio, sys/filio or sys/ioctl +set sys/filio.h i_sysfilio +eval $inhdr +echo " " +if $test `./findhdr sys/ioctl.h`; then + val="$define" + echo ' found.' >&4 +else + val="$undef" + if $test $i_sysfilio = "$define"; then + echo ' NOT found.' >&4 + else + $test $i_sgtty = "$define" && xxx="sgtty.h" + $test $i_termio = "$define" && xxx="termio.h" + $test $i_termios = "$define" && xxx="termios.h" +echo "No found, assuming ioctl args are defined in <$xxx>." >&4 + fi +fi +set i_sysioctl +eval $setvar + +: see if this is a sys/param system +set sys/param.h i_sysparam +eval $inhdr + +: see if this is a unistd.h system +set unistd.h i_unistd +eval $inhdr + +: see if this is an utime system +set utime.h i_utime +eval $inhdr + : see if this is a vfork system case "$d_vfork" in -define) set vfork.h i_vfork +"$define") + set vfork.h i_vfork eval $inhdr ;; -*) i_vfork="$undef";; +*) + i_vfork="$undef" + ;; esac + : end of configuration questions echo " " echo "End of configuration questions." @@ -5803,7 +7224,11 @@ $startsh # Configured by: $cf_by # Target system: $myuname +dynamic_ext='$dynamic_ext' extensions='$extensions' +known_extensions='$known_extensions' +static_ext='$static_ext' +useposix='$useposix' d_eunice='$d_eunice' d_xenix='$d_xenix' eunicefix='$eunicefix' @@ -5872,6 +7297,7 @@ uniq='$uniq' uuname='$uuname' vi='$vi' zcat='$zcat' +libswanted='$libswanted' hint='$hint' myuname='$myuname' osname='$osname' @@ -5887,7 +7313,12 @@ Revision='$Revision' Source='$Source' State='$State' afs='$afs' -memalignbytes='$memalignbytes' +alignbytes='$alignbytes' +archlib='$archlib' +archlibexp='$archlibexp' +archname='$archname' +d_archlib='$d_archlib' +installarchlib='$installarchlib' bin='$bin' binexp='$binexp' installbin='$installbin' @@ -5902,11 +7333,14 @@ optimize='$optimize' cf_by='$cf_by' cf_time='$cf_time' contains='$contains' +cpp_stuff='$cpp_stuff' cpplast='$cpplast' cppminus='$cppminus' cpprun='$cpprun' cppstdin='$cppstdin' d_access='$d_access' +d_alarm='$d_alarm' +d_attrib='$d_attrib' d_bcmp='$d_bcmp' d_bcopy='$d_bcopy' d_bzero='$d_bzero' @@ -5914,48 +7348,86 @@ d_casti32='$d_casti32' castflags='$castflags' d_castneg='$d_castneg' d_charsprf='$d_charsprf' +d_chown='$d_chown' +d_chroot='$d_chroot' d_chsize='$d_chsize' +d_closedir='$d_closedir' +d_void_closedir='$d_void_closedir' d_const='$d_const' cryptlib='$cryptlib' d_crypt='$d_crypt' d_csh='$d_csh' +d_cuserid='$d_cuserid' +d_dbl_dig='$d_dbl_dig' +d_difftime='$d_difftime' +d_dlerror='$d_dlerror' +d_dlopen='$d_dlopen' +d_dlsymun='$d_dlsymun' d_dosuid='$d_dosuid' +d_suidsafe='$d_suidsafe' +d_drem='$d_drem' d_dup2='$d_dup2' d_fchmod='$d_fchmod' d_fchown='$d_fchown' d_fcntl='$d_fcntl' +d_fd_macros='$d_fd_macros' +d_fd_set='$d_fd_set' +d_fds_bits='$d_fds_bits' +d_fgetpos='$d_fgetpos' d_flexfnam='$d_flexfnam' d_flock='$d_flock' +d_fmod='$d_fmod' +d_fork='$d_fork' +d_fsetpos='$d_fsetpos' +d_Gconvert='$d_Gconvert' d_getgrps='$d_getgrps' d_gethent='$d_gethent' aphostname='$aphostname' d_gethname='$d_gethname' d_phostname='$d_phostname' d_uname='$d_uname' +d_getlogin='$d_getlogin' d_getpgrp2='$d_getpgrp2' d_getpgrp='$d_getpgrp' +d_getppid='$d_getppid' d_getprior='$d_getprior' +d_group='$d_group' d_htonl='$d_htonl' d_isascii='$d_isascii' d_killpg='$d_killpg' d_link='$d_link' +d_linuxstd='$d_linuxstd' +d_locconv='$d_locconv' +d_lockf='$d_lockf' d_lstat='$d_lstat' +d_mblen='$d_mblen' +d_mbstowcs='$d_mbstowcs' +d_mbtowc='$d_mbtowc' d_memcmp='$d_memcmp' d_memcpy='$d_memcpy' d_memmove='$d_memmove' d_memset='$d_memset' d_mkdir='$d_mkdir' +d_mkfifo='$d_mkfifo' +d_mktime='$d_mktime' d_msg='$d_msg' d_msgctl='$d_msgctl' d_msgget='$d_msgget' d_msgrcv='$d_msgrcv' d_msgsnd='$d_msgsnd' +d_nice='$d_nice' d_open3='$d_open3' +d_passwd='$d_passwd' +d_fpathconf='$d_fpathconf' +d_pathconf='$d_pathconf' +d_pause='$d_pause' +d_pipe='$d_pipe' d_portable='$d_portable' d_readdir='$d_readdir' d_rewinddir='$d_rewinddir' d_seekdir='$d_seekdir' d_telldir='$d_telldir' +d_readlink='$d_readlink' d_rename='$d_rename' d_rmdir='$d_rmdir' d_safebcpy='$d_safebcpy' @@ -5967,6 +7439,7 @@ d_semget='$d_semget' d_semop='$d_semop' d_setegid='$d_setegid' d_seteuid='$d_seteuid' +d_setlinebuf='$d_setlinebuf' d_setlocale='$d_setlocale' d_setpgid='$d_setpgid' d_setpgrp2='$d_setpgrp2' @@ -5982,7 +7455,8 @@ d_setruid='$d_setruid' d_setsid='$d_setsid' d_shm='$d_shm' d_shmat='$d_shmat' -d_voidshmat='$d_voidshmat' +d_shmatprototype='$d_shmatprototype' +shmattype='$shmattype' d_shmctl='$d_shmctl' d_shmdt='$d_shmdt' d_shmget='$d_shmget' @@ -5995,25 +7469,28 @@ d_statblks='$d_statblks' d_stdstdio='$d_stdstdio' d_index='$d_index' d_strchr='$d_strchr' +d_strcoll='$d_strcoll' d_strctcpy='$d_strctcpy' d_strerrm='$d_strerrm' d_strerror='$d_strerror' d_sysernlst='$d_sysernlst' d_syserrlst='$d_syserrlst' +d_strxfrm='$d_strxfrm' d_symlink='$d_symlink' d_syscall='$d_syscall' +d_sysconf='$d_sysconf' d_system='$d_system' +d_tcgetpgrp='$d_tcgetpgrp' +d_tcsetpgrp='$d_tcsetpgrp' d_time='$d_time' timetype='$timetype' clocktype='$clocktype' d_times='$d_times' d_truncate='$d_truncate' -d_usendir='$d_usendir' -i_ndir='$i_ndir' -ndirc='$ndirc' -ndirlib='$ndirlib' -ndiro='$ndiro' +d_tzname='$d_tzname' +d_umask='$d_umask' d_vfork='$d_vfork' +usevfork='$usevfork' d_voidsig='$d_voidsig' signal_t='$signal_t' d_volatile='$d_volatile' @@ -6021,25 +7498,33 @@ d_charvspr='$d_charvspr' d_vprintf='$d_vprintf' d_wait4='$d_wait4' d_waitpid='$d_waitpid' +d_wcstombs='$d_wcstombs' +d_wctomb='$d_wctomb' +dlext='$dlext' cccdlflags='$cccdlflags' ccdlflags='$ccdlflags' -dldir='$dldir' -dlobj='$dlobj' dlsrc='$dlsrc' lddlflags='$lddlflags' -shlibsuffix='$shlibsuffix' usedl='$usedl' +fpostype='$fpostype' gidtype='$gidtype' groupstype='$groupstype' h_fcntl='$h_fcntl' h_sysfile='$h_sysfile' +i_db='$i_db' i_dbm='$i_dbm' d_dirnamlen='$d_dirnamlen' +direntrytype='$direntrytype' i_dirent='$i_dirent' +i_dld='$i_dld' i_dlfcn='$i_dlfcn' i_fcntl='$i_fcntl' +i_float='$i_float' i_gdbm='$i_gdbm' i_grp='$i_grp' +i_limits='$i_limits' +i_malloc='$i_malloc' +i_math='$i_math' i_memory='$i_memory' i_ndbm='$i_ndbm' i_neterrno='$i_neterrno' @@ -6052,19 +7537,21 @@ d_pwcomment='$d_pwcomment' d_pwexpire='$d_pwexpire' d_pwquota='$d_pwquota' i_pwd='$i_pwd' -i_sdbm='$i_sdbm' -i_stdarg='$i_stdarg' i_stddef='$i_stddef' +i_stdlib='$i_stdlib' i_string='$i_string' strings='$strings' i_sysdir='$i_sysdir' i_sysfile='$i_sysfile' d_voidtty='$d_voidtty' i_bsdioctl='$i_bsdioctl' +i_sysfilio='$i_sysfilio' i_sysioctl='$i_sysioctl' i_syssockio='$i_syssockio' i_sysndir='$i_sysndir' +i_sysparam='$i_sysparam' i_sysselct='$i_sysselct' +i_systimes='$i_systimes' i_sgtty='$i_sgtty' i_termio='$i_termio' i_termios='$i_termios' @@ -6074,13 +7561,13 @@ i_time='$i_time' timeincl='$timeincl' i_unistd='$i_unistd' i_utime='$i_utime' +i_stdarg='$i_stdarg' i_varargs='$i_varargs' i_varhdr='$i_varhdr' i_vfork='$i_vfork' intsize='$intsize' -lib='$lib' -libexp='$libexp' libc='$libc' +glibpth='$glibpth' libpth='$libpth' plibpth='$plibpth' xlibpth='$xlibpth' @@ -6102,6 +7589,7 @@ medium='$medium' models='$models' small='$small' split='$split' +modetype='$modetype' mydomain='$mydomain' myhostname='$myhostname' phostname='$phostname' @@ -6114,19 +7602,23 @@ orderlib='$orderlib' ranlib='$ranlib' package='$package' spackage='$spackage' +prefix='$prefix' installprivlib='$installprivlib' privlib='$privlib' privlibexp='$privlibexp' prototype='$prototype' -ptrsize='$ptrsize' randbits='$randbits' installscript='$installscript' scriptdir='$scriptdir' scriptdirexp='$scriptdirexp' +selecttype='$selecttype' sig_name='$sig_name' +sizetype='$sizetype' +so='$so' sharpbang='$sharpbang' shsharp='$shsharp' spitshell='$spitshell' +ssizetype='$ssizetype' startsh='$startsh' stdchar='$stdchar' sysman='$sysman' @@ -6238,4 +7730,6 @@ fi $rm -f kit*isdone ark*isdone $rm -rf UU + : End of Configure + diff --git a/perl5-notes b/Doc/perl5-notes similarity index 100% rename from perl5-notes rename to Doc/perl5-notes diff --git a/EXTERN.h b/EXTERN.h index 44d2fe4..765c558 100644 --- a/EXTERN.h +++ b/EXTERN.h @@ -1,20 +1,10 @@ -/* $RCSfile: EXTERN.h,v $$Revision: 4.1 $$Date: 92/08/07 17:18:03 $ +/* EXTERN.h * - * Copyright (c) 1991, Larry Wall + * Copyright (c) 1991-1994, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. * - * $Log: EXTERN.h,v $ - * Revision 4.1 92/08/07 17:18:03 lwall - * Stage 6 Snapshot - * - * Revision 4.0.1.1 91/06/07 10:10:32 lwall - * patch4: new copyright notice - * - * Revision 4.0 91/03/20 00:58:26 lwall - * 4.0 baseline. - * */ #undef EXT diff --git a/HelpWanted b/HelpWanted deleted file mode 100644 index d4dcca9..0000000 --- a/HelpWanted +++ /dev/null @@ -1,13 +0,0 @@ -Anything in Todo that strikes your fancy and I agree to the design of - -Configure support - Dynamic loading - libperl.so - Drop-in module directories - -Test suite enhancement - POSIX - -Extension interface - Documentation - xvarpp diff --git a/INTERN.h b/INTERN.h index 780c122..7a9d475 100644 --- a/INTERN.h +++ b/INTERN.h @@ -1,20 +1,10 @@ -/* $RCSfile: INTERN.h,v $$Revision: 4.1 $$Date: 92/08/07 17:18:04 $ +/* INTERN.h * - * Copyright (c) 1991, Larry Wall + * Copyright (c) 1991-1994, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. * - * $Log: INTERN.h,v $ - * Revision 4.1 92/08/07 17:18:04 lwall - * Stage 6 Snapshot - * - * Revision 4.0.1.1 91/06/07 10:10:42 lwall - * patch4: new copyright notice - * - * Revision 4.0 91/03/20 00:58:35 lwall - * 4.0 baseline. - * */ #undef EXT diff --git a/MANIFEST b/MANIFEST index a71f86d..d06638a 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,73 +1,37 @@ Artistic The "Artistic License" -Configure Portability tool +Changes Differences between Perl 4 and Perl 5 +Configure Portability tool Copying The GNU General Public License +Doc/perl5-notes Samples of new functionality EXTERN.h Included before foreign .h files INTERN.h Included before domestic .h files MANIFEST This list of files Makefile.SH A script that generates Makefile README The Instructions -README.ncr Special instructions for NCR -README.uport Special instructions for Microports -README.xenix Special instructions for Xenix -XSUB.h -atarist/FILES -atarist/README.ST -atarist/RESULTS -atarist/atarist.c -atarist/config.h -atarist/echo.c -atarist/explain -atarist/makefile.sm -atarist/makefile.st -atarist/osbind.pl -atarist/perldb.diff -atarist/perlglob.c -atarist/test/binhandl -atarist/test/ccon -atarist/test/dbm -atarist/test/err -atarist/test/gdbm -atarist/test/gdbm.t -atarist/test/glob -atarist/test/osexample.pl -atarist/test/pi.pl -atarist/test/printenv -atarist/test/readme -atarist/test/sig -atarist/test/tbinmode -atarist/usersub.c -atarist/usub/README.ATARI -atarist/usub/acurses.mus -atarist/usub/makefile.st -atarist/usub/usersub.c -atarist/wildmat.c -autosplit -av.c -av.h -bar.pm +README.vms Notes about VMS +Todo The Wishlist +XSUB.h Include file for extension subroutines +autosplit Splits up autoloader functions +av.c Array value code +av.h Array value header c2ph.SH program to translate dbx stabs to perl c2ph.doc documentation for c2ph cflags.SH A script that emits C compilation flags per file -client A client to test sockets config.H Sample config.h config_h.SH Produces config.h configpm Produces lib/Config.pm -cop.h -cv.h -deb.c -dlperl/Makefile -dlperl/dlperl.c -dlperl/dlperl.doc -dlperl/dlperl.man -dlperl/usersub.c +cop.h Control operator header +cv.h Code value header +deb.c Debugging routines doSH Script to run all the *.SH files doio.c I/O operations doop.c Support code for various operations -dosish.h +dosish.h Some defines for MS/DOSish machines dump.c Debugging output eg/ADB An adb wrapper to put in your crash dir eg/README Intro to example perl scripts eg/changes A program to list recently changed files +eg/client A sample client eg/down A program to do things to subdirectories eg/dus A program to do du -s on non-mounted dirs eg/findcp A find wrapper that implements a -cp switch @@ -93,86 +57,109 @@ eg/scan/scan_ps Scan for process anomalies eg/scan/scan_sudo Scan for sudo anomalies eg/scan/scan_suid Scan for setuid anomalies eg/scan/scanner An anomaly reporter +eg/server A sample server eg/shmkill A program to remove unused shared memory eg/sysvipc/README Intro to Sys V IPC examples eg/sysvipc/ipcmsg Example of SYS V IPC message queues eg/sysvipc/ipcsem Example of Sys V IPC semaphores eg/sysvipc/ipcshm Example of Sys V IPC shared memory eg/travesty A program to print travesties of its input text -eg/unuc.pats -eg/uudecode +eg/unuc Un-uppercases an all-uppercase text +eg/uudecode A version of uudecode eg/van/empty A program to empty the trashcan eg/van/unvanish A program to undo what vanish does eg/van/vanexp A program to expire vanished files eg/van/vanish A program to put files in a trashcan eg/who A sample who program -emacs/cperl-mode -emacs/emacs19 +eg/wrapsuid A setuid script wrapper generator +emacs/cperl-mode An alternate perl-mode +emacs/emacs19 Notes about emacs 19 emacs/perl-mode.el Emacs major mode for perl emacs/perldb.el Emacs debugging emacs/perldb.pl Emacs debugging emacs/tedstuff Some optional patches -embed_h.SH -ext/README -ext/curses/Makefile -ext/curses/bsdcurses.mus -ext/curses/curses.mus -ext/curses/pager -ext/dbm/GDBM_File.xs GDBM extension -ext/dbm/Makefile -ext/dbm/NDBM_File.xs NDBM extension -ext/dbm/ODBM_File.xs ODBM extension -ext/dbm/SDBM_File.xs SDBM extension -ext/dbm/sdbm/CHANGES -ext/dbm/sdbm/COMPARE -ext/dbm/sdbm/Makefile.SH -ext/dbm/sdbm/README.too -ext/dbm/sdbm/biblio -ext/dbm/sdbm/dba.c -ext/dbm/sdbm/dbd.c -ext/dbm/sdbm/dbe.1 -ext/dbm/sdbm/dbe.c -ext/dbm/sdbm/dbm.c -ext/dbm/sdbm/dbm.h -ext/dbm/sdbm/dbu.c -ext/dbm/sdbm/grind -ext/dbm/sdbm/hash.c -ext/dbm/sdbm/linux.patches -ext/dbm/sdbm/makefile.sdbm -ext/dbm/sdbm/pair.c -ext/dbm/sdbm/pair.h -ext/dbm/sdbm/readme.ms -ext/dbm/sdbm/readme.ps -ext/dbm/sdbm/sdbm.3 -ext/dbm/sdbm/sdbm.c -ext/dbm/sdbm/sdbm.h -ext/dbm/sdbm/tune.h -ext/dbm/sdbm/util.c -ext/dbm/typemap -ext/dl/dl_hpux.c Dynamic loading for HPUX. -ext/dl/dl_next.c Dynamic loading for NeXT -ext/dl/dl_sunos.c Dynamic loading for SunOS 4.1.? -ext/dl/eg/Makefile -ext/dl/eg/Makefile.att -ext/dl/eg/main.c -ext/dl/eg/test.c -ext/dl/eg/test1.c -ext/man2mus -ext/mus -ext/posix/POSIX.xs -ext/posix/typemap -ext/typemap -ext/typemap.oi -ext/typemap.xlib -ext/typemap.xpm -ext/xsubpp -ext/xvarpp +embed.h Maps symbols to safer names +embed_h.SH Produces embed.h +ext/DB_File/DB_File.pm Berkeley DB extension Perl module +ext/DB_File/DB_File.xs Berkeley DB extension external subroutines +ext/DB_File/DB_File_BS Berkeley DB extension mkbootstrap fodder +ext/DB_File/Makefile.SH Berkeley DB extension makefile writer +ext/DB_File/typemap Berkeley DB extension interface types +ext/DynaLoader/DynaLoader.doc Dynamic Loader specification +ext/DynaLoader/DynaLoader.pm Dynamic Loader perl module +ext/DynaLoader/Makefile.SH Dynamic Loader makefile writer +ext/DynaLoader/README Dynamic Loader notes and intro +ext/DynaLoader/dl_aix.xs AIX 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 +ext/DynaLoader/dl_next.xs Next implementation +ext/DynaLoader/dl_none.xs Stub implementation +ext/DynaLoader/dl_vms.xs VMS implementation +ext/DynaLoader/dlutils.c Dynamic loader utilities for dl_*.xs files +ext/Fcntl/Fcntl.pm Fcntl extension Perl module +ext/Fcntl/Fcntl.xs Fcntl extension external subroutines +ext/Fcntl/MANIFEST Fcntl extension file list +ext/Fcntl/Makefile.SH Fcntl extension makefile writer +ext/GDBM_File/GDBM_File.pm GDBM extension Perl module +ext/GDBM_File/GDBM_File.xs GDBM extension external subroutines +ext/GDBM_File/Makefile.SH GDBM extension makefile writer +ext/GDBM_File/typemap GDBM extension interface types +ext/NDBM_File/Makefile.SH 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/typemap NDBM extension interface types +ext/ODBM_File/Makefile.SH 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/typemap ODBM extension interface types +ext/POSIX/Makefile.SH POSIX extension makefile writer +ext/POSIX/POSIX.pm POSIX extension Perl module +ext/POSIX/POSIX.xs POSIX extension external subroutines +ext/POSIX/typemap POSIX extension interface types +ext/SDBM_File/Makefile.SH SDBM extension makefile writer +ext/SDBM_File/SDBM_File.pm SDBM extension Perl module +ext/SDBM_File/SDBM_File.xs SDBM extension external subroutines +ext/SDBM_File/sdbm/CHANGES SDBM kit +ext/SDBM_File/sdbm/COMPARE SDBM kit +ext/SDBM_File/sdbm/Makefile.SH SDBM kit +ext/SDBM_File/sdbm/README SDBM kit +ext/SDBM_File/sdbm/README.too SDBM kit +ext/SDBM_File/sdbm/biblio SDBM kit +ext/SDBM_File/sdbm/dba.c SDBM kit +ext/SDBM_File/sdbm/dbd.c SDBM kit +ext/SDBM_File/sdbm/dbe.1 SDBM kit +ext/SDBM_File/sdbm/dbe.c SDBM kit +ext/SDBM_File/sdbm/dbm.c SDBM kit +ext/SDBM_File/sdbm/dbm.h SDBM kit +ext/SDBM_File/sdbm/dbu.c SDBM kit +ext/SDBM_File/sdbm/grind SDBM kit +ext/SDBM_File/sdbm/hash.c SDBM kit +ext/SDBM_File/sdbm/linux.patches SDBM kit +ext/SDBM_File/sdbm/makefile.sdbm SDBM kit +ext/SDBM_File/sdbm/pair.c SDBM kit +ext/SDBM_File/sdbm/pair.h SDBM kit +ext/SDBM_File/sdbm/readme.ms SDBM kit +ext/SDBM_File/sdbm/readme.ps SDBM kit +ext/SDBM_File/sdbm/sdbm.3 SDBM kit +ext/SDBM_File/sdbm/sdbm.c SDBM kit +ext/SDBM_File/sdbm/sdbm.h SDBM kit +ext/SDBM_File/sdbm/tune.h SDBM kit +ext/SDBM_File/sdbm/util.c SDBM kit +ext/SDBM_File/typemap SDBM extension interface types +ext/Socket/Makefile.SH Socket extension makefile writer +ext/Socket/Socket.pm Socket extension Perl module +ext/Socket/Socket.xs Socket extension external subroutines +ext/typemap Extension interface types +ext/util/extliblist Used by extension Makefile.SH to make lib lists +ext/util/make_ext Used by Makefile to execute extension Makefiles +ext/util/mkbootstrap Turns ext/*/*_BS into bootstrap info +ext/xsubpp External subroutine preprocessor form.h Public declarations for the above -gettest A little script to test the get* routines -global.sym -gv.c -gv.h -h2ph.SH A thing to turn C .h file into perl .ph files +global.sym Symbols that need hiding when embedded +gv.c Glob value code +gv.h Glob value header +h2ph.SH A thing to turn C .h files into perl .ph files h2pl/README How to turn .ph files into .pl files h2pl/cbreak.pl cbreak routines using .ph h2pl/cbreak2.pl cbreak routines using .pl @@ -181,209 +168,246 @@ h2pl/eg/sys/errno.pl Sample translated errno.pl h2pl/eg/sys/ioctl.pl Sample translated ioctl.pl h2pl/eg/sysexits.pl Sample translated sysexits.pl h2pl/getioctlsizes Program to extract types from ioctl.h -h2pl/mksizes Program to make %sizeof array. +h2pl/mksizes Program to make %sizeof array h2pl/mkvars Program to make .pl from .ph files h2pl/tcbreak cbreak test routine using .ph h2pl/tcbreak2 cbreak test routine using .pl +h2xs Program to make .xs files from C header files handy.h Handy definitions -hints/3b1.sh -hints/3b1cc -hints/3b2.sh -hints/aix_rs.sh -hints/aix_rt.sh -hints/altos486.sh -hints/apollo_C6_7.sh -hints/apollo_C6_8.sh -hints/aux.sh -hints/cray.sh -hints/dec_osf_1.sh -hints/dec_osf_2.sh -hints/dec_osf_3.sh -hints/dgux.sh -hints/dnix.sh -hints/dynix.sh -hints/fps.sh -hints/genix.sh -hints/greenhills.sh -hints/hp9000_300.sh -hints/hp9000_400.sh -hints/hp9000_700.sh -hints/hp9000_800.sh -hints/hpux.sh -hints/i386.sh -hints/isc_3_2_2.sh -hints/isc_3_2_3.sh -hints/mc6000.sh -hints/mips.sh -hints/mpc.sh -hints/ncr_tower.sh -hints/next.sh -hints/next_3_2.sh -hints/opus.sh -hints/osf1.sh -hints/sco_2_3_0.sh -hints/sco_2_3_1.sh -hints/sco_2_3_2.sh -hints/sco_2_3_3.sh -hints/sco_2_3_4.sh -hints/sco_3.sh -hints/sgi.sh -hints/solaris_2_0.sh -hints/solaris_2_1.sh -hints/solaris_2_2.sh -hints/solaris_2_3.sh -hints/stellar.sh -hints/sunos_3_4.sh -hints/sunos_3_5.sh -hints/sunos_4_0_1.sh -hints/sunos_4_0_2.sh -hints/sunos_4_1_2.sh -hints/sunos_4_1_3.sh -hints/svr4.sh -hints/ti1500.sh -hints/titan.sh -hints/ultrix_1.sh -hints/ultrix_3.sh -hints/ultrix_4.sh -hints/unisysdynix.sh -hints/utekv.sh -hints/uts.sh -hints/vax.sh -hv.c -hv.h -hvdbm.h +hints/3b1.sh Hints for named architecture +hints/3b1cc Hints for named architecture +hints/README.hints Hints for named architecture +hints/aix.sh Hints for named architecture +hints/altos486.sh Hints for named architecture +hints/apollo.sh Hints for named architecture +hints/aux.sh Hints for named architecture +hints/bsd386.sh Hints for named architecture +hints/dec_osf.sh Hints for named architecture +hints/dgux.sh Hints for named architecture +hints/dnix.sh Hints for named architecture +hints/dynix.sh Hints for named architecture +hints/esix4.sh Hints for named architecture +hints/fps.sh Hints for named architecture +hints/freebsd.sh Hints for named architecture +hints/genix.sh Hints for named architecture +hints/greenhills.sh Hints for named architecture +hints/hpux_9.sh Hints for named architecture +hints/i386.sh Hints for named architecture +hints/irix_4.sh Hints for named architecture +hints/irix_5.sh Hints for named architecture +hints/isc.sh Hints for named architecture +hints/isc_2.sh Hints for named architecture +hints/linux.sh Hints for named architecture +hints/mips.sh Hints for named architecture +hints/mpc.sh Hints for named architecture +hints/ncr_tower.sh Hints for named architecture +hints/netbsd.sh Hints for named architecture +hints/next_3_2.sh Hints for named architecture +hints/opus.sh Hints for named architecture +hints/sco_2_3_0.sh Hints for named architecture +hints/sco_2_3_1.sh Hints for named architecture +hints/sco_2_3_2.sh Hints for named architecture +hints/sco_2_3_3.sh Hints for named architecture +hints/sco_2_3_4.sh Hints for named architecture +hints/sco_3.sh Hints for named architecture +hints/solaris_2.sh Hints for named architecture +hints/stellar.sh Hints for named architecture +hints/sunos_4_0.sh Hints for named architecture +hints/sunos_4_1.sh Hints for named architecture +hints/svr4.sh Hints for named architecture +hints/ti1500.sh Hints for named architecture +hints/titanos.sh Hints for named architecture +hints/ultrix_4.sh Hints for named architecture +hints/unicos.sh Hints for named architecture +hints/unisysdynix.sh Hints for named architecture +hints/utekv.sh Hints for named architecture +hints/uts.sh Hints for named architecture +hv.c Hash value code +hv.h Hash value header installperl Perl script to do "make install" dirty work -interp.sym +interp.sym Interpreter specific symbols to hide in a struct ioctl.pl Sample ioctl.pl -keywords.h -lib/AutoLoader.pm -lib/English.pm -lib/Exporter.pm -lib/FOOBAR.pm -lib/FileHandle.pm -lib/Hostname.pm -lib/NDBM_File.pm -lib/POSIX.pm -lib/SDBM_File.pm +keywords.h The keyword numbers +keywords.pl Program to write keywords.h +lib/AnyDBM_File.pm Perl module to emulate dbmopen +lib/AutoLoader.pm Autoloader base class +lib/AutoSplit.pm A module to split up autoload functions +lib/Benchmark.pm A module to time pieces of code and such +lib/Carp.pm Error message base class +lib/Cwd.pm Various cwd routines (getcwd, fastcwd, chdir) +lib/English.pm Readable aliases for short variables +lib/Env.pm Map environment into ordinary variables +lib/Exporter.pm Exporter base class +lib/ExtUtils/MakeMaker.pm Write Makefiles for extensions +lib/File/Basename.pm A module to emulate the basename program +lib/File/CheckTree.pm Perl module supporting wholesale file mode validation +lib/File/Find.pm Routines to do a find +lib/FileHandle.pm FileHandle methods +lib/Shell.pm A module to make AUTOLOADEed system() calls +lib/Getopt/Long.pm A module to fetch command options (GetOptions) +lib/Getopt/Std.pm A module to fetch command options (getopt, getopts) +lib/I18N/Collate.pm Routines to do strxfrm-based collation +lib/IPC/Open2.pm Open a two-ended pipe +lib/IPC/Open3.pm Open a three-ended pipe! +lib/Math/BigInt.pm An arbitrary precision integer arithmetic package +lib/Math/BigFloat.pm An arbitrary precision floating-point arithmetic package +lib/Math/Complex.pm A Complex package +lib/Net/Ping.pm Ping methods +lib/Search/Dict.pm A module to do binary search on dictionaries +lib/Sys/Hostname.pm Hostname methods +lib/Sys/Syslog.pm Perl module supporting syslogging +lib/Term/Cap.pm Perl module supporting termcap usage +lib/Term/Complete.pm A command completion subroutine +lib/Test/Harness.pm A test harness +lib/Text/Abbrev.pm An abbreviation table builder +lib/Text/ParseWords.pm Perl module to split words on arbitrary delimiter +lib/Text/Soundex.pm Perl module to implement Soundex +lib/Text/Tabs.pm Do expand and unexpand +lib/TieHash.pm Base class for tied hashes +lib/Time/Local.pm Reverse translation of localtime, gmtime lib/abbrev.pl An abbreviation table builder lib/assert.pl assertion and panic with stack trace 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/cacheout.pl Manages output filehandles when you need too many +lib/chat2.inter A chat2 with interaction lib/chat2.pl Randal's famous expect-ish routines lib/complete.pl A command completion subroutine lib/ctime.pl A ctime workalike -lib/dotsh.pl.art +lib/dotsh.pl Code to "dot" in a shell script lib/dumpvar.pl A variable dumper lib/exceptions.pl catch and throw routines lib/fastcwd.pl a faster but more dangerous getcwd lib/find.pl A find emulator--used by find2perl lib/finddepth.pl A depth-first find emulator--used by find2perl lib/flush.pl Routines to do single flush -lib/ftp.pl -lib/getcwd.pl a getcwd() emulator +lib/ftp.pl FTP code +lib/getcwd.pl A getcwd() emulator lib/getopt.pl Perl library supporting option parsing lib/getopts.pl Perl library supporting option parsing -lib/hostname.pl +lib/hostname.pl Old hostname code lib/importenv.pl Perl routine to get environment into variables +lib/integer.pm For "use integer" +lib/less.pm For "use less" lib/look.pl A "look" equivalent lib/newgetopt.pl A perl library supporting long option parsing -lib/open2.pl -lib/open3.pl -lib/perldb.pl Perl debugging routines +lib/open2.pl Open a two-ended pipe +lib/open3.pl Open a three-ended pipe +lib/perl5db.pl Perl debugging routines lib/pwd.pl Routines to keep track of PWD environment variable -lib/quotewords.pl.art lib/shellwords.pl Perl library to split into words with shell quoting -lib/soundex.pl.art +lib/sigtrap.pm For trapping an abort and giving traceback lib/stat.pl Perl library supporting stat function +lib/strict.pm For "use strict" +lib/subs.pm Declare overriding subs lib/syslog.pl Perl library supporting syslogging -lib/tainted.pl +lib/tainted.pl Old code for tainting lib/termcap.pl Perl library supporting termcap usage lib/timelocal.pl Perl library supporting inverse of localtime, gmtime lib/validate.pl Perl library supporting wholesale file mode validation makedepend.SH Precursor to makedepend makedir.SH Precursor to makedir -makefile.lib make libperl.a malloc.c A version of malloc you might not want -mg.c -mg.h -miniperlmain.c Basic perl w/o dynamic loading or extensions. -msdos/Changes.dds Expanation of MS-DOS patches by Diomidis Spinellis -msdos/Makefile MS-DOS makefile -msdos/README.msdos Compiling and usage information -msdos/Wishlist.dds My wishlist -msdos/chdir.c A chdir that can change drives -msdos/config.h Definitions for msdos -msdos/dir.h MS-DOS header for directory access functions -msdos/directory.c MS-DOS directory access functions. -msdos/eg/crlf.bat Convert files from unix to MS-DOS line termination -msdos/eg/drives.bat List the system drives and their characteristics -msdos/eg/lf.bat Convert files from MS-DOS to Unix line termination -msdos/glob.c A command equivalent to csh glob -msdos/msdos.c MS-DOS ioctl, sleep, gete?[gu]if, spawn, aspawn -msdos/popen.c My_popen and my_pclose for MS-DOS -msdos/usage.c How to invoke perl under MS-DOS -opcode.h -opcode.pl -os2/Makefile Makefile for OS/2 -os2/README.OS2 Notes for OS/2 -os2/a2p.cs Compiler script for a2p -os2/a2p.def Linker defs for a2p -os2/alarm.c An implementation of alarm() -os2/alarm.h Header file for same -os2/config.h Configuration file for OS/2 -os2/crypt.c -os2/dir.h Directory header -os2/director.c Directory routines -os2/eg/alarm.pl Example of alarm code -os2/eg/os2.pl Sample script for OS/2 -os2/eg/syscalls.pl Example of syscall on OS/2 -os2/glob.c Globbing routines -os2/makefile Make file -os2/mktemp.c Mktemp() using TMP -os2/os2.c Unix compatibility functions -os2/perl.bad names of protect-only API calls for BIND -os2/perl.cs Compiler script for perl -os2/perl.def Linker defs for perl -os2/perldb.dif Changes to make the debugger work -os2/perlglob.bad names of protect-only API calls for BIND -os2/perlglob.cs Compiler script for perlglob -os2/perlglob.def Linker defs for perlglob -os2/perlsh.cmd Poor man's shell for os2 -os2/popen.c Code for opening pipes -os2/s2p.cmd s2p as command file -os2/selfrun.bat A self running perl script for DOS -os2/selfrun.cmd Example of extproc feature -os2/suffix.c Code for creating backup filenames -os2/tests.dif +mg.c Magic code +mg.h Magic header +miniperlmain.c Basic perl w/o dynamic loading or extensions +mv-if-diff Script to mv a file if it changed +myconfig Prints summary of the current configuration +op.c Opcode syntax tree code +op.h Opcode syntax tree header +opcode.h Automatically generated opcode header +opcode.pl Opcode header generatore patchlevel.h The current patch level of perl perl.c main() perl.h Global declarations -perl.man The manual page(s) +perl_exp.SH Creates list of exported symbols for AIX. perlsh A poor man's perl shell -perly.c -perly.c.byacc -perly.c.diff -perly.c.yacc +perly.c A byacc'ed perly.y +perly.c.diff Fixup perly.c to allow recursion perly.fixer A program to remove yacc stack limitations -perly.h.yacc +perly.h The header file for perly.c perly.y Yacc grammar for perl -perly.y.save +pl2pm A pl to pm translator +pod/Makefile Make pods into something else +pod/modpods/Abbrev.pod Doc for Abbrev.pm +pod/modpods/AnyDBMFile.pod Doc for AnyDBMFile.pm +pod/modpods/AutoLoader.pod Doc for AutoLoader.pm +pod/modpods/AutoSplit.pod Doc for AutoSplit.pm +pod/modpods/Basename.pod Doc for Basename.pm +pod/modpods/Benchmark.pod Doc for Benchmark.pm +pod/modpods/Carp.pod Doc for Carp.pm +pod/modpods/CheckTree.pod Doc for CheckTree.pm +pod/modpods/Collate.pod Doc for Collate.pm +pod/modpods/Config.pod Doc for Config.pm +pod/modpods/Cwd.pod Doc for Cwd.pm +pod/modpods/DB_File.pod Doc for File.pm +pod/modpods/Dynaloader.pod Doc for Dynaloader.pm +pod/modpods/English.pod Doc for English.pm +pod/modpods/Env.pod Doc for Env.pm +pod/modpods/Exporter.pod Doc for Exporter.pm +pod/modpods/Fcntl.pod Doc for Fcntl.pm +pod/modpods/FileHandle.pod Doc for FileHandle.pm +pod/modpods/Find.pod Doc for Find.pm +pod/modpods/Finddepth.pod Doc for Finddepth.pm +pod/modpods/GetOptions.pod Doc for GetOptions.pm +pod/modpods/Getopt.pod Doc for Getopt.pm +pod/modpods/MakeMaker.pod Doc for MakeMaker.pm +pod/modpods/Open2.pod Doc for Open2.pm +pod/modpods/Open3.pod Doc for Open3.pm +pod/modpods/POSIX.pod Doc for POSIX.pm +pod/modpods/Ping.pod Doc for Ping.pm +pod/modpods/Socket.pod Doc for Socket.pm +pod/modpods/integer.pod Doc for integer.pm +pod/modpods/less.pod Doc for less.pm +pod/modpods/sigtrap.pod Doc for sigtrap.pm +pod/modpods/strict.pod Doc for strict.pm +pod/modpods/subs.pod Doc for subs.pm +pod/perl.pod Top level perl man page +pod/perlapi.pod XS api info +pod/perlbook.pod Book info +pod/perlbot.pod Object-oriented Bag o' Tricks +pod/perlcall.pod Callback info +pod/perldata.pod Data structure info +pod/perldebug.pod Debugger info +pod/perldiag.pod Diagnostic info +pod/perlembed.pod Embedding info +pod/perlform.pod Format info +pod/perlfunc.pod Function info +pod/perlguts.pod Internals info +pod/perlipc.pod IPC info +pod/perlmod.pod Module info +pod/perlobj.pod Object info +pod/perlop.pod Operator info +pod/perlovl.pod Overloading info +pod/perlpod.pod Pod info +pod/perlre.pod Regular expression info +pod/perlref.pod References info +pod/perlrun.pod Execution info +pod/perlsec.pod Security info +pod/perlstyle.pod Style info +pod/perlsub.pod Subroutine info +pod/perlsyn.pod Syntax info +pod/perltrap.pod Trap info +pod/perlvar.pod Variable info +pod/pod2html Translator to turn pod into HTML +pod/pod2man Translator to turn pod into manpage +pod/splitman Splits perlfunc into multiple man pages pp.c Push/Pop code pp.h Push/Pop code defs -proto.h -protos +pp_ctl.c Push/Pop code for control flow +pp_hot.c Push/Pop code for heavily used opcodes +pp_sys.c Push/Pop code for system interaction +proto.h Prototypes regcomp.c Regular expression compiler regcomp.h Private declarations for above regexec.c Regular expression evaluator regexp.h Public declarations for the above -scope.c -scope.h -server A server to test sockets -sortfunc -sv.c -sv.h +run.c The interpreter loop +scope.c Scope entry and exit code +scope.h Scope entry and exit header +sv.c Scalar value code +sv.h Scalar value header t/README Instructions for regression tests t/TEST The regression tester t/base/cond.t See if conditionals work @@ -411,10 +435,18 @@ t/io/inplace.t See if inplace editing works t/io/pipe.t See if secure pipes work t/io/print.t See if print commands work t/io/tell.t See if file seeking works -t/lib/bigint.t -t/lib/english.t -t/lib/ndbm.t -t/lib/sdbm.t +t/lib/anydbm.t See if AnyDBM_File works +t/lib/bigint.t See if bigint.pl works +t/lib/db-btree.t See if DB_File works +t/lib/db-hash.t See if DB_File works +t/lib/db-recno.t See if DB_File works +t/lib/english.t See if English works +t/lib/gdbm.t See if GDBM_File works +t/lib/ndbm.t See if NDBM_File works +t/lib/odbm.t See if ODBM_File works +t/lib/posix.t See if POSIX works +t/lib/sdbm.t See if SDBM_File works +t/lib/soundex.t See if Soundex works t/op/append.t See if . works t/op/array.t See if array operations work t/op/auto.t See if autoincrement et all work @@ -437,18 +469,21 @@ t/op/join.t See if join works t/op/list.t See if array lists work t/op/local.t See if local works t/op/magic.t See if magic variables work +t/op/misc.t See if miscellaneous bugs have been fixed t/op/mkdir.t See if mkdir works -t/op/my.t +t/op/my.t See if lexical scoping works t/op/oct.t See if oct and hex work t/op/ord.t See if ord works t/op/pack.t See if pack and unpack work t/op/pat.t See if esoteric patterns work t/op/push.t See if push and pop work +t/op/quotemeta.t See if quotemeta works +t/op/rand.t See if rand works t/op/range.t See if .. works t/op/re_tests Input file for op.regexp t/op/read.t See if read() works t/op/readdir.t See if readdir() works -t/op/ref.t +t/op/ref.t See if refs and objects work t/op/regexp.t See if regular expressions work t/op/repeat.t See if x operator works t/op/sleep.t See if sleep works @@ -457,20 +492,35 @@ t/op/split.t See if split works t/op/sprintf.t See if sprintf works t/op/stat.t See if stat works t/op/study.t See if study works -t/op/subst.t +t/op/subst.t See if substitution works t/op/substr.t See if substr works t/op/time.t See if time functions work t/op/undef.t See if undef works t/op/unshift.t See if unshift works t/op/vec.t See if vectors work t/op/write.t See if write works -taint.c +t/re_tests Regular expressions for regexp.t +taint.c Tainting code toke.c The tokener -unixish.h -usersub.c User supplied (possibly proprietary) subroutines +unixish.h Defines that are assumed on Unix util.c Utility routines util.h Public declarations for the above -writemain.SH Generate perlmain.c from miniperlmain.c+extensions. +vms/config.vms VMS port +vms/descrip.mms VMS port +vms/genconfig.pl VMS port +vms/genopt.com VMS port +vms/gen_shrfls.pl VMS port +vms/makefile. VMS port +vms/mms2make.pl VMS port +vms/perlshr.c VMS port +vms/perlvms.pod VMS port +vms/sockadapt.c VMS port +vms/sockadapt.h VMS port +vms/test.com VMS port +vms/vms.c VMS port +vms/vmsish.h VMS port +vms/writemain.pl VMS port +writemain.SH Generate perlmain.c from miniperlmain.c+extensions x2p/EXTERN.h Same as above x2p/INTERN.h Same as above x2p/Makefile.SH Precursor to Makefile @@ -483,7 +533,7 @@ x2p/find2perl.SH A find to perl translator x2p/handy.h Handy definitions x2p/hash.c Associative arrays again x2p/hash.h Public declarations for the above -x2p/malloc.c +x2p/malloc.c Malloc code x2p/s2p.SH Sed to perl translator x2p/s2p.man Manual page for sed to perl translator x2p/str.c String handling package @@ -491,3 +541,4 @@ x2p/str.h Public declarations for the above x2p/util.c Utility routines x2p/util.h Public declarations for the above x2p/walk.c Parse tree walker +xf A script to translate Perl 4 symbols to Perl 5 diff --git a/MANIFEST.new b/MANIFEST.new deleted file mode 100644 index a71f86d..0000000 --- a/MANIFEST.new +++ /dev/null @@ -1,493 +0,0 @@ -Artistic The "Artistic License" -Configure Portability tool -Copying The GNU General Public License -EXTERN.h Included before foreign .h files -INTERN.h Included before domestic .h files -MANIFEST This list of files -Makefile.SH A script that generates Makefile -README The Instructions -README.ncr Special instructions for NCR -README.uport Special instructions for Microports -README.xenix Special instructions for Xenix -XSUB.h -atarist/FILES -atarist/README.ST -atarist/RESULTS -atarist/atarist.c -atarist/config.h -atarist/echo.c -atarist/explain -atarist/makefile.sm -atarist/makefile.st -atarist/osbind.pl -atarist/perldb.diff -atarist/perlglob.c -atarist/test/binhandl -atarist/test/ccon -atarist/test/dbm -atarist/test/err -atarist/test/gdbm -atarist/test/gdbm.t -atarist/test/glob -atarist/test/osexample.pl -atarist/test/pi.pl -atarist/test/printenv -atarist/test/readme -atarist/test/sig -atarist/test/tbinmode -atarist/usersub.c -atarist/usub/README.ATARI -atarist/usub/acurses.mus -atarist/usub/makefile.st -atarist/usub/usersub.c -atarist/wildmat.c -autosplit -av.c -av.h -bar.pm -c2ph.SH program to translate dbx stabs to perl -c2ph.doc documentation for c2ph -cflags.SH A script that emits C compilation flags per file -client A client to test sockets -config.H Sample config.h -config_h.SH Produces config.h -configpm Produces lib/Config.pm -cop.h -cv.h -deb.c -dlperl/Makefile -dlperl/dlperl.c -dlperl/dlperl.doc -dlperl/dlperl.man -dlperl/usersub.c -doSH Script to run all the *.SH files -doio.c I/O operations -doop.c Support code for various operations -dosish.h -dump.c Debugging output -eg/ADB An adb wrapper to put in your crash dir -eg/README Intro to example perl scripts -eg/changes A program to list recently changed files -eg/down A program to do things to subdirectories -eg/dus A program to do du -s on non-mounted dirs -eg/findcp A find wrapper that implements a -cp switch -eg/findtar A find wrapper that pumps out a tar file -eg/g/gcp A program to do a global rcp -eg/g/gcp.man Manual page for gcp -eg/g/ged A program to do a global edit -eg/g/ghosts A sample /etc/ghosts file -eg/g/gsh A program to do a global rsh -eg/g/gsh.man Manual page for gsh -eg/muck A program to find missing make dependencies -eg/muck.man Manual page for muck -eg/myrup A program to find lightly loaded machines -eg/nih Script to insert #! workaround -eg/relink A program to change symbolic links -eg/rename A program to rename files -eg/rmfrom A program to feed doomed filenames to -eg/scan/scan_df Scan for filesystem anomalies -eg/scan/scan_last Scan for login anomalies -eg/scan/scan_messages Scan for console message anomalies -eg/scan/scan_passwd Scan for passwd file anomalies -eg/scan/scan_ps Scan for process anomalies -eg/scan/scan_sudo Scan for sudo anomalies -eg/scan/scan_suid Scan for setuid anomalies -eg/scan/scanner An anomaly reporter -eg/shmkill A program to remove unused shared memory -eg/sysvipc/README Intro to Sys V IPC examples -eg/sysvipc/ipcmsg Example of SYS V IPC message queues -eg/sysvipc/ipcsem Example of Sys V IPC semaphores -eg/sysvipc/ipcshm Example of Sys V IPC shared memory -eg/travesty A program to print travesties of its input text -eg/unuc.pats -eg/uudecode -eg/van/empty A program to empty the trashcan -eg/van/unvanish A program to undo what vanish does -eg/van/vanexp A program to expire vanished files -eg/van/vanish A program to put files in a trashcan -eg/who A sample who program -emacs/cperl-mode -emacs/emacs19 -emacs/perl-mode.el Emacs major mode for perl -emacs/perldb.el Emacs debugging -emacs/perldb.pl Emacs debugging -emacs/tedstuff Some optional patches -embed_h.SH -ext/README -ext/curses/Makefile -ext/curses/bsdcurses.mus -ext/curses/curses.mus -ext/curses/pager -ext/dbm/GDBM_File.xs GDBM extension -ext/dbm/Makefile -ext/dbm/NDBM_File.xs NDBM extension -ext/dbm/ODBM_File.xs ODBM extension -ext/dbm/SDBM_File.xs SDBM extension -ext/dbm/sdbm/CHANGES -ext/dbm/sdbm/COMPARE -ext/dbm/sdbm/Makefile.SH -ext/dbm/sdbm/README.too -ext/dbm/sdbm/biblio -ext/dbm/sdbm/dba.c -ext/dbm/sdbm/dbd.c -ext/dbm/sdbm/dbe.1 -ext/dbm/sdbm/dbe.c -ext/dbm/sdbm/dbm.c -ext/dbm/sdbm/dbm.h -ext/dbm/sdbm/dbu.c -ext/dbm/sdbm/grind -ext/dbm/sdbm/hash.c -ext/dbm/sdbm/linux.patches -ext/dbm/sdbm/makefile.sdbm -ext/dbm/sdbm/pair.c -ext/dbm/sdbm/pair.h -ext/dbm/sdbm/readme.ms -ext/dbm/sdbm/readme.ps -ext/dbm/sdbm/sdbm.3 -ext/dbm/sdbm/sdbm.c -ext/dbm/sdbm/sdbm.h -ext/dbm/sdbm/tune.h -ext/dbm/sdbm/util.c -ext/dbm/typemap -ext/dl/dl_hpux.c Dynamic loading for HPUX. -ext/dl/dl_next.c Dynamic loading for NeXT -ext/dl/dl_sunos.c Dynamic loading for SunOS 4.1.? -ext/dl/eg/Makefile -ext/dl/eg/Makefile.att -ext/dl/eg/main.c -ext/dl/eg/test.c -ext/dl/eg/test1.c -ext/man2mus -ext/mus -ext/posix/POSIX.xs -ext/posix/typemap -ext/typemap -ext/typemap.oi -ext/typemap.xlib -ext/typemap.xpm -ext/xsubpp -ext/xvarpp -form.h Public declarations for the above -gettest A little script to test the get* routines -global.sym -gv.c -gv.h -h2ph.SH A thing to turn C .h file into perl .ph files -h2pl/README How to turn .ph files into .pl files -h2pl/cbreak.pl cbreak routines using .ph -h2pl/cbreak2.pl cbreak routines using .pl -h2pl/eg/sizeof.ph Sample sizeof array initialization -h2pl/eg/sys/errno.pl Sample translated errno.pl -h2pl/eg/sys/ioctl.pl Sample translated ioctl.pl -h2pl/eg/sysexits.pl Sample translated sysexits.pl -h2pl/getioctlsizes Program to extract types from ioctl.h -h2pl/mksizes Program to make %sizeof array. -h2pl/mkvars Program to make .pl from .ph files -h2pl/tcbreak cbreak test routine using .ph -h2pl/tcbreak2 cbreak test routine using .pl -handy.h Handy definitions -hints/3b1.sh -hints/3b1cc -hints/3b2.sh -hints/aix_rs.sh -hints/aix_rt.sh -hints/altos486.sh -hints/apollo_C6_7.sh -hints/apollo_C6_8.sh -hints/aux.sh -hints/cray.sh -hints/dec_osf_1.sh -hints/dec_osf_2.sh -hints/dec_osf_3.sh -hints/dgux.sh -hints/dnix.sh -hints/dynix.sh -hints/fps.sh -hints/genix.sh -hints/greenhills.sh -hints/hp9000_300.sh -hints/hp9000_400.sh -hints/hp9000_700.sh -hints/hp9000_800.sh -hints/hpux.sh -hints/i386.sh -hints/isc_3_2_2.sh -hints/isc_3_2_3.sh -hints/mc6000.sh -hints/mips.sh -hints/mpc.sh -hints/ncr_tower.sh -hints/next.sh -hints/next_3_2.sh -hints/opus.sh -hints/osf1.sh -hints/sco_2_3_0.sh -hints/sco_2_3_1.sh -hints/sco_2_3_2.sh -hints/sco_2_3_3.sh -hints/sco_2_3_4.sh -hints/sco_3.sh -hints/sgi.sh -hints/solaris_2_0.sh -hints/solaris_2_1.sh -hints/solaris_2_2.sh -hints/solaris_2_3.sh -hints/stellar.sh -hints/sunos_3_4.sh -hints/sunos_3_5.sh -hints/sunos_4_0_1.sh -hints/sunos_4_0_2.sh -hints/sunos_4_1_2.sh -hints/sunos_4_1_3.sh -hints/svr4.sh -hints/ti1500.sh -hints/titan.sh -hints/ultrix_1.sh -hints/ultrix_3.sh -hints/ultrix_4.sh -hints/unisysdynix.sh -hints/utekv.sh -hints/uts.sh -hints/vax.sh -hv.c -hv.h -hvdbm.h -installperl Perl script to do "make install" dirty work -interp.sym -ioctl.pl Sample ioctl.pl -keywords.h -lib/AutoLoader.pm -lib/English.pm -lib/Exporter.pm -lib/FOOBAR.pm -lib/FileHandle.pm -lib/Hostname.pm -lib/NDBM_File.pm -lib/POSIX.pm -lib/SDBM_File.pm -lib/abbrev.pl An abbreviation table builder -lib/assert.pl assertion and panic with stack trace -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/cacheout.pl Manages output filehandles when you need too many -lib/chat2.pl Randal's famous expect-ish routines -lib/complete.pl A command completion subroutine -lib/ctime.pl A ctime workalike -lib/dotsh.pl.art -lib/dumpvar.pl A variable dumper -lib/exceptions.pl catch and throw routines -lib/fastcwd.pl a faster but more dangerous getcwd -lib/find.pl A find emulator--used by find2perl -lib/finddepth.pl A depth-first find emulator--used by find2perl -lib/flush.pl Routines to do single flush -lib/ftp.pl -lib/getcwd.pl a getcwd() emulator -lib/getopt.pl Perl library supporting option parsing -lib/getopts.pl Perl library supporting option parsing -lib/hostname.pl -lib/importenv.pl Perl routine to get environment into variables -lib/look.pl A "look" equivalent -lib/newgetopt.pl A perl library supporting long option parsing -lib/open2.pl -lib/open3.pl -lib/perldb.pl Perl debugging routines -lib/pwd.pl Routines to keep track of PWD environment variable -lib/quotewords.pl.art -lib/shellwords.pl Perl library to split into words with shell quoting -lib/soundex.pl.art -lib/stat.pl Perl library supporting stat function -lib/syslog.pl Perl library supporting syslogging -lib/tainted.pl -lib/termcap.pl Perl library supporting termcap usage -lib/timelocal.pl Perl library supporting inverse of localtime, gmtime -lib/validate.pl Perl library supporting wholesale file mode validation -makedepend.SH Precursor to makedepend -makedir.SH Precursor to makedir -makefile.lib make libperl.a -malloc.c A version of malloc you might not want -mg.c -mg.h -miniperlmain.c Basic perl w/o dynamic loading or extensions. -msdos/Changes.dds Expanation of MS-DOS patches by Diomidis Spinellis -msdos/Makefile MS-DOS makefile -msdos/README.msdos Compiling and usage information -msdos/Wishlist.dds My wishlist -msdos/chdir.c A chdir that can change drives -msdos/config.h Definitions for msdos -msdos/dir.h MS-DOS header for directory access functions -msdos/directory.c MS-DOS directory access functions. -msdos/eg/crlf.bat Convert files from unix to MS-DOS line termination -msdos/eg/drives.bat List the system drives and their characteristics -msdos/eg/lf.bat Convert files from MS-DOS to Unix line termination -msdos/glob.c A command equivalent to csh glob -msdos/msdos.c MS-DOS ioctl, sleep, gete?[gu]if, spawn, aspawn -msdos/popen.c My_popen and my_pclose for MS-DOS -msdos/usage.c How to invoke perl under MS-DOS -opcode.h -opcode.pl -os2/Makefile Makefile for OS/2 -os2/README.OS2 Notes for OS/2 -os2/a2p.cs Compiler script for a2p -os2/a2p.def Linker defs for a2p -os2/alarm.c An implementation of alarm() -os2/alarm.h Header file for same -os2/config.h Configuration file for OS/2 -os2/crypt.c -os2/dir.h Directory header -os2/director.c Directory routines -os2/eg/alarm.pl Example of alarm code -os2/eg/os2.pl Sample script for OS/2 -os2/eg/syscalls.pl Example of syscall on OS/2 -os2/glob.c Globbing routines -os2/makefile Make file -os2/mktemp.c Mktemp() using TMP -os2/os2.c Unix compatibility functions -os2/perl.bad names of protect-only API calls for BIND -os2/perl.cs Compiler script for perl -os2/perl.def Linker defs for perl -os2/perldb.dif Changes to make the debugger work -os2/perlglob.bad names of protect-only API calls for BIND -os2/perlglob.cs Compiler script for perlglob -os2/perlglob.def Linker defs for perlglob -os2/perlsh.cmd Poor man's shell for os2 -os2/popen.c Code for opening pipes -os2/s2p.cmd s2p as command file -os2/selfrun.bat A self running perl script for DOS -os2/selfrun.cmd Example of extproc feature -os2/suffix.c Code for creating backup filenames -os2/tests.dif -patchlevel.h The current patch level of perl -perl.c main() -perl.h Global declarations -perl.man The manual page(s) -perlsh A poor man's perl shell -perly.c -perly.c.byacc -perly.c.diff -perly.c.yacc -perly.fixer A program to remove yacc stack limitations -perly.h.yacc -perly.y Yacc grammar for perl -perly.y.save -pp.c Push/Pop code -pp.h Push/Pop code defs -proto.h -protos -regcomp.c Regular expression compiler -regcomp.h Private declarations for above -regexec.c Regular expression evaluator -regexp.h Public declarations for the above -scope.c -scope.h -server A server to test sockets -sortfunc -sv.c -sv.h -t/README Instructions for regression tests -t/TEST The regression tester -t/base/cond.t See if conditionals work -t/base/if.t See if if works -t/base/lex.t See if lexical items work -t/base/pat.t See if pattern matching works -t/base/term.t See if various terms work -t/cmd/elsif.t See if else-if works -t/cmd/for.t See if for loops work -t/cmd/mod.t See if statement modifiers work -t/cmd/subval.t See if subroutine values work -t/cmd/switch.t See if switch optimizations work -t/cmd/while.t See if while loops work -t/comp/cmdopt.t See if command optimization works -t/comp/cpp.t See if C preprocessor works -t/comp/decl.t See if declarations work -t/comp/multiline.t See if multiline strings work -t/comp/package.t See if packages work -t/comp/script.t See if script invokation works -t/comp/term.t See if more terms work -t/io/argv.t See if ARGV stuff works -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/pipe.t See if secure pipes work -t/io/print.t See if print commands work -t/io/tell.t See if file seeking works -t/lib/bigint.t -t/lib/english.t -t/lib/ndbm.t -t/lib/sdbm.t -t/op/append.t See if . works -t/op/array.t See if array operations work -t/op/auto.t See if autoincrement et all work -t/op/chop.t See if chop works -t/op/cond.t See if conditional expressions work -t/op/delete.t See if delete works -t/op/do.t See if subroutines work -t/op/each.t See if associative iterators work -t/op/eval.t See if eval operator works -t/op/exec.t See if exec and system work -t/op/exp.t See if math functions work -t/op/flip.t See if range operator works -t/op/fork.t See if fork works -t/op/glob.t See if <*> works -t/op/goto.t See if goto works -t/op/groups.t See if $( works -t/op/index.t See if index works -t/op/int.t See if int works -t/op/join.t See if join works -t/op/list.t See if array lists work -t/op/local.t See if local works -t/op/magic.t See if magic variables work -t/op/mkdir.t See if mkdir works -t/op/my.t -t/op/oct.t See if oct and hex work -t/op/ord.t See if ord works -t/op/pack.t See if pack and unpack work -t/op/pat.t See if esoteric patterns work -t/op/push.t See if push and pop work -t/op/range.t See if .. works -t/op/re_tests Input file for op.regexp -t/op/read.t See if read() works -t/op/readdir.t See if readdir() works -t/op/ref.t -t/op/regexp.t See if regular expressions work -t/op/repeat.t See if x operator works -t/op/sleep.t See if sleep works -t/op/sort.t See if sort works -t/op/split.t See if split works -t/op/sprintf.t See if sprintf works -t/op/stat.t See if stat works -t/op/study.t See if study works -t/op/subst.t -t/op/substr.t See if substr works -t/op/time.t See if time functions work -t/op/undef.t See if undef works -t/op/unshift.t See if unshift works -t/op/vec.t See if vectors work -t/op/write.t See if write works -taint.c -toke.c The tokener -unixish.h -usersub.c User supplied (possibly proprietary) subroutines -util.c Utility routines -util.h Public declarations for the above -writemain.SH Generate perlmain.c from miniperlmain.c+extensions. -x2p/EXTERN.h Same as above -x2p/INTERN.h Same as above -x2p/Makefile.SH Precursor to Makefile -x2p/a2p.h Global declarations -x2p/a2p.man Manual page for awk to perl translator -x2p/a2p.y A yacc grammer for awk -x2p/a2py.c Awk compiler, sort of -x2p/cflags.SH A script that emits C compilation flags per file -x2p/find2perl.SH A find to perl translator -x2p/handy.h Handy definitions -x2p/hash.c Associative arrays again -x2p/hash.h Public declarations for the above -x2p/malloc.c -x2p/s2p.SH Sed to perl translator -x2p/s2p.man Manual page for sed to perl translator -x2p/str.c String handling package -x2p/str.h Public declarations for the above -x2p/util.c Utility routines -x2p/util.h Public declarations for the above -x2p/walk.c Parse tree walker diff --git a/Makefile b/Makefile deleted file mode 100644 index 8da9eee..0000000 --- a/Makefile +++ /dev/null @@ -1,311 +0,0 @@ -# .SH,v $Revision: 4.1 $Date: 92/08/07 17:18:08 $ -# This file is derived from Makefile.SH. Any changes made here will -# be lost the next time you run Configure. -# Makefile is used to generate makefile. The only difference -# is that makefile has the dependencies filled in at the end. -# -# $Log: Makefile.SH,v $ -# Revision 4.1 92/08/07 17:18:08 lwall -# Stage 6 Snapshot -# -# Revision 4.0.1.4 92/06/08 11:40:43 lwall -# patch20: cray didn't give enough memory to /bin/sh -# patch20: various and sundry fixes -# -# Revision 4.0.1.3 91/11/05 15:48:11 lwall -# patch11: saberized perl -# patch11: added support for dbz -# -# Revision 4.0.1.2 91/06/07 10:14:43 lwall -# patch4: cflags now emits entire cc command except for the filename -# patch4: alternate make programs are now semi-supported -# patch4: uperl.o no longer tries to link in libraries prematurely -# patch4: installperl now installs x2p stuff too -# -# Revision 4.0.1.1 91/04/11 17:30:39 lwall -# patch1: C flags are now settable on a per-file basis -# -# Revision 4.0 91/03/20 00:58:54 lwall -# 4.0 baseline. -# -# - -# I now supply perly.c with the kits, so don't remake perly.c without byacc -BYACC = byacc -CC = cc -bin = /usr/local/bin -scriptdir = /usr/local/bin -privlib = /usr/local/lib/perl -mansrc = /usr/local/man/man1 -manext = 1 -LDFLAGS = -CLDFLAGS = - -SMALL = -LARGE = -mallocsrc = malloc.c -mallocobj = malloc.o -dlsrc = dl_sunos.c -dlobj = dl_sunos.o -dldir = ext/dl -LNS = /bin/ln -s -RMS = rm -f -ranlib = /usr/bin/ranlib - -# The following are used to build and install shared libraries for -# dynamic loading. -LDDLFLAGS = -CCDLFLAGS = -CCCDLFLAGS = -SHLIBSUFFIX = .so - -libs = -ldbm -ldl -lm -lposix - -public = perl - -shellflags = - -## To use an alternate make, set in config.sh. -MAKE = make - -CCCMD = `sh $(shellflags) cflags $@` - -private = - -scripts = h2ph - -manpages = perl.man h2ph.man - -util = - -sh = Makefile.SH cflags.SH embed_h.SH makedepend.SH makedir.SH writemain.SH - -h1 = EXTERN.h INTERN.h av.h cop.h config.h embed.h form.h handy.h -h2 = hv.h op.h opcode.h perl.h regcomp.h regexp.h gv.h sv.h util.h - -h1 = EXTERN.h INTERN.h XSUB.h av.h config.h cop.h cv.h dosish.h -h2 = embed.h form.h gv.h handy.h hv.h hvdbm.h keywords.h mg.h op.h -h3 = opcode.h patchlevel.h perl.h perly.h pp.h proto.h regcomp.h -h4 = regexp.h scope.h sv.h unixish.h util.h -h = $(h1) $(h2) $(h3) $(h4) - -c1 = av.c scope.c op.c doop.c doio.c dump.c hv.c -c2 = $(mallocsrc) mg.c perly.c pp.c regcomp.c regexec.c -c3 = gv.c sv.c taint.c toke.c util.c deb.c run.c - -c = $(c1) $(c2) $(c3) $(dlsrc) miniperlmain.c perlmain.c - -s1 = av.c scope.c op.c doop.c doio.c dump.c hv.c -s2 = $(mallocsrc) mg.c perly.c pp.c regcomp.c regexec.c -s3 = gv.c sv.c taint.c toke.c util.c deb.c run.c perly.c - -saber = $(s1) $(s2) $(s3) $(dlsrc) - -obj1 = av.o scope.o op.o doop.o doio.o dump.o hv.o -obj2 = $(mallocobj) mg.o perly.o pp.o regcomp.o regexec.o -obj3 = gv.o sv.o taint.o toke.o util.o deb.o run.o - -obj = $(obj1) $(obj2) $(obj3) - -lintflags = -hbvxac - -addedbyconf = Makefile.old bsd eunice filexp loc pdp11 usg v7 - -# grrr -SHELL = /bin/sh - -.c.o: - $(CCCMD) $*.c - -all: miniperl perl lib/Config.pm - -#all: $(public) $(private) $(util) $(scripts) -# cd x2p; $(MAKE) all -# touch all - -# Phony target to force checking subdirectories. -FORCE: - - -$(dlsrc): $(dldir)/$(dlsrc) - cp $(dldir)/$(dlsrc) $(dlsrc) - -$(dlobj): $(dlsrc) - $(CCCMD) $(dlsrc) - - -# NDBM_File extension -NDBM_File.o: NDBM_File.c - $(CCCMD) $(CCCDLFLAGS) $*.c - -NDBM_File.c: ext/dbm/NDBM_File.xs ext/xsubpp ext/typemap - test -f miniperl || make miniperl - ./miniperl ext/xsubpp ext/dbm/NDBM_File.xs >tmp - mv tmp NDBM_File.c - -lib/auto/NDBM_File/NDBM_File$(SHLIBSUFFIX): NDBM_File.o - test -d lib/auto/NDBM_File || mkdir lib/auto/NDBM_File - ld $(LDDLFLAGS) -o $@ NDBM_File.o - -# ODBM_File extension -ODBM_File.o: ODBM_File.c - $(CCCMD) $(CCCDLFLAGS) $*.c - -ODBM_File.c: ext/dbm/ODBM_File.xs ext/xsubpp ext/typemap - test -f miniperl || make miniperl - ./miniperl ext/xsubpp ext/dbm/ODBM_File.xs >tmp - mv tmp ODBM_File.c - -lib/auto/ODBM_File/ODBM_File$(SHLIBSUFFIX): ODBM_File.o - test -d lib/auto/ODBM_File || mkdir lib/auto/ODBM_File - ld $(LDDLFLAGS) -o $@ ODBM_File.o - -# SDBM_File extension -SDBM_File.o: SDBM_File.c - $(CCCMD) $(CCCDLFLAGS) $*.c - -SDBM_File.c: ext/dbm/SDBM_File.xs ext/xsubpp ext/typemap - test -f miniperl || make miniperl - ./miniperl ext/xsubpp ext/dbm/SDBM_File.xs >tmp - mv tmp SDBM_File.c - -lib/auto/SDBM_File/SDBM_File$(SHLIBSUFFIX): SDBM_File.o ext/dbm/sdbm/libsdbm.a - test -d lib/auto/SDBM_File || mkdir lib/auto/SDBM_File - ld $(LDDLFLAGS) -o $@ SDBM_File.o ext/dbm/sdbm/libsdbm.a - -# POSIX extension -POSIX.o: POSIX.c - $(CCCMD) $(CCCDLFLAGS) $*.c - -POSIX.c: ext/posix/POSIX.xs ext/xsubpp ext/typemap - test -f miniperl || make miniperl - ./miniperl ext/xsubpp ext/posix/POSIX.xs >tmp - mv tmp POSIX.c - -lib/auto/POSIX/POSIX$(SHLIBSUFFIX): POSIX.o - test -d lib/auto/POSIX || mkdir lib/auto/POSIX - ld $(LDDLFLAGS) -o $@ POSIX.o -lm - -# List of extensions (used by writemain) to generate perlmain.c -ext= NDBM_File ODBM_File SDBM_File POSIX -extsrc= NDBM_File.c ODBM_File.c SDBM_File.c POSIX.c -# Extension dependencies. -extdep= lib/auto/NDBM_File/NDBM_File$(SHLIBSUFFIX) lib/auto/ODBM_File/ODBM_File$(SHLIBSUFFIX) lib/auto/SDBM_File/SDBM_File$(SHLIBSUFFIX) lib/auto/POSIX/POSIX$(SHLIBSUFFIX) -# How to include extensions in linking command -extobj= - -ext/dbm/sdbm/libsdbm.a: ext/dbm/sdbm/sdbm.h ext/dbm/sdbm/sdbm.c - cd ext/dbm/sdbm; $(MAKE) -f Makefile libsdbm.a - -# The $& notation tells Sequent machines that it can do a parallel make, -# and is harmless otherwise. - -miniperl: $& miniperlmain.o perl.o $(obj) - $(CC) $(LARGE) $(CLDFLAGS) -o miniperl miniperlmain.o perl.o $(obj) $(libs) - -perlmain.c: miniperlmain.c - sh writemain $(ext) > perlmain.c - -perlmain.o: perlmain.c - -perl: $& perlmain.o perl.o $(obj) $(dlobj) $(extdep) - $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o perl perlmain.o perl.o $(obj) $(dlobj) $(extobj) $(libs) - -libperl.rlb: libperl.a - $(ranlib) libperl.a - touch libperl.rlb - -libperl.a: $& perl.o $(obj) - ar rcuv libperl.a $(obj) - -# This version, if specified in Configure, does ONLY those scripts which need -# set-id emulation. Suidperl must be setuid root. It contains the "taint" -# checks as well as the special code to validate that the script in question -# has been invoked correctly. - -suidperl: $& sperl.o perlmain.o libperl.rlb - $(CC) $(LARGE) $(CLDFLAGS) sperl.o perlmain.o libperl.a $(libs) -o suidperl - -lib/Config.pm: config.sh miniperl - ./miniperl configpm - -saber: $(saber) - # load $(saber) - # load /lib/libm.a - -sperl.o: perl.c perly.h patchlevel.h $(h) - $(RMS) sperl.c - $(LNS) perl.c sperl.c - $(CCCMD) -DIAMSUID sperl.c - $(RMS) sperl.c - -perly.h: perly.c - @ echo Dummy dependency for dumb parallel make - touch perly.h - -opcode.h: opcode.pl - - perl opcode.pl - -embed.h: embed_h.SH global.sym interp.sym - sh embed_h.SH - -perly.c: - @ echo 'Expect' 80 shift/reduce and 62 reduce/reduce conflicts - $(BYACC) -d perly.y - sh $(shellflags) ./perly.fixer y.tab.c perly.c - mv y.tab.h perly.h - echo 'extern YYSTYPE yylval;' >>perly.h - -perly.o: perly.c perly.h $(h) - $(CCCMD) perly.c - -install: all - ./perl installperl - -clean: - rm -f *.o all perl miniperl - rm -f POSIX.c ?DBM_File.c perlmain.c - rm -f ext/dbm/sdbm/libsdbm.a - cd ext/dbm/sdbm; $(MAKE) -f Makefile clean - cd x2p; $(MAKE) clean - -realclean: clean - cd x2p; $(MAKE) realclean - cd ext/dbm/sdbm; $(MAKE) -f Makefile realclean - rm -f *.orig */*.orig *~ */*~ core $(addedbyconf) h2ph h2ph.man - rm -f Makefile cflags embed_h makedepend makedir writemain - rm -f config.h t/perl makefile makefile.old cflags - rm -rf lib/auto/?DBM_File lib/auto/POSIX - rm -f x2p/Makefile x2p/makefile x2p/makefile.old x2p/cflags - rm -f lib/Config.pm - rm -f c2ph pstruct - -# The following lint has practically everything turned on. Unfortunately, -# you have to wade through a lot of mumbo jumbo that can't be suppressed. -# If the source file has a /*NOSTRICT*/ somewhere, ignore the lint message -# for that spot. - -lint: perly.c $(c) - lint $(lintflags) $(defs) perly.c $(c) > perl.fuzz - -depend: makedepend - - test -f perly.h || cp /dev/null perly.h - ./makedepend - - test -s perly.h || /bin/rm -f perly.h - cd x2p; $(MAKE) depend - -test: perl lib/Config.pm - - cd t && chmod +x TEST */*.t - - cd t && (rm -f perl; $(LNS) ../perl perl) && ./perl TEST .clist - -hlist: $(h) - echo $(h) | tr ' ' '\012' >.hlist - -shlist: $(sh) - echo $(sh) | tr ' ' '\012' >.shlist - -# AUTOMATICALLY GENERATED MAKE DEPENDENCIES--PUT NOTHING BELOW THIS LINE -# If this runs make out of memory, delete /usr/include lines. diff --git a/Makefile.SH b/Makefile.SH index 88b8b71..e1e666d 100644 --- a/Makefile.SH +++ b/Makefile.SH @@ -22,51 +22,43 @@ case "$d_dosuid" in *) suidperl='';; esac -: Certain parts of Makefile need to be commented out if dynamic -: loading is not used. -case "$usedl" in -define) comment='' ;; -*) comment='#' ;; +: Configure sets byacc=byacc if byacc is not found. We reset it to '' +case "$byacc" in +''|'byacc') byacc='';; esac +: Prepare dependency lists for Makefile. +dynamic_list=' ' +for f in $dynamic_ext; do + : the dependency named here will never exist + dynamic_list="$dynamic_list $f.$dlext" +done + +static_list=' ' +static_ai_list=' ' +for f in $static_ext; do + base=`echo "$f" | sed 's/.*\///'` + static_list="$static_list ext/$f/$base.a" + if test -f ext/$f/AutoInit.c; then + static_ai_list="$static_ai_list ext/$f/AutoInit.c" + fi + if test -f ext/$f/AutoInit.pl; then + static_ai_list="$static_ai_list ext/$f/AutoInit.pl" + fi +done + echo "Extracting Makefile (with variable substitutions)" -: This section of the file will have variable substitutions done on it. -: Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!. -: Protect any dollar signs and backticks that you do not want interpreted -: by putting a backslash in front. You may delete these comments. -$spitshell >Makefile <Makefile <<'!NO!SUBS!' +# Makefile.SH # This file is derived from Makefile.SH. Any changes made here will # be lost the next time you run Configure. # Makefile is used to generate makefile. The only difference # is that makefile has the dependencies filled in at the end. # -# \$Log: Makefile.SH,v \$ -# Revision 4.1 92/08/07 17:18:08 lwall -# Stage 6 Snapshot -# -# Revision 4.0.1.4 92/06/08 11:40:43 lwall -# patch20: cray didn't give enough memory to /bin/sh -# patch20: various and sundry fixes -# -# Revision 4.0.1.3 91/11/05 15:48:11 lwall -# patch11: saberized perl -# patch11: added support for dbz -# -# Revision 4.0.1.2 91/06/07 10:14:43 lwall -# patch4: cflags now emits entire cc command except for the filename -# patch4: alternate make programs are now semi-supported -# patch4: uperl.o no longer tries to link in libraries prematurely -# patch4: installperl now installs x2p stuff too -# -# Revision 4.0.1.1 91/04/11 17:30:39 lwall -# patch1: C flags are now settable on a per-file basis -# -# Revision 4.0 91/03/20 00:58:54 lwall -# 4.0 baseline. -# # +!NO!SUBS! +$spitshell >>Makefile <>Makefile <<'!NO!SUBS!' -CCCMD = `sh $(shellflags) cflags $@` +CCCMD = `sh $(shellflags) cflags $(perllib) $@` private = -scripts = h2ph +scripts = -manpages = perl.man h2ph.man +manpages = perl.man util = sh = Makefile.SH cflags.SH embed_h.SH makedepend.SH makedir.SH writemain.SH -h1 = EXTERN.h INTERN.h av.h cop.h config.h embed.h form.h handy.h -h2 = hv.h op.h opcode.h perl.h regcomp.h regexp.h gv.h sv.h util.h - h1 = EXTERN.h INTERN.h XSUB.h av.h config.h cop.h cv.h dosish.h -h2 = embed.h form.h gv.h handy.h hv.h hvdbm.h keywords.h mg.h op.h +h2 = embed.h form.h gv.h handy.h hv.h keywords.h mg.h op.h h3 = opcode.h patchlevel.h perl.h perly.h pp.h proto.h regcomp.h h4 = regexp.h scope.h sv.h unixish.h util.h h = $(h1) $(h2) $(h3) $(h4) -c1 = av.c scope.c op.c doop.c doio.c dump.c hv.c -c2 = $(mallocsrc) mg.c perly.c pp.c regcomp.c regexec.c +c1 = $(mallocsrc) av.c scope.c op.c doop.c doio.c dump.c hv.c mg.c +c2 = perl.c perly.c pp.c pp_hot.c pp_ctl.c pp_sys.c regcomp.c regexec.c c3 = gv.c sv.c taint.c toke.c util.c deb.c run.c -c = $(c1) $(c2) $(c3) $(dlsrc) miniperlmain.c perlmain.c - -s1 = av.c scope.c op.c doop.c doio.c dump.c hv.c -s2 = $(mallocsrc) mg.c perly.c pp.c regcomp.c regexec.c -s3 = gv.c sv.c taint.c toke.c util.c deb.c run.c perly.c - -saber = $(s1) $(s2) $(s3) $(dlsrc) +c = $(c1) $(c2) $(c3) miniperlmain.c perlmain.c -obj1 = av.o scope.o op.o doop.o doio.o dump.o hv.o -obj2 = $(mallocobj) mg.o perly.o pp.o regcomp.o regexec.o -obj3 = gv.o sv.o taint.o toke.o util.o deb.o run.o +obj1 = $(mallocobj) gv.o toke.o perly.o op.o regcomp.o dump.o util.o mg.o +obj2 = hv.o av.o run.o pp_hot.o sv.o pp.o scope.o pp_ctl.o pp_sys.o +obj3 = doop.o doio.o regexec.o taint.o deb.o obj = $(obj1) $(obj2) $(obj3) +# Once perl has been Configure'd and built ok you build different +# perl variants (Debugging, Embedded, Multiplicity etc) by saying: +# make clean; make perllib=libperl.a +# where is some combination of 'd' and(or) 'e' or 'm'. +# See cflags to understand how this works. +# +# Eventually some form of 'make-a-perl' script will automate this +# together with linking a perl executable with any desired +# static modules. +perllib = libperl.a + lintflags = -hbvxac -addedbyconf = Makefile.old bsd eunice filexp loc pdp11 usg v7 +addedbyconf = UU # grrr SHELL = /bin/sh @@ -158,142 +155,55 @@ SHELL = /bin/sh .c.o: $(CCCMD) $*.c -all: miniperl perl lib/Config.pm - -#all: $(public) $(private) $(util) $(scripts) -# cd x2p; $(MAKE) all -# touch all +all: makefile miniperl preplibrary $(public) $(dynamic_ext) + @echo " "; echo " Making x2p stuff"; cd x2p; $(MAKE) all + @echo " "; echo " Making docs"; cd pod; $(MAKE) all; # Phony target to force checking subdirectories. FORCE: !NO!SUBS! -### Some makes have problems with the following dependency -### if $(dlsrc) or $(dlobj) is empty. -### Therefore, comment it out if dlsrc is null. -### -$spitshell >>Makefile <>Makefile <tmp - mv tmp $base.c - -${comment}lib/auto/$base/$base\$(SHLIBSUFFIX): $base.o $extradep -${comment} test -d lib/auto/$base || mkdir lib/auto/$base -${comment} ld \$(LDDLFLAGS) -o \$@ $base.o $extraobj -!GROK!THIS! - -done - -$spitshell >>Makefile <>Makefile <<'!NO!SUBS!' # The $& notation tells Sequent machines that it can do a parallel make, # and is harmless otherwise. -miniperl: $& miniperlmain.o perl.o $(obj) - $(CC) $(LARGE) $(CLDFLAGS) -o miniperl miniperlmain.o perl.o $(obj) $(libs) +miniperl: $& miniperlmain.o $(perllib) + $(CC) $(LARGE) $(CLDFLAGS) -o miniperl miniperlmain.o $(perllib) $(libs) -perlmain.c: miniperlmain.c - sh writemain $(ext) > perlmain.c +perlmain.c: miniperlmain.c config.sh makefile $(static_ext_autoinit) + sh writemain $(DYNALOADER) $(static_ext) > tmp + sh mv-if-diff tmp perlmain.c perlmain.o: perlmain.c -perl: $& perlmain.o perl.o $(obj) $(dlobj) $(extdep) - $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o perl perlmain.o perl.o $(obj) $(dlobj) $(extobj) $(libs) +# The file ext.libs is a list of libraries that must be linked in +# for static extensions, e.g. -lm -lgdbm, etc. The individual +# static extension Makefile's add to it. +ext.libs: $(static_ext) + -@test -f ext.libs || touch ext.libs -pureperl: $& perlmain.o perl.o $(obj) $(dlobj) $(extdep) - purify $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o pureperl perlmain.o perl.o $(obj) $(dlobj) $(extobj) $(libs) +perl: $& perlmain.o $(perllib) $(DYNALOADER) $(static_ext) ext.libs + $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o perl perlmain.o $(perllib) $(DYNALOADER) $(static_ext) `cat ext.libs` $(libs) -quantperl: $& perlmain.o perl.o $(obj) $(dlobj) $(extdep) - quantify $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o quantperl perlmain.o perl.o $(obj) $(dlobj) $(extobj) $(libs) +pureperl: $& perlmain.o $(perllib) $(DYNALOADER) $(static_ext) ext.libs + purify $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o pureperl perlmain.o $(perllib) $(DYNALOADER) $(static_ext) `cat ext.libs` $(libs) -libperl.rlb: libperl.a - $(ranlib) libperl.a - touch libperl.rlb +quantperl: $& perlmain.o $(perllib) $(DYNALOADER) $(static_ext) ext.libs + quantify $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o quantperl perlmain.o $(perllib) $(DYNALOADER) $(static_ext) `cat ext.libs` $(libs) -libperl.a: $& perl.o $(obj) - ar rcuv libperl.a $(obj) +$(perllib): $& perl.o $(obj) + ar rcu $(perllib) perl.o $(obj) + @$(ranlib) $(perllib) # This version, if specified in Configure, does ONLY those scripts which need # set-id emulation. Suidperl must be setuid root. It contains the "taint" # checks as well as the special code to validate that the script in question # has been invoked correctly. -suidperl: $& sperl.o perlmain.o libperl.rlb - $(CC) $(LARGE) $(CLDFLAGS) sperl.o perlmain.o libperl.a $(libs) -o suidperl - -lib/Config.pm: config.sh miniperl - ./miniperl configpm - -saber: $(saber) - # load $(saber) - # load /lib/libm.a +suidperl: $& sperl.o perlmain.o $(perllib) $(DYNALOADER) $(static_ext) ext.libs + $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o suidperl perlmain.o sperl.o $(perllib) $(DYNALOADER) $(static_ext) `cat ext.libs` $(libs) sperl.o: perl.c perly.h patchlevel.h $(h) $(RMS) sperl.c @@ -301,46 +211,109 @@ sperl.o: perl.c perly.h patchlevel.h $(h) $(CCCMD) -DIAMSUID sperl.c $(RMS) sperl.c -perly.h: perly.c - @ echo Dummy dependency for dumb parallel make - touch perly.h - opcode.h: opcode.pl - perl opcode.pl embed.h: embed_h.SH global.sym interp.sym sh embed_h.SH -perly.c: - @ echo 'Expect' 80 shift/reduce and 62 reduce/reduce conflicts - $(BYACC) -d perly.y - sh $(shellflags) ./perly.fixer y.tab.c perly.c - mv y.tab.h perly.h - echo 'extern YYSTYPE yylval;' >>perly.h +preplibrary: miniperl lib/Config.pm + @test -d lib/auto || mkdir lib/auto + @echo " AutoSplitting perl library" + @./miniperl -Ilib -e 'use AutoSplit; \ + autosplit_lib_modules(@ARGV)' lib/*.pm lib/*/*.pm -perly.o: perly.c perly.h $(h) - $(CCCMD) perly.c +lib/Config.pm: config.sh miniperl + ./miniperl configpm install: all ./perl installperl +!NO!SUBS! + +: Only print out the rules for running byacc if the user _has_ byacc. +: Otherwise, comment them out. Users who really know what they are +: doing can uncomment them and run yacc or bison or whatever. +: Configure sets byacc=byacc if byacc is not found. +case "$byacc" in +''|'byacc') + comment1='#' + comment2='' ;; +*) comment1='' + comment2='#' ;; +esac + +$spitshell >>Makefile <>perly.h + +# This version is used only if you do not have byacc. +${comment2}perly.c: perly.y +${comment2} touch perly.c + +!GROK!THIS! + +$spitshell >>Makefile <<'!NO!SUBS!' +# Extensions: +# Names added to $(dynamic_ext) or $(static_ext) will automatically +# get built. There should ordinarily be no need to change any of +# this part of makefile. +# +# The dummy dependency is a place holder in case $(dynamic_ext) or +# $(static_ext) is empty. +# +# DynaLoader may be needed for extensions that use Makefile.PL. + +$(DYNALOADER): miniperl preplibrary FORCE + @sh ext/util/make_ext static $@ + +d_dummy $(dynamic_ext): miniperl preplibrary $(DYNALOADER) FORCE + @sh ext/util/make_ext dynamic $@ + +s_dummy $(static_ext): miniperl preplibrary $(DYNALOADER) FORCE + @sh ext/util/make_ext static $@ clean: - rm -f *.o all perl miniperl - rm -f POSIX.c ?DBM_File.c perlmain.c - rm -f ext/dbm/sdbm/libsdbm.a - cd ext/dbm/sdbm; $(MAKE) -f Makefile clean - cd x2p; $(MAKE) clean + rm -f *.o *.a all perl suidperl miniperl + rm -f perlmain.c + rm -f perl.exp ext.libs ext/util/extlibist + -cd x2p; $(MAKE) clean + -cd pod; $(MAKE) clean + -@for x in ext/* ; do \ + if test -f $$x/Makefile; then \ + echo " Making clean in $$x"; \ + cd $$x; $(MAKE) clean ; cd ../.. ; \ + fi ; \ + done realclean: clean - cd x2p; $(MAKE) realclean - cd ext/dbm/sdbm; $(MAKE) -f Makefile realclean - rm -f *.orig */*.orig *~ */*~ core $(addedbyconf) h2ph h2ph.man - rm -f Makefile cflags embed_h makedepend makedir writemain - rm -f config.h t/perl makefile makefile.old cflags - rm -rf lib/auto/?DBM_File lib/auto/POSIX + -cd x2p; $(MAKE) realclean + -@for x in ext/* ; do \ + if test -f $$x/Makefile; then \ + echo " Making realclean in $$x"; \ + cd $$x; $(MAKE) realclean ; cd ../.. ; \ + fi ; \ + done + rm -f *.orig */*.orig *~ */*~ core t/core + rm -rf $(addedbyconf) + rm -f Makefile cflags makedepend makedir writemain + rm -f config.h t/perl makefile makefile.old rm -f x2p/Makefile x2p/makefile x2p/makefile.old x2p/cflags rm -f lib/Config.pm - rm -f c2ph pstruct + rm -rf lib/auto + rm -f h2ph h2ph.man c2ph pstruct + rm -rf .config # The following lint has practically everything turned on. Unfortunately, # you have to wade through a lot of mumbo jumbo that can't be suppressed. @@ -350,13 +323,18 @@ realclean: clean lint: perly.c $(c) lint $(lintflags) $(defs) perly.c $(c) > perl.fuzz +makefile: Makefile + make depend + +# When done, touch perlmain.c so that it doesn't get remade each time. depend: makedepend - test -f perly.h || cp /dev/null perly.h ./makedepend - test -s perly.h || /bin/rm -f perly.h + - test -s perlmain.c && touch perlmain.c cd x2p; $(MAKE) depend -test: perl lib/Config.pm +test: miniperl perl preplibrary $(dynamic_ext) - cd t && chmod +x TEST */*.t - cd t && (rm -f perl; $(LNS) ../perl perl) && ./perl TEST - -typedef DBM* NDBM_File; -#define dbm_new(dbtype,filename,flags,mode) dbm_open(filename,flags,mode) -#define nextkey(db,key) dbm_nextkey(db) - -static int -XS_NDBM_File_dbm_new(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 4) { - croak("Usage: NDBM_File::new(dbtype, filename, flags, mode)"); - } - { - char * dbtype = SvPV(ST(1),na); - char * filename = SvPV(ST(2),na); - int flags = (int)SvIV(ST(3)); - int mode = (int)SvIV(ST(4)); - NDBM_File RETVAL; - - RETVAL = dbm_new(dbtype, filename, flags, mode); - ST(0) = sv_newmortal(); - sv_setptrobj(ST(0), RETVAL, "NDBM_File"); - } - return ax; -} - -static int -XS_NDBM_File_dbm_DESTROY(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: NDBM_File::DESTROY(db)"); - } - { - NDBM_File db; - - if (SvROK(ST(1))) { - unsigned long tmp; - tmp = (unsigned long)SvNV((SV*)SvRV(ST(1))); - db = (NDBM_File) tmp; - } - else - croak("db is not a reference"); - dbm_close(db); - } - return ax; -} - -static int -XS_NDBM_File_dbm_fetch(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 2) { - croak("Usage: NDBM_File::fetch(db, key)"); - } - { - NDBM_File db; - datum key; - datum RETVAL; - - if (sv_isa(ST(1), "NDBM_File")) { - unsigned long tmp; - tmp = (unsigned long)SvNV((SV*)SvRV(ST(1))); - db = (NDBM_File) tmp; - } - else - croak("db is not of type NDBM_File"); - - key.dptr = SvPV(ST(2), na); - key.dsize = (int)na;; - - RETVAL = dbm_fetch(db, key); - ST(0) = sv_newmortal(); - sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); - } - return ax; -} - -static int -XS_NDBM_File_dbm_store(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items < 3 || items > 4) { - croak("Usage: NDBM_File::store(db, key, value, flags = DBM_REPLACE)"); - } - { - NDBM_File db; - datum key; - datum value; - int flags; - int RETVAL; - - if (sv_isa(ST(1), "NDBM_File")) { - unsigned long tmp; - tmp = (unsigned long)SvNV((SV*)SvRV(ST(1))); - db = (NDBM_File) tmp; - } - else - croak("db is not of type NDBM_File"); - - key.dptr = SvPV(ST(2), na); - key.dsize = (int)na;; - - value.dptr = SvPV(ST(3), na); - value.dsize = (int)na;; - - if (items < 4) - flags = DBM_REPLACE; - else { - flags = (int)SvIV(ST(4)); - } - - RETVAL = dbm_store(db, key, value, flags); - ST(0) = sv_newmortal(); - sv_setiv(ST(0), (I32)RETVAL); - } - return ax; -} - -static int -XS_NDBM_File_dbm_delete(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 2) { - croak("Usage: NDBM_File::delete(db, key)"); - } - { - NDBM_File db; - datum key; - int RETVAL; - - if (sv_isa(ST(1), "NDBM_File")) { - unsigned long tmp; - tmp = (unsigned long)SvNV((SV*)SvRV(ST(1))); - db = (NDBM_File) tmp; - } - else - croak("db is not of type NDBM_File"); - - key.dptr = SvPV(ST(2), na); - key.dsize = (int)na;; - - RETVAL = dbm_delete(db, key); - ST(0) = sv_newmortal(); - sv_setiv(ST(0), (I32)RETVAL); - } - return ax; -} - -static int -XS_NDBM_File_dbm_firstkey(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: NDBM_File::firstkey(db)"); - } - { - NDBM_File db; - datum RETVAL; - - if (sv_isa(ST(1), "NDBM_File")) { - unsigned long tmp; - tmp = (unsigned long)SvNV((SV*)SvRV(ST(1))); - db = (NDBM_File) tmp; - } - else - croak("db is not of type NDBM_File"); - - RETVAL = dbm_firstkey(db); - ST(0) = sv_newmortal(); - sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); - } - return ax; -} - -static int -XS_NDBM_File_nextkey(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 2) { - croak("Usage: NDBM_File::nextkey(db, key)"); - } - { - NDBM_File db; - datum key; - datum RETVAL; - - if (sv_isa(ST(1), "NDBM_File")) { - unsigned long tmp; - tmp = (unsigned long)SvNV((SV*)SvRV(ST(1))); - db = (NDBM_File) tmp; - } - else - croak("db is not of type NDBM_File"); - - key.dptr = SvPV(ST(2), na); - key.dsize = (int)na;; - - RETVAL = nextkey(db, key); - ST(0) = sv_newmortal(); - sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); - } - return ax; -} - -static int -XS_NDBM_File_dbm_error(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: NDBM_File::error(db)"); - } - { - NDBM_File db; - int RETVAL; - - if (sv_isa(ST(1), "NDBM_File")) { - unsigned long tmp; - tmp = (unsigned long)SvNV((SV*)SvRV(ST(1))); - db = (NDBM_File) tmp; - } - else - croak("db is not of type NDBM_File"); - - RETVAL = dbm_error(db); - ST(0) = sv_newmortal(); - sv_setiv(ST(0), (I32)RETVAL); - } - return ax; -} - -static int -XS_NDBM_File_dbm_clearerr(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: NDBM_File::clearerr(db)"); - } - { - NDBM_File db; - int RETVAL; - - if (sv_isa(ST(1), "NDBM_File")) { - unsigned long tmp; - tmp = (unsigned long)SvNV((SV*)SvRV(ST(1))); - db = (NDBM_File) tmp; - } - else - croak("db is not of type NDBM_File"); - - RETVAL = dbm_clearerr(db); - ST(0) = sv_newmortal(); - sv_setiv(ST(0), (I32)RETVAL); - } - return ax; -} - -int boot_NDBM_File(ix,ax,items) -int ix; -int ax; -int items; -{ - char* file = __FILE__; - - newXSUB("NDBM_File::new", 0, XS_NDBM_File_dbm_new, file); - newXSUB("NDBM_File::DESTROY", 0, XS_NDBM_File_dbm_DESTROY, file); - newXSUB("NDBM_File::fetch", 0, XS_NDBM_File_dbm_fetch, file); - newXSUB("NDBM_File::store", 0, XS_NDBM_File_dbm_store, file); - newXSUB("NDBM_File::delete", 0, XS_NDBM_File_dbm_delete, file); - newXSUB("NDBM_File::firstkey", 0, XS_NDBM_File_dbm_firstkey, file); - newXSUB("NDBM_File::nextkey", 0, XS_NDBM_File_nextkey, file); - newXSUB("NDBM_File::error", 0, XS_NDBM_File_dbm_error, file); - newXSUB("NDBM_File::clearerr", 0, XS_NDBM_File_dbm_clearerr, file); -} diff --git a/ODBM_File.c b/ODBM_File.c deleted file mode 100644 index 8a073f3..0000000 --- a/ODBM_File.c +++ /dev/null @@ -1,271 +0,0 @@ -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#ifdef NULL -#undef NULL -#endif -#include - -#include - -typedef void* ODBM_File; - -#define odbm_fetch(db,key) fetch(key) -#define odbm_store(db,key,value,flags) store(key,value) -#define odbm_delete(db,key) delete(key) -#define odbm_firstkey(db) firstkey() -#define odbm_nextkey(db,key) nextkey(key) - -static int dbmrefcnt; - -#ifndef DBM_REPLACE -#define DBM_REPLACE 0 -#endif - -static int -XS_ODBM_File_odbm_new(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 4) { - croak("Usage: ODBM_File::new(dbtype, filename, flags, mode)"); - } - { - char * dbtype = SvPV(ST(1),na); - char * filename = SvPV(ST(2),na); - int flags = (int)SvIV(ST(3)); - int mode = (int)SvIV(ST(4)); - ODBM_File RETVAL; - { - char tmpbuf[1025]; - if (dbmrefcnt++) - croak("Old dbm can only open one database"); - sprintf(tmpbuf,"%s.dir",filename); - if (stat(tmpbuf, &statbuf) < 0) { - if (flags & O_CREAT) { - if (mode < 0 || close(creat(tmpbuf,mode)) < 0) - croak("ODBM_File: Can't create %s", filename); - sprintf(tmpbuf,"%s.pag",filename); - if (close(creat(tmpbuf,mode)) < 0) - croak("ODBM_File: Can't create %s", filename); - } - else - croak("ODBM_FILE: Can't open %s", filename); - } - RETVAL = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setptrobj(ST(0), RETVAL, "ODBM_File"); - } - } - return ax; -} - -static int -XS_ODBM_File_DESTROY(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: ODBM_File::DESTROY(db)"); - } - { - ODBM_File db; - - if (SvROK(ST(1))) { - unsigned long tmp; - tmp = (unsigned long)SvNV((SV*)SvRV(ST(1))); - db = (ODBM_File) tmp; - } - else - croak("db is not a reference"); - dbmrefcnt--; - dbmclose(); - } - return ax; -} - -static int -XS_ODBM_File_odbm_fetch(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 2) { - croak("Usage: ODBM_File::fetch(db, key)"); - } - { - ODBM_File db; - datum key; - datum RETVAL; - - if (sv_isa(ST(1), "ODBM_File")) { - unsigned long tmp; - tmp = (unsigned long)SvNV((SV*)SvRV(ST(1))); - db = (ODBM_File) tmp; - } - else - croak("db is not of type ODBM_File"); - - key.dptr = SvPV(ST(2), na); - key.dsize = (int)na;; - - RETVAL = odbm_fetch(db, key); - ST(0) = sv_newmortal(); - sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); - } - return ax; -} - -static int -XS_ODBM_File_odbm_store(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items < 3 || items > 4) { - croak("Usage: ODBM_File::store(db, key, value, flags = DBM_REPLACE)"); - } - { - ODBM_File db; - datum key; - datum value; - int flags; - int RETVAL; - - if (sv_isa(ST(1), "ODBM_File")) { - unsigned long tmp; - tmp = (unsigned long)SvNV((SV*)SvRV(ST(1))); - db = (ODBM_File) tmp; - } - else - croak("db is not of type ODBM_File"); - - key.dptr = SvPV(ST(2), na); - key.dsize = (int)na;; - - value.dptr = SvPV(ST(3), na); - value.dsize = (int)na;; - - if (items < 4) - flags = DBM_REPLACE; - else { - flags = (int)SvIV(ST(4)); - } - - RETVAL = odbm_store(db, key, value, flags); - ST(0) = sv_newmortal(); - sv_setiv(ST(0), (I32)RETVAL); - } - return ax; -} - -static int -XS_ODBM_File_odbm_delete(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 2) { - croak("Usage: ODBM_File::delete(db, key)"); - } - { - ODBM_File db; - datum key; - int RETVAL; - - if (sv_isa(ST(1), "ODBM_File")) { - unsigned long tmp; - tmp = (unsigned long)SvNV((SV*)SvRV(ST(1))); - db = (ODBM_File) tmp; - } - else - croak("db is not of type ODBM_File"); - - key.dptr = SvPV(ST(2), na); - key.dsize = (int)na;; - - RETVAL = odbm_delete(db, key); - ST(0) = sv_newmortal(); - sv_setiv(ST(0), (I32)RETVAL); - } - return ax; -} - -static int -XS_ODBM_File_odbm_firstkey(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: ODBM_File::firstkey(db)"); - } - { - ODBM_File db; - datum RETVAL; - - if (sv_isa(ST(1), "ODBM_File")) { - unsigned long tmp; - tmp = (unsigned long)SvNV((SV*)SvRV(ST(1))); - db = (ODBM_File) tmp; - } - else - croak("db is not of type ODBM_File"); - - RETVAL = odbm_firstkey(db); - ST(0) = sv_newmortal(); - sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); - } - return ax; -} - -static int -XS_ODBM_File_odbm_nextkey(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 2) { - croak("Usage: ODBM_File::nextkey(db, key)"); - } - { - ODBM_File db; - datum key; - datum RETVAL; - - if (sv_isa(ST(1), "ODBM_File")) { - unsigned long tmp; - tmp = (unsigned long)SvNV((SV*)SvRV(ST(1))); - db = (ODBM_File) tmp; - } - else - croak("db is not of type ODBM_File"); - - key.dptr = SvPV(ST(2), na); - key.dsize = (int)na;; - - RETVAL = odbm_nextkey(db, key); - ST(0) = sv_newmortal(); - sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); - } - return ax; -} - -int boot_ODBM_File(ix,ax,items) -int ix; -int ax; -int items; -{ - char* file = __FILE__; - - newXSUB("ODBM_File::new", 0, XS_ODBM_File_odbm_new, file); - newXSUB("ODBM_File::DESTROY", 0, XS_ODBM_File_DESTROY, file); - newXSUB("ODBM_File::fetch", 0, XS_ODBM_File_odbm_fetch, file); - newXSUB("ODBM_File::store", 0, XS_ODBM_File_odbm_store, file); - newXSUB("ODBM_File::delete", 0, XS_ODBM_File_odbm_delete, file); - newXSUB("ODBM_File::firstkey", 0, XS_ODBM_File_odbm_firstkey, file); - newXSUB("ODBM_File::nextkey", 0, XS_ODBM_File_odbm_nextkey, file); -} diff --git a/Obsolete b/Obsolete deleted file mode 100644 index c8dbdd0..0000000 --- a/Obsolete +++ /dev/null @@ -1,25 +0,0 @@ - - File | Old symbol | New symbol ------------------------------------+----------------------+--------------------- -atarist/config.h | GIDTYPE | Gid_t -atarist/config.h | HAS_GDBM | I_GDBM -atarist/config.h | UIDTYPE | Uid_t -doio.c | STDSTDIO | USE_STD_STDIO -hvdbm.h | HAS_GDBM | I_GDBM -mg.c | GIDTYPE | Gid_t -mg.c | UIDTYPE | Uid_t -msdos/config.h | GIDTYPE | Gid_t -msdos/config.h | UIDTYPE | Uid_t -os2/config.h | GIDTYPE | Gid_t -os2/config.h | HAS_GDBM | I_GDBM -os2/config.h | UIDTYPE | Uid_t -perl.c | GIDTYPE | Gid_t -perl.c | UIDTYPE | Uid_t -perl.h | GIDTYPE | Gid_t -perl.h | UIDTYPE | Uid_t -pp.c | STATBLOCKS | USE_STAT_BLOCKS -pp.c | STDSTDIO | USE_STD_STDIO -sv.c | STDSTDIO | USE_STD_STDIO -usersub.c | STDSTDIO | USE_STD_STDIO -util.c | CHARVSPRINTF | USE_CHAR_VSPRINTF -util.c | SAFE_BCOPY | HAS_SAFE_BCOPY diff --git a/POSIX.c b/POSIX.c deleted file mode 100644 index b5036e5..0000000 --- a/POSIX.c +++ /dev/null @@ -1,3605 +0,0 @@ -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#include -#include -#include -#include -#ifdef I_FLOAT -#include -#endif -#include -#include -#include -#include -#ifdef I_PWD -#include -#endif -#include -#include -#ifdef I_STDARG -#include -#endif -#ifdef I_STDDEF -#include -#endif -#include -#include -#include -#include -#include -#include -#include -#include -#if defined(I_TERMIOS) && !defined(CR3) -#include -#endif -#include -#include -#include - -typedef int SysRet; -typedef sigset_t* POSIX__SigSet; -typedef HV* POSIX__SigAction; - -#define HAS_UNAME - -#ifndef HAS_GETPGRP -#define getpgrp() not_here("getpgrp") -#endif -#ifndef HAS_NICE -#define nice(a) not_here("nice") -#endif -#ifndef HAS_READLINK -#define readlink(a,b,c) not_here("readlink") -#endif -#ifndef HAS_SETPGID -#define setpgid(a,b) not_here("setpgid") -#endif -#ifndef HAS_SETSID -#define setsid() not_here("setsid") -#endif -#ifndef HAS_SYMLINK -#define symlink(a,b) not_here("symlink") -#endif -#ifndef HAS_TCGETPGRP -#define tcgetpgrp(a) not_here("tcgetpgrp") -#endif -#ifndef HAS_TCSETPGRP -#define tcsetpgrp(a,b) not_here("tcsetpgrp") -#endif -#ifndef HAS_TIMES -#define times(a) not_here("times") -#endif -#ifndef HAS_UNAME -#define uname(a) not_here("uname") -#endif -#ifndef HAS_WAITPID -#define waitpid(a,b,c) not_here("waitpid") -#endif - -static int -not_here(s) -char *s; -{ - croak("POSIX::%s not implemented on this architecture", s); - return -1; -} - -int constant(name, arg) -char *name; -int arg; -{ - errno = 0; - switch (*name) { - case 'A': - if (strEQ(name, "ARG_MAX")) -#ifdef ARG_MAX - return ARG_MAX; -#else - goto not_there; -#endif - break; - case 'B': - if (strEQ(name, "BUFSIZ")) -#ifdef BUFSIZ - return BUFSIZ; -#else - goto not_there; -#endif - if (strEQ(name, "BRKINT")) -#ifdef BRKINT - return BRKINT; -#else - goto not_there; -#endif - if (strEQ(name, "B9600")) -#ifdef B9600 - return B9600; -#else - goto not_there; -#endif - if (strEQ(name, "B19200")) -#ifdef B19200 - return B19200; -#else - goto not_there; -#endif - if (strEQ(name, "B38400")) -#ifdef B38400 - return B38400; -#else - goto not_there; -#endif - if (strEQ(name, "B0")) -#ifdef B0 - return B0; -#else - goto not_there; -#endif - if (strEQ(name, "B110")) -#ifdef B110 - return B110; -#else - goto not_there; -#endif - if (strEQ(name, "B1200")) -#ifdef B1200 - return B1200; -#else - goto not_there; -#endif - if (strEQ(name, "B134")) -#ifdef B134 - return B134; -#else - goto not_there; -#endif - if (strEQ(name, "B150")) -#ifdef B150 - return B150; -#else - goto not_there; -#endif - if (strEQ(name, "B1800")) -#ifdef B1800 - return B1800; -#else - goto not_there; -#endif - if (strEQ(name, "B200")) -#ifdef B200 - return B200; -#else - goto not_there; -#endif - if (strEQ(name, "B2400")) -#ifdef B2400 - return B2400; -#else - goto not_there; -#endif - if (strEQ(name, "B300")) -#ifdef B300 - return B300; -#else - goto not_there; -#endif - if (strEQ(name, "B4800")) -#ifdef B4800 - return B4800; -#else - goto not_there; -#endif - if (strEQ(name, "B50")) -#ifdef B50 - return B50; -#else - goto not_there; -#endif - if (strEQ(name, "B600")) -#ifdef B600 - return B600; -#else - goto not_there; -#endif - if (strEQ(name, "B75")) -#ifdef B75 - return B75; -#else - goto not_there; -#endif - break; - case 'C': - if (strEQ(name, "CHAR_BIT")) -#ifdef CHAR_BIT - return CHAR_BIT; -#else - goto not_there; -#endif - if (strEQ(name, "CHAR_MAX")) -#ifdef CHAR_MAX - return CHAR_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "CHAR_MIN")) -#ifdef CHAR_MIN - return CHAR_MIN; -#else - goto not_there; -#endif - if (strEQ(name, "CHILD_MAX")) -#ifdef CHILD_MAX - return CHILD_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "CLK_TCK")) -#ifdef CLK_TCK - return CLK_TCK; -#else - goto not_there; -#endif - if (strEQ(name, "CLOCAL")) -#ifdef CLOCAL - return CLOCAL; -#else - goto not_there; -#endif - if (strEQ(name, "CLOCKS_PER_SEC")) -#ifdef CLOCKS_PER_SEC - return CLOCKS_PER_SEC; -#else - goto not_there; -#endif - if (strEQ(name, "CREAD")) -#ifdef CREAD - return CREAD; -#else - goto not_there; -#endif - if (strEQ(name, "CS5")) -#ifdef CS5 - return CS5; -#else - goto not_there; -#endif - if (strEQ(name, "CS6")) -#ifdef CS6 - return CS6; -#else - goto not_there; -#endif - if (strEQ(name, "CS7")) -#ifdef CS7 - return CS7; -#else - goto not_there; -#endif - if (strEQ(name, "CS8")) -#ifdef CS8 - return CS8; -#else - goto not_there; -#endif - if (strEQ(name, "CSIZE")) -#ifdef CSIZE - return CSIZE; -#else - goto not_there; -#endif - if (strEQ(name, "CSTOPB")) -#ifdef CSTOPB - return CSTOPB; -#else - goto not_there; -#endif - break; - case 'D': - if (strEQ(name, "DBL_MAX")) -#ifdef DBL_MAX - return DBL_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "DBL_MIN")) -#ifdef DBL_MIN - return DBL_MIN; -#else - goto not_there; -#endif - if (strEQ(name, "DBL_DIG")) -#ifdef DBL_DIG - return DBL_DIG; -#else - goto not_there; -#endif - if (strEQ(name, "DBL_EPSILON")) -#ifdef DBL_EPSILON - return DBL_EPSILON; -#else - goto not_there; -#endif - if (strEQ(name, "DBL_MANT_DIG")) -#ifdef DBL_MANT_DIG - return DBL_MANT_DIG; -#else - goto not_there; -#endif - if (strEQ(name, "DBL_MAX_10_EXP")) -#ifdef DBL_MAX_10_EXP - return DBL_MAX_10_EXP; -#else - goto not_there; -#endif - if (strEQ(name, "DBL_MAX_EXP")) -#ifdef DBL_MAX_EXP - return DBL_MAX_EXP; -#else - goto not_there; -#endif - if (strEQ(name, "DBL_MIN_10_EXP")) -#ifdef DBL_MIN_10_EXP - return DBL_MIN_10_EXP; -#else - goto not_there; -#endif - if (strEQ(name, "DBL_MIN_EXP")) -#ifdef DBL_MIN_EXP - return DBL_MIN_EXP; -#else - goto not_there; -#endif - break; - case 'E': - switch (name[1]) { - case 'A': - if (strEQ(name, "EACCES")) -#ifdef EACCES - return EACCES; -#else - goto not_there; -#endif - if (strEQ(name, "EAGAIN")) -#ifdef EAGAIN - return EAGAIN; -#else - goto not_there; -#endif - break; - case 'B': - if (strEQ(name, "EBADF")) -#ifdef EBADF - return EBADF; -#else - goto not_there; -#endif - if (strEQ(name, "EBUSY")) -#ifdef EBUSY - return EBUSY; -#else - goto not_there; -#endif - break; - case 'C': - if (strEQ(name, "ECHILD")) -#ifdef ECHILD - return ECHILD; -#else - goto not_there; -#endif - if (strEQ(name, "ECHO")) -#ifdef ECHO - return ECHO; -#else - goto not_there; -#endif - if (strEQ(name, "ECHOE")) -#ifdef ECHOE - return ECHOE; -#else - goto not_there; -#endif - if (strEQ(name, "ECHOK")) -#ifdef ECHOK - return ECHOK; -#else - goto not_there; -#endif - if (strEQ(name, "ECHONL")) -#ifdef ECHONL - return ECHONL; -#else - goto not_there; -#endif - break; - case 'D': - if (strEQ(name, "EDEADLK")) -#ifdef EDEADLK - return EDEADLK; -#else - goto not_there; -#endif - if (strEQ(name, "EDOM")) -#ifdef EDOM - return EDOM; -#else - goto not_there; -#endif - break; - case 'E': - if (strEQ(name, "EEXIST")) -#ifdef EEXIST - return EEXIST; -#else - goto not_there; -#endif - break; - case 'F': - if (strEQ(name, "EFAULT")) -#ifdef EFAULT - return EFAULT; -#else - goto not_there; -#endif - if (strEQ(name, "EFBIG")) -#ifdef EFBIG - return EFBIG; -#else - goto not_there; -#endif - break; - case 'I': - if (strEQ(name, "EINTR")) -#ifdef EINTR - return EINTR; -#else - goto not_there; -#endif - if (strEQ(name, "EINVAL")) -#ifdef EINVAL - return EINVAL; -#else - goto not_there; -#endif - if (strEQ(name, "EIO")) -#ifdef EIO - return EIO; -#else - goto not_there; -#endif - if (strEQ(name, "EISDIR")) -#ifdef EISDIR - return EISDIR; -#else - goto not_there; -#endif - break; - case 'M': - if (strEQ(name, "EMFILE")) -#ifdef EMFILE - return EMFILE; -#else - goto not_there; -#endif - if (strEQ(name, "EMLINK")) -#ifdef EMLINK - return EMLINK; -#else - goto not_there; -#endif - break; - case 'N': - if (strEQ(name, "ENOMEM")) -#ifdef ENOMEM - return ENOMEM; -#else - goto not_there; -#endif - if (strEQ(name, "ENOSPC")) -#ifdef ENOSPC - return ENOSPC; -#else - goto not_there; -#endif - if (strEQ(name, "ENOEXEC")) -#ifdef ENOEXEC - return ENOEXEC; -#else - goto not_there; -#endif - if (strEQ(name, "ENOTTY")) -#ifdef ENOTTY - return ENOTTY; -#else - goto not_there; -#endif - if (strEQ(name, "ENOTDIR")) -#ifdef ENOTDIR - return ENOTDIR; -#else - goto not_there; -#endif - if (strEQ(name, "ENOTEMPTY")) -#ifdef ENOTEMPTY - return ENOTEMPTY; -#else - goto not_there; -#endif - if (strEQ(name, "ENFILE")) -#ifdef ENFILE - return ENFILE; -#else - goto not_there; -#endif - if (strEQ(name, "ENODEV")) -#ifdef ENODEV - return ENODEV; -#else - goto not_there; -#endif - if (strEQ(name, "ENOENT")) -#ifdef ENOENT - return ENOENT; -#else - goto not_there; -#endif - if (strEQ(name, "ENOLCK")) -#ifdef ENOLCK - return ENOLCK; -#else - goto not_there; -#endif - if (strEQ(name, "ENOSYS")) -#ifdef ENOSYS - return ENOSYS; -#else - goto not_there; -#endif - if (strEQ(name, "ENXIO")) -#ifdef ENXIO - return ENXIO; -#else - goto not_there; -#endif - if (strEQ(name, "ENAMETOOLONG")) -#ifdef ENAMETOOLONG - return ENAMETOOLONG; -#else - goto not_there; -#endif - break; - case 'O': - if (strEQ(name, "EOF")) -#ifdef EOF - return EOF; -#else - goto not_there; -#endif - break; - case 'P': - if (strEQ(name, "EPERM")) -#ifdef EPERM - return EPERM; -#else - goto not_there; -#endif - if (strEQ(name, "EPIPE")) -#ifdef EPIPE - return EPIPE; -#else - goto not_there; -#endif - break; - case 'R': - if (strEQ(name, "ERANGE")) -#ifdef ERANGE - return ERANGE; -#else - goto not_there; -#endif - if (strEQ(name, "EROFS")) -#ifdef EROFS - return EROFS; -#else - goto not_there; -#endif - break; - case 'S': - if (strEQ(name, "ESPIPE")) -#ifdef ESPIPE - return ESPIPE; -#else - goto not_there; -#endif - if (strEQ(name, "ESRCH")) -#ifdef ESRCH - return ESRCH; -#else - goto not_there; -#endif - break; - case 'X': - if (strEQ(name, "EXIT_FAILURE")) -#ifdef EXIT_FAILURE - return EXIT_FAILURE; -#else - return 1; -#endif - if (strEQ(name, "EXIT_SUCCESS")) -#ifdef EXIT_SUCCESS - return EXIT_SUCCESS; -#else - return 0; -#endif - if (strEQ(name, "EXDEV")) -#ifdef EXDEV - return EXDEV; -#else - goto not_there; -#endif - break; - } - if (strEQ(name, "E2BIG")) -#ifdef E2BIG - return E2BIG; -#else - goto not_there; -#endif - break; - case 'F': - if (strnEQ(name, "FLT_", 4)) { - if (strEQ(name, "FLT_MAX")) -#ifdef FLT_MAX - return FLT_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "FLT_MIN")) -#ifdef FLT_MIN - return FLT_MIN; -#else - goto not_there; -#endif - if (strEQ(name, "FLT_ROUNDS")) -#ifdef FLT_ROUNDS - return FLT_ROUNDS; -#else - goto not_there; -#endif - if (strEQ(name, "FLT_DIG")) -#ifdef FLT_DIG - return FLT_DIG; -#else - goto not_there; -#endif - if (strEQ(name, "FLT_EPSILON")) -#ifdef FLT_EPSILON - return FLT_EPSILON; -#else - goto not_there; -#endif - if (strEQ(name, "FLT_MANT_DIG")) -#ifdef FLT_MANT_DIG - return FLT_MANT_DIG; -#else - goto not_there; -#endif - if (strEQ(name, "FLT_MAX_10_EXP")) -#ifdef FLT_MAX_10_EXP - return FLT_MAX_10_EXP; -#else - goto not_there; -#endif - if (strEQ(name, "FLT_MAX_EXP")) -#ifdef FLT_MAX_EXP - return FLT_MAX_EXP; -#else - goto not_there; -#endif - if (strEQ(name, "FLT_MIN_10_EXP")) -#ifdef FLT_MIN_10_EXP - return FLT_MIN_10_EXP; -#else - goto not_there; -#endif - if (strEQ(name, "FLT_MIN_EXP")) -#ifdef FLT_MIN_EXP - return FLT_MIN_EXP; -#else - goto not_there; -#endif - if (strEQ(name, "FLT_RADIX")) -#ifdef FLT_RADIX - return FLT_RADIX; -#else - goto not_there; -#endif - break; - } - if (strnEQ(name, "F_", 2)) { - if (strEQ(name, "F_DUPFD")) -#ifdef F_DUPFD - return F_DUPFD; -#else - goto not_there; -#endif - if (strEQ(name, "F_GETFD")) -#ifdef F_GETFD - return F_GETFD; -#else - goto not_there; -#endif - if (strEQ(name, "F_GETFL")) -#ifdef F_GETFL - return F_GETFL; -#else - goto not_there; -#endif - if (strEQ(name, "F_GETLK")) -#ifdef F_GETLK - return F_GETLK; -#else - goto not_there; -#endif - if (strEQ(name, "F_OK")) -#ifdef F_OK - return F_OK; -#else - goto not_there; -#endif - if (strEQ(name, "F_RDLCK")) -#ifdef F_RDLCK - return F_RDLCK; -#else - goto not_there; -#endif - if (strEQ(name, "F_SETFD")) -#ifdef F_SETFD - return F_SETFD; -#else - goto not_there; -#endif - if (strEQ(name, "F_SETFL")) -#ifdef F_SETFL - return F_SETFL; -#else - goto not_there; -#endif - if (strEQ(name, "F_SETLK")) -#ifdef F_SETLK - return F_SETLK; -#else - goto not_there; -#endif - if (strEQ(name, "F_SETLKW")) -#ifdef F_SETLKW - return F_SETLKW; -#else - goto not_there; -#endif - if (strEQ(name, "F_UNLCK")) -#ifdef F_UNLCK - return F_UNLCK; -#else - goto not_there; -#endif - if (strEQ(name, "F_WRLCK")) -#ifdef F_WRLCK - return F_WRLCK; -#else - goto not_there; -#endif - break; - } - if (strEQ(name, "FD_CLOEXEC")) return FD_CLOEXEC; - if (strEQ(name, "FILENAME_MAX")) -#ifdef FILENAME_MAX - return FILENAME_MAX; -#else - goto not_there; -#endif - break; - case 'H': - if (strEQ(name, "HUGE_VAL")) -#ifdef HUGE_VAL - return HUGE_VAL; -#else - goto not_there; -#endif - if (strEQ(name, "HUPCL")) -#ifdef HUPCL - return HUPCL; -#else - goto not_there; -#endif - break; - case 'I': - if (strEQ(name, "INT_MAX")) -#ifdef INT_MAX - return INT_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "INT_MIN")) -#ifdef INT_MIN - return INT_MIN; -#else - goto not_there; -#endif - if (strEQ(name, "ICANON")) -#ifdef ICANON - return ICANON; -#else - goto not_there; -#endif - if (strEQ(name, "ICRNL")) -#ifdef ICRNL - return ICRNL; -#else - goto not_there; -#endif - if (strEQ(name, "IEXTEN")) -#ifdef IEXTEN - return IEXTEN; -#else - goto not_there; -#endif - if (strEQ(name, "IGNBRK")) -#ifdef IGNBRK - return IGNBRK; -#else - goto not_there; -#endif - if (strEQ(name, "IGNCR")) -#ifdef IGNCR - return IGNCR; -#else - goto not_there; -#endif - if (strEQ(name, "IGNPAR")) -#ifdef IGNPAR - return IGNPAR; -#else - goto not_there; -#endif - if (strEQ(name, "INLCR")) -#ifdef INLCR - return INLCR; -#else - goto not_there; -#endif - if (strEQ(name, "INPCK")) -#ifdef INPCK - return INPCK; -#else - goto not_there; -#endif - if (strEQ(name, "ISIG")) -#ifdef ISIG - return ISIG; -#else - goto not_there; -#endif - if (strEQ(name, "ISTRIP")) -#ifdef ISTRIP - return ISTRIP; -#else - goto not_there; -#endif - if (strEQ(name, "IXOFF")) -#ifdef IXOFF - return IXOFF; -#else - goto not_there; -#endif - if (strEQ(name, "IXON")) -#ifdef IXON - return IXON; -#else - goto not_there; -#endif - break; - case 'L': - if (strnEQ(name, "LC_", 3)) { - if (strEQ(name, "LC_ALL")) -#ifdef LC_ALL - return LC_ALL; -#else - goto not_there; -#endif - if (strEQ(name, "LC_COLLATE")) -#ifdef LC_COLLATE - return LC_COLLATE; -#else - goto not_there; -#endif - if (strEQ(name, "LC_CTYPE")) -#ifdef LC_CTYPE - return LC_CTYPE; -#else - goto not_there; -#endif - if (strEQ(name, "LC_MONETARY")) -#ifdef LC_MONETARY - return LC_MONETARY; -#else - goto not_there; -#endif - if (strEQ(name, "LC_NUMERIC")) -#ifdef LC_NUMERIC - return LC_NUMERIC; -#else - goto not_there; -#endif - if (strEQ(name, "LC_TIME")) -#ifdef LC_TIME - return LC_TIME; -#else - goto not_there; -#endif - break; - } - if (strnEQ(name, "LDBL_", 5)) { - if (strEQ(name, "LDBL_MAX")) -#ifdef LDBL_MAX - return LDBL_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "LDBL_MIN")) -#ifdef LDBL_MIN - return LDBL_MIN; -#else - goto not_there; -#endif - if (strEQ(name, "LDBL_DIG")) -#ifdef LDBL_DIG - return LDBL_DIG; -#else - goto not_there; -#endif - if (strEQ(name, "LDBL_EPSILON")) -#ifdef LDBL_EPSILON - return LDBL_EPSILON; -#else - goto not_there; -#endif - if (strEQ(name, "LDBL_MANT_DIG")) -#ifdef LDBL_MANT_DIG - return LDBL_MANT_DIG; -#else - goto not_there; -#endif - if (strEQ(name, "LDBL_MAX_10_EXP")) -#ifdef LDBL_MAX_10_EXP - return LDBL_MAX_10_EXP; -#else - goto not_there; -#endif - if (strEQ(name, "LDBL_MAX_EXP")) -#ifdef LDBL_MAX_EXP - return LDBL_MAX_EXP; -#else - goto not_there; -#endif - if (strEQ(name, "LDBL_MIN_10_EXP")) -#ifdef LDBL_MIN_10_EXP - return LDBL_MIN_10_EXP; -#else - goto not_there; -#endif - if (strEQ(name, "LDBL_MIN_EXP")) -#ifdef LDBL_MIN_EXP - return LDBL_MIN_EXP; -#else - goto not_there; -#endif - break; - } - if (strnEQ(name, "L_", 2)) { - if (strEQ(name, "L_ctermid")) -#ifdef L_ctermid - return L_ctermid; -#else - goto not_there; -#endif - if (strEQ(name, "L_cuserid")) -#ifdef L_cuserid - return L_cuserid; -#else - goto not_there; -#endif - if (strEQ(name, "L_tmpname")) -#ifdef L_tmpname - return L_tmpname; -#else - goto not_there; -#endif - break; - } - if (strEQ(name, "LONG_MAX")) -#ifdef LONG_MAX - return LONG_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "LONG_MIN")) -#ifdef LONG_MIN - return LONG_MIN; -#else - goto not_there; -#endif - if (strEQ(name, "LINK_MAX")) -#ifdef LINK_MAX - return LINK_MAX; -#else - goto not_there; -#endif - break; - case 'M': - if (strEQ(name, "MAX_CANON")) -#ifdef MAX_CANON - return MAX_CANON; -#else - goto not_there; -#endif - if (strEQ(name, "MAX_INPUT")) -#ifdef MAX_INPUT - return MAX_INPUT; -#else - goto not_there; -#endif - if (strEQ(name, "MB_CUR_MAX")) -#ifdef MB_CUR_MAX - return MB_CUR_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "MB_LEN_MAX")) -#ifdef MB_LEN_MAX - return MB_LEN_MAX; -#else - goto not_there; -#endif - break; - case 'N': - if (strEQ(name, "NULL")) return NULL; - if (strEQ(name, "NAME_MAX")) -#ifdef NAME_MAX - return NAME_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "NCCS")) -#ifdef NCCS - return NCCS; -#else - goto not_there; -#endif - if (strEQ(name, "NGROUPS_MAX")) -#ifdef NGROUPS_MAX - return NGROUPS_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "NOFLSH")) -#ifdef NOFLSH - return NOFLSH; -#else - goto not_there; -#endif - break; - case 'O': - if (strnEQ(name, "O_", 2)) { - if (strEQ(name, "O_APPEND")) -#ifdef O_APPEND - return O_APPEND; -#else - goto not_there; -#endif - if (strEQ(name, "O_CREAT")) -#ifdef O_CREAT - return O_CREAT; -#else - goto not_there; -#endif - if (strEQ(name, "O_TRUNC")) -#ifdef O_TRUNC - return O_TRUNC; -#else - goto not_there; -#endif - if (strEQ(name, "O_RDONLY")) -#ifdef O_RDONLY - return O_RDONLY; -#else - goto not_there; -#endif - if (strEQ(name, "O_RDWR")) -#ifdef O_RDWR - return O_RDWR; -#else - goto not_there; -#endif - if (strEQ(name, "O_WRONLY")) -#ifdef O_WRONLY - return O_WRONLY; -#else - goto not_there; -#endif - if (strEQ(name, "O_EXCL")) -#ifdef O_EXCL - return O_EXCL; -#else - goto not_there; -#endif - if (strEQ(name, "O_NOCTTY")) -#ifdef O_NOCTTY - return O_NOCTTY; -#else - goto not_there; -#endif - if (strEQ(name, "O_NONBLOCK")) -#ifdef O_NONBLOCK - return O_NONBLOCK; -#else - goto not_there; -#endif - if (strEQ(name, "O_ACCMODE")) -#ifdef O_ACCMODE - return O_ACCMODE; -#else - goto not_there; -#endif - break; - } - if (strEQ(name, "OPEN_MAX")) -#ifdef OPEN_MAX - return OPEN_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "OPOST")) -#ifdef OPOST - return OPOST; -#else - goto not_there; -#endif - break; - case 'P': - if (strEQ(name, "PATH_MAX")) -#ifdef PATH_MAX - return PATH_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "PARENB")) -#ifdef PARENB - return PARENB; -#else - goto not_there; -#endif - if (strEQ(name, "PARMRK")) -#ifdef PARMRK - return PARMRK; -#else - goto not_there; -#endif - if (strEQ(name, "PARODD")) -#ifdef PARODD - return PARODD; -#else - goto not_there; -#endif - if (strEQ(name, "PIPE_BUF")) -#ifdef PIPE_BUF - return PIPE_BUF; -#else - goto not_there; -#endif - break; - case 'R': - if (strEQ(name, "RAND_MAX")) -#ifdef RAND_MAX - return RAND_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "R_OK")) -#ifdef R_OK - return R_OK; -#else - goto not_there; -#endif - break; - case 'S': - if (strnEQ(name, "SIG", 3)) { - if (name[3] == '_') { - if (strEQ(name, "SIG_BLOCK")) -#ifdef SIG_BLOCK - return SIG_BLOCK; -#else - goto not_there; -#endif -#ifdef SIG_DFL - if (strEQ(name, "SIG_DFL")) return (int)SIG_DFL; -#endif -#ifdef SIG_ERR - if (strEQ(name, "SIG_ERR")) return (int)SIG_ERR; -#endif -#ifdef SIG_IGN - if (strEQ(name, "SIG_IGN")) return (int)SIG_IGN; -#endif - if (strEQ(name, "SIG_SETMASK")) -#ifdef SIG_SETMASK - return SIG_SETMASK; -#else - goto not_there; -#endif - if (strEQ(name, "SIG_UNBLOCK")) -#ifdef SIG_UNBLOCK - return SIG_UNBLOCK; -#else - goto not_there; -#endif - break; - } - if (strEQ(name, "SIGABRT")) -#ifdef SIGABRT - return SIGABRT; -#else - goto not_there; -#endif - if (strEQ(name, "SIGALRM")) -#ifdef SIGALRM - return SIGALRM; -#else - goto not_there; -#endif - if (strEQ(name, "SIGCHLD")) -#ifdef SIGCHLD - return SIGCHLD; -#else - goto not_there; -#endif - if (strEQ(name, "SIGCONT")) -#ifdef SIGCONT - return SIGCONT; -#else - goto not_there; -#endif - if (strEQ(name, "SIGFPE")) -#ifdef SIGFPE - return SIGFPE; -#else - goto not_there; -#endif - if (strEQ(name, "SIGHUP")) -#ifdef SIGHUP - return SIGHUP; -#else - goto not_there; -#endif - if (strEQ(name, "SIGILL")) -#ifdef SIGILL - return SIGILL; -#else - goto not_there; -#endif - if (strEQ(name, "SIGINT")) -#ifdef SIGINT - return SIGINT; -#else - goto not_there; -#endif - if (strEQ(name, "SIGKILL")) -#ifdef SIGKILL - return SIGKILL; -#else - goto not_there; -#endif - if (strEQ(name, "SIGPIPE")) -#ifdef SIGPIPE - return SIGPIPE; -#else - goto not_there; -#endif - if (strEQ(name, "SIGQUIT")) -#ifdef SIGQUIT - return SIGQUIT; -#else - goto not_there; -#endif - if (strEQ(name, "SIGSEGV")) -#ifdef SIGSEGV - return SIGSEGV; -#else - goto not_there; -#endif - if (strEQ(name, "SIGSTOP")) -#ifdef SIGSTOP - return SIGSTOP; -#else - goto not_there; -#endif - if (strEQ(name, "SIGTERM")) -#ifdef SIGTERM - return SIGTERM; -#else - goto not_there; -#endif - if (strEQ(name, "SIGTSTP")) -#ifdef SIGTSTP - return SIGTSTP; -#else - goto not_there; -#endif - if (strEQ(name, "SIGTTIN")) -#ifdef SIGTTIN - return SIGTTIN; -#else - goto not_there; -#endif - if (strEQ(name, "SIGTTOU")) -#ifdef SIGTTOU - return SIGTTOU; -#else - goto not_there; -#endif - if (strEQ(name, "SIGUSR1")) -#ifdef SIGUSR1 - return SIGUSR1; -#else - goto not_there; -#endif - if (strEQ(name, "SIGUSR2")) -#ifdef SIGUSR2 - return SIGUSR2; -#else - goto not_there; -#endif - break; - } - if (name[1] == '_') { -#ifdef S_ISBLK - if (strEQ(name, "S_ISBLK")) return S_ISBLK(arg); -#endif -#ifdef S_ISCHR - if (strEQ(name, "S_ISCHR")) return S_ISCHR(arg); -#endif -#ifdef S_ISDIR - if (strEQ(name, "S_ISDIR")) return S_ISDIR(arg); -#endif -#ifdef S_ISFIFO - if (strEQ(name, "S_ISFIFO")) return S_ISFIFO(arg); -#endif -#ifdef S_ISREG - if (strEQ(name, "S_ISREG")) return S_ISREG(arg); -#endif - if (strEQ(name, "S_ISGID")) -#ifdef S_ISGID - return S_ISGID; -#else - goto not_there; -#endif - if (strEQ(name, "S_ISUID")) -#ifdef S_ISUID - return S_ISUID; -#else - goto not_there; -#endif - if (strEQ(name, "S_IRGRP")) -#ifdef S_IRGRP - return S_IRGRP; -#else - goto not_there; -#endif - if (strEQ(name, "S_IROTH")) -#ifdef S_IROTH - return S_IROTH; -#else - goto not_there; -#endif - if (strEQ(name, "S_IRUSR")) -#ifdef S_IRUSR - return S_IRUSR; -#else - goto not_there; -#endif - if (strEQ(name, "S_IRWXG")) -#ifdef S_IRWXG - return S_IRWXG; -#else - goto not_there; -#endif - if (strEQ(name, "S_IRWXO")) -#ifdef S_IRWXO - return S_IRWXO; -#else - goto not_there; -#endif - if (strEQ(name, "S_IRWXU")) -#ifdef S_IRWXU - return S_IRWXU; -#else - goto not_there; -#endif - if (strEQ(name, "S_IWGRP")) -#ifdef S_IWGRP - return S_IWGRP; -#else - goto not_there; -#endif - if (strEQ(name, "S_IWOTH")) -#ifdef S_IWOTH - return S_IWOTH; -#else - goto not_there; -#endif - if (strEQ(name, "S_IWUSR")) -#ifdef S_IWUSR - return S_IWUSR; -#else - goto not_there; -#endif - if (strEQ(name, "S_IXGRP")) -#ifdef S_IXGRP - return S_IXGRP; -#else - goto not_there; -#endif - if (strEQ(name, "S_IXOTH")) -#ifdef S_IXOTH - return S_IXOTH; -#else - goto not_there; -#endif - if (strEQ(name, "S_IXUSR")) -#ifdef S_IXUSR - return S_IXUSR; -#else - goto not_there; -#endif - break; - } - if (strEQ(name, "SEEK_CUR")) -#ifdef SEEK_CUR - return SEEK_CUR; -#else - goto not_there; -#endif - if (strEQ(name, "SEEK_END")) -#ifdef SEEK_END - return SEEK_END; -#else - goto not_there; -#endif - if (strEQ(name, "SEEK_SET")) -#ifdef SEEK_SET - return SEEK_SET; -#else - goto not_there; -#endif - if (strEQ(name, "STREAM_MAX")) -#ifdef STREAM_MAX - return STREAM_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "SHRT_MAX")) -#ifdef SHRT_MAX - return SHRT_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "SHRT_MIN")) -#ifdef SHRT_MIN - return SHRT_MIN; -#else - goto not_there; -#endif - if (strEQ(name, "SA_NOCLDSTOP")) -#ifdef SA_NOCLDSTOP - return SA_NOCLDSTOP; -#else - goto not_there; -#endif - if (strEQ(name, "SCHAR_MAX")) -#ifdef SCHAR_MAX - return SCHAR_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "SCHAR_MIN")) -#ifdef SCHAR_MIN - return SCHAR_MIN; -#else - goto not_there; -#endif - if (strEQ(name, "SSIZE_MAX")) -#ifdef SSIZE_MAX - return SSIZE_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "STDIN_FILENO")) -#ifdef STDIN_FILENO - return STDIN_FILENO; -#else - goto not_there; -#endif - if (strEQ(name, "STDOUT_FILENO")) -#ifdef STDOUT_FILENO - return STDOUT_FILENO; -#else - goto not_there; -#endif - if (strEQ(name, "STRERR_FILENO")) -#ifdef STRERR_FILENO - return STRERR_FILENO; -#else - goto not_there; -#endif - break; - case 'T': - if (strEQ(name, "TCIFLUSH")) -#ifdef TCIFLUSH - return TCIFLUSH; -#else - goto not_there; -#endif - if (strEQ(name, "TCIOFF")) -#ifdef TCIOFF - return TCIOFF; -#else - goto not_there; -#endif - if (strEQ(name, "TCIOFLUSH")) -#ifdef TCIOFLUSH - return TCIOFLUSH; -#else - goto not_there; -#endif - if (strEQ(name, "TCION")) -#ifdef TCION - return TCION; -#else - goto not_there; -#endif - if (strEQ(name, "TCOFLUSH")) -#ifdef TCOFLUSH - return TCOFLUSH; -#else - goto not_there; -#endif - if (strEQ(name, "TCOOFF")) -#ifdef TCOOFF - return TCOOFF; -#else - goto not_there; -#endif - if (strEQ(name, "TCOON")) -#ifdef TCOON - return TCOON; -#else - goto not_there; -#endif - if (strEQ(name, "TCSADRAIN")) -#ifdef TCSADRAIN - return TCSADRAIN; -#else - goto not_there; -#endif - if (strEQ(name, "TCSAFLUSH")) -#ifdef TCSAFLUSH - return TCSAFLUSH; -#else - goto not_there; -#endif - if (strEQ(name, "TCSANOW")) -#ifdef TCSANOW - return TCSANOW; -#else - goto not_there; -#endif - if (strEQ(name, "TMP_MAX")) -#ifdef TMP_MAX - return TMP_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "TOSTOP")) -#ifdef TOSTOP - return TOSTOP; -#else - goto not_there; -#endif - if (strEQ(name, "TZNAME_MAX")) -#ifdef TZNAME_MAX - return TZNAME_MAX; -#else - goto not_there; -#endif - break; - case 'U': - if (strEQ(name, "UCHAR_MAX")) -#ifdef UCHAR_MAX - return UCHAR_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "UINT_MAX")) -#ifdef UINT_MAX - return UINT_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "ULONG_MAX")) -#ifdef ULONG_MAX - return ULONG_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "USHRT_MAX")) -#ifdef USHRT_MAX - return USHRT_MAX; -#else - goto not_there; -#endif - break; - case 'V': - if (strEQ(name, "VEOF")) -#ifdef VEOF - return VEOF; -#else - goto not_there; -#endif - if (strEQ(name, "VEOL")) -#ifdef VEOL - return VEOL; -#else - goto not_there; -#endif - if (strEQ(name, "VERASE")) -#ifdef VERASE - return VERASE; -#else - goto not_there; -#endif - if (strEQ(name, "VINTR")) -#ifdef VINTR - return VINTR; -#else - goto not_there; -#endif - if (strEQ(name, "VKILL")) -#ifdef VKILL - return VKILL; -#else - goto not_there; -#endif - if (strEQ(name, "VMIN")) -#ifdef VMIN - return VMIN; -#else - goto not_there; -#endif - if (strEQ(name, "VQUIT")) -#ifdef VQUIT - return VQUIT; -#else - goto not_there; -#endif - if (strEQ(name, "VSTART")) -#ifdef VSTART - return VSTART; -#else - goto not_there; -#endif - if (strEQ(name, "VSTOP")) -#ifdef VSTOP - return VSTOP; -#else - goto not_there; -#endif - if (strEQ(name, "VSUSP")) -#ifdef VSUSP - return VSUSP; -#else - goto not_there; -#endif - if (strEQ(name, "VTIME")) -#ifdef VTIME - return VTIME; -#else - goto not_there; -#endif - break; - case 'W': - if (strEQ(name, "W_OK")) -#ifdef W_OK - return W_OK; -#else - goto not_there; -#endif -#ifdef WEXITSTATUS - if (strEQ(name, "WEXITSTATUS")) return WEXITSTATUS(arg); -#endif -#ifdef WIFEXITED - if (strEQ(name, "WIFEXITED")) return WIFEXITED(arg); -#endif -#ifdef WIFSIGNALED - if (strEQ(name, "WIFSIGNALED")) return WIFSIGNALED(arg); -#endif -#ifdef WIFSTOPPED - if (strEQ(name, "WIFSTOPPED")) return WIFSTOPPED(arg); -#endif - if (strEQ(name, "WNOHANG")) -#ifdef WNOHANG - return WNOHANG; -#else - goto not_there; -#endif -#ifdef WSTOPSIG - if (strEQ(name, "WSTOPSIG")) return WSTOPSIG(arg); -#endif -#ifdef WTERMSIG - if (strEQ(name, "WTERMSIG")) return WTERMSIG(arg); -#endif - if (strEQ(name, "WUNTRACED")) -#ifdef WUNTRACED - return WUNTRACED; -#else - goto not_there; -#endif - break; - case 'X': - if (strEQ(name, "X_OK")) -#ifdef X_OK - return X_OK; -#else - goto not_there; -#endif - break; - case '_': - if (strnEQ(name, "_PC_", 4)) { - if (strEQ(name, "_PC_CHOWN_RESTRICTED")) -#ifdef _PC_CHOWN_RESTRICTED - return _PC_CHOWN_RESTRICTED; -#else - goto not_there; -#endif - if (strEQ(name, "_PC_LINK_MAX")) -#ifdef _PC_LINK_MAX - return _PC_LINK_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "_PC_MAX_CANON")) -#ifdef _PC_MAX_CANON - return _PC_MAX_CANON; -#else - goto not_there; -#endif - if (strEQ(name, "_PC_MAX_INPUT")) -#ifdef _PC_MAX_INPUT - return _PC_MAX_INPUT; -#else - goto not_there; -#endif - if (strEQ(name, "_PC_NAME_MAX")) -#ifdef _PC_NAME_MAX - return _PC_NAME_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "_PC_NO_TRUNC")) -#ifdef _PC_NO_TRUNC - return _PC_NO_TRUNC; -#else - goto not_there; -#endif - if (strEQ(name, "_PC_PATH_MAX")) -#ifdef _PC_PATH_MAX - return _PC_PATH_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "_PC_PIPE_BUF")) -#ifdef _PC_PIPE_BUF - return _PC_PIPE_BUF; -#else - goto not_there; -#endif - if (strEQ(name, "_PC_VDISABLE")) -#ifdef _PC_VDISABLE - return _PC_VDISABLE; -#else - goto not_there; -#endif - break; - } - if (strnEQ(name, "_POSIX_", 7)) { - if (strEQ(name, "_POSIX_ARG_MAX")) -#ifdef _POSIX_ARG_MAX - return _POSIX_ARG_MAX; -#else - return 0; -#endif - if (strEQ(name, "_POSIX_CHILD_MAX")) -#ifdef _POSIX_CHILD_MAX - return _POSIX_CHILD_MAX; -#else - return 0; -#endif - if (strEQ(name, "_POSIX_CHOWN_RESTRICTED")) -#ifdef _POSIX_CHOWN_RESTRICTED - return _POSIX_CHOWN_RESTRICTED; -#else - return 0; -#endif - if (strEQ(name, "_POSIX_JOB_CONTROL")) -#ifdef _POSIX_JOB_CONTROL - return _POSIX_JOB_CONTROL; -#else - return 0; -#endif - if (strEQ(name, "_POSIX_LINK_MAX")) -#ifdef _POSIX_LINK_MAX - return _POSIX_LINK_MAX; -#else - return 0; -#endif - if (strEQ(name, "_POSIX_MAX_CANON")) -#ifdef _POSIX_MAX_CANON - return _POSIX_MAX_CANON; -#else - return 0; -#endif - if (strEQ(name, "_POSIX_MAX_INPUT")) -#ifdef _POSIX_MAX_INPUT - return _POSIX_MAX_INPUT; -#else - return 0; -#endif - if (strEQ(name, "_POSIX_NAME_MAX")) -#ifdef _POSIX_NAME_MAX - return _POSIX_NAME_MAX; -#else - return 0; -#endif - if (strEQ(name, "_POSIX_NGROUPS_MAX")) -#ifdef _POSIX_NGROUPS_MAX - return _POSIX_NGROUPS_MAX; -#else - return 0; -#endif - if (strEQ(name, "_POSIX_NO_TRUNC")) -#ifdef _POSIX_NO_TRUNC - return _POSIX_NO_TRUNC; -#else - return 0; -#endif - if (strEQ(name, "_POSIX_OPEN_MAX")) -#ifdef _POSIX_OPEN_MAX - return _POSIX_OPEN_MAX; -#else - return 0; -#endif - if (strEQ(name, "_POSIX_PATH_MAX")) -#ifdef _POSIX_PATH_MAX - return _POSIX_PATH_MAX; -#else - return 0; -#endif - if (strEQ(name, "_POSIX_PIPE_BUF")) -#ifdef _POSIX_PIPE_BUF - return _POSIX_PIPE_BUF; -#else - return 0; -#endif - if (strEQ(name, "_POSIX_SAVED_IDS")) -#ifdef _POSIX_SAVED_IDS - return _POSIX_SAVED_IDS; -#else - return 0; -#endif - if (strEQ(name, "_POSIX_SSIZE_MAX")) -#ifdef _POSIX_SSIZE_MAX - return _POSIX_SSIZE_MAX; -#else - return 0; -#endif - if (strEQ(name, "_POSIX_STREAM_MAX")) -#ifdef _POSIX_STREAM_MAX - return _POSIX_STREAM_MAX; -#else - return 0; -#endif - if (strEQ(name, "_POSIX_TZNAME_MAX")) -#ifdef _POSIX_TZNAME_MAX - return _POSIX_TZNAME_MAX; -#else - return 0; -#endif - if (strEQ(name, "_POSIX_VDISABLE")) -#ifdef _POSIX_VDISABLE - return _POSIX_VDISABLE; -#else - return 0; -#endif - if (strEQ(name, "_POSIX_VERSION")) -#ifdef _POSIX_VERSION - return _POSIX_VERSION; -#else - return 0; -#endif - break; - } - if (strnEQ(name, "_SC_", 4)) { - if (strEQ(name, "_SC_ARG_MAX")) -#ifdef _SC_ARG_MAX - return _SC_ARG_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "_SC_CHILD_MAX")) -#ifdef _SC_CHILD_MAX - return _SC_CHILD_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "_SC_CLK_TCK")) -#ifdef _SC_CLK_TCK - return _SC_CLK_TCK; -#else - goto not_there; -#endif - if (strEQ(name, "_SC_JOB_CONTROL")) -#ifdef _SC_JOB_CONTROL - return _SC_JOB_CONTROL; -#else - goto not_there; -#endif - if (strEQ(name, "_SC_NGROUPS_MAX")) -#ifdef _SC_NGROUPS_MAX - return _SC_NGROUPS_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "_SC_OPEN_MAX")) -#ifdef _SC_OPEN_MAX - return _SC_OPEN_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "_SC_SAVED_IDS")) -#ifdef _SC_SAVED_IDS - return _SC_SAVED_IDS; -#else - goto not_there; -#endif - if (strEQ(name, "_SC_STREAM_MAX")) -#ifdef _SC_STREAM_MAX - return _SC_STREAM_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "_SC_TZNAME_MAX")) -#ifdef _SC_TZNAME_MAX - return _SC_TZNAME_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "_SC_VERSION")) -#ifdef _SC_VERSION - return _SC_VERSION; -#else - goto not_there; -#endif - break; - } - if (strEQ(name, "_IOFBF")) -#ifdef _IOFBF - return _IOFBF; -#else - goto not_there; -#endif - if (strEQ(name, "_IOLBF")) -#ifdef _IOLBF - return _IOLBF; -#else - goto not_there; -#endif - if (strEQ(name, "_IONBF")) -#ifdef _IONBF - return _IONBF; -#else - goto not_there; -#endif - break; - } - errno = EINVAL; - return 0; - -not_there: - errno = ENOENT; - return 0; -} - -static int -XS_POSIX__SigSet_new(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items < 0) { - croak("Usage: POSIX::SigSet::new(packname = \"POSIX::SigSet\", ...)"); - } - { - char * packname; - POSIX__SigSet RETVAL; - - if (items < 1) - packname = "POSIX::SigSet"; - else { - packname = SvPV(ST(1),na); - } - { - int i; - RETVAL = (sigset_t*)safemalloc(sizeof(sigset_t)); - sigemptyset(RETVAL); - for (i = 2; i <= items; i++) - sigaddset(RETVAL, SvIV(ST(i))); - } - ST(0) = sv_newmortal(); - sv_setptrobj(ST(0), RETVAL, "POSIX::SigSet"); - } - return ax; -} - -static int -XS_POSIX__SigSet_DESTROY(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: POSIX::SigSet::DESTROY(sigset)"); - } - { - POSIX__SigSet sigset; - - if (SvROK(ST(1))) { - unsigned long tmp; - tmp = (unsigned long)SvNV((SV*)SvRV(ST(1))); - sigset = (POSIX__SigSet) tmp; - } - else - croak("sigset is not a reference"); - safefree(sigset); - } - return ax; -} - -static int -XS_POSIX__SigSet_sigaddset(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 2) { - croak("Usage: POSIX::SigSet::addset(sigset, sig)"); - } - { - POSIX__SigSet sigset; - int sig = (int)SvIV(ST(2)); - SysRet RETVAL; - - if (sv_isa(ST(1), "POSIX::SigSet")) { - unsigned long tmp; - tmp = (unsigned long)SvNV((SV*)SvRV(ST(1))); - sigset = (POSIX__SigSet) tmp; - } - else - croak("sigset is not of type POSIX::SigSet"); - - RETVAL = sigaddset(sigset, sig); - ST(0) = sv_newmortal(); - if (RETVAL != -1) { - if (RETVAL == 0) - sv_setpvn(ST(0), "0 but true", 10); - else - sv_setiv(ST(0), (I32)RETVAL); - } - } - return ax; -} - -static int -XS_POSIX__SigSet_sigdelset(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 2) { - croak("Usage: POSIX::SigSet::delset(sigset, sig)"); - } - { - POSIX__SigSet sigset; - int sig = (int)SvIV(ST(2)); - SysRet RETVAL; - - if (sv_isa(ST(1), "POSIX::SigSet")) { - unsigned long tmp; - tmp = (unsigned long)SvNV((SV*)SvRV(ST(1))); - sigset = (POSIX__SigSet) tmp; - } - else - croak("sigset is not of type POSIX::SigSet"); - - RETVAL = sigdelset(sigset, sig); - ST(0) = sv_newmortal(); - if (RETVAL != -1) { - if (RETVAL == 0) - sv_setpvn(ST(0), "0 but true", 10); - else - sv_setiv(ST(0), (I32)RETVAL); - } - } - return ax; -} - -static int -XS_POSIX__SigSet_sigemptyset(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: POSIX::SigSet::emptyset(sigset)"); - } - { - POSIX__SigSet sigset; - SysRet RETVAL; - - if (sv_isa(ST(1), "POSIX::SigSet")) { - unsigned long tmp; - tmp = (unsigned long)SvNV((SV*)SvRV(ST(1))); - sigset = (POSIX__SigSet) tmp; - } - else - croak("sigset is not of type POSIX::SigSet"); - - RETVAL = sigemptyset(sigset); - ST(0) = sv_newmortal(); - if (RETVAL != -1) { - if (RETVAL == 0) - sv_setpvn(ST(0), "0 but true", 10); - else - sv_setiv(ST(0), (I32)RETVAL); - } - } - return ax; -} - -static int -XS_POSIX__SigSet_sigfillset(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: POSIX::SigSet::fillset(sigset)"); - } - { - POSIX__SigSet sigset; - SysRet RETVAL; - - if (sv_isa(ST(1), "POSIX::SigSet")) { - unsigned long tmp; - tmp = (unsigned long)SvNV((SV*)SvRV(ST(1))); - sigset = (POSIX__SigSet) tmp; - } - else - croak("sigset is not of type POSIX::SigSet"); - - RETVAL = sigfillset(sigset); - ST(0) = sv_newmortal(); - if (RETVAL != -1) { - if (RETVAL == 0) - sv_setpvn(ST(0), "0 but true", 10); - else - sv_setiv(ST(0), (I32)RETVAL); - } - } - return ax; -} - -static int -XS_POSIX__SigSet_sigismember(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 2) { - croak("Usage: POSIX::SigSet::ismember(sigset, sig)"); - } - { - POSIX__SigSet sigset; - int sig = (int)SvIV(ST(2)); - int RETVAL; - - if (sv_isa(ST(1), "POSIX::SigSet")) { - unsigned long tmp; - tmp = (unsigned long)SvNV((SV*)SvRV(ST(1))); - sigset = (POSIX__SigSet) tmp; - } - else - croak("sigset is not of type POSIX::SigSet"); - - RETVAL = sigismember(sigset, sig); - ST(0) = sv_newmortal(); - sv_setiv(ST(0), (I32)RETVAL); - } - return ax; -} - -static int -XS_POSIX_constant(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 2) { - croak("Usage: POSIX::constant(name,arg)"); - } - { - char * name = SvPV(ST(1),na); - int arg = (int)SvIV(ST(2)); - int RETVAL; - - RETVAL = constant(name, arg); - ST(0) = sv_newmortal(); - sv_setiv(ST(0), (I32)RETVAL); - } - return ax; -} - -static int -XS_POSIX_isalnum(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: POSIX::isalnum(charstring)"); - } - { - char * charstring = SvPV(ST(1),na); - int RETVAL; - char *s; - RETVAL = 1; - for (s = charstring; *s && RETVAL; s++) - if (!isalnum(*s)) - RETVAL = 0; - ST(0) = sv_newmortal(); - sv_setiv(ST(0), (I32)RETVAL); - } - return ax; -} - -static int -XS_POSIX_isalpha(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: POSIX::isalpha(charstring)"); - } - { - char * charstring = SvPV(ST(1),na); - int RETVAL; - char *s; - RETVAL = 1; - for (s = charstring; *s && RETVAL; s++) - if (!isalpha(*s)) - RETVAL = 0; - ST(0) = sv_newmortal(); - sv_setiv(ST(0), (I32)RETVAL); - } - return ax; -} - -static int -XS_POSIX_iscntrl(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: POSIX::iscntrl(charstring)"); - } - { - char * charstring = SvPV(ST(1),na); - int RETVAL; - char *s; - RETVAL = 1; - for (s = charstring; *s && RETVAL; s++) - if (!iscntrl(*s)) - RETVAL = 0; - ST(0) = sv_newmortal(); - sv_setiv(ST(0), (I32)RETVAL); - } - return ax; -} - -static int -XS_POSIX_isdigit(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: POSIX::isdigit(charstring)"); - } - { - char * charstring = SvPV(ST(1),na); - int RETVAL; - char *s; - RETVAL = 1; - for (s = charstring; *s && RETVAL; s++) - if (!isdigit(*s)) - RETVAL = 0; - ST(0) = sv_newmortal(); - sv_setiv(ST(0), (I32)RETVAL); - } - return ax; -} - -static int -XS_POSIX_isgraph(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: POSIX::isgraph(charstring)"); - } - { - char * charstring = SvPV(ST(1),na); - int RETVAL; - char *s; - RETVAL = 1; - for (s = charstring; *s && RETVAL; s++) - if (!isgraph(*s)) - RETVAL = 0; - ST(0) = sv_newmortal(); - sv_setiv(ST(0), (I32)RETVAL); - } - return ax; -} - -static int -XS_POSIX_islower(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: POSIX::islower(charstring)"); - } - { - char * charstring = SvPV(ST(1),na); - int RETVAL; - char *s; - RETVAL = 1; - for (s = charstring; *s && RETVAL; s++) - if (!islower(*s)) - RETVAL = 0; - ST(0) = sv_newmortal(); - sv_setiv(ST(0), (I32)RETVAL); - } - return ax; -} - -static int -XS_POSIX_isprint(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: POSIX::isprint(charstring)"); - } - { - char * charstring = SvPV(ST(1),na); - int RETVAL; - char *s; - RETVAL = 1; - for (s = charstring; *s && RETVAL; s++) - if (!isprint(*s)) - RETVAL = 0; - ST(0) = sv_newmortal(); - sv_setiv(ST(0), (I32)RETVAL); - } - return ax; -} - -static int -XS_POSIX_ispunct(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: POSIX::ispunct(charstring)"); - } - { - char * charstring = SvPV(ST(1),na); - int RETVAL; - char *s; - RETVAL = 1; - for (s = charstring; *s && RETVAL; s++) - if (!ispunct(*s)) - RETVAL = 0; - ST(0) = sv_newmortal(); - sv_setiv(ST(0), (I32)RETVAL); - } - return ax; -} - -static int -XS_POSIX_isspace(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: POSIX::isspace(charstring)"); - } - { - char * charstring = SvPV(ST(1),na); - int RETVAL; - char *s; - RETVAL = 1; - for (s = charstring; *s && RETVAL; s++) - if (!isspace(*s)) - RETVAL = 0; - ST(0) = sv_newmortal(); - sv_setiv(ST(0), (I32)RETVAL); - } - return ax; -} - -static int -XS_POSIX_isupper(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: POSIX::isupper(charstring)"); - } - { - char * charstring = SvPV(ST(1),na); - int RETVAL; - char *s; - RETVAL = 1; - for (s = charstring; *s && RETVAL; s++) - if (!isupper(*s)) - RETVAL = 0; - ST(0) = sv_newmortal(); - sv_setiv(ST(0), (I32)RETVAL); - } - return ax; -} - -static int -XS_POSIX_isxdigit(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: POSIX::isxdigit(charstring)"); - } - { - char * charstring = SvPV(ST(1),na); - int RETVAL; - char *s; - RETVAL = 1; - for (s = charstring; *s && RETVAL; s++) - if (!isxdigit(*s)) - RETVAL = 0; - ST(0) = sv_newmortal(); - sv_setiv(ST(0), (I32)RETVAL); - } - return ax; -} - -static int -XS_POSIX_open(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items < 1 || items > 3) { - croak("Usage: POSIX::open(filename, flags = O_RDONLY, mode = 0666)"); - } - { - char * filename = SvPV(ST(1),na); - int flags; - int mode; - SysRet RETVAL; - - if (items < 2) - flags = O_RDONLY; - else { - flags = (int)SvIV(ST(2)); - } - - if (items < 3) - mode = 0666; - else { - mode = (int)SvIV(ST(3)); - } - - RETVAL = open(filename, flags, mode); - ST(0) = sv_newmortal(); - if (RETVAL != -1) { - if (RETVAL == 0) - sv_setpvn(ST(0), "0 but true", 10); - else - sv_setiv(ST(0), (I32)RETVAL); - } - } - return ax; -} - -static int -XS_POSIX_localeconv(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 0) { - croak("Usage: POSIX::localeconv()"); - } - { - HV * RETVAL; - struct lconv *lcbuf; - RETVAL = newHV(); - if (lcbuf = localeconv()) { - /* the strings */ - if (lcbuf->decimal_point && *lcbuf->decimal_point) - hv_store(RETVAL, "decimal_point", 13, - newSVpv(lcbuf->decimal_point, 0), 0); - if (lcbuf->thousands_sep && *lcbuf->thousands_sep) - hv_store(RETVAL, "thousands_sep", 13, - newSVpv(lcbuf->thousands_sep, 0), 0); - if (lcbuf->grouping && *lcbuf->grouping) - hv_store(RETVAL, "grouping", 8, - newSVpv(lcbuf->grouping, 0), 0); - if (lcbuf->int_curr_symbol && *lcbuf->int_curr_symbol) - hv_store(RETVAL, "int_curr_symbol", 15, - newSVpv(lcbuf->int_curr_symbol, 0), 0); - if (lcbuf->currency_symbol && *lcbuf->currency_symbol) - hv_store(RETVAL, "currency_symbol", 15, - newSVpv(lcbuf->currency_symbol, 0), 0); - if (lcbuf->mon_decimal_point && *lcbuf->mon_decimal_point) - hv_store(RETVAL, "mon_decimal_point", 17, - newSVpv(lcbuf->mon_decimal_point, 0), 0); - if (lcbuf->mon_thousands_sep && *lcbuf->mon_thousands_sep) - hv_store(RETVAL, "mon_thousands_sep", 17, - newSVpv(lcbuf->mon_thousands_sep, 0), 0); - if (lcbuf->mon_grouping && *lcbuf->mon_grouping) - hv_store(RETVAL, "mon_grouping", 12, - newSVpv(lcbuf->mon_grouping, 0), 0); - if (lcbuf->positive_sign && *lcbuf->positive_sign) - hv_store(RETVAL, "positive_sign", 13, - newSVpv(lcbuf->positive_sign, 0), 0); - if (lcbuf->negative_sign && *lcbuf->negative_sign) - hv_store(RETVAL, "negative_sign", 13, - newSVpv(lcbuf->negative_sign, 0), 0); - /* the integers */ - if (lcbuf->int_frac_digits != CHAR_MAX) - hv_store(RETVAL, "int_frac_digits", 15, - newSViv(lcbuf->int_frac_digits), 0); - if (lcbuf->frac_digits != CHAR_MAX) - hv_store(RETVAL, "frac_digits", 11, - newSViv(lcbuf->frac_digits), 0); - if (lcbuf->p_cs_precedes != CHAR_MAX) - hv_store(RETVAL, "p_cs_precedes", 13, - newSViv(lcbuf->p_cs_precedes), 0); - if (lcbuf->p_sep_by_space != CHAR_MAX) - hv_store(RETVAL, "p_sep_by_space", 14, - newSViv(lcbuf->p_sep_by_space), 0); - if (lcbuf->n_cs_precedes != CHAR_MAX) - hv_store(RETVAL, "n_cs_precedes", 13, - newSViv(lcbuf->n_cs_precedes), 0); - if (lcbuf->n_sep_by_space != CHAR_MAX) - hv_store(RETVAL, "n_sep_by_space", 14, - newSViv(lcbuf->n_sep_by_space), 0); - if (lcbuf->p_sign_posn != CHAR_MAX) - hv_store(RETVAL, "p_sign_posn", 11, - newSViv(lcbuf->p_sign_posn), 0); - if (lcbuf->n_sign_posn != CHAR_MAX) - hv_store(RETVAL, "n_sign_posn", 11, - newSViv(lcbuf->n_sign_posn), 0); - } - ST(0) = newRV((SV*)RETVAL); - sv_2mortal(ST(0)); - } - return ax; -} - -static int -XS_POSIX_setlocale(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 2) { - croak("Usage: POSIX::setlocale(category, locale)"); - } - { - int category = (int)SvIV(ST(1)); - char * locale = SvPV(ST(2),na); - char * RETVAL; - - RETVAL = setlocale(category, locale); - ST(0) = sv_newmortal(); - sv_setpv(ST(0), RETVAL); - } - return ax; -} - -static int -XS_POSIX_acos(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: POSIX::acos(x)"); - } - { - double x = (double)SvNV(ST(1)); - double RETVAL; - - RETVAL = acos(x); - ST(0) = sv_newmortal(); - sv_setnv(ST(0), (double)RETVAL); - } - return ax; -} - -static int -XS_POSIX_asin(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: POSIX::asin(x)"); - } - { - double x = (double)SvNV(ST(1)); - double RETVAL; - - RETVAL = asin(x); - ST(0) = sv_newmortal(); - sv_setnv(ST(0), (double)RETVAL); - } - return ax; -} - -static int -XS_POSIX_atan(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: POSIX::atan(x)"); - } - { - double x = (double)SvNV(ST(1)); - double RETVAL; - - RETVAL = atan(x); - ST(0) = sv_newmortal(); - sv_setnv(ST(0), (double)RETVAL); - } - return ax; -} - -static int -XS_POSIX_ceil(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: POSIX::ceil(x)"); - } - { - double x = (double)SvNV(ST(1)); - double RETVAL; - - RETVAL = ceil(x); - ST(0) = sv_newmortal(); - sv_setnv(ST(0), (double)RETVAL); - } - return ax; -} - -static int -XS_POSIX_cosh(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: POSIX::cosh(x)"); - } - { - double x = (double)SvNV(ST(1)); - double RETVAL; - - RETVAL = cosh(x); - ST(0) = sv_newmortal(); - sv_setnv(ST(0), (double)RETVAL); - } - return ax; -} - -static int -XS_POSIX_floor(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: POSIX::floor(x)"); - } - { - double x = (double)SvNV(ST(1)); - double RETVAL; - - RETVAL = floor(x); - ST(0) = sv_newmortal(); - sv_setnv(ST(0), (double)RETVAL); - } - return ax; -} - -static int -XS_POSIX_fmod(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 2) { - croak("Usage: POSIX::fmod(x,y)"); - } - { - double x = (double)SvNV(ST(1)); - double y = (double)SvNV(ST(2)); - double RETVAL; - - RETVAL = fmod(x, y); - ST(0) = sv_newmortal(); - sv_setnv(ST(0), (double)RETVAL); - } - return ax; -} - -static int -XS_POSIX_frexp(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: POSIX::frexp(x)"); - } - { - double x = (double)SvNV(ST(1)); - dSP; - int expvar; - sp--; - /* (We already know stack is long enough.) */ - PUSHs(sv_2mortal(newSVnv(frexp(x,&expvar)))); - PUSHs(sv_2mortal(newSViv(expvar))); - ax = sp - stack_base; - } - return ax; -} - -static int -XS_POSIX_ldexp(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 2) { - croak("Usage: POSIX::ldexp(x,exp)"); - } - { - double x = (double)SvNV(ST(1)); - int exp = (int)SvIV(ST(2)); - double RETVAL; - - RETVAL = ldexp(x, exp); - ST(0) = sv_newmortal(); - sv_setnv(ST(0), (double)RETVAL); - } - return ax; -} - -static int -XS_POSIX_log10(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: POSIX::log10(x)"); - } - { - double x = (double)SvNV(ST(1)); - double RETVAL; - - RETVAL = log10(x); - ST(0) = sv_newmortal(); - sv_setnv(ST(0), (double)RETVAL); - } - return ax; -} - -static int -XS_POSIX_modf(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: POSIX::modf(x)"); - } - { - double x = (double)SvNV(ST(1)); - dSP; - double intvar; - sp--; - /* (We already know stack is long enough.) */ - PUSHs(sv_2mortal(newSVnv(modf(x,&intvar)))); - PUSHs(sv_2mortal(newSVnv(intvar))); - ax = sp - stack_base; - } - return ax; -} - -static int -XS_POSIX_sinh(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: POSIX::sinh(x)"); - } - { - double x = (double)SvNV(ST(1)); - double RETVAL; - - RETVAL = sinh(x); - ST(0) = sv_newmortal(); - sv_setnv(ST(0), (double)RETVAL); - } - return ax; -} - -static int -XS_POSIX_tanh(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: POSIX::tanh(x)"); - } - { - double x = (double)SvNV(ST(1)); - double RETVAL; - - RETVAL = tanh(x); - ST(0) = sv_newmortal(); - sv_setnv(ST(0), (double)RETVAL); - } - return ax; -} - -static int -XS_POSIX_sigaction(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items < 2 || items > 3) { - croak("Usage: POSIX::sigaction(sig, action, oldaction = 0)"); - } - { - int sig = (int)SvIV(ST(1)); - POSIX__SigAction action; - POSIX__SigAction oldaction; - SysRet RETVAL; - - if (sv_isa(ST(2), "POSIX::SigAction")) - action = (HV*)SvRV(ST(2)); - else - croak("action is not of type POSIX::SigAction"); - - if (items < 3) - oldaction = 0; - else { - if (sv_isa(ST(3), "POSIX::SigAction")) - oldaction = (HV*)SvRV(ST(3)); - else - croak("oldaction is not of type POSIX::SigAction"); - } - - - if (!siggv) - gv_fetchpv("SIG", TRUE, SVt_PVHV); - - { - struct sigaction act; - struct sigaction oact; - POSIX__SigSet sigset; - SV** svp; - SV** sigsvp = hv_fetch(GvHVn(siggv), - sig_name[sig], - strlen(sig_name[sig]), - TRUE); - - /* Remember old handler name if desired. */ - if (oldaction) { - char *hand = SvPVx(*sigsvp, na); - svp = hv_fetch(oldaction, "HANDLER", 7, TRUE); - sv_setpv(*svp, *hand ? hand : "DEFAULT"); - } - - if (action) { - /* Vector new handler through %SIG. (We always use sighandler - for the C signal handler, which reads %SIG to dispatch.) */ - svp = hv_fetch(action, "HANDLER", 7, FALSE); - if (!svp) - croak("Can't supply an action without a HANDLER"); - sv_setpv(*sigsvp, SvPV(*svp, na)); - mg_set(*sigsvp); /* handles DEFAULT and IGNORE */ - act.sa_handler = sighandler; - - /* Set up any desired mask. */ - svp = hv_fetch(action, "MASK", 4, FALSE); - if (svp && sv_isa(*svp, "POSIX::SigSet")) { - sigset = (sigset_t*)(unsigned long)SvNV((SV*)SvRV(*svp)); - act.sa_mask = *sigset; - } - else - sigemptyset(& act.sa_mask); - - /* Set up any desired flags. */ - svp = hv_fetch(action, "FLAGS", 5, FALSE); - act.sa_flags = svp ? SvIV(*svp) : 0; - } - - /* Now work around sigaction oddities */ - if (action && oldaction) - RETVAL = sigaction(sig, & act, & oact); - else if (action) - RETVAL = sigaction(sig, & act, (struct sigaction*)0); - else if (oldaction) - RETVAL = sigaction(sig, (struct sigaction*)0, & oact); - - if (oldaction) { - /* Get back the mask. */ - svp = hv_fetch(oldaction, "MASK", 4, TRUE); - if (sv_isa(*svp, "POSIX::SigSet")) - sigset = (sigset_t*)(unsigned long)SvNV((SV*)SvRV(*svp)); - else { - sigset = (sigset_t*)safemalloc(sizeof(sigset_t)); - sv_setptrobj(*svp, sigset, "POSIX::SigSet"); - } - *sigset = oact.sa_mask; - - /* Get back the flags. */ - svp = hv_fetch(oldaction, "FLAGS", 5, TRUE); - sv_setiv(*svp, oact.sa_flags); - } - } - ST(0) = sv_newmortal(); - if (RETVAL != -1) { - if (RETVAL == 0) - sv_setpvn(ST(0), "0 but true", 10); - else - sv_setiv(ST(0), (I32)RETVAL); - } - } - return ax; -} - -static int -XS_POSIX_sigpending(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: POSIX::sigpending(sigset)"); - } - { - POSIX__SigSet sigset; - SysRet RETVAL; - - if (sv_isa(ST(1), "POSIX::SigSet")) { - unsigned long tmp; - tmp = (unsigned long)SvNV((SV*)SvRV(ST(1))); - sigset = (POSIX__SigSet) tmp; - } - else - croak("sigset is not of type POSIX::SigSet"); - - RETVAL = sigpending(sigset); - ST(0) = sv_newmortal(); - if (RETVAL != -1) { - if (RETVAL == 0) - sv_setpvn(ST(0), "0 but true", 10); - else - sv_setiv(ST(0), (I32)RETVAL); - } - } - return ax; -} - -static int -XS_POSIX_sigprocmask(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items < 2 || items > 3) { - croak("Usage: POSIX::sigprocmask(how, sigset, oldsigset = 0)"); - } - { - int how = (int)SvIV(ST(1)); - POSIX__SigSet sigset; - POSIX__SigSet oldsigset; - SysRet RETVAL; - - if (sv_isa(ST(2), "POSIX::SigSet")) { - unsigned long tmp; - tmp = (unsigned long)SvNV((SV*)SvRV(ST(2))); - sigset = (POSIX__SigSet) tmp; - } - else - croak("sigset is not of type POSIX::SigSet"); - - if (items < 3) - oldsigset = 0; - else { - if (sv_isa(ST(3), "POSIX::SigSet")) { - unsigned long tmp; - tmp = (unsigned long)SvNV((SV*)SvRV(ST(3))); - oldsigset = (POSIX__SigSet) tmp; - } - else - croak("oldsigset is not of type POSIX::SigSet"); - } - - RETVAL = sigprocmask(how, sigset, oldsigset); - ST(0) = sv_newmortal(); - if (RETVAL != -1) { - if (RETVAL == 0) - sv_setpvn(ST(0), "0 but true", 10); - else - sv_setiv(ST(0), (I32)RETVAL); - } - } - return ax; -} - -static int -XS_POSIX_sigsuspend(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: POSIX::sigsuspend(signal_mask)"); - } - { - POSIX__SigSet signal_mask; - SysRet RETVAL; - - if (sv_isa(ST(1), "POSIX::SigSet")) { - unsigned long tmp; - tmp = (unsigned long)SvNV((SV*)SvRV(ST(1))); - signal_mask = (POSIX__SigSet) tmp; - } - else - croak("signal_mask is not of type POSIX::SigSet"); - - RETVAL = sigsuspend(signal_mask); - ST(0) = sv_newmortal(); - if (RETVAL != -1) { - if (RETVAL == 0) - sv_setpvn(ST(0), "0 but true", 10); - else - sv_setiv(ST(0), (I32)RETVAL); - } - } - return ax; -} - -static int -XS_POSIX__exit(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: POSIX::_exit(status)"); - } - { - int status = (int)SvIV(ST(1)); - - _exit(status); - } - return ax; -} - -static int -XS_POSIX_close(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: POSIX::close(fd)"); - } - { - int fd = (int)SvIV(ST(1)); - SysRet RETVAL; - - RETVAL = close(fd); - ST(0) = sv_newmortal(); - if (RETVAL != -1) { - if (RETVAL == 0) - sv_setpvn(ST(0), "0 but true", 10); - else - sv_setiv(ST(0), (I32)RETVAL); - } - } - return ax; -} - -static int -XS_POSIX_dup(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: POSIX::dup(fd)"); - } - { - int fd = (int)SvIV(ST(1)); - SysRet RETVAL; - - RETVAL = dup(fd); - ST(0) = sv_newmortal(); - if (RETVAL != -1) { - if (RETVAL == 0) - sv_setpvn(ST(0), "0 but true", 10); - else - sv_setiv(ST(0), (I32)RETVAL); - } - } - return ax; -} - -static int -XS_POSIX_dup2(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 2) { - croak("Usage: POSIX::dup2(fd1, fd2)"); - } - { - int fd1 = (int)SvIV(ST(1)); - int fd2 = (int)SvIV(ST(2)); - SysRet RETVAL; - - RETVAL = dup2(fd1, fd2); - ST(0) = sv_newmortal(); - if (RETVAL != -1) { - if (RETVAL == 0) - sv_setpvn(ST(0), "0 but true", 10); - else - sv_setiv(ST(0), (I32)RETVAL); - } - } - return ax; -} - -static int -XS_POSIX_lseek(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 0) { - croak("Usage: POSIX::lseek()"); - } - { - int; - Off_t; - int; - SysRet RETVAL; - - RETVAL = lseek(); - ST(0) = sv_newmortal(); - if (RETVAL != -1) { - if (RETVAL == 0) - sv_setpvn(ST(0), "0 but true", 10); - else - sv_setiv(ST(0), (I32)RETVAL); - } - } - return ax; -} - -static int -XS_POSIX_nice(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: POSIX::nice(incr)"); - } - { - int incr = (int)SvIV(ST(1)); - SysRet RETVAL; - - RETVAL = nice(incr); - ST(0) = sv_newmortal(); - if (RETVAL != -1) { - if (RETVAL == 0) - sv_setpvn(ST(0), "0 but true", 10); - else - sv_setiv(ST(0), (I32)RETVAL); - } - } - return ax; -} - -static int -XS_POSIX_pipe(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 0) { - croak("Usage: POSIX::pipe()"); - } - { - int RETVAL; - dSP; - int fds[2]; - sp--; - if (pipe(fds) != -1) { - EXTEND(sp,2); - PUSHs(sv_2mortal(newSViv(fds[0]))); - PUSHs(sv_2mortal(newSViv(fds[1]))); - } - ax = sp - stack_base; - } - return ax; -} - -static int -XS_POSIX_read(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 0) { - croak("Usage: POSIX::read()"); - } - { - SysRet RETVAL; - int fd; - char * buffer; - size_t nbytes; - - RETVAL = read(fd, buffer, nbytes); - croak("POSIX::read() not implemented yet\n"); - ST(0) = sv_newmortal(); - if (RETVAL != -1) { - if (RETVAL == 0) - sv_setpvn(ST(0), "0 but true", 10); - else - sv_setiv(ST(0), (I32)RETVAL); - } - } - return ax; -} - -static int -XS_POSIX_setgid(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: POSIX::setgid(gid)"); - } - { - Gid_t gid = (Gid_t)SvNV(ST(1)); - SysRet RETVAL; - - RETVAL = setgid(gid); - ST(0) = sv_newmortal(); - if (RETVAL != -1) { - if (RETVAL == 0) - sv_setpvn(ST(0), "0 but true", 10); - else - sv_setiv(ST(0), (I32)RETVAL); - } - } - return ax; -} - -static int -XS_POSIX_setpgid(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 2) { - croak("Usage: POSIX::setpgid(pid, pgid)"); - } - { - pid_t pid = (pid_t)SvNV(ST(1)); - pid_t pgid = (pid_t)SvNV(ST(2)); - SysRet RETVAL; - - RETVAL = setpgid(pid, pgid); - ST(0) = sv_newmortal(); - if (RETVAL != -1) { - if (RETVAL == 0) - sv_setpvn(ST(0), "0 but true", 10); - else - sv_setiv(ST(0), (I32)RETVAL); - } - } - return ax; -} - -static int -XS_POSIX_setsid(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 0) { - croak("Usage: POSIX::setsid()"); - } - { - pid_t RETVAL; - - RETVAL = setsid(); - ST(0) = sv_newmortal(); - sv_setnv(ST(0), (double)RETVAL); - } - return ax; -} - -static int -XS_POSIX_setuid(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: POSIX::setuid(uid)"); - } - { - Uid_t uid = (Uid_t)SvNV(ST(1)); - SysRet RETVAL; - - RETVAL = setuid(uid); - ST(0) = sv_newmortal(); - if (RETVAL != -1) { - if (RETVAL == 0) - sv_setpvn(ST(0), "0 but true", 10); - else - sv_setiv(ST(0), (I32)RETVAL); - } - } - return ax; -} - -static int -XS_POSIX_tcgetpgrp(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: POSIX::tcgetpgrp(fd)"); - } - { - int fd = (int)SvIV(ST(1)); - pid_t RETVAL; - - RETVAL = tcgetpgrp(fd); - ST(0) = sv_newmortal(); - sv_setnv(ST(0), (double)RETVAL); - } - return ax; -} - -static int -XS_POSIX_tcsetpgrp(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 2) { - croak("Usage: POSIX::tcsetpgrp(fd, pgrp_id)"); - } - { - int fd = (int)SvIV(ST(1)); - pid_t pgrp_id = (pid_t)SvNV(ST(2)); - SysRet RETVAL; - - RETVAL = tcsetpgrp(fd, pgrp_id); - ST(0) = sv_newmortal(); - if (RETVAL != -1) { - if (RETVAL == 0) - sv_setpvn(ST(0), "0 but true", 10); - else - sv_setiv(ST(0), (I32)RETVAL); - } - } - return ax; -} - -static int -XS_POSIX_uname(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 0) { - croak("Usage: POSIX::uname()"); - } - { - int RETVAL; - dSP; - struct utsname buf; - sp--; - if (uname(&buf) >= 0) { - EXTEND(sp, 5); - PUSHs(sv_2mortal(newSVpv(buf.sysname, 0))); - PUSHs(sv_2mortal(newSVpv(buf.nodename, 0))); - PUSHs(sv_2mortal(newSVpv(buf.release, 0))); - PUSHs(sv_2mortal(newSVpv(buf.version, 0))); - PUSHs(sv_2mortal(newSVpv(buf.machine, 0))); - } - ax = sp - stack_base; - } - return ax; -} - -static int -XS_POSIX_write(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 0) { - croak("Usage: POSIX::write()"); - } - { - SysRet RETVAL; - int fd; - char * buffer; - size_t nbytes; - - RETVAL = write(fd, buffer, nbytes); - croak("POSIX::write() not implemented yet\n"); - ST(0) = sv_newmortal(); - if (RETVAL != -1) { - if (RETVAL == 0) - sv_setpvn(ST(0), "0 but true", 10); - else - sv_setiv(ST(0), (I32)RETVAL); - } - } - return ax; -} - -int boot_POSIX(ix,ax,items) -int ix; -int ax; -int items; -{ - char* file = __FILE__; - - newXSUB("POSIX::SigSet::new", 0, XS_POSIX__SigSet_new, file); - newXSUB("POSIX::SigSet::DESTROY", 0, XS_POSIX__SigSet_DESTROY, file); - newXSUB("POSIX::SigSet::addset", 0, XS_POSIX__SigSet_sigaddset, file); - newXSUB("POSIX::SigSet::delset", 0, XS_POSIX__SigSet_sigdelset, file); - newXSUB("POSIX::SigSet::emptyset", 0, XS_POSIX__SigSet_sigemptyset, file); - newXSUB("POSIX::SigSet::fillset", 0, XS_POSIX__SigSet_sigfillset, file); - newXSUB("POSIX::SigSet::ismember", 0, XS_POSIX__SigSet_sigismember, file); - newXSUB("POSIX::constant", 0, XS_POSIX_constant, file); - newXSUB("POSIX::isalnum", 0, XS_POSIX_isalnum, file); - newXSUB("POSIX::isalpha", 0, XS_POSIX_isalpha, file); - newXSUB("POSIX::iscntrl", 0, XS_POSIX_iscntrl, file); - newXSUB("POSIX::isdigit", 0, XS_POSIX_isdigit, file); - newXSUB("POSIX::isgraph", 0, XS_POSIX_isgraph, file); - newXSUB("POSIX::islower", 0, XS_POSIX_islower, file); - newXSUB("POSIX::isprint", 0, XS_POSIX_isprint, file); - newXSUB("POSIX::ispunct", 0, XS_POSIX_ispunct, file); - newXSUB("POSIX::isspace", 0, XS_POSIX_isspace, file); - newXSUB("POSIX::isupper", 0, XS_POSIX_isupper, file); - newXSUB("POSIX::isxdigit", 0, XS_POSIX_isxdigit, file); - newXSUB("POSIX::open", 0, XS_POSIX_open, file); - newXSUB("POSIX::localeconv", 0, XS_POSIX_localeconv, file); - newXSUB("POSIX::setlocale", 0, XS_POSIX_setlocale, file); - newXSUB("POSIX::acos", 0, XS_POSIX_acos, file); - newXSUB("POSIX::asin", 0, XS_POSIX_asin, file); - newXSUB("POSIX::atan", 0, XS_POSIX_atan, file); - newXSUB("POSIX::ceil", 0, XS_POSIX_ceil, file); - newXSUB("POSIX::cosh", 0, XS_POSIX_cosh, file); - newXSUB("POSIX::floor", 0, XS_POSIX_floor, file); - newXSUB("POSIX::fmod", 0, XS_POSIX_fmod, file); - newXSUB("POSIX::frexp", 0, XS_POSIX_frexp, file); - newXSUB("POSIX::ldexp", 0, XS_POSIX_ldexp, file); - newXSUB("POSIX::log10", 0, XS_POSIX_log10, file); - newXSUB("POSIX::modf", 0, XS_POSIX_modf, file); - newXSUB("POSIX::sinh", 0, XS_POSIX_sinh, file); - newXSUB("POSIX::tanh", 0, XS_POSIX_tanh, file); - newXSUB("POSIX::sigaction", 0, XS_POSIX_sigaction, file); - newXSUB("POSIX::sigpending", 0, XS_POSIX_sigpending, file); - newXSUB("POSIX::sigprocmask", 0, XS_POSIX_sigprocmask, file); - newXSUB("POSIX::sigsuspend", 0, XS_POSIX_sigsuspend, file); - newXSUB("POSIX::_exit", 0, XS_POSIX__exit, file); - newXSUB("POSIX::close", 0, XS_POSIX_close, file); - newXSUB("POSIX::dup", 0, XS_POSIX_dup, file); - newXSUB("POSIX::dup2", 0, XS_POSIX_dup2, file); - newXSUB("POSIX::lseek", 0, XS_POSIX_lseek, file); - newXSUB("POSIX::nice", 0, XS_POSIX_nice, file); - newXSUB("POSIX::pipe", 0, XS_POSIX_pipe, file); - newXSUB("POSIX::read", 0, XS_POSIX_read, file); - newXSUB("POSIX::setgid", 0, XS_POSIX_setgid, file); - newXSUB("POSIX::setpgid", 0, XS_POSIX_setpgid, file); - newXSUB("POSIX::setsid", 0, XS_POSIX_setsid, file); - newXSUB("POSIX::setuid", 0, XS_POSIX_setuid, file); - newXSUB("POSIX::tcgetpgrp", 0, XS_POSIX_tcgetpgrp, file); - newXSUB("POSIX::tcsetpgrp", 0, XS_POSIX_tcsetpgrp, file); - newXSUB("POSIX::uname", 0, XS_POSIX_uname, file); - newXSUB("POSIX::write", 0, XS_POSIX_write, file); -} diff --git a/README b/README index beec54a..d9a97c7 100644 --- a/README +++ b/README @@ -51,10 +51,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's also a Nutshell -Handbook published by O'Reilly & Assoc. Their U.S. number is -1-800-998-9938 and their international number is 1-707-829-0515. -E-mail to nuts@ora.com. +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. Please read all the directions below before you proceed any further, and then follow them carefully. @@ -65,10 +64,25 @@ in MANIFEST. Installation 1) Run Configure. This will figure out various things about your system. - Some things Configure will figure out for itself, other things it will - ask you about. It will then proceed to make config.h, config.sh, and - Makefile. If you're a hotshot, run Configure -d to take all the - defaults and then edit config.sh to patch up any flaws. + Some things Configure will figure out for itself, other things it + will ask you about. It will then proceed to make config.h, + config.sh, and Makefile. You may have to explicitly say + sh Configure to ensure that Configure is run under sh. + If you're a hotshot, run Configure -d to take all the defaults and + then edit config.sh to patch up any flaws. + + Configure supports a number of useful options. Run Configure -h + to get a listing. To compile with gcc, for example, you can run + Configure -Dcc=gcc, or answer 'gcc' at the cc prompt. + + By default, perl will be installed in /usr/local/{bin, lib, man}. + You can specify a different prefix for the default installation + directory, when Configure prompts you or by using something like + Configure -Dprefix=/whatever. + + You can also supply a file config.over to over-ride Configure's + guesses. It will get loaded up at the very end, just before + config.sh is created. You might possibly have to trim # comments from the front of Configure if your sh doesn't handle them, but all other # comments will be taken @@ -82,9 +96,8 @@ Installation If you have any additional changes to make to the C definitions, they can be done in cflags.SH. For instance, to turn off the optimizer - on eval.c, find the line in the switch structure for eval.c and - put the command $optimize='-g' before the ;;. You will probably - want to change the entry for teval.c too. To change the C flags + on toke.c, find the line in the switch structure for toke.c and + put the command optimize='-g' before the ;;. To change the C flags for all the files, edit config.sh and change either $ccflags or $optimize. 3) make depend @@ -111,46 +124,30 @@ Installation Makefile.SH, since a default rule only takes effect in the absence of a specific rule. - Most of the following hints are now done automatically by Configure. + Many of the following hints are now done automatically by Configure. + Some of the hints here were for Perl 4, and are probably obsolete. + They're left here for the moment just to give you some ideas for + what to try if you're having trouble. - The 3b2 needs to turn off -O. - Compilers with limited switch tables may have to define -DSMALLSWITCHES - Domain/OS 10.3 (at least) native C 6.7 may need -opt 2 for eval.c AIX/RT may need a -a switch and -DCRIPPLED_CC. - AIX RS/6000 needs to use system malloc and avoid -O on eval.c and toke.c. - AIX RS/6000 needs -D_NO_PROTO. - SUNOS 4.0.[12] needs -DFPUTS_BOTCH. - SUNOS 3.[45] should use the system malloc. - SGI machines may need -Ddouble="long float" and -O1. - Vax-based systems may need to hand assemble teval.s with a -J switch. - Ultrix on MIPS machines may need -DLANGUAGE_C. - Ultrix 4.0 on MIPS machines may need -Olimit 2900 or so. Ultrix 3.[01] on MIPS needs to undefine WAITPID--the system call is busted. - MIPS machines need /bin before /bsd43/bin in PATH. MIPS machines may need to undef d_volatile. - MIPS machines may need to turn off -O on cmd.c, perl.c and tperl.c. + MIPS machines may need to turn off -O on some files. Some MIPS machines may need to undefine CASTNEGFLOAT. - Xenix 386 needs -Sm11000 for yacc, and may need -UM_I86. - SCO Xenix may need -m25000 for yacc. See also README.xenix. - Genix needs to use libc rather than libc_s, or #undef VARARGS. + Xenix 386 may need -UM_I86. See also README.xenix. + Genix may need to use libc rather than libc_s, or #undef VARARGS. NCR Tower 32 (OS 2.01.01) may need -W2,-Sl,2000 and #undef MKDIR. - A/UX may appears to work with -O -B/usr/lib/big/ optimizer flags. - A/UX needs -lposix to find rewinddir. + A/UX may appear to work with -O -B/usr/lib/big/ optimizer flags. + A/UX may need -lposix to find rewinddir. A/UX may need -ZP -DPOSIX, and -g if big cc is used. - FPS machines may need -J and -DBADSWITCH. UTS may need one or more of -DCRIPPLED_CC, -K or -g, and undef LSTAT. - dynix may need to undefine CASTNEGFLOAT (d_castneg='undef' in config.sh). - Dnix (not dynix) may need to remove -O. - IRIX 3.3 may need to undefine VFORK. - HP/UX may need to pull cerror.o and syscall.o out of libc.a and link - them in explicitly. - If you get syntax errors on '(', try -DCRIPPLED_CC or -DBADSWITCH or both. - Machines with half-implemented dbm routines will need to #undef ODBM & NDBM. - If you have GDBM available and want it instead of NDBM, say -DHAS_GDBM. - C's that don't try to restore registers on longjmp() may need -DJMPCLOBBER. - (Try this if you get random glitches.) + If you get syntax errors on '(', try -DCRIPPLED_CC. + Machines with half-implemented dbm routines will need to #undef I_ODBM + SCO prior to 3.2.4 may be missing dbmclose(). An upgrade to 3.2.4 + that includes libdbm.nfs (which includes dbmclose()) may be available. If you get duplicates upon linking for malloc et al, say -DHIDEMYMALLOC. - Turn on support for 64-bit integers (long longs) with -DQUAD. + If you get duplicate function definitions (a perl function has the + same name as another function on your system) try -DEMBED. 5) make test @@ -170,7 +167,12 @@ Installation you are not root, you must own the directories in question and you should ignore any messages about chown not working. -7) Read the manual entry before running perl. + Most of the documentation in the pod/ directory is also available + in HTML format. Type + cd pod; make html; cd .. + to generate the html versions. + +7) Read the manual entries before running perl. 8) IMPORTANT! Help save the world! Communicate any problems and suggested patches to me, lwall@netlabs.com (Larry Wall), so we can diff --git a/README.Conf b/README.Conf deleted file mode 100644 index 807b457..0000000 --- a/README.Conf +++ /dev/null @@ -1,146 +0,0 @@ -From: doughera@lafcol.lafayette.edu (Andy Dougherty) -Subject: RE: First stab at Configure Support for perl5alpha -Date: Fri Apr 29 16:43:18 EDT 1994 - -I have incorporated various fixes/suggestions into the Configure -support for perl5alpha8. The main changes are the following: - -Better incorporation of extensions in Makefile.SH. - -miniperlmain.c no longer requires dynamic loading. - -perl can use dynamic loading if available, but extensions can - also be compiled in statically, if desired. - -perlmain.c now built from miniperlmain.c by writemain.SH, - which is called in the makefile. Only the requested extensions - are compiled in. - -dynamic loading broken up into dl_sunos.c, dl_next.c, dl_hpux.c. - Configure will look for dl_$osname.c, where osname is determined - at the same time as hints are suggested. - -Configure support added for sdbm library (ext/dbm/sdbm/libsdbm.a). - This still needs testing. - -Tests for extensions now check in %Config to see if that extension - is available. Note, however, the sdbm is not an *optional* - extension, so it will fail (and make test will complain) - if sdbm is not installed. Thus perl programmers can safely assume - that at least sdbm is available. - -configpm now correctly handles comments at the end of config.sh - (which Configure places there if a hints file tries to propagate - unknown variables, such as libswanted). - -makedepend now works in UU/ subdirectory (so it doesn't delete - miniperlmain.c on systems with 14-character file name limits). - -ext/typemap: My compiler couldn't handle some of the more complex - casts, so an intermediate unsigned long variable has been introduced. - I should probably re-do this in terms of a CRIPPLED_CC macro in - XSUB.h, but it's not clear to me that it's worth it. - -some new or updated hints files. - -miscellaneous bug fixes. - -Problems remaining: - - -POSIX module is still under construction. - -Dynamic loading of extensions works on SunOS 4.1.3, but it - might need modifications to work with other systems. - -It is possible to do mixed dynamic/static loading, that is, - load commonly used modules statically and other modules - dynamically. Currently, this must be done by hand by setting - extobj in makefile and hand-editing perlmain.c. - The newXSUB line for the static module must be moved into - the #ifdef USE_DYNAMIC_LOADING section in perlmain.c, and the - module .o file must be added to the extobj= line in makefile. - -lib/[sn]dbm.t tests create a new file with a hard-wired set of - flags. These should be replaced with O_CREAT | O_RDWR, which - will be available from POSIX.pm, once it is up and running. - For now, you might have to change the 0x202 to 0x102 (or perhaps - 0x402) in lib/[sn]dbm.t for the tests to succeed. - -I have applied several suggested fixes for use on the DEC alpha, - but I haven't been able to keep up with all of them. - -Though CRIPPLED_CC works, it might be desireable to have Configure - try to figure it out. - -To apply: Obtain a clean copy of perl5alpha8 - cd - patch -p1 < - -As before, I am willing to continue to coordinate and develop the -Configure support. - -Thanks to the following for various and often quite substantial -patches and suggestions: - Peter Galbavy - Jarkko Hietaniemi - Andreas Koenig - Raphael Manfredi - David Meyer - Jeff Okamoto - John Stoffel - Larry Wall (lwall@netlabs.com> - - Andy Dougherty doughera@lafcol.lafayette.edu - Dept. of Physics Phone: (610) 250-5212 - Lafayette College FAX: (610) 250-9263 - Easton, PA 18042-1782 - -================================================================= - -From: doughera@lafcol.lafayette.edu (Andy Dougherty) -Subject: First stab at Configure Support for perl5alpha -Date: Mon Apr 4 15:13:50 EDT 1994 - -I've updated Configure to support perl5alpha7. Consider this a -first attempt. I am willing to continue to develop and coordinate -improvement on this. I've included the metaconfig units (in the U/ -directory) that I developed for this. New units, or fixes to these, -are welcome. - -Here's what should work: - -You should be able to Configure and run miniperl on any platform - that supported perl4. - - -Configure should be more amenable to hints. In particular, - you can remove directories from the library search path with - a hints file. See hints/solaris_2_3.sh for an example. - -Here's what needs improvement: - -Including dynamic loading on works on SunOS 4.1.x, as far as I - know, but nowhere else. I don't understand enough about what's - going on to put in stub functions for those who might want/have to - use another dynamic linking package or static linking. Configure - assumes you want to use the dl.c source file if you try to use - dynamic linking. Still, you should be able to get miniperl up and - running. - - -I haven't made any changes to installperl. - - -Makefile.SH (and hence makefile) should arrange to pick up the - appropriate .pm modules from the extensions directory and install - them. I haven't done anything about that. - - -I didn't incorporate any of the Configure changes into the - extension files, partly because I couldn't get past the dynamic - loading problem on my main machine, but mostly because I haven't - had the time yet. That's near the top of the ToDo list. - - -I made no changes to the x2p/ subdirectory, though some might - be probably needed. - - -Lots of the hints files are probably now out of date. - The solaris_2_[23].sh ones are completely untested guesses. - Fixed/updated version are welcome. - - -The defaults are to use perl's malloc and compile with - -g -DDEBUGGING. I was unable to get perl to pass all tests - with anything else. Part of the problem may be the stupid stub - functions I inserted in dump.c and sv.c, but there may be other - malloc/free problems elsewhere. - - -Whatever else I broke to get this to work. - -Thanks to - Tim Bunce , - Manoj Srivastava , and - Bill Hertzing -for various suggestions and help. Thanks to Raphael Manfredi for -much work on dist-3.0. - - Andy Dougherty doughera@lafcol.lafayette.edu - Dept. of Physics Phone: (610) 250-5212 - Lafayette College FAX: (610) 250-9263 - Easton, PA 18042-1782 diff --git a/README.ncr b/README.ncr deleted file mode 100644 index a21e0f2..0000000 --- a/README.ncr +++ /dev/null @@ -1,151 +0,0 @@ -From: lreed@ncratl.AtlantaGA.NCR.COM (Len Reed) -Newsgroups: comp.lang.perl -Subject: Fixes for Perl 4.019 on NCR Tower V.3 -Date: 17 Feb 92 16:41:30 GMT -Organization: Holos Software, Inc. - -Here are the fixes needed to make perl 4.019 on the NCR Tower V.3 system. -I have bundled this as a shar file: feed everything below the CUT line -to /bin/sh. - -The file hints/ncr_tower.sh fixes several problems. It replaces the -standard copy thereof. Note that I use perl's malloc. Note also -that I have turned the optimizer completely off (-O0). Optimizing -at -O1 or -O2 produces some errors that the test suite doesn't catch. -(Problems with alloca() and setjmp/longjmp, I think.) It should be -possible to optimize some modules but I haven't experimented with this. - -[NOTE: this hints file is already installed--lwall] - -I'm don't know if mkdir(2) works: I've left it undef'ed. It is certainly -broken in V.2. If you need fast mkdir's you may want to experiment with -this. - -The file patch.twg fixes a stupidity in /usr/netinclude/sys/time.h. -You'll need this if you have WIN-TCP; you can't use it if you don't -have WIN-TCP. If needed, apply this patch *before* running Configure. - -Make sure you tell Configure that any config.sh it finds is to be ignored. - -After running Configure and make depend, edit config.h so that -the CPPSTDIN definition has DEFAULT_CPP=/dev/null prepended. It should -look this this: - -#define CPPSTDIN "DEFAULT_CPP=/dev/null cc -E" - -This must be done by hand after running "make depend" and before running -make. I was unable to encode this into the hints file. - -This resulting perl should pass all tests. - --Len Reed -Holos Software, Inc. -holos0!lbr@gatech.edu (my main account) -lreed@ncratl.atlantaga.ncr.com (this account--on a customer's machine) - ------CUT HERE---- -#!/bin/sh -# This is a shell archive (shar 3.32) -# made 02/17/1992 16:36 UTC by lreed@ncratl -# Source directory /usr/acct/lreed/,q -# -# existing files WILL be overwritten -# -# This shar contains: -# length mode name -# ------ ---------- ------------------------------------------ -# 1593 -rw-rw-rw- patch.twg -# 176 -rw-r--r-- hints/ncr_tower.sh -# -if touch 2>&1 | fgrep 'amc' > /dev/null - then TOUCH=touch - else TOUCH=true -fi -# ============= patch.twg ============== -echo "x - extracting patch.twg (Text)" -sed 's/^X//' << 'SHAR_EOF' > patch.twg && -XThe following patch fixes /usr/netinclude/sys/time.h on the Tower V.3. -XPulling in with -I/usr/inetinclude makes a mess unless -Xthe file is pulled in, too. It's stupid that an -Xapplication (e.g., perl) should have to do this. Thus, I fixed -Xthe system header file. The alternative is to make each application -Xget the header file itself. (The #if allows the application to do -Xit, though, for compatibility with existing applications.) -X -XTo apply this patch, chdir to /usr/netinclude/sys and run -X patch shouldn't cause -X HDEF to blow up the compile--auto pull in its defining file. -X */ -X# include -X#endif -X -Xbefore HDEF is used. -X -X-----The patch starts below this line -X -X*** time.h.old Fri Feb 14 12:06:46 1992 -X--- time.h Fri Feb 14 12:04:32 1992 -X*************** -X*** 4,12 **** -X /* time.h 6.1 83/07/29 */ -X /* " @(#)time.h (TWG) 2.2 88/05/17 " */ -X -X! /* -X HDEF( "@(#)$RCSfile: README.ncr,v $$Revision: 4.1 $$Date: 92/08/07 17:18:12 $" ) -X- */ -X -X /* -X * Structure returned by gettimeofday(2) system call, -X--- 4,17 ---- -X /* time.h 6.1 83/07/29 */ -X /* " @(#)time.h (TWG) 2.2 88/05/17 " */ -X -X! #ifndef HDEF -X! /* Len Reed 5/6/91 -- pulling in shouldn't cause -X! HDEF to blow up the compile--auto pull in its defining file. -X! */ -X! # include -X! #endif -X! -X HDEF( "@(#)$RCSfile: README.ncr,v $$Revision: 4.1 $$Date: 92/08/07 17:18:12 $" ) -X -X /* -X * Structure returned by gettimeofday(2) system call, -SHAR_EOF -$TOUCH -am 0217113592 patch.twg && -chmod 0666 patch.twg || -echo "restore of patch.twg failed" -set `wc -c patch.twg`;Wc_c=$1 -if test "$Wc_c" != "1593"; then - echo original size 1593, current size $Wc_c -fi -# ============= hints/ncr_tower.sh ============== -if test ! -d 'hints'; then - echo "x - creating directory hints" - mkdir 'hints' -fi -echo "x - extracting hints/ncr_tower.sh (Text)" -sed 's/^X//' << 'SHAR_EOF' > hints/ncr_tower.sh && -Xoptimize='-O0' -Xccflags="$ccflags -W2,-Sl,2000" -Xeval_cflags='large="-W0,-XL"' -Xteval_cflags=$eval_cflags -Xd_mkdir=$undef -Xusemymalloc='y' -Xmallocsrc='malloc.c' -Xmallocobj='malloc.o' -SHAR_EOF -$TOUCH -am 0214073692 hints/ncr_tower.sh && -chmod 0644 hints/ncr_tower.sh || -echo "restore of hints/ncr_tower.sh failed" -set `wc -c hints/ncr_tower.sh`;Wc_c=$1 -if test "$Wc_c" != "176"; then - echo original size 176, current size $Wc_c -fi -exit 0 - - diff --git a/README.uport b/README.uport deleted file mode 100644 index b2b5712..0000000 --- a/README.uport +++ /dev/null @@ -1,34 +0,0 @@ -From dwm@uf.msc.umn.edu Tue Dec 19 15:03:27 1989 -Subject: perl on Microport Un*x 2.4 - -Here are the steps to get perl patchlevel 6 running on Microport Un*x 2.4. - -(1) Get the directory routines (opendir, readdir, etc) from an archive - somewhere. I got mine from uunet: comp.sources.unix/volume9/gwyn-dir-lib - and comp.sources.unix/volume10/dir-lib.pch. Compile a large memory - version of the library and put it in /usr/lib/large/dir.a. Also put - the dir.h include file in /usr/include/sys. [ If you don't want to - do this make sure I_SYSDIR does not defined in config.sh ] - -(2) Configure causes sh to get a segmentation fault when it does the - ". config.sh" near line 2551. You will have to remove that line - from Configure and make sure you get your configuration info right - the first time or start over if you make a mistake. - -[Or just run the .SH files by hand and proceed to the make depend.] - -(3) If you are using C-shell, put a blank line at the start of Configure so it - wont get executed by the C-shell. If you are using ksh, you will have to - execute Configure with 'sh Configure'. Configure does not work with - ksh. - -(4) When you run Configure, select compilation option -DCRIPPLED_CC. - I also selected -DDEBUGGING to make debugging easier. I recommend it. - You can use -O, but you will then have to compile consarg.c and util.c - separately without -O because the optimizer generates bad code for these - routines. The optimizer also dies harmlessly while optimizing cmd.c, - eval.c (who can blame it? [sorry, Larry]), and toke.c. - I am still trying to isolate the remaining optimization problems in - consarg.c and util.c. - -[The rest of the previously published instructions are no longer necessary.] diff --git a/README.vms b/README.vms new file mode 100644 index 0000000..dbf6251 --- /dev/null +++ b/README.vms @@ -0,0 +1,232 @@ +Last revised: 09-Oct-1994 by Charles Bailey bailey@genetics.upenn.edu + +The VMS port of perl5 is still under development. At this time, the perl +binaries built under VMS handle internal operations properly, for the most +part, as well as most of the system calls which have close equivalents under +VMS. There are still some incompatibilities in process handling (e.g the +fork/exec model for creating subprocesses doesn't do what you might expect +under Unix), and there remain some file handling differences from Unix. There +is a VMS implementation of the DynaLoader, but it hasn't been tested much, so +it may still have some bugs in it. Over the longer term, we'll try to get many +of the useful VMS system services integrated as well, depending on time and +people available. Of course, if you'd like to add something yourself, or join +the porting team, we'd love to have you! + +The current sources and build procedures have been tested on a VAX using VAXC +and on an AXP using DECC. IF you run into problems with other compilers, +please let us know. + + +* Other software required + +At the moment, in addition to basic VMS, you'll need two things: + - a C compiler: VAXC, DECC, or gcc for the VAX; DECC for the AXP + - a make tool: DEC's MMS or the free analog MMK (available from ftp.spc.edu) + or a standard make utility (e.g. GNU make, also available from + ftp.spc.edu). +In addition, you may include socket support if you have a IP stack running +on your system. See the topic "Socket support" for more information. + +* Socket support + +Perl5 includes a number of IP socket routines among its builtin functions, +which are available if you choose to compile perl with socket support. Since +IP networking is an optional addition to VMS, there are several different IP +stacks available, it's difficult to automate the process of building perl5 with +socket support in a way which will work on all systems. + +By default, perl5 is built without IP socket support. If you define the macro +SOCKET when invoking MMS, however, socket support will be included. As +distributed, perl5 for VMS includes support for the SOCKETSHR socket library, +which is layered on MadGoat software's vendor-independent NETLIB interface. +This provides support for all socket calls used by perl5 except the +[g|s]et*ent() routines, which are replaced for the moment by stubs which +generate a fatal error if a perl script attempts to call one of these routines. +If you'd like to link perl directly to your IP stack to take advantage of these +routines or to eliminate the intermediate NETLIB, then make the following +changes: + - In Descrip.MMS, locate the section beginning with .ifdef SOCKET, and + change the SOCKLIB macro so that it translates to the filespec of your + IP stack's socket library. This will be added to the RTL options file. + - Edit the file SockAdapt.H in the [.VMS] subdirectory so that it + includes the In.H, NetDb.H, and, if necessary, Errno.H header files + for your IP stack, or so that it declares the standard TCP/IP data + structures appropriately (see the distributed copy of SockAdapt.H + for a collection of the structures needed by perl.) You should also + define any logical names necessary to find these files before invoking + MMS to build perl. + - Edit the file SockAdapt.C in the [.VMS] subdirectory so that it + contains routines which substitute for any IP library routines + required by perl which your IP stack does not provide. This may + require a little trial and error; we'll try to compile a complete + list soon of socket routines required by perl5. + +* Building perl under VMS + +Since you're reading this, presumable you've unpacked the perl distribution +into its directory tree, in which you will find a [.vms] subdirectory below +the directory in which this file is found. If this isn't the case, then you'll +need to unpack the distribution properly, or manually edit Descrip.MMS or +the VMS Makefile. to alter directory paths as necessary. (I'd advise using the +`normal' directory tree, at least for the first time through.) This +subdirectory contains several files, among which are the following: + Config.VMS - A template C header file set up for VMS. + Descrip.MMS - The MMS/MMK dependency file for building perl + GenConfig.Pl - A perl script to generate Config.SH retrospectively + from Config.VMS, since the Configure shell script which + normally generates Config.SH doesn't run under VMS. + GenOpt.Com - A little DCL procedure used to write some linker options + files, since not all make utilities can do this easily. + Gen_ShrFls.Pl - A perl script which generates linker options files and + MACRO declarations for PerlShr.Exe. + Makefile. - The make dependency file for building perl + MMS2Make.Pl - A perl script used to generate Makefile. from Descrip.MMS + VMSish.H - C header file containing VMS-specific definitions + VMS.C - C source code for VMS-specific routines + WriteMain.Pl - A perl script used to generate perlmain.c during the build. +There may also be other files pertaining to features under development; for the +most part, you can ignore them. + +Config.VMS and Decrip.MMS/Makefile. are set up to build a version of perl which +includes all features known to work when this release was assembled. If you +have code at your site which would support additional features (e.g. emulation +of Unix system calls), feel free to make the appropriate changes to these +files. (Note: Do not use or edit config.h in the main perl source directory; +it is superseded by the current Config.VMS during the build.) You may also +wish to make site-specific changes to Descrip.MMS or Makefile. to reflect local +conventions for naming of files, etc. + +At the moment, system-specific information which becomes part of the perl5 +Config extension is hard-coded into the file genconfig.pl in the vms +subdirectory. Before you build perl, you should make any changes to the list +at the end of this file necessary to reflect your system (e.g your hostname and +VMS version). + +Examine the information at the beginning of Descrip.MMS for information about +specifying alternate C compilers or building a version of perl with debugging +support. For instance, if you want to use DECC, you'll need to include the +/macro="decc=1" qualifier to MMS (If you're using make, these options are not +supported.) If you're on an AXP system, define the macro __AXP__ (MMK does +this for you), and DECC will automatically be selected. + +To start the build, set default to the main source directory. +Then, if you are using MMS or MMK, issue the command +$ MMS/Descrip=[.VMS] ! or MMK +If you are using make, issue the command +$ Make -f [.VMS]Makefile. +Note that the Makefile. doesn't support conditional compilation, and is +set up to use VAXC on a VAX, and does not include socket support. You can +either edit the Makefile. by hand, using Descrip.MMS as a guide, or use the +Makefile. to build Miniperl.Exe, and then run the Perl script MMS@Make.pl, +found in the [.VMS] subdirectory, to generate a new Makefile with the options +appropriate to your site. + +Note for sites using early versions of DECC: A bug in some versions of the +DECC RTL causes newlines to be lost when writing to a pipe. This causes +Gen_ShrFls.pl to fail, since it can't read the preprocessor output to identify +global variables and routines. You can work around this problem by defining +the macro DECC_PIPES_BROKEN when you invoke MMS or MMK. + +This will build the following files: + Miniperl.Exe - a stand-alone version of without any extensions. + Miniperl has all the intrinsic capabilities of perl, + but cannot make use of the DynaLoader or any + extensions which use XS code. + PerlShr.Exe - a shareable image containing most of perl's internal + routines and global variables. Perl.Exe is linked to + this image, as are all dynamic extensions, so everyone's + using the same set of global variables and routines. + Perl.Exe - the main perl executable image. It's contains the + main() routine, plus code for any statically linked + extensions. + PerlShr_Attr.Opt - A linker options file which specifies psect attributes + matching those in PerlShr.Exe. It should be used when + linking images against PerlShr.Exe + [.Lib]Config.pm - the perl extension which saves configuration information + about perl and your system. + [.lib]DynaLoader.pm - The perl extension which performs dynamic linking of + shareable images for extensions. +There are, of course, a number of other files created for use during the build. +Once you've got the binaries built, you may wish to `build' the `tidy' or +`clean' targets to remove extra files. + + +* Installing perl once it's built + +Once the build is complete, you'll need to do the following: + - Put PerlShr.Exe in a common directory, and make it world-readable. + If you place it in a location other than Sys$Share, you'll need to + define the logical name PerlShr to point to the image. + - Put Perl.Exe in a common directory, and make it world executable + - Define a foreign command to invoke perl, using a statement like + $ Perl == "$dev:[dir]Perl.Exe" + - Create a world-readable directory tree for perl library modules, + scripts, and what-have-you, and define PERL_ROOT as a rooted logical + name pointing to the top of this tree (i.e. if your perl files were + going to live in DKA1:[Perl5...], then you should + $ Define/Translation=Concealed Perl_Root DKA1:[Perl5.] + - Define the logical name PERLSHR as the full file specification of + PERLSHR.EXE, so executable images linked to it can find it. Alternatively, + you can justput PERLSHR.EXE int SYS$SHARE. + - Place the files from the [.lib] subdirectory in the distribution package + into a [.lib] subdirectory off the root directory described above. + - Most of the perl5 documentation lives in the [.pod] subdirectory, and + is written in a simple markup format which can be easily read. In this + directory as well are pod2man and pod2html translators to reformat the + docs for common display engines; a pod2hlp translator is under development. + Information on perl5 can also be gleaned from the files in the [.doc] + subdirectory (internals documents and summaries of changes), and from + the test scripts in the [.t...] subdirectories. +For now, that's it. + + +* For more information + +If you're interested in more information on perl in general, consult the Usenet +newsgroup comp.lang.perl. The FAQ for that group provides pointers to other +online sources of information, as well as books describing perl in depth. + +If you're interested in up-to-date information on perl5 development and +internals, you might want to subscribe to the perl5-porters mailing list. You +can do this by sending a message to perl5-porters-request@isi.edu, containing +the single line +subscribe perl5-porters Your Name Here +This is a moderately high-volume list at the moment (25-50 messages/day). + +Finally, if you're interested in ongoing information about the VMS port, you +can subscribe to the VMSperl mailing list by sending a request to +bailey@genetics.upenn.edu (it's to a human, not a list server - this is a small +operation at the moment). And, as always, we welcome any help or code you'd +like to offer - you can send mail to bailey@genetics.upenn.edu or directly to +the VMSperl list at vmsperl@genetics.upenn.edu. + +Good luck using perl. Please let us know how it works for you - we can't +guarantee that we'll be able to fix bugs quickly, but we'll try, and we'd +certainly like to know they're out there. + + +* Acknowledgements + +There are, of course, far too many people involved in the porting and testing +of perl5 to mention everyone who deserves it, so please forgive us if we've +missed someone. That said, special thanks are due to the following: + David Denholm + for extensive testing and provision of pipe and SocketShr code, + Mark Pizzolato + for the getredirection() code + Rich Salz + for readdir() and related routines + Denis Haskin + for work on a pod-to-hlp translator for the perl5 documentation + Richard Dyson and + Kent Covert + for additional testing on the AXP. +and to the entire VMSperl group for useful advice and suggestions. In addition +the perl5-porters, especially Andy Dougherty +and Tim Bunce , deserve credit for their creativity and +willingness to work with the VMS newcomers. Finally, the greatest debt of +gratitude is due to Larry Wall , for having the ideas which +have made our sleepless nights possible. + +Thanks, +The VMSperl group diff --git a/README.xenix b/README.xenix deleted file mode 100644 index ca9a060..0000000 --- a/README.xenix +++ /dev/null @@ -1,53 +0,0 @@ -From jpl-devvax!elroy.jpl.nasa.gov!sdd.hp.com!spool.mu.edu!uunet!mcsun!ukc!stl!robobar!ronald Thu Mar 7 09:51:06 PST 1991 -Article 4564 of comp.lang.perl: -Path: jpl-devvax!elroy.jpl.nasa.gov!sdd.hp.com!spool.mu.edu!uunet!mcsun!ukc!stl!robobar!ronald ->From: ronald@robobar.co.uk (Ronald S H Khoo) -Newsgroups: comp.lang.perl -Subject: Re: directory entries chopped on SCO Unix -Message-ID: <1991Mar7.083046.14410@robobar.co.uk> -Date: 7 Mar 91 08:30:46 GMT -References: <18097@ogicse.ogi.edu> <498@stephsf.stephsf.com> -Organization: Robobar Ltd., Perivale, Middx., ENGLAND. -Lines: 38 -Status: OR - -wengland@stephsf.stephsf.com (Bill England) writes: - -> Would modification of the config to -> drop the Xenix specific test and also dropping the -lx library -> work better on Xenix boxes ? Sorry I can't test Xenix here. - -This is a difficult question to answer, mostly because it's hard to -tell exactly what kind of Xenix you have. - - Early releases didn't have any kind of ndir -- no problem - - Many releases have only sys/ndir + -lx -- no problem - - SCO Xenix 2.3.[012] have ndir + dirent, but dirent is reputedly - broken on .0 and .1, hence the hack to undef it. - - *However*, the kernel upgrade to 2.3.3 (where dirent apparently works) - from any lower 2.3.? is a free upgrade, which you can anon FTP or UUCP. - -I use dirent -- I had to make a decision which set of directory routines -to throw out (so that there would be no confusion), so I threw out the -old ones. This means I have to manually remove the ! defined(M_XENIX) -hacks from the source which is very ugh. - -My opinion is that the hacks should be removed seeing as they only apply -to a small number of operating system versions which you upgrade for -free anyway. Chip may disagree with me. It all rather depends on your -particular point of view. - -You could hack Configure to do case "`uname -r`" in 2.3.[01]) -I guess. It's a lot of code to handle just one specific case, -since you have to determine whether to do it or not as well. - -In short, I Really Don't Know But It's All Very Annoying. - -Just another Xenix user, --- -Ronald Khoo +44 81 991 1142 (O) +44 71 229 7741 (H) - - diff --git a/SDBM_File.c b/SDBM_File.c deleted file mode 100644 index fcf2259..0000000 --- a/SDBM_File.c +++ /dev/null @@ -1,296 +0,0 @@ -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" -#include "ext/dbm/sdbm/sdbm.h" - -typedef DBM* SDBM_File; -#define sdbm_new(dbtype,filename,flags,mode) sdbm_open(filename,flags,mode) -#define nextkey(db,key) sdbm_nextkey(db) - -static int -XS_SDBM_File_sdbm_new(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 4) { - croak("Usage: SDBM_File::new(dbtype, filename, flags, mode)"); - } - { - char * dbtype = SvPV(ST(1),na); - char * filename = SvPV(ST(2),na); - int flags = (int)SvIV(ST(3)); - int mode = (int)SvIV(ST(4)); - SDBM_File RETVAL; - - RETVAL = sdbm_new(dbtype, filename, flags, mode); - ST(0) = sv_newmortal(); - sv_setptrobj(ST(0), RETVAL, "SDBM_File"); - } - return ax; -} - -static int -XS_SDBM_File_sdbm_DESTROY(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: SDBM_File::DESTROY(db)"); - } - { - SDBM_File db; - - if (SvROK(ST(1))) { - unsigned long tmp; - tmp = (unsigned long)SvNV((SV*)SvRV(ST(1))); - db = (SDBM_File) tmp; - } - else - croak("db is not a reference"); - sdbm_close(db); - } - return ax; -} - -static int -XS_SDBM_File_sdbm_fetch(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 2) { - croak("Usage: SDBM_File::fetch(db, key)"); - } - { - SDBM_File db; - datum key; - datum RETVAL; - - if (sv_isa(ST(1), "SDBM_File")) { - unsigned long tmp; - tmp = (unsigned long)SvNV((SV*)SvRV(ST(1))); - db = (SDBM_File) tmp; - } - else - croak("db is not of type SDBM_File"); - - key.dptr = SvPV(ST(2), na); - key.dsize = (int)na;; - - RETVAL = sdbm_fetch(db, key); - ST(0) = sv_newmortal(); - sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); - } - return ax; -} - -static int -XS_SDBM_File_sdbm_store(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items < 3 || items > 4) { - croak("Usage: SDBM_File::store(db, key, value, flags = DBM_REPLACE)"); - } - { - SDBM_File db; - datum key; - datum value; - int flags; - int RETVAL; - - if (sv_isa(ST(1), "SDBM_File")) { - unsigned long tmp; - tmp = (unsigned long)SvNV((SV*)SvRV(ST(1))); - db = (SDBM_File) tmp; - } - else - croak("db is not of type SDBM_File"); - - key.dptr = SvPV(ST(2), na); - key.dsize = (int)na;; - - value.dptr = SvPV(ST(3), na); - value.dsize = (int)na;; - - if (items < 4) - flags = DBM_REPLACE; - else { - flags = (int)SvIV(ST(4)); - } - - RETVAL = sdbm_store(db, key, value, flags); - ST(0) = sv_newmortal(); - sv_setiv(ST(0), (I32)RETVAL); - } - return ax; -} - -static int -XS_SDBM_File_sdbm_delete(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 2) { - croak("Usage: SDBM_File::delete(db, key)"); - } - { - SDBM_File db; - datum key; - int RETVAL; - - if (sv_isa(ST(1), "SDBM_File")) { - unsigned long tmp; - tmp = (unsigned long)SvNV((SV*)SvRV(ST(1))); - db = (SDBM_File) tmp; - } - else - croak("db is not of type SDBM_File"); - - key.dptr = SvPV(ST(2), na); - key.dsize = (int)na;; - - RETVAL = sdbm_delete(db, key); - ST(0) = sv_newmortal(); - sv_setiv(ST(0), (I32)RETVAL); - } - return ax; -} - -static int -XS_SDBM_File_sdbm_firstkey(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: SDBM_File::firstkey(db)"); - } - { - SDBM_File db; - datum RETVAL; - - if (sv_isa(ST(1), "SDBM_File")) { - unsigned long tmp; - tmp = (unsigned long)SvNV((SV*)SvRV(ST(1))); - db = (SDBM_File) tmp; - } - else - croak("db is not of type SDBM_File"); - - RETVAL = sdbm_firstkey(db); - ST(0) = sv_newmortal(); - sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); - } - return ax; -} - -static int -XS_SDBM_File_nextkey(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 2) { - croak("Usage: SDBM_File::nextkey(db, key)"); - } - { - SDBM_File db; - datum key; - datum RETVAL; - - if (sv_isa(ST(1), "SDBM_File")) { - unsigned long tmp; - tmp = (unsigned long)SvNV((SV*)SvRV(ST(1))); - db = (SDBM_File) tmp; - } - else - croak("db is not of type SDBM_File"); - - key.dptr = SvPV(ST(2), na); - key.dsize = (int)na;; - - RETVAL = nextkey(db, key); - ST(0) = sv_newmortal(); - sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); - } - return ax; -} - -static int -XS_SDBM_File_sdbm_error(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: SDBM_File::error(db)"); - } - { - SDBM_File db; - int RETVAL; - - if (sv_isa(ST(1), "SDBM_File")) { - unsigned long tmp; - tmp = (unsigned long)SvNV((SV*)SvRV(ST(1))); - db = (SDBM_File) tmp; - } - else - croak("db is not of type SDBM_File"); - - RETVAL = sdbm_error(db); - ST(0) = sv_newmortal(); - sv_setiv(ST(0), (I32)RETVAL); - } - return ax; -} - -static int -XS_SDBM_File_sdbm_clearerr(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items != 1) { - croak("Usage: SDBM_File::clearerr(db)"); - } - { - SDBM_File db; - int RETVAL; - - if (sv_isa(ST(1), "SDBM_File")) { - unsigned long tmp; - tmp = (unsigned long)SvNV((SV*)SvRV(ST(1))); - db = (SDBM_File) tmp; - } - else - croak("db is not of type SDBM_File"); - - RETVAL = sdbm_clearerr(db); - ST(0) = sv_newmortal(); - sv_setiv(ST(0), (I32)RETVAL); - } - return ax; -} - -int boot_SDBM_File(ix,ax,items) -int ix; -int ax; -int items; -{ - char* file = __FILE__; - - newXSUB("SDBM_File::new", 0, XS_SDBM_File_sdbm_new, file); - newXSUB("SDBM_File::DESTROY", 0, XS_SDBM_File_sdbm_DESTROY, file); - newXSUB("SDBM_File::fetch", 0, XS_SDBM_File_sdbm_fetch, file); - newXSUB("SDBM_File::store", 0, XS_SDBM_File_sdbm_store, file); - newXSUB("SDBM_File::delete", 0, XS_SDBM_File_sdbm_delete, file); - newXSUB("SDBM_File::firstkey", 0, XS_SDBM_File_sdbm_firstkey, file); - newXSUB("SDBM_File::nextkey", 0, XS_SDBM_File_nextkey, file); - newXSUB("SDBM_File::error", 0, XS_SDBM_File_sdbm_error, file); - newXSUB("SDBM_File::clearerr", 0, XS_SDBM_File_sdbm_clearerr, file); -} diff --git a/Todo b/Todo index 6e75f7e..a71e3ff 100755 --- a/Todo +++ b/Todo @@ -1,6 +1,6 @@ -Modules - POSIX (in progress) +Modules needed X/Motif/Tk etc. + Curses Tie Modules VecArray Implement array using vec() @@ -8,34 +8,18 @@ Tie Modules VirtualArray Implement array using a file ShiftSplice Defines shift et al in terms of splice method -Bugs - Make yyparse recursion longjmp() proof. - Make "delete $array{$key} while ($key) = each %array" safe - <$handle> doesn't work intuitively if $handle is ARGV - Anything in the Bugs directory - -Regexp extensions - /m for multiline - /\Afoo/ (beginning of string, or where previous g match left off) - /foo\Z/ (end of string only) - negative regexp assertions? - /<>/x for grouping? - /f for fixed variable interpolation? - Rewrite regexp parser for better integrated optimization - Would be nice to have Profiler pack "(stuff)*" Contiguous bitfields in pack/unpack lexperl Bundled perl preprocessor - Make $[ compile-time instead of run-time Use posix calls internally where possible const variables gettimeofday bytecompiler format BOTTOM - willcall() + $obj->can("method") to probe method inheritance -iprefix. -i rename file only when successfully changed All ARGV input should act like <> @@ -44,30 +28,33 @@ Would be nice to have report HANDLE [formats]. tie(FILEHANDLE, ...) __DATA__ + support in perlmain to rerun debugger + make 'r' print return value like gdb 'fini' -Possible averments +Possible pragmas debugger - optimize + optimize (use less memory, CPU) Optimizations - Optimize switch statements - Optimize foreach on array - Optimize foreach (1..1000000) + constant function cache + switch structures + foreach(@array) + foreach (1..1000000) + foreach(reverse...) Set KEEP on constant split Cache eval tree (unless lexical outer scope used (mark in &compiling?)) rcatmaybe Shrink opcode tables via multiple implementations selected in peep - Cache hash value? + Cache hash value? (Not a win, according to Guido) Optimize away @_ where possible sfio? "one pass" global destruction Optimize sort by { $a <=> $b } + Rewrite regexp parser for better integrated optimization -Need to think more about +Vague possibilities ref function in list context Populate %SIG at startup if appropriate - -Vague possibilities sub mysplice(@, $, $, ...) data prettyprint function? (or is it, as I suspect, a lib routine?) Nested destructors @@ -82,3 +69,7 @@ Vague possibilities structured types paren counting in tokener to queue remote expectations autocroak? + Modifiable $1 et al + substr EXPR,OFFSET,LENGTH,STRING + locally capture warnings into an array + diff --git a/U/Extensions.U b/U/Extensions.U deleted file mode 100644 index ec14205..0000000 --- a/U/Extensions.U +++ /dev/null @@ -1,71 +0,0 @@ -?RCS: $Id: Extensions.U,v$ -?RCS: -?RCS: You may redistribute only under the terms of the Artistic Licence, -?RCS: as specified in the README file that comes with the distribution. -?RCS: You may reuse parts of this distribution only within the terms of -?RCS: that same Artistic Licence; a copy of which may be found at the root -?RCS: of the source tree for dist 3.0. -?RCS: -?RCS: $Log: Extensions.U,v $ -?RCS: -?MAKE:extensions : find Myread i_dbm i_ndbm i_gdbm i_sdbm -?MAKE: -pick add $@ %< -?S:extensions: -?S: This variable holds a list of extension files we want to -?S: include in perl. -?S:. -?T:xxx -?INIT:: List of extensions we want: -?INIT:extensions='' -?X: -case "$extensions" in -' '|'') echo "Looking for extensions..." - case "$find" in - *find*) - cd .. - extensions=`$find ext -type f -name \*.xs -print` - set X $extensions - shift - extensions="$*" - cd UU - ;; - *) extensions='ext/dbm/NDBM_File.xs ext/dbm/ODBM_File.xs ext/dbm/GDBM_File.xs ext/dbm/SDBM_File.xs ext/posix/POSIX.xs' - ;; - esac - ;; -none) extensions='' ;; -*) ;; -esac -: Now see which are supported on this system. -dflt="" -for xxx in $extensions ; do - case "$xxx" in - *ODBM*) case "$i_dbm" in - define) dflt="$dflt $xxx" ;; - *) ;; - esac - ;; - *NDBM*) case "$i_ndbm" in - define) dflt="$dflt $xxx" ;; - *) ;; - esac - ;; - *GDBM*) case "$i_gdbm" in - define) dflt="$dflt $xxx" ;; - *) ;; - esac - ;; - *SDBM*) case "$i_sdbm" in - define) dflt="$dflt $xxx" ;; - *) ;; - esac - ;; - *) dflt="$dflt $xxx" - ;; - esac -done - -rp="What extensions do you wish to include?" -. ./myread -extensions="$ans" - diff --git a/U/Guess.U b/U/Guess.U deleted file mode 100644 index c7566db..0000000 --- a/U/Guess.U +++ /dev/null @@ -1,153 +0,0 @@ -?RCS: $Id: Guess.U,v 3.0.1.3 1993/12/15 08:14:35 ram Exp $ -?RCS: -?RCS: Copyright (c) 1991-1993, Raphael Manfredi -?RCS: -?RCS: You may redistribute only under the terms of the Artistic Licence, -?RCS: as specified in the README file that comes with the distribution. -?RCS: You may reuse parts of this distribution only within the terms of -?RCS: that same Artistic Licence; a copy of which may be found at the root -?RCS: of the source tree for dist 3.0. -?RCS: -?RCS: $Log: Guess.U,v $ -?RCS: Revision 3.0.1.3 1993/12/15 08:14:35 ram -?RCS: patch15: variable d_bsd was not always set properly -?RCS: -?RCS: Revision 3.0.1.2 1993/08/30 08:57:14 ram -?RCS: patch8: fixed comment which wrongly attributed the usrinc symbol -?RCS: patch8: no more ugly messages when no /usr/include/ctype.h -?RCS: -?RCS: Revision 3.0.1.1 1993/08/27 14:37:37 ram -?RCS: patch7: added support for OSF/1 machines -?RCS: -?RCS: Revision 3.0 1993/08/18 12:04:57 ram -?RCS: Baseline for dist 3.0 netwide release. -?RCS: -?X: -?X: This unit hazards some guesses as to what the general nature of the system -?X: is. The information it collects here is used primarily to establish default -?X: answers to other questions. -?X: -?MAKE:Guess d_eunice d_xenix: cat test echo n c contains rm Loc eunicefix -?MAKE: -pick add $@ %< -?S:d_eunice: -?S: This variable conditionally defines the symbols EUNICE and VAX, which -?S: alerts the C program that it must deal with ideosyncracies of VMS. -?S:. -?S:d_xenix: -?S: This variable conditionally defines the symbol XENIX, which alerts -?S: the C program that it runs under Xenix. -?S:. -?X:We don't use BSD in the source. It's too vague, and often defined -?X:in header files anyway (e.g. NetBSD). -?X:?S:d_bsd: -?X:?S: This symbol conditionally defines the symbol BSD when running on a -?X:?S: BSD system. -?X:?S:. -?C:EUNICE: -?C: This symbol, if defined, indicates that the program is being compiled -?C: under the EUNICE package under VMS. The program will need to handle -?C: things like files that don't go away the first time you unlink them, -?C: due to version numbering. It will also need to compensate for lack -?C: of a respectable link() command. -?C:. -?C:VMS: -?C: This symbol, if defined, indicates that the program is running under -?C: VMS. It is currently only set in conjunction with the EUNICE symbol. -?C:. -?C:XENIX: -?C: This symbol, if defined, indicates thet the program is running under -?C: Xenix (at least 3.0 ?). -?C:. -?X:We don't use BSD in the source. It's too vague. -?X:?C:BSD: -?X:?C: This symbol, if defined, indicates that the program is running under -?X:?C: a BSD system. -?X:?C:. -?H:#$d_eunice EUNICE /**/ -?H:#$d_eunice VMS /**/ -?H:#$d_xenix XENIX /**/ -?X:?H:#$d_bsd BSD /**/ -?H:. -?T:xxx -: make some quick guesses about what we are up against -echo " " -$echo $n "Hmm... $c" -echo exit 1 >bsd -echo exit 1 >usg -echo exit 1 >v7 -echo exit 1 >osf1 -echo exit 1 >eunice -echo exit 1 >xenix -echo exit 1 >venix -?X: -?X: Do not use 'usrinc', or we get a circular dependency. because -?X: usrinc is defined in usrinc.U, which relies on us... -?X: -$cat /usr/include/signal.h /usr/include/sys/signal.h >foo 2>/dev/null -if test -f /osf_boot || $contains 'OSF/1' /usr/include/ctype.h >/dev/null 2>&1 -then - echo "Looks kind of like an OSF/1 system, but we'll see..." - echo exit 0 >osf1 -elif test `echo abc | tr a-z A-Z` = Abc ; then - xxx=`./loc addbib blurfl $pth` - if $test -f $xxx; then - echo "Looks kind of like a USG system with BSD features, but we'll see..." - echo exit 0 >bsd - echo exit 0 >usg - else - if $contains SIGTSTP foo >/dev/null 2>&1 ; then - echo "Looks kind of like an extended USG system, but we'll see..." - else - echo "Looks kind of like a USG system, but we'll see..." - fi - echo exit 0 >usg - fi -elif $contains SIGTSTP foo >/dev/null 2>&1 ; then - echo "Looks kind of like a BSD system, but we'll see..." - echo exit 0 >bsd -else - echo "Looks kind of like a Version 7 system, but we'll see..." - echo exit 0 >v7 -fi -case "$eunicefix" in -*unixtovms*) - $cat <<'EOI' -There is, however, a strange, musty smell in the air that reminds me of -something...hmm...yes...I've got it...there's a VMS nearby, or I'm a Blit. -EOI - echo exit 0 >eunice - d_eunice="$define" -: it so happens the Eunice I know will not run shell scripts in Unix format - ;; -*) - echo " " - echo "Congratulations. You aren't running Eunice." - d_eunice="$undef" - ;; -esac -if test -f /xenix; then - echo "Actually, this looks more like a XENIX system..." - echo exit 0 >xenix - d_xenix="$define" -else - echo " " - echo "It's not Xenix..." - d_xenix="$undef" -fi -chmod +x xenix -$eunicefix xenix -if test -f /venix; then - echo "Actually, this looks more like a VENIX system..." - echo exit 0 >venix -else - echo " " - if xenix; then - : null - else - echo "Nor is it Venix..." - fi -fi -chmod +x bsd usg v7 osf1 eunice xenix venix -$eunicefix bsd usg v7 osf1 eunice xenix venix -$rm -f foo - diff --git a/U/Loc.U b/U/Loc.U deleted file mode 100644 index fcb7a64..0000000 --- a/U/Loc.U +++ /dev/null @@ -1,252 +0,0 @@ -?RCS: $Id: Loc.U,v 3.0.1.3 1994/01/24 14:01:44 ram Exp $ -?RCS: -?RCS: Copyright (c) 1991-1993, Raphael Manfredi -?RCS: -?RCS: You may redistribute only under the terms of the Artistic Licence, -?RCS: as specified in the README file that comes with the distribution. -?RCS: You may reuse parts of this distribution only within the terms of -?RCS: that same Artistic Licence; a copy of which may be found at the root -?RCS: of the source tree for dist 3.0. -?RCS: $Log: Loc.U,v $ -?RCS: Revision 3.0.1.3 1994/01/24 14:01:44 ram -?RCS: patch16: added metalint hint on changed PATH variable -?RCS: -?RCS: Revision 3.0.1.2 1993/12/15 08:16:52 ram -?RCS: patch15: now set _test variable when test is built-in -?RCS: patch15: fixed rare cases where echo is not needed -?RCS: -?RCS: Revision 3.0.1.1 1993/09/13 15:47:13 ram -?RCS: patch10: test program not always in /bin/test (WAD) -?RCS: -?RCS: Revision 3.0 1993/08/18 12:05:05 ram -?RCS: Baseline for dist 3.0 netwide release. -?RCS: -?X: -?X: This unit produces a shell script "loc" which can be used to find out -?X: where in a list of directories something is. It then uses loc to -?X: determine the location of commonly used programs. It leaves loc sitting -?X: around for other Configure units to use, but arranges for its demise -?X: at the end of Configure. -?X: -?X: To add a new program to find, add it both to the ?MAKE: line and to either -?X: the loclist or trylist variable. -?X: -?X: I put startsh at the end of the dependency list, in order to avoid the -?X: loading of the spitshell unit before the instructions. -?X: -?MAKE:Loc Mcc awk bash bison byacc cat chgrp chmod chown compress cp cpio \ - cpp csh date echo egrep emacs expr find flex gcc grep inews ksh \ - less line lint ln lp lpr ls mail mailx make mkdir more mv nroff \ - perl pg pmake pr rm rmail sed sendmail sh shar sleep smail sort \ - submit tail tar tbl test touch tr troff uname uniq uuname vi \ - zcat: eunicefix n c Instruct Myread startsh -?MAKE: -pick weed $@ %< -?LINT:describe Loc Mcc awk bash bison byacc cat chgrp chmod chown compress \ - cp cpio cpp csh date echo egrep emacs expr find flex gcc grep \ - inews ksh less line lint ln lp lpr ls mail mailx make mkdir more \ - mv nroff perl pg pmake pr rm rmail sed sendmail sh shar sleep \ - smail sort submit tail tar tbl test touch tr troff uname uniq \ - uuname vi zcat -?V::pth loclist trylist -?T:thing xxx dir file say _test -?LINT:change PATH -: find out where common programs are -echo " " -echo "Locating common programs..." >&4 -cat <loc -$startsh -case \$# in -0) exit 1;; -esac -thing=\$1 -shift -dflt=\$1 -shift -for dir in \$*; do - case "\$thing" in - .) - if test -d \$dir/\$thing; then - echo \$dir - exit 0 - fi - ;; - *) - if test -f \$dir/\$thing; then - echo \$dir/\$thing - exit 0 - elif test -f \$dir/\$thing.exe; then - : on Eunice apparently - echo \$dir/\$thing - exit 0 - fi - ;; - esac -done -echo \$dflt -exit 1 -EOSC -chmod +x loc -$eunicefix loc -loclist=" -?awk:awk -?cat:cat -?chgrp:chgrp -?chmod:chmod -?chown:chown -?cp:cp -?echo:echo -?expr:expr -?grep:grep -?ln:ln -?ls:ls -?make:make -?mkdir:mkdir -?mv:mv -?rm:rm -?sed:sed -?sleep:sleep -?sort:sort -?tail:tail -?touch:touch -?tr:tr -?uniq:uniq -" -trylist=" -?Mcc:Mcc -?bash:bash -?bison:bison -?byacc:byacc -?compress:compress -?cpio:cpio -?cpp:cpp -?csh:csh -?date:date -?egrep:egrep -?emacs:emacs -?find:find -?flex:flex -?gcc:gcc -?inews:inews -?ksh:ksh -?less:less -?line:line -?lint:lint -?lp:lp -?lpr:lpr -?mail:mail -?mailx:mailx -?more:more -?nroff:nroff -?perl:perl -?pg:pg -?pmake:pmake -?pr:pr -?rmail:rmail -?sendmail:sendmail -?sh:sh -?shar:shar -?smail:smail -?submit:submit -?tar:tar -?tbl:tbl -?test:test -?troff:troff -?uname:uname -?uuname:uuname -?vi:vi -?zcat:zcat -" -?LINT:set Loc Mcc awk bash bison byacc cat chgrp chmod chown compress cp \ - cpio cpp csh date echo egrep emacs expr find flex gcc grep inews \ - ksh less line lint ln lp lpr ls mail mailx make mkdir more mv \ - nroff perl pg pmake pr rm rmail sed sendmail sh shar sleep \ - smail sort submit tail tar tbl test touch tr troff uname uniq \ - uuname vi zcat -pth=`echo $PATH | sed -e 's/:/ /g'` -pth="$pth /lib /usr/lib" -for file in $loclist; do - xxx=`./loc $file $file $pth` - eval $file=$xxx - eval _$file=$xxx - case "$xxx" in - /*) - echo $file is in $xxx. - ;; - *) - echo "I don't know where $file is. I hope it's in everyone's PATH." - ;; - esac -done -echo " " -echo "Don't worry if any of the following aren't found..." -say=offhand -for file in $trylist; do - xxx=`./loc $file $file $pth` - eval $file=$xxx - eval _$file=$xxx - case "$xxx" in - /*) - echo $file is in $xxx. - ;; - *) - echo "I don't see $file out there, $say." - say=either - ;; - esac -done -case "$egrep" in -egrep) - echo "Substituting grep for egrep." - egrep=$grep - ;; -esac -case "$test" in -test) - echo "Hopefully test is built into your sh." - ;; -*) - if sh -c "PATH= test true" >/dev/null 2>&1; then - echo "Using the test built into your sh." -?X: -?X: We need to set both test and _test, since Oldconfig.U will use the _test -?X: value to systematically restore computed paths, which may be wrong if -?X: we choose to load an old config.sh generated on another platform. -?X: - test=test - _test=test - fi - ;; -esac -?LINT:change n c -case "$echo" in -echo) - echo "Hopefully echo is built into your sh." - ;; -?X: For those rare cases where we don't need $echo... -'') ;; -*) - echo " " -echo "Checking compatibility between $echo and builtin echo (if any)..." >&4 - $echo $n "hi there$c" >foo1 - echo $n "hi there$c" >foo2 - if cmp foo1 foo2 >/dev/null 2>&1; then - echo "They are compatible. In fact, they may be identical." - else - case "$n" in - '-n') n='' c='\c';; - *) n='-n' c='';; - esac - cat <$c" - $echo "*" - fi - $rm -f foo1 foo2 - ;; -esac - diff --git a/U/Oldconfig.U b/U/Oldconfig.U deleted file mode 100644 index 2b6d3a0..0000000 --- a/U/Oldconfig.U +++ /dev/null @@ -1,369 +0,0 @@ -?RCS: $Id: Oldconfig.U,v 3.0.1.2 1994/01/24 14:05:02 ram Exp $ -?RCS: -?RCS: Copyright (c) 1991-1993, Raphael Manfredi -?RCS: -?RCS: You may redistribute only under the terms of the Artistic Licence, -?RCS: as specified in the README file that comes with the distribution. -?RCS: You may reuse parts of this distribution only within the terms of -?RCS: that same Artistic Licence; a copy of which may be found at the root -?RCS: of the source tree for dist 3.0. -?RCS: -?RCS: $Log: Oldconfig.U,v $ -?RCS: Revision 3.0.1.2 1994/01/24 14:05:02 ram -?RCS: patch16: added post-processing on myuname for Xenix targets -?RCS: patch16: message proposing config.sh defaults made consistent -?RCS: -?RCS: Revision 3.0.1.1 1993/09/13 15:56:32 ram -?RCS: patch10: force use of config.sh when -d option is used (WAD) -?RCS: patch10: complain about non-existent hint files (WAD) -?RCS: patch10: added Options dependency for fastread variable -?RCS: -?RCS: Revision 3.0 1993/08/18 12:05:12 ram -?RCS: Baseline for dist 3.0 netwide release. -?RCS: -?X: -?X: This unit tries to remember what we did last time we ran Configure, mostly -?X: for the sake of setting defaults. -?X: -?MAKE:Oldconfig hint myuname osname osvers: Instruct Myread uname \ - sed test cat rm n c contains Loc Options -?MAKE: -pick wipe $@ %< -?S:myuname: -?S: The output of 'uname -a' if available, otherwise the hostname. On Xenix, -?S: pseudo variables assignments in the output are stripped, thank you. The -?S: whole thing is then lower-cased. -?S:. -?S:hint: -?S: Gives the type of hints used for previous answers. May be one of -?S: "default", "recommended" or "previous". -?S:. -?S:osname: -?S: This variable contains the operating system name (e.g. sunos, -?S: solaris, hpux, etc.). It can be useful later on for setting -?S: defaults. It is set to '' if we can't figure it out. -?S:. -?S:osvers: -?S: This variable contains the operating system version (e.g. -?S: 4.1.3, 5.2, etc.). It is primarily used for helping select -?S: an appropriate hints file, but might be useful elsewhere for -?S: setting defaults. It is set to '' if we can't figure it out. -?S:. -?T:tmp file oldmyuname hintfile tans _ -?LINT:change n c -: Try to determine whether config.sh was made on this system -case "$config_sh" in -'') -?X: indentation wrong on purpose--RAM -?X: Leave a white space between first two '(' for ksh. The sub-shell is needed -?X: on some machines to avoid the error message when uname is not found; e.g. -?X: old SUN-OS 3.2 would not execute hostname in (uname -a || hostname). Sigh! -myuname=`( ($uname -a) 2>/dev/null || hostname) 2>&1` -?X: Special mention for Xenix, whose 'uname -a' gives us output like this: -?X: sysname=XENIX -?X: nodename=whatever -?X: release=2.3.2 .. etc... -?X: Therefore, we strip all this variable assignment junk and remove all the -?X: new lines to keep the myuname variable sane... --RAM -myuname=`echo $myuname | $sed -e 's/^[^=]*=//' | \ - tr '[A-Z]' '[a-z]' | tr '\012' ' '` -dflt=n -if test "$fastread" = yes; then - dflt=y -elif test -f ../config.sh; then -?X: The value from config.sh will superseed the one we've just computed -?X: ... but not if we choose to ignore config.sh, so eval oldmyuname here. - oldmyuname='' - if $contains myuname= ../config.sh >/dev/null 2>&1; then - eval "old`grep myuname= ../config.sh`" - fi - if test "X$myuname" = "X$oldmyuname"; then - dflt=y - fi -fi - -@if {test -d ../hints} -: Get old answers from old config file if Configure was run on the -: same system, otherwise use the hints. -hint=default -cd .. -if test -f config.sh; then - echo " " - rp="I see a config.sh file. Shall I use it to set the defaults?" - . UU/myread - case "$ans" in - n*|N*) echo "OK, I'll ignore it."; mv config.sh config.sh.old;; - *) echo "Fetching default answers from your old config.sh file..." >&4 - tmp="$n" - tans="$c" - . ./config.sh - cp config.sh UU - n="$tmp" - c="$tans" - hint=previous - ;; - esac -fi -if test ! -f config.sh; then - $cat <&4 - dflt='' - : Half the following guesses are probably wrong... If you have better - : tests or hints, please send them to - : The metaconfig authors would also appreciate a copy... - $test -f /irix && osname=sgi - $test -f /xenix && osname=sco_xenix - $test -f /dynix && osname=dynix - $test -f /dnix && osname=dnix - $test -f /bin/mips && /bin/mips && osname=mips - $test -d /NextApps && test -f /usr/adm/software_version && osname=next - $test -d /usr/include/minix && osname=minix -?X: If we have uname, we already computed a suitable uname -a output, correctly -?X: formatted for Xenix, and it lies in $myuname. - if $test -f $uname; then - set X $myuname - shift - - $test -f $5.sh && dflt="$dflt $5" - - case "$5" in - fps*) osname=fps ;; - mips*) - case "$4" in - umips) osname=umips ;; - *) osname=mips ;; - esac;; - [23]100) osname=mips ;; - next*) osname=next ;; - news*) osname=news ;; - i386*) if $test -f /etc/kconfig; then - osname=isc - if $contains _SYSV3 /usr/include/stdio.h > /dev/null 2>&1 ; then - osvers=3.2.3 - elif $contains _POSIX_SOURCE /usr/include/stdio.h > /dev/null 2>&1 ; then - osvers=3.2.2 - fi - fi - ;; - esac - - case "$1" in - aix) osname=aix_rs ;; - sunos) osname=sunos - case "$3" in - [34]*) osvers=$3 ;; - 5*) osname=solaris - osvers=`echo $3 | $sed 's/^5/2/g'` ;; - esac - ;; - solaris) osname=solaris - case "$3" in - 5*) osvers=`echo $3 | $sed 's/^5/2/g'` ;; - esac - ;; - dnix) osname=dnix ;; - dgux) osname=dgux ;; - genix) osname=genix ;; - hp*ux) osname=hpux ;; - next) osname=next ;; - irix) osname=sgi ;; - ultrix) osname=ultrix - case "$3" in - 1*) osvers=1 ;; - 2*) osvers=2 ;; - 3*) osvers=3 ;; - 4*) osvers=4 ;; - esac - ;; - osf1) case "$5" in - alpha) osname=dec_osf - case "$3" in - [vt]1\.*) osvers=1 ;; - [vt]2\.*) osvers=2 ;; - [vt]3\.*) osvers=3 ;; - esac - ;; - hp*) osname=hp_osf1 ;; # TR - mips) osname=mips_osf1 ;; # TR - # TR = Technology Releases: (un^N)supported - esac - ;; - uts) osname=uts ;; - $2) case "$osname" in - *isc*) ;; - *) if test -f /etc/systemid; then - osname=sco - : Does anyone know if these next gyrations are needed - set `echo $3 | $sed 's/\./ /g'` $4 - if $test -f sco_$1_$2_$3.sh; then - osvers=$1.$2.$3 - elif $test -f sco_$1_$2.sh; then - osvers=$1.$2 - elif $test -f sco_$1.sh; then - osvers=$1 - fi - fi - ;; - esac - ;; - esac - else -?X: Try to identify sony's NEWS-OS (BSD unix) - if test -f /vmunix -a -f news_os.sh; then - (what /vmunix | tr '[A-Z]' '[a-z]') > ../UU/kernel.what 2>&1 - if $contains news-os ../UU/kernel.what >/dev/null 2>&1; then - osname=news_os - fi - $rm -f ../UU/kernel.what - fi - fi - - : Now look for a hint file osname_osvers - file=`echo "${osname}_${osvers}" | sed -e 's@\.@_@g' -e 's@_$@@'` - case "$file" in - '') dflt=none ;; - *) case "$osvers" in - '') dflt=$file - ;; - *) if $test -f $file.sh ; then - dflt=$file - elif $test -f "${osname}.sh" ; then - dflt="${osname}" - else - dflt=none - fi - ;; - esac - ;; - esac - - $cat <> ../UU/config.sh - elif $test X$tans = X -o X$tans = Xnone ; then - : nothing - else - : Give one chance to correct a possible typo. - echo "$file.sh does not exist" - dflt=$file - rp="hint to use instead?" - . ../UU/myread - for file in $ans; do - if $test -f "$file.sh"; then - . ./$file.sh - $cat $file.sh >> ../UU/config.sh - elif $test X$ans = X -o X$ans = Xnone ; then - : nothing - else - echo "$file.sh does not exist -- ignored." - fi - done - fi - done - - hint=recommended - : Remember our hint file for later. - if $test -f "$file.sh" ; then - hintfile="$file.sh" - else - hintfile=none - fi - - cd .. -fi -cd UU -@else -: Get old answers, if there is a config file out there -hint=default -if test -f ../config.sh; then - echo " " - rp="I see a config.sh file. Shall I use it to set the defaults?" - . ./myread - case "$ans" in - n*|N*) echo "OK, I'll ignore it.";; - *) echo "Fetching default answers from your old config.sh file..." >&4 - tmp="$n" - tans="$c" - . ../config.sh - cp ../config.sh . - n="$tmp" - c="$tans" - hint=previous - ;; - esac -fi -@end -?X: remember, indentation is wrong--RAM -;; -*) - echo " " - echo "Fetching default answers from $config_sh..." >&4 - tmp="$n" - tans="$c" - cd .. -?X: preserve symbolic links, if any - cp $config_sh config.sh 2>/dev/null - . ./config.sh - cd UU - cp ../config.sh . - n="$tmp" - c="$tans" - hint=previous - ;; -esac - -: Restore computed paths -for file in $loclist $trylist; do - eval $file="\$_$file" -done - -cat << EOM -Configure uses the operating system name and version to set some defaults. -Say "none" to leave it blank. -EOM - -case "$osname" in - ''|' ') - case "$hintfile" in - none) dflt=none ;; - *) dflt=`echo $hintfile | sed -e 's/\.sh$//' -e 's/_.*$//'` ;; - esac - ;; - *) dflt="$osname" ;; -esac -rp="Operating system name?" -. ./myread -case "$ans" in - none) osname='' ;; - *) osname="$ans" ;; -esac - -case "$osvers" in - ''|' ') - case "$hintfile" in - none) dflt=none ;; - *) dflt=`echo $hintfile | sed -e 's/\.sh$//' -e 's/^[^_]*//'` - dflt=`echo $dflt | sed -e 's/^_//' -e 's/_/./g'` ;; - esac - ;; - *) dflt="$osvers" ;; -esac -rp="Operating system version?" -. ./myread -case "$ans" in - none) osvers='' ;; - *) osvers="$ans" ;; -esac diff --git a/U/README.U b/U/README.U deleted file mode 100644 index 4d4f964..0000000 --- a/U/README.U +++ /dev/null @@ -1,15 +0,0 @@ -?X: These units are based on the ones supplied with dist-3.0 -?X: patchlevel 22. They have been changed or enhanced to work with -?X: perl5alpha. I would appreciate hearing about any changes, -?X: corrections, or enhancements. -?X: Andy Dougherty doughera@lafcol.lafayette.edu -?X: Dept. of Physics -?X: Lafayette College -?X: Easton, PA 18042-1782 -?X: Sat Apr 2 15:45:17 EST 1994 -?RCS: -?RCS: You may redistribute only under the terms of the Artistic Licence, -?RCS: as specified in the README file that comes with the distribution. -?RCS: You may reuse parts of this distribution only within the terms of -?RCS: that same Artistic Licence; a copy of which may be found at the root -?RCS: of the source tree for dist 3.0, or in the perl distribution. diff --git a/U/alignbytes.U b/U/alignbytes.U deleted file mode 100644 index 3852646..0000000 --- a/U/alignbytes.U +++ /dev/null @@ -1,57 +0,0 @@ -?RCS: $Id: alignbytes.U,v 3.0 1993/08/18 12:05:23 ram Exp $ -?RCS: -?RCS: Copyright (c) 1991-1993, Raphael Manfredi -?RCS: -?RCS: You may redistribute only under the terms of the Artistic Licence, -?RCS: as specified in the README file that comes with the distribution. -?RCS: You may reuse parts of this distribution only within the terms of -?RCS: that same Artistic Licence; a copy of which may be found at the root -?RCS: of the source tree for dist 3.0. -?RCS: -?RCS: $Log: alignbytes.U,v $ -?RCS: Revision 3.0 1993/08/18 12:05:23 ram -?RCS: Baseline for dist 3.0 netwide release. -?RCS: -?MAKE:memalignbytes: Myread cat cc ccflags rm -?MAKE: -pick add $@ %< -?S:memalignbytes: -?S: This variable holds the number of bytes required to align a -?S: double. Usual values are 2, 4 and 8. -?S:. -?X: This used to be called ALIGNBYTES, but that conflicts with -?X: in NetBSD. -?C:MEM_ALIGNBYTES (ALIGNBYTES): -?C: This symbol contains the number of bytes required to align a -?C: double. Usual values are 2, 4 and 8. -?C:. -?H:#define MEM_ALIGNBYTES $memalignbytes /**/ -?H:. -: check for alignment requirements -echo " " -case "$memalignbytes" in -'') echo "Checking alignment constraints..." >&4 - $cat >try.c <<'EOCP' -struct foobar { - char foo; - double bar; -} try; -main() -{ - printf("%d\n", (char *)&try.bar - (char *)&try.foo); -} -EOCP - if $cc $ccflags try.c -o try >/dev/null 2>&1; then - dflt=`./try` - else - dflt='8' - echo"(I can't seem to compile the test program...)" - fi - ;; -*) dflt="$memalignbytes" - ;; -esac -rp="Doubles must be aligned on a how-many-byte boundary?" -. ./myread -memalignbytes="$ans" -$rm -f try.c try - diff --git a/U/cc.U b/U/cc.U deleted file mode 100644 index 0495017..0000000 --- a/U/cc.U +++ /dev/null @@ -1,111 +0,0 @@ -?RCS: $Id: cc.U,v 3.0 1993/08/18 12:05:30 ram Exp $ -?RCS: -?RCS: Copyright (c) 1991-1993, Raphael Manfredi -?RCS: -?RCS: You may redistribute only under the terms of the Artistic Licence, -?RCS: as specified in the README file that comes with the distribution. -?RCS: You may reuse parts of this distribution only within the terms of -?RCS: that same Artistic Licence; a copy of which may be found at the root -?RCS: of the source tree for dist 3.0. -?RCS: -?RCS: $Log: cc.U,v $ -?RCS: Revision 3.0 1993/08/18 12:05:30 ram -?RCS: Baseline for dist 3.0 netwide release. -?RCS: -?MAKE:gccversion cc: cat contains sysman +large cpp rm test \ - Mcc Myread Guess Oldconfig Loc -?MAKE: -pick add $@ %< -?S:cc: -?S: This variable holds the name of a command to execute a C compiler which -?S: can resolve multiple global references that happen to have the same -?S: name. Usual values are "cc", "Mcc", "cc -M", and "gcc". -?S:. -?S:gccversion: -?S: If GNU cc (gcc) is used, this variable holds '1' or '2' to -?S: indicate whether the compiler is version 1 or 2. This is used in -?S: setting some of the default cflags. -?S:. -?D:cc='cc' -?INIT:gccversion='' -?LINT:change cpp -: see if we need a special compiler -echo " " -if usg; then - case "$cc" in - '') case "$Mcc" in - /*) dflt='Mcc';; - *) case "$large" in - -M*) dflt='cc';; - *) if $contains '\-M' $sysman/cc.1 >/dev/null 2>&1 ; then - if $contains '\-M' $sysman/cpp.1 >/dev/null 2>&1; then - dflt='cc' - else - dflt='cc -M' - fi - else - dflt='cc' - fi;; - esac;; - esac;; - *) dflt="$cc";; - esac - $cat <<'EOM' -On some systems the default C compiler will not resolve multiple global -references that happen to have the same name. On some such systems the "Mcc" -command may be used to force these to be resolved. On other systems a "cc -M" -command is required. (Note that the -M flag on other systems indicates a -memory model to use!) If you have the Gnu C compiler, you might wish to use -that instead. - -EOM - rp="What command will force resolution on this system?" - . ./myread - cc="$ans" -else - case "$cc" in - '') dflt=cc;; - *) dflt="$cc";; - esac - rp="Use which C compiler?" - . ./myread - cc="$ans" -fi -case "$cc" in -gcc*) echo "Checking out which version of gcc" -$cat >gccvers.c < -int main() -{ -char *v; -v = "unknown"; -#ifdef __GNUC__ -# ifdef __VERSION__ - v = __VERSION__; -# endif -#endif -switch((int) v[0]) - { - case '1': printf("1\n"); break; - case '2': printf("2\n"); break; - case '3': printf("3\n"); break; - default: break; - } -#ifdef __GNUC__ -return 0; -#else -return 1; -#endif -} -EOM - if $cc -o gccvers gccvers.c >/dev/null 2>&1; then - gccversion=`./gccvers` - echo "You appear to have version $gccversion." - else - echo "Doesn't appear to be GNU cc." - fi - $rm -f gccvers* - if $test "$gccversion" = '1'; then - cpp=`./loc gcc-cpp $cpp $pth` - fi - ;; -esac diff --git a/U/ccflags.U b/U/ccflags.U deleted file mode 100644 index 1b9bf39..0000000 --- a/U/ccflags.U +++ /dev/null @@ -1,236 +0,0 @@ -?RCS: $Id: ccflags.U,v 3.0.1.3 1993/09/13 15:58:29 ram Exp $ -?RCS: -?RCS: Copyright (c) 1991-1993, Raphael Manfredi -?RCS: -?RCS: You may redistribute only under the terms of the Artistic Licence, -?RCS: as specified in the README file that comes with the distribution. -?RCS: You may reuse parts of this distribution only within the terms of -?RCS: that same Artistic Licence; a copy of which may be found at the root -?RCS: of the source tree for dist 3.0. -?RCS: -?RCS: $Log: ccflags.U,v $ -?RCS: Revision 3.0.1.3 1993/09/13 15:58:29 ram -?RCS: patch10: explicitely mention -DDEBUG just in case they need it (WAD) -?RCS: patch10: removed all the "tans" variable usage (WAD) -?RCS: -?RCS: Revision 3.0.1.2 1993/08/27 14:39:38 ram -?RCS: patch7: added support for OSF/1 machines -?RCS: -?RCS: Revision 3.0.1.1 1993/08/25 14:00:24 ram -?RCS: patch6: added defaults for cppflags, ccflags and ldflags -?RCS: -?RCS: Revision 3.0 1993/08/18 12:05:31 ram -?RCS: Baseline for dist 3.0 netwide release. -?RCS: -?MAKE:ccflags ldflags lkflags cppflags optimize: test cat Myread Guess \ - Oldconfig cc gccversion mips_type +usrinc package contains -?MAKE: -pick add $@ %< -?S:ccflags: -?S: This variable contains any additional C compiler flags desired by -?S: the user. It is up to the Makefile to use this. -?S:. -?S:cppflags: -?S: This variable holds the flags that will be passed to the C pre- -?S: processor. It is up to the Makefile to use it. -?S:. -?S:optimize: -?S: This variable contains any optimizer/debugger flag that should be used. -?S: It is up to the Makefile to use it. -?S:. -?S:ldflags: -?S: This variable contains any additional C loader flags desired by -?S: the user. It is up to the Makefile to use this. -?S:. -?S:lkflags: -?S: This variable contains any additional C partial linker flags desired by -?S: the user. It is up to the Makefile to use this. -?S:. -?T:inctest thisincl xxx flag inclwanted -?D:cppflags='' -?D:ccflags='' -?D:ldflags='' -?INIT:: no include file wanted by default -?INIT:inclwanted='' -?INIT: -: determine optimize, if desired, or use for debug flag also -case "$optimize" in -' ') dflt="none";; -'') dflt="-g";; -*) dflt="$optimize";; -esac -$cat </dev/null 2>&1 - then - dflt="$dflt -posix" - fi - ;; - esac - ;; -esac - -?X: In USG mode, a MIPS system may need some BSD includes -case "$mips_type" in -*BSD*) ;; -'') ;; -*) inclwanted="$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 -done - -?X: Include test function (header, symbol) -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' - -?X: -?X: SCO unix uses NO_PROTOTYPE instead of _NO_PROTO -?X: OSF/1 uses __LANGUAGE_C__ instead of LANGUAGE_C -?X: -if ./osf1; then - set signal.h __LANGUAGE_C__; eval $inctest -else - set signal.h LANGUAGE_C; eval $inctest -fi -set signal.h NO_PROTOTYPE; eval $inctest -set signal.h _NO_PROTO; eval $inctest - -case "$dflt" in -'') dflt=none;; -esac -case "$ccflags" in -'') ;; -*) dflt="$ccflags";; -esac -$cat <&4 -if $test "$intsize" -eq 4; then - xxx=int -else - xxx=long -fi - -$cat >try.c < -#include -blech() { exit(3); } -main() -{ - $xxx i32; - double f; - int result = 0; - signal(SIGFPE, blech); - - f = (double) 0x7fffffff; - f = 10 * f; - i32 = ( $xxx )f; - - if (i32 != ( $xxx )f) - result |= 1; - exit(result); -} -EOCP -if $cc -o try $ccflags try.c >/dev/null 2>&1; then - ./try - yyy=$? -else - yyy=1 -fi -case "$yyy" in -0) val="$define" - echo "Yup, it can." - ;; -*) val="$undef" - echo "Nope, it can't." - ;; -esac -set d_casti32 -eval $setvar -$rm -f try try.* diff --git a/U/d_htonl.U b/U/d_htonl.U deleted file mode 100644 index 0cb1647..0000000 --- a/U/d_htonl.U +++ /dev/null @@ -1,76 +0,0 @@ -?RCS: $Id: d_htonl.U,v 3.0 1993/08/18 12:06:22 ram Exp $ -?RCS: -?RCS: Copyright (c) 1991-1993, Raphael Manfredi -?RCS: -?RCS: You may redistribute only under the terms of the Artistic Licence, -?RCS: as specified in the README file that comes with the distribution. -?RCS: You may reuse parts of this distribution only within the terms of -?RCS: that same Artistic Licence; a copy of which may be found at the root -?RCS: of the source tree for dist 3.0. -?RCS: -?RCS: $Log: d_htonl.U,v $ -?RCS: Revision 3.0 1993/08/18 12:06:22 ram -?RCS: Baseline for dist 3.0 netwide release. -?RCS: -?MAKE:d_htonl: cc ccflags Inlibc i_niin i_sysin rm -?MAKE: -pick add $@ %< -?S:d_htonl: -?S: This variable conditionally defines HAS_HTONL if htonl() and its -?S: friends are available to do network order byte swapping. -?S:. -?C:HAS_HTONL (HTONL): -?C: This symbol, if defined, indicates that the htonl() routine (and -?C: friends htons() ntohl() ntohs()) are available to do network -?C: order byte swapping. -?C:. -?C:HAS_HTONS (HTONS): -?C: This symbol, if defined, indicates that the htons() routine (and -?C: friends htonl() ntohl() ntohs()) are available to do network -?C: order byte swapping. -?C:. -?C:HAS_NTOHL (NTOHL): -?C: This symbol, if defined, indicates that the ntohl() routine (and -?C: friends htonl() htons() ntohs()) are available to do network -?C: order byte swapping. -?C:. -?C:HAS_NTOHS (NTOHS): -?C: This symbol, if defined, indicates that the ntohs() routine (and -?C: friends htonl() htons() ntohl()) are available to do network -?C: order byte swapping. -?C:. -?H:#$d_htonl HAS_HTONL /**/ -?H:#$d_htonl HAS_HTONS /**/ -?H:#$d_htonl HAS_NTOHL /**/ -?H:#$d_htonl HAS_NTOHS /**/ -?H:. -?LINT:set d_htonl -: see if htonl --and friends-- exists -set htonl d_htonl -eval $inlibc -: Maybe they are macros. -case "$d_htonl" in -'define') ;; -*) cat > try.c < -#include -#$i_niin I_NETINET_IN -#$i_sysin I_SYS_IN -#ifdef I_NETINET_IN -# include -#endif -#ifdef I_SYS_IN -# include -#endif -int main() -{ - int x; - printf("x = ", htonl(7)); -} -EOM - if $cc $ccflags -c try.c >/dev/null 2>&1; then - d_htonl="$define" - echo "But it seems to be defined as a macro." - fi - $rm -f try.* try - ;; -esac diff --git a/U/d_isascii.U b/U/d_isascii.U deleted file mode 100644 index 70fba19..0000000 --- a/U/d_isascii.U +++ /dev/null @@ -1,50 +0,0 @@ -?RCS: $Id: d_isascii.U,v 3.0 1993/08/18 12:06:44 ram Exp $ -?RCS: -?RCS: Copyright (c) 1991-1993, Raphael Manfredi -?RCS: -?RCS: You may redistribute only under the terms of the Artistic Licence, -?RCS: as specified in the README file that comes with the distribution. -?RCS: You may reuse parts of this distribution only within the terms of -?RCS: that same Artistic Licence; a copy of which may be found at the root -?RCS: of the source tree for dist 3.0. -?RCS: -?RCS: $Log: d_isascii.U,v $ -?RCS: Revision 3.0 1993/08/18 12:06:44 ram -?RCS: Baseline for dist 3.0 netwide release. -?RCS: -?MAKE:d_isascii: cc cat cppflags rm Setvar Findhdr -?MAKE: -pick add $@ %< -?S:d_isascii: -?S: This variable conditionally defines the HAS_ISASCII manifest constant, -?S: which indicates to the C program that isascii() is available. -?S:. -?C:HAS_ISASCII (ISASCII): -?C: This manifest constant lets the C program know that the -?C: isascii is available. -?C:. -?H:#$d_isascii HAS_ISASCII /**/ -?H:. -?LINT:set d_isascii -: Look for isascii -echo " " -$cat >isascii.c <<'EOCP' -#include -#include -main() { - int c = 'A'; - if (isascii(c)) - exit(0); - else - exit(1); -} -EOCP -if $cc $cppflags -o isascii isascii.c >/dev/null 2>&1 ; then - echo "isascii() found." - val="$define" -else - echo "isascii() NOT found." - val="$undef" -fi -set d_isascii -eval $setvar -$rm -f isascii* diff --git a/U/d_readdir.U b/U/d_readdir.U deleted file mode 100644 index e9364b4..0000000 --- a/U/d_readdir.U +++ /dev/null @@ -1,70 +0,0 @@ -?RCS: $Id: d_readdir.U,v 3.0 1993/08/18 12:06:52 ram Exp $ -?RCS: -?RCS: Copyright (c) 1991-1993, Raphael Manfredi -?RCS: -?RCS: You may redistribute only under the terms of the Artistic Licence, -?RCS: as specified in the README file that comes with the distribution. -?RCS: You may reuse parts of this distribution only within the terms of -?RCS: that same Artistic Licence; a copy of which may be found at the root -?RCS: of the source tree for dist 3.0. -?RCS: -?RCS: $Log: d_readdir.U,v $ -?RCS: Revision 3.0 1993/08/18 12:06:52 ram -?RCS: Baseline for dist 3.0 netwide release. -?RCS: -?X: Force checking for inclusion -?X:INC: i_dirent -?MAKE:d_readdir d_seekdir d_telldir d_rewinddir: Inlibc -?MAKE: -pick add $@ %< -?S:d_readdir: -?S: This variable conditionally defines HAS_READDIR if readdir() is -?S: available to read directory entries. -?S:. -?C:HAS_READDIR (READDIR): -?C: This symbol, if defined, indicates that the readdir routine is -?C: available to read directory entries. You may have to include -?C: . See I_DIRENT. -?C:. -?H:#$d_readdir HAS_READDIR /**/ -?H:. -?S:d_seekdir: -?S: This variable conditionally defines HAS_SEEKDIR if seekdir() is -?S: available. -?S:. -?C:HAS_SEEKDIR: -?C: This symbol, if defined, indicates that the seekdir routine is -?C: available. You may have to include . See I_DIRENT. -?C:. -?H:#$d_seekdir HAS_SEEKDIR /**/ -?H:. -?S:d_telldir: -?S: This variable conditionally defines HAS_TELLDIR if telldir() is -?S: available. -?S:. -?C:HAS_TELLDIR: -?C: This symbol, if defined, indicates that the telldir routine is -?C: available. You may have to include . See I_DIRENT. -?C:. -?H:#$d_telldir HAS_TELLDIR /**/ -?H:. -?S:d_rewinddir: -?S: This variable conditionally defines HAS_REWINDDIR if rewinddir() is -?S: available. -?S:. -?C:HAS_REWINDDIR: -?C: This symbol, if defined, indicates that the rewinddir routine is -?C: available. You may have to include . See I_DIRENT. -?C:. -?H:#$d_rewinddir HAS_REWINDDIR /**/ -?H:. -?LINT:set d_readdir d_seekdir d_telldir d_rewinddir -: see if readdir and friends exist -set readdir d_readdir -eval $inlibc -set seekdir d_seekdir -eval $inlibc -set telldir d_telldir -eval $inlibc -set rewinddir d_rewinddir -eval $inlibc - diff --git a/U/d_safebcpy.U b/U/d_safebcpy.U deleted file mode 100644 index b7373a0..0000000 --- a/U/d_safebcpy.U +++ /dev/null @@ -1,81 +0,0 @@ -?RCS: $Id: d_safebcpy.U,v 3.0 1993/08/18 12:06:58 ram Exp $ -?RCS: -?RCS: Copyright (c) 1991-1993, Raphael Manfredi -?RCS: -?RCS: You may redistribute only under the terms of the Artistic Licence, -?RCS: as specified in the README file that comes with the distribution. -?RCS: You may reuse parts of this distribution only within the terms of -?RCS: that same Artistic Licence; a copy of which may be found at the root -?RCS: of the source tree for dist 3.0. -?RCS: -?RCS: $Log: d_safebcpy.U,v $ -?RCS: -?RCS: Copy "abcde..." string to char abc[] so that gcc doesn't -?RCS: try to store the string in read-only memory. -?RCS: -?RCS: Revision 3.0 1993/08/18 12:06:58 ram -?RCS: Baseline for dist 3.0 netwide release. -?RCS: -?MAKE:d_safebcpy: cat d_bcopy +cc +ccflags +libs rm Oldconfig Setvar -?MAKE: -pick add $@ %< -?S:d_safebcpy: -?S: This variable conditionally defines the HAS_SAFE_BCOPY symbol if -?S: the bcopy() routine can do overlapping copies. -?S:. -?C:HAS_SAFE_BCOPY (SAFE_BCOPY): -?C: This symbol, if defined, indicates that the bcopy routine is available -?C: to copy potentially overlapping memory blocks. Otherwise you should -?C: probably use memmove() or memcpy(). If neither is defined, roll your -?C: own version. -?C:. -?H:#$d_safebcpy HAS_SAFE_BCOPY /**/ -?H:. -?LINT: set d_safebcpy -: can bcopy handle overlapping blocks? -?X: assume the worst -val="$undef" -case "$d_bcopy" in -"$define") - echo " " - echo "Checking to see if your bcopy() can do overlapping copies..." >&4 - $cat >foo.c <<'EOCP' -main() -{ -char buf[128], abc[128]; -char *b; -int len; -int off; -int align; -bcopy("abcdefghijklmnopqrstuvwxyz0123456789", abc, 36); - -for (align = 7; align >= 0; align--) { - for (len = 36; len; len--) { - b = buf+align; - bcopy(abc, b, len); - for (off = 1; off <= len; off++) { - bcopy(b, b+off, len); - bcopy(b+off, b, len); - if (bcmp(b, abc, len)) - exit(1); - } - } -} -exit(0); -} -EOCP - if $cc foo.c -o safebcpy $ccflags $libs >/dev/null 2>&1 ; then - if ./safebcpy 2>/dev/null; then - echo "Yes, it can." - val="$define" - else - echo "It can't, sorry." - fi - else - echo "(I can't compile the test program, so we'll assume not...)" - fi - ;; -esac -$rm -f foo.* safebcpy core -set d_safebcpy -eval $setvar - diff --git a/U/d_safemcpy.U b/U/d_safemcpy.U deleted file mode 100644 index 2f32680..0000000 --- a/U/d_safemcpy.U +++ /dev/null @@ -1,82 +0,0 @@ -?RCS: $Id: d_safemcpy.U,v 3.0 1993/08/18 12:06:58 ram Exp $ -?RCS: -?RCS: Copyright (c) 1991-1993, Raphael Manfredi -?RCS: -?RCS: You may redistribute only under the terms of the Artistic Licence, -?RCS: as specified in the README file that comes with the distribution. -?RCS: You may reuse parts of this distribution only within the terms of -?RCS: that same Artistic Licence; a copy of which may be found at the root -?RCS: of the source tree for dist 3.0. -?RCS: -?RCS: $Log: d_safemcpy.U,v $ -?RCS: -?RCS: Copy "abcde..." string to char abc[] so that -?RCS: gcc doesn't try to store the string in read-only memory. -?RCS: -?RCS: Revision 3.0 1993/08/18 12:06:58 ram -?RCS: Baseline for dist 3.0 netwide release. -?RCS: -?MAKE:d_safemcpy: cat d_memcpy +cc +ccflags +libs rm Oldconfig Setvar -?MAKE: -pick add $@ %< -?S:d_safemcpy: -?S: This variable conditionally defines the HAS_SAFE_MEMCPY symbol if -?S: the memcpy() routine can do overlapping copies. -?S:. -?C:HAS_SAFE_MEMCPY (SAFE_MEMCPY): -?C: This symbol, if defined, indicates that the memcpy routine is available -?C: to copy potentially overlapping memory blocks. Otherwise you should -?C: probably use memmove() or memcpy(). If neither is defined, roll your -?C: own version. -?C:. -?H:#$d_safemcpy HAS_SAFE_MEMCPY /**/ -?H:. -?LINT: set d_safemcpy -: can memcpy handle overlapping blocks? -?X: assume the worst -val="$undef" -case "$d_memcpy" in -"$define") - echo " " - echo "Checking to see if your memcpy() can do overlapping copies..." >&4 - $cat >foo.c <<'EOCP' -main() -{ -char buf[128], abc[128]; -char *b; -int len; -int off; -int align; - -memcpy(abc, "abcdefghijklmnopqrstuvwxyz0123456789", 36); - -for (align = 7; align >= 0; align--) { - for (len = 36; len; len--) { - b = buf+align; - memcpy(abc, b, len); - for (off = 1; off <= len; off++) { - memcpy(b, b+off, len); - memcpy(b+off, b, len); - if (memcmp(b, abc, len)) - exit(1); - } - } -} -exit(0); -} -EOCP - if $cc foo.c -o safemcpy $ccflags $libs >/dev/null 2>&1 ; then - if ./safemcpy 2>/dev/null; then - echo "Yes, it can." - val="$define" - else - echo "It can't, sorry." - fi - else - echo "(I can't compile the test program, so we'll assume not...)" - fi - ;; -esac -$rm -f foo.* safemcpy core -set d_safemcpy -eval $setvar - diff --git a/U/d_setlocale.U b/U/d_setlocale.U deleted file mode 100644 index 14ce638..0000000 --- a/U/d_setlocale.U +++ /dev/null @@ -1,30 +0,0 @@ -?RCS: $Id: d_setlocale.U,v 3.0 1993/08/18 12:07:36 ram Exp $ -?RCS: -?RCS: Copyright (c) 1991-1993, Raphael Manfredi -?RCS: -?RCS: You may redistribute only under the terms of the Artistic Licence, -?RCS: as specified in the README file that comes with the distribution. -?RCS: You may reuse parts of this distribution only within the terms of -?RCS: that same Artistic Licence; a copy of which may be found at the root -?RCS: of the source tree for dist 3.0. -?RCS: -?RCS: $Log: d_setlocale.U,v $ -?RCS: Revision 3.0 1993/08/18 12:07:36 ram -?RCS: Baseline for dist 3.0 netwide release. -?RCS: -?MAKE:d_setlocale: Inlibc -?MAKE: -pick add $@ %< -?S:d_setlocale: -?S: This variable conditionally defines HAS_SETLOCALE if setlocale() is -?S: available to handle locale-specific ctype implementations. -?S:. -?C:HAS_SETLOCALE: -?C: This symbol, if defined, indicates that the setlocale routine is -?C: available to handle locale-specific ctype implementations. -?C:. -?H:#$d_setlocale HAS_SETLOCALE /**/ -?H:. -?LINT:set d_setlocale -: see if setlocale exists -set setlocale d_setlocale -eval $inlibc diff --git a/U/d_shmat.U b/U/d_shmat.U deleted file mode 100644 index e3f8097..0000000 --- a/U/d_shmat.U +++ /dev/null @@ -1,54 +0,0 @@ -?RCS: $Id: d_shmat.U,v 3.0 1993/08/18 12:07:18 ram Exp $ -?RCS: -?RCS: Copyright (c) 1991-1993, Raphael Manfredi -?RCS: -?RCS: You may redistribute only under the terms of the Artistic Licence, -?RCS: as specified in the README file that comes with the distribution. -?RCS: You may reuse parts of this distribution only within the terms of -?RCS: that same Artistic Licence; a copy of which may be found at the root -?RCS: of the source tree for dist 3.0. -?RCS: -?RCS: $Log: d_shmat.U,v $ -?RCS: Revision 3.0 1993/08/18 12:07:18 ram -?RCS: Baseline for dist 3.0 netwide release. -?RCS: -?MAKE:d_shmat d_voidshmat: Inlibc cppstdin cppflags cppminus usrinc \ - contains -?MAKE: -pick add $@ %< -?S:d_shmat: -?S: This variable conditionally defines the HAS_SHMAT symbol, which -?S: indicates to the C program that the shmat() routine is available. -?S:. -?S:d_voidshmat: -?S: This symbol, if defined, indicates that the shmat() routine -?S: returns a pointer of type void*. Otherwise, char* is assumed. -?S:. -?C:HAS_SHMAT: -?C: This symbol, if defined, indicates that the shmat() routine is -?C: available to attach a shared memory segment to the process space. -?C:. -?H:#$d_shmat HAS_SHMAT /**/ -?H:. -?C:VOIDSHMAT: -?C: This symbol, if defined, indicates that the shmat() routine -?C: returns a pointer of type void*. Otherwise, char* is assumed. -?C:. -?H:#$d_voidshmat VOIDSHMAT /**/ -?H:. -?LINT:set d_shmat d_voidshmat -: see if shmat exists -set shmat d_shmat -eval $inlibc -: see what shmat returns -d_voidshmat="$undef" -case "$d_shmat" in -define) - $cppstdin $cppflags $cppminus < $usrinc/sys/shm.h >voidshmat.txt 2>/dev/null - if $contains "void.*shmat" voidshmat.txt >/dev/null 2>&1; then - echo "and shmat returns (void*)" - d_voidshmat="$define" - else - echo "and shmat returns (char*)" - fi - ;; -esac diff --git a/U/d_strerror.U b/U/d_strerror.U deleted file mode 100644 index 252d9df..0000000 --- a/U/d_strerror.U +++ /dev/null @@ -1,113 +0,0 @@ -?RCS: $Id: d_strerror.U,v 3.0.1.1 1994/01/24 14:08:56 ram Exp $ -?RCS: -?RCS: Copyright (c) 1991-1993, Raphael Manfredi -?RCS: -?RCS: You may redistribute only under the terms of the Artistic Licence, -?RCS: as specified in the README file that comes with the distribution. -?RCS: You may reuse parts of this distribution only within the terms of -?RCS: that same Artistic Licence; a copy of which may be found at the root -?RCS: of the source tree for dist 3.0. -?RCS: -?RCS: $Log: d_strerror.U,v $ -?RCS: Revision 3.0.1.1 1994/01/24 14:08:56 ram -?RCS: patch16: protected code looking for sys_errnolist[] with @if -?RCS: patch16: added default value for d_sysernlst -?RCS: -?RCS: Revision 3.0 1993/08/18 12:07:35 ram -?RCS: Baseline for dist 3.0 netwide release. -?RCS: -?MAKE:d_strerror d_syserrlst d_sysernlst d_strerrm: contains Csym Findhdr -?MAKE: -pick add $@ %< -?S:d_strerror: -?S: This variable conditionally defines HAS_STRERROR if strerror() is -?S: available to translate error numbers to strings. -?S:. -?S:d_syserrlst: -?S: This variable conditionally defines HAS_SYS_ERRLIST if sys_errlist[] is -?S: available to translate error numbers to strings. -?S:. -?S:d_sysernlst: -?S: This variable conditionally defines HAS_SYS_ERRNOLIST if sys_errnolist[] -?S: is available to translate error numbers to the symbolic name. -?S:. -?S:d_strerrm: -?S: This variable conditionally defines strerrr as a macro if the -?S: sys_errlist[] array is defined. -?S:. -?C:HAS_STRERROR (STRERROR): -?C: This symbol, if defined, indicates that the strerror routine is -?C: available to translate error numbers to strings. See the writeup -?C: of Strerror() in this file before you try to define your own. -?C:. -?C:HAS_SYS_ERRLIST (SYSERRLIST): -?C: This symbol, if defined, indicates that the sys_errlist array is -?C: available to translate error numbers to strings. The extern int -?C: sys_nerr gives the size of that table. -?C:. -?C:HAS_SYS_ERRNOLIST (SYSERRNOLIST): -?C: This symbol, if defined, indicates that the sys_errnolist array is -?C: available to translate an errno code into its symbolic name (e.g. -?C: ENOENT). The extern int sys_nerrno gives the size of that table. -?C:. -?C:Strerror: -?C: This preprocessor symbol is defined as a macro if strerror() is -?C: not available to translate error numbers to strings but sys_errlist[] -?C: array is there. -?C:. -?H:#$d_strerror HAS_STRERROR /**/ -?H:#$d_syserrlst HAS_SYS_ERRLIST /**/ -?H:#$d_sysernlst HAS_SYS_ERRNOLIST /**/ -?H:?%<:#ifdef HAS_STRERROR -?H:?%<:# define Strerror strerror -?H:?%<:#else -?H:#$d_strerrm Strerror(e) ((e)<0||(e)>=sys_nerr?"unknown":sys_errlist[e]) /**/ -?H:?%<:#endif -?H:. -?D:d_sysernlst='' -?T:xxx val -: see if strerror and/or sys_errlist[] exist -echo " " -if set strerror val -f d_strerror; eval $csym; $val; then - echo 'strerror() found.' >&4 - d_strerror="$define" - d_strerrm="$undef" - if set sys_errlist val -a d_syserrlst; eval $csym; $val; then - echo "(You also have sys_errlist[], so we could roll our own strerror.)" - d_syserrlst="$define" - else - echo "(Since you don't have sys_errlist[], sterror() is welcome.)" - d_syserrlst="$undef" - fi -elif xxx=`./findhdr string.h`; test "$xxx" || xxx=`./findhdr strings.h`; \ - $contains '#[ ]*define.*strerror' "$xxx" >/dev/null 2>&1; then - echo 'strerror() found in string header.' >&4 - d_strerror="$define" - d_strerrm="$undef" - if set sys_errlist val -a d_syserrlst; eval $csym; $val; then - echo "(Most probably, strerror() uses sys_errlist[] for descriptions.)" - d_syserrlst="$define" - else - echo "(You don't appear to have any sys_errlist[], how can this be?)" - d_syserrlst="$undef" - fi -elif set sys_errlist val -a d_syserrlst; eval $csym; $val; then -echo "strerror() not found, but you have sys_errlist[] so we'll use that." >&4 - d_strerror="$undef" - d_syserrlst="$define" - d_strerrm="$define" -else - echo 'strerror() and sys_errlist[] NOT found.' >&4 - d_strerror="$undef" - d_syserrlst="$undef" - d_strerrm="$undef" -fi -@if d_sysernlst || HAS_SYS_ERRNOLIST -if set sys_errnolist val -a d_sysernlst; eval $csym; $val; then - echo "(Symbolic error codes can be fetched via the sys_errnolist[] array.)" - d_sysernlst="$define" -else - echo "(However, I can't extract the symbolic error code out of errno.)" - d_sysernlst="$undef" -fi -@end - diff --git a/U/d_vfork.U b/U/d_vfork.U deleted file mode 100644 index fb67434..0000000 --- a/U/d_vfork.U +++ /dev/null @@ -1,56 +0,0 @@ -?RCS: $Id: d_vfork.U,v 3.0.1.2 1993/10/16 13:49:39 ram Exp $ -?RCS: -?RCS: Copyright (c) 1991-1993, Raphael Manfredi -?RCS: -?RCS: You may redistribute only under the terms of the Artistic Licence, -?RCS: as specified in the README file that comes with the distribution. -?RCS: You may reuse parts of this distribution only within the terms of -?RCS: that same Artistic Licence; a copy of which may be found at the root -?RCS: of the source tree for dist 3.0. -?RCS: -?RCS: $Log: d_vfork.U,v $ -?RCS: Revision 3.0.1.2 1993/10/16 13:49:39 ram -?RCS: patch12: added magic for vfork() -?RCS: -?RCS: Revision 3.0.1.1 1993/09/13 16:06:57 ram -?RCS: patch10: removed automatic remapping of vfork on fork (WAD) -?RCS: patch10: added compatibility code for older config.sh (WAD) -?RCS: -?RCS: Revision 3.0 1993/08/18 12:07:55 ram -?RCS: Baseline for dist 3.0 netwide release. -?RCS: -?MAKE:d_vfork: Inlibc -?MAKE: -pick add $@ %< -?S:d_vfork: -?S: This variable conditionally defines the HAS_VFORK symbol, which -?S: indicates the vfork() routine is available. -?S:. -?C:HAS_VFORK (VFORK): -?C: This symbol, if defined, indicates that vfork() exists. -?C:. -?H:#$d_vfork HAS_VFORK /**/ -?H:. -?M:vfork: HAS_VFORK -?M:#ifndef HAS_VFORK -?M:#define vfork fork -?M:#endif -?M:. -?LINT:set d_vfork -: see if there is a vfork -set vfork d_vfork -eval $inlibc -: But do we want to use it. vfork is reportedly unreliable in -: perl in Solaris 2.x, and probably elsewhere. -case "$d_vfork" in -define) - dflt='n' - rp="Some systems have problems with vork. Do you want to use it?" - . ./myread - case "$ans" in - y|Y) ;; - *) echo "Ok, we won't use vfork." - d_vfork="$undef" - ;; - esac - ;; -esac diff --git a/U/dlsrc.U b/U/dlsrc.U deleted file mode 100644 index 616818d..0000000 --- a/U/dlsrc.U +++ /dev/null @@ -1,230 +0,0 @@ -?RCS: $Id: dlsrc.U,v$ -?RCS: -?RCS: You may redistribute only under the terms of the Artistic Licence, -?RCS: as specified in the README file that comes with the distribution. -?RCS: You may reuse parts of this distribution only within the terms of -?RCS: that same Artistic Licence; a copy of which may be found at the root -?RCS: of the source tree for dist 3.0. -?RCS: -?RCS: $Log: dlsrc.U,v $ -?RCS: -?X: hpux support thanks to Jeff Okamoto -?X: -?X: To create a shared library, you must compile ALL source files in the -?X: library with +z (or possibly +Z if the library is whopping huge), -?X: then link the library with -b. Example: -?X: cc -c +z module_a.c -?X: cc -c +z module_b.c -?X: ld -b module_a.o module_b.o -o module.sl -?X: -?MAKE:usedl dlsrc dlobj dldir cccdlflags lddlflags ccdlflags \ - shlibsuffix: Getfile Myread test osname sed i_dlfcn Findhdr cc -?MAKE: -pick add $@ %< -?S:usedl: -?S: This variable contains indicates if the the system supports dynamic -?S: loading of some sort. See also dlsrc and dlobj. -?S:. -?S:dlsrc: -?S: This variable contains the name of the dynamic loading file that -?S: will be used with the package. -?S:. -?S:dlobj: -?S: This variable contains the name of the dynamic loading object -?S: file that will be used with the package. This is used in Makefile. -?S:. -?S:dldir: -?S: This variable contains the directory from which to fetch dlsrc. -?S: It is up to the makefile to use it. -?S:. -?S:cccdlflags: -?S: This variable contains any special flags that might need to be -?S: passed with cc -c to compile modules to be used to create a shared -?S: library that will be used for dynamic loading. For hpux, this -?S: should be +z. It is up to the makefile to use it. -?S:. -?S:lddlflags: -?S: This variable contains any special flags that might need to be -?S: passed to ld to create a shared library suitable for dynamic -?S: loading. It is up to the makefile to use it. For hpux, it -?S: should be -b. For sunos 4.1, it is empty. -?S:. -?S:ccdlflags: -?S: This variable contains any special flags that might need to be -?S: passed to cc to link with a shared library for dynamic loading. -?S: It is up to the makefile to use it. For sunos 4.1, it should -?S: be empty. -?S:. -?S:shlibsuffix: -?S: Shared libraries are built by Makefile in the form -?S: lib/auto/xxx/xxx${shsuffix}, where xxx is -?S: the name of the library, e.g. /lib/auto/POSIX/POSIX.so -?S:. -?C:USE_DYNAMIC_LOADING ~ %<: -?C: This symbol, if defined, indicates that dynamic loading of -?C: some sort is available. -?C:. -?H:?%<:#$usedl USE_DYNAMIC_LOADING /**/ -?H:. -?W:%<:dlopen -?INIT:: File to use for dynamic loading -?INIT:usedl='' -?T:xxx -?X: -?X: We select a default of 'define' for usedl if either dl_$osname.c -?X: exists or if i_dlfcn is defined (which probably means dl_sunos.c -?X: will work.) -?X: -: determine which dynamic loading, if any, to compile in -echo " " -case "$usedl" in -'') case "$i_dlfcn" in - define) dflt='y' ;; - *) dflt='n' ;; - esac - : Does a dl.c file exist for this operating system - $test -f ../ext/dl/dl_${osname}.c && dflt='y' - ;; -define|y|true) dflt='y' - usedl="$define" - ;; -*) dflt='n' - ;; -esac -rp="Do you wish to attempt to use dynamic loading?" -. ./myread -usedl="$ans" -case "$ans" in -y*) usedl="$define" - if $test -f ../ext/dl/dl_${osname}.c ; then - dflt="ext/dl/dl_${osname}.c" - else - dflt='ext/dl/dl.c' - fi - echo "The following dynamic loading files are available:" - cd ..; ls -C ext/dl/dl*.c; cd UU - rp="Source file to use for dynamic loading" - fn="fne~" - . ./getfile - : emulate basename and dirname - xxx=`echo $ans | $sed -e 's@.*/\([^/]*\)$@\1@' -e 's@\.c$@@'` - dlobj=$xxx.o - dlsrc=$xxx.c - dldir=`echo $ans | $sed 's@\(.*\)/[^/]*$@\1@'` - case "$dldir" in - '') dldir="." ;; - *) ;; - esac - if $test -f ../$dldir/$dlsrc; then - usedl="$define" - else - echo "File $dlsrc does not exist -- ignored" - usedl="$undef" - fi - - cat << EOM - -Some systems may require passing special flags to $cc -c to -compile modules that will be used to create a shared library. -To use no flags, say "none". -EOM - case "$cccdlflags" in - ''|' ') case "$osname" in - hpux) dflt='+z' ;; - next) dflt='none' ;; - sunos) dflt='none' ;; - *) dflt='none' ;; - esac - ;; - *) dflt="$cccdlflags" ;; - esac - rp="Any special flags to pass to $cc -c to compile shared library modules?" - . ./myread - case "$ans" in - none) cccdlflags='' ;; - *) cccdlflags="$ans" ;; - esac - - cat << 'EOM' - -Some systems may require passing special flags to ld to -create a shared library. To use no flags, say "none". -EOM -?X: I have received one report that NeXT requires -r here. -?X: On SunOS 4.1.3, that makes the library no longer shared. - case "$lddlflags" in - ''|' ') case "$osname" in - hpux) dflt='-b' ;; - next) dflt='none' ;; - sunos) dflt='none' ;; - *) dflt='none' ;; - esac - ;; - *) dflt="$lddlflags" ;; - esac - rp="Any special flags to pass to ld to create a shared library?" - . ./myread - case "$ans" in - none) lddlflags='' ;; - *) lddlflags="$ans" ;; - esac - - cat < to get any typedef'ed information. -?C:. -?H:#define Gid_t $gidtype /* Type for getgid(), etc... */ -?H:. -?T:xxx -?INIT:gidtype='' -: see what type gids are declared as in the kernel -case "$gidtype" in -'') - if $contains 'gid_t;' `./findhdr sys/types.h` >/dev/null 2>&1 ; then - dflt='gid_t'; - else - 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 - fi - ;; -*) dflt="$gidtype";; -esac -echo " " -rp="What is the type for group ids returned by getgid()?" -. ./myread -val="$ans" -set gidtype -eval $setvar diff --git a/U/groupstype.U b/U/groupstype.U deleted file mode 100644 index 355ea14..0000000 --- a/U/groupstype.U +++ /dev/null @@ -1,51 +0,0 @@ -?RCS: $Id: groupstype.U,v$ -?RCS: -?RCS: You may redistribute only under the terms of the Artistic Licence, -?RCS: as specified in the README file that comes with the distribution. -?RCS: You may reuse parts of this distribution only within the terms of -?RCS: that same Artistic Licence; a copy of which may be found at the root -?RCS: of the source tree for dist 3.0. -?RCS: -?RCS: $Log: groupstype.U,v $ -?RCS: -?MAKE:groupstype: gidtype d_getgrps Myread Oldconfig Findhdr cat Setvar -?MAKE: -pick add $@ %< -?INIT:groupstype='' -?S:groupstype: -?S: This variable defines GROUPSTYPE to be something like gid_t, int, -?S: ushort, or whatever type is used for the second argument to -?S: getgroups(). Usually, this is the same of gidtype, but -?S: sometimes it isn't. -?S:. -?C:GROUPSTYPE: -?C: This symbol holds the type used for the second argument to -?C: getgroups(). Usually, this is the same of gidtype, but -?C: sometimes it isn't. It can be int, ushort, uid_t, etc... -?C: It may be necessary to include to get any -?C: typedef'ed information. This is only required if you have -?C: getgroups(). -?C:. -?H:?%<:#ifdef HAS_GETGROUPS -?H:?%<:#define GROUPSTYPE $groupstype /* Type for 2nd arg to getgroups() */ -?H:?%<:#endif -?H:. -?W:%<:getgroups HAS_GETGROUPS -case "$d_getgrps" in -'define') - case "$groupstype" in - '') dflt="$gidtype" ;; - *) dflt="$groupstype" ;; - esac - echo " " - $cat < exists and should -?S: be included. -?S:. -?C:I_DLFCN: -?C: This symbol, if defined, indicates that exists and should -?C: be included. -?C:. -?H:#$i_dlfcn I_DLFCN /**/ -?H:. -?LINT:set i_dlfcn -: see if dlfcn is available -set dlfcn.h i_dlfcn -eval $inhdr diff --git a/U/i_net_errno.U b/U/i_net_errno.U deleted file mode 100644 index c5fb911..0000000 --- a/U/i_net_errno.U +++ /dev/null @@ -1,50 +0,0 @@ -?RCS: $Id: i_net_errno.U,v $ -?RCS: -?RCS: You may redistribute only under the terms of the Artistic Licence, -?RCS: as specified in the README file that comes with the distribution. -?RCS: You may reuse parts of this distribution only within the terms of -?RCS: that same Artistic Licence; a copy of which may be found at the root -?RCS: of the source tree for dist 3.0. -?RCS: -?RCS: $Log: i_net_errno.U,v $ -?RCS: -?MAKE:i_neterrno: Inhdr cc ccflags rm -?MAKE: -pick add $@ %< -?S:i_neterrno: -?S: This variable conditionally defines the I_NET_ERRNO symbol, which -?S: indicates to the C program that exists and should -?S: be included. -?S:. -?C:I_NET_ERRNO: -?C: This symbol, if defined, indicates that exists and -?C: should be included. -?C:. -?H:#$i_neterrno I_NET_ERRNO /**/ -?H:. -?LINT:set i_neterrno -: see if net/errno.h is available -set net/errno.h i_neterrno -eval $inhdr -: Unfortunately, it causes problems on some systems. Arrgh. -case '$i_neterrno' in -'define') echo " found." - cat > try.c <<'EOM' -#include -#include -#include -int func() -{ -int x; -x = ENOTSOCK; -return x; -} -EOM - if $cc $ccflags -c try.c >/dev/null 2>&1; then - i_neterrno="$define" - else - echo "But it causes problems, so we won't include it" - i_neterrno="$undef" - fi - $rm -f try.* try - ;; -esac diff --git a/U/i_pwd.U b/U/i_pwd.U deleted file mode 100644 index 69aa030..0000000 --- a/U/i_pwd.U +++ /dev/null @@ -1,134 +0,0 @@ -?RCS: $Id: i_pwd.U,v 3.0 1993/08/18 12:08:25 ram Exp $ -?RCS: -?RCS: Copyright (c) 1991-1993, Raphael Manfredi -?RCS: -?RCS: You may redistribute only under the terms of the Artistic Licence, -?RCS: as specified in the README file that comes with the distribution. -?RCS: You may reuse parts of this distribution only within the terms of -?RCS: that same Artistic Licence; a copy of which may be found at the root -?RCS: of the source tree for dist 3.0. -?RCS: -?RCS: $Log: i_pwd.U,v $ -?RCS: Revision 3.0 1993/08/18 12:08:25 ram -?RCS: Baseline for dist 3.0 netwide release. -?RCS: -?X: -?X: This unit looks wether there is a pwd system or not -?X: -?MAKE:i_pwd d_pwquota d_pwage d_pwchange d_pwclass d_pwexpire d_pwcomment: \ - test contains rm cppstdin cppflags cppminus Findhdr -?MAKE: -pick add $@ %< -?S:i_pwd: -?S: This variable conditionally defines I_PWD, which indicates -?S: to the C program that it should include . -?S:. -?S:d_pwquota: -?S: This varaible conditionally defines PWQUOTA, which indicates -?S: that struct passwd contains pw_quota. -?S:. -?S:d_pwage: -?S: This varaible conditionally defines PWAGE, which indicates -?S: that struct passwd contains pw_age. -?S:. -?S:d_pwchange: -?S: This varaible conditionally defines PWCHANGE, which indicates -?S: that struct passwd contains pw_change. -?S:. -?S:d_pwclass: -?S: This varaible conditionally defines PWCLASS, which indicates -?S: that struct passwd contains pw_class. -?S:. -?S:d_pwexpire: -?S: This varaible conditionally defines PWEXPIRE, which indicates -?S: that struct passwd contains pw_expire. -?S:. -?S:d_pwcomment: -?S: This varaible conditionally defines PWCOMMENT, which indicates -?S: that struct passwd contains pw_comment. -?S:. -?C:I_PWD: -?C: This symbol, if defined, indicates to the C program that it should -?C: include . -?C:. -?C:PWQUOTA: -?C: This symbol, if defined, indicates to the C program that struct passwd -?C: contains pw_quota. -?C:. -?C:PWAGE: -?C: This symbol, if defined, indicates to the C program that struct passwd -?C: contains pw_age. -?C:. -?C:PWCHANGE: -?C: This symbol, if defined, indicates to the C program that struct passwd -?C: contains pw_change. -?C:. -?C:PWCLASS: -?C: This symbol, if defined, indicates to the C program that struct passwd -?C: contains pw_class. -?C:. -?C:PWEXPIRE: -?C: This symbol, if defined, indicates to the C program that struct passwd -?C: contains pw_expire. -?C:. -?C:PWCOMMENT: -?C: This symbol, if defined, indicates to the C program that struct passwd -?C: contains pw_comment. -?C:. -?H:#$i_pwd I_PWD /**/ -?H:#$d_pwquota PWQUOTA /**/ -?H:#$d_pwage PWAGE /**/ -?H:#$d_pwchange PWCHANGE /**/ -?H:#$d_pwclass PWCLASS /**/ -?H:#$d_pwexpire PWEXPIRE /**/ -?H:#$d_pwcomment PWCOMMENT /**/ -?H:. -?T:xxx -: see if this is a pwd system -echo " " -xxx=`./findhdr pwd.h` -if $test "$xxx"; then - i_pwd="$define" - echo " found." >&4 - $cppstdin $cppflags $cppminus < $xxx >$$.h - if $contains 'pw_quota' $$.h >/dev/null 2>&1; then - d_pwquota="$define" - else - d_pwquota="$undef" - fi - if $contains 'pw_age' $$.h >/dev/null 2>&1; then - d_pwage="$define" - else - d_pwage="$undef" - fi - if $contains 'pw_change' $$.h >/dev/null 2>&1; then - d_pwchange="$define" - else - d_pwchange="$undef" - fi - if $contains 'pw_class' $$.h >/dev/null 2>&1; then - d_pwclass="$define" - else - d_pwclass="$undef" - fi - if $contains 'pw_expire' $$.h >/dev/null 2>&1; then - d_pwexpire="$define" - else - d_pwexpire="$undef" - fi - if $contains 'pw_comment' $$.h >/dev/null 2>&1; then - d_pwcomment="$define" - else - d_pwcomment="$undef" - fi - $rm -f $$.h -else - i_pwd="$undef" - d_pwquota="$undef" - d_pwage="$undef" - d_pwchange="$undef" - d_pwclass="$undef" - d_pwexpire="$undef" - d_pwcomment="$undef" - echo " NOT found." >&4 -fi - diff --git a/U/i_sdbm.U b/U/i_sdbm.U deleted file mode 100644 index 3e01615..0000000 --- a/U/i_sdbm.U +++ /dev/null @@ -1,37 +0,0 @@ -?RCS: $Id: i_sdbm.U,v $ -?RCS: -?RCS: Copyright (c) 1991-1993, Raphael Manfredi -?RCS: -?RCS: You may redistribute only under the terms of the Artistic Licence, -?RCS: as specified in the README file that comes with the distribution. -?RCS: You may reuse parts of this distribution only within the terms of -?RCS: that same Artistic Licence; a copy of which may be found at the root -?RCS: of the source tree for dist 3.0. -?RCS: -?RCS: $Log: i_sdbm.U,v $ -?RCS: -?MAKE:i_sdbm: Inhdr package Setvar -?MAKE: -pick add $@ %< -?S:i_sdbm: -?S: This variable conditionally defines the I_SDBM symbol, which -?S: indicates to the C program that sdbm.h exists and should -?S: be included. -?S:. -?C:I_SDBM (HAS_SDBM): -?C: This symbol, if defined, indicates that sdbm.h exists and should -?C: be included. -?C:. -?H:#$i_sdbm I_SDBM /**/ -?H:. -?LINT:set i_sdbm -: see if sdbm.h is wanted -?X: Since perl includes sdbm, don't ask here. Always include it. -?X: But, we'll allow a hints file to over-rule us. -echo " " -echo "$package includes an implementation of sdbm in ext/dbm/sdbm." -case "$i_sdbm" in - ''|' ') val="$define" ;; - *) val="$i_sdbm" ;; -esac -set i_sdbm -eval $setvar diff --git a/U/i_sgtty.U b/U/i_sgtty.U deleted file mode 100644 index b890d78..0000000 --- a/U/i_sgtty.U +++ /dev/null @@ -1,128 +0,0 @@ -?MAKE:i_sgtty: Inhdr -?MAKE: -pick add $@ %< -?S:i_sgtty: -?S: This variable conditionally defines the I_SGTTY symbol, and -?S: indicates whether a C program should include . -?S:. -?C:I_SGTTY: -?C: This symbol, if defined, indicates to the C program that it should -?C: include . -?C:. -?H:#$i_sgtty I_SGTTY /**/ -?H:. -?LINT:set i_sgtty -: see if this is a sgtty.h system -set sgtty.h i_sgtty -eval $inhdr -?MAKE:i_sgtty: Inhdr -?MAKE: -pick add $@ %< -?S:i_sgtty: -?S: This variable conditionally defines the I_SGTTY symbol, and -?S: indicates whether a C program should include . -?S:. -?C:I_SGTTY: -?C: This symbol, if defined, indicates to the C program that it should -?C: include . -?C:. -?H:#$i_sgtty I_SGTTY /**/ -?H:. -?LINT:set i_sgtty -: see if this is a sgtty.h system -set sgtty.h i_sgtty -eval $inhdr -?MAKE:i_sgtty: Inhdr -?MAKE: -pick add $@ %< -?S:i_sgtty: -?S: This variable conditionally defines the I_SGTTY symbol, and -?S: indicates whether a C program should include . -?S:. -?C:I_SGTTY: -?C: This symbol, if defined, indicates to the C program that it should -?C: include . -?C:. -?H:#$i_sgtty I_SGTTY /**/ -?H:. -?LINT:set i_sgtty -: see if this is a sgtty.h system -set sgtty.h i_sgtty -eval $inhdr -?MAKE:i_sgtty: Inhdr -?MAKE: -pick add $@ %< -?S:i_sgtty: -?S: This variable conditionally defines the I_SGTTY symbol, and -?S: indicates whether a C program should include . -?S:. -?C:I_SGTTY: -?C: This symbol, if defined, indicates to the C program that it should -?C: include . -?C:. -?H:#$i_sgtty I_SGTTY /**/ -?H:. -?LINT:set i_sgtty -: see if this is a sgtty.h system -set sgtty.h i_sgtty -eval $inhdr -?MAKE:i_sgtty: Inhdr -?MAKE: -pick add $@ %< -?S:i_sgtty: -?S: This variable conditionally defines the I_SGTTY symbol, and -?S: indicates whether a C program should include . -?S:. -?C:I_SGTTY: -?C: This symbol, if defined, indicates to the C program that it should -?C: include . -?C:. -?H:#$i_sgtty I_SGTTY /**/ -?H:. -?LINT:set i_sgtty -: see if this is a sgtty.h system -set sgtty.h i_sgtty -eval $inhdr -?MAKE:i_sgtty: Inhdr -?MAKE: -pick add $@ %< -?S:i_sgtty: -?S: This variable conditionally defines the I_SGTTY symbol, and -?S: indicates whether a C program should include . -?S:. -?C:I_SGTTY: -?C: This symbol, if defined, indicates to the C program that it should -?C: include . -?C:. -?H:#$i_sgtty I_SGTTY /**/ -?H:. -?LINT:set i_sgtty -: see if this is a sgtty.h system -set sgtty.h i_sgtty -eval $inhdr -?MAKE:i_sgtty: Inhdr -?MAKE: -pick add $@ %< -?S:i_sgtty: -?S: This variable conditionally defines the I_SGTTY symbol, and -?S: indicates whether a C program should include . -?S:. -?C:I_SGTTY: -?C: This symbol, if defined, indicates to the C program that it should -?C: include . -?C:. -?H:#$i_sgtty I_SGTTY /**/ -?H:. -?LINT:set i_sgtty -: see if this is a sgtty.h system -set sgtty.h i_sgtty -eval $inhdr -?MAKE:i_sgtty: Inhdr -?MAKE: -pick add $@ %< -?S:i_sgtty: -?S: This variable conditionally defines the I_SGTTY symbol, and -?S: indicates whether a C program should include . -?S:. -?C:I_SGTTY: -?C: This symbol, if defined, indicates to the C program that it should -?C: include . -?C:. -?H:#$i_sgtty I_SGTTY /**/ -?H:. -?LINT:set i_sgtty -: see if this is a sgtty.h system -set sgtty.h i_sgtty -eval $inhdr diff --git a/U/i_termio.U b/U/i_termio.U deleted file mode 100644 index f1eb947..0000000 --- a/U/i_termio.U +++ /dev/null @@ -1,117 +0,0 @@ -?RCS: $Id: i_termio.U,v 3.0 1993/08/18 12:08:44 ram Exp $ -?RCS: -?RCS: Copyright (c) 1991-1993, Raphael Manfredi -?RCS: -?RCS: You may redistribute only under the terms of the Artistic Licence, -?RCS: as specified in the README file that comes with the distribution. -?RCS: You may reuse parts of this distribution only within the terms of -?RCS: that same Artistic Licence; a copy of which may be found at the root -?RCS: of the source tree for dist 3.0. -?RCS: -?RCS: $Log: i_termio.U,v $ -?RCS: Revision 3.0 1993/08/18 12:08:44 ram -?RCS: Baseline for dist 3.0 netwide release. -?RCS: -?X: -?X: Include all three (possible) definitions in config_h.SH. -?X: There are enough implementations of posix termios.h out there -?X: that do not work well with other system headers or are -?X: incomplete. This makes it easier for the user to back off -?X: and try sgtty.h or i_termio.h instead. -?X: -?MAKE:i_termio i_sgtty i_termios: test Inlibc Cppsym Guess Setvar Findhdr -?MAKE: -pick add $@ %< -?S:i_termio: -?S: This variable conditionally defines the I_TERMIO symbol, which -?S: indicates to the C program that it should include rather -?S: than . -?S:. -?S:i_termios: -?S: This variable conditionally defines the I_TERMIOS symbol, which -?S: indicates to the C program that the POSIX file is -?S: to be included. -?S:. -?S:i_sgtty: -?S: This variable conditionally defines the I_SGTTY symbol, which -?S: indicates to the C program that it should include rather -?S: than . -?S:. -?C:I_TERMIO ~ %<: -?C: This symbol, if defined, indicates that the program should include -?C: rather than . There are also differences in -?C: the ioctl() calls that depend on the value of this symbol. -?C:. -?C:I_TERMIOS ~ %<: -?C: This symbol, if defined, indicates that the program should include -?C: the POSIX termios.h rather than sgtty.h or termio.h. -?C: There are also differences in the ioctl() calls that depend on the -?C: value of this symbol. -?C:. -?C:I_SGTTY ~ %<: -?C: This symbol, if defined, indicates that the program should include -?C: rather than . There are also differences in -?C: the ioctl() calls that depend on the value of this symbol. -?C:. -?H:?%<:#$i_termio I_TERMIO /**/ -?H:?%<:#$i_termios I_TERMIOS /**/ -?H:?%<:#$i_sgtty I_SGTTY /**/ -?H:. -?T:val2 val3 -?LINT:set i_termio i_sgtty i_termios -: see if this is a termio system -val="$undef" -val2="$undef" -val3="$undef" -?X: Prefer POSIX-approved termios.h over all else -if $test `./findhdr termios.h`; then - set tcsetattr i_termios - eval $inlibc - val3="$i_termios" -fi -echo " " -case "$val3" in -"$define") echo "You have POSIX termios.h... good!" >&4;; -*) if Cppsym pyr; then - case "`/bin/universe`" in - ucb) if $test `./findhdr sgtty.h`; then - val2="$define" - echo " found." >&4 - else - echo "System is pyramid with BSD universe." - echo " not found--you could have problems." >&4 - fi;; - *) if $test `./findhdr termio.h`; then - val="$define" - echo " found." >&4 - else - echo "System is pyramid with USG universe." - echo " not found--you could have problems." >&4 - fi;; - esac -?X: Start with USG to avoid problems if both usg/bsd was guessed - elif usg; then - if $test `./findhdr termio.h`; then - echo " found." >&4 - val="$define" - elif $test `./findhdr sgtty.h`; then - echo " found." >&4 - val2="$define" - else -echo "Neither nor found--you could have problems." >&4 - fi - else - if $test `./findhdr sgtty.h`; then - echo " found." >&4 - val2="$define" - elif $test `./findhdr termio.h`; then - echo " found." >&4 - val="$define" - else -echo "Neither nor found--you could have problems." >&4 - fi - fi;; -esac -set i_termio; eval $setvar -val=$val2; set i_sgtty; eval $setvar -val=$val3; set i_termios; eval $setvar - diff --git a/U/i_termios.U b/U/i_termios.U deleted file mode 100644 index f676710..0000000 --- a/U/i_termios.U +++ /dev/null @@ -1,64 +0,0 @@ -?MAKE:i_termios: Inhdr -?MAKE: -pick add $@ %< -?S:i_termios: -?S: This variable conditionally defines the I_TERMIOS symbol, and -?S: indicates whether a C program should include . -?S:. -?C:I_TERMIOS: -?C: This symbol, if defined, indicates to the C program that it should -?C: include . -?C:. -?H:#$i_termios I_TERMIOS /**/ -?H:. -?LINT:set i_termios -: see if this is a termios.h system -set termios.h i_termios -eval $inhdr -?MAKE:i_termios: Inhdr -?MAKE: -pick add $@ %< -?S:i_termios: -?S: This variable conditionally defines the I_TERMIOS symbol, and -?S: indicates whether a C program should include . -?S:. -?C:I_TERMIOS: -?C: This symbol, if defined, indicates to the C program that it should -?C: include . -?C:. -?H:#$i_termios I_TERMIOS /**/ -?H:. -?LINT:set i_termios -: see if this is a termios.h system -set termios.h i_termios -eval $inhdr -?MAKE:i_termios: Inhdr -?MAKE: -pick add $@ %< -?S:i_termios: -?S: This variable conditionally defines the I_TERMIOS symbol, and -?S: indicates whether a C program should include . -?S:. -?C:I_TERMIOS: -?C: This symbol, if defined, indicates to the C program that it should -?C: include . -?C:. -?H:#$i_termios I_TERMIOS /**/ -?H:. -?LINT:set i_termios -: see if this is a termios.h system -set termios.h i_termios -eval $inhdr -?MAKE:i_termios: Inhdr -?MAKE: -pick add $@ %< -?S:i_termios: -?S: This variable conditionally defines the I_TERMIOS symbol, and -?S: indicates whether a C program should include . -?S:. -?C:I_TERMIOS: -?C: This symbol, if defined, indicates to the C program that it should -?C: include . -?C:. -?H:#$i_termios I_TERMIOS /**/ -?H:. -?LINT:set i_termios -: see if this is a termios.h system -set termios.h i_termios -eval $inhdr diff --git a/U/i_vfork.U b/U/i_vfork.U deleted file mode 100644 index 19af424..0000000 --- a/U/i_vfork.U +++ /dev/null @@ -1,34 +0,0 @@ -?RCS: $Id: i_vfork.U,v 3.0 1993/08/18 12:08:50 ram Exp $ -?RCS: -?RCS: Copyright (c) 1991-1993, Raphael Manfredi -?RCS: -?RCS: You may redistribute only under the terms of the Artistic Licence, -?RCS: as specified in the README file that comes with the distribution. -?RCS: You may reuse parts of this distribution only within the terms of -?RCS: that same Artistic Licence; a copy of which may be found at the root -?RCS: of the source tree for dist 3.0. -?RCS: -?RCS: $Log: i_vfork.U,v $ -?RCS: Revision 3.0 1993/08/18 12:08:50 ram -?RCS: Baseline for dist 3.0 netwide release. -?RCS: -?MAKE:i_vfork: Inhdr d_vfork -?MAKE: -pick add $@ %< -?S:i_vfork: -?S: This variable conditionally defines the I_VFORK symbol, and indicates -?S: whether a C program should include vfork.h. -?S:. -?C:I_VFORK: -?C: This symbol, if defined, indicates to the C program that it should -?C: include vfork.h. -?C:. -?H:#$i_vfork I_VFORK /**/ -?H:. -?LINT:set i_vfork -: see if this is a vfork system -case "$d_vfork" in -define) set vfork.h i_vfork - eval $inhdr - ;; -*) i_vfork="$undef";; -esac diff --git a/U/libc.U b/U/libc.U deleted file mode 100644 index 9f497f1..0000000 --- a/U/libc.U +++ /dev/null @@ -1,288 +0,0 @@ -?RCS: $Id: libc.U,v 3.0.1.3 1994/01/24 14:12:17 ram Exp $ -?RCS: -?RCS: Copyright (c) 1991-1993, Raphael Manfredi -?RCS: -?RCS: You may redistribute only under the terms of the Artistic Licence, -?RCS: as specified in the README file that comes with the distribution. -?RCS: You may reuse parts of this distribution only within the terms of -?RCS: that same Artistic Licence; a copy of which may be found at the root -?RCS: of the source tree for dist 3.0. -?RCS: -?RCS: $Log: libc.U,v $ -?RCS: Revision 3.0.1.3 1994/01/24 14:12:17 ram -?RCS: patch16: can now export nm_extract as an internal-use only variable -?RCS: -?RCS: Revision 3.0.1.2 1993/09/13 16:09:03 ram -?RCS: patch10: added special handling for Apollo systems (WAD) -?RCS: -?RCS: Revision 3.0.1.1 1993/08/27 14:40:03 ram -?RCS: patch7: added entry for /usr/shlib/libc.so (OSF/1 machines) -?RCS: -?RCS: Revision 3.0 1993/08/18 12:08:57 ram -?RCS: Baseline for dist 3.0 netwide release. -?RCS: -?MAKE:libc +nm_extract: echo n c rm test grep Getfile Myread Oldconfig Loc \ - sed libs incpath libpth runnm nm_opt contains plibpth xlibpth -?MAKE: -pick add $@ %< -?S:libc: -?S: This variable contains the location of the C library. -?S:. -?S:nm_extract: -?S: This variable holds the name of the extraction command used to process -?S: the output of nm and yield the list of defined symbols. It is used -?S: internally by Configure. -?S:. -?T:thislib try libnames xxx xscan xrun thisname com tans -?LINT:change libpth nm_opt -case "$runnm" in -true) -?X: indentation is wrong on purpose--RAM -: get list of predefined functions in a handy place -echo " " -case "$libc" in -'') libc=unknown - case "$libs" in - *-lc_s*) libc=`./loc libc_s.a $libc $libpth` - esac - ;; -esac -libpth="$plibpth $libpth" -libnames=''; -case "$libs" in -'') ;; -*) for thislib in $libs; do - case "$thislib" in - -l*) - thislib=`expr X$thislib : 'X-l\(.*\)'` - try=`./loc lib$thislib.a blurfl/dyick $libpth` - if test ! -f $try; then - try=`./loc lib$thislib blurfl/dyick $libpth` - if test ! -f $try; then - try=`./loc lib$thislib.so.'*' blurfl/dyick $libpth` - if test ! -f $try; then - try=`./loc $thislib blurfl/dyick $libpth` - if test ! -f $try; then - try=`./loc Slib$thislib.a blurfl/dyick $xlibpth` - if test ! -f $try; then - try='' - fi - fi - fi - fi - fi - libnames="$libnames $try" - ;; - *) libnames="$libnames $thislib" ;; - esac - done - ;; -esac -?X: -?X: Some systems (e.g. DG/UX) use "environmental" links, which make the test -?X: -f fail. Ditto for symbolic links. So in order to reliably check the -?X: existence of a file, we use test -r. It will still fail with DG/UX links -?X: though, but at least it will detect symbolic links. At some strategic -?X: points, we make use of (test -h), using a sub-shell in case builtin test -?X: does not implement the -h check for symbolic links. This makes it -?X: possible to preset libc in a hint file for instance and have it show up -?X: as-is in the question. -?X: -xxx=normal -case "$libc" in -unknown) - set /usr/ccs/lib/libc.so - $test -r $1 || set /usr/lib/libc.so - $test -r $1 || set /usr/shlib/libc.so - $test -r $1 || set /usr/lib/libc.so.[0-9]* - $test -r $1 || set /lib/libsys_s.a - eval set \$$# - ;; -*) -?X: ensure the test below for the (shared) C library will fail - set blurfl - ;; -esac -if $test -r "$1"; then - echo "Your (shared) C library seems to be in $1." - libc="$1" -elif $test -r /lib/libc && $test -r /lib/clib; then -?X: -?X: Apollo has its C library in /lib/clib AND /lib/libc -?X: not to mention its math library in /lib/syslib... -?X: - echo "Your C library seems to be in both /lib/clib and /lib/libc." - xxx=apollo - libc='/lib/clib /lib/libc' - if $test -r /lib/syslib; then - echo "(Your math library is in /lib/syslib.)" -?X: Put syslib in libc -- not quite right, but won't hurt - libc="$libc /lib/syslib" - fi -elif $test -r "$libc" || (test -h "$libc") >/dev/null 2>&1; then - echo "Your C library seems to be in $libc, as you said before." -?X: For mips, and... -elif $test -r $incpath/usr/lib/libc.a; then - libc=$incpath/usr/lib/libc.a; - echo "Your C library seems to be in $libc. That's fine." -elif $test -r /lib/libc.a; then - libc=/lib/libc.a; - echo "Your C library seems to be in $libc. You're normal." -else - if tans=`./loc libc.a blurfl/dyick $libpth`; $test -r "$tans"; then - : - elif tans=`./loc libc blurfl/dyick $libpth`; $test -r "$tans"; then - libnames="$libnames "`./loc clib blurfl/dyick $libpth` - elif tans=`./loc clib blurfl/dyick $libpth`; $test -r "$tans"; then - : - elif tans=`./loc Slibc.a blurfl/dyick $xlibpth`; $test -r "$tans"; then - : - elif tans=`./loc Mlibc.a blurfl/dyick $xlibpth`; $test -r "$tans"; then - : - else - tans=`./loc Llibc.a blurfl/dyick $xlibpth` - fi - if $test -r "$tans"; then - echo "Your C library seems to be in $tans, of all places." - libc=$tans - else - libc='blurfl' - fi -fi -if $test $xxx = apollo -o -r "$libc" || (test -h "$libc") >/dev/null 2>&1; then - dflt="$libc" - cat < libpath - cat >&4 < libnames -set X `cat libnames` -shift -xxx=files -case $# in 1) xxx=file; esac -echo "Extracting names from the following $xxx for later perusal:" >&4 -echo " " -$sed 's/^/ /' libnames >&4 -echo " " -$echo $n "This may take a while...$c" >&4 - -nm $nm_opt $* 2>/dev/null >libc.tmp -$echo $n ".$c" -?X: -?X: To accelerate processing, we look at the correct 'sed' command -?X: by using a small subset of libc.tmp, i.e. fprintf function. -?X: When we know which sed command to use, do the name extraction -?X: -$grep fprintf libc.tmp > libc.ptf -?X: -?X: In order to ehance readability and save some space, we define -?X: some variables that will be "eval"ed. -?X: -xscan='eval "libc.list"; $echo $n ".$c" >&4' -xrun='eval "libc.list"; echo "done" >&4' -?X: BSD-like output -if com="$sed -n -e 's/^.* [ADTS] *_[_.]*//p' -e 's/^.* [ADTS] //p'";\ - eval $xscan;\ - $contains '^fprintf$' libc.list >/dev/null 2>&1; then - eval $xrun -?X: SYSV-like output -elif com="$sed -n -e 's/^__*//' -e 's/^\([a-zA-Z_0-9$]*\).*xtern.*/\1/p'";\ - eval $xscan;\ - $contains '^fprintf$' libc.list >/dev/null 2>&1; then - eval $xrun -elif com="$sed -n -e '/|UNDEF/d' -e '/FUNC..GL/s/^.*|__*//p'";\ - eval $xscan;\ - $contains '^fprintf$' libc.list >/dev/null 2>&1; then - eval $xrun -elif com="$sed -n -e 's/^.* D __*//p' -e 's/^.* D //p'";\ - eval $xscan;\ - $contains '^fprintf$' libc.list >/dev/null 2>&1; then - eval $xrun -elif com="$sed -n -e 's/^_//' -e 's/^\([a-zA-Z_0-9]*\).*xtern.*text.*/\1/p'";\ - eval $xscan;\ - $contains '^fprintf$' libc.list >/dev/null 2>&1; then - eval $xrun -elif com="$sed -n -e 's/^.*|FUNC |GLOB .*|//p'";\ - eval $xscan;\ - $contains '^fprintf$' libc.list >/dev/null 2>&1; then - eval $xrun -elif com="$grep '|' | $sed -n -e '/|COMMON/d' -e '/|DATA/d' \ - -e '/ file/d' -e 's/^\([^ ]*\).*/\1/p'";\ - eval $xscan;\ - $contains '^fprintf$' libc.list >/dev/null 2>&1; then - eval $xrun -elif com="$sed -n -e 's/^.*|FUNC |GLOB .*|//p' -e 's/^.*|FUNC |WEAK .*|//p'";\ - eval $xscan;\ - $contains '^fprintf$' libc.list >/dev/null 2>&1; then - eval $xrun -?X: mips nm output (sysV) -elif com="$sed -n -e 's/^__//' -e '/|Undef/d' -e '/|Proc/s/ .*//p'";\ - eval $xscan;\ - $contains '^fprintf$' libc.list >/dev/null 2>&1; then - eval $xrun -else - nm -p $* 2>/dev/null >libc.tmp - com="$sed -n -e 's/^.* [ADTS] *_[_.]*//p' -e 's/^.* [ADTS] //p'";\ - eval "libc.list" - if $contains '^fprintf$' libc.list >/dev/null 2>&1; then - nm_opt='-p' - echo "done" >&4 - else - echo " " - echo "nm didn't seem to work right. Trying ar instead..." >&4 - com='' - if ar t $libc > libc.tmp; then - for thisname in $libnames; do - ar t $thisname >>libc.tmp - done - $sed -e 's/\.o$//' < libc.tmp > libc.list - echo "Ok." >&4 - else - echo "ar didn't seem to work right." >&4 - echo "Maybe this is a Cray...trying bld instead..." >&4 - if bld t $libc | $sed -e 's/.*\///' -e 's/\.o:.*$//' > libc.list; then - for thisname in $libnames; do - bld t $libnames | \ - $sed -e 's/.*\///' -e 's/\.o:.*$//' >>libc.list - ar t $thisname >>libc.tmp - done - echo "Ok." >&4 - else - echo "That didn't work either. Giving up." >&4 - exit 1 - fi - fi - fi -fi -nm_extract="$com" -if $test -f /lib/syscalls.exp; then - echo " " - echo "Also extracting names from /lib/syscalls.exp for good ole AIX..." >&4 - $sed -n 's/^\([^ ]*\)[ ]*syscall$/\1/p' /lib/syscalls.exp >>libc.list -fi -?X: remember, indentation is wrong on purpose--RAM -;; -esac -$rm -f libnames libpath - diff --git a/U/libpth.U b/U/libpth.U deleted file mode 100644 index 2c030c2..0000000 --- a/U/libpth.U +++ /dev/null @@ -1,74 +0,0 @@ -?RCS: $Id: libpth.U,v 3.0 1993/08/18 12:09:02 ram Exp $ -?RCS: -?RCS: Copyright (c) 1991-1993, Raphael Manfredi -?RCS: -?RCS: You may redistribute only under the terms of the Artistic Licence, -?RCS: as specified in the README file that comes with the distribution. -?RCS: You may reuse parts of this distribution only within the terms of -?RCS: that same Artistic Licence; a copy of which may be found at the root -?RCS: of the source tree for dist 3.0. -?RCS: -?RCS: $Log: libpth.U,v $ -?RCS: Revision 3.0 1993/08/18 12:09:02 ram -?RCS: Baseline for dist 3.0 netwide release. -?RCS: -?X: -?X: This unit initializes the path for C library lookup. -?X: -?MAKE:libpth xlibpth plibpth: mips incpath test cat Myread -?MAKE: -pick add $@ %< -?S:libpth: -?S: This variable holds the general path used to find libraries. It is -?S: intended to be used by other units. -?S:. -?S:plibpth: -?S: Holds the private path used by Configure to find out the libraries. -?S: Its value is prepended to libpth. This variable takes care of special -?S: machines, like the mips. Usually, it should be empty. -?S:. -?T: xxx yyy -?INIT:: change the next line if compiling for Xenix/286 on Xenix/386 -?INIT:xlibpth='/usr/lib/386 /lib/386' -?INIT: -?INIT:: general looking path for locating libraries -?INIT:libpth="/usr/lib/large /lib /usr/lib $xlibpth /lib/large" -?INIT:libpth="$libpth /usr/lib/small /lib/small" -?INIT:libpth="$libpth /usr/ccs/lib /usr/ucblib /usr/local/lib" -?INIT: -?INIT:: Private path used by Configure to find libraries. Its value -?INIT:: is prepend to libpth. This variable takes care of special -?INIT:: machines, like the mips. Usually, it should be empty. -?INIT:plibpth='' -?INIT: -?LINT:describe xlibpth -?LINT:use mips -: Set private lib path -case "$plibpth" in -'') if mips; then -?X: on mips, we DO NOT want /lib, and we want $incpath/usr/lib - plibpth="$incpath/usr/lib /usr/local/lib /usr/ccs/lib" - fi;; -esac -libpth="$plibpth $libpth" -: Now check and see which directories actually exist. -xxx='' -for yyy in $libpth -do - if $test -d $yyy; then - xxx="$xxx $yyy" - fi -done -libpth="$xxx" -$cat <&4 -case "$libs" in -' '|'') dflt='';; -*) dflt="$libs";; -esac -case "$libswanted" in -'') libswanted='c_s';; -esac -for thislib in $libswanted; do - case "$thislib" in - dbm) thatlib=ndbm;; - *_s) thatlib=NONE;; - *) thatlib=${thislib}_s;; - esac - xxx=`./loc lib$thislib.a X $libpth` - yyy=`./loc lib$thatlib.a X $libpth` - zzz=`./loc lib$thislib.so.[0-9]'*' X $libpth` - if $test -f $xxx; then - echo "Found -l$thislib." - case "$dflt" in - *"-l$thislib "*|*-l$thislib|*"-l$thatlib "*|*-l$thatlib) ;; - *) dflt="$dflt -l$thislib";; - esac - elif $test -f $yyy; then - echo "Found -l$thatlib." - case "$dflt" in - *"-l$thatlib "*|*-l$thatlib) ;; - *) dflt="$dflt -l$thatlib";; - esac - elif $test -f $zzz; then - echo "Found -$thislib." - case "$dflt" in - *"-l$thislib "*|*-l$thislib) ;; - *) dflt="$dflt -l$thislib";; - esac - else - xxx=`./loc Slib$thislib.a X $xlibpth` - yyy=`./loc Slib$thatlib.a X $xlibpth` - if $test -f $xxx; then - echo "Found -l$thislib." - case "$dflt" in - *"-l$thislib "*|*-l$thislib|*"-l$thatlib "*|*-l$thatlib) ;; - *) dflt="$dflt -l$thislib";; - esac - elif $test -f $yyy; then - echo "Found -l$thatlib." - case "$dflt" in - *"-l$thatlib "*|*-l$thatlib) ;; - *) dflt="$dflt -l$thatlib";; - esac - else - echo "No -l$thislib." - fi - fi -done -set X $dflt -shift -dflt="$*" -case "$libs" in -'') dflt="$dflt";; -*) dflt="$libs";; -esac -case "$dflt" in -' '|'') dflt='none';; -esac - -$cat <&4 - libyacc='' - ;; -*yacc) - if $test -r /usr/lib/liby.a || $test -r /usr/local/lib/liby.a ; then - echo "-ly found." >&4 - libyacc='-ly' - else - xxx=`./loc liby.a x $libpth` - case "$xxx" in - x) - echo "No yacc library found." >&4 - libyacc='' - ;; - *) - echo "yacc library found in $xxx." >&4 - libyacc="$xxx" - ;; - esac - fi - ;; -*bison*) - echo "You are using bison, so I won't look for a yacc library." >&4 - libyacc='' - ;; -*) -echo "You don't seem to have yacc, so I won't look for the yacc library." >&4 - libyacc='' - ;; -esac - diff --git a/U/lns.U b/U/lns.U deleted file mode 100644 index fcefb1f..0000000 --- a/U/lns.U +++ /dev/null @@ -1,21 +0,0 @@ -?RCS: $Id: lns.U,v $ -?RCS: -?RCS: $Log: lns.U,v $ -?RCS: -?MAKE:lns: ln touch -?MAKE: -pick add $@ %< -?S:lns: -?S: This variable holds the name of the command to make -?S: symbolic links (if they are supported). It can be used -?S: in the Makefile. It is either 'ln -s' or 'ln' -?S:. -?X: We can't rely on d_symlink because that may be listed in the -?X: C library but unimplemented. -: determine whether symbolic links are supported -$touch blurfl -if $ln -s blurfl sym > /dev/null 2>&1 ; then - lns="$ln -s" -else - lns="$ln" -fi -rm -f blurfl sym diff --git a/U/loc_sed.U b/U/loc_sed.U deleted file mode 100644 index 9eb8b21..0000000 --- a/U/loc_sed.U +++ /dev/null @@ -1,10 +0,0 @@ -?RCS: $Id: loc_sed.U,v $ -?RCS: -?MAKE:: sed -?MAKE: -pick add $@ %< -?C:LOC_SED: -?C: This symbol holds the complete pathname to the sed program. -?C:. -?H:#define LOC_SED "$sed" /**/ -?H:. -?X: This is used in perl.c. diff --git a/U/mallocsrc.U b/U/mallocsrc.U deleted file mode 100644 index 9fd5382..0000000 --- a/U/mallocsrc.U +++ /dev/null @@ -1,108 +0,0 @@ -?RCS: $Id: mallocsrc.U,v 3.0 1993/08/18 12:09:12 ram Exp $ -?RCS: -?RCS: Copyright (c) 1991-1993, Raphael Manfredi -?RCS: -?RCS: You may redistribute only under the terms of the Artistic Licence, -?RCS: as specified in the README file that comes with the distribution. -?RCS: You may reuse parts of this distribution only within the terms of -?RCS: that same Artistic Licence; a copy of which may be found at the root -?RCS: of the source tree for dist 3.0. -?RCS: -?RCS: $Log: mallocsrc.U,v $ -?RCS: Revision 3.0 1993/08/18 12:09:12 ram -?RCS: Baseline for dist 3.0 netwide release. -?RCS: -?MAKE:mallocsrc mallocobj usemymalloc malloctype d_mymalloc: Myread Oldconfig package \ - Guess Setvar test rm cat +cc +ccflags Findhdr -?MAKE: -pick add $@ %< -?S:usemymalloc: -?S: This variable contains y if the malloc that comes with this package -?S: is desired over the system's version of malloc. People often include -?S: special versions of malloc for effiency, but such versions are often -?S: less portable. See also mallocsrc and mallocobj. -?S:. -?S:mallocsrc: -?S: This variable contains the name of the malloc.c that comes with -?S: the package, if that malloc.c is preferred over the system malloc. -?S: Otherwise the value is null. This variable is intended for generating -?S: Makefiles. -?S:. -?S:d_mymalloc: -?S: This variable conditionally defines MYMALLOC in case other parts -?S: of the source want to take special action if MYMALLOC is used. -?S: This may include different sorts of profiling or error detection. -?S:. -?S:mallocobj: -?S: This variable contains the name of the malloc.o that this package -?S: generates, if that malloc.o is preferred over the system malloc. -?S: Otherwise the value is null. This variable is intended for generating -?S: Makefiles. See mallocsrc. -?S:. -?S:malloctype: -?S: This variable contains the kind of ptr returned by malloc and realloc. -?S:. -?C:Malloc_t (MALLOCPTRTYPE): -?C: This symbol is the type of pointer returned by malloc and realloc. -?C:. -?H:#define Malloc_t $malloctype /**/ -?H:. -?C:MYMALLOC: -?C: This symbol, if defined, indicates that we're using our own malloc. -?C:. -?H:#$d_mymalloc MYMALLOC /**/ -?H:. -?X: Cannot test for mallocsrc; it is the unit's name and there is a bug in -?X: the interpreter which defines all the names, even though they are not used. -@if mallocobj -: determine which malloc to compile in -: Old versions had dflt='y' only for bsd or v7. -echo " " -case "$usemymalloc" in -'') - if bsd || v7; then - dflt='y' - else - dflt='y' - fi - ;; -*) dflt="$usemymalloc" - ;; -esac -rp="Do you wish to attempt to use the malloc that comes with $package?" -. ./myread -usemymalloc="$ans" -case "$ans" in -y*) mallocsrc='malloc.c' - mallocobj='malloc.o' - d_mymalloc="$define" - ;; -*) mallocsrc='' - mallocobj='' - d_mymalloc="$undef" - ;; -esac -@end - -@if MALLOCPTRTYPE || Malloc_t -: compute the type returned by malloc -echo " " -case "$malloctype" in -'') - if $test `./findhdr malloc.h`; then - echo "#include " > malloc.c - fi -#include - $cat >>malloc.c <<'END' -void *malloc(); -END - if $cc $ccflags -c malloc.c >/dev/null 2>&1; then - malloctype='void *' - else - malloctype='char *' - fi - $rm -f malloc.[co] - ;; -esac -echo "Your system wants malloc to return '$malloctype', it would seem." >&4 - -@end diff --git a/U/prototype.U b/U/prototype.U deleted file mode 100644 index b0332f5..0000000 --- a/U/prototype.U +++ /dev/null @@ -1,115 +0,0 @@ -?RCS: $Id: prototype.U,v 3.0.1.2 1994/01/24 14:15:36 ram Exp $ -?RCS: -?RCS: Copyright (c) 1991-1993, Raphael Manfredi -?RCS: -?RCS: You may redistribute only under the terms of the Artistic Licence, -?RCS: as specified in the README file that comes with the distribution. -?RCS: You may reuse parts of this distribution only within the terms of -?RCS: that same Artistic Licence; a copy of which may be found at the root -?RCS: of the source tree for dist 3.0. -?RCS: -?RCS: $Log: prototype.U,v $ -?RCS: Revision 3.0.1.2 1994/01/24 14:15:36 ram -?RCS: patch16: prototype handling macros now appear only when needed -?RCS: -?RCS: Revision 3.0.1.1 1993/08/25 14:03:12 ram -?RCS: patch6: defines were referring to non-existent VOID symbol -?RCS: -?RCS: Revision 3.0 1993/08/18 12:09:36 ram -?RCS: Baseline for dist 3.0 netwide release. -?RCS: -?MAKE:prototype: Myread Oldconfig cat +cc rm Setvar -?MAKE: -pick add $@ %< -?S:prototype: -?S: This variable holds the eventual value of CAN_PROTOTYPE, which -?S: indicates the C compiler can handle funciton prototypes. -?S:. -?C:CAN_PROTOTYPE ~ %<: -?C: If defined, this macro indicates that the C compiler can handle -?C: function prototypes. -?C:. -?C:DOTS: -?C: This macro is used to specify the ... in function prototypes which -?C: have arbitrary additional arguments. -?C:. -?C:NXT_ARG: -?C: This macro is used to separate arguments in the declared argument list. -?C:. -?C:P_FUNC: -?C: This macro is used to declare "private" (static) functions. -?C: It takes three arguments: the function type and name, a parenthesized -?C: traditional (comma separated) argument list, and the declared argument -?C: list (in which arguments are separated with NXT_ARG, and additional -?C: arbitrary arguments are specified with DOTS). For example: -?C: -?C: P_FUNC(int foo, (bar, baz), int bar NXT_ARG char *baz[]) -?C:. -?C:P_FUNC_VOID: -?C: This macro is used to declare "private" (static) functions that have -?C: no arguments. The macro takes one argument: the function type and name. -?C: For example: -?C: -?C: P_FUNC_VOID(int subr) -?C:. -?C:V_FUNC: -?C: This macro is used to declare "public" (non-static) functions. -?C: It takes three arguments: the function type and name, a parenthesized -?C: traditional (comma separated) argument list, and the declared argument -?C: list (in which arguments are separated with NXT_ARG, and additional -?C: arbitrary arguments are specified with DOTS). For example: -?C: -?C: V_FUNC(int main, (argc, argv), int argc NXT_ARG char *argv[]) -?C:. -?C:V_FUNC_VOID: -?C: This macro is used to declare "public" (non-static) functions that have -?C: no arguments. The macro takes one argument: the function type and name. -?C: For example: -?C: -?C: V_FUNC_VOID(int fork) -?C:. -?C:P: -?C: This macro is used to declare function parameters for folks who want -?C: to make declarations with prototypes using a different style than -?C: the above macros. Use double parentheses. For example: -?C: -?C: int main P((int argc, char *argv[])); -?C:. -?H:?%<:#$prototype CAN_PROTOTYPE /**/ -?H:?%<:#ifdef CAN_PROTOTYPE -?H:?NXT_ARG:#define NXT_ARG , -?H:?DOTS:#define DOTS , ... -?H:?V_FUNC:#define V_FUNC(name, arglist, args)name(args) -?H:?P_FUNC:#define P_FUNC(name, arglist, args)static name(args) -?H:?V_FUNC_VOID:#define V_FUNC_VOID(name)name(void) -?H:?P_FUNC_VOID:#define P_FUNC_VOID(name)static name(void) -?H:?P:#define P(args) args -?H:?%<:#else -?H:?NXT_ARG:#define NXT_ARG ; -?H:?DOTS:#define DOTS -?H:?V_FUNC:#define V_FUNC(name, arglist, args)name arglist args; -?H:?P_FUNC:#define P_FUNC(name, arglist, args)static name arglist args; -?H:?V_FUNC_VOID:#define V_FUNC_VOID(name)name() -?H:?P_FUNC_VOID:#define P_FUNC_VOID(name)static name() -?H:?P:#define P(args) () -?H:?%<:#endif -?H:. -?W:%<:NXT_ARG DOTS V_FUNC P_FUNC V_FUNC_VOID P_FUNC_VOID _ -?LINT:set prototype -: Cruising for prototypes -echo " " -echo "Checking out function prototypes..." >&4 -$cat >prototype.c <<'EOCP' -main(int argc, char *argv[]) { - exit(0);} -EOCP -if $cc -c prototype.c >prototype.out 2>&1 ; then - echo "Your C compiler appears to support function prototypes." - val="$define" -else - echo "Your C compiler doesn't seem to understand function prototypes." - val="$undef" -fi -set prototype -eval $setvar -$rm -f prototype* - diff --git a/U/sig_name.U b/U/sig_name.U deleted file mode 100644 index 9b3f9e3..0000000 --- a/U/sig_name.U +++ /dev/null @@ -1,86 +0,0 @@ -?RCS: $Id: sig_name.U,v 3.0 1993/08/18 12:09:47 ram Exp $ -?RCS: -?RCS: Copyright (c) 1991-1993, Raphael Manfredi -?RCS: -?RCS: You may redistribute only under the terms of the Artistic Licence, -?RCS: as specified in the README file that comes with the distribution. -?RCS: You may reuse parts of this distribution only within the terms of -?RCS: that same Artistic Licence; a copy of which may be found at the root -?RCS: of the source tree for dist 3.0. -?RCS: -?RCS: $Log: sig_name.U,v $ -?RCS: Revision 3.0 1993/08/18 12:09:47 ram -?RCS: Baseline for dist 3.0 netwide release. -?RCS: -?MAKE:sig_name: awk rm Findhdr -?MAKE: -pick add $@ %< -?S:sig_name: -?S: This variable holds the signal names, space separated. The leading -?S: SIG in signals name is removed. -?S:. -?C:SIG_NAME: -?C: This symbol contains a list of signal names in order. This is intended -?C: to be used as a static array initialization, like this: -?C: char *sig_name[] = { SIG_NAME }; -?C: The signals in the list are separated with commas, and each signal -?C: is surrounded by double quotes. There is no leading SIG in the signal -?C: name, i.e. SIGQUIT is known as "QUIT". -?C:. -?H:#define SIG_NAME "`echo $sig_name | sed 's/ /","/g'`" /**/ -?H:. -?T:xxx -: generate list of signal names -echo " " -case "$sig_name" in -'') - echo "Generating a list of signal names..." >&4 - xxx=`./findhdr signal.h`" "`./findhdr sys/signal.h` - set X `cat $xxx 2>&1 | $awk ' -$1 ~ /^#define$/ && $2 ~ /^SIG[A-Z0-9]*$/ && $3 ~ /^[1-9][0-9]*$/ { - sig[$3] = substr($2,4,20) - if (max < $3 && $3 < 60) { - max = $3 - } -} - -END { - for (i = 1; i <= max; i++) { - if (sig[i] == "") - printf "%d", i - else - printf "%s", sig[i] - if (i < max) - printf " " - } - printf "\n" -} -'` - shift - case $# in - 0) - echo 'kill -l' >/tmp/foo$$ - set X `csh -f 70) - { - printf "\n" - linelen = length(name) - } - printf "%s", name } }' diff --git a/U/voidflags.U b/U/voidflags.U deleted file mode 100644 index 7d9a0d0..0000000 --- a/U/voidflags.U +++ /dev/null @@ -1,148 +0,0 @@ -?RCS: $Id: voidflags.U,v 3.0 1993/08/18 12:10:01 ram Exp $ -?RCS: -?RCS: Copyright (c) 1991-1993, Raphael Manfredi -?RCS: -?RCS: You may redistribute only under the terms of the Artistic Licence, -?RCS: as specified in the README file that comes with the distribution. -?RCS: You may reuse parts of this distribution only within the terms of -?RCS: that same Artistic Licence; a copy of which may be found at the root -?RCS: of the source tree for dist 3.0. -?RCS: -?RCS: $Log: voidflags.U,v $ -?RCS: Revision 3.0 1993/08/18 12:10:01 ram -?RCS: Baseline for dist 3.0 netwide release. -?RCS: -?MAKE:voidflags defvoidused: cat rm contains cc package Oldconfig Myread -?MAKE: -pick add $@ %< -?S:voidflags: -?S: This variable contains the eventual value of the VOIDFLAGS symbol, -?S: which indicates how much support of the void type is given by this -?S: compiler. See VOIDFLAGS for more info. -?S:. -?X: Exceptionally, we have to explicitely alias the symbol name for -?X: config_h.SH, otherwise the comment would not appear. -?C:VOIDFLAGS ~ %<: -?C: This symbol indicates how much support of the void type is given by this -?C: compiler. What various bits mean: -?C: -?C: 1 = supports declaration of void -?C: 2 = supports arrays of pointers to functions returning void -?C: 4 = supports comparisons between pointers to void functions and -?C: addresses of void functions -?C: 8 = suports declaration of generic void pointers -?C: -?C: The package designer should define VOIDUSED to indicate the requirements -?C: of the package. This can be done either by #defining VOIDUSED before -?C: including config.h, or by defining defvoidused in Myinit.U. If the -?C: latter approach is taken, only those flags will be tested. If the -?C: level of void support necessary is not present, defines void to int. -?C:. -?H:?%<:#ifndef VOIDUSED -?H:?%<:# define VOIDUSED $defvoidused -?H:?%<:#endif -?H:?%<:#define VOIDFLAGS $voidflags -?H:?%<:#if (VOIDFLAGS & VOIDUSED) != VOIDUSED -?H:?%<:# define void int /* is void to be avoided? */ -?H:?%<:# define M_VOID /* Xenix strikes again */ -?H:?%<:# define VOID -?H:?%<:#else -?H:?%<:# define VOID void -?H:?%<:#endif -?H:. -?W:%<:void VOID VOIDUSED -?INIT:: full support for void wanted by default -?INIT:defvoidused=15 -?INIT: -?LINT:describe defvoidused -?LINT:known void M_VOID VOIDUSED -: check for void type -echo " " -$cat >&4 <try.c <<'EOCP' -#if TRY & 1 -void main() { -#else -main() { -#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); -} -EOCP -?X: This unit used to use cc -S in those tests to try to speed up things, but -?X: unfortunately, AIX 3.2 does not support this option. - if $cc -c -DTRY=$defvoidused try.c >.out 2>&1 ; then - voidflags=$defvoidused - echo "It appears to support void to the level $package wants ($defvoidused)." - 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 -c -DTRY=1 try.c >/dev/null 2>&1 ; then - echo "It supports 1..." - if $cc -c -DTRY=3 try.c >/dev/null 2>&1 ; then - echo "It also supports 2..." - if $cc -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 -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 -c -DTRY=13 try.c >/dev/null 2>&1 ; then - voidflags=13 - echo "But it supports 4 and 8." - else - if $cc -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 -dflt="$voidflags"; -rp="Your void support flags add up to what?" -. ./myread -voidflags="$ans" -$rm -f try.* .out - diff --git a/U/yacc.U b/U/yacc.U deleted file mode 100644 index 679970c..0000000 --- a/U/yacc.U +++ /dev/null @@ -1,81 +0,0 @@ -?RCS: $Id: yacc.U,v 3.0 1993/08/18 12:10:03 ram Exp $ -?RCS: -?RCS: Copyright (c) 1991-1993, Raphael Manfredi -?RCS: -?RCS: You may redistribute only under the terms of the Artistic Licence, -?RCS: as specified in the README file that comes with the distribution. -?RCS: You may reuse parts of this distribution only within the terms of -?RCS: that same Artistic Licence; a copy of which may be found at the root -?RCS: of the source tree for dist 3.0. -?RCS: -?RCS: $Log: yacc.U,v $ -?RCS: Revision 3.0 1993/08/18 12:10:03 ram -?RCS: Baseline for dist 3.0 netwide release. -?RCS: -?MAKE:yacc yaccflags: Guess Myread Oldconfig byacc bison cat test package -?MAKE: -pick add $@ %< -?S:yacc: -?S: This variable holds the name of the compiler compiler we -?S: want to use in the Makefile. It can be yacc, byacc, or bison -y. -?S:. -?S:yaccflags: -?S: This variable contains any additional yacc flags desired by the -?S: user. It is up to the Makefile to use this. -?S:. -: determine compiler compiler -case "$yacc" in -'') - dflt=yacc;; -*) - dflt="$yacc";; -esac -echo " " -rp="yacc" -if $test -f "$byacc"; then - dflt="$byacc" - rp="byacc or $rp" -fi -if $test -f "$bison"; then - rp="$rp or bison -y" -fi -$cat <CHARVSPRINTF -!>GIDTYPE -!>HAS_GDBM -!>SAFE_BCOPY -!>STATBLOCKS -!>STDSTDIO -!>UIDTYPE ->ALIGNBYTES ->BIN ->BSD ->BYTEORDER ->CASTFLAGS ->CASTI32 ->CASTNEGFLOAT ->CHARSPRINTF ->CPPMINUS ->CPPSTDIN ->CSH ->DIRNAMLEN ->DOSUID ->EUNICE ->FLEXFILENAMES ->F_OK ->GROUPSTYPE ->Gid_t ->HASVOLATILE ->HAS_BCMP ->HAS_BCOPY ->HAS_BZERO ->HAS_CHSIZE ->HAS_CRYPT ->HAS_DUP2 ->HAS_FCHMOD ->HAS_FCHOWN ->HAS_FCNTL ->HAS_FLOCK ->HAS_GETGROUPS ->HAS_GETHOSTENT ->HAS_GETPGRP ->HAS_GETPGRP2 ->HAS_GETPRIORITY ->HAS_HTONL ->HAS_HTONS ->HAS_ISASCII ->HAS_KILLPG ->HAS_LINK ->HAS_LSTAT ->HAS_MEMCMP ->HAS_MEMCPY ->HAS_MEMMOVE ->HAS_MEMSET ->HAS_MKDIR ->HAS_MSG ->HAS_MSGCTL ->HAS_MSGGET ->HAS_MSGRCV ->HAS_MSGSND ->HAS_NTOHL ->HAS_NTOHS ->HAS_OPEN3 ->HAS_READDIR ->HAS_RENAME ->HAS_RMDIR ->HAS_SAFE_BCOPY ->HAS_SAFE_MEMCPY ->HAS_SELECT ->HAS_SEM ->HAS_SEMCTL ->HAS_SEMGET ->HAS_SEMOP ->HAS_SETEGID ->HAS_SETEUID ->HAS_SETLOCALE ->HAS_SETPGID ->HAS_SETPGRP ->HAS_SETPGRP2 ->HAS_SETPRIORITY ->HAS_SETREGID ->HAS_SETRESGID ->HAS_SETRESUID ->HAS_SETREUID ->HAS_SETRGID ->HAS_SETRUID ->HAS_SETSID ->HAS_SHM ->HAS_SHMAT ->HAS_SHMCTL ->HAS_SHMDT ->HAS_SHMGET ->HAS_SOCKET ->HAS_SOCKETPAIR ->HAS_STRERROR ->HAS_SYMLINK ->HAS_SYSCALL ->HAS_SYSTEM ->HAS_SYS_ERRLIST ->HAS_TIMES ->HAS_TRUNCATE ->HAS_UNAME ->HAS_VFORK ->HAS_VPRINTF ->HAS_WAIT4 ->HAS_WAITPID ->INTSIZE ->I_DBM ->I_DIRENT ->I_FCNTL ->I_GDBM ->I_GRP ->I_NDBM ->I_NDIR ->I_NETINET_IN ->I_PWD ->I_STDARG ->I_STDDEF ->I_SYS_DIR ->I_SYS_FILE ->I_SYS_IN ->I_SYS_IOCTL ->I_SYS_NDIR ->I_SYS_SELECT ->I_SYS_TIME ->I_TIME ->I_UTIME ->I_VARARGS ->I_VFORK ->Malloc_t ->O_APPEND ->O_CREAT ->O_EXCL ->O_RDONLY ->O_RDWR ->O_TRUNC ->O_WRONLY ->PRIVLIB ->PWAGE ->PWCHANGE ->PWCLASS ->PWCOMMENT ->PWEXPIRE ->PWQUOTA ->RANDBITS ->R_OK ->SCRIPTDIR ->SIG_NAME ->STDCHAR ->Strerror ->USE_CHAR_VSPRINTF ->USE_OLDSOCKET ->USE_STAT_BLOCKS ->USE_STD_STDIO ->USE_STRUCT_COPY ->Uid_t ->VMS ->VOID ->VOIDSIG ->VOIDWANT ->W_OK ->X_OK ->_ ->bcmp ->bcopy ->bzero ->const ->dlopen ->getgroups ->index ->rindex ->va_dcl ->vfork ->void ->volatile -Date -Log -RCSfile -Revision -alignbytes -bin -byacc -byteorder -c -castflags -cat -cc -ccflags -cp -cppflags -cppminus -cppstdin -cryptlib -csh -d_access -d_bcmp -d_bcopy -d_bsd -d_bzero -d_casti32 -d_castneg -d_charsprf -d_charvspr -d_chsize -d_const -d_crypt -d_csh -d_dirnamlen -d_dosuid -d_dup2 -d_eunice -d_fchmod -d_fchown -d_fcntl -d_flexfnam -d_flock -d_gethent -d_getpgrp -d_getpgrp2 -d_getprior -d_htonl -d_isascii -d_killpg -d_link -d_lstat -d_memcmp -d_memcpy -d_memmove -d_memset -d_mkdir -d_msg -d_msgctl -d_msgget -d_msgrcv -d_msgsnd -d_oldsock -d_open3 -d_pwage -d_pwchange -d_pwclass -d_pwcomment -d_pwexpire -d_pwquota -d_readdir -d_rename -d_rmdir -d_safebcpy -d_safemcpy -d_select -d_sem -d_semctl -d_semget -d_semop -d_setegid -d_seteuid -d_setlocale -d_setpgid -d_setpgrp -d_setpgrp2 -d_setprior -d_setregid -d_setresgid -d_setresuid -d_setreuid -d_setrgid -d_setruid -d_setsid -d_shm -d_shmat -d_shmctl -d_shmdt -d_shmget -d_socket -d_sockpair -d_statblks -d_stdstdio -d_strchr -d_strctcpy -d_strerrm -d_strerror -d_symlink -d_syscall -d_syserrlst -d_system -d_times -d_truncate -d_uname -d_vfork -d_voidsig -d_volatile -d_vprintf -d_wait4 -d_waitpid -dlobj -dlsrc -echo -egrep -eunicefix -expr -extensions -find -gidtype -groupstype -i_dbm -i_dirent -i_fcntl -i_gdbm -i_grp -i_ndbm -i_ndir -i_niin -i_pwd -i_stdarg -i_stddef -i_sysdir -i_sysfile -i_sysin -i_sysioctl -i_sysndir -i_sysselct -i_systime -i_time -i_utime -i_varargs -i_varhdr -i_vfork -installbin -installprivlib -intsize -large -ldflags -lib -libs -line -mallocobj -mallocsrc -malloctype -manext -mansrc -mkdir -mv -n -optimize -perl -privlib -prototype -randbits -rm -scriptdir -sed -sig_name -small -sort -spitshell -split -startsh -stdchar -test -tr -uidtype -uname -uniq -voidflags -yacc diff --git a/XSUB.h b/XSUB.h index a8a193b..508ebd7 100644 --- a/XSUB.h +++ b/XSUB.h @@ -1 +1,22 @@ -#define ST(s) stack_base[ax + s] +#define ST(off) stack_base[ax + off] + +#ifdef CAN_PROTOTYPE +#define XS(name) void name(CV* cv) +#else +#define XS(name) void name(cv) CV* cv; +#endif + +#define dXSARGS \ + dSP; dMARK; \ + I32 ax = mark - stack_base + 1; \ + I32 items = sp - mark + +#define XSANY CvXSUBANY(cv) + +#define dXSI32 I32 ix = XSANY.any_i32 + +#define XSRETURN(off) stack_sp = stack_base + ax + ((off) - 1); return + +#define XSRETURNNO ST(0)=sv_mortalcopy(&sv_no); XSRETURN(1) +#define XSRETURNYES ST(0)=sv_mortalcopy(&sv_yes); XSRETURN(1) +#define XSRETURNUNDEF ST(0)=sv_mortalcopy(&sv_undef); XSRETURN(1) diff --git a/atarist/FILES b/atarist/FILES deleted file mode 100644 index 752f8e2..0000000 --- a/atarist/FILES +++ /dev/null @@ -1,48 +0,0 @@ - -Shipping list for the perl 4.019 atariST port: - -perl.diffs contains diffs from the following perl 4.019 files: - - perl.h arg.h handy.h doarg.c doio.c eval.c malloc.c perl.c regcomp.c - str.c toke.c util.c - - the file `explain' contains a brief explaination of the diffs in - `perl.diffs' - -The following files are supplied whole (not as diffs) and replace files with -the same name from the perl 4.019 distribution: - - config.h usersub.c - -The following files are specific to this atariST port: - - atarist.c echo.c wildmat.c perlglob.c - makefile.sm makefile.st - -The following files are in usub/ - - makefile.st README.ATARI usersub.c acurses.mus - -The following files should be added to the perl 4.019 library: - - osbind.pl perldb.diff (diffs against perldb.pl in perl 4.019 lib) - -AtariST specific tests - - test/* - -Misc: - - FILES README.ST (read this) RESULTS (explains results of tests) - explain (explains perl.diffs) - -Some binary distributions will also contain: - perl.ttp uperl.a cperl.ttp (cursesperl) perld.ttp - (these are all buildable using the material above). - -If you are missing any of the files on this list, please mail me. Please -dont ask me to mail binaries. Some of the binaries are available at -various atari archives, including atari.archive.umich.edu in -atari/languages/perl4019.zoo. - - ++jrb bammi@cadence.com diff --git a/atarist/README.ST b/atarist/README.ST deleted file mode 100644 index 0d42ba0..0000000 --- a/atarist/README.ST +++ /dev/null @@ -1,186 +0,0 @@ -See: FILES for a shipping list of files in this archive. -See: explain for a brief explaination of the diffs in perl.diffs. - -Here is a port of perl 4.0 Patchlevel 19 to the atariST series.: - -Whats new since atariST perl 4.010 - - many minor problems fixed. - - - configuration cleaned up. - - - makefiles now have a uperl.a target, so that usub's can be - linked. (see usub/* to see how to make cursesperl) - - - perl will now compile and run correctly with or without - the malloc that comes with perl. - - - FILEs opened for write now correctly contain CR/LF unless - they are binmode'ed. - - - complete support for gemdos/xbios/bios calls. see osbind.pl - and osexample.pl on how to use this facility. - - - tracked perl to Patchlevel 19. - -known problems: - - $! still does'nt contain the correct value when there is no error. - i still have'nt been able to track this down. - -------------------------------------------------------------------------- - -Here is a port of perl 4.0 Patchlevel 10 to the atariST series. - -What you'll need: - - a decent shell (i use gulam for obvious reasons), other - highly recommended ones are bash 1.08/1.10, gemini/mufpel, okami, - microCsh, init from apratt for MiNT. avoid neodesk. avoid the - desktop like the plague. The shell should be setup to use - atari/mwc conventions for command lines and environment setup - and passing. (in gulam be sure to `set env_style mw'). - - - a decent set of file utils (ls, rm, mv, etc etc) in your $PATH. - if you dont have these, look on atari.archive. the gnuFileutils - are available there. - - - included here are echo and perlglob that you will need. - - - setting UNIXMODE is recommended but not required. If you are - going to run the perl tests, then set UNIXMODE to atleast - "/.,LAd", else you will get a lot of unnecessary failures. - (alternately you will have to go in and edit long path names. - get rid of things dealing with links, and rename paths - beginning with "/dev/..." etc) - - - if you are going to compile: you'll need gcc distribution, - (i used gcc-1.40 and libs at Patchlevel 73 initially. i - currently use gcc-2.1 and libs at Patchlevel 80). Also you will - need the port of gdbm (i used v1.5). you'll also need bison. - all these are available on atari.archive, in atari/gnustuff/tos - the diffs as enclosed in this kit assume you have gcc libs at - Patchlevel 80. - -Compiling: - - get and install gnu gdbm (i used v1.5 -- see README.ST in - the gdbm distribution on how to make the gdbm library). - - - get the perl kit at Patchlevel 19 - - - copy config.h usersub.c atarist.c echo.c wildmat.c perlglob.c - makefile.sm makefile.smd makefile.st makefile.std makefile.stm - - - apply the diffs in file `perl.diffs' using patch - - - decide which makefile you want to use: - makefile.st perl with gcc library malloc - makefile.sm perl with malloc that comes with perl - - - hit make -f . (if you are not cross-compiling, - you'll have to adjust the makefile yourself -- watchout for - perly.fixer). - This will result in 3 executables, perl.ttp, perlglob.ttp - and echo.ttp. Put all these executables in a sub-directory - in your $PATH (and depending on your shell, issue a rehash). - (if you use makefile.std instead of makefile.st, the executable - will be called perld.ttp. this is perl compiled with - -DDEBUGGING) - -Compiling usubs: - see the files in usub/* and the makefile.st there. - -Testing: - - run perl from a decent shell. i use either gulam or bash - if you are going to be running from gulam, be sure to - set env_style mw - (this can be done automatically by including the above - line in the gulam.g startup file). bash always uses - atari/mwc conventions so you dont have to do anything special. - (if you run perl from the desktop, you are asking for trouble!) - - - you'll have to run the tests by hand. Almost all the tests - pass. You'll have to judge for yourself when a test fails - if it should have. I was able to explain all failures. If you - cant, ask me via mail. (one day i will cook up a script to - do this). - - - It helps to have all the gnu fileutils in your PATH here. - especially echo.ttp and perlglob.ttp. - - - Also a lot more tests will pass if you have UNIXMODE setup - i use "/.,LAd". If you dont use UNIXMODE, you'll have to hack - some of the tests. - - - You may have to fix up a few Pathnames in the tests if you - are cd'ing to a particular test sub-directory to run the tests. - - - Compare your tests with the results i got -- see file RESULTS. - -General: - - setenv PERLLIB to point at the subdirectory containing lib/* - (if you want PERLLIB to contain more than one path, seperate - them with commas) - - - UNIXMODE is supported not required. - - - Pipes are a little flakey sometimes, but mostly work fine. - Pipes, `prog` etc are much more efficient if you have set - the environment var TEMP to point to a ramdisk. Note, when - you set TEMP, it should contain *no* tailing backslash (or slash). - - - to force binary mode use "binmode FILE" - - - browse thru config.h to see whats supported - - - should MiNT'ize this much more. - - - avoid using the backtick (`commands`). Use 'open(FOO, "command |")' - and use the filehandle FOO as appro. - - - the command passed to system etc can contain - redirections of stdin/out, but system does not understand - fancy pipelines etc. - - - syscall() to make gemdos/bios/xbios are fully supported now. - (note: we dont use ioctl like messy-dos to do this, as we can do - real ioctl's on devices) - - - i still need to cons up the lineA stuff. - it should be just as easy to cons up aes/vdi outcalls too. imagine - graphics from perl!. - - - watch out for re-directions. TOS blows up if you try to - re-direct a re-directed handle. atari has greatly improved this - situation. hopefully, the next general release of TOS will contain - these fixes. - - - in the perl libs (particularly perldb.pl) you will - need to s?/dev/tty?/dev/console?. perl -d works just fine. - for instance: (for this to work, UNIXMODE should include the - 'd' option): -*** /home/bammi/etc/src/perl/lib/perldb.pl Tue Jun 11 17:40:17 1991 ---- perldb.pl Mon Oct 7 21:46:28 1991 -*************** -*** 49,56 **** - # - # - -! open(IN, "/dev/tty") || open(OUT, ">&STDOUT"); # so we don't dongle stdout - select(OUT); - $| = 1; # for DB'OUT - select(STDOUT); ---- 49,56 ---- - # - # - -! open(IN, "/dev/console") || open(OUT, ">&STDOUT"); # so we don't dongle stdout - select(OUT); - $| = 1; # for DB'OUT - select(STDOUT); - -cheers, --- -bang: uunet!cadence!bammi jwahar r. bammi -domain: bammi@cadence.com -GEnie: J.Bammi -CIS: 71515,155 diff --git a/atarist/RESULTS b/atarist/RESULTS deleted file mode 100644 index d276890..0000000 --- a/atarist/RESULTS +++ /dev/null @@ -1,120 +0,0 @@ -t/base: - -cond.t -if.t -lex.t -pat.t -term.t - -all of these pass. if you are running from this directory -make sure you have a file ..\Makefile for term.t to pass. - -================================= - -t/cmd: - -elsif.t -for.t -mod.t -subval.t -switch.t -while.t - -all of these passed. be sure to set UNIXMODE for these to pass. -make sure there is a file called ./TEST if you run in this sub-directory -for mod.t. - -================================= - -t/comp: - -cmdopt.t -decl.t -package.t -script.t -term.t -multiline.t - -all these work. if you are running in this subdir then cp perl.ttp ./perl -before running. - -cpp.t - fails. i need to fix for -P. -================================= - -t/io: - -if you are running in this subdir make sure: --- there is a file ../Makefile --- have a ./perl - -argv.t: 2 & 3 fail - `.....` with pipes will not work. redirections may (have'nt checked) - -dup.t: only 1 will pass. what the hell is the rest doing (the atari goes - into in infinite loop) - -pipe.t: fails. have to look into this. pipe() on the atari sort of -work most of the time. see gcc-lib/pipe.c - -print.t: all pass -tell.t: all pass -================================= - -t/lib: - -bit.t : pass -================================= - -t/op: - -append.t pass -array.t pass -auto.t pass -chop.t pass -cond.t pass -dbm.t -- cant possibly work with gdbm, it does'nt create .pag etc files -gdbm.t added new test to test gdbm based perl -delete.t pass -do.t pass -each.t pass -eval.t pass -exec.t 4,5,6 fail rest pass (obviously) -exp.t pass -flip.t pass -fork.t correctly fails -glob.t 1 fails rest pass (as i said dont depend on `....` to work on the ST) -goto.t 1,2 pass 3 fail (again because of `...`) -groups.t makes no sense on the ST -index.t pass -int.t pass -join.t pass -list.t pass -local.t pass -magic.t fail obviously -mkdir.t the failure is obvious, rest pass (our err strings dont match unix's) -oct.t pass -ord.t pass -pack.t pass -pat.t pass!!!! (works with lib malloc too now, yeah!) -push.t pass -range.t pass -read.t pass -regexp.t pass! (make sure re_tests is in cwd if running in cwd, and edit - path in regexp.t) -repeat.t pass -s.t pass -sleep.t pass -sort.t pass -split.t pass -sprintf.t pass -stat.t obvious ones fail, looks good -study.t pass -substr.t pass -time.t pass -undef.t pass -unshift.t pass -vec.t pass -write.t fail due to `...` -================================= - diff --git a/atarist/atarist.c b/atarist/atarist.c deleted file mode 100644 index 2d69c9d..0000000 --- a/atarist/atarist.c +++ /dev/null @@ -1,282 +0,0 @@ -/* - * random stuff for atariST - */ - -#include "EXTERN.h" -#include "perl.h" - -/* call back stuff, atari specific stuff below */ -/* Be sure to refetch the stack pointer after calling these routines. */ - -int -callback(subname, sp, gimme, hasargs, numargs) -char *subname; -int sp; /* stack pointer after args are pushed */ -int gimme; /* called in array or scalar context */ -int hasargs; /* whether to create a @_ array for routine */ -int numargs; /* how many args are pushed on the stack */ -{ - static ARG myarg[3]; /* fake syntax tree node */ - int arglast[3]; - - arglast[2] = sp; - sp -= numargs; - arglast[1] = sp--; - arglast[0] = sp; - - if (!myarg[0].arg_ptr.arg_str) - myarg[0].arg_ptr.arg_str = str_make("",0); - - myarg[1].arg_type = A_WORD; - myarg[1].arg_ptr.arg_stab = stabent(subname, FALSE); - - myarg[2].arg_type = hasargs ? A_EXPR : A_NULL; - - return do_subr(myarg, gimme, arglast); -} - -int -callv(subname, sp, gimme, argv) -char *subname; -register int sp; /* current stack pointer */ -int gimme; /* called in array or scalar context */ -register char **argv; /* null terminated arg list, NULL for no arglist */ -{ - register int items = 0; - int hasargs = (argv != 0); - - astore(stack, ++sp, Nullstr); /* reserve spot for 1st return arg */ - if (hasargs) { - while (*argv) { - astore(stack, ++sp, str_2mortal(str_make(*argv,0))); - items++; - argv++; - } - } - return callback(subname, sp, gimme, hasargs, items); -} - -#include -#include - -long _stksize = 64*1024L; -unsigned long __DEFAULT_BUFSIZ__ = 4 * 1024L; - -/* - * The following code is based on the do_exec and do_aexec functions - * in file doio.c - */ -int -do_aspawn(really,arglast) -STR *really; -int *arglast; -{ - register STR **st = stack->ary_array; - register int sp = arglast[1]; - register int items = arglast[2] - sp; - register char **a; - char **argv; - char *tmps; - int status; - - if (items) { - New(1101,argv, items+1, char*); - a = argv; - for (st += ++sp; items > 0; items--,st++) { - if (*st) - *a++ = str_get(*st); - else - *a++ = ""; - } - *a = Nullch; - if (really && *(tmps = str_get(really))) - status = spawnvp(-P_WAIT,tmps,argv); /* -P_WAIT is a hack, see spawnvp.c in the lib */ - else - status = spawnvp(-P_WAIT,argv[0],argv); - Safefree(argv); - } - return status; -} - - -int -do_spawn(cmd) -char *cmd; -{ - return system(cmd); -} - -#if 0 /* patchlevel 79 onwards we can */ -/* - * we unfortunately cannot use the super efficient fread/write from the lib - */ -size_t fread(void *data, size_t size, size_t count, FILE *fp) -{ - size_t i, j; - unsigned char *buf = (unsigned char *)data; - int c; - - for(i = 0; i < count; i++) - { - for(j = 0; j < size; j++) - { - if((c = getc(fp)) == EOF) - return 0; - *buf++ = c; - } - } - return i; -} - -size_t fwrite(const void *data, size_t size, size_t count, FILE *fp) -{ - size_t i, j; - const unsigned char *buf = (const unsigned char *)data; - - for(i = 0; i < count; i++) - { - for(j = 0; j < size; j++) - { - if(fputc(*buf++, fp) == EOF) - return 0; - } - } - return i; -} -#endif - -#ifdef HAS_SYSCALL -#define __NO_INLINE__ -#include /* must include this for proper protos */ - -/* these must match osbind.pl */ -#define TRAP_1_W 1 -#define TRAP_1_WW 2 -#define TRAP_1_WL 3 -#define TRAP_1_WLW 4 -#define TRAP_1_WWW 5 -#define TRAP_1_WLL 6 -#define TRAP_1_WWLL 7 -#define TRAP_1_WLWW 8 -#define TRAP_1_WWLLL 9 -#define TRAP_13_W 10 -#define TRAP_13_WW 11 -#define TRAP_13_WL 12 -#define TRAP_13_WWW 13 -#define TRAP_13_WWL 14 -#define TRAP_13_WWLWWW 15 -#define TRAP_14_W 16 -#define TRAP_14_WW 17 -#define TRAP_14_WL 18 -#define TRAP_14_WWW 19 -#define TRAP_14_WWL 20 -#define TRAP_14_WWLL 21 -#define TRAP_14_WLLW 22 -#define TRAP_14_WLLL 23 -#define TRAP_14_WWWL 24 -#define TRAP_14_WWWWL 25 -#define TRAP_14_WLLWW 26 -#define TRAP_14_WWWWWWW 27 -#define TRAP_14_WLLWWWWW 28 -#define TRAP_14_WLLWWWWLW 29 -#define TRAP_14_WLLWWWWWLW 30 - -int syscall(trap, fn, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12 ) -unsigned long trap, fn, a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12; -{ - /* for now */ - switch(trap) - { - case TRAP_1_W: - return trap_1_w(fn); - - case TRAP_1_WW: - return trap_1_ww(fn, a1); - - case TRAP_1_WL: - return trap_1_wl(fn, a1); - - case TRAP_1_WLW: - return trap_1_wlw(fn, a1, a2); - - case TRAP_1_WWW: - return trap_1_www(fn, a1, a2); - - case TRAP_1_WLL: - return trap_1_wll(fn, a1, a2); - - case TRAP_1_WWLL: - return trap_1_wwll(fn, a1, a2, a3); - - case TRAP_1_WLWW: - return trap_1_wlww(fn, a1, a2, a3); - - case TRAP_1_WWLLL: - return trap_1_wwlll(fn, a1, a2, a3, a4); - - case TRAP_13_W: - return trap_13_w(fn); - - case TRAP_13_WW: - return trap_13_ww(fn, a1); - - case TRAP_13_WL: - return trap_13_wl(fn, a1); - - case TRAP_13_WWW: - return trap_13_www(fn, a1, a2); - - case TRAP_13_WWL: - return trap_13_wwl(fn, a1, a2); - - case TRAP_13_WWLWWW: - return trap_13_wwlwww(fn, a1, a2, a3, a4, a5); - - case TRAP_14_W: - return trap_14_w(fn); - - case TRAP_14_WW: - return trap_14_ww(fn, a1); - - case TRAP_14_WL: - return trap_14_wl(fn, a1); - - case TRAP_14_WWW: - return trap_14_www(fn, a1, a2); - - case TRAP_14_WWL: - return trap_14_wwl(fn, a1, a2); - - case TRAP_14_WWLL: - return trap_14_wwll(fn, a1, a2, a3); - - case TRAP_14_WLLW: - return trap_14_wllw(fn, a1, a2, a3); - - case TRAP_14_WLLL: - return trap_14_wlll(fn, a1, a2, a3); - - case TRAP_14_WWWL: - return trap_14_wwwl(fn, a1, a2, a3); - - case TRAP_14_WWWWL: - return trap_14_wwwwl(fn, a1, a2, a3, a4); - - case TRAP_14_WLLWW: - return trap_14_wllww(fn, a1, a2, a3, a4); - - case TRAP_14_WWWWWWW: - return trap_14_wwwwwww(fn, a1, a2, a3, a4, a5, a6); - - case TRAP_14_WLLWWWWW: - return trap_14_wllwwwww(fn, a1, a2, a3, a4, a5, a6, a7); - - case TRAP_14_WLLWWWWLW: - return trap_14_wllwwwwlw(fn, a1, a2, a3, a4, a5, a6, a7, a8); - - case TRAP_14_WLLWWWWWLW: - return trap_14_wllwwwwwlw(fn, a1, a2, a3, a4, a5, a6, a7, a8, a9); - } -} -#endif - diff --git a/atarist/config.h b/atarist/config.h deleted file mode 100644 index 7e43254..0000000 --- a/atarist/config.h +++ /dev/null @@ -1,912 +0,0 @@ -#ifndef config_h -#define config_h -/* config.h - * 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. - */ - /*SUPPRESS 460*/ - - -/* EUNICE - * This symbol, if defined, indicates that the program is being compiled - * under the EUNICE package under VMS. The program will need to handle - * things like files that don't go away the first time you unlink them, - * due to version numbering. It will also need to compensate for lack - * of a respectable link() command. - */ -/* VMS - * This symbol, if defined, indicates that the program is running under - * VMS. It is currently only set in conjunction with the EUNICE symbol. - */ -/*#undef EUNICE /**/ -/*#undef VMS /**/ - -/* ALIGNBYTES - * This symbol contains the number of bytes required to align a double. - * Usual values are 2, 4, and 8. - */ -#define ALIGNBYTES 2 /**/ - -/* BIN - * This symbol holds the name of the directory in which the user wants - * to keep publicly executable images for the package in question. It - * is most often a local directory such as /usr/local/bin. - */ -#define BIN "/bin" /**/ - -/* BYTEORDER - * This symbol contains an encoding of the order of bytes in a long. - * Usual values (in hex) are 0x1234, 0x4321, 0x2143, 0x3412... - */ -#define BYTEORDER 0x4321 /**/ - -/* 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". - */ -/* 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 "". - */ -#define CPPSTDIN "gcc -E" -#define CPPMINUS "" - -/* HAS_BCMP - * This symbol, if defined, indicates that the bcmp routine is available - * to compare blocks of memory. If undefined, use memcmp. If that's - * not available, roll your own. - */ -#define HAS_BCMP /**/ - -/* HAS_BCOPY - * This symbol, if defined, indicates that the bcopy routine is available - * to copy blocks of memory. Otherwise you should probably use memcpy(). - * If neither is defined, roll your own. - */ -/* SAFE_BCOPY - * This symbol, if defined, indicates that the bcopy routine is available - * to copy potentially overlapping copy blocks of bcopy. Otherwise you - * should probably use memmove() or memcpy(). If neither is defined, - * roll your own. - */ -#define HAS_BCOPY /**/ -#define SAFE_BCOPY /**/ - -/* HAS_BZERO - * This symbol, if defined, indicates that the bzero routine is available - * to zero blocks of memory. Otherwise you should probably use memset() - * or roll your own. - */ -#define HAS_BZERO /**/ - -/* CASTNEGFLOAT - * This symbol, if defined, indicates that this C compiler knows how to - * cast negative or large floating point 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: - * 1 = couldn't cast < 0 - * 2 = couldn't cast >= 0x80000000 - */ -#define CASTNEGFLOAT /**/ -#define CASTFLAGS 0 /**/ - -/* CHARSPRINTF - * This symbol is defined if this system declares "char *sprintf()" in - * stdio.h. The trend seems to be to declare it as "int sprintf()". It - * is up to the package author to declare sprintf correctly based on the - * symbol. - */ -/* #define CHARSPRINTF /**/ - -/* 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. - */ -/*#undef HAS_CHSIZE /**/ - -/* HAS_CRYPT - * This symbol, if defined, indicates that the crypt routine is available - * to encrypt passwords and the like. - */ -/* #define HAS_CRYPT /**/ - -/* CSH - * This symbol, if defined, indicates that the C-shell exists. - * If defined, contains the full pathname of csh. - */ -/* #define CSH "/bin/csh" /**/ - -/* 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. - */ -/*#undef DOSUID /**/ - -/* HAS_DUP2 - * This symbol, if defined, indicates that the dup2 routine is available - * to dup file descriptors. Otherwise you should use dup(). - */ -#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 /**/ - -/* 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_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_GETHOSTENT - * This symbol, if defined, indicates that the gethostent() routine is - * available to lookup host names in some data base or other. - */ -/* #define HAS_GETHOSTENT /**/ - -/* HAS_GETPGRP - * This symbol, if defined, indicates that the getpgrp() routine is - * available to get the current process group. - */ -#define HAS_GETPGRP /**/ - -/* HAS_GETPGRP2 - * This symbol, if defined, indicates that the getpgrp2() (as in DG/UX) - * routine is available to get the current process group. - */ -/*#undef HAS_GETPGRP2 /**/ - -/* HAS_GETPRIORITY - * This symbol, if defined, indicates that the getpriority() routine is - * available to get a process's priority. - */ -/* #define HAS_GETPRIORITY /**/ - -/* HAS_HTONS - * This symbol, if defined, indicates that the htons routine (and friends) - * are available to do network order byte swapping. - */ -/* HAS_HTONL - * This symbol, if defined, indicates that the htonl routine (and friends) - * are available to do network order byte swapping. - */ -/* HAS_NTOHS - * This symbol, if defined, indicates that the ntohs routine (and friends) - * are available to do network order byte swapping. - */ -/* HAS_NTOHL - * This symbol, if defined, indicates that the ntohl routine (and friends) - * are available to do network order byte swapping. - */ -/* #define HAS_HTONS /**/ -/* #define HAS_HTONL /**/ -/* #define HAS_NTOHS /**/ -/* #define HAS_NTOHL /**/ - -/* index - * This preprocessor symbol is defined, along with rindex, if the system - * uses the strchr and strrchr routines instead. - */ -/* rindex - * This preprocessor symbol is defined, along with index, if the system - * uses the strchr and strrchr routines instead. - */ -/* #define index strchr /* cultural */ -/* #define rindex strrchr /* differences? */ -#include - -/* HAS_ISASCII - * This symbol, if defined, indicates that the isascii routine is available - * to test characters for asciiness. - */ -#define HAS_ISASCII /**/ - -/* 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_LSTAT - * This symbol, if defined, indicates that the lstat() routine is - * available to stat symbolic links. - */ -#define HAS_LSTAT /**/ - -/* HAS_MEMCMP - * This symbol, if defined, indicates that the memcmp routine is available - * to compare blocks of memory. If undefined, roll your own. - */ -#define HAS_MEMCMP /**/ - -/* HAS_MEMCPY - * This symbol, if defined, indicates that the memcpy routine is available - * to copy blocks of memory. Otherwise you should probably use bcopy(). - * If neither is defined, roll your own. - */ -/* SAFE_MEMCPY - * This symbol, if defined, indicates that the memcpy routine is available - * to copy potentially overlapping copy blocks of memory. Otherwise you - * should probably use memmove() or bcopy(). If neither is defined, - * roll your own. - */ -#define HAS_MEMCPY /**/ -/*#undef SAFE_MEMCPY /**/ - -/* HAS_MEMMOVE - * This symbol, if defined, indicates that the memmove routine is available - * to move potentially overlapping blocks of memory. Otherwise you - * should use bcopy() or roll your own. - */ -/*#undef HAS_MEMMOVE /**/ - -/* HAS_MEMSET - * This symbol, if defined, indicates that the memset routine is available - * to set a block of memory to a character. If undefined, roll your own. - */ -#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_MSG - * This symbol, if defined, indicates that the entire msg*(2) library is - * supported. - */ -/* #define HAS_MSG /**/ - -/* HAS_MSGCTL - * This symbol, if defined, indicates that the msgctl() routine is - * available to control message passing. - */ -/* #define HAS_MSGCTL /**/ - -/* HAS_MSGGET - * This symbol, if defined, indicates that the msgget() routine is - * available to get messages. - */ -/* #define HAS_MSGGET /**/ - -/* HAS_MSGRCV - * This symbol, if defined, indicates that the msgrcv() routine is - * available to receive messages. - */ -/* #define HAS_MSGRCV /**/ - -/* HAS_MSGSND - * This symbol, if defined, indicates that the msgsnd() routine is - * available to send messages. - */ -/* #define HAS_MSGSND /**/ - -/* HAS_NDBM - * This symbol, if defined, indicates that ndbm.h exists and should - * be included. - */ -/* #define HAS_NDBM /**/ - -/* HAS_ODBM - * This symbol, if defined, indicates that dbm.h exists and should - * be included. - */ -/* #define HAS_ODBM /**/ - -/* HAS_OPEN3 - * This manifest constant lets the C program know that the three - * argument form of open(2) is available. - */ -#define HAS_OPEN3 /**/ - -/* HAS_READDIR - * This symbol, if defined, indicates that the readdir routine is available - * from the C library to read directories. - */ -#define HAS_READDIR /**/ - -/* 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_REWINDDIR - * This symbol, if defined, indicates that the rewindir routine is - * available to rewind directories. - */ -#define HAS_REWINDDIR /**/ - -/* 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_SEEKDIR - * This symbol, if defined, indicates that the seekdir routine is - * available to seek into directories. - */ -#define HAS_SEEKDIR /**/ - -/* HAS_SELECT - * This symbol, if defined, indicates that the select() subroutine - * exists. - */ -/* #define HAS_SELECT /**/ - -/* HAS_SEM - * This symbol, if defined, indicates that the entire sem*(2) library is - * supported. - */ -/* #define HAS_SEM /**/ - -/* HAS_SEMCTL - * This symbol, if defined, indicates that the semctl() routine is - * available to control semaphores. - */ -/* #define HAS_SEMCTL /**/ - -/* HAS_SEMGET - * This symbol, if defined, indicates that the semget() routine is - * available to get semaphores ids. - */ -/* #define HAS_SEMGET /**/ - -/* HAS_SEMOP - * This symbol, if defined, indicates that the semop() routine is - * available to perform semaphore operations. - */ -/* #define HAS_SEMOP /**/ - -/* 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_SETPGRP - * This symbol, if defined, indicates that the setpgrp() routine is - * available to set the current process group. - */ -#define HAS_SETPGRP /**/ - -/* HAS_SETPGRP2 - * This symbol, if defined, indicates that the setpgrp2() (as in DG/UX) - * routine is available to set the current process group. - */ -/*#undef 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 program. - */ -/* HAS_SETRESGID - * This symbol, if defined, indicates that the setresgid routine is - * available to change the real, effective and saved gid of the current - * program. - */ -/* #define HAS_SETREGID /**/ -/*#undef 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 program. - */ -/* HAS_SETRESUID - * This symbol, if defined, indicates that the setresuid routine is - * available to change the real, effective and saved uid of the current - * program. - */ -/* #define HAS_SETREUID /**/ -/*#undef 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_SHM - * This symbol, if defined, indicates that the entire shm*(2) library is - * supported. - */ -/* #define HAS_SHM /**/ - -/* HAS_SHMAT - * This symbol, if defined, indicates that the shmat() routine is - * available to attach a shared memory segment. - */ -/* VOID_SHMAT - * This symbol, if defined, indicates that the shmat() routine - * returns a pointer of type void*. - */ -/* #define HAS_SHMAT /**/ - -/*#undef VOIDSHMAT /**/ - -/* HAS_SHMCTL - * This symbol, if defined, indicates that the shmctl() routine is - * available to control a shared memory segment. - */ -/* #define HAS_SHMCTL /**/ - -/* HAS_SHMDT - * This symbol, if defined, indicates that the shmdt() routine is - * available to detach a shared memory segment. - */ -/* #define HAS_SHMDT /**/ - -/* HAS_SHMGET - * This symbol, if defined, indicates that the shmget() routine is - * available to get a shared memory segment id. - */ -/* #define HAS_SHMGET /**/ - -/* 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. - */ -/* OLDSOCKET - * This symbol, if defined, indicates that the 4.1c BSD socket interface - * is supported instead of the 4.2/4.3 BSD socket interface. - */ -/* #define HAS_SOCKET /**/ - -/* #define HAS_SOCKETPAIR /**/ - -/*#undef OLDSOCKET /**/ - -/* STATBLOCKS - * This symbol is defined if this system has a stat structure declaring - * st_blksize and st_blocks. - */ -#define STATBLOCKS /**/ - -/* STDSTDIO - * This symbol is defined if this system has a FILE structure declaring - * _ptr and _cnt in stdio.h. - */ -/* #define STDSTDIO /**/ /* we do, but semantics are different */ - -/* STRUCTCOPY - * 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 STRUCTCOPY /**/ - -/* HAS_STRERROR - * This symbol, if defined, indicates that the strerror() routine is - * available to translate error numbers to strings. - */ -#define HAS_STRERROR /**/ - -/* 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_TELLDIR - * This symbol, if defined, indicates that the telldir routine is - * available to tell your location in directories. - */ -#define HAS_TELLDIR /**/ - -/* HAS_TRUNCATE - * This symbol, if defined, indicates that the truncate routine is - * available to truncate files. - */ -/* #define HAS_TRUNCATE /**/ - -/* HAS_VFORK - * This symbol, if defined, indicates that vfork() exists. - */ -#ifdef __MINT__ -#define HAS_VFORK /**/ -#endif - -/* VOIDSIG - * This symbol is defined if this system declares "void (*signal())()" in - * signal.h. The old way was to declare it as "int (*signal())()". It - * is up to the package author to declare things correctly based on the - * symbol. - */ -/* TO_SIGNAL - * This symbol's value is either "void" or "int", corresponding to the - * appropriate return "type" of a signal handler. Thus, one can declare - * a signal handler using "TO_SIGNAL (*handler())()", and define the - * handler using "TO_SIGNAL handler(sig)". - */ -#define VOIDSIG /**/ -#define TO_SIGNAL void /**/ - -/* HASVOLATILE - * This symbol, if defined, indicates that this C compiler knows about - * the volatile declaration. - */ -#define HASVOLATILE /**/ - -/* 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(). - */ -/* CHARVSPRINTF - * 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 CHARVSPRINTF /**/ - -/* HAS_WAIT4 - * This symbol, if defined, indicates that wait4() exists. - */ -/* #define HAS_WAIT4 /**/ - -/* HAS_WAITPID - * This symbol, if defined, indicates that waitpid() exists. - */ -/*#undef HAS_WAITPID /**/ - -/* GIDTYPE - * This symbol has a value like gid_t, int, ushort, or whatever type is - * used to declare group ids in the kernel. - */ -#define GIDTYPE gid_t /**/ - -/* GROUPSTYPE - * This symbol has a value like gid_t, int, ushort, or whatever type is - * used in the return value of getgroups(). - */ -/* #define GROUPSTYPE unsigned short /**/ - -/* I_FCNTL - * This manifest constant tells the C program to include . - */ -#define I_FCNTL /**/ - -/* I_GDBM - * This symbol, if defined, indicates that gdbm.h exists and should - * be included. - */ -#define I_GDBM /**/ -#define HAS_GDBM - -/* I_GRP - * This symbol, if defined, indicates to the C program that it should - * include grp.h. - */ -/* #define I_GRP /**/ - -/* I_NETINET_IN - * This symbol, if defined, indicates to the C program that it should - * include netinet/in.h. - */ -/* I_SYS_IN - * This symbol, if defined, indicates to the C program that it should - * include sys/in.h. - */ -/* #define I_NETINET_IN /**/ -/*#undef I_SYS_IN /**/ - -/* I_PWD - * This symbol, if defined, indicates to the C program that it should - * include pwd.h. - */ -/* 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. - */ -#define I_PWD /**/ -/* #define PWQUOTA /**/ -/*#undef PWAGE /**/ -/*#undef PWCHANGE /**/ -/*#undef PWCLASS /**/ -/*#undef PWEXPIRE /**/ -/* #define PWCOMMENT /**/ - -/* I_SYS_FILE - * This manifest constant tells the C program to include . - */ -/* #define I_SYS_FILE /**/ - -/* I_SYSIOCTL - * This symbol, if defined, indicates that sys/ioctl.h exists and should - * be included. - */ -#define I_SYSIOCTL /**/ - -/* I_TIME - * This symbol is defined if the program should include . - */ -/* I_SYS_TIME - * This symbol is defined if the program should include . - */ -/* SYSTIMEKERNEL - * This symbol is defined if the program should include - * with KERNEL defined. - */ -/* I_SYS_SELECT - * This symbol is defined if the program should include . - */ -#define I_TIME /**/ -/* #define I_SYS_TIME /**/ -/*#undef SYSTIMEKERNEL /**/ -/*#undef I_SYS_SELECT /**/ - -/* I_UTIME - * This symbol, if defined, indicates to the C program that it should - * include utime.h. - */ -/*#undef I_UTIME /**/ - -/* I_VARARGS - * This symbol, if defined, indicates to the C program that it should - * include varargs.h. - */ -#define I_VARARGS /**/ - -/* I_VFORK - * This symbol, if defined, indicates to the C program that it should - * include vfork.h. - */ -/* #define I_VFORK /**/ - -/* INTSIZE - * This symbol contains the size of an int, so that the C preprocessor - * can make decisions based on it. - */ -#ifdef __MSHORT__ -#define INTSIZE 2 /**/ -#else -#define INTSIZE 4 /**/ -#endif - -/* I_DIRENT - * This symbol, if defined, indicates that the program should use the - * P1003-style directory routines, and include . - */ -/* I_SYS_DIR - * This symbol, if defined, indicates that the program should use the - * directory functions by including . - */ -/* I_NDIR - * This symbol, if defined, indicates that the program should include the - * system's version of ndir.h, rather than the one with this package. - */ -/* I_SYS_NDIR - * This symbol, if defined, indicates that the program should include the - * system's version of sys/ndir.h, rather than the one with this package. - */ -/* I_MY_DIR - * This symbol, if defined, indicates that the program should compile - * the ndir.c code provided with the package. - */ -/* 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. - */ -#define I_DIRENT /**/ -/*#undef I_SYS_DIR /**/ -/*#undef I_NDIR /**/ -/*#undef I_SYS_NDIR /**/ -/*#undef I_MY_DIR /**/ -/*#undef DIRNAMLEN /**/ - -/* MYMALLOC - * This symbol, if defined, indicates that we're using our own malloc. - */ -/* MALLOCPTRTYPE - * This symbol defines the kind of ptr returned by malloc and realloc. - */ -/* #define MYMALLOC /**/ -#define MALLOCPTRTYPE void /**/ - - - -/* RANDBITS - * This symbol contains the number of bits of random number the rand() - * function produces. Usual values are 15, 16, and 31. - */ -#ifdef __MSHORT__ -#define RANDBITS 15 /**/ -#else -#define RANDBITS 31 /**/ -#endif - -/* SCRIPTDIR - * This symbol holds the name of the directory in which the user wants - * to keep publicly executable scripts for the package in question. It - * is often a directory that is mounted across diverse architectures. - */ -#define SCRIPTDIR "/bin" /**/ - -/* SIG_NAME - * This symbol contains an list of signal names in order. - */ -#define SIG_NAME "NULL","HUP","INT","QUIT","ILL","TRAP","ABRT","PRIV","FPE","KILL","BUS","SEGV","SYS","PIPE","ALRM","TERM","URG","STOP","TSTP","CONT","CHLD","TTIN","TTOU","IO","XCPU","XFSZ","VTALRM","PROF","WINCH","USR1","USR2" - -/* 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 unsigned char /**/ - -/* UIDTYPE - * This symbol has a value like uid_t, int, ushort, or whatever type is - * used to declare user ids in the kernel. - */ -#define UIDTYPE uid_t /**/ - -/* VOIDHAVE - * 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 - * - * The package designer should define VOIDWANT to indicate the requirements - * of the package. This can be done either by #defining VOIDWANT before - * including config.h, or by defining voidwant in Myinit.U. If the level - * of void support necessary is not present, config.h defines void to "int", - * VOID to the empty string, and VOIDP to "char *". - */ -/* void - * This symbol is used for void casts. On implementations which support - * void appropriately, its value is "void". Otherwise, its value maps - * to "int". - */ -/* VOID - * This symbol's value is "void" if the implementation supports void - * appropriately. Otherwise, its value is the empty string. The primary - * use of this symbol is in specifying void parameter lists for function - * prototypes. - */ -/* VOIDP - * This symbol is used for casting generic pointers. On implementations - * which support void appropriately, its value is "void *". Otherwise, - * its value is "char *". - */ -#ifndef VOIDWANT -#define VOIDWANT 7 -#endif -#define VOIDHAVE 7 -#if (VOIDHAVE & VOIDWANT) != VOIDWANT -#define void int /* is void to be avoided? */ -#define VOID -#define VOIDP (char *) -#define M_VOID /* Xenix strikes again */ -#else -#define VOID void -#define VOIDP (void *) -#endif - -/* 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 PRIVLIB "/usr/lib/perl" /**/ -extern char *PRIVLIB; /* $PERLIB or /lib */ - -/* param.h does'nt really need types, but is #define'ed to make sure types.h - * is included - */ -#define PARAM_NEEDS_TYPES - -/* These are selective unix services in the gcc-st lib - */ -#define HAS_GETLOGIN -#define HAS_GETPPID -#define HAS_KILL -#define HAS_UMASK -#define HAS_PASSWD -#endif diff --git a/atarist/echo.c b/atarist/echo.c deleted file mode 100644 index 0853d62..0000000 --- a/atarist/echo.c +++ /dev/null @@ -1,98 +0,0 @@ -/* - * echo args, globbing is necessary. - * usage: - * echo [-n] [args ...] - * \n \r \b \c \v \\ \f \t \NNN escapes supported - * -n and \c mean dont echo the final newline. - * - * ++jrb bammi@cadence.com - */ - -#include - -#if __STDC__ -# include -#else -# define __PROTO(X) () -#endif - -char **glob __PROTO((char *patt, int decend_dir)); -int contains_wild __PROTO((char *patt)); -void free_all __PROTO((void)); - - -int final_newline = 1; /* turned off by -n or \c */ - -int main(argc, argv) -int argc; -char **argv; -{ - --argc; ++argv; - if((*argv)[0] == '-') - { - if ((*argv)[1] == 'n') - final_newline = 0; - else - { - fputs("usage: echo [-n] [arguement ... ]\n", stderr); - return 1; - } - --argc; ++argv; - } - - while(argc--) - { - char *word = *argv; - char **list; - - if(contains_wild(word) && (list = glob(word, 0))) - { - while(*list) - { - fputs(*list, stdout); - if(*++list) putchar(' '); - } - free_all(); - } - else - { - char c; - for(c = *word; c; c = (*word)? *++word : 0) - { - if(c != '\\') - putchar(c); - else - { - switch(*++word) - { - case 'b': putchar('\b'); break; - case 'f': putchar('\f'); break; - case 'n': putchar('\n'); break; - case 'r': putchar('\r'); break; - case 't': putchar('\t'); break; - case 'v': putchar('\v'); break; - case '\\': putchar('\\'); break; - case 'c': final_newline = 0; break; - default: putchar(*word); /* ?? */ - case '0': - { - int n = 0; - for(c = *++word; (c >= '0') && (c <= '7'); c = *++word) - n = (n << 3) + (c - '0'); - putchar(n); - } - } - } - } - } - if(*++argv) putchar(' '); - } - if(final_newline) putchar('\n'); - return 0; -} - - - - - - diff --git a/atarist/explain b/atarist/explain deleted file mode 100644 index 9e8fca0..0000000 --- a/atarist/explain +++ /dev/null @@ -1,77 +0,0 @@ -Here is a brief explaination of the diffs in perl.diffs. If anything -is unclear please just ask: - -General: - Many of the #ifdef MSDOS where required for the atari too. In order -to avoid cluttering up the source, upfront in perl.h we #define -MSDOS_OR_ATARI if either defined(MSDOS) or defined(atarist). - - Some of the diffs that i felt were universally applicable are not protected -with #ifdef's. In the explainations below i has indicated all such -changes. - -perl.h: - -- define MSDOS_OR_ATARI if appro. - -- typedef size_t - assume its there in if STANDARD_C otherwise - typedef it to unsigned int (i would have ideally liked unsigned long, - but we get into trouble with half-assed headers from sun etc) -(this change not protected with a #ifdef since hopefully its universally appli) - - -- make the type of STRLEN size_t for all systems -(this change not protected with a #ifdef since hopefully its universally appli) - - -- more #ifdef MSDOS -> #ifdef MSDOS_OR_ATARI changes. - -arg.h: - -- in the atari headers we already have O_PIPE. Change all instances of - O_PIPE to PERL_O_PIPE. All such changes protected with #ifdef atarist. - -handy.h: - -- make MEM_SIZE size_t like STRLEN. -(this change not protected with a #ifdef since hopefully its universally appli) - -doarg.c: - -- accomodate the large number of args needed for the atari syscall(). - -- do the 9 thru 14 arg versions of syscall for the atarist. - -doio.c: - -- mode[] needed to be initialized. -(this change not protected with a #ifdef since hopefully its universally appli) - - -- you may find this strange, we do not define STDSTDIO, because even - though we have the "standard" field in FILE, the semantics are - different. However, some contexts will work correctly, and there - you will see #if defined(STDSTDIO) || defined(atarist) - - -- more #ifdef MSDOS -> #ifdef MSDOS_OR_ATARI changes. - -eval.c: - -- more #ifdef MSDOS -> #ifdef MSDOS_OR_ATARI changes. - -malloc.c:: - -- instead of bashfully using ints to hold sizes use MEM_SIZE. - adjust some casts and printf format specifiers due to this. - (atarigcc can run in two modes, with 16 or 32 bit ints, so...) -(this change not protected with a #ifdef since hopefully its universally appli) - - -- atarist changes sometimes ||'ed with I286 as appro. - -perl.c: - -- more #ifdef MSDOS -> #ifdef MSDOS_OR_ATARI changes. - -regcomp.c: - -- like O_PIPE the atarist headers already has META defined. Change all - instances of META to PERL_META. All such changes protected with - #ifdef atarist. - -str.c: - -- more #ifdef MSDOS -> #ifdef MSDOS_OR_ATARI changes. - -token.c:: - -- META -> PERL_META renaming for atari - -util.c:: - -- more adjustments for memory sizes being MEM_SIZE instead of int. - -- more #ifdef MSDOS -> #ifdef MSDOS_OR_ATARI changes. - -++jrb bammi@cadence.com diff --git a/atarist/makefile.sm b/atarist/makefile.sm deleted file mode 100644 index 069645e..0000000 --- a/atarist/makefile.sm +++ /dev/null @@ -1,460 +0,0 @@ -# : Makefile.SH,v 9820Revision: 4.0.1.2 9820Date: 91/06/07 10:14:43 $ -# -# $Log: makefile.sm,v $ -# Revision 4.1 92/08/07 17:18:37 lwall -# Stage 6 Snapshot -# -# Revision 4.0.1.1 92/06/08 11:50:00 lwall -# Initial revision -# -# Revision 4.0.1.2 91/06/07 10:14:43 lwall -# patch4: cflags now emits entire cc command except for the filename -# patch4: alternate make programs are now semi-supported -# patch4: uperl.o no longer tries to link in libraries prematurely -# patch4: installperl now installs x2p stuff too -# -# Revision 4.0.1.1 91/04/11 17:30:39 lwall -# patch1: C flags are now settable on a per-file basis -# -# Revision 4.0 91/03/20 00:58:54 lwall -# 4.0 baseline. -# -# - -CC = cgcc -YACC = bison -y -LDFLAGS = -CLDFLAGS = -SMALL = -LARGE = -mallocsrc = malloc.c -mallocobj = malloc.o -SLN = ln -s - -libs = -lgdbm -lpml - -public = perl.ttp - -# To use an alternate make, set in config.sh. -MAKE = make - - -CCCMD = $(CC) -O2 -fomit-frame-pointer -fstrength-reduce -c -DMYMALLOC - -private = - -scripts = - -manpages = perl.man h2ph.man - -util = echo.ttp perlglob.ttp - -sh = Makefile.SH makedepend.SH h2ph.SH - -h1 = EXTERN.h INTERN.h arg.h array.h cmd.h config.h form.h handy.h -h2 = hash.h perl.h regcomp.h regexp.h spat.h stab.h str.h util.h - -h = $(h1) $(h2) - -c1 = array.c cmd.c cons.c consarg.c doarg.c doio.c dolist.c dump.c -c2 = eval.c form.c hash.c $(mallocsrc) perl.c regcomp.c regexec.c -c3 = stab.c str.c toke.c util.c atarist.c usersub.c - -c = $(c1) $(c2) $(c3) - -obj1 = array.o cmd.o cons.o consarg.o doarg.o doio.o dolist.o dump.o -obj2 = eval.o form.o hash.o $(mallocobj) perl.o regcomp.o regexec.o -obj3 = stab.o str.o toke.o util.o atarist.o - -obj = $(obj1) $(obj2) $(obj3) - -lintflags = -hbvxac - -# grrr -SHELL = /bin/sh - -.c.o: - $(CCCMD) $*.c - -all: $(public) $(util) - -# This is the standard version that contains no "taint" checks and is -# used for all scripts that aren't set-id or running under something set-id. -# The $& notation is tells Sequent machines that it can do a parallel make, -# and is harmless otherwise. - -perl.ttp: perly.o $(obj) usersub.o - $(CC) $(LARGE) $(CLDFLAGS) $(obj) perly.o usersub.o $(libs) -o perl.ttp -v -s - -echo.ttp: wildmat.o echo.c - $(CC) -O -mshort -fomit-frame-pointer -o echo.ttp \ - echo.c wildmat.o -liio16 -s - -perlglob.ttp: wildmat.o perlglob.c - $(CC) -O -mshort -fomit-frame-pointer -o perlglob.ttp \ - perlglob.c wildmat.o -liio16 -s - -wildmat.o: wildmat.c - $(CC) -O -mshort -fomit-frame-pointer -c wildmat.c - -perly.h: perly.c - @ echo Dummy dependency for dumb parallel make - touch perly.h - -perly.c: perly.y perly.fixer - @ echo 'Expect either' 29 shift/reduce and 59 reduce/reduce conflicts... - @ echo ' or' 27 shift/reduce and 61 reduce/reduce conflicts... - $(YACC) -d perly.y - sh ./perly.fixer y.tab.c perly.c - mv y.tab.h perly.h - echo 'extern YYSTYPE yylval;' >>perly.h - -perly.o: perly.c perly.h $(h) - $(CCCMD) perly.c - - -clean: - rm -f *.o - -realclean: clean - rm -f *.ttp report core - rm -f perly.c perly.h - -# The following lint has practically everything turned on. Unfortunately, -# you have to wade through a lot of mumbo jumbo that can't be suppressed. -# If the source file has a /*NOSTRICT*/ somewhere, ignore the lint message -# for that spot. - -lint: perly.c $(c) - lint $(lintflags) $(defs) perly.c $(c) > perl.fuzz - -depend: makedepend - - test -f perly.h || cp /dev/null perly.h - ./makedepend - - test -s perly.h || /bin/rm -f perly.h - -test: perl - - cd t && chmod +x TEST */*.t - - cd t && (rm -f perl; $(SLN) ../perl .) && ./perl TEST .clist - -hlist: - echo $(h) | tr ' ' '\012' >.hlist - -shlist: - echo $(sh) | tr ' ' '\012' >.shlist - -# AUTOMATICALLY GENERATED MAKE DEPENDENCIES--PUT NOTHING BELOW THIS LINE -# If this runs make out of memory, delete /usr/include lines. -array.o: EXTERN.h -array.o: arg.h -array.o: array.c -array.o: array.h -array.o: cmd.h -array.o: config.h -array.o: form.h -array.o: handy.h -array.o: hash.h -array.o: perl.h -array.o: regexp.h -array.o: spat.h -array.o: stab.h -array.o: str.h -array.o: util.h -cmd.o: EXTERN.h -cmd.o: arg.h -cmd.o: array.h -cmd.o: cmd.c -cmd.o: cmd.h -cmd.o: config.h -cmd.o: form.h -cmd.o: handy.h -cmd.o: hash.h -cmd.o: perl.h -cmd.o: regexp.h -cmd.o: spat.h -cmd.o: stab.h -cmd.o: str.h -cmd.o: util.h -cons.o: EXTERN.h -cons.o: arg.h -cons.o: array.h -cons.o: cmd.h -cons.o: config.h -cons.o: cons.c -cons.o: form.h -cons.o: handy.h -cons.o: hash.h -cons.o: perl.h -cons.o: perly.h -cons.o: regexp.h -cons.o: spat.h -cons.o: stab.h -cons.o: str.h -cons.o: util.h -consarg.o: EXTERN.h -consarg.o: arg.h -consarg.o: array.h -consarg.o: cmd.h -consarg.o: config.h -consarg.o: consarg.c -consarg.o: form.h -consarg.o: handy.h -consarg.o: hash.h -consarg.o: perl.h -consarg.o: regexp.h -consarg.o: spat.h -consarg.o: stab.h -consarg.o: str.h -consarg.o: util.h -doarg.o: EXTERN.h -doarg.o: arg.h -doarg.o: array.h -doarg.o: cmd.h -doarg.o: config.h -doarg.o: doarg.c -doarg.o: form.h -doarg.o: handy.h -doarg.o: hash.h -doarg.o: perl.h -doarg.o: regexp.h -doarg.o: spat.h -doarg.o: stab.h -doarg.o: str.h -doarg.o: util.h -doio.o: EXTERN.h -doio.o: arg.h -doio.o: array.h -doio.o: cmd.h -doio.o: config.h -doio.o: doio.c -doio.o: form.h -doio.o: handy.h -doio.o: hash.h -doio.o: perl.h -doio.o: regexp.h -doio.o: spat.h -doio.o: stab.h -doio.o: str.h -doio.o: util.h -dolist.o: EXTERN.h -dolist.o: arg.h -dolist.o: array.h -dolist.o: cmd.h -dolist.o: config.h -dolist.o: dolist.c -dolist.o: form.h -dolist.o: handy.h -dolist.o: hash.h -dolist.o: perl.h -dolist.o: regexp.h -dolist.o: spat.h -dolist.o: stab.h -dolist.o: str.h -dolist.o: util.h -dump.o: EXTERN.h -dump.o: arg.h -dump.o: array.h -dump.o: cmd.h -dump.o: config.h -dump.o: dump.c -dump.o: form.h -dump.o: handy.h -dump.o: hash.h -dump.o: perl.h -dump.o: regexp.h -dump.o: spat.h -dump.o: stab.h -dump.o: str.h -dump.o: util.h -eval.o: EXTERN.h -eval.o: arg.h -eval.o: array.h -eval.o: cmd.h -eval.o: config.h -eval.o: eval.c -eval.o: form.h -eval.o: handy.h -eval.o: hash.h -eval.o: perl.h -eval.o: regexp.h -eval.o: spat.h -eval.o: stab.h -eval.o: str.h -eval.o: util.h -form.o: EXTERN.h -form.o: arg.h -form.o: array.h -form.o: cmd.h -form.o: config.h -form.o: form.c -form.o: form.h -form.o: handy.h -form.o: hash.h -form.o: perl.h -form.o: regexp.h -form.o: spat.h -form.o: stab.h -form.o: str.h -form.o: util.h -hash.o: EXTERN.h -hash.o: arg.h -hash.o: array.h -hash.o: cmd.h -hash.o: config.h -hash.o: form.h -hash.o: handy.h -hash.o: hash.c -hash.o: hash.h -hash.o: perl.h -hash.o: regexp.h -hash.o: spat.h -hash.o: stab.h -hash.o: str.h -hash.o: util.h -perl.o: EXTERN.h -perl.o: arg.h -perl.o: array.h -perl.o: cmd.h -perl.o: config.h -perl.o: form.h -perl.o: handy.h -perl.o: hash.h -perl.o: patchlevel.h -perl.o: perl.c -perl.o: perl.h -perl.o: perly.h -perl.o: regexp.h -perl.o: spat.h -perl.o: stab.h -perl.o: str.h -perl.o: util.h -regcomp.o: EXTERN.h -regcomp.o: INTERN.h -regcomp.o: arg.h -regcomp.o: array.h -regcomp.o: cmd.h -regcomp.o: config.h -regcomp.o: form.h -regcomp.o: handy.h -regcomp.o: hash.h -regcomp.o: perl.h -regcomp.o: regcomp.c -regcomp.o: regcomp.h -regcomp.o: regexp.h -regcomp.o: spat.h -regcomp.o: stab.h -regcomp.o: str.h -regcomp.o: util.h -regexec.o: EXTERN.h -regexec.o: arg.h -regexec.o: array.h -regexec.o: cmd.h -regexec.o: config.h -regexec.o: form.h -regexec.o: handy.h -regexec.o: hash.h -regexec.o: perl.h -regexec.o: regcomp.h -regexec.o: regexec.c -regexec.o: regexp.h -regexec.o: spat.h -regexec.o: stab.h -regexec.o: str.h -regexec.o: util.h -stab.o: EXTERN.h -stab.o: arg.h -stab.o: array.h -stab.o: cmd.h -stab.o: config.h -stab.o: form.h -stab.o: handy.h -stab.o: hash.h -stab.o: perl.h -stab.o: regexp.h -stab.o: spat.h -stab.o: stab.c -stab.o: stab.h -stab.o: str.h -stab.o: util.h -str.o: EXTERN.h -str.o: arg.h -str.o: array.h -str.o: cmd.h -str.o: config.h -str.o: form.h -str.o: handy.h -str.o: hash.h -str.o: perl.h -str.o: perly.h -str.o: regexp.h -str.o: spat.h -str.o: stab.h -str.o: str.c -str.o: str.h -str.o: util.h -toke.o: EXTERN.h -toke.o: arg.h -toke.o: array.h -toke.o: cmd.h -toke.o: config.h -toke.o: form.h -toke.o: handy.h -toke.o: hash.h -toke.o: perl.h -toke.o: perly.h -toke.o: regexp.h -toke.o: spat.h -toke.o: stab.h -toke.o: str.h -toke.o: toke.c -toke.o: util.h -util.o: EXTERN.h -util.o: arg.h -util.o: array.h -util.o: cmd.h -util.o: config.h -util.o: form.h -util.o: handy.h -util.o: hash.h -util.o: perl.h -util.o: regexp.h -util.o: spat.h -util.o: stab.h -util.o: str.h -util.o: util.c -util.o: util.h -atarist.o: EXTERN.h -atarist.o: arg.h -atarist.o: array.h -atarist.o: cmd.h -atarist.o: config.h -atarist.o: form.h -atarist.o: handy.h -atarist.o: hash.h -atarist.o: perl.h -atarist.o: regexp.h -atarist.o: spat.h -atarist.o: stab.h -atarist.o: str.h -atarist.o: atarist.c -atarist.o: util.h - -malloc.o: EXTERN.h -malloc.o: arg.h -malloc.o: array.h -malloc.o: cmd.h -malloc.o: config.h -malloc.o: form.h -malloc.o: handy.h -malloc.o: hash.h -malloc.o: perl.h -malloc.o: regexp.h -malloc.o: spat.h -malloc.o: stab.h -malloc.o: str.h -malloc.o: malloc.c -malloc.o: util.h - diff --git a/atarist/makefile.st b/atarist/makefile.st deleted file mode 100644 index 98fa645..0000000 --- a/atarist/makefile.st +++ /dev/null @@ -1,465 +0,0 @@ -# : Makefile.SH,v 9820Revision: 4.0.1.2 9820Date: 91/06/07 10:14:43 $ -# -# $Log: makefile.st,v $ -# Revision 4.1 92/08/07 17:18:40 lwall -# Stage 6 Snapshot -# -# Revision 4.0.1.1 92/06/08 11:50:13 lwall -# Initial revision -# -# Revision 4.0.1.2 91/06/07 10:14:43 lwall -# patch4: cflags now emits entire cc command except for the filename -# patch4: alternate make programs are now semi-supported -# patch4: uperl.o no longer tries to link in libraries prematurely -# patch4: installperl now installs x2p stuff too -# -# Revision 4.0.1.1 91/04/11 17:30:39 lwall -# patch1: C flags are now settable on a per-file basis -# -# Revision 4.0 91/03/20 00:58:54 lwall -# 4.0 baseline. -# -# - -CC = cgcc -YACC = bison -y -LDFLAGS = -CLDFLAGS = -SMALL = -LARGE = -mallocsrc = -mallocobj = -SLN = ln -s - -libs = -lgdbm -lpml - -public = perl.ttp - -# To use an alternate make, set in config.sh. -MAKE = make - - -CCCMD = $(CC) -O2 -fomit-frame-pointer -fstrength-reduce -c - -private = - -scripts = - -manpages = perl.man h2ph.man - -util = echo.ttp perlglob.ttp - -sh = Makefile.SH makedepend.SH h2ph.SH - -h1 = EXTERN.h INTERN.h arg.h array.h cmd.h config.h form.h handy.h -h2 = hash.h perl.h regcomp.h regexp.h spat.h stab.h str.h util.h - -h = $(h1) $(h2) - -c1 = array.c cmd.c cons.c consarg.c doarg.c doio.c dolist.c dump.c -c2 = eval.c form.c hash.c $(mallocsrc) perl.c regcomp.c regexec.c -c3 = stab.c str.c toke.c util.c atarist.c usersub.c - -c = $(c1) $(c2) $(c3) - -obj1 = array.o cmd.o cons.o consarg.o doarg.o doio.o dolist.o dump.o -obj2 = eval.o form.o hash.o $(mallocobj) perl.o regcomp.o regexec.o -obj3 = stab.o str.o toke.o util.o atarist.o - -obj = $(obj1) $(obj2) $(obj3) - -lintflags = -hbvxac - -# grrr -SHELL = /bin/sh - -.c.o: - $(CCCMD) $*.c - -all: $(public) $(util) - -# This is the standard version that contains no "taint" checks and is -# used for all scripts that aren't set-id or running under something set-id. -# The $& notation is tells Sequent machines that it can do a parallel make, -# and is harmless otherwise. - -perl.ttp: perly.o $(obj) usersub.o - $(CC) $(LARGE) $(CLDFLAGS) $(obj) perly.o usersub.o $(libs) -o perl.ttp -v -s - -echo.ttp: wildmat.o echo.c - $(CC) -O -mshort -fomit-frame-pointer -o echo.ttp \ - echo.c wildmat.o -liio16 -s - -perlglob.ttp: wildmat.o perlglob.c - $(CC) -O -mshort -fomit-frame-pointer -o perlglob.ttp \ - perlglob.c wildmat.o -liio16 -s - -# we cant do a uperl.o, so we do our best. -# -uperl.a: perly.o $(obj) - car rs uperl.a perly.o $(obj) - -wildmat.o: wildmat.c - $(CC) -O -mshort -fomit-frame-pointer -c wildmat.c - -perly.h: perly.c - @ echo Dummy dependency for dumb parallel make - touch perly.h - -perly.c: perly.y perly.fixer - @ echo 'Expect either' 29 shift/reduce and 59 reduce/reduce conflicts... - @ echo ' or' 27 shift/reduce and 61 reduce/reduce conflicts... - $(YACC) -d perly.y - sh ./perly.fixer y.tab.c perly.c - mv y.tab.h perly.h - echo 'extern YYSTYPE yylval;' >>perly.h - -perly.o: perly.c perly.h $(h) - $(CCCMD) perly.c - - -clean: - rm -f *.o - -realclean: clean - rm -f *.ttp report core - rm -f perly.c perly.h - -# The following lint has practically everything turned on. Unfortunately, -# you have to wade through a lot of mumbo jumbo that can't be suppressed. -# If the source file has a /*NOSTRICT*/ somewhere, ignore the lint message -# for that spot. - -lint: perly.c $(c) - lint $(lintflags) $(defs) perly.c $(c) > perl.fuzz - -depend: makedepend - - test -f perly.h || cp /dev/null perly.h - ./makedepend - - test -s perly.h || /bin/rm -f perly.h - -test: perl - - cd t && chmod +x TEST */*.t - - cd t && (rm -f perl; $(SLN) ../perl .) && ./perl TEST .clist - -hlist: - echo $(h) | tr ' ' '\012' >.hlist - -shlist: - echo $(sh) | tr ' ' '\012' >.shlist - -# AUTOMATICALLY GENERATED MAKE DEPENDENCIES--PUT NOTHING BELOW THIS LINE -# If this runs make out of memory, delete /usr/include lines. -array.o: EXTERN.h -array.o: arg.h -array.o: array.c -array.o: array.h -array.o: cmd.h -array.o: config.h -array.o: form.h -array.o: handy.h -array.o: hash.h -array.o: perl.h -array.o: regexp.h -array.o: spat.h -array.o: stab.h -array.o: str.h -array.o: util.h -cmd.o: EXTERN.h -cmd.o: arg.h -cmd.o: array.h -cmd.o: cmd.c -cmd.o: cmd.h -cmd.o: config.h -cmd.o: form.h -cmd.o: handy.h -cmd.o: hash.h -cmd.o: perl.h -cmd.o: regexp.h -cmd.o: spat.h -cmd.o: stab.h -cmd.o: str.h -cmd.o: util.h -cons.o: EXTERN.h -cons.o: arg.h -cons.o: array.h -cons.o: cmd.h -cons.o: config.h -cons.o: cons.c -cons.o: form.h -cons.o: handy.h -cons.o: hash.h -cons.o: perl.h -cons.o: perly.h -cons.o: regexp.h -cons.o: spat.h -cons.o: stab.h -cons.o: str.h -cons.o: util.h -consarg.o: EXTERN.h -consarg.o: arg.h -consarg.o: array.h -consarg.o: cmd.h -consarg.o: config.h -consarg.o: consarg.c -consarg.o: form.h -consarg.o: handy.h -consarg.o: hash.h -consarg.o: perl.h -consarg.o: regexp.h -consarg.o: spat.h -consarg.o: stab.h -consarg.o: str.h -consarg.o: util.h -doarg.o: EXTERN.h -doarg.o: arg.h -doarg.o: array.h -doarg.o: cmd.h -doarg.o: config.h -doarg.o: doarg.c -doarg.o: form.h -doarg.o: handy.h -doarg.o: hash.h -doarg.o: perl.h -doarg.o: regexp.h -doarg.o: spat.h -doarg.o: stab.h -doarg.o: str.h -doarg.o: util.h -doio.o: EXTERN.h -doio.o: arg.h -doio.o: array.h -doio.o: cmd.h -doio.o: config.h -doio.o: doio.c -doio.o: form.h -doio.o: handy.h -doio.o: hash.h -doio.o: perl.h -doio.o: regexp.h -doio.o: spat.h -doio.o: stab.h -doio.o: str.h -doio.o: util.h -dolist.o: EXTERN.h -dolist.o: arg.h -dolist.o: array.h -dolist.o: cmd.h -dolist.o: config.h -dolist.o: dolist.c -dolist.o: form.h -dolist.o: handy.h -dolist.o: hash.h -dolist.o: perl.h -dolist.o: regexp.h -dolist.o: spat.h -dolist.o: stab.h -dolist.o: str.h -dolist.o: util.h -dump.o: EXTERN.h -dump.o: arg.h -dump.o: array.h -dump.o: cmd.h -dump.o: config.h -dump.o: dump.c -dump.o: form.h -dump.o: handy.h -dump.o: hash.h -dump.o: perl.h -dump.o: regexp.h -dump.o: spat.h -dump.o: stab.h -dump.o: str.h -dump.o: util.h -eval.o: EXTERN.h -eval.o: arg.h -eval.o: array.h -eval.o: cmd.h -eval.o: config.h -eval.o: eval.c -eval.o: form.h -eval.o: handy.h -eval.o: hash.h -eval.o: perl.h -eval.o: regexp.h -eval.o: spat.h -eval.o: stab.h -eval.o: str.h -eval.o: util.h -form.o: EXTERN.h -form.o: arg.h -form.o: array.h -form.o: cmd.h -form.o: config.h -form.o: form.c -form.o: form.h -form.o: handy.h -form.o: hash.h -form.o: perl.h -form.o: regexp.h -form.o: spat.h -form.o: stab.h -form.o: str.h -form.o: util.h -hash.o: EXTERN.h -hash.o: arg.h -hash.o: array.h -hash.o: cmd.h -hash.o: config.h -hash.o: form.h -hash.o: handy.h -hash.o: hash.c -hash.o: hash.h -hash.o: perl.h -hash.o: regexp.h -hash.o: spat.h -hash.o: stab.h -hash.o: str.h -hash.o: util.h -perl.o: EXTERN.h -perl.o: arg.h -perl.o: array.h -perl.o: cmd.h -perl.o: config.h -perl.o: form.h -perl.o: handy.h -perl.o: hash.h -perl.o: patchlevel.h -perl.o: perl.c -perl.o: perl.h -perl.o: perly.h -perl.o: regexp.h -perl.o: spat.h -perl.o: stab.h -perl.o: str.h -perl.o: util.h -regcomp.o: EXTERN.h -regcomp.o: INTERN.h -regcomp.o: arg.h -regcomp.o: array.h -regcomp.o: cmd.h -regcomp.o: config.h -regcomp.o: form.h -regcomp.o: handy.h -regcomp.o: hash.h -regcomp.o: perl.h -regcomp.o: regcomp.c -regcomp.o: regcomp.h -regcomp.o: regexp.h -regcomp.o: spat.h -regcomp.o: stab.h -regcomp.o: str.h -regcomp.o: util.h -regexec.o: EXTERN.h -regexec.o: arg.h -regexec.o: array.h -regexec.o: cmd.h -regexec.o: config.h -regexec.o: form.h -regexec.o: handy.h -regexec.o: hash.h -regexec.o: perl.h -regexec.o: regcomp.h -regexec.o: regexec.c -regexec.o: regexp.h -regexec.o: spat.h -regexec.o: stab.h -regexec.o: str.h -regexec.o: util.h -stab.o: EXTERN.h -stab.o: arg.h -stab.o: array.h -stab.o: cmd.h -stab.o: config.h -stab.o: form.h -stab.o: handy.h -stab.o: hash.h -stab.o: perl.h -stab.o: regexp.h -stab.o: spat.h -stab.o: stab.c -stab.o: stab.h -stab.o: str.h -stab.o: util.h -str.o: EXTERN.h -str.o: arg.h -str.o: array.h -str.o: cmd.h -str.o: config.h -str.o: form.h -str.o: handy.h -str.o: hash.h -str.o: perl.h -str.o: perly.h -str.o: regexp.h -str.o: spat.h -str.o: stab.h -str.o: str.c -str.o: str.h -str.o: util.h -toke.o: EXTERN.h -toke.o: arg.h -toke.o: array.h -toke.o: cmd.h -toke.o: config.h -toke.o: form.h -toke.o: handy.h -toke.o: hash.h -toke.o: perl.h -toke.o: perly.h -toke.o: regexp.h -toke.o: spat.h -toke.o: stab.h -toke.o: str.h -toke.o: toke.c -toke.o: util.h -util.o: EXTERN.h -util.o: arg.h -util.o: array.h -util.o: cmd.h -util.o: config.h -util.o: form.h -util.o: handy.h -util.o: hash.h -util.o: perl.h -util.o: regexp.h -util.o: spat.h -util.o: stab.h -util.o: str.h -util.o: util.c -util.o: util.h -atarist.o: EXTERN.h -atarist.o: arg.h -atarist.o: array.h -atarist.o: cmd.h -atarist.o: config.h -atarist.o: form.h -atarist.o: handy.h -atarist.o: hash.h -atarist.o: perl.h -atarist.o: regexp.h -atarist.o: spat.h -atarist.o: stab.h -atarist.o: str.h -atarist.o: atarist.c -atarist.o: util.h - -malloc.o: EXTERN.h -malloc.o: arg.h -malloc.o: array.h -malloc.o: cmd.h -malloc.o: config.h -malloc.o: form.h -malloc.o: handy.h -malloc.o: hash.h -malloc.o: perl.h -malloc.o: regexp.h -malloc.o: spat.h -malloc.o: stab.h -malloc.o: str.h -malloc.o: malloc.c -malloc.o: util.h - diff --git a/atarist/osbind.pl b/atarist/osbind.pl deleted file mode 100644 index 84f64fb..0000000 --- a/atarist/osbind.pl +++ /dev/null @@ -1,382 +0,0 @@ -# -# gemdos/xbios/bios interface on the atari -# -# ++jrb bammi@cadence.com -# - -# camel book pp204 -sub enum { - local($_) = @_; - local(@specs) = split(/,/); - local($val); - for(@specs) { - if(/=/) { - $val = eval $_; - } else { - eval $_ . ' = ++$val'; - } - } -} - -# these must match the defines in atarist.c - -&enum(<<'EOL'); -$_trap_1_w=1, $_trap_1_ww, $_trap_1_wl, $_trap_1_wlw, $_trap_1_www, -$_trap_1_wll, $_trap_1_wwll, $_trap_1_wlww, $_trap_1_wwlll, $_trap_13_w, -$_trap_13_ww, $_trap_13_wl, $_trap_13_www, $_trap_13_wwl, $_trap_13_wwlwww, -$_trap_14_w, $_trap_14_ww, $_trap_14_wl, $_trap_14_www, $_trap_14_wwl, -$_trap_14_wwll, $_trap_14_wllw, $_trap_14_wlll, $_trap_14_wwwl, -$_trap_14_wwwwl, $_trap_14_wllww, $_trap_14_wwwwwww, $_trap_14_wllwwwww, -$_trap_14_wllwwwwlw, $_trap_14_wllwwwwwlw -EOL - -sub Pterm0 { - syscall($_trap_1_w, 0x00); -} -sub Cconin { - syscall($_trap_1_w, 0x01); -} -sub Cconout { - syscall($_trap_1_ww, 0x02, @_); -} -sub Cauxin { - syscall($_trap_1_w, 0x03); -} -sub Cauxout { - syscall($_trap_1_ww, 0x04, @_); -} -sub Cprnout { - syscall($_trap_1_ww, 0x05, @_); -} -sub Crawio { - syscall($_trap_1_ww, 0x06, @_); -} -sub Crawcin { - syscall($_trap_1_w, 0x07); -} -sub Cnecin { - syscall($_trap_1_w, 0x08); -} -sub Cconws { - syscall($_trap_1_wl, 0x09, @_); -} -sub Cconrs { - syscall($_trap_1_wl, 0x0A, @_); -} -sub Cconis { - syscall($_trap_1_w, 0x0B); -} -sub Dsetdrv { - syscall($_trap_1_ww, 0x0E, @_); -} -sub Cconos { - syscall($_trap_1_w, 0x10); -} -sub Cprnos { - syscall($_trap_1_w, 0x11); -} -sub Cauxis { - syscall($_trap_1_w, 0x12); -} -sub Cauxos { - syscall($_trap_1_w, 0x13); -} -sub Dgetdrv { - syscall($_trap_1_w, 0x19); -} -sub Fsetdta { - syscall($_trap_1_wl, 0x1A, @_); -} -sub Super { - syscall($_trap_1_wl, 0x20, @_); -} -sub Tgetdate { - syscall($_trap_1_w, 0x2A); -} -sub Tsetdate { - syscall($_trap_1_ww, 0x2B, @_); -} -sub Tgettime { - syscall($_trap_1_w, 0x2C); -} -sub Tsettime { - syscall($_trap_1_ww, 0x2D, @_); -} -sub Fgetdta { - syscall($_trap_1_w, 0x2F); -} -sub Sversion { - syscall($_trap_1_w, 0x30); -} -sub Ptermres { - syscall($_trap_1_wlw, 0x31, @_); -} -sub Dfree { - syscall($_trap_1_wlw, 0x36, @_); -} -sub Dcreate { - syscall($_trap_1_wl, 0x39, @_); -} -sub Ddelete { - syscall($_trap_1_wl, 0x3A, @_); -} -sub Dsetpath { - syscall($_trap_1_wl, 0x3B, @_); -} -sub Fcreate { - syscall($_trap_1_wlw, 0x3C, @_); -} -sub Fopen { - syscall($_trap_1_wlw, 0x3D, @_); -} -sub Fclose { - syscall($_trap_1_ww, 0x3E, @_); -} -sub Fread { - syscall($_trap_1_wwll, 0x3F, @_); -} -sub Fwrite { - syscall($_trap_1_wwll, 0x40, @_); -} -sub Fdelete { - syscall($_trap_1_wl, 0x41, @_); -} -sub Fseek { - syscall($_trap_1_wlww, 0x42, @_); -} -sub Fattrib { - syscall($_trap_1_wlww, 0x43, @_); -} -sub Fdup { - syscall($_trap_1_ww, 0x45, @_); -} -sub Fforce { - syscall($_trap_1_www, 0x46, @_); -} -sub Dgetpath { - syscall($_trap_1_wlw, 0x47, @_); -} -sub Malloc { - syscall($_trap_1_wl, 0x48, @_); -} -sub Mfree { - syscall($_trap_1_wl, 0x49, @_); -} -sub Mshrink { - syscall($_trap_1_wwll, 0x4A, @_); -} -sub Pexec { - syscall($_trap_1_wwlll, 0x4B, @_); -} -sub Pterm { - syscall($_trap_1_ww, 0x4C, @_); -} -sub Fsfirst { - syscall($_trap_1_wlw, 0x4E, @_); -} -sub Fsnext { - syscall($_trap_1_w, 0x4F); -} -sub Frename { - syscall($_trap_1_wwll, 0x56, @_); -} -sub Fdatime { - syscall($_trap_1_wlww, 0x57, @_); -} -sub Getmpb { - syscall($_trap_13_wl, 0x00, @_); -} -sub Bconstat { - syscall($_trap_13_ww, 0x01, @_); -} -sub Bconin { - syscall($_trap_13_ww, 0x02, @_); -} -sub Bconout { - syscall($_trap_13_www, 0x03, @_); -} -sub Rwabs { - syscall($_trap_13_wwlwww, 0x04, @_); -} -sub Setexc { - syscall($_trap_13_wwl, 0x05, @_); -} -sub Tickcal { - syscall($_trap_13_w, 0x06); -} -sub Getbpb { - syscall($_trap_13_ww, 0x07, @_); -} -sub Bcostat { - syscall($_trap_13_ww, 0x08, @_); -} -sub Mediach { - syscall($_trap_13_ww, 0x09, @_); -} -sub Drvmap { - syscall($_trap_13_w, 0x0A); -} -sub Kbshift { - syscall($_trap_13_ww, 0x0B, @_); -} -sub Getshift { - &Kbshift(-1); -} -sub Initmous { - syscall($_trap_14_wwll, 0x00, @_); -} -sub Ssbrk { - syscall($_trap_14_ww, 0x01, @_); -} -sub Physbase { - syscall($_trap_14_w, 0x02); -} -sub Logbase { - syscall($_trap_14_w, 0x03); -} -sub Getrez { - syscall($_trap_14_w, 0x04); -} -sub Setscreen { - syscall($_trap_14_wllw, 0x05, @_); -} -sub Setpallete { - syscall($_trap_14_wl, 0x06, @_); -} -sub Setcolor { - syscall($_trap_14_www, 0x07, @_); -} -sub Floprd { - syscall($_trap_14_wllwwwww, 0x08, @_); -} -sub Flopwr { - syscall($_trap_14_wllwwwww, 0x09, @_); -} -sub Flopfmt { - syscall($_trap_14_wllwwwwwlw, 0x0A, @_); -} -sub Midiws { - syscall($_trap_14_wwl, 0x0C, @_); -} -sub Mfpint { - syscall($_trap_14_wwl, 0x0D, @_); -} -sub Iorec { - syscall($_trap_14_ww, 0x0E, @_); -} -sub Rsconf { - syscall($_trap_14_wwwwwww, 0x0F, @_); -} -sub Keytbl { - syscall($_trap_14_wlll, 0x10, @_); -} -sub Random { - syscall($_trap_14_w, 0x11); -} -sub Protobt { - syscall($_trap_14_wllww, 0x12, @_); -} -sub Flopver { - syscall($_trap_14_wllwwwww, 0x13, @_); -} -sub Scrdmp { - syscall($_trap_14_w, 0x14); -} -sub Cursconf { - syscall($_trap_14_www, 0x15, @_); -} -sub Settime { - syscall($_trap_14_wl, 0x16, @_); -} -sub Gettime { - syscall($_trap_14_w, 0x17); -} -sub Bioskeys { - syscall($_trap_14_w, 0x18); -} -sub Ikbdws { - syscall($_trap_14_wwl, 0x19, @_); -} -sub Jdisint { - syscall($_trap_14_ww, 0x1A, @_); -} -sub Jenabint { - syscall($_trap_14_ww, 0x1B, @_); -} -sub Giaccess { - syscall($_trap_14_www, 0x1C, @_); -} -sub Offgibit { - syscall($_trap_14_ww, 0x1D, @_); -} -sub Ongibit { - syscall($_trap_14_ww, 0x1E, @_); -} -sub Xbtimer { - syscall($_trap_14_wwwwl, 0x1E, @_); -} -sub Dosound { - syscall($_trap_14_wl, 0x20, @_); -} -sub Setprt { - syscall($_trap_14_ww, 0x21, @_); -} -sub Kbdvbase { - syscall($_trap_14_w, 0x22); -} -sub Kbrate { - syscall($_trap_14_www, 0x23, @_); -} -sub Prtblk { - syscall($_trap_14_wl, 0x24, @_); -} -sub Vsync { - syscall($_trap_14_w, 0x25); -} -sub Supexec { - syscall($_trap_14_wl, 0x26, @_); -} -sub Blitmode { - syscall($_trap_14_ww, 0x40, @_); -} -sub Mxalloc { - syscall($_trap_1_wlw, 0x44, @_); -} -sub Maddalt { - syscall($_trap_1_wll, 0x14, @_); -} -sub Setpalette { - syscall($_trap_14_wl, 0x06, @_); -} -sub EsetShift { - syscall($_trap_14_ww, 80, @_); -} -sub EgetShift { - syscall($_trap_14_w, 81); -} -sub EsetBank { - syscall($_trap_14_ww, 82, @_); -} -sub EsetColor { - syscall($_trap_14_www, 83, @_); -} -sub EsetPalette { - syscall($_trap_14_wwwl, 84, @_); -} -sub EgetPalette { - syscall($_trap_14_wwwl, 85, @_); -} -sub EsetGray { - syscall($_trap_14_ww, 86, @_); -} -sub EsetSmear { - syscall($_trap_14_ww, 87, @_); -} -sub Bconmap { - syscall($_trap_14_ww, 0x2b, @_); -} -sub Bconctl { - syscall($_trap_14_wwl, 0x2d, @_); -} - -1; diff --git a/atarist/perldb.diff b/atarist/perldb.diff deleted file mode 100644 index 8b78159..0000000 --- a/atarist/perldb.diff +++ /dev/null @@ -1,182 +0,0 @@ -*** ../../../lib/perldb.pl Mon Nov 11 10:40:22 1991 ---- perldb.pl Mon May 18 17:00:56 1992 -*************** -*** 1,10 **** - package DB; - -! # modified Perl debugger, to be run from Emacs in perldb-mode -! # Ray Lischner (uunet!mntgfx!lisch) as of 5 Nov 1990 -! # Johan Vromans -- upgrade to 4.0 pl 10 -! -! $header = '$RCSfile: perldb.diff,v $$Revision: 4.1 $$Date: 92/08/07 17:18:44 $'; - # - # This file is automatically included if you do perl -d. - # It's probably not useful to include this yourself. ---- 1,6 ---- - package DB; - -! $header = '$RCSfile: perldb.diff,v $$Revision: 4.1 $$Date: 92/08/07 17:18:44 $'; - # - # This file is automatically included if you do perl -d. - # It's probably not useful to include this yourself. -*************** -*** 14,22 **** - # have a breakpoint. It also inserts a do 'perldb.pl' before the first line. - # - # $Log: perldb.diff,v $ - # Revision 4.1 92/08/07 17:18:44 lwall - # Stage 6 Snapshot - # - # Revision 4.0.1.1 92/06/08 11:50:28 lwall - # Initial revision - # -- # Revision 4.0.1.2 91/11/05 17:55:58 lwall -- # patch11: perldb.pl modified to run within emacs in perldb-mode -- # - # Revision 4.0.1.1 91/06/07 11:17:44 lwall - # patch4: added $^P variable to control calling of perldb routines - # patch4: debugger sometimes listed wrong number of lines for a statement ---- 10,15 ---- -*************** -*** 56,63 **** - # - # - -! open(IN, "/dev/tty") || open(OUT, ">&STDOUT"); # so we don't dongle stdout - select(OUT); - $| = 1; # for DB'OUT - select(STDOUT); ---- 49,56 ---- - # - # - -! open(IN, "/dev/console") || open(OUT, ">&STDOUT"); # so we don't dongle stdout - select(OUT); - $| = 1; # for DB'OUT - select(STDOUT); -*************** -*** 64,79 **** - $| = 1; # for real STDOUT - $sub = ''; - -- # Is Perl being run from Emacs? -- $emacs = $main'ARGV[$[] eq '-emacs'; -- shift(@main'ARGV) if $emacs; -- - $header =~ s/.Header: ([^,]+),v(\s+\S+\s+\S+).*$/$1$2/; -! print OUT "\nLoading DB routines from $header\n"; -! print OUT ("Emacs support ", -! $emacs ? "enabled" : "available", -! ".\n"); -! print OUT "\nEnter h for help.\n\n"; - - sub DB { - &save; ---- 57,64 ---- - $| = 1; # for real STDOUT - $sub = ''; - - $header =~ s/.Header: ([^,]+),v(\s+\S+\s+\S+).*$/$1$2/; -! print OUT "\nLoading DB routines from $header\n\nEnter h for help.\n\n"; - - sub DB { - &save; -*************** -*** 93,107 **** - } - } - if ($single || $trace || $signal) { -! if ($emacs) { -! print OUT "\032\032$filename:$line:0\n"; -! } else { -! print OUT "$package'" unless $sub =~ /'/; -! print OUT "$sub($filename:$line):\t",$dbline[$line]; -! for ($i = $line + 1; $i <= $max && $dbline[$i] == 0; ++$i) { -! last if $dbline[$i] =~ /^\s*(}|#|\n)/; -! print OUT "$sub($filename:$i):\t",$dbline[$i]; -! } - } - } - $evalarg = $action, &eval if $action; ---- 78,88 ---- - } - } - if ($single || $trace || $signal) { -! print OUT "$package'" unless $sub =~ /'/; -! print OUT "$sub($filename:$line):\t",$dbline[$line]; -! for ($i = $line + 1; $i <= $max && $dbline[$i] == 0; ++$i) { -! last if $dbline[$i] =~ /^\s*(;|}|#|\n)/; -! print OUT "$sub($filename:$i):\t",$dbline[$i]; - } - } - $evalarg = $action, &eval if $action; -*************** -*** 263,276 **** - $i = $2; - $i = $line if $i eq '.'; - $i = 1 if $i < 1; -! if ($emacs) { -! print OUT "\032\032$filename:$i:0\n"; -! $i = $end; -! } else { -! for (; $i <= $end; $i++) { -! print OUT "$i:\t", $dbline[$i]; -! last if $signal; -! } - } - $start = $i; # remember in case they want more - $start = $max if $start > $max; ---- 244,252 ---- - $i = $2; - $i = $line if $i eq '.'; - $i = 1 if $i < 1; -! for (; $i <= $end; $i++) { -! print OUT "$i:\t", $dbline[$i]; -! last if $signal; - } - $start = $i; # remember in case they want more - $start = $max if $start > $max; -*************** -*** 417,427 **** - $start = 1 if ($start > $max); - last if ($start == $end); - if ($dbline[$start] =~ m'."\n$pat\n".'i) { -! if ($emacs) { -! print OUT "\032\032$filename:$start:0\n"; -! } else { -! print OUT "$start:\t", $dbline[$start], "\n"; -! } - last; - } - } '; ---- 393,399 ---- - $start = 1 if ($start > $max); - last if ($start == $end); - if ($dbline[$start] =~ m'."\n$pat\n".'i) { -! print OUT "$start:\t", $dbline[$start], "\n"; - last; - } - } '; -*************** -*** 445,455 **** - $start = $max if ($start <= 0); - last if ($start == $end); - if ($dbline[$start] =~ m'."\n$pat\n".'i) { -! if ($emacs) { -! print OUT "\032\032$filename:$start:0\n"; -! } else { -! print OUT "$start:\t", $dbline[$start], "\n"; -! } - last; - } - } '; ---- 417,423 ---- - $start = $max if ($start <= 0); - last if ($start == $end); - if ($dbline[$start] =~ m'."\n$pat\n".'i) { -! print OUT "$start:\t", $dbline[$start], "\n"; - last; - } - } '; diff --git a/atarist/perlglob.c b/atarist/perlglob.c deleted file mode 100644 index 002639e..0000000 --- a/atarist/perlglob.c +++ /dev/null @@ -1,45 +0,0 @@ -/* - * glob and echo any globbed args - * - * ++jrb bammi@cadence.com - */ - -#include - -#if __STDC__ -# include -#else -# define __PROTO(X) () -#endif - -char **glob __PROTO((char *patt, int decend_dir)); -int contains_wild __PROTO((char *patt)); -void free_all __PROTO((void)); - - -int main(argc, argv) -int argc; -char **argv; -{ - --argc; ++argv; - while(argc--) - { - char *word = *argv; - char **list; - int did_some = 0; - - if(contains_wild(word) && (list = glob(word, 0))) - { - while(*list) - { - fputs(*list, stdout); - if(*++list) putchar(' '); - } - free_all(); - did_some = 1; - } - if(*++argv && did_some) putchar(' '); - } - putchar('\0'); - return 0; -} diff --git a/atarist/test/binhandl b/atarist/test/binhandl deleted file mode 100644 index 6f62f4d..0000000 --- a/atarist/test/binhandl +++ /dev/null @@ -1,15 +0,0 @@ -die "Usage: binhandl files ...\n" if $#ARGV < $[; - -NEXTFILE: -while ($FILEHAND = shift) { - unless (open(FILEHAND)) { - printf STDERR "Can't open \"$FILEHAND\"\n"; - next NEXTFILE; - } - if (-B FILEHAND) { - print "\"$FILEHAND\" is binary\n"; - } else { - print "\"$FILEHAND\" is text\n"; - } - close(FILEHAND); -} diff --git a/atarist/test/ccon b/atarist/test/ccon deleted file mode 100644 index 47bc8e2..0000000 --- a/atarist/test/ccon +++ /dev/null @@ -1,5 +0,0 @@ -require 'osbind.pl'; - - &Cconws("Hello World\r\n"); - $str = "This is a string being printed by Fwrite Gemdos trap\r\n"; - &Fwrite(1, length($str), $str); diff --git a/atarist/test/dbm b/atarist/test/dbm deleted file mode 100644 index b73e07d..0000000 --- a/atarist/test/dbm +++ /dev/null @@ -1,124 +0,0 @@ -die "cant create dbmtest" unless dbmopen(%keys, "dbmtest", 0666); - -print "Writing...\n"; -$keys{'key0'} = 0; -$keys{'key1'} = 1; -$keys{'key2'} = 2; -$keys{'key3'} = 3; -$keys{'key4'} = 4; -$keys{'key5'} = 5; -$keys{'key6'} = 6; -$keys{'key7'} = 7; -$keys{'key8'} = 8; -$keys{'key9'} = 9; -$keys{'key10'} = 10; -$keys{'key11'} = 11; -$keys{'key12'} = 12; -$keys{'key13'} = 13; -$keys{'key14'} = 14; -$keys{'key15'} = 15; -$keys{'key16'} = 16; -$keys{'key17'} = 17; -$keys{'key18'} = 18; -$keys{'key19'} = 19; -$keys{'key20'} = 20; -$keys{'key21'} = 21; -$keys{'key22'} = 22; -$keys{'key23'} = 23; -$keys{'key24'} = 24; -$keys{'key25'} = 25; -$keys{'key26'} = 26; -$keys{'key27'} = 27; -$keys{'key28'} = 28; -$keys{'key29'} = 29; -$keys{'key30'} = 30; -$keys{'key31'} = 31; -$keys{'key32'} = 32; -$keys{'key33'} = 33; -$keys{'key34'} = 34; -$keys{'key35'} = 35; -$keys{'key36'} = 36; -$keys{'key37'} = 37; -$keys{'key38'} = 38; -$keys{'key39'} = 39; -$keys{'key40'} = 40; -$keys{'key41'} = 41; -$keys{'key42'} = 42; -$keys{'key43'} = 43; -$keys{'key44'} = 44; -$keys{'key45'} = 45; -$keys{'key46'} = 46; -$keys{'key47'} = 47; -$keys{'key48'} = 48; -$keys{'key49'} = 49; -$keys{'key50'} = 50; -$keys{'key51'} = 51; -$keys{'key52'} = 52; -$keys{'key53'} = 53; -$keys{'key54'} = 54; -$keys{'key55'} = 55; -$keys{'key56'} = 56; -$keys{'key57'} = 57; -$keys{'key58'} = 58; -$keys{'key59'} = 59; -$keys{'key60'} = 60; -$keys{'key61'} = 61; -$keys{'key62'} = 62; -$keys{'key63'} = 63; -$keys{'key64'} = 64; -$keys{'key65'} = 65; -$keys{'key66'} = 66; -$keys{'key67'} = 67; -$keys{'key68'} = 68; -$keys{'key69'} = 69; -$keys{'key70'} = 70; -$keys{'key71'} = 71; -$keys{'key72'} = 72; -$keys{'key73'} = 73; -$keys{'key74'} = 74; -$keys{'key75'} = 75; -$keys{'key76'} = 76; -$keys{'key77'} = 77; -$keys{'key78'} = 78; -$keys{'key79'} = 79; -$keys{'key80'} = 80; -$keys{'key81'} = 81; -$keys{'key82'} = 82; -$keys{'key83'} = 83; -$keys{'key84'} = 84; -$keys{'key85'} = 85; -$keys{'key86'} = 86; -$keys{'key87'} = 87; -$keys{'key88'} = 88; -$keys{'key89'} = 89; -$keys{'key90'} = 90; -$keys{'key91'} = 91; -$keys{'key92'} = 92; -$keys{'key93'} = 93; -$keys{'key94'} = 94; -$keys{'key95'} = 95; -$keys{'key96'} = 96; -$keys{'key97'} = 97; -$keys{'key98'} = 98; -$keys{'key99'} = 99; -$keys{'key9998'} = 9998; -$keys{'key9999'} = 9999; -print "Done\n"; - -dbmclose (%keys); - -die "cant read dbmtest" unless dbmopen(%rkeys, "dbmtest", undef); - -$i = 0; -print "Reading...\n"; -while (($key, $val) = each %rkeys) -{ - if ($keys{$key} != $val) - { - print 'Incorrect val ', $key, ' = ', $val, ' expecting ', $keys{$key}, "\n"; - $i = $i + 1; - } -} -print "Done\n"; -dbmclose (%keys); -print $i, "Error(s)\n"; diff --git a/atarist/test/err b/atarist/test/err deleted file mode 100644 index cf32624..0000000 --- a/atarist/test/err +++ /dev/null @@ -1,4 +0,0 @@ -$! = 0 + 0; -print $!, "\n"; -$e = $! + 0; -print $e, "\n"; diff --git a/atarist/test/gdbm b/atarist/test/gdbm deleted file mode 100644 index 207eea3..0000000 --- a/atarist/test/gdbm +++ /dev/null @@ -1,28 +0,0 @@ -die "cant create dbmtest" unless dbmopen(%keys, "dbmtest", 0666); - -print "Writing...\n"; - -foreach (0..100) { - $keys{"$_"} = $_; -} - -print "Done\n"; - -dbmclose (%keys); - -die "cant read dbmtest" unless dbmopen(%rkeys, "dbmtest", undef); - -$i = 0; -print "Reading...\n"; -while (($key, $val) = each %rkeys) -{ - if ($keys{$key} != $val) - { - print 'Incorrect val ', $key, ' = ', $val, ' expecting ', $keys{$key}, "\n"; - $i = $i + 1; - } -} -print "Done\n"; -dbmclose (%keys); -print $i, " Error(s)\n"; -unlink "dbmtest"; diff --git a/atarist/test/gdbm.t b/atarist/test/gdbm.t deleted file mode 100644 index 8e4a3a1..0000000 --- a/atarist/test/gdbm.t +++ /dev/null @@ -1,101 +0,0 @@ -#!./perl - -# -# based on t/op/dbm.t modified for gdbm and atariST stat() semantics -# -print "1..12\n"; - -unlink ; -umask(0); -print (dbmopen(h,'Op.dbm',0640) ? "ok 1\n" : "not ok 1\n"); -($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, - $blksize,$blocks) = stat('Op.dbm'); -print (($mode & 0770) == 0640 ? "ok 2\n" : "not ok 2\n"); -while (($key,$value) = each(h)) { - $i++; -} -print (!$i ? "ok 3\n" : "not ok 3\n"); - -$h{'goner1'} = 'snork'; - -$h{'abc'} = 'ABC'; -$h{'def'} = 'DEF'; -$h{'jkl','mno'} = "JKL\034MNO"; -$h{'a',2,3,4,5} = join("\034",'A',2,3,4,5); -$h{'a'} = 'A'; -$h{'b'} = 'B'; -$h{'c'} = 'C'; -$h{'d'} = 'D'; -$h{'e'} = 'E'; -$h{'f'} = 'F'; -$h{'g'} = 'G'; -$h{'h'} = 'H'; -$h{'i'} = 'I'; - -$h{'goner2'} = 'snork'; -delete $h{'goner2'}; - -dbmclose(h); -print (dbmopen(h,'Op.dbm',0640) ? "ok 4\n" : "not ok 4\n"); - -$h{'j'} = 'J'; -$h{'k'} = 'K'; -$h{'l'} = 'L'; -$h{'m'} = 'M'; -$h{'n'} = 'N'; -$h{'o'} = 'O'; -$h{'p'} = 'P'; -$h{'q'} = 'Q'; -$h{'r'} = 'R'; -$h{'s'} = 'S'; -$h{'t'} = 'T'; -$h{'u'} = 'U'; -$h{'v'} = 'V'; -$h{'w'} = 'W'; -$h{'x'} = 'X'; -$h{'y'} = 'Y'; -$h{'z'} = 'Z'; - -$h{'goner3'} = 'snork'; - -delete $h{'goner1'}; -delete $h{'goner3'}; - -@keys = keys(%h); -@values = values(%h); - -if ($#keys == 29 && $#values == 29) {print "ok 5\n";} else {print "not ok 5\n";} - -while (($key,$value) = each(h)) { - if ($key eq $keys[$i] && $value eq $values[$i] && $key gt $value) { - $key =~ y/a-z/A-Z/; - $i++ if $key eq $value; - } -} - -if ($i == 30) {print "ok 6\n";} else {print "not ok 6\n";} - -@keys = ('blurfl', keys(h), 'dyick'); -if ($#keys == 31) {print "ok 7\n";} else {print "not ok 7\n";} - -$h{'foo'} = ''; -$h{''} = 'bar'; - -# check cache overflow and numeric keys and contents -$ok = 1; -for ($i = 1; $i < 200; $i++) { $h{$i + 0} = $i + 0; } -for ($i = 1; $i < 200; $i++) { $ok = 0 unless $h{$i} == $i; } -print ($ok ? "ok 8\n" : "not ok 8\n"); - -($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, - $blksize,$blocks) = stat('Op.dbm'); -print ($size > 0 ? "ok 9\n" : "not ok 9\n"); - -@h{0..200} = 200..400; -@foo = @h{0..200}; -print join(':',200..400) eq join(':',@foo) ? "ok 10\n" : "not ok 10\n"; - -print ($h{'foo'} eq '' ? "ok 11\n" : "not ok 11\n"); -print ($h{''} eq 'bar' ? "ok 12\n" : "not ok 12\n"); - -unlink 'Op.dbm'; diff --git a/atarist/test/glob b/atarist/test/glob deleted file mode 100644 index c090c56..0000000 --- a/atarist/test/glob +++ /dev/null @@ -1,4 +0,0 @@ -while(<*.pl>) -{ - print $_, "\n"; -} diff --git a/atarist/test/osexample.pl b/atarist/test/osexample.pl deleted file mode 100644 index 47bc8e2..0000000 --- a/atarist/test/osexample.pl +++ /dev/null @@ -1,5 +0,0 @@ -require 'osbind.pl'; - - &Cconws("Hello World\r\n"); - $str = "This is a string being printed by Fwrite Gemdos trap\r\n"; - &Fwrite(1, length($str), $str); diff --git a/atarist/test/pi.pl b/atarist/test/pi.pl deleted file mode 100644 index b7766bb..0000000 --- a/atarist/test/pi.pl +++ /dev/null @@ -1,174 +0,0 @@ -# --------------------------------------------------------------------------- -# pi.perl computes pi (3.14...) about 5120 Digits -# -# W. Kebsch, July-1988 {uunet!mcvax}!unido!nixpbe!kebsch - -$my_name = $0; -$version = $my_name . "-1.2"; - -# some working parameter - -$smax = 5120; # max digits -$lmax = 4; # digits per one array element -$hmax = 10000; # one array element contains: 0..9999 -$smin = $lmax; # min digits -$mag = 7; # magic number - -# subroutines - -sub mul_tm # multiply the tm array with a long value -{ - $cb = pop(@_); # elements(array) - $x = pop(@_); # value - - $c = 0; - for($i = 1; $i <= $cb; $i++) - { - $z = $tm[$i] * $x + $c; - $c = int($z / $hmax); - $tm[$i] = $z - $c * $hmax; - } -} - -sub mul_pm # multiply the pm array with a long value -{ - $cb = pop(@_); # elements(array) - $x = pop(@_); # value - - $c = 0; - for($i = 1; $i <= $cb; $i++) - { - $z = $pm[$i] * $x + $c; - $c = int($z / $hmax); - $pm[$i] = $z - $c * $hmax; - } -} - -sub divide # divide the tm array by a long value -{ - $cb = pop(@_); # elements(array) - $x = pop(@_); # value - - $c = 0; - for($i = $cb; $i >= 1; $i--) - { - $z = $tm[$i] + $c; - $q = int($z / $x); - $tm[$i] = $q; - $c = ($z - $q * $x) * $hmax; - } -} - -sub add # add tm array to pm array -{ - $cb = pop(@_); # elements(array) - - $c = 0; - for($i = 1; $i <= $cb; $i++) - { - $z = $pm[$i] + $tm[$i] + $c; - if($z >= $hmax) - { - $pm[$i] = $z - $hmax; - $c = 1; - } - else - { - $pm[$i] = $z; - $c = 0; - } - } -} - -$m0 = 0; $m1 = 0; $m2 = 0; - -sub check_xb # reduce current no. of elements (speed up!) -{ - $cb = pop(@_); # current no. of elements - - if(($pm[$cb] == $m0) && ($pm[$cb - 1] == $m1) && ($pm[$cb - 2] == $m2)) - { - $cb--; - } - $m0 = $pm[$cb]; - $m1 = $pm[$cb - 1]; - $m2 = $pm[$cb - 2]; - $cb; -} - -sub display # show the result -{ - $cb = pop(@_); # elements(array); - - printf("\n%3d.", $pm[$cb]); - $j = $mag - $lmax; - for($i = $cb - 1; $i >= $j; $i--) - { - printf(" %04d", $pm[$i]); - } - print "\n"; -} - -sub the_job # let's do the job -{ - $s = pop(@_); # no. of digits - - $s = int(($s + $lmax - 1) / $lmax) * $lmax; - $b = int($s / $lmax) + $mag - $lmax; - $xb = $b; - $t = int($s * 5 / 3); - - for($i = 1; $i <= $b; $i++) # init arrays - { - $pm[$i] = 0; - $tm[$i] = 0; - } - $pm[$b - 1] = $hmax / 2; - $tm[$b - 1] = $hmax / 2; - - printf("digits:%5d, terms:%5d, elements:%5d\n", $s, $t, $b); - for($n = 1; $n <= $t; $n++) - { - printf("\r\t\t\t term:%5d", $n); - if($n < 200) - { - do mul_tm((4 * ($n * $n - $n) + 1), $xb); - } - else - { - do mul_tm((2 * $n - 1), $xb); - do mul_tm((2 * $n - 1), $xb); - } - if($n < 100) - { - do divide(($n * (16 * $n + 8)), $xb); - } - else - { - do divide((8 * $n), $xb); - do divide((2 * $n + 1), $xb); - } - do add($xb); - if($xb > $mag) - { - $xb = do check_xb($xb); - } - } - do mul_pm(6, $b); - do display($b); - ($user,$sys,$cuser,$csys) = times; - printf("\n[u=%g s=%g cu=%g cs=%g]\n",$user, $sys, $cuser, $csys); -} - -# main block ---------------------------------------------------------------- - -$no_of_args = $#ARGV + 1; -print("$version, "); -die("usage: $my_name ") unless($no_of_args == 1); -$digits = int($ARGV[0]); -die("no. of digits out of range [$smin\..$smax]") - unless(($digits >= $smin) && ($digits <= $smax)); -do the_job($digits); -exit 0; - -# That's all ---------------------------------------------------------------- diff --git a/atarist/test/printenv b/atarist/test/printenv deleted file mode 100644 index 6c2619a..0000000 --- a/atarist/test/printenv +++ /dev/null @@ -1,16 +0,0 @@ -$exit = 0; -$\ = "\n"; -if($#ARGV >= 0) { - foreach (@ARGV) { - if(defined $ENV{$_}) { - print $ENV{$_}; - } else { - $exit = 1; - } - } -} else { - foreach (sort keys %ENV) { - print $_, '=', $ENV{$_}; - } -} -exit $exit; diff --git a/atarist/test/readme b/atarist/test/readme deleted file mode 100644 index 9b75f99..0000000 --- a/atarist/test/readme +++ /dev/null @@ -1,3 +0,0 @@ -this directory contain simple tests for the atariST port. to run a test -simply enter - perl file diff --git a/atarist/test/sig b/atarist/test/sig deleted file mode 100644 index ac1b2b2..0000000 --- a/atarist/test/sig +++ /dev/null @@ -1,12 +0,0 @@ -sub handler { - local($sig) = @_; - print "Caught SIG$sig\n"; - exit(0); -} - -$SIG{'INT'} = 'handler'; - -print "Hit CRTL-C to see if it is trapped\n"; -while($_ = ) { - print $_; -} diff --git a/atarist/test/tbinmode b/atarist/test/tbinmode deleted file mode 100644 index 4cf4f78..0000000 --- a/atarist/test/tbinmode +++ /dev/null @@ -1,12 +0,0 @@ -open(FP, ">bintest") || die "Can't open bintest for write\n"; -binmode FP; -print FP pack("C*", 0xaa, 0x55, 0xaa, 0x55, - 0xff, 0x0d, 0x0a); -close FP; - -open(FP, "); -close FP; -printf "expect:\t7 elements: aa 55 aa 55 ff 0d 0a\n"; -printf "got:\t%d elements: %x %x %x %x %x %02x %02x\n", $#got+1-$[, @got; diff --git a/atarist/usersub.c b/atarist/usersub.c deleted file mode 100644 index aba53d7..0000000 --- a/atarist/usersub.c +++ /dev/null @@ -1,9 +0,0 @@ -#include "EXTERN.h" -#include "perl.h" -#include - -int userinit() -{ - install_null(); /* install device /dev/null or NUL: */ - return 0; -} diff --git a/atarist/usub/README.ATARI b/atarist/usub/README.ATARI deleted file mode 100644 index 89174eb..0000000 --- a/atarist/usub/README.ATARI +++ /dev/null @@ -1 +0,0 @@ -For the atariST bsd derived curses use acurses.mus (its got its own wrinkles!) diff --git a/atarist/usub/acurses.mus b/atarist/usub/acurses.mus deleted file mode 100644 index 67e6b74..0000000 --- a/atarist/usub/acurses.mus +++ /dev/null @@ -1,704 +0,0 @@ -/* $RCSfile: acurses.mus,v $$Revision: 4.1 $$Date: 92/08/07 17:19:04 $ - * - * $Log: acurses.mus,v $ - * Revision 4.1 92/08/07 17:19:04 lwall - * Stage 6 Snapshot - * - * Revision 4.0.1.1 92/06/08 11:54:30 lwall - * Initial revision - * - * Revision 4.0.1.1 91/11/05 19:04:53 lwall - * initial checkin - * - * Revision 4.0 91/03/20 01:56:13 lwall - * 4.0 baseline. - * - * Revision 3.0.1.1 90/08/09 04:05:21 lwall - * patch19: Initial revision - * - */ - -#include "EXTERN.h" -#include "perl.h" - -char *savestr(); - -#ifdef atarist /* save and restore definition of VOID around curses.h */ -# define __SAVEVOID VOID -# undef VOID -#endif - -#include - -static enum uservars { - UV_curscr, - UV_stdscr, - UV_Def_term, - UV_My_term, - UV_ttytype, - UV_LINES, - UV_COLS, - UV_ERR, - UV_OK, -}; - -static enum usersubs { - US_addch, - US_waddch, - US_addstr, - US_waddstr, - US_box, - US_clear, - US_wclear, - US_clearok, - US_clrtobot, - US_wclrtobot, - US_clrtoeol, - US_wclrtoeol, - US_delch, - US_wdelch, - US_deleteln, - US_wdeleteln, - US_erase, - US_werase, - US_flushok, - US_idlok, - US_insch, - US_winsch, - US_insertln, - US_winsertln, - US_move, - US_wmove, - US_overlay, - US_overwrite, - US_printw, - US_wprintw, - US_refresh, - US_wrefresh, - US_standout, - US_wstandout, - US_standend, - US_wstandend, - US_cbreak, - US_nocbreak, - US_echo, - US_noecho, - US_getch, - US_wgetch, - US_getstr, - US_wgetstr, - US_raw, - US_noraw, - US_scanw, - US_wscanw, - US_baudrate, - US_delwin, - US_endwin, - US_erasechar, - US_getcap, - US_getyx, - US_inch, - US_winch, - US_initscr, - US_killchar, - US_leaveok, - US_longname, - US_fullname, - US_mvwin, - US_newwin, - US_nl, - US_nonl, - US_scrollok, - US_subwin, - US_touchline, - US_touchoverlap, - US_touchwin, - US_unctrl, - US_gettmode, - US_mvcur, - US_scroll, - US_savetty, - US_resetty, - US_setterm, - US_tstp, - US__putchar, - US_testcallback, -}; - -static int usersub(); -static int userset(); -static int userval(); - -int -init_curses() -{ - struct ufuncs uf; - char *filename = "curses.c"; - - uf.uf_set = userset; - uf.uf_val = userval; - -#define MAGICVAR(name, ix) uf.uf_index = ix, magicname(name, &uf, sizeof uf) - - MAGICVAR("curscr", UV_curscr); - MAGICVAR("stdscr", UV_stdscr); - MAGICVAR("Def_term",UV_Def_term); - MAGICVAR("My_term", UV_My_term); - MAGICVAR("ttytype", UV_ttytype); - MAGICVAR("LINES", UV_LINES); - MAGICVAR("COLS", UV_COLS); - MAGICVAR("ERR", UV_ERR); - MAGICVAR("OK", UV_OK); - - make_usub("addch", US_addch, usersub, filename); - make_usub("waddch", US_waddch, usersub, filename); - make_usub("addstr", US_addstr, usersub, filename); - make_usub("waddstr", US_waddstr, usersub, filename); - make_usub("box", US_box, usersub, filename); - make_usub("clear", US_clear, usersub, filename); - make_usub("wclear", US_wclear, usersub, filename); - make_usub("clearok", US_clearok, usersub, filename); - make_usub("clrtobot", US_clrtobot, usersub, filename); - make_usub("wclrtobot", US_wclrtobot, usersub, filename); - make_usub("clrtoeol", US_clrtoeol, usersub, filename); - make_usub("wclrtoeol", US_wclrtoeol, usersub, filename); - make_usub("delch", US_delch, usersub, filename); - make_usub("wdelch", US_wdelch, usersub, filename); - make_usub("deleteln", US_deleteln, usersub, filename); - make_usub("wdeleteln", US_wdeleteln, usersub, filename); - make_usub("erase", US_erase, usersub, filename); - make_usub("werase", US_werase, usersub, filename); - make_usub("flushok", US_flushok, usersub, filename); - make_usub("idlok", US_idlok, usersub, filename); - make_usub("insch", US_insch, usersub, filename); - make_usub("winsch", US_winsch, usersub, filename); - make_usub("insertln", US_insertln, usersub, filename); - make_usub("winsertln", US_winsertln, usersub, filename); - make_usub("move", US_move, usersub, filename); - make_usub("wmove", US_wmove, usersub, filename); - make_usub("overlay", US_overlay, usersub, filename); - make_usub("overwrite", US_overwrite, usersub, filename); - make_usub("printw", US_printw, usersub, filename); - make_usub("wprintw", US_wprintw, usersub, filename); - make_usub("refresh", US_refresh, usersub, filename); - make_usub("wrefresh", US_wrefresh, usersub, filename); - make_usub("standout", US_standout, usersub, filename); - make_usub("wstandout", US_wstandout, usersub, filename); - make_usub("standend", US_standend, usersub, filename); - make_usub("wstandend", US_wstandend, usersub, filename); - make_usub("cbreak", US_cbreak, usersub, filename); - make_usub("nocbreak", US_nocbreak, usersub, filename); - make_usub("echo", US_echo, usersub, filename); - make_usub("noecho", US_noecho, usersub, filename); - make_usub("getch", US_getch, usersub, filename); - make_usub("wgetch", US_wgetch, usersub, filename); - make_usub("getstr", US_getstr, usersub, filename); - make_usub("wgetstr", US_wgetstr, usersub, filename); - make_usub("raw", US_raw, usersub, filename); - make_usub("noraw", US_noraw, usersub, filename); - make_usub("scanw", US_scanw, usersub, filename); - make_usub("wscanw", US_wscanw, usersub, filename); - make_usub("baudrate", US_baudrate, usersub, filename); - make_usub("delwin", US_delwin, usersub, filename); - make_usub("endwin", US_endwin, usersub, filename); - make_usub("erasechar", US_erasechar, usersub, filename); - make_usub("getcap", US_getcap, usersub, filename); - make_usub("getyx", US_getyx, usersub, filename); - make_usub("inch", US_inch, usersub, filename); - make_usub("winch", US_winch, usersub, filename); - make_usub("initscr", US_initscr, usersub, filename); - make_usub("killchar", US_killchar, usersub, filename); - make_usub("leaveok", US_leaveok, usersub, filename); - make_usub("longname", US_longname, usersub, filename); - make_usub("fullname", US_fullname, usersub, filename); - make_usub("mvwin", US_mvwin, usersub, filename); - make_usub("newwin", US_newwin, usersub, filename); - make_usub("nl", US_nl, usersub, filename); - make_usub("nonl", US_nonl, usersub, filename); - make_usub("scrollok", US_scrollok, usersub, filename); - make_usub("subwin", US_subwin, usersub, filename); - make_usub("touchline", US_touchline, usersub, filename); - make_usub("touchoverlap", US_touchoverlap,usersub, filename); - make_usub("touchwin", US_touchwin, usersub, filename); - make_usub("unctrl", US_unctrl, usersub, filename); - make_usub("gettmode", US_gettmode, usersub, filename); - make_usub("mvcur", US_mvcur, usersub, filename); - make_usub("scroll", US_scroll, usersub, filename); - make_usub("savetty", US_savetty, usersub, filename); - make_usub("resetty", US_resetty, usersub, filename); - make_usub("setterm", US_setterm, usersub, filename); - make_usub("tstp", US_tstp, usersub, filename); - make_usub("_putchar", US__putchar, usersub, filename); - make_usub("testcallback", US_testcallback,usersub, filename); -}; - -static int -usersub(ix, sp, items) -int ix; -register int sp; -register int items; -{ - STR **st = stack->ary_array + sp; - register int i; - register char *tmps; - register STR *Str; /* used in str_get and str_gnum macros */ - - switch (ix) { -CASE int addch -I char ch -END - -CASE int waddch -I WINDOW* win -I char ch -END - -CASE int addstr -I char* str -END - -CASE int waddstr -I WINDOW* win -I char* str -END - -CASE void box -I WINDOW* win -I char vert -I char hor -END - -CASE int clear -END - -CASE int wclear -I WINDOW* win -END - -CASE int clearok -I WINDOW* win -I bool boolf -END - -CASE void clrtobot -END - -CASE void wclrtobot -I WINDOW* win -END - -CASE void clrtoeol -END - -CASE void wclrtoeol -I WINDOW* win -END - -CASE int delch -END - -CASE int wdelch -I WINDOW* win -END - -CASE int deleteln -END - -CASE int wdeleteln -I WINDOW* win -END - -CASE void erase -END - -CASE void werase -I WINDOW* win -END - -CASE int flushok -I WINDOW* win -I bool boolf -END - -CASE void idlok -I WINDOW* win -I bool boolf -END - -CASE int insch -I char c -END - -CASE int winsch -I WINDOW* win -I char c -END - -CASE void insertln -END - -CASE void winsertln -I WINDOW* win -END - -CASE int move -I int y -I int x -END - -CASE int wmove -I WINDOW* win -I int y -I int x -END - -CASE void overlay -I WINDOW* win1 -I WINDOW* win2 -END - -CASE void overwrite -I WINDOW* win1 -I WINDOW* win2 -END - - case US_printw: - if (items < 1) - fatal("Usage: &printw($fmt, $arg1, $arg2, ... )"); - else { - int retval; - STR* str = str_new(0); - - do_sprintf(str, items - 1, st + 1); - retval = addstr(str->str_ptr); - str_numset(st[0], (double) retval); - str_free(str); - } - return sp; - - case US_wprintw: - if (items < 2) - fatal("Usage: &wprintw($win, $fmt, $arg1, $arg2, ... )"); - else { - int retval; - STR* str = str_new(0); - WINDOW* win = *(WINDOW**) str_get(st[1]); - - do_sprintf(str, items - 1, st + 1); - retval = waddstr(win, str->str_ptr); - str_numset(st[0], (double) retval); - str_free(str); - } - return sp; - -CASE int refresh -END - -CASE int wrefresh -I WINDOW* win -END - -CASE int standout -END - -CASE void wstandout -I WINDOW* win -END - -CASE int standend -END - -CASE void wstandend -I WINDOW* win -END - -CASE int cbreak -END - -CASE int nocbreak -END - -CASE int echo -END - -CASE int noecho -END - - case US_getch: - if (items != 0) - fatal("Usage: &getch()"); - else { - int retval; - char retch; - - retval = getch(); - if (retval == EOF) - st[0] = &str_undef; - else { - retch = retval; - str_nset(st[0], &retch, 1); - } - } - return sp; - - case US_wgetch: - if (items != 1) - fatal("Usage: &wgetch($win)"); - else { - int retval; - char retch; - WINDOW* win = *(WINDOW**) str_get(st[1]); - - retval = wgetch(win); - if (retval == EOF) - st[0] = &str_undef; - else { - retch = retval; - str_nset(st[0], &retch, 1); - } - } - return sp; - -CASE int getstr -IO char* str -END - -CASE int wgetstr -I WINDOW* win -IO char* str -END - -CASE int raw -END - -CASE int noraw -END - -CASE int baudrate -END - -CASE void delwin -I WINDOW* win -END - -CASE void endwin -END - -CASE int erasechar -END - - case US_getcap: - if (items != 1) - fatal("Usage: &getcap($str)"); - else { - char* retval; - char* str = (char*) str_get(st[1]); - char output[50], *outputp = output; - - retval = tgetstr(str, &outputp); - str_set(st[0], (char*) retval); - } - return sp; - - case US_getyx: - if (items != 3) - fatal("Usage: &getyx($win, $y, $x)"); - else { - int retval; - STR* str = str_new(0); - WINDOW* win = *(WINDOW**) str_get(st[1]); - int y; - int x; - - do_sprintf(str, items - 1, st + 1); - retval = getyx(win, y, x); - str_numset(st[2], (double)y); - str_numset(st[3], (double)x); - str_numset(st[0], (double) retval); - str_free(str); - } - return sp; - - -CASE int inch -END - -CASE int winch -I WINDOW* win -END - -CASE WINDOW* initscr -END - -CASE int killchar -END - -CASE int leaveok -I WINDOW* win -I bool boolf -END - -CASE char* longname -I char* termbuf -IO char* name -END - -CASE int fullname -I char* termbuf -IO char* name -END - -CASE int mvwin -I WINDOW* win -I int y -I int x -END - -CASE WINDOW* newwin -I int lines -I int cols -I int begin_y -I int begin_x -END - -CASE int nl -END - -CASE int nonl -END - -CASE int scrollok -I WINDOW* win -I bool boolf -END - -CASE WINDOW* subwin -I WINDOW* win -I int lines -I int cols -I int begin_y -I int begin_x -END - -CASE void touchline -I WINDOW* win -I int y -I int startx -I int endx -END - -CASE void touchoverlap -I WINDOW* win1 -I WINDOW* win2 -END - -CASE void touchwin -I WINDOW* win -END - -CASE char* unctrl -I char ch -END - -CASE void gettmode -END - -CASE void mvcur -I int lasty -I int lastx -I int newy -I int newx -END - -CASE int scroll -I WINDOW* win -END - -CASE int savetty -END - -CASE void resetty -END - -CASE int setterm -I char* name -END - -CASE void tstp -END - -CASE int _putchar -I char ch -END - - case US_testcallback: - sp = callback("callback", sp + items, curcsv->wantarray, 1, items); - break; - - default: - fatal("Unimplemented user-defined subroutine"); - } - return sp; -} - -static int -userval(ix, str) -int ix; -STR *str; -{ - switch (ix) { - case UV_COLS: - str_numset(str, (double)COLS); - break; - case UV_Def_term: - str_set(str, Def_term); - break; - case UV_ERR: - str_numset(str, (double)ERR); - break; - case UV_LINES: - str_numset(str, (double)LINES); - break; - case UV_My_term: - str_numset(str, (double)My_term); - break; - case UV_OK: - str_numset(str, (double)OK); - break; - case UV_curscr: - str_nset(str, &curscr, sizeof(WINDOW*)); - break; - case UV_stdscr: - str_nset(str, &stdscr, sizeof(WINDOW*)); - break; - case UV_ttytype: - str_set(str, ttytype); - break; - } - return 0; -} - -static int -userset(ix, str) -int ix; -STR *str; -{ - switch (ix) { - case UV_COLS: - COLS = (int)str_gnum(str); - break; - case UV_Def_term: - Def_term = savestr(str_get(str)); /* never freed */ - break; - case UV_LINES: - LINES = (int)str_gnum(str); - break; - case UV_My_term: - My_term = (bool)str_gnum(str); - break; - case UV_ttytype: - strcpy(ttytype, str_get(str)); /* hope it fits */ - break; - } - return 0; -} diff --git a/atarist/usub/makefile.st b/atarist/usub/makefile.st deleted file mode 100644 index ede484f..0000000 --- a/atarist/usub/makefile.st +++ /dev/null @@ -1,17 +0,0 @@ -CC = cgcc -SRC = .. -GLOBINCS = -LOCINCS = -LIBS = -lcurses -lgdbm -lpml -lgnu - -cperl.ttp: $(SRC)/uperl.a usersub.o curses.o - $(CC) $(SRC)/uperl.a usersub.o curses.o $(LIBS) -o cperl.ttp - -usersub.o: usersub.c - $(CC) -c -I$(SRC) $(GLOBINCS) -O usersub.c - -curses.o: curses.c - $(CC) -c -I$(SRC) $(GLOBINCS) -O curses.c - -curses.c: acurses.mus - perl mus acurses.mus >curses.c diff --git a/atarist/usub/usersub.c b/atarist/usub/usersub.c deleted file mode 100644 index 5083db1..0000000 --- a/atarist/usub/usersub.c +++ /dev/null @@ -1,30 +0,0 @@ -/* $RCSfile: usersub.c,v $$Revision: 4.1 $$Date: 92/08/07 17:19:07 $ - * - * $Log: usersub.c,v $ - * Revision 4.1 92/08/07 17:19:07 lwall - * Stage 6 Snapshot - * - * Revision 4.0.1.1 92/06/08 11:54:52 lwall - * Initial revision - * - * Revision 4.0.1.1 91/11/05 19:07:24 lwall - * patch11: there are now subroutines for calling back from C into Perl - * - * Revision 4.0 91/03/20 01:56:34 lwall - * 4.0 baseline. - * - * Revision 3.0.1.1 90/08/09 04:06:10 lwall - * patch19: Initial revision - * - */ - -#include "EXTERN.h" -#include "perl.h" - -int -userinit() -{ - install_null(); /* install device /dev/null or NUL: */ - init_curses(); - return 0; -} diff --git a/atarist/wildmat.c b/atarist/wildmat.c deleted file mode 100644 index 98a3182..0000000 --- a/atarist/wildmat.c +++ /dev/null @@ -1,507 +0,0 @@ -/* $Revision: 4.1 $ -** -** Do shell-style pattern matching for ?, \, [], and * characters. -** Might not be robust in face of malformed patterns; e.g., "foo[a-" -** could cause a segmentation violation. It is 8bit clean. -** -** Written by Rich $alz, mirror!rs, Wed Nov 26 19:03:17 EST 1986. -** Rich $alz is now . -** April, 1991: Replaced mutually-recursive calls with in-line code -** for the star character. -** -** Special thanks to Lars Mathiesen for the ABORT code. -** This can greatly speed up failing wildcard patterns. For example: -** pattern: -*-*-*-*-*-*-12-*-*-*-m-*-*-* -** text 1: -adobe-courier-bold-o-normal--12-120-75-75-m-70-iso8859-1 -** text 2: -adobe-courier-bold-o-normal--12-120-75-75-X-70-iso8859-1 -** Text 1 matches with 51 calls, while text 2 fails with 54 calls. Without -** the ABORT, then it takes 22310 calls to fail. Ugh. The following -** explanation is from Lars: -** The precondition that must be fulfilled is that DoMatch will consume -** at least one character in text. This is true if *p is neither '*' nor -** '\0'.) The last return has ABORT instead of FALSE to avoid quadratic -** behaviour in cases like pattern "*a*b*c*d" with text "abcxxxxx". With -** FALSE, each star-loop has to run to the end of the text; with ABORT -** only the last one does. -** -** Once the control of one instance of DoMatch enters the star-loop, that -** instance will return either TRUE or ABORT, and any calling instance -** will therefore return immediately after (without calling recursively -** again). In effect, only one star-loop is ever active. It would be -** possible to modify the code to maintain this context explicitly, -** eliminating all recursive calls at the cost of some complication and -** loss of clarity (and the ABORT stuff seems to be unclear enough by -** itself). I think it would be unwise to try to get this into a -** released version unless you have a good test data base to try it out -** on. -*/ - -#define TRUE 1 -#define FALSE 0 -#define ABORT -1 - - - /* What character marks an inverted character class? */ -#define NEGATE_CLASS '^' - /* Is "*" a common pattern? */ -#define OPTIMIZE_JUST_STAR - /* Do tar(1) matching rules, which ignore a trailing slash? */ -#undef MATCH_TAR_PATTERN - - -/* -** Match text and p, return TRUE, FALSE, or ABORT. -*/ -static int -DoMatch(text, p) - char *text; - char *p; -{ - int last; - int matched; - int reverse; - - for ( ; *p; text++, p++) { - if (*text == '\0' && *p != '*') - return ABORT; - switch (*p) { - case '\\': - /* Literal match with following character. */ - p++; - /* FALLTHROUGH */ - default: - if (*text != *p) - return FALSE; - continue; - case '?': - /* Match anything. */ - continue; - case '*': - while (*++p == '*') - /* Consecutive stars act just like one. */ - continue; - if (*p == '\0') - /* Trailing star matches everything. */ - return TRUE; - while (*text) - if ((matched = DoMatch(text++, p)) != FALSE) - return matched; - return ABORT; - case '[': - reverse = p[1] == NEGATE_CLASS ? TRUE : FALSE; - if (reverse) - /* Inverted character class. */ - p++; - for (last = 0400, matched = FALSE; *++p && *p != ']'; last = *p) - /* This next line requires a good C compiler. */ - if (*p == '-' ? *text <= *++p && *text >= last : *text == *p) - matched = TRUE; - if (matched == reverse) - return FALSE; - continue; - } - } - -#ifdef MATCH_TAR_PATTERN - if (*text == '/') - return TRUE; -#endif /* MATCH_TAR_ATTERN */ - return *text == '\0'; -} - - -/* -** User-level routine. Returns TRUE or FALSE. -*/ -int -wildmat(text, p) - char *text; - char *p; -{ -#ifdef OPTIMIZE_JUST_STAR - if (p[0] == '*' && p[1] == '\0') - return TRUE; -#endif /* OPTIMIZE_JUST_STAR */ - return DoMatch(text, p) == TRUE; -} - -#include -#include -#include -#include -#if __STDC__ -#ifdef unix -#define _SIZE_T /* unix defines size_t in sys/types.h */ -#endif -#ifndef _COMPILER_H -# include -#endif -#include -#include -#else -extern char *malloc(), *realloc(); -extern char *rindex(), *strdup(); -#define __PROTO(x) () -#endif -#include - -#define MAX_DIR 32 /* max depth of dir recursion */ -static struct { - char *dir, *patt; -} dir_stack[MAX_DIR]; -static int stack_p; -static char **matches; -static int nmatches; - -static void *ck_memalloc __PROTO((void *)); -#define ck_strdup(p) ck_memalloc(strdup(p)) -#define ck_malloc(s) ck_memalloc(malloc(s)) -#define ck_realloc(p, s) ck_memalloc(realloc(p, s)) - - -#define DEBUGX(x) - -/* - * return true if patt contains a wildcard char - */ -int contains_wild(patt) -char *patt; -{ - char c; - char *p; - - /* only check for wilds in the basename part of the pathname only */ - if((p = rindex(patt, '/')) == NULL) - p = rindex(patt, '\\'); - if(!p) - p = patt; - - while((c = *p++)) - if((c == '*') || (c == '?') || (c == '[')) - return 1; - return 0; -} - -#ifndef ZOO -void free_all() -{ - char **p; - - if(!matches) - return; - - for(p = matches; *p; p++) - free(*p); - free(matches); - matches = NULL; -} -#endif - -static void push(dir, patt) -char *dir; -char *patt; -{ - if(stack_p < (MAX_DIR - 2)) - stack_p++; - else - { - fprintf(stderr,"directory stack overflow\n"); - exit(99); - } - dir_stack[stack_p].dir = dir; - dir_stack[stack_p].patt = patt; -} - -/* - * glob patt - * if decend_dir is true, recursively decend any directories encountered. - * returns pointer to all matches encountered. - * if the initial patt is a directory, and decend_dir is true, it is - * equivalent to specifying the pattern "patt\*" - * - * Restrictions: - * - handles wildcards only in the base part of a pathname - * ie: will not handle \foo\*\bar\ (wildcard in the middle of pathname) - * - * - max dir recursion is MAX_DIR - * - * - on certain failures it will just skip potential matches as if they - * were not present. - * - * ++jrb bammi@cadence.com - */ -static char **do_match __PROTO((int decend_dir)); - -char **glob(patt, decend_dir) -char *patt; -int decend_dir; -{ - char *dir, *basepatt, *p; - struct stat s; - - DEBUGX((fprintf(stderr,"glob(%s, %d)\n", patt, decend_dir))); - matches = NULL; - nmatches = 0; - stack_p = -1; - - /* first check for wildcards */ - if(contains_wild(patt)) - { - /* break it up into dir and base patt, do_matches and return */ - p = ck_strdup(patt); - if((basepatt = rindex(p, '/')) == NULL) - basepatt = rindex(p, '\\'); - if(basepatt) - { - dir = p; - *basepatt++ = '\0'; - basepatt = ck_strdup(basepatt); - } - else - { - dir = ck_strdup("."); - basepatt = p; - } - - if(strcmp(basepatt, "*.*") == 0) - { - /* the desktop, and other braindead shells strike again */ - basepatt[1] = '\0'; - } - push(dir, basepatt); - DEBUGX((fprintf(stderr, "calling %s, %s\n", dir, basepatt))); - return do_match(decend_dir); - } - - /* if no wilds, check for dir */ - if(decend_dir && (!stat(patt, &s))) - { - if((s.st_mode & S_IFMT) == S_IFDIR) - { /* is a dir */ - size_t len = strlen(patt); - - dir = ck_strdup(patt); - --len; - if(len && ((dir[len] == '/') -#ifdef atarist - || (dir[len] == '\\') -#endif - )) - dir[len] = '\0'; - basepatt = ck_strdup("*"); - push(dir, basepatt); - DEBUGX((fprintf(stderr, "calling %s, %s\n", dir, basepatt))); - return do_match(decend_dir); - } - } - return NULL; -} - -static char **do_match(decend_dir) -int decend_dir; -{ - DIR *dirp; - struct dirent *d; - struct stat s; - char *dir, *basepatt; - - while(stack_p >= 0) - { - dir = ck_strdup(dir_stack[stack_p].dir); - free(dir_stack[stack_p].dir); - basepatt = ck_strdup(dir_stack[stack_p].patt); - free(dir_stack[stack_p--].patt); - - DEBUGX((fprintf(stderr,"dir %s patt %s stack %d\n", dir, basepatt, stack_p))); - - dirp = opendir(dir); - if(!dirp) - { - free(dir); - DEBUGX((fprintf(stderr,"no dir\n"))); - continue; - } - - while((d = readdir(dirp))) - { - char *p = ck_malloc(strlen(dir) + strlen(d->d_name) + 2L); - if(strcmp(dir, ".")) - /* If we have a full pathname then */ - { /* let's append the directory info */ - strcpy(p, dir); -#ifndef unix - strcat(p, "\\"); -#else - strcat(p, "/"); -#endif - strcat(p, d->d_name); - } - else /* Otherwise, the name is just fine, */ - strcpy(p, d->d_name); /* there's no need for './' -- bjsjr */ - - DEBUGX((fprintf(stderr, "Testing %s\n", p))); - if(!stat(p, &s)) /* if stat fails, ignore it */ - { - if( ((s.st_mode & S_IFMT) == S_IFREG) || - ((s.st_mode & S_IFMT) == S_IFLNK) ) - { /* it is a file/symbolic link */ - if(wildmat(d->d_name, basepatt)) - { /* it matches pattern */ - DEBUGX((fprintf(stderr,"File Matched\n"))); - if(matches == NULL) - matches = (char **)ck_malloc(sizeof(char *)); - else - matches = (char **) - ck_realloc(matches, (nmatches+1)*sizeof(char *)); - matches[nmatches++] = p; - } /* no match */ - else - { - DEBUGX((fprintf(stderr,"No File Match\n"))); - free(p); - } - } else if(decend_dir && ((s.st_mode & S_IFMT) == S_IFDIR)) - { - if(!((!strcmp(d->d_name,".")) || (!strcmp(d->d_name, "..") -#ifdef atarist - || (!strcmp(d->d_name, ".dir")) -#endif - ))) - { - char *push_p = ck_strdup("*"); - push(p, push_p); - DEBUGX((fprintf(stderr,"Dir pushed\n"))); - } - else - { - DEBUGX((fprintf(stderr, "DIR skipped\n"))); - free(p); - } - } - else - { - DEBUGX((fprintf(stderr, "Not a dir/no decend\n"))); - free(p); - } - } /* stat */ - else - { - DEBUGX((fprintf(stderr, "Stat failed\n"))); - free(p); - } - } /* while readdir */ - closedir(dirp); - free(basepatt); - free(dir); - DEBUGX((fprintf(stderr, "Dir done\n\n"))); - } /* while dirs in stack */ - - if(!nmatches) - { - DEBUGX((fprintf(stderr, "No matches\n"))); - return NULL; - } - - matches = (char **)realloc(matches, (nmatches+1)*sizeof(char *)); - if(!matches) - { return NULL; } - matches[nmatches] = NULL; - DEBUGX((fprintf(stderr, "%d matches\n", nmatches))); - return matches; -} - -#ifdef ZOO -#include "errors.i" -#endif - -static void *ck_memalloc(p) -void *p; -{ - if(!p) - { -#ifndef ZOO - fprintf(stderr, "Out of memory\n"); - exit(98); -#else - prterror('f', no_memory); -#endif - } - return p; -} - -#ifdef TEST_GLOB -void test(path, dec) -char *path; -int dec; -{ - char **m; - char **matches; - - printf("Testing %s %d\n", path, dec); - matches = glob(path, dec); - if(!matches) - { - printf("No matches\n"); - } - else - { - for(m = matches; *m; m++) - printf("%s\n", *m); - putchar('\n'); - free_all(); - } -} - -int main() -{ -#ifndef unix - test("e:\\lib\\*.olb", 0); - test("e:\\lib", 0); - test("e:\\lib\\", 1); -#else - test("/net/acae127/home/bammi/News/comp.sources.misc/*.c", 0); - test("/net/acae127/home/bammi/News/comp.sources.misc", 0); - test("/net/acae127/home/bammi/News/comp.sources.misc", 1); - test("/net/acae127/home/bammi/atari/cross-gcc", 1); -#endif - - return 0; -} - -#endif - -#ifdef TEST_WILDMAT -#include - -/* Yes, we use gets not fgets. Sue me. */ -extern char *gets(); - - -main() -{ - char pattern[80]; - char text[80]; - - printf("Wildmat tester. Enter pattern, then strings to test.\n"); - printf("A blank line gets prompts for a new pattern; a blank pattern\n"); - printf("exits the program.\n\n"); - - for ( ; ; ) { - printf("Enter pattern: "); - if (gets(pattern) == NULL) - break; - for ( ; ; ) { - printf("Enter text: "); - if (gets(text) == NULL) - exit(0); - if (text[0] == '\0') - /* Blank line; go back and get a new pattern. */ - break; - printf(" %s\n", wildmat(text, pattern) ? "YES" : "NO"); - } - } - - exit(0); - /* NOTREACHED */ -} -#endif /* TEST_WILDMAT */ diff --git a/autosplit b/autosplit index a57b6fe..7d8e1d2 100755 --- a/autosplit +++ b/autosplit @@ -1,29 +1,4 @@ #!./miniperl - -chdir "lib" if -d "lib"; - -$package = shift; - -$filename = "$package.pm"; -open(IN, $filename) || die "Can't open $filename: $!\n"; -while () { - last if /^__END__/; -} -$_ or die "Can't find __END__ in $filename\n"; - -mkdir "auto/$package", 0777 unless -d "auto/$package"; -while () { - if (/^sub ([\w:]+)/) { - $name = $1; - print OUT "1;\n"; - $newname = "auto/$package/$name.al"; - open(OUT, ">$newname") or warn "Can't create $newname: $!\n"; - print OUT <<"END"; -# NOTE: Derived from $package.pm. Changes made here will be lost. -package $package; - -END - } - print OUT $_; -} -print OUT "1;\n"; +BEGIN { unshift @INC, "lib" } +use AutoSplit; +autosplit_lib_modules(@ARGV); diff --git a/av.c b/av.c index 58489fd..058e154 100644 --- a/av.c +++ b/av.c @@ -1,32 +1,98 @@ -/* $RCSfile: array.c,v $$Revision: 4.1 $$Date: 92/08/07 17:18:22 $ +/* av.c * - * Copyright (c) 1991, Larry Wall + * Copyright (c) 1991-1994, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. * - * $Log: array.c,v $ - * Revision 4.1 92/08/07 17:18:22 lwall - * Stage 6 Snapshot - * - * Revision 4.0.1.3 92/06/08 11:45:05 lwall - * patch20: Perl now distinguishes overlapped copies from non-overlapped - * - * Revision 4.0.1.2 91/11/05 16:00:14 lwall - * patch11: random cleanup - * patch11: passing non-existend array elements to subrouting caused core dump - * - * Revision 4.0.1.1 91/06/07 10:19:08 lwall - * patch4: new copyright notice - * - * Revision 4.0 91/03/20 01:03:32 lwall - * 4.0 baseline. - * + */ + +/* + * "...for the Entwives desired order, and plenty, and peace (by which they + * meant that things should remain where they had set them)." --Treebeard */ #include "EXTERN.h" #include "perl.h" +static void av_reify _((AV* av)); + +static void +av_reify(av) +AV* av; +{ + I32 key; + SV* sv; + + key = AvMAX(av) + 1; + while (key > AvFILL(av) + 1) + AvARRAY(av)[--key] = &sv_undef; + while (key) { + sv = AvARRAY(av)[--key]; + assert(sv); + if (sv != &sv_undef) + (void)SvREFCNT_inc(sv); + } + AvREAL_on(av); +} + +void +av_extend(av,key) +AV *av; +I32 key; +{ + if (key > AvMAX(av)) { + SV** ary; + I32 tmp; + I32 newmax; + + if (AvALLOC(av) != AvARRAY(av)) { + ary = AvALLOC(av) + AvFILL(av) + 1; + tmp = AvARRAY(av) - AvALLOC(av); + Move(AvARRAY(av), AvALLOC(av), AvFILL(av)+1, SV*); + AvMAX(av) += tmp; + SvPVX(av) = (char*)AvALLOC(av); + if (AvREAL(av)) { + while (tmp) + ary[--tmp] = &sv_undef; + } + + if (key > AvMAX(av) - 10) { + newmax = key + AvMAX(av); + goto resize; + } + } + else { + if (AvALLOC(av)) { + newmax = key + AvMAX(av) / 5; + resize: + Renew(AvALLOC(av),newmax+1, SV*); + ary = AvALLOC(av) + AvMAX(av) + 1; + tmp = newmax - AvMAX(av); + if (av == stack) { /* Oops, grew stack (via av_store()?) */ + stack_sp = AvALLOC(av) + (stack_sp - stack_base); + stack_base = AvALLOC(av); + stack_max = stack_base + newmax; + } + } + else { + newmax = key < 4 ? 4 : key; + New(2,AvALLOC(av), newmax+1, SV*); + ary = AvALLOC(av) + 1; + tmp = newmax; + AvALLOC(av)[0] = &sv_undef; /* For the stacks */ + } + if (AvREAL(av)) { + while (tmp) + ary[--tmp] = &sv_undef; + } + + SvPVX(av) = (char*)AvALLOC(av); + AvMAX(av) = newmax; + } + } +} + SV** av_fetch(av,key,lval) register AV *av; @@ -35,38 +101,33 @@ I32 lval; { SV *sv; + if (!av) + return 0; + if (SvRMAGICAL(av)) { if (mg_find((SV*)av,'P')) { - if (key < 0) - return 0; sv = sv_newmortal(); mg_copy((SV*)av, sv, 0, key); - if (!lval) { - mg_get((SV*)sv); - sv_unmagic(sv,'p'); - } Sv = sv; return &Sv; } } - if (key < 0 || key > AvFILL(av)) { - if (key < 0) { - key += AvFILL(av) + 1; - if (key < 0) - return 0; - } - else { - if (!lval) - return 0; - if (AvREAL(av)) - sv = NEWSV(5,0); - else - sv = sv_newmortal(); - return av_store(av,key,sv); - } + if (key < 0) { + key += AvFILL(av) + 1; + if (key < 0) + return 0; + } + else if (key > AvFILL(av)) { + if (!lval) + return 0; + if (AvREALISH(av)) + sv = NEWSV(5,0); + else + sv = sv_newmortal(); + return av_store(av,key,sv); } - if (!AvARRAY(av)[key]) { + if (AvARRAY(av)[key] == &sv_undef) { if (lval) { sv = NEWSV(6,0); return av_store(av,key,sv); @@ -82,14 +143,10 @@ register AV *av; I32 key; SV *val; { - I32 tmp; SV** ary; - if (key < 0) { - key += AvFILL(av) + 1; - if (key < 0) - return 0; - } + if (!av) + return 0; if (SvRMAGICAL(av)) { if (mg_find((SV*)av,'P')) { @@ -98,52 +155,38 @@ SV *val; } } - if (key > AvMAX(av)) { - I32 newmax; - - if (AvALLOC(av) != AvARRAY(av)) { - tmp = AvARRAY(av) - AvALLOC(av); - Move(AvARRAY(av), AvALLOC(av), AvMAX(av)+1, SV*); - Zero(AvALLOC(av)+AvMAX(av)+1, tmp, SV*); - AvMAX(av) += tmp; - SvPVX(av) = (char*)(AvARRAY(av) - tmp); - if (key > AvMAX(av) - 10) { - newmax = key + AvMAX(av); - goto resize; - } - } - else { - if (AvALLOC(av)) { - newmax = key + AvMAX(av) / 5; - resize: - Renew(AvALLOC(av),newmax+1, SV*); - Zero(&AvALLOC(av)[AvMAX(av)+1], newmax - AvMAX(av), SV*); - } - else { - newmax = key < 4 ? 4 : key; - Newz(2,AvALLOC(av), newmax+1, SV*); - } - SvPVX(av) = (char*)AvALLOC(av); - AvMAX(av) = newmax; - } + if (key < 0) { + key += AvFILL(av) + 1; + if (key < 0) + return 0; } + if (!val) + val = &sv_undef; + + if (key > AvMAX(av)) + av_extend(av,key); + if (AvREIFY(av)) + av_reify(av); + ary = AvARRAY(av); - if (AvREAL(av)) { - if (AvFILL(av) < key) { - while (++AvFILL(av) < key) { - if (ary[AvFILL(av)] != Nullsv) { - SvREFCNT_dec(ary[AvFILL(av)]); - ary[AvFILL(av)] = Nullsv; - } - } + if (AvFILL(av) < key) { + if (!AvREAL(av)) { + if (av == stack && key > stack_sp - stack_base) + stack_sp = stack_base + key; /* XPUSH in disguise */ + do + ary[++AvFILL(av)] = &sv_undef; + while (AvFILL(av) < key); } - if (ary[key]) - SvREFCNT_dec(ary[key]); + AvFILL(av) = key; } + else if (AvREAL(av)) + SvREFCNT_dec(ary[key]); ary[key] = val; if (SvSMAGICAL(av)) { - MAGIC* mg = SvMAGIC(av); - sv_magic(val, (SV*)av, tolower(mg->mg_type), 0, key); + if (val != &sv_undef) { + MAGIC* mg = SvMAGIC(av); + sv_magic(val, (SV*)av, toLOWER(mg->mg_type), 0, key); + } mg_set((SV*)av); } return &ary[key]; @@ -154,9 +197,8 @@ newAV() { register AV *av; - Newz(1,av,1,AV); - SvREFCNT(av) = 1; - sv_upgrade(av,SVt_PVAV); + av = (AV*)NEWSV(3,0); + sv_upgrade((SV *)av, SVt_PVAV); AvREAL_on(av); AvALLOC(av) = 0; SvPVX(av) = 0; @@ -173,23 +215,20 @@ register SV **strp; register I32 i; register SV** ary; - Newz(3,av,1,AV); - sv_upgrade(av,SVt_PVAV); + av = (AV*)NEWSV(8,0); + sv_upgrade((SV *) av,SVt_PVAV); New(4,ary,size+1,SV*); AvALLOC(av) = ary; - Zero(ary,size,SV*); - AvREAL_on(av); + AvFLAGS(av) = AVf_REAL; SvPVX(av) = (char*)ary; AvFILL(av) = size - 1; AvMAX(av) = size - 1; for (i = 0; i < size; i++) { - if (*strp) { - ary[i] = NEWSV(7,0); - sv_setsv(ary[i], *strp); - } + assert (*strp); + ary[i] = NEWSV(7,0); + sv_setsv(ary[i], *strp); strp++; } - SvOK_on(av); return av; } @@ -201,22 +240,20 @@ register SV **strp; register AV *av; register SV** ary; - Newz(3,av,1,AV); - SvREFCNT(av) = 1; - sv_upgrade(av,SVt_PVAV); + av = (AV*)NEWSV(9,0); + sv_upgrade((SV *)av, SVt_PVAV); New(4,ary,size+1,SV*); AvALLOC(av) = ary; Copy(strp,ary,size,SV*); - AvREAL_off(av); + AvFLAGS(av) = AVf_REIFY; SvPVX(av) = (char*)ary; AvFILL(av) = size - 1; AvMAX(av) = size - 1; while (size--) { - if (*strp) - SvTEMP_off(*strp); + assert (*strp); + SvTEMP_off(*strp); strp++; } - SvOK_on(av); return av; } @@ -225,18 +262,25 @@ av_clear(av) register AV *av; { register I32 key; + SV** ary; - if (!av || !AvREAL(av) || AvMAX(av) < 0) + if (!av || AvMAX(av) < 0) return; /*SUPPRESS 560*/ + + if (AvREAL(av)) { + ary = AvARRAY(av); + key = AvFILL(av) + 1; + while (key) { + SvREFCNT_dec(ary[--key]); + ary[key] = &sv_undef; + } + } if (key = AvARRAY(av) - AvALLOC(av)) { AvMAX(av) += key; - SvPVX(av) = (char*)(AvARRAY(av) - key); + SvPVX(av) = (char*)AvALLOC(av); } - for (key = 0; key <= AvMAX(av); key++) - SvREFCNT_dec(AvARRAY(av)[key]); AvFILL(av) = -1; - Zero(AvARRAY(av), AvMAX(av)+1, SV*); } void @@ -248,13 +292,14 @@ register AV *av; if (!av) return; /*SUPPRESS 560*/ + if (AvREAL(av)) { + key = AvFILL(av) + 1; + while (key) + SvREFCNT_dec(AvARRAY(av)[--key]); + } if (key = AvARRAY(av) - AvALLOC(av)) { AvMAX(av) += key; - SvPVX(av) = (char*)(AvARRAY(av) - key); - } - if (AvREAL(av)) { - for (key = 0; key <= AvMAX(av); key++) - SvREFCNT_dec(AvARRAY(av)[key]); + SvPVX(av) = (char*)AvALLOC(av); } Safefree(AvALLOC(av)); AvALLOC(av) = 0; @@ -262,12 +307,14 @@ register AV *av; AvMAX(av) = AvFILL(av) = -1; } -bool +void av_push(av,val) register AV *av; SV *val; { - return av_store(av,++(AvFILL(av)),val) != 0; + if (!av) + return; + av_store(av,AvFILL(av)+1,val); } SV * @@ -276,27 +323,16 @@ register AV *av; { SV *retval; - if (AvFILL(av) < 0) - return Nullsv; + if (!av || AvFILL(av) < 0) + return &sv_undef; retval = AvARRAY(av)[AvFILL(av)]; - AvARRAY(av)[AvFILL(av)--] = Nullsv; + AvARRAY(av)[AvFILL(av)--] = &sv_undef; if (SvSMAGICAL(av)) mg_set((SV*)av); return retval; } void -av_popnulls(av) -register AV *av; -{ - register I32 fill = AvFILL(av); - - while (fill >= 0 && !AvARRAY(av)[fill]) - fill--; - AvFILL(av) = fill; -} - -void av_unshift(av,num) register AV *av; register I32 num; @@ -304,30 +340,40 @@ register I32 num; register I32 i; register SV **sstr,**dstr; - if (num <= 0) + if (!av || num <= 0) return; - if (AvARRAY(av) - AvALLOC(av) >= num) { - AvMAX(av) += num; - AvFILL(av) += num; - while (num--) { - SvPVX(av) = (char*)(AvARRAY(av) - 1); - *AvARRAY(av) = Nullsv; - } + if (!AvREAL(av)) { + if (AvREIFY(av)) + av_reify(av); + else + croak("Can't unshift"); } - else { - (void)av_store(av,AvFILL(av)+num,(SV*)0); /* maybe extend array */ + i = AvARRAY(av) - AvALLOC(av); + if (i) { + if (i > num) + i = num; + num -= i; + + AvMAX(av) += i; + AvFILL(av) += i; + SvPVX(av) = (char*)(AvARRAY(av) - i); + } + if (num) { + av_extend(av,AvFILL(av)+num); + AvFILL(av) += num; dstr = AvARRAY(av) + AvFILL(av); sstr = dstr - num; #ifdef BUGGY_MSC5 # pragma loop_opt(off) /* don't loop-optimize the following code */ #endif /* BUGGY_MSC5 */ - for (i = AvFILL(av) - num; i >= 0; i--) { + for (i = AvFILL(av) - num; i >= 0; --i) { *dstr-- = *sstr--; #ifdef BUGGY_MSC5 # pragma loop_opt() /* loop-optimization back to command-line setting */ #endif /* BUGGY_MSC5 */ } - Zero(AvARRAY(av), num, SV*); + while (num) + AvARRAY(av)[--num] = &sv_undef; } } @@ -337,10 +383,11 @@ register AV *av; { SV *retval; - if (AvFILL(av) < 0) - return Nullsv; + if (!av || AvFILL(av) < 0) + return &sv_undef; retval = *AvARRAY(av); - *AvARRAY(av) = Nullsv; + if (AvREAL(av)) + *AvARRAY(av) = &sv_undef; SvPVX(av) = (char*)(AvARRAY(av) + 1); AvMAX(av)--; AvFILL(av)--; @@ -361,15 +408,29 @@ av_fill(av, fill) register AV *av; I32 fill; { + if (!av) + croak("panic: null array"); if (fill < 0) fill = -1; if (fill <= AvMAX(av)) { + I32 key = AvFILL(av); + SV** ary = AvARRAY(av); + + if (AvREAL(av)) { + while (key > fill) { + SvREFCNT_dec(ary[key]); + ary[key--] = &sv_undef; + } + } + else { + while (key < fill) + ary[++key] = &sv_undef; + } + AvFILL(av) = fill; if (SvSMAGICAL(av)) mg_set((SV*)av); } - else { - AvFILL(av) = fill - 1; /* don't clobber in-between values */ - (void)av_store(av,fill,Nullsv); - } + else + (void)av_store(av,fill,&sv_undef); } diff --git a/av.h b/av.h index 42f5c85..082a8ab 100644 --- a/av.h +++ b/av.h @@ -1,30 +1,17 @@ -/* $RCSfile: array.h,v $$Revision: 4.1 $$Date: 92/08/07 17:18:24 $ +/* av.h * - * Copyright (c) 1991, Larry Wall + * Copyright (c) 1991-1994, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. * - * $Log: array.h,v $ - * Revision 4.1 92/08/07 17:18:24 lwall - * Stage 6 Snapshot - * - * Revision 4.0.1.2 92/06/08 11:45:57 lwall - * patch20: removed implicit int declarations on funcions - * - * Revision 4.0.1.1 91/06/07 10:19:20 lwall - * patch4: new copyright notice - * - * Revision 4.0 91/03/20 01:03:44 lwall - * 4.0 baseline. - * */ struct xpvav { - char * xav_array; /* pointer to malloced string */ - int xav_fill; - int xav_max; - int xof_off; /* ptr is incremented by offset */ + char* xav_array; /* pointer to malloced string */ + SSize_t xav_fill; + SSize_t xav_max; + IV xof_off; /* ptr is incremented by offset */ double xnv_nv; /* numeric value, if any */ MAGIC* xmg_magic; /* magic for scalar array */ HV* xmg_stash; /* class package */ @@ -35,6 +22,7 @@ struct xpvav { }; #define AVf_REAL 1 /* free old entries */ +#define AVf_REIFY 2 /* can become real */ #define Nullav Null(AV*) @@ -45,6 +33,12 @@ struct xpvav { #define AvARYLEN(av) ((XPVAV*) SvANY(av))->xav_arylen #define AvFLAGS(av) ((XPVAV*) SvANY(av))->xav_flags -#define AvREAL(av) (((XPVAV*) SvANY(av))->xav_flags & AVf_REAL) -#define AvREAL_on(av) (((XPVAV*) SvANY(av))->xav_flags |= AVf_REAL) -#define AvREAL_off(av) (((XPVAV*) SvANY(av))->xav_flags &= ~AVf_REAL) +#define AvREAL(av) (AvFLAGS(av) & AVf_REAL) +#define AvREAL_on(av) (AvFLAGS(av) |= AVf_REAL) +#define AvREAL_off(av) (AvFLAGS(av) &= ~AVf_REAL) +#define AvREIFY(av) (AvFLAGS(av) & AVf_REIFY) +#define AvREIFY_on(av) (AvFLAGS(av) |= AVf_REIFY) +#define AvREIFY_off(av) (AvFLAGS(av) &= ~AVf_REIFY) + +#define AvREALISH(av) AvFLAGS(av) /* REAL or REIFY -- shortcut */ + diff --git a/bar b/bar deleted file mode 100755 index 8c82917..0000000 --- a/bar +++ /dev/null @@ -1,35 +0,0 @@ -#!./perl - -BEGIN {require POSIX; import POSIX; } - - -print POSIX::pipe(), "\n"; - -$sigset = new POSIX::SigSet 1,3; -delset $sigset 1; -if (ismember $sigset 1) { print "BAD\n" } -if (ismember $sigset 3) { print "GOOD\n" } -$mask = new POSIX::SigSet &SIGINT; -$action = new POSIX::SigAction 'main::SigHUP', $mask, 0; -sigaction(&SIGHUP, $action); -kill HUP, $$; -print "DONE\n"; - -sub SigHUP { - print "SigHUP1\n"; - sleep 10; - print "SigHUP2\n"; -} - -__END__ -print &_POSIX_OPEN_MAX, "\n"; - -$x = setlocale(&LC_NUMERIC, "En_TRY"); -print $x,"\n"; -$! = 12; - -print +POSIX::errno(), "\n"; -print 123.45,"\n"; -__END__ -$lconv = localeconv(); -print %$lconv, "\n"; diff --git a/bench/fib b/bench/fib deleted file mode 100755 index 022d9d0..0000000 --- a/bench/fib +++ /dev/null @@ -1,20 +0,0 @@ -#!./perl - -sub fib -{ - ($_[0] < 2) ? $_[0] : &fib($_[0]-1) + &fib($_[0]-2); -} - -sub myruntime -{ - local(@t) = times; # in seconds - $t[0] + $t[1]; -} - -$x = (shift || 20); -print "Starting fib($x)\n"; -$before = &myruntime; -$y = &fib($x); -$after = &myruntime; -printf("Done. Result $y in %g cpu seconds.\n", $after-$before); - diff --git a/byacc b/byacc deleted file mode 120000 index 14034ef..0000000 --- a/byacc +++ /dev/null @@ -1 +0,0 @@ -../perl-byacc1.8.2/byacc \ No newline at end of file diff --git a/c2ph b/c2ph deleted file mode 100644 index 373c689..0000000 --- a/c2ph +++ /dev/null @@ -1,1071 +0,0 @@ -#!/usr/local/bin/perl -# -# -# c2ph (aka pstruct) -# Tom Christiansen, -# -# As pstruct, dump C structures as generated from 'cc -g -S' stabs. -# As c2ph, do this PLUS generate perl code for getting at the structures. -# -# See the usage message for more. If this isn't enough, read the code. -# - -$RCSID = '$RCSfile: c2ph.SH,v $$Revision: 4.1 $$Date: 92/08/07 17:19:10 $'; - - -###################################################################### - -# some handy data definitions. many of these can be reset later. - -$bitorder = 'b'; # ascending; set to B for descending bit fields - -%intrinsics = -%template = ( - 'char', 'c', - 'unsigned char', 'C', - 'short', 's', - 'short int', 's', - 'unsigned short', 'S', - 'unsigned short int', 'S', - 'short unsigned int', 'S', - 'int', 'i', - 'unsigned int', 'I', - 'long', 'l', - 'long int', 'l', - 'unsigned long', 'L', - 'unsigned long', 'L', - 'long unsigned int', 'L', - 'unsigned long int', 'L', - 'long long', 'q', - 'long long int', 'q', - 'unsigned long long', 'Q', - 'unsigned long long int', 'Q', - 'float', 'f', - 'double', 'd', - 'pointer', 'p', - 'null', 'x', - 'neganull', 'X', - 'bit', $bitorder, -); - -&buildscrunchlist; -delete $intrinsics{'neganull'}; -delete $intrinsics{'bit'}; -delete $intrinsics{'null'}; - -# use -s to recompute sizes -%sizeof = ( - 'char', '1', - 'unsigned char', '1', - 'short', '2', - 'short int', '2', - 'unsigned short', '2', - 'unsigned short int', '2', - 'short unsigned int', '2', - 'int', '4', - 'unsigned int', '4', - 'long', '4', - 'long int', '4', - 'unsigned long', '4', - 'unsigned long int', '4', - 'long unsigned int', '4', - 'long long', '8', - 'long long int', '8', - 'unsigned long long', '8', - 'unsigned long long int', '8', - 'float', '4', - 'double', '8', - 'pointer', '4', -); - -($type_width, $member_width, $offset_width, $size_width) = (20, 20, 6, 5); - -($offset_fmt, $size_fmt) = ('d', 'd'); - -$indent = 2; - -$CC = 'cc'; -$CFLAGS = '-g -S'; -$DEFINES = ''; - -$perl++ if $0 =~ m#/?c2ph$#; - -require 'getopts.pl'; - -eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_]+=)(.*)/ && shift; - -&Getopts('aixdpvtnws:') || &usage(0); - -$opt_d && $debug++; -$opt_t && $trace++; -$opt_p && $perl++; -$opt_v && $verbose++; -$opt_n && ($perl = 0); - -if ($opt_w) { - ($type_width, $member_width, $offset_width) = (45, 35, 8); -} -if ($opt_x) { - ($offset_fmt, $offset_width, $size_fmt, $size_width) = ( 'x', '08', 'x', 04 ); -} - -eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_]+=)(.*)/ && shift; - -sub PLUMBER { - select(STDERR); - print "oops, apperent pager foulup\n"; - $isatty++; - &usage(1); -} - -sub usage { - local($oops) = @_; - unless (-t STDOUT) { - select(STDERR); - } elsif (!$oops) { - $isatty++; - $| = 1; - print "hit for further explanation: "; - ; - open (PIPE, "|". ($ENV{PAGER} || 'more')); - $SIG{PIPE} = PLUMBER; - select(PIPE); - } - - print "usage: $0 [-dpnP] [var=val] [files ...]\n"; - - exit unless $isatty; - - print < 1) { - warn "Only one *.s file allowed!\n"; - &usage; - } - } - elsif (@ARGV == 1 && $ARGV[0] =~ /\.c$/) { - local($dir, $file) = $ARGV[0] =~ m#(.*/)?(.*)$#; - $chdir = "cd $dir; " if $dir; - &system("$chdir$CC $CFLAGS $DEFINES $file") && exit 1; - $ARGV[0] =~ s/\.c$/.s/; - } - else { - $TMP = "/tmp/c2ph.$$.c"; - &system("cat @ARGV > $TMP") && exit 1; - &system("cd /tmp; $CC $CFLAGS $DEFINES $TMP") && exit 1; - unlink $TMP; - $TMP =~ s/\.c$/.s/; - @ARGV = ($TMP); - } -} - -if ($opt_s) { - for (split(/[\s,]+/, $opt_s)) { - $interested{$_}++; - } -} - - -$| = 1 if $debug; - -main: { - - if ($trace) { - if (-t && !@ARGV) { - print STDERR "reading from your keyboard: "; - } else { - print STDERR "reading from " . (@ARGV ? "@ARGV" : "").": "; - } - } - -STAB: while (<>) { - if ($trace && !($. % 10)) { - $lineno = $..''; - print STDERR $lineno, "\b" x length($lineno); - } - next unless /^\s*\.stabs\s+/; - $line = $_; - s/^\s*\.stabs\s+//; - &stab; - } - print STDERR "$.\n" if $trace; - unlink $TMP if $TMP; - - &compute_intrinsics if $perl && !$opt_i; - - print STDERR "resolving types\n" if $trace; - - &resolve_types; - &adjust_start_addrs; - - $sum = 2 + $type_width + $member_width; - $pmask1 = "%-${type_width}s %-${member_width}s"; - $pmask2 = "%-${sum}s %${offset_width}${offset_fmt}%s %${size_width}${size_fmt}%s"; - - if ($perl) { - # resolve template -- should be in stab define order, but even this isn't enough. - print STDERR "\nbuilding type templates: " if $trace; - for $i (reverse 0..$#type) { - next unless defined($name = $type[$i]); - next unless defined $struct{$name}; - $build_recursed = 0; - &build_template($name) unless defined $template{&psou($name)} || - $opt_s && !$interested{$name}; - } - print STDERR "\n\n" if $trace; - } - - print STDERR "dumping structs: " if $trace; - - - foreach $name (sort keys %struct) { - next if $opt_s && !$interested{$name}; - print STDERR "$name " if $trace; - - undef @sizeof; - undef @typedef; - undef @offsetof; - undef @indices; - undef @typeof; - - $mname = &munge($name); - - $fname = &psou($name); - - print "# " if $perl && $verbose; - $pcode = ''; - print "$fname {\n" if !$perl || $verbose; - $template{$fname} = &scrunch($template{$fname}) if $perl; - &pstruct($name,$name,0); - print "# " if $perl && $verbose; - print "}\n" if !$perl || $verbose; - print "\n" if $perl && $verbose; - - if ($perl) { - print "$pcode"; - - printf("\nsub %-32s { %4d; }\n\n", "${mname}'struct", $countof{$name}); - - print < $sizeof{$b}; } - - - foreach $name (sort keys %intrinsics) { - print '$',&munge($name),"'typedef = '", $template{$name}, "';\n"; - } - - print "\n1;\n"; - - exit; -} - -######################################################################################## - - -sub stab { - next unless /:[\$\w]+(\(\d+,\d+\))?=[\*\$\w]+/; # (\d+,\d+) is for sun - s/"// || next; - s/",([x\d]+),([x\d]+),([x\d]+),.*// || next; - - next if /^\s*$/; - - $size = $3 if $3; - - - $line = $_; - - if (($name, $pdecl) = /^([\$ \w]+):[tT]((\d+)(=[rufs*](\d+))+)$/) { - print "$name is a typedef for some funky pointers: $pdecl\n" if $debug; - &pdecl($pdecl); - next; - } - - - - if (/(([ \w]+):t(\d+|\(\d+,\d+\)))=r?(\d+|\(\d+,\d+\))(;\d+;\d+;)?/) { - local($ident) = $2; - push(@intrinsics, $ident); - $typeno = &typeno($3); - $type[$typeno] = $ident; - print STDERR "intrinsic $ident in new type $typeno\n" if $debug; - next; - } - - if (($name, $typeordef, $typeno, $extra, $struct, $_) - = /^([\$ \w]+):([ustT])(\d+|\(\d+,\d+\))(=[rufs*](\d+))?(.*)$/) - { - $typeno = &typeno($typeno); # sun foolery - } - elsif (/^[\$\w]+:/) { - next; # variable - } - else { - warn "can't grok stab: <$_> in: $line " if $_; - next; - } - - #warn "got size $size for $name\n"; - $sizeof{$name} = $size if $size; - - s/;[-\d]*;[-\d]*;$//; # we don't care about ranges - - $typenos{$name} = $typeno; - - unless (defined $type[$typeno]) { - &panic("type 0??") unless $typeno; - $type[$typeno] = $name unless defined $type[$typeno]; - printf "new type $typeno is $name" if $debug; - if ($extra =~ /\*/ && defined $type[$struct]) { - print ", a typedef for a pointer to " , $type[$struct] if $debug; - } - } else { - printf "%s is type %d", $name, $typeno if $debug; - print ", a typedef for " , $type[$typeno] if $debug; - } - print "\n" if $debug; - #next unless $extra =~ /[su*]/; - - #$type[$struct] = $name; - - if ($extra =~ /[us*]/) { - &sou($name, $extra); - $_ = &sdecl($name, $_, 0); - } - elsif (/^=ar/) { - print "it's a bare array typedef -- that's pretty sick\n" if $debug; - $_ = "$typeno$_"; - $scripts = ''; - $_ = &adecl($_,1); - - } - elsif (s/((\w+):t(\d+|\(\d+,\d+\)))?=r?(;\d+;\d+;)?//) { # the ?'s are for gcc - push(@intrinsics, $2); - $typeno = &typeno($3); - $type[$typeno] = $2; - print STDERR "intrinsic $2 in new type $typeno\n" if $debug; - } - elsif (s/^=e//) { # blessed by thy compiler; mine won't do this - &edecl; - } - else { - warn "Funny remainder for $name on line $_ left in $line " if $_; - } -} - -sub typeno { # sun thinks types are (0,27) instead of just 27 - local($_) = @_; - s/\(\d+,(\d+)\)/$1/; - $_; -} - -sub pstruct { - local($what,$prefix,$base) = @_; - local($field, $fieldname, $typeno, $count, $offset, $entry); - local($fieldtype); - local($type, $tname); - local($mytype, $mycount, $entry2); - local($struct_count) = 0; - local($pad, $revpad, $length, $prepad, $lastoffset, $lastlength, $fmt); - local($bits,$bytes); - local($template); - - - local($mname) = &munge($name); - - sub munge { - local($_) = @_; - s/[\s\$\.]/_/g; - $_; - } - - local($sname) = &psou($what); - - $nesting++; - - for $field (split(/;/, $struct{$what})) { - $pad = $prepad = 0; - $entry = ''; - ($fieldname, $typeno, $count, $offset, $length) = split(/,/, $field); - - $type = $type[$typeno]; - - $type =~ /([^[]*)(\[.*\])?/; - $mytype = $1; - $count .= $2; - $fieldtype = &psou($mytype); - - local($fname) = &psou($name); - - if ($build_templates) { - - $pad = ($offset - ($lastoffset + $lastlength))/8 - if defined $lastoffset; - - if (! $finished_template{$sname}) { - if ($isaunion{$what}) { - $template{$sname} .= 'X' x $revpad . ' ' if $revpad; - } else { - $template{$sname} .= 'x' x $pad . ' ' if $pad; - } - } - - $template = &fetch_template($type) x - ($count ? &scripts2count($count) : 1); - - if (! $finished_template{$sname}) { - $template{$sname} .= $template; - } - - $revpad = $length/8 if $isaunion{$what}; - - ($lastoffset, $lastlength) = ($offset, $length); - - } else { - print '# ' if $perl && $verbose; - $entry = sprintf($pmask1, - ' ' x ($nesting * $indent) . $fieldtype, - "$prefix.$fieldname" . $count); - - $entry =~ s/(\*+)( )/$2$1/; - - printf $pmask2, - $entry, - ($base+$offset)/8, - ($bits = ($base+$offset)%8) ? ".$bits" : " ", - $length/8, - ($bits = $length % 8) ? ".$bits": "" - if !$perl || $verbose; - - - if ($perl && $nesting == 1) { - $template = &scrunch(&fetch_template($type) x - ($count ? &scripts2count($count) : 1)); - push(@sizeof, int($length/8) .",\t# $fieldname"); - push(@offsetof, int($offset/8) .",\t# $fieldname"); - push(@typedef, "'$template', \t# $fieldname"); - $type =~ s/(struct|union) //; - push(@typeof, "'$type" . ($count ? $count : '') . - "',\t# $fieldname"); - } - - print ' ', ' ' x $indent x $nesting, $template - if $perl && $verbose; - - print "\n" if !$perl || $verbose; - - } - if ($perl) { - local($mycount) = defined $struct{$mytype} ? $countof{$mytype} : 1; - $mycount *= &scripts2count($count) if $count; - if ($nesting==1 && !$build_templates) { - $pcode .= sprintf("sub %-32s { %4d; }\n", - "${mname}'${fieldname}", $struct_count); - push(@indices, $struct_count); - } - $struct_count += $mycount; - } - - - &pstruct($type, "$prefix.$fieldname", $base+$offset) - if $recurse && defined $struct{$type}; - } - - $countof{$what} = $struct_count unless defined $countof{$whati}; - - $template{$sname} .= '$' if $build_templates; - $finished_template{$sname}++; - - if ($build_templates && !defined $sizeof{$name}) { - local($fmt) = &scrunch($template{$sname}); - print STDERR "no size for $name, punting with $fmt..." if $debug; - eval '$sizeof{$name} = length(pack($fmt, ()))'; - if ($@) { - chop $@; - warn "couldn't get size for \$name: $@"; - } else { - print STDERR $sizeof{$name}, "\n" if $debUg; - } - } - - --$nesting; -} - - -sub psize { - local($me) = @_; - local($amstruct) = $struct{$me} ? 'struct ' : ''; - - print '$sizeof{\'', $amstruct, $me, '\'} = '; - printf "%d;\n", $sizeof{$me}; -} - -sub pdecl { - local($pdecl) = @_; - local(@pdecls); - local($tname); - - warn "pdecl: $pdecl\n" if $debug; - - $pdecl =~ s/\(\d+,(\d+)\)/$1/g; - $pdecl =~ s/\*//g; - @pdecls = split(/=/, $pdecl); - $typeno = $pdecls[0]; - $tname = pop @pdecls; - - if ($tname =~ s/^f//) { $tname = "$tname&"; } - #else { $tname = "$tname*"; } - - for (reverse @pdecls) { - $tname .= s/^f// ? "&" : "*"; - #$tname =~ s/^f(.*)/$1&/; - print "type[$_] is $tname\n" if $debug; - $type[$_] = $tname unless defined $type[$_]; - } -} - - - -sub adecl { - ($arraytype, $unknown, $lower, $upper) = (); - #local($typeno); - # global $typeno, @type - local($_, $typedef) = @_; - - while (s/^((\d+)=)?ar(\d+);//) { - ($arraytype, $unknown) = ($2, $3); - if (s/^(\d+);(\d+);//) { - ($lower, $upper) = ($1, $2); - $scripts .= '[' . ($upper+1) . ']'; - } else { - warn "can't find array bounds: $_"; - } - } - if (s/^([\d*f=]*),(\d+),(\d+);//) { - ($start, $length) = ($2, $3); - local($whatis) = $1; - if ($whatis =~ /^(\d+)=/) { - $typeno = $1; - &pdecl($whatis); - } else { - $typeno = $whatis; - } - } elsif (s/^(\d+)(=[*suf]\d*)//) { - local($whatis) = $2; - - if ($whatis =~ /[f*]/) { - &pdecl($whatis); - } elsif ($whatis =~ /[su]/) { # - print "$prefix.$fieldname is an array$scripts anon structs; disgusting\n" - if $debug; - #$type[$typeno] = $name unless defined $type[$typeno]; - ##printf "new type $typeno is $name" if $debug; - $typeno = $1; - $type[$typeno] = "$prefix.$fieldname"; - local($name) = $type[$typeno]; - &sou($name, $whatis); - $_ = &sdecl($name, $_, $start+$offset); - 1; - $start = $start{$name}; - $offset = $sizeof{$name}; - $length = $offset; - } else { - warn "what's this? $whatis in $line "; - } - } elsif (/^\d+$/) { - $typeno = $_; - } else { - warn "bad array stab: $_ in $line "; - next STAB; - } - #local($wasdef) = defined($type[$typeno]) && $debug; - #if ($typedef) { - #print "redefining $type[$typeno] to " if $wasdef; - #$type[$typeno] = "$whatis$scripts"; # unless defined $type[$typeno]; - #print "$type[$typeno]\n" if $wasdef; - #} else { - #$type[$arraytype] = $type[$typeno] unless defined $type[$arraytype]; - #} - $type[$arraytype] = "$type[$typeno]$scripts" if defined $type[$typeno]; - print "type[$arraytype] is $type[$arraytype]\n" if $debug; - print "$prefix.$fieldname is an array of $type[$arraytype]\n" if $debug; - $_; -} - - - -sub sdecl { - local($prefix, $_, $offset) = @_; - - local($fieldname, $scripts, $type, $arraytype, $unknown, - $whatis, $pdecl, $upper,$lower, $start,$length) = (); - local($typeno,$sou); - - -SFIELD: - while (/^([^;]+);/) { - $scripts = ''; - warn "sdecl $_\n" if $debug; - if (s/^([\$\w]+)://) { - $fieldname = $1; - } elsif (s/(\d+)=([us])(\d+|\(\d+,\d+\))//) { # - $typeno = &typeno($1); - $type[$typeno] = "$prefix.$fieldname"; - local($name) = "$prefix.$fieldname"; - &sou($name,$2); - $_ = &sdecl("$prefix.$fieldname", $_, $start+$offset); - $start = $start{$name}; - $offset += $sizeof{$name}; - #print "done with anon, start is $start, offset is $offset\n"; - #next SFIELD; - } else { - warn "weird field $_ of $line" if $debug; - next STAB; - #$fieldname = &gensym; - #$_ = &sdecl("$prefix.$fieldname", $_, $start+$offset); - } - - if (/^\d+=ar/) { - $_ = &adecl($_); - } - elsif (s/^(\d+|\(\d+,\d+\))?,(\d+),(\d+);//) { - ($start, $length) = ($2, $3); - &panic("no length?") unless $length; - $typeno = &typeno($1) if $1; - } - elsif (s/^((\d+|\(\d+,\d+\))(=[*f](\d+|\(\d+,\d+\)))+),(\d+),(\d+);//) { - ($pdecl, $start, $length) = ($1,$5,$6); - &pdecl($pdecl); - } - elsif (s/(\d+)=([us])(\d+|\(\d+,\d+\))//) { # the dratted anon struct - ($typeno, $sou) = ($1, $2); - $typeno = &typeno($typeno); - if (defined($type[$typeno])) { - warn "now how did we get type $1 in $fieldname of $line?"; - } else { - print "anon type $typeno is $prefix.$fieldname\n" if $debug; - $type[$typeno] = "$prefix.$fieldname" unless defined $type[$typeno]; - }; - local($name) = "$prefix.$fieldname"; - &sou($name,$sou); - print "anon ".($isastruct{$name}) ? "struct":"union"." for $prefix.$fieldname\n" if $debug; - $type[$typeno] = "$prefix.$fieldname"; - $_ = &sdecl("$prefix.$fieldname", $_, $start+$offset); - $start = $start{$name}; - $length = $sizeof{$name}; - } - else { - warn "can't grok stab for $name ($_) in line $line "; - next STAB; - } - - &panic("no length for $prefix.$fieldname") unless $length; - $struct{$name} .= join(',', $fieldname, $typeno, $scripts, $start, $length) . ';'; - } - if (s/;\d*,(\d+),(\d+);//) { - local($start, $size) = ($1, $2); - $sizeof{$prefix} = $size; - print "start of $prefix is $start, size of $sizeof{$prefix}\n" if $debug; - $start{$prefix} = $start; - } - $_; -} - -sub edecl { - s/;$//; - $enum{$name} = $_; - $_ = ''; -} - -sub resolve_types { - local($sou); - for $i (0 .. $#type) { - next unless defined $type[$i]; - $_ = $type[$i]; - unless (/\d/) { - print "type[$i] $type[$i]\n" if $debug; - next; - } - print "type[$i] $_ ==> " if $debug; - s/^(\d+)(\**)\&\*(\**)/"$2($3".&type($1) . ')()'/e; - s/^(\d+)\&/&type($1)/e; - s/^(\d+)/&type($1)/e; - s/(\*+)([^*]+)(\*+)/$1$3$2/; - s/\((\*+)(\w+)(\*+)\)/$3($1$2)/; - s/^(\d+)([\*\[].*)/&type($1).$2/e; - #s/(\d+)(\*|(\[[\[\]\d\*]+]\])+)/&type($1).$2/ge; - $type[$i] = $_; - print "$_\n" if $debug; - } -} -sub type { &psou($type[$_[0]] || ""); } - -sub adjust_start_addrs { - for (sort keys %start) { - ($basename = $_) =~ s/\.[^.]+$//; - $start{$_} += $start{$basename}; - print "start: $_ @ $start{$_}\n" if $debug; - } -} - -sub sou { - local($what, $_) = @_; - /u/ && $isaunion{$what}++; - /s/ && $isastruct{$what}++; -} - -sub psou { - local($what) = @_; - local($prefix) = ''; - if ($isaunion{$what}) { - $prefix = 'union '; - } elsif ($isastruct{$what}) { - $prefix = 'struct '; - } - $prefix . $what; -} - -sub scrunch { - local($_) = @_; - - study; - - s/\$//g; - s/ / /g; - 1 while s/(\w) \1/$1$1/g; - - # i wanna say this, but perl resists my efforts: - # s/(\w)(\1+)/$2 . length($1)/ge; - - &quick_scrunch; - - s/ $//; - - $_; -} - -sub buildscrunchlist { - $scrunch_code = "sub quick_scrunch {\n"; - for (values %intrinsics) { - $scrunch_code .= "\ts/($_{2,})/'$_' . length(\$1)/ge;\n"; - } - $scrunch_code .= "}\n"; - print "$scrunch_code" if $debug; - eval $scrunch_code; - &panic("can't eval scrunch_code $@ \nscrunch_code") if $@; -} - -sub fetch_template { - local($mytype) = @_; - local($fmt); - local($count) = 1; - - &panic("why do you care?") unless $perl; - - if ($mytype =~ s/(\[\d+\])+$//) { - $count .= $1; - } - - if ($mytype =~ /\*/) { - $fmt = $template{'pointer'}; - } - elsif (defined $template{$mytype}) { - $fmt = $template{$mytype}; - } - elsif (defined $struct{$mytype}) { - if (!defined $template{&psou($mytype)}) { - &build_template($mytype) unless $mytype eq $name; - } - elsif ($template{&psou($mytype)} !~ /\$$/) { - #warn "incomplete template for $mytype\n"; - } - $fmt = $template{&psou($mytype)} || '?'; - } - else { - warn "unknown fmt for $mytype\n"; - $fmt = '?'; - } - - $fmt x $count . ' '; -} - -sub compute_intrinsics { - local($TMP) = "/tmp/c2ph-i.$$.c"; - open (TMP, ">$TMP") || die "can't open $TMP: $!"; - select(TMP); - - print STDERR "computing intrinsic sizes: " if $trace; - - undef %intrinsics; - - print <<'EOF'; -main() { - char *mask = "%d %s\n"; -EOF - - for $type (@intrinsics) { - next if $type eq 'void'; - print <<"EOF"; - printf(mask,sizeof($type), "$type"); -EOF - } - - print <<'EOF'; - printf(mask,sizeof(char *), "pointer"); - exit(0); -} -EOF - close TMP; - - select(STDOUT); - open(PIPE, "cd /tmp && $CC $TMP && /tmp/a.out|"); - while () { - chop; - split(' ',$_,2);; - print "intrinsic $_[1] is size $_[0]\n" if $debug; - $sizeof{$_[1]} = $_[0]; - $intrinsics{$_[1]} = $template{$_[0]}; - } - close(PIPE) || die "couldn't read intrinsics!"; - unlink($TMP, '/tmp/a.out'); - print STDERR "done\n" if $trace; -} - -sub scripts2count { - local($_) = @_; - - s/^\[//; - s/\]$//; - s/\]\[/*/g; - $_ = eval; - &panic("$_: $@") if $@; - $_; -} - -sub system { - print STDERR "@_\n" if $trace; - system @_; -} - -sub build_template { - local($name) = @_; - - &panic("already got a template for $name") if defined $template{$name}; - - local($build_templates) = 1; - - local($lparen) = '(' x $build_recursed; - local($rparen) = ')' x $build_recursed; - - print STDERR "$lparen$name$rparen " if $trace; - $build_recursed++; - &pstruct($name,$name,0); - print STDERR "TEMPLATE for $name is ", $template{&psou($name)}, "\n" if $debug; - --$build_recursed; -} - - -sub panic { - - select(STDERR); - - print "\npanic: @_\n"; - - exit 1 if $] <= 4.003; # caller broken - - local($i,$_); - local($p,$f,$l,$s,$h,$a,@a,@sub); - for ($i = 0; ($p,$f,$l,$s,$h,$w) = caller($i); $i++) { - @a = @DB'args; - for (@a) { - if (/^StB\000/ && length($_) == length($_main{'_main'})) { - $_ = sprintf("%s",$_); - } - else { - s/'/\\'/g; - s/([^\0]*)/'$1'/ unless /^-?[\d.]+$/; - s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg; - s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg; - } - } - $w = $w ? '@ = ' : '$ = '; - $a = $h ? '(' . join(', ', @a) . ')' : ''; - push(@sub, "$w&$s$a from file $f line $l\n"); - last if $signal; - } - for ($i=0; $i <= $#sub; $i++) { - last if $signal; - print $sub[$i]; - } - exit 1; -} - -sub squishseq { - local($num); - local($last) = -1e8; - local($string); - local($seq) = '..'; - - while (defined($num = shift)) { - if ($num == ($last + 1)) { - $string .= $seq unless $inseq++; - $last = $num; - next; - } elsif ($inseq) { - $string .= $last unless $last == -1e8; - } - - $string .= ',' if defined $string; - $string .= $num; - $last = $num; - $inseq = 0; - } - $string .= $last if $inseq && $last != -e18; - $string; -} diff --git a/c2ph.SH b/c2ph.SH index 747c15f..57e7822 100755 --- a/c2ph.SH +++ b/c2ph.SH @@ -37,7 +37,7 @@ $spitshell >>c2ph <<'!NO!SUBS!' # See the usage message for more. If this isn't enough, read the code. # -$RCSID = '$RCSfile: c2ph.SH,v $$Revision: 4.1 $$Date: 92/08/07 17:19:10 $'; +$RCSID = 'c2ph.SH'; ###################################################################### diff --git a/cflags b/cflags deleted file mode 100755 index a2ee627..0000000 --- a/cflags +++ /dev/null @@ -1,79 +0,0 @@ -case "$0" in -*/*) cd `expr X$0 : 'X\(.*\)/'` ;; -esac -case $CONFIG in -'') - if test ! -f config.sh; then - ln ../config.sh . || \ - ln ../../config.sh . || \ - ln ../../../config.sh . || \ - (echo "Can't find config.sh."; exit 1) - fi 2>/dev/null - . ./config.sh - ;; -esac - -also=': ' -case $# in -1) also='echo 1>&2 " CCCMD = "' -esac - -case $# in -0) set *.c; echo "The current C flags are:" ;; -esac - -set `echo "$* " | sed 's/\.[oc] / /g'` - -for file do - - case "$#" in - 1) ;; - *) echo $n " $file.c $c" ;; - esac - - : allow variables like toke_cflags to be evaluated - - eval 'eval ${'"${file}_cflags"'-""}' - - : or customize here - - case "$file" in - NDBM_File) ;; - ODBM_File) ;; - POSIX) ;; - SDBM_File) ;; - av) ;; - deb) ;; - dl) ;; - doio) ;; - doop) ;; - dump) ;; - gv) ;; - hv) ;; - main) ;; - malloc) ;; - mg) ;; - miniperlmain) ;; - op) ;; - perl) ;; - perlmain) ;; - perly) ;; - pp) ;; - regcomp) ;; - regexec) ;; - run) ;; - scope) ;; - sv) ;; - taint) ;; - toke) ;; - usersub) ;; - util) ;; - *) ;; - esac - - echo "$cc -c $ccflags $optimize $large $split" - eval "$also "'"$cc -c $ccflags $optimize $large $split"' - - . ./config.sh - -done diff --git a/cflags.SH b/cflags.SH index dc1c9de..4a17475 100755 --- a/cflags.SH +++ b/cflags.SH @@ -1,13 +1,15 @@ case $CONFIG in '') - if test ! -f config.sh; then - ln ../config.sh . || \ - ln ../../config.sh . || \ - ln ../../../config.sh . || \ - (echo "Can't find config.sh."; exit 1) - fi - . ./config.sh - ;; + if test -f config.sh; then TOP=.; + elif test -f ../config.sh; then TOP=..; + elif test -f ../../config.sh; then TOP=../..; + elif test -f ../../../config.sh; then TOP=../../..; + elif test -f ../../../../config.sh; then TOP=../../../..; + else + echo "Can't find config.sh."; exit 1 + fi + . $TOP/config.sh + ;; esac : This forces SH files to create target in same directory as SH file. : This is so that make depend always knows where to find SH derivatives. @@ -19,25 +21,37 @@ echo "Extracting cflags (with variable substitutions)" : Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!. : Protect any dollar signs and backticks that you do not want interpreted : by putting a backslash in front. You may delete these comments. -rm -f cflags $spitshell >cflags <>cflags <<'!NO!SUBS!' -case "$0" in -*/*) cd `expr X$0 : 'X\(.*\)/'` ;; -esac case $CONFIG in '') - if test ! -f config.sh; then - ln ../config.sh . || \ - ln ../../config.sh . || \ - ln ../../../config.sh . || \ - (echo "Can't find config.sh."; exit 1) - fi 2>/dev/null - . ./config.sh - ;; + if test -f config.sh; then TOP=.; + elif test -f ../config.sh; then TOP=..; + elif test -f ../../config.sh; then TOP=../..; + elif test -f ../../../config.sh; then TOP=../../..; + elif test -f ../../../../config.sh; then TOP=../../../..; + else + echo "Can't find config.sh."; exit 1 + fi + . $TOP/config.sh + ;; +esac + +perltype='' +optdebug='' # ensure -g used if building a -DDEBUGGING libperl +case $# in +2) case $1 in + *perl.*) perltype='';; + *perld.*) perltype='-DDEBUGGING'; optdebug='-g' ;; + *perle.*) perltype='-DEMBED';; + *perlde.*) perltype='-DDEBUGGING -DEMBED'; optdebug='-g' ;; + *perlm.*) perltype='-DEMBED -DMULTIPLICITY';; + *perldm.*) perltype='-DDEBUGGING -DEMBED -DMULTIPLICITY'; optdebug='-g' ;; + esac + shift ;; esac also=': ' @@ -65,6 +79,8 @@ for file do : or customize here case "$file" in + DB_File) ;; + GDBM_File) ;; NDBM_File) ;; ODBM_File) ;; POSIX) ;; @@ -86,6 +102,9 @@ for file do perlmain) ;; perly) ;; pp) ;; + pp_ctl) ;; + pp_hot) ;; + pp_sys) ;; regcomp) ;; regexec) ;; run) ;; @@ -98,12 +117,16 @@ for file do *) ;; esac - echo "$cc -c $ccflags $optimize $large $split" - eval "$also "'"$cc -c $ccflags $optimize $large $split"' + if test "X$optdebug" != "X"; then + optimize="$optdebug" + fi + + echo "$cc -c $ccflags $optimize $perltype $large $split" + eval "$also "'"$cc -c $ccflags $optimize $perltype $large $split"' - . ./config.sh + . $TOP/config.sh done !NO!SUBS! -chmod +x cflags +chmod 755 cflags $eunicefix cflags diff --git a/config.H b/config.H index 22594b7..5ad7f3f 100644 --- a/config.H +++ b/config.H @@ -1,6 +1,6 @@ -/* config.H: This is a sample config.h file. config.h is produced - from config_h.SH by Configure. This file is intended only for - those having problems with the regular Configure process. +/* 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 @@ -14,14 +14,20 @@ * $Id: Config_h.U,v 3.0.1.2 1993/08/24 12:13:20 ram Exp $ */ -/* Configuration time: Thu Apr 28 11:13:38 EDT 1994 - * Configured by: doughera - * Target system: sunos einstein 4.1.3 3 sun4c +/* Configuration time: Thu Oct 6 18:27:36 EDT 1994 + * Configured by: andy + * Target system: crystal crystal 3.2 2 i386 */ #ifndef _config_h_ #define _config_h_ +/* MEM_ALIGNBYTES: + * This symbol contains the number of bytes required to align a + * double. Usual values are 2, 4 and 8. + */ +#define MEM_ALIGNBYTES 4 /**/ + /* 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. @@ -32,7 +38,7 @@ * This symbol hold the hexadecimal constant defined in byteorder, * i.e. 0x1234 or 0x4321, etc... */ -#define BYTEORDER 0x4321 /* large digits for MSB */ +#define BYTEORDER 0x1234 /* large digits for MSB */ /* CPPSTDIN: * This symbol contains the first part of the string which will invoke @@ -46,8 +52,14 @@ * output. This symbol will have the value "-" if CPPSTDIN needs a minus * to specify standard input, otherwise the value is "". */ -#define CPPSTDIN "/home/doughera/src/perl5a8-ad/cppstdin" -#define CPPMINUS "" +#define CPPSTDIN "gcc -E" +#define CPPMINUS "-" + +/* HAS_ALARM: + * This symbol, if defined, indicates that the alarm routine is + * available. + */ +#define HAS_ALARM /**/ /* HAS_BCMP: * This symbol is defined if the bcmp() routine is available to @@ -67,6 +79,12 @@ */ #define HAS_BZERO /**/ +/* 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. @@ -87,13 +105,25 @@ * is up to the package author to declare sprintf correctly based on the * symbol. */ -#define CHARSPRINTF /**/ +/*#define CHARSPRINTF /**/ + +/* 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 /**/ +#define HAS_CHSIZE /**/ /* HASCONST: * This symbol, if defined, indicates that this C compiler knows about @@ -101,7 +131,7 @@ * within your programs. The mere use of the "const" keyword will * trigger the necessary tests. */ -/*#define HASCONST /**/ +#define HASCONST /**/ #ifndef HASCONST #define const #endif @@ -116,22 +146,27 @@ * This symbol, if defined, indicates that the C-shell exists. * If defined, contains the full pathname of csh. */ -#define CSH "/usr/bin/csh" /**/ +#define CSH "/bin/csh" /**/ -/* 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. +/* HAS_CUSERID: + * This symbol, if defined, indicates that the cuserid routine is + * available to get character login names. */ -/*#define DOSUID /**/ +#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_DUP2: * This symbol, if defined, indicates that the dup2 routine is @@ -143,13 +178,13 @@ * This symbol, if defined, indicates that the fchmod routine is available * to change mode of opened files. If unavailable, use chmod(). */ -#define HAS_FCHMOD /**/ +/*#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 /**/ +/*#define HAS_FCHOWN /**/ /* HAS_FCNTL: * This symbol, if defined, indicates to the C program that @@ -157,17 +192,35 @@ */ #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 /**/ +/*#define FLEXFILENAMES /**/ /* HAS_FLOCK: * This symbol, if defined, indicates that the flock routine is * available to do file locking. */ -#define HAS_FLOCK /**/ +/*#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_GETGROUPS: * This symbol, if defined, indicates that the getgroups() routine is @@ -180,7 +233,7 @@ * This symbol, if defined, indicates that the gethostent routine is * available to lookup host names in some data base or other. */ -#define HAS_GETHOSTENT /**/ +/*#define HAS_GETHOSTENT /**/ /* HAS_UNAME: * This symbol, if defined, indicates that the C program may use the @@ -189,6 +242,12 @@ */ #define HAS_UNAME /**/ +/* HAS_GETLOGIN: + * This symbol, if defined, indicates that the getlogin routine is + * available to get the login name. + */ +#define HAS_GETLOGIN /**/ + /* HAS_GETPGRP: * This symbol, if defined, indicates that the getpgrp routine is * available to get the current process group. @@ -201,18 +260,55 @@ */ /*#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 /**/ +/*#define HAS_GETPRIORITY /**/ + +/* HAS_GROUP: + * This symbol, if defined, indicates that the group routine is + * available. + */ +/*#define HAS_GROUP /**/ + +/* 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_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 /**/ +/*#define HAS_KILLPG /**/ /* HAS_LINK: * This symbol, if defined, indicates that the link routine is @@ -220,12 +316,36 @@ */ #define HAS_LINK /**/ +/* 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. @@ -259,41 +379,78 @@ */ #define HAS_MKDIR /**/ +/* HAS_MKTIME: + * This symbol, if defined, indicates that the mktime routine is + * available. + */ +#define HAS_MKTIME /**/ + /* 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_MSGCTL: - * This symbol, if defined, indicates that the msgctl() routine is - * available to perform message control operations. +/* HAS_NICE: + * This symbol, if defined, indicates that the nice routine is + * available. */ -#define HAS_MSGCTL /**/ +#define HAS_NICE /**/ -/* HAS_MSGGET: - * This symbol, if defined, indicates that the msgget() routine is - * available to get a new message queue. +/* HAS_OPEN3: + * This manifest constant lets the C program know that the three + * argument form of open(2) is available. */ -#define HAS_MSGGET /**/ +#define HAS_OPEN3 /**/ -/* HAS_MSGRCV: - * This symbol, if defined, indicates that the msgrcv() routine is - * available to extract a message from the message queue. +/* HAS_PASSWD: + * This symbol, if defined, indicates that the passwd routine is + * available. */ -#define HAS_MSGRCV /**/ +/*#define HAS_PASSWD /**/ -/* HAS_MSGSND: - * This symbol, if defined, indicates that the msgsnd() routine is - * available to send a message into the message queue. +/* HAS_PAUSE: + * This symbol, if defined, indicates that the pause routine is + * available to suspend a process until a signal is received. */ -#define HAS_MSGSND /**/ +#define HAS_PAUSE /**/ -/* HAS_OPEN3: - * This manifest constant lets the C program know that the three - * argument form of open(2) is available. +/* HAS_PIPE: + * This symbol, if defined, indicates that the pipe routine is + * available to create an inter-process channel. */ -#define HAS_OPEN3 /**/ +#define HAS_PIPE /**/ + +/* 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 @@ -322,24 +479,6 @@ */ #define HAS_SEM /**/ -/* HAS_SEMCTL: - * This symbol, if defined, indicates that the semctl() routine is - * available to perform semaphore control operations. - */ -#define HAS_SEMCTL /**/ - -/* HAS_SEMGET: - * This symbol, if defined, indicates that the semget() routine is - * available to get a set of semaphores. - */ -#define HAS_SEMGET /**/ - -/* HAS_SEMOP: - * This symbol, if defined, indicates that the semop() routine is - * available to execute semaphore operations. - */ -#define HAS_SEMOP /**/ - /* HAS_SETEGID: * This symbol, if defined, indicates that the setegid routine is available * to change the effective gid of the current program. @@ -352,6 +491,19 @@ */ #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 routine is * available to set process group ID. @@ -374,7 +526,7 @@ * This symbol, if defined, indicates that the setpriority routine is * available to set a process's priority. */ -#define HAS_SETPRIORITY /**/ +/*#define HAS_SETPRIORITY /**/ /* HAS_SETREGID: * This symbol, if defined, indicates that the setregid routine is @@ -406,13 +558,13 @@ * This symbol, if defined, indicates that the setrgid routine is available * to change the real gid of the current program. */ -#define HAS_SETRGID /**/ +/*#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 /**/ +/*#define HAS_SETRUID /**/ /* HAS_SETSID: * This symbol, if defined, indicates that the setsid routine is @@ -426,23 +578,19 @@ */ #define HAS_SHM /**/ -/* HAS_SHMCTL: - * This symbol, if defined, indicates that the shmctl() routine is - * available to perform shared memory control operations. - */ -#define HAS_SHMCTL /**/ - -/* HAS_SHMDT: - * This symbol, if defined, indicates that the shmdt() routine is - * available to detach a shared memory segment from the process space. +/* Shmat_t: + * This symbol holds the return type of the shmat() system call. + * Usually set to 'void *' or 'char *'. */ -#define HAS_SHMDT /**/ - -/* HAS_SHMGET: - * This symbol, if defined, indicates that the shmget() routine is - * available to request a shared memory segment from the kernel. +/* 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 HAS_SHMGET /**/ +#define Shmat_t char * /**/ +/*#define HAS_SHMAT_PROTOTYPE /**/ /* HAS_SOCKET: * This symbol, if defined, indicates that the BSD socket interface is @@ -452,20 +600,14 @@ * This symbol, if defined, indicates that the BSD socketpair() call is * supported. */ -/* USE_OLDSOCKET: - * This symbol, if defined, indicates that the 4.1c BSD socket interface - * is supported instead of the 4.2/4.3 BSD socket interface. For instance, - * there is no setsockopt() call. - */ #define HAS_SOCKET /**/ -#define HAS_SOCKETPAIR /**/ -/*#define USE_OLDSOCKET /**/ +/*#define HAS_SOCKETPAIR /**/ /* USE_STAT_BLOCKS: * This symbol is defined if this system has a stat structure declaring * st_blksize and st_blocks. */ -#define USE_STAT_BLOCKS /**/ +/*#define USE_STAT_BLOCKS /**/ /* USE_STD_STDIO: * This symbol is defined if this system has a FILE structure declaring @@ -473,6 +615,24 @@ */ #define USE_STD_STDIO /**/ +/* 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 @@ -480,6 +640,31 @@ */ #define USE_STRUCT_COPY /**/ +/* 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_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. @@ -498,12 +683,17 @@ */ #define HAS_SYSTEM /**/ -/* 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). +/* 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 Time_t long /* Time type */ +#define HAS_TCSETPGRP /**/ /* HAS_TIMES: * This symbol, if defined, indicates that the times() routine exists. @@ -516,13 +706,24 @@ * This symbol, if defined, indicates that the truncate routine is * available to truncate files. */ -#define HAS_TRUNCATE /**/ +/*#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 /**/ -/* I_NDIR: - * This symbol, if defined, indicates that the program should include the - * system's version of ndir.h, rather than the one with this package. +/* HAS_VFORK: + * This symbol, if defined, indicates that vfork() exists. */ -/*#define I_NDIR /**/ +/*#define HAS_VFORK /**/ /* VOIDSIG: * This symbol is defined if this system declares "void (*signal(...))()" in @@ -536,7 +737,7 @@ * This symbol, if defined, indicates that this C compiler knows about * the volatile declaration. */ -/*#define HASVOLATILE /**/ +#define HASVOLATILE /**/ #ifndef HASVOLATILE #define volatile #endif @@ -553,12 +754,12 @@ * symbol. */ #define HAS_VPRINTF /**/ -#define USE_CHAR_VSPRINTF /**/ +/*#define USE_CHAR_VSPRINTF /**/ /* HAS_WAIT4: * This symbol, if defined, indicates that wait4() exists. */ -#define HAS_WAIT4 /**/ +/*#define HAS_WAIT4 /**/ /* HAS_WAITPID: * This symbol, if defined, indicates that the waitpid routine is @@ -566,11 +767,33 @@ */ #define HAS_WAITPID /**/ -/* I_DBM: - * This symbol, if defined, indicates to the C program that it should - * include . +/* 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 /**/ + +/* 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 I_DBM /**/ +#define Gid_t gid_t /* Type for getgid(), etc... */ /* I_DIRENT: * This symbol, if defined, indicates to the C program that it should @@ -583,24 +806,32 @@ * 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 /**/ -#ifdef I_DIRENT #define Direntry_t struct dirent -#else -#define Direntry_t struct direct -#endif + +/* 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 /**/ +#define I_FCNTL /**/ -/* I_GDBM: - * This symbol, if defined, indicates that gdbm.h exists and should - * be included. +/* 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_GDBM /**/ +#define I_FLOAT /**/ /* I_GRP: * This symbol, if defined, indicates to the C program that it should @@ -608,6 +839,25 @@ */ #define I_GRP /**/ +/* 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_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 ndbm.h exists and should * be included. @@ -618,18 +868,43 @@ * This symbol, if defined, indicates to the C program that it should * include . Otherwise, you may try . */ -/* I_SYS_IN: - * This symbol, if defined, indicates to the C program that it should - * include instead of . - */ #define I_NETINET_IN /**/ -/*#define I_SYS_IN /**/ -/* I_STDARG: - * This symbol, if defined, indicates that exists and should - * be included. +/* 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. */ -/*#define I_STDARG /**/ +/* 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. + */ +#define I_PWD /**/ +/*#define PWQUOTA /**/ +#define PWAGE /**/ +/*#define PWCHANGE /**/ +/*#define PWCLASS /**/ +/*#define PWEXPIRE /**/ +#define PWCOMMENT /**/ /* I_STDDEF: * This symbol, if defined, indicates that exists and should @@ -637,6 +912,12 @@ */ #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). @@ -653,7 +934,7 @@ * 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 /**/ +/*#define I_SYS_FILE /**/ /* I_SYS_IOCTL: * This symbol, if defined, indicates that exists and should @@ -667,21 +948,53 @@ */ /*#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_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_TIME: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -/* I_SYS_TIME: +/* I_SYS_TIMES: * This symbol, if defined, indicates to the C program that it should - * include . + * include . */ -/* I_SYS_TIME_KERNEL: +#define I_SYS_TIMES /**/ + +/* 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_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. */ @@ -689,17 +1002,34 @@ #define I_SYS_TIME /**/ /*#define I_SYS_TIME_KERNEL /**/ +/* 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_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_VARARGS /**/ +#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 /**/ /* INTSIZE: * This symbol contains the size of an int, so that the C preprocessor @@ -720,13 +1050,31 @@ * execution path, but it should be accessible by the world. The program * should be prepared to do ~ expansion. */ -#define PRIVLIB "/usr/local/lib/perl" /**/ +#define PRIVLIB "/usr/local/lib/perl5" /**/ + +/* 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 /* RANDBITS: * This symbol contains the number of bits of random number the rand() * function produces. Usual values are 15, 16, and 31. */ -#define RANDBITS 31 /**/ +#define RANDBITS 15 /**/ /* SCRIPTDIR: * This symbol holds the name of the directory in which the user wants @@ -736,6 +1084,32 @@ */ #define SCRIPTDIR "/usr/local/bin" /**/ +/* 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 * /**/ + +/* SIG_NAME: + * This symbol contains a list of signal names in order. 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". + */ +#define SIG_NAME "ZERO","HUP","INT","QUIT","ILL","TRAP","ABRT","EMT","FPE","KILL","BUS","SEGV","SYS","PIPE","ALRM","TERM","USR1","USR2","CLD","PWR","WINCH","21","POLL","CONT","STOP","TSTP","TTIN","TTOU" /**/ + +/* 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 */ + /* STDCHAR: * This symbol is defined to be the type of char used in stdio.h. * It has the values "unsigned char" or "char". @@ -749,6 +1123,31 @@ */ #define Uid_t uid_t /* UID type */ +/* 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 + /* EUNICE: * This symbol, if defined, indicates that the program is being compiled * under the EUNICE package under VMS. The program will need to handle @@ -763,73 +1162,155 @@ /*#define EUNICE /**/ /*#define VMS /**/ -/* MEM_ALIGNBYTES: - * This symbol contains the number of bytes required to align a - * double. Usual values are 2, 4 and 8. +/* LOC_SED: + * This symbol holds the complete pathname to the sed program. */ -#define MEM_ALIGNBYTES 8 /**/ +#define LOC_SED "/bin/sed" /**/ + +/* 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. + */ +#define ARCHLIB "/usr/local/lib/perl5/isc" /**/ + +/* CAT2: + * This macro catenates 2 tokens together. + */ +#if 42 == 1 +#define CAT2(a,b)a/**/b +#define CAT3(a,b,c)a/**/b/**/c +#define CAT4(a,b,c,d)a/**/b/**/c/**/d +#define CAT5(a,b,c,d,e)a/**/b/**/c/**/d/**/e +#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 CAT3(a,b,c)a ## b ## c +#define CAT4(a,b,c,d)a ## b ## c ## d +#define CAT5(a,b,c,d,e)a ## b ## c ## d ## e +#define StGiFy(a)# a +#define STRINGIFY(a)StGiFy(a) +#define SCAT2(a,b)StGiFy(a) StGiFy(b) +#define SCAT3(a,b,c)StGiFy(a) StGiFy(b) StGiFy(c) +#define SCAT4(a,b,c,d)StGiFy(a) StGiFy(b) StGiFy(c) StGiFy(d) +#define SCAT5(a,b,c,d,e)StGiFy(a) StGiFy(b) StGiFy(c) StGiFy(d) StGiFy(e) +#endif +#ifndef CAT2 +#include "Bletch: How does this C preprocessor catenate tokens?" +#endif -/* CASTI32: - * This symbol is defined if the C compiler can cast negative - * or large floating point numbers to 32-bit ints. +/* GNUC_ATTRIBUTE_CHECK: + * This symbol indicates the C compiler can check for function attributes, + * such as printf formats. */ -#define CASTI32 /**/ +#define GNUC_ATTRIBUTE_CHECK /* */ -/* HAS_HTONL: - * This symbol, if defined, indicates that the htonl() routine (and - * friends htons() ntohl() ntohs()) are available to do network - * order byte swapping. +/* VOID_CLOSEDIR: + * This symbol, if defined, indicates that the closedir() routine + * does not return a value. */ -/* HAS_HTONS: - * This symbol, if defined, indicates that the htons() routine (and - * friends htonl() ntohl() ntohs()) are available to do network - * order byte swapping. +/*#define VOID_CLOSEDIR /**/ + +/* HAS_DLERROR: + * This symbol, if defined, indicates that the dlerror routine is + * available. */ -/* HAS_NTOHL: - * This symbol, if defined, indicates that the ntohl() routine (and - * friends htonl() htons() ntohs()) are available to do network - * order byte swapping. +/*#define HAS_DLERROR /**/ + +/* 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. */ -/* 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 DLSYM_NEEDS_UNDERSCORE /* */ + +/* 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. */ -#define HAS_HTONL /**/ -#define HAS_HTONS /**/ -#define HAS_NTOHL /**/ -#define HAS_NTOHS /**/ +/* 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_DREM: + * This symbol, if defined, indicates that the drem routine is + * available. This is a Pyramid routine that is the same as + * fmod. + */ +/*#define HAS_DREM /**/ + +/* HAS_FMOD: + * This symbol, if defined, indicates that the fmod routine is + * available. + */ +#define HAS_FMOD /**/ + +/* 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. + */ +#define Gconvert(x,n,t,b) sprintf((b),"%.*g",(n),(x)) /* HAS_ISASCII: - * This manifest constant lets the C program know that the - * isascii is available. + * This manifest constant lets the C program know that isascii + * is available. */ #define HAS_ISASCII /**/ -/* 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. +/* USE_LINUX_STDIO: + * This symbol is defined if this system has a FILE structure declaring + * _IO_read_base, _IO_read_ptr, and _IO_read_end in stdio.h. */ -#define HAS_READDIR /**/ +/*#define USE_LINUX_STDIO /**/ -/* HAS_SEEKDIR: - * This symbol, if defined, indicates that the seekdir routine is - * available. You may have to include . See I_DIRENT. +/* HAS_LOCALECONV: + * This symbol, if defined, indicates that the localeconv routine is + * available for numeric and monetary formatting conventions. */ -#define HAS_SEEKDIR /**/ +#define HAS_LOCALECONV /**/ -/* HAS_TELLDIR: - * This symbol, if defined, indicates that the telldir routine is - * available. You may have to include . See I_DIRENT. +/* HAS_MKFIFO: + * This symbol, if defined, indicates that the mkfifo routine is + * available. */ -#define HAS_TELLDIR /**/ +#define HAS_MKFIFO /**/ -/* HAS_REWINDDIR: - * This symbol, if defined, indicates that the rewinddir routine is - * available. You may have to include . See I_DIRENT. +/* HAS_PATHCONF: + * This symbol, if defined, indicates that pathconf() is available + * to determine file-system related limits and options associated + * with a given filename. */ -#define HAS_REWINDDIR /**/ +/* 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_SAFE_BCOPY: * This symbol, if defined, indicates that the bcopy routine is available @@ -845,70 +1326,28 @@ * probably use memmove() or memcpy(). If neither is defined, roll your * own version. */ -/*#define HAS_SAFE_MEMCPY /**/ - -/* HAS_SETLOCALE: - * This symbol, if defined, indicates that the setlocale routine is - * available to handle locale-specific ctype implementations. - */ -#define HAS_SETLOCALE /**/ - -/* HAS_SHMAT: - * This symbol, if defined, indicates that the shmat() routine is - * available to attach a shared memory segment to the process space. - */ -#define HAS_SHMAT /**/ +#define HAS_SAFE_MEMCPY /**/ -/* VOIDSHMAT: - * This symbol, if defined, indicates that the shmat() routine - * returns a pointer of type void*. Otherwise, char* is assumed. - */ -/*#define VOIDSHMAT /**/ - -/* 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_SYSCONF: + * This symbol, if defined, indicates that sysconf() is available + * to determine system related limits and options. */ -/* 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 /**/ -#ifdef HAS_STRERROR -# define Strerror strerror -#else -#define Strerror(e) ((e)<0||(e)>=sys_nerr?"unknown":sys_errlist[e]) /**/ -#endif +#define HAS_SYSCONF /**/ -/* HAS_VFORK: - * This symbol, if defined, indicates that vfork() exists. +/* 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 HAS_VFORK /**/ +#define Time_t time_t /* Time type */ /* USE_DYNAMIC_LOADING: * This symbol, if defined, indicates that dynamic loading of * some sort is available. */ -#define USE_DYNAMIC_LOADING /**/ +/*#define USE_DYNAMIC_LOADING /**/ -/* 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... */ - -/* GROUPSTYPE: +/* Groups_t: * This symbol holds the type used for the second argument to * getgroups(). Usually, this is the same of gidtype, but * sometimes it isn't. It can be int, ushort, uid_t, etc... @@ -917,226 +1356,41 @@ * getgroups(). */ #ifdef HAS_GETGROUPS -#define GROUPSTYPE int /* Type for 2nd arg to getgroups() */ +#define Groups_t gid_t /* Type for 2nd arg to getgroups() */ #endif -/* I_DLFCN: - * This symbol, if defined, indicates that exists and should - * be included. - */ -#define I_DLFCN /**/ - -/* I_MEMORY: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -#define I_MEMORY /**/ - /* I_NET_ERRNO: * This symbol, if defined, indicates that exists and * should be included. */ -/*#define I_NET_ERRNO /**/ - -/* 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. - */ -#define I_PWD /**/ -/*#define PWQUOTA /**/ -#define PWAGE /**/ -/*#define PWCHANGE /**/ -/*#define PWCLASS /**/ -/*#define PWEXPIRE /**/ -#define PWCOMMENT /**/ - -/* 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_VFORK: - * This symbol, if defined, indicates to the C program that it should - * include vfork.h. - */ -/*#define I_VFORK /**/ - -/* LOC_SED: - * This symbol holds the complete pathname to the sed program. - */ -#define LOC_SED "/usr/bin/sed" /**/ +#define I_NET_ERRNO /**/ /* Malloc_t: * This symbol is the type of pointer returned by malloc and realloc. */ -#define Malloc_t char * /**/ +#define Malloc_t void * /**/ /* MYMALLOC: * This symbol, if defined, indicates that we're using our own malloc. */ #define MYMALLOC /**/ -/* CAN_PROTOTYPE: - * If defined, this macro indicates that the C compiler can handle - * function prototypes. - */ -/*#define CAN_PROTOTYPE /**/ -#ifdef CAN_PROTOTYPE -#else -#endif - -/* PTRSIZE: - * This symbol contains the size of a pointer to a long so that - * the C preprocessor can make decisions based on it. - */ -#define PTRSIZE 4 /**/ - -/* SIG_NAME: - * This symbol contains a list of signal names in order. 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". - */ -#define SIG_NAME "ZERO","HUP","INT","QUIT","ILL","TRAP","ABRT","EMT","FPE","KILL","BUS","SEGV","SYS","PIPE","ALRM","TERM","URG","STOP","TSTP","CONT","CLD","TTIN","TTOU","IO","XCPU","XFSZ","VTALRM","PROF","WINCH","LOST","USR1","USR2" /**/ - -/* 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. +/* 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. */ -#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 */ -# define VOID -#else -# define VOID void -#endif +#define Mode_t mode_t /* file mode parameter for system calls*/ -/* - * The following symbols are obsolete. They are mapped to the the new - * symbols only to ease the transition process. The sources should be - * updated so as to use the new symbols only, as the support for these - * obsolete symbols may end without notice. +/* 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). */ - -#ifdef MEM_ALIGNBYTES -#define ALIGNBYTES MEM_ALIGNBYTES -#endif - -#ifdef USE_CHAR_VSPRINTF -#define CHARVSPRINTF USE_CHAR_VSPRINTF -#endif - -#ifdef Gid_t -#define GIDTYPE Gid_t -#endif - -#ifdef I_GDBM -#define HAS_GDBM I_GDBM -#endif - -#ifdef I_NDBM -#define HAS_NDBM I_NDBM -#endif - -#ifdef I_DBM -#define HAS_ODBM I_DBM -#endif - -#ifdef I_SYS_IOCTL -#define I_SYSIOCTL I_SYS_IOCTL -#endif - -#ifdef Malloc_t -#define MALLOCPTRTYPE Malloc_t -#endif - -#ifdef USE_OLDSOCKET -#define OLDSOCKET USE_OLDSOCKET -#endif - -#ifdef HAS_SAFE_BCOPY -#define SAFE_BCOPY HAS_SAFE_BCOPY -#endif - -#ifdef HAS_SAFE_MEMCPY -#define SAFE_MEMCPY HAS_SAFE_MEMCPY -#endif - -#ifdef USE_STAT_BLOCKS -#define STATBLOCKS USE_STAT_BLOCKS -#endif - -#ifdef USE_STD_STDIO -#define STDSTDIO USE_STD_STDIO -#endif - -#ifdef USE_STRUCT_COPY -#define STRUCTCOPY USE_STRUCT_COPY -#endif - -#ifdef Uid_t -#define UIDTYPE Uid_t -#endif - -#ifdef HAS_SYSTEM -#define SYSTEM HAS_SYSTEM -#endif +#define SSize_t int /* signed count of bytes */ #endif diff --git a/config.h b/config.h deleted file mode 100644 index d4252a3..0000000 --- a/config.h +++ /dev/null @@ -1,1144 +0,0 @@ -/* - * 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.2 1993/08/24 12:13:20 ram Exp $ - */ - -/* Configuration time: Wed May 4 15:10:39 PDT 1994 - * Configured by: lwall - * Target system: sunos scalpel 4.1.3 3 sun4c - */ - -#ifndef _config_h_ -#define _config_h_ - -/* 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. - */ -#define BIN "/usr/local/bin" /**/ - -/* BYTEORDER: - * This symbol hold the hexadecimal constant defined in byteorder, - * i.e. 0x1234 or 0x4321, etc... - */ -#define BYTEORDER 0x4321 /* large digits for MSB */ - -/* 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 "". - */ -#define CPPSTDIN "/tmp_mnt/net/vaccine/export/src/local/lwall/perl5/cppstdin" -#define CPPMINUS "" - -/* 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 /**/ - -/* 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 - */ -#define CASTNEGFLOAT /**/ -#define CASTFLAGS 0 /**/ - -/* CHARSPRINTF: - * This symbol is defined if this system declares "char *sprintf()" in - * stdio.h. The trend seems to be to declare it as "int sprintf()". It - * is up to the package author to declare sprintf correctly based on the - * symbol. - */ -#define CHARSPRINTF /**/ - -/* 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 /**/ - -/* CSH: - * This symbol, if defined, indicates that the C-shell exists. - * If defined, contains the full pathname of csh. - */ -#define CSH "/bin/csh" /**/ - -/* 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 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 /**/ - -/* 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_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_GETHOSTENT: - * This symbol, if defined, indicates that the gethostent routine is - * available to lookup host names in some data base or other. - */ -/*#define HAS_GETHOSTENT /**/ - -/* 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. - */ -#define HAS_UNAME /**/ - -/* HAS_GETPGRP: - * This symbol, if defined, indicates that the getpgrp routine is - * available to get the current process group. - */ -#define HAS_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_GETPRIORITY: - * This symbol, if defined, indicates that the getpriority routine is - * available to get a process's priority. - */ -#define HAS_GETPRIORITY /**/ - -/* 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_LSTAT: - * This symbol, if defined, indicates that the lstat routine is - * available to do file stats on symbolic links. - */ -#define HAS_LSTAT /**/ - -/* 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_MSG: - * This symbol, if defined, indicates that the entire msg*(2) library is - * supported (IPC mechanism based on message queues). - */ -#define HAS_MSG /**/ - -/* HAS_MSGCTL: - * This symbol, if defined, indicates that the msgctl() routine is - * available to perform message control operations. - */ -#define HAS_MSGCTL /**/ - -/* HAS_MSGGET: - * This symbol, if defined, indicates that the msgget() routine is - * available to get a new message queue. - */ -#define HAS_MSGGET /**/ - -/* HAS_MSGRCV: - * This symbol, if defined, indicates that the msgrcv() routine is - * available to extract a message from the message queue. - */ -#define HAS_MSGRCV /**/ - -/* HAS_MSGSND: - * This symbol, if defined, indicates that the msgsnd() routine is - * available to send a message into the message queue. - */ -#define HAS_MSGSND /**/ - -/* HAS_OPEN3: - * This manifest constant lets the C program know that the three - * argument form of open(2) is available. - */ -#define HAS_OPEN3 /**/ - -/* 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_SEM: - * This symbol, if defined, indicates that the entire sem*(2) library is - * supported. - */ -#define HAS_SEM /**/ - -/* HAS_SEMCTL: - * This symbol, if defined, indicates that the semctl() routine is - * available to perform semaphore control operations. - */ -#define HAS_SEMCTL /**/ - -/* HAS_SEMGET: - * This symbol, if defined, indicates that the semget() routine is - * available to get a set of semaphores. - */ -#define HAS_SEMGET /**/ - -/* HAS_SEMOP: - * This symbol, if defined, indicates that the semop() routine is - * available to execute semaphore operations. - */ -#define HAS_SEMOP /**/ - -/* 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_SETPGID: - * This symbol, if defined, indicates that the setpgid 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. - */ -#define HAS_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 /**/ - -/* HAS_SHM: - * This symbol, if defined, indicates that the entire shm*(2) library is - * supported. - */ -#define HAS_SHM /**/ - -/* HAS_SHMCTL: - * This symbol, if defined, indicates that the shmctl() routine is - * available to perform shared memory control operations. - */ -#define HAS_SHMCTL /**/ - -/* HAS_SHMDT: - * This symbol, if defined, indicates that the shmdt() routine is - * available to detach a shared memory segment from the process space. - */ -#define HAS_SHMDT /**/ - -/* HAS_SHMGET: - * This symbol, if defined, indicates that the shmget() routine is - * available to request a shared memory segment from the kernel. - */ -#define HAS_SHMGET /**/ - -/* 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. - */ -/* USE_OLDSOCKET: - * This symbol, if defined, indicates that the 4.1c BSD socket interface - * is supported instead of the 4.2/4.3 BSD socket interface. For instance, - * there is no setsockopt() call. - */ -#define HAS_SOCKET /**/ -#define HAS_SOCKETPAIR /**/ -/*#define USE_OLDSOCKET /**/ - -/* USE_STAT_BLOCKS: - * This symbol is defined if this system has a stat structure declaring - * st_blksize and st_blocks. - */ -#define USE_STAT_BLOCKS /**/ - -/* USE_STD_STDIO: - * This symbol is defined if this system has a FILE structure declaring - * _ptr and _cnt in stdio.h. - */ -#define USE_STD_STDIO /**/ - -/* 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_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_SYSTEM: - * This symbol, if defined, indicates that the system routine is - * available to issue a shell command. - */ -#define HAS_SYSTEM /**/ - -/* 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 long /* 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_TRUNCATE: - * This symbol, if defined, indicates that the truncate routine is - * available to truncate files. - */ -#define HAS_TRUNCATE /**/ - -/* I_NDIR: - * This symbol, if defined, indicates that the program should include the - * system's version of ndir.h, rather than the one with this package. - */ -/*#define I_NDIR /**/ - -/* VOIDSIG: - * This symbol is defined if this system declares "void (*signal(...))()" in - * signal.h. The old way was to declare it as "int (*signal(...))()". It - * is up to the package author to declare things correctly based on the - * symbol. - */ -#define VOIDSIG /**/ - -/* HASVOLATILE: - * This symbol, if defined, indicates that this C compiler knows about - * the volatile declaration. - */ -/*#define HASVOLATILE /**/ -#ifndef HASVOLATILE -#define volatile -#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 /**/ - -/* 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 /**/ - -/* I_DBM: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -#define I_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. - */ -#define I_DIRENT /**/ -/*#define DIRNAMLEN /**/ -#ifdef I_DIRENT -#define Direntry_t struct dirent -#else -#define Direntry_t struct direct -#endif - -/* I_FCNTL: - * This manifest constant tells the C program to include . - */ -/*#define I_FCNTL /**/ - -/* I_GDBM: - * This symbol, if defined, indicates that gdbm.h exists and should - * be included. - */ -/*#define I_GDBM /**/ - -/* I_GRP: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -#define I_GRP /**/ - -/* I_NDBM: - * This symbol, if defined, indicates that ndbm.h exists and should - * be included. - */ -#define I_NDBM /**/ - -/* I_NETINET_IN: - * This symbol, if defined, indicates to the C program that it should - * include . Otherwise, you may try . - */ -/* I_SYS_IN: - * This symbol, if defined, indicates to the C program that it should - * include instead of . - */ -#define I_NETINET_IN /**/ -/*#define I_SYS_IN /**/ - -/* I_STDARG: - * This symbol, if defined, indicates that exists and should - * be included. - */ -/*#define I_STDARG /**/ - -/* I_STDDEF: - * This symbol, if defined, indicates that exists and should - * be included. - */ -#define I_STDDEF /**/ - -/* 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_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_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_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_VARARGS: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -#define I_VARARGS /**/ - -/* INTSIZE: - * This symbol contains the size of an int, so that the C preprocessor - * can make decisions based on it. - */ -#define INTSIZE 4 /**/ - -/* 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. - */ -#define Off_t off_t /* type */ - -/* 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 PRIVLIB "/usr/local/lib/perl" /**/ - -/* PTRSIZE: - * This symbol contains the size of a pointer, so that the C preprocessor - * can make decisions based on it. - */ -#define PTRSIZE 4 /**/ - -/* RANDBITS: - * This symbol contains the number of bits of random number the rand() - * function produces. Usual values are 15, 16, and 31. - */ -#define RANDBITS 31 /**/ - -/* SCRIPTDIR: - * This symbol holds the name of the directory in which the user wants - * to put publicly executable scripts for the package in question. It - * is often a directory that is mounted across diverse architectures. - * Programs must be prepared to deal with ~name expansion. - */ -#define SCRIPTDIR "/usr/local/bin" /**/ - -/* 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 unsigned char /**/ - -/* 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 */ - -/* EUNICE: - * This symbol, if defined, indicates that the program is being compiled - * under the EUNICE package under VMS. The program will need to handle - * things like files that don't go away the first time you unlink them, - * due to version numbering. It will also need to compensate for lack - * of a respectable link() command. - */ -/* VMS: - * This symbol, if defined, indicates that the program is running under - * VMS. It is currently only set in conjunction with the EUNICE symbol. - */ -/*#define EUNICE /**/ -/*#define VMS /**/ - -/* MEM_ALIGNBYTES: - * This symbol contains the number of bytes required to align a - * double. Usual values are 2, 4 and 8. - */ -#define MEM_ALIGNBYTES 8 /**/ - -/* CASTI32: - * This symbol is defined if the C compiler can cast negative - * or large floating point numbers to 32-bit ints. - */ -#define CASTI32 /**/ - -/* 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_ISASCII: - * This manifest constant lets the C program know that the - * isascii is available. - */ -#define HAS_ISASCII /**/ - -/* 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_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_SETLOCALE: - * This symbol, if defined, indicates that the setlocale routine is - * available to handle locale-specific ctype implementations. - */ -#define HAS_SETLOCALE /**/ - -/* HAS_SHMAT: - * This symbol, if defined, indicates that the shmat() routine is - * available to attach a shared memory segment to the process space. - */ -#define HAS_SHMAT /**/ - -/* VOIDSHMAT: - * This symbol, if defined, indicates that the shmat() routine - * returns a pointer of type void*. Otherwise, char* is assumed. - */ -/*#define VOIDSHMAT /**/ - -/* 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 /**/ -#ifdef HAS_STRERROR -# define Strerror strerror -#else -#define Strerror(e) ((e)<0||(e)>=sys_nerr?"unknown":sys_errlist[e]) /**/ -#endif - -/* HAS_VFORK: - * This symbol, if defined, indicates that vfork() exists. - */ -/*#define HAS_VFORK /**/ - -/* USE_DYNAMIC_LOADING: - * This symbol, if defined, indicates that dynamic loading of - * some sort is available. - */ -#define USE_DYNAMIC_LOADING /**/ - -/* 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... */ - -/* GROUPSTYPE: - * This symbol holds the type used for the second argument to - * getgroups(). Usually, this is the same of gidtype, 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(). - */ -#ifdef HAS_GETGROUPS -#define GROUPSTYPE int /* Type for 2nd arg to getgroups() */ -#endif - -/* I_DLFCN: - * This symbol, if defined, indicates that exists and should - * be included. - */ -#define I_DLFCN /**/ - -/* I_MEMORY: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -#define I_MEMORY /**/ - -/* I_NET_ERRNO: - * This symbol, if defined, indicates that exists and - * should be included. - */ -/*#define I_NET_ERRNO /**/ - -/* 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. - */ -#define I_PWD /**/ -/*#define PWQUOTA /**/ -#define PWAGE /**/ -/*#define PWCHANGE /**/ -/*#define PWCLASS /**/ -/*#define PWEXPIRE /**/ -#define PWCOMMENT /**/ - -/* 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_VFORK: - * This symbol, if defined, indicates to the C program that it should - * include vfork.h. - */ -/*#define I_VFORK /**/ - -/* LOC_SED: - * This symbol holds the complete pathname to the sed program. - */ -#define LOC_SED "/bin/sed" /**/ - -/* Malloc_t: - * This symbol is the type of pointer returned by malloc and realloc. - */ -#define Malloc_t char * /**/ - -/* MYMALLOC: - * This symbol, if defined, indicates that we're using our own malloc. - */ -#define MYMALLOC /**/ - -/* CAN_PROTOTYPE: - * If defined, this macro indicates that the C compiler can handle - * function prototypes. - */ -/*#define CAN_PROTOTYPE /**/ -#ifdef CAN_PROTOTYPE -#else -#endif - -/* SIG_NAME: - * This symbol contains a list of signal names in order. 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". - */ -#define SIG_NAME "ZERO","HUP","INT","QUIT","ILL","TRAP","ABRT","EMT","FPE","KILL","BUS","SEGV","SYS","PIPE","ALRM","TERM","URG","STOP","TSTP","CONT","CLD","TTIN","TTOU","IO","XCPU","XFSZ","VTALRM","PROF","WINCH","LOST","USR1","USR2" /**/ - -/* 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 */ -# define VOID -#else -# define VOID void -#endif - -/* - * The following symbols are obsolete. They are mapped to the the new - * symbols only to ease the transition process. The sources should be - * updated so as to use the new symbols only, as the support for these - * obsolete symbols may end without notice. - */ - -#ifdef MEM_ALIGNBYTES -#define ALIGNBYTES MEM_ALIGNBYTES -#endif - -#ifdef USE_CHAR_VSPRINTF -#define CHARVSPRINTF USE_CHAR_VSPRINTF -#endif - -#ifdef Gid_t -#define GIDTYPE Gid_t -#endif - -#ifdef I_GDBM -#define HAS_GDBM I_GDBM -#endif - -#ifdef I_NDBM -#define HAS_NDBM I_NDBM -#endif - -#ifdef I_DBM -#define HAS_ODBM I_DBM -#endif - -#ifdef I_SYS_IOCTL -#define I_SYSIOCTL I_SYS_IOCTL -#endif - -#ifdef Malloc_t -#define MALLOCPTRTYPE Malloc_t -#endif - -#ifdef USE_OLDSOCKET -#define OLDSOCKET USE_OLDSOCKET -#endif - -#ifdef HAS_SAFE_BCOPY -#define SAFE_BCOPY HAS_SAFE_BCOPY -#endif - -#ifdef HAS_SAFE_MEMCPY -#define SAFE_MEMCPY HAS_SAFE_MEMCPY -#endif - -#ifdef USE_STAT_BLOCKS -#define STATBLOCKS USE_STAT_BLOCKS -#endif - -#ifdef USE_STD_STDIO -#define STDSTDIO USE_STD_STDIO -#endif - -#ifdef USE_STRUCT_COPY -#define STRUCTCOPY USE_STRUCT_COPY -#endif - -#ifdef HAS_SYSTEM -#define SYSTEM HAS_SYSTEM -#endif - -#ifdef Uid_t -#define UIDTYPE Uid_t -#endif - -#endif diff --git a/config.sh b/config.sh deleted file mode 100644 index 640042f..0000000 --- a/config.sh +++ /dev/null @@ -1,353 +0,0 @@ -#!/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". -# - -# Configuration time: Wed May 4 15:10:39 PDT 1994 -# Configured by: lwall -# Target system: sunos scalpel 4.1.3 3 sun4c - -extensions=' ext/dbm/NDBM_File.xs ext/dbm/ODBM_File.xs ext/dbm/SDBM_File.xs ext/posix/POSIX.xs' -d_eunice='undef' -d_xenix='undef' -eunicefix=':' -Mcc='Mcc' -awk='/bin/awk' -bash='' -bison='/usr/local/bin/bison' -byacc='byacc' -cat='/bin/cat' -chgrp='' -chmod='' -chown='' -compress='' -cp='/bin/cp' -cpio='' -cpp='/usr/lib/cpp' -csh='/bin/csh' -date='/bin/date' -echo='/bin/echo' -egrep='/bin/egrep' -emacs='' -expr='/bin/expr' -find='/bin/find' -flex='' -gcc='' -grep='/bin/grep' -inews='' -ksh='' -less='' -line='/bin/line' -lint='' -ln='/bin/ln' -lp='' -lpr='' -ls='' -mail='' -mailx='' -make='' -mkdir='/bin/mkdir' -more='' -mv='/bin/mv' -nroff='/bin/nroff' -perl='/home/netlabs1/lwall/pl/perl' -pg='' -pmake='' -pr='' -rm='/bin/rm' -rmail='' -sed='/bin/sed' -sendmail='' -sh='' -shar='' -sleep='' -smail='' -sort='/bin/sort' -submit='' -tail='' -tar='' -tbl='' -test='test' -touch='/bin/touch' -tr='/bin/tr' -troff='' -uname='/bin/uname' -uniq='/bin/uniq' -uuname='' -vi='' -zcat='' -hint='recommended' -myuname='sunos scalpel 4.1.3 3 sun4c ' -osname='sunos' -osvers='4.1.3' -Author='' -Date='$Date' -Header='' -Id='$Id' -Locker='' -Log='$Log' -RCSfile='$RCSfile' -Revision='$Revision' -Source='' -State='' -afs='false' -memalignbytes='8' -bin='/usr/local/bin' -binexp='/usr/local/bin' -installbin='/usr/local/bin' -byteorder='4321' -cc='cc' -gccversion='' -ccflags='-DDEBUGGING' -cppflags=' -DDEBUGGING' -ldflags='' -lkflags='' -optimize='-g' -cf_by='lwall' -cf_time='Wed May 4 15:10:39 PDT 1994' -contains='grep' -cpplast='' -cppminus='' -cpprun='/usr/lib/cpp' -cppstdin='/tmp_mnt/net/vaccine/export/src/local/lwall/perl5/cppstdin' -d_access='define' -d_bcmp='define' -d_bcopy='define' -d_bzero='define' -d_casti32='define' -castflags='0' -d_castneg='define' -d_charsprf='define' -d_chsize='undef' -d_const='undef' -cryptlib='' -d_crypt='define' -d_csh='define' -d_dosuid='undef' -d_dup2='define' -d_fchmod='define' -d_fchown='define' -d_fcntl='define' -d_flexfnam='define' -d_flock='define' -d_getgrps='define' -d_gethent='undef' -aphostname='' -d_gethname='undef' -d_phostname='undef' -d_uname='define' -d_getpgrp2='undef' -d_getpgrp='define' -d_getprior='define' -d_htonl='define' -d_isascii='define' -d_killpg='define' -d_link='define' -d_lstat='define' -d_memcmp='define' -d_memcpy='define' -d_memmove='undef' -d_memset='define' -d_mkdir='define' -d_msg='define' -d_msgctl='define' -d_msgget='define' -d_msgrcv='define' -d_msgsnd='define' -d_open3='define' -d_portable='undef' -d_readdir='define' -d_rewinddir='define' -d_seekdir='define' -d_telldir='define' -d_rename='define' -d_rmdir='define' -d_safebcpy='define' -d_safemcpy='undef' -d_select='define' -d_sem='define' -d_semctl='define' -d_semget='define' -d_semop='define' -d_setegid='define' -d_seteuid='define' -d_setlocale='define' -d_setpgid='define' -d_setpgrp2='undef' -d_bsdpgrp='' -d_setpgrp='define' -d_setprior='define' -d_setregid='define' -d_setresgid='undef' -d_setresuid='undef' -d_setreuid='define' -d_setrgid='define' -d_setruid='define' -d_setsid='define' -d_shm='define' -d_shmat='define' -d_voidshmat='undef' -d_shmctl='define' -d_shmdt='define' -d_shmget='define' -d_oldsock='undef' -d_socket='define' -d_sockpair='define' -sockethdr='' -socketlib='' -d_statblks='define' -d_stdstdio='define' -d_index='undef' -d_strchr='define' -d_strctcpy='define' -d_strerrm='define' -d_strerror='undef' -d_sysernlst='' -d_syserrlst='define' -d_symlink='define' -d_syscall='define' -d_system='define' -d_time='define' -timetype='long' -clocktype='long' -d_times='define' -d_truncate='define' -d_usendir='undef' -i_ndir='undef' -ndirc='' -ndirlib='' -ndiro='' -d_vfork='undef' -d_voidsig='define' -signal_t='void' -d_volatile='undef' -d_charvspr='define' -d_vprintf='define' -d_wait4='define' -d_waitpid='define' -cccdlflags='' -ccdlflags='' -dldir='ext/dl' -dlobj='dl_sunos.o' -dlsrc='dl_sunos.c' -lddlflags='' -shlibsuffix='.so' -usedl='define' -gidtype='gid_t' -groupstype='int' -h_fcntl='false' -h_sysfile='true' -i_dbm='define' -d_dirnamlen='undef' -i_dirent='define' -i_dlfcn='define' -i_fcntl='undef' -i_gdbm='undef' -i_grp='define' -i_memory='define' -i_ndbm='define' -i_neterrno='undef' -i_niin='define' -i_sysin='undef' -d_pwage='define' -d_pwchange='undef' -d_pwclass='undef' -d_pwcomment='define' -d_pwexpire='undef' -d_pwquota='undef' -i_pwd='define' -i_sdbm='define' -i_stdarg='undef' -i_stddef='define' -i_string='define' -strings='/usr/include/string.h' -i_sysdir='define' -i_sysfile='define' -d_voidtty='' -i_bsdioctl='' -i_sysioctl='define' -i_syssockio='' -i_sysndir='undef' -i_sysselct='undef' -i_sgtty='undef' -i_termio='undef' -i_termios='define' -i_systime='define' -i_systimek='undef' -i_time='undef' -timeincl='/usr/include/sys/time.h ' -i_unistd='define' -i_utime='define' -i_varargs='define' -i_varhdr='varargs.h' -i_vfork='undef' -intsize='4' -lib='/usr/local/lib' -libexp='/usr/local/lib' -libc='/usr/lib/libc.so.1.8.1' -libpth=' /lib /usr/lib /usr/ucblib /usr/local/lib' -plibpth='' -xlibpth='/usr/lib/386 /lib/386' -libs='-ldbm -ldl -lm -lposix' -lns='/bin/ln -s' -lseektype='off_t' -d_mymalloc='define' -mallocobj='malloc.o' -mallocsrc='malloc.c' -malloctype='char *' -usemymalloc='y' -installmansrc='/usr/local/man/man1' -manext='1' -mansrc='/usr/local/man/man1' -mansrcexp='/usr/local/man/man1' -huge='' -large='' -medium='' -models='none' -small='' -split='' -mydomain='' -myhostname='scalpel' -phostname='hostname' -c='' -n='-n' -groupcat='' -hostcat='ypcat hosts' -passcat='' -orderlib='false' -ranlib='/usr/bin/ranlib' -package='perl' -spackage='' -installprivlib='/usr/local/lib/perl' -privlib='/usr/local/lib/perl' -privlibexp='/usr/local/lib/perl' -prototype='undef' -ptrsize='4' -randbits='31' -installscript='/usr/local/bin' -scriptdir='/usr/local/bin' -scriptdirexp='/usr/local/bin' -sig_name='ZERO HUP INT QUIT ILL TRAP ABRT EMT FPE KILL BUS SEGV SYS PIPE ALRM TERM URG STOP TSTP CONT CLD TTIN TTOU IO XCPU XFSZ VTALRM PROF WINCH LOST USR1 USR2' -sharpbang='#!' -shsharp='true' -spitshell='cat' -startsh='#!/bin/sh' -stdchar='unsigned char' -sysman='/usr/man/man1' -uidtype='uid_t' -nm_opt='' -runnm='true' -usenm='true' -incpath='' -mips='' -mips_type='' -usrinc='/usr/include' -defvoidused='15' -voidflags='15' -yacc='yacc' -yaccflags='' -PATCHLEVEL=0 -CONFIG=true diff --git a/config_c++.h b/config_c++.h deleted file mode 100644 index 53666bd..0000000 --- a/config_c++.h +++ /dev/null @@ -1,895 +0,0 @@ -#ifndef config_h -#define config_h -/* config.h - * 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. - */ - /*SUPPRESS 460*/ - - -/* EUNICE - * This symbol, if defined, indicates that the program is being compiled - * under the EUNICE package under VMS. The program will need to handle - * things like files that don't go away the first time you unlink them, - * due to version numbering. It will also need to compensate for lack - * of a respectable link() command. - */ -/* VMS - * This symbol, if defined, indicates that the program is running under - * VMS. It is currently only set in conjunction with the EUNICE symbol. - */ -/*#undef EUNICE */ -/*#undef VMS */ - -/* LOC_SED - * This symbol holds the complete pathname to the sed program. - */ -#define LOC_SED "/bin/sed" /**/ - -/* ALIGNBYTES - * This symbol contains the number of bytes required to align a double. - * Usual values are 2, 4, and 8. - */ -#define ALIGNBYTES 8 /**/ - -/* BIN - * This symbol holds the name of the directory in which the user wants - * to keep publicly executable images for the package in question. It - * is most often a local directory such as /usr/local/bin. - */ -#define BIN "/usr/local/bin" /**/ - -/* BYTEORDER - * This symbol contains an encoding of the order of bytes in a long. - * Usual values (in hex) are 0x1234, 0x4321, 0x2143, 0x3412... - */ -#define BYTEORDER 0x4321 /**/ - -/* 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". - */ -/* 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 "". - */ -#define CPPSTDIN "/usr/lib/cpp" -#define CPPMINUS "" - -/* HAS_BCMP - * This symbol, if defined, indicates that the bcmp routine is available - * to compare blocks of memory. If undefined, use memcmp. If that's - * not available, roll your own. - */ -#define HAS_BCMP /**/ - -/* HAS_BCOPY - * This symbol, if defined, indicates that the bcopy routine is available - * to copy blocks of memory. Otherwise you should probably use memcpy(). - * If neither is defined, roll your own. - */ -/* SAFE_BCOPY - * This symbol, if defined, indicates that the bcopy routine is available - * to copy potentially overlapping copy blocks of bcopy. Otherwise you - * should probably use memmove() or memcpy(). If neither is defined, - * roll your own. - */ -#define HAS_BCOPY /**/ -#define SAFE_BCOPY /**/ - -/* HAS_BZERO - * This symbol, if defined, indicates that the bzero routine is available - * to zero blocks of memory. Otherwise you should probably use memset() - * or roll your own. - */ -#define HAS_BZERO /**/ - -/* CASTNEGFLOAT - * This symbol, if defined, indicates that this C compiler knows how to - * cast negative or large floating point 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: - * 1 = couldn't cast < 0 - * 2 = couldn't cast >= 0x80000000 - */ -#define CASTNEGFLOAT /**/ -#define CASTFLAGS 0 /**/ - -/* CHARSPRINTF - * This symbol is defined if this system declares "char *sprintf()" in - * stdio.h. The trend seems to be to declare it as "int sprintf()". It - * is up to the package author to declare sprintf correctly based on the - * symbol. - */ -#define CHARSPRINTF /**/ - -/* 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. - */ -/*#undef HAS_CHSIZE */ - -/* HAS_CRYPT - * This symbol, if defined, indicates that the crypt routine is available - * to encrypt passwords and the like. - */ -#define HAS_CRYPT /**/ - -/* CSH - * This symbol, if defined, indicates that the C-shell exists. - * If defined, contains the full pathname of csh. - */ -#define CSH "/bin/csh" /**/ - -/* 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. - */ -/*#undef DOSUID */ - -/* HAS_DUP2 - * This symbol, if defined, indicates that the dup2 routine is available - * to dup file descriptors. Otherwise you should use dup(). - */ -#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 /**/ - -/* 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_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_GETHOSTENT - * This symbol, if defined, indicates that the gethostent() routine is - * available to lookup host names in some data base or other. - */ -/*#undef HAS_GETHOSTENT */ - -/* HAS_GETPGRP - * This symbol, if defined, indicates that the getpgrp() routine is - * available to get the current process group. - */ -#define HAS_GETPGRP /**/ - -/* HAS_GETPGRP2 - * This symbol, if defined, indicates that the getpgrp2() (as in DG/UX) - * routine is available to get the current process group. - */ -/*#undef HAS_GETPGRP2 */ - -/* HAS_GETPRIORITY - * This symbol, if defined, indicates that the getpriority() routine is - * available to get a process's priority. - */ -#define HAS_GETPRIORITY /**/ - -/* HAS_HTONS - * This symbol, if defined, indicates that the htons routine (and friends) - * are available to do network order byte swapping. - */ -/* HAS_HTONL - * This symbol, if defined, indicates that the htonl routine (and friends) - * are available to do network order byte swapping. - */ -/* HAS_NTOHS - * This symbol, if defined, indicates that the ntohs routine (and friends) - * are available to do network order byte swapping. - */ -/* HAS_NTOHL - * This symbol, if defined, indicates that the ntohl routine (and friends) - * are available to do network order byte swapping. - */ -#define HAS_HTONS /**/ -#define HAS_HTONL /**/ -#define HAS_NTOHS /**/ -#define HAS_NTOHL /**/ - -/* index - * This preprocessor symbol is defined, along with rindex, if the system - * uses the strchr and strrchr routines instead. - */ -/* rindex - * This preprocessor symbol is defined, along with index, if the system - * uses the strchr and strrchr routines instead. - */ -/*#undef index strchr cultural */ -/*#undef rindex strrchr differences? */ - -/* HAS_ISASCII - * This symbol, if defined, indicates that the isascii routine is available - * to test characters for asciiness. - */ -#define HAS_ISASCII /**/ - -/* 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_LSTAT - * This symbol, if defined, indicates that the lstat() routine is - * available to stat symbolic links. - */ -#define HAS_LSTAT /**/ - -/* HAS_MEMCMP - * This symbol, if defined, indicates that the memcmp routine is available - * to compare blocks of memory. If undefined, roll your own. - */ -#define HAS_MEMCMP /**/ - -/* HAS_MEMCPY - * This symbol, if defined, indicates that the memcpy routine is available - * to copy blocks of memory. Otherwise you should probably use bcopy(). - * If neither is defined, roll your own. - */ -/* SAFE_MEMCPY - * This symbol, if defined, indicates that the memcpy routine is available - * to copy potentially overlapping copy blocks of memory. Otherwise you - * should probably use memmove() or bcopy(). If neither is defined, - * roll your own. - */ -#define HAS_MEMCPY /**/ -/*#undef SAFE_MEMCPY */ - -/* HAS_MEMMOVE - * This symbol, if defined, indicates that the memmove routine is available - * to move potentially overlapping blocks of memory. Otherwise you - * should use bcopy() or roll your own. - */ -/*#undef HAS_MEMMOVE */ - -/* HAS_MEMSET - * This symbol, if defined, indicates that the memset routine is available - * to set a block of memory to a character. If undefined, roll your own. - */ -#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_MSG - * This symbol, if defined, indicates that the entire msg*(2) library is - * supported. - */ -#define HAS_MSG /**/ - -/* HAS_MSGCTL - * This symbol, if defined, indicates that the msgctl() routine is - * available to control message passing. - */ -#define HAS_MSGCTL /**/ - -/* HAS_MSGGET - * This symbol, if defined, indicates that the msgget() routine is - * available to get messages. - */ -#define HAS_MSGGET /**/ - -/* HAS_MSGRCV - * This symbol, if defined, indicates that the msgrcv() routine is - * available to receive messages. - */ -#define HAS_MSGRCV /**/ - -/* HAS_MSGSND - * This symbol, if defined, indicates that the msgsnd() routine is - * available to send messages. - */ -#define HAS_MSGSND /**/ - -/* HAS_NDBM - * This symbol, if defined, indicates that ndbm.h exists and should - * be included. - */ -#define HAS_NDBM /**/ - -/* HAS_ODBM - * This symbol, if defined, indicates that dbm.h exists and should - * be included. - */ -#define HAS_ODBM /**/ - -/* HAS_OPEN3 - * This manifest constant lets the C program know that the three - * argument form of open(2) is available. - */ -#define HAS_OPEN3 /**/ - -/* HAS_READDIR - * This symbol, if defined, indicates that the readdir routine is available - * from the C library to read directories. - */ -#define HAS_READDIR /**/ - -/* 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_REWINDDIR - * This symbol, if defined, indicates that the rewindir routine is - * available to rewind directories. - */ -/*#undef HAS_REWINDDIR */ - -/* 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_SEEKDIR - * This symbol, if defined, indicates that the seekdir routine is - * available to seek into directories. - */ -#define HAS_SEEKDIR /**/ - -/* HAS_SELECT - * This symbol, if defined, indicates that the select() subroutine - * exists. - */ -#define HAS_SELECT /**/ - -/* HAS_SEM - * This symbol, if defined, indicates that the entire sem*(2) library is - * supported. - */ -#define HAS_SEM /**/ - -/* HAS_SEMCTL - * This symbol, if defined, indicates that the semctl() routine is - * available to control semaphores. - */ -#define HAS_SEMCTL /**/ - -/* HAS_SEMGET - * This symbol, if defined, indicates that the semget() routine is - * available to get semaphores ids. - */ -#define HAS_SEMGET /**/ - -/* HAS_SEMOP - * This symbol, if defined, indicates that the semop() routine is - * available to perform semaphore operations. - */ -#define HAS_SEMOP /**/ - -/* 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_SETPGRP - * This symbol, if defined, indicates that the setpgrp() routine is - * available to set the current process group. - */ -#define HAS_SETPGRP /**/ - -/* HAS_SETPGRP2 - * This symbol, if defined, indicates that the setpgrp2() (as in DG/UX) - * routine is available to set the current process group. - */ -/*#undef 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 program. - */ -/* HAS_SETRESGID - * This symbol, if defined, indicates that the setresgid routine is - * available to change the real, effective and saved gid of the current - * program. - */ -#define HAS_SETREGID /**/ -/*#undef 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 program. - */ -/* HAS_SETRESUID - * This symbol, if defined, indicates that the setresuid routine is - * available to change the real, effective and saved uid of the current - * program. - */ -#define HAS_SETREUID /**/ -/*#undef 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_SHM - * This symbol, if defined, indicates that the entire shm*(2) library is - * supported. - */ -#define HAS_SHM /**/ - -/* HAS_SHMAT - * This symbol, if defined, indicates that the shmat() routine is - * available to attach a shared memory segment. - */ -/* VOID_SHMAT - * This symbol, if defined, indicates that the shmat() routine - * returns a pointer of type void*. - */ -#define HAS_SHMAT /**/ - -/*#undef VOIDSHMAT */ - -/* HAS_SHMCTL - * This symbol, if defined, indicates that the shmctl() routine is - * available to control a shared memory segment. - */ -#define HAS_SHMCTL /**/ - -/* HAS_SHMDT - * This symbol, if defined, indicates that the shmdt() routine is - * available to detach a shared memory segment. - */ -#define HAS_SHMDT /**/ - -/* HAS_SHMGET - * This symbol, if defined, indicates that the shmget() routine is - * available to get a shared memory segment id. - */ -#define HAS_SHMGET /**/ - -/* 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. - */ -/* OLDSOCKET - * This symbol, if defined, indicates that the 4.1c BSD socket interface - * is supported instead of the 4.2/4.3 BSD socket interface. - */ -#define HAS_SOCKET /**/ - -#define HAS_SOCKETPAIR /**/ - -/*#undef OLDSOCKET */ - -/* STATBLOCKS - * This symbol is defined if this system has a stat structure declaring - * st_blksize and st_blocks. - */ -#define STATBLOCKS /**/ - -/* STDSTDIO - * This symbol is defined if this system has a FILE structure declaring - * _ptr and _cnt in stdio.h. - */ -#define STDSTDIO /**/ - -/* STRUCTCOPY - * 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 STRUCTCOPY /**/ - -/* HAS_STRERROR - * This symbol, if defined, indicates that the strerror() routine is - * available to translate error numbers to strings. - */ -/*#undef HAS_STRERROR */ - -/* 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_TELLDIR - * This symbol, if defined, indicates that the telldir routine is - * available to tell your location in directories. - */ -#define HAS_TELLDIR /**/ - -/* HAS_TRUNCATE - * This symbol, if defined, indicates that the truncate routine is - * available to truncate files. - */ -#define HAS_TRUNCATE /**/ - -/* HAS_VFORK - * This symbol, if defined, indicates that vfork() exists. - */ -#define HAS_VFORK /**/ - -/* VOIDSIG - * This symbol is defined if this system declares "void (*signal())()" in - * signal.h. The old way was to declare it as "int (*signal())()". It - * is up to the package author to declare things correctly based on the - * symbol. - */ -/* TO_SIGNAL - * This symbol's value is either "void" or "int", corresponding to the - * appropriate return "type" of a signal handler. Thus, one can declare - * a signal handler using "TO_SIGNAL (*handler())()", and define the - * handler using "TO_SIGNAL handler(sig)". - */ -#define VOIDSIG /**/ -#define TO_SIGNAL int /**/ - -/* HASVOLATILE - * This symbol, if defined, indicates that this C compiler knows about - * the volatile declaration. - */ -/*#undef HASVOLATILE */ - -/* 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(). - */ -/* CHARVSPRINTF - * 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 CHARVSPRINTF /**/ - -/* HAS_WAIT4 - * This symbol, if defined, indicates that wait4() exists. - */ -#define HAS_WAIT4 /**/ - -/* HAS_WAITPID - * This symbol, if defined, indicates that waitpid() exists. - */ -#define HAS_WAITPID /**/ - -/* GIDTYPE - * This symbol has a value like gid_t, int, ushort, or whatever type is - * used to declare group ids in the kernel. - */ -#define GIDTYPE int /**/ - -/* GROUPSTYPE - * This symbol has a value like gid_t, int, ushort, or whatever type is - * used in the return value of getgroups(). - */ -#define GROUPSTYPE int /**/ - -/* I_FCNTL - * This manifest constant tells the C program to include . - */ -/*#undef I_FCNTL */ - -/* I_GDBM - * This symbol, if defined, indicates that gdbm.h exists and should - * be included. - */ -/*#undef I_GDBM */ - -/* I_GRP - * This symbol, if defined, indicates to the C program that it should - * include grp.h. - */ -#define I_GRP /**/ - -/* I_NETINET_IN - * This symbol, if defined, indicates to the C program that it should - * include netinet/in.h. - */ -/* I_SYS_IN - * This symbol, if defined, indicates to the C program that it should - * include sys/in.h. - */ -#define I_NETINET_IN /**/ -/*#undef I_SYS_IN */ - -/* I_PWD - * This symbol, if defined, indicates to the C program that it should - * include pwd.h. - */ -/* 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. - */ -#define I_PWD /**/ -/*#undef PWQUOTA */ -#define PWAGE /**/ -/*#undef PWCHANGE */ -/*#undef PWCLASS */ -/*#undef PWEXPIRE */ -#define PWCOMMENT /**/ - -/* I_SYS_FILE - * This manifest constant tells the C program to include . - */ -#define I_SYS_FILE /**/ - -/* I_SYSIOCTL - * This symbol, if defined, indicates that sys/ioctl.h exists and should - * be included. - */ -#define I_SYSIOCTL /**/ - -/* I_TIME - * This symbol is defined if the program should include . - */ -/* I_SYS_TIME - * This symbol is defined if the program should include . - */ -/* SYSTIMEKERNEL - * This symbol is defined if the program should include - * with KERNEL defined. - */ -/* I_SYS_SELECT - * This symbol is defined if the program should include . - */ -/*#undef I_TIME */ -#define I_SYS_TIME /**/ -/*#undef SYSTIMEKERNEL */ -/*#undef I_SYS_SELECT */ - -/* I_UTIME - * This symbol, if defined, indicates to the C program that it should - * include utime.h. - */ -#define I_UTIME /**/ - -/* I_VARARGS - * This symbol, if defined, indicates to the C program that it should - * include varargs.h. - */ -#define I_VARARGS /**/ - -/* I_VFORK - * This symbol, if defined, indicates to the C program that it should - * include vfork.h. - */ -#define I_VFORK /**/ - -/* INTSIZE - * This symbol contains the size of an int, so that the C preprocessor - * can make decisions based on it. - */ -#define INTSIZE 4 /**/ - -/* I_DIRENT - * This symbol, if defined, indicates that the program should use the - * P1003-style directory routines, and include . - */ -/* I_SYS_DIR - * This symbol, if defined, indicates that the program should use the - * directory functions by including . - */ -/* I_NDIR - * This symbol, if defined, indicates that the program should include the - * system's version of ndir.h, rather than the one with this package. - */ -/* I_SYS_NDIR - * This symbol, if defined, indicates that the program should include the - * system's version of sys/ndir.h, rather than the one with this package. - */ -/* I_MY_DIR - * This symbol, if defined, indicates that the program should compile - * the ndir.c code provided with the package. - */ -/* 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. - */ -#define I_DIRENT /**/ -/*#undef I_SYS_DIR */ -/*#undef I_NDIR */ -/*#undef I_SYS_NDIR */ -/*#undef I_MY_DIR */ -/*#undef DIRNAMLEN */ - -/* MYMALLOC - * This symbol, if defined, indicates that we're using our own malloc. - */ -/* MALLOCPTRTYPE - * This symbol defines the kind of ptr returned by malloc and realloc. - */ -#define MYMALLOC /**/ - -#define MALLOCPTRTYPE char /**/ - - -/* RANDBITS - * This symbol contains the number of bits of random number the rand() - * function produces. Usual values are 15, 16, and 31. - */ -#define RANDBITS 31 /**/ - -/* SCRIPTDIR - * This symbol holds the name of the directory in which the user wants - * to keep publicly executable scripts for the package in question. It - * is often a directory that is mounted across diverse architectures. - */ -#define SCRIPTDIR "/usr/local/bin" /**/ - -/* SIG_NAME - * This symbol contains an list of signal names in order. - */ -#define SIG_NAME "ZERO","HUP","INT","QUIT","ILL","TRAP","ABRT","EMT","FPE","KILL","BUS","SEGV","SYS","PIPE","ALRM","TERM","URG","STOP","TSTP","CONT","CLD","TTIN","TTOU","IO","XCPU","XFSZ","VTALRM","PROF","WINCH","LOST","USR1","USR2" /**/ - -/* 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 unsigned char /**/ - -/* UIDTYPE - * This symbol has a value like uid_t, int, ushort, or whatever type is - * used to declare user ids in the kernel. - */ -#define UIDTYPE int /**/ - -/* VOIDHAVE - * 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 - * - * The package designer should define VOIDWANT to indicate the requirements - * of the package. This can be done either by #defining VOIDWANT before - * including config.h, or by defining voidwant in Myinit.U. If the level - * of void support necessary is not present, config.h defines void to "int", - * VOID to the empty string, and VOIDP to "char *". - */ -/* void - * This symbol is used for void casts. On implementations which support - * void appropriately, its value is "void". Otherwise, its value maps - * to "int". - */ -/* VOID - * This symbol's value is "void" if the implementation supports void - * appropriately. Otherwise, its value is the empty string. The primary - * use of this symbol is in specifying void parameter lists for function - * prototypes. - */ -/* VOIDP - * This symbol is used for casting generic pointers. On implementations - * which support void appropriately, its value is "void *". Otherwise, - * its value is "char *". - */ -#ifndef VOIDWANT -#define VOIDWANT 7 -#endif -#define VOIDHAVE 7 -#if (VOIDHAVE & VOIDWANT) != VOIDWANT -#define void int /* is void to be avoided? */ -#define VOID -#define VOIDP (char *) -#define M_VOID /* Xenix strikes again */ -#else -#define VOID void -#define VOIDP (void *) -#endif - -/* 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 PRIVLIB "/usr/local/lib/perl" /**/ - -#define I_MATH - -#endif - diff --git a/config_h.SH b/config_h.SH index 65b8f9f..19304be 100755 --- a/config_h.SH +++ b/config_h.SH @@ -25,7 +25,7 @@ sed <config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' * 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.2 1993/08/24 12:13:20 ram Exp $ + * Config_h.U */ /* Configuration time: $cf_time @@ -36,6 +36,12 @@ sed <config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' #ifndef _config_h_ #define _config_h_ +/* MEM_ALIGNBYTES: + * This symbol contains the number of bytes required to align a + * double. Usual values are 2, 4 and 8. + */ +#define MEM_ALIGNBYTES $alignbytes /**/ + /* 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. @@ -63,6 +69,12 @@ sed <config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' #define CPPSTDIN "$cppstdin" #define CPPMINUS "$cppminus" +/* HAS_ALARM: + * This symbol, if defined, indicates that the alarm routine is + * available. + */ +#$d_alarm HAS_ALARM /**/ + /* HAS_BCMP: * This symbol is defined if the bcmp() routine is available to * compare blocks of memory. @@ -81,6 +93,12 @@ sed <config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' */ #$d_bzero HAS_BZERO /**/ +/* CASTI32: + * This symbol is defined if the C compiler can cast negative + * or large floating point numbers to 32-bit ints. + */ +#$d_casti32 CASTI32 /**/ + /* CASTNEGFLOAT: * This symbol is defined if the C compiler can cast negative * numbers to unsigned longs, ints and shorts. @@ -103,6 +121,18 @@ sed <config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' */ #$d_charsprf CHARSPRINTF /**/ +/* HAS_CHOWN: + * This symbol, if defined, indicates that the chown routine is + * available. + */ +#$d_chown HAS_CHOWN /**/ + +/* HAS_CHROOT: + * This symbol, if defined, indicates that the chroot routine is + * available. + */ +#$d_chroot 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. @@ -132,20 +162,25 @@ sed <config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' */ #$d_csh CSH "$csh" /**/ -/* 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. +/* HAS_CUSERID: + * This symbol, if defined, indicates that the cuserid routine is + * available to get character login names. */ -#$d_dosuid DOSUID /**/ +#$d_cuserid 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. + */ +#$d_dbl_dig HAS_DBL_DIG /* */ + +/* HAS_DIFFTIME: + * This symbol, if defined, indicates that the difftime routine is + * available. + */ +#$d_difftime HAS_DIFFTIME /**/ /* HAS_DUP2: * This symbol, if defined, indicates that the dup2 routine is @@ -171,6 +206,12 @@ sed <config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' */ #$d_fcntl HAS_FCNTL /**/ +/* HAS_FGETPOS: + * This symbol, if defined, indicates that the fgetpos routine is + * available to get the file position indicator, similar to ftell(). + */ +#$d_fgetpos HAS_FGETPOS /**/ + /* FLEXFILENAMES: * This symbol, if defined, indicates that the system supports filenames * longer than 14 characters. @@ -183,6 +224,18 @@ sed <config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' */ #$d_flock HAS_FLOCK /**/ +/* HAS_FORK: + * This symbol, if defined, indicates that the fork routine is + * available. + */ +#$d_fork HAS_FORK /**/ + +/* HAS_FSETPOS: + * This symbol, if defined, indicates that the fsetpos routine is + * available to set the file position indicator, similar to fseek(). + */ +#$d_fsetpos HAS_FSETPOS /**/ + /* HAS_GETGROUPS: * This symbol, if defined, indicates that the getgroups() routine is * available to get the list of process groups. If unavailable, multiple @@ -203,6 +256,12 @@ sed <config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' */ #$d_uname HAS_UNAME /**/ +/* HAS_GETLOGIN: + * This symbol, if defined, indicates that the getlogin routine is + * available to get the login name. + */ +#$d_getlogin HAS_GETLOGIN /**/ + /* HAS_GETPGRP: * This symbol, if defined, indicates that the getpgrp routine is * available to get the current process group. @@ -215,12 +274,49 @@ sed <config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' */ #$d_getpgrp2 HAS_GETPGRP2 /**/ +/* HAS_GETPPID: + * This symbol, if defined, indicates that the getppid routine is + * available to get the parent process ID. + */ +#$d_getppid HAS_GETPPID /**/ + /* HAS_GETPRIORITY: * This symbol, if defined, indicates that the getpriority routine is * available to get a process's priority. */ #$d_getprior HAS_GETPRIORITY /**/ +/* HAS_GROUP: + * This symbol, if defined, indicates that the group routine is + * available. + */ +#$d_group HAS_GROUP /**/ + +/* 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. + */ +#$d_htonl HAS_HTONL /**/ +#$d_htonl HAS_HTONS /**/ +#$d_htonl HAS_NTOHL /**/ +#$d_htonl HAS_NTOHS /**/ + /* HAS_KILLPG: * This symbol, if defined, indicates that the killpg routine is available * to kill process groups. If unavailable, you probably should use kill @@ -234,12 +330,36 @@ sed <config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' */ #$d_link HAS_LINK /**/ +/* HAS_LOCKF: + * This symbol, if defined, indicates that the lockf routine is + * available to do file locking. + */ +#$d_lockf HAS_LOCKF /**/ + /* HAS_LSTAT: * This symbol, if defined, indicates that the lstat routine is * available to do file stats on symbolic links. */ #$d_lstat 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. + */ +#$d_mblen 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. + */ +#$d_mbstowcs HAS_MBSTOWCS /**/ + +/* HAS_MBTOWC: + * This symbol, if defined, indicates that the mbtowc routine is available + * to covert a multibyte to a wide character. + */ +#$d_mbtowc HAS_MBTOWC /**/ + /* HAS_MEMCMP: * This symbol, if defined, indicates that the memcmp routine is available * to compare blocks of memory. @@ -273,41 +393,78 @@ sed <config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' */ #$d_mkdir HAS_MKDIR /**/ +/* HAS_MKTIME: + * This symbol, if defined, indicates that the mktime routine is + * available. + */ +#$d_mktime HAS_MKTIME /**/ + /* 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_MSGCTL: - * This symbol, if defined, indicates that the msgctl() routine is - * available to perform message control operations. +/* HAS_NICE: + * This symbol, if defined, indicates that the nice routine is + * available. */ -#$d_msgctl HAS_MSGCTL /**/ +#$d_nice HAS_NICE /**/ -/* HAS_MSGGET: - * This symbol, if defined, indicates that the msgget() routine is - * available to get a new message queue. +/* HAS_OPEN3: + * This manifest constant lets the C program know that the three + * argument form of open(2) is available. */ -#$d_msgget HAS_MSGGET /**/ +#$d_open3 HAS_OPEN3 /**/ -/* HAS_MSGRCV: - * This symbol, if defined, indicates that the msgrcv() routine is - * available to extract a message from the message queue. +/* HAS_PASSWD: + * This symbol, if defined, indicates that the passwd routine is + * available. */ -#$d_msgrcv HAS_MSGRCV /**/ +#$d_passwd HAS_PASSWD /**/ -/* HAS_MSGSND: - * This symbol, if defined, indicates that the msgsnd() routine is - * available to send a message into the message queue. +/* HAS_PAUSE: + * This symbol, if defined, indicates that the pause routine is + * available to suspend a process until a signal is received. */ -#$d_msgsnd HAS_MSGSND /**/ +#$d_pause HAS_PAUSE /**/ -/* HAS_OPEN3: - * This manifest constant lets the C program know that the three - * argument form of open(2) is available. +/* HAS_PIPE: + * This symbol, if defined, indicates that the pipe routine is + * available to create an inter-process channel. */ -#$d_open3 HAS_OPEN3 /**/ +#$d_pipe HAS_PIPE /**/ + +/* 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. + */ +#$d_readdir HAS_READDIR /**/ + +/* HAS_SEEKDIR: + * This symbol, if defined, indicates that the seekdir routine is + * available. You may have to include . See I_DIRENT. + */ +#$d_seekdir HAS_SEEKDIR /**/ + +/* HAS_TELLDIR: + * This symbol, if defined, indicates that the telldir routine is + * available. You may have to include . See I_DIRENT. + */ +#$d_telldir HAS_TELLDIR /**/ + +/* HAS_REWINDDIR: + * This symbol, if defined, indicates that the rewinddir routine is + * available. You may have to include . See I_DIRENT. + */ +#$d_rewinddir HAS_REWINDDIR /**/ + +/* HAS_READLINK: + * This symbol, if defined, indicates that the readlink routine is + * available to read the value of a symbolic link. + */ +#$d_readlink HAS_READLINK /**/ /* HAS_RENAME: * This symbol, if defined, indicates that the rename routine is available @@ -336,24 +493,6 @@ sed <config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' */ #$d_sem HAS_SEM /**/ -/* HAS_SEMCTL: - * This symbol, if defined, indicates that the semctl() routine is - * available to perform semaphore control operations. - */ -#$d_semctl HAS_SEMCTL /**/ - -/* HAS_SEMGET: - * This symbol, if defined, indicates that the semget() routine is - * available to get a set of semaphores. - */ -#$d_semget HAS_SEMGET /**/ - -/* HAS_SEMOP: - * This symbol, if defined, indicates that the semop() routine is - * available to execute semaphore operations. - */ -#$d_semop HAS_SEMOP /**/ - /* HAS_SETEGID: * This symbol, if defined, indicates that the setegid routine is available * to change the effective gid of the current program. @@ -366,18 +505,25 @@ sed <config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' */ #$d_seteuid 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. + */ +#$d_setlinebuf HAS_SETLINEBUF /**/ + +/* HAS_SETLOCALE: + * This symbol, if defined, indicates that the setlocale routine is + * available to handle locale-specific ctype implementations. + */ +#$d_setlocale HAS_SETLOCALE /**/ + /* HAS_SETPGID: * This symbol, if defined, indicates that the setpgid routine is * available to set process group ID. */ #$d_setpgid HAS_SETPGID /**/ -/* HAS_SETPGRP: - * This symbol, if defined, indicates that the setpgrp routine is - * available to set the current process group. - */ -#$d_setpgrp HAS_SETPGRP /**/ - /* HAS_SETPGRP2: * This symbol, if defined, indicates that the setpgrp2() (as in DG/UX) * routine is available to set the current process group. @@ -440,23 +586,19 @@ sed <config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' */ #$d_shm HAS_SHM /**/ -/* HAS_SHMCTL: - * This symbol, if defined, indicates that the shmctl() routine is - * available to perform shared memory control operations. - */ -#$d_shmctl HAS_SHMCTL /**/ - -/* HAS_SHMDT: - * This symbol, if defined, indicates that the shmdt() routine is - * available to detach a shared memory segment from the process space. +/* Shmat_t: + * This symbol holds the return type of the shmat() system call. + * Usually set to 'void *' or 'char *'. */ -#$d_shmdt HAS_SHMDT /**/ - -/* HAS_SHMGET: - * This symbol, if defined, indicates that the shmget() routine is - * available to request a shared memory segment from the kernel. +/* 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. */ -#$d_shmget HAS_SHMGET /**/ +#define Shmat_t $shmattype /**/ +#$d_shmatprototype HAS_SHMAT_PROTOTYPE /**/ /* HAS_SOCKET: * This symbol, if defined, indicates that the BSD socket interface is @@ -466,14 +608,8 @@ sed <config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' * This symbol, if defined, indicates that the BSD socketpair() call is * supported. */ -/* USE_OLDSOCKET: - * This symbol, if defined, indicates that the 4.1c BSD socket interface - * is supported instead of the 4.2/4.3 BSD socket interface. For instance, - * there is no setsockopt() call. - */ #$d_socket HAS_SOCKET /**/ #$d_sockpair HAS_SOCKETPAIR /**/ -#$d_oldsock USE_OLDSOCKET /**/ /* USE_STAT_BLOCKS: * This symbol is defined if this system has a stat structure declaring @@ -487,6 +623,24 @@ sed <config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' */ #$d_stdstdio USE_STD_STDIO /**/ +/* 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. + */ +#$d_strchr HAS_STRCHR /**/ +#$d_index HAS_INDEX /**/ + +/* HAS_STRCOLL: + * This symbol, if defined, indicates that the strcoll routine is + * available to compare strings using collating information. + */ +#$d_strcoll 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 @@ -494,6 +648,31 @@ sed <config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' */ #$d_strctcpy USE_STRUCT_COPY /**/ +/* 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. + */ +#$d_strerror HAS_STRERROR /**/ +#$d_syserrlst HAS_SYS_ERRLIST /**/ +#define Strerror(e) $d_strerrm + +/* HAS_STRXFRM: + * This symbol, if defined, indicates that the strxfrm() routine is + * available to transform strings. + */ +#$d_strxfrm HAS_STRXFRM /**/ + /* HAS_SYMLINK: * This symbol, if defined, indicates that the symlink routine is available * to create symbolic links. @@ -512,12 +691,17 @@ sed <config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' */ #$d_system HAS_SYSTEM /**/ -/* 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). +/* HAS_TCGETPGRP: + * This symbol, if defined, indicates that the tcgetpgrp routine is + * available to get foreground process group ID. */ -#define Time_t $timetype /* Time type */ +#$d_tcgetpgrp HAS_TCGETPGRP /**/ + +/* HAS_TCSETPGRP: + * This symbol, if defined, indicates that the tcsetpgrp routine is + * available to set foreground process group ID. + */ +#$d_tcsetpgrp HAS_TCSETPGRP /**/ /* HAS_TIMES: * This symbol, if defined, indicates that the times() routine exists. @@ -532,11 +716,22 @@ sed <config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' */ #$d_truncate HAS_TRUNCATE /**/ -/* I_NDIR: - * This symbol, if defined, indicates that the program should include the - * system's version of ndir.h, rather than the one with this package. +/* HAS_TZNAME: + * This symbol, if defined, indicates that the tzname[] array is + * available to access timezone names. + */ +#$d_tzname 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. + */ +#$d_umask HAS_UMASK /**/ + +/* HAS_VFORK: + * This symbol, if defined, indicates that vfork() exists. */ -#$i_ndir I_NDIR /**/ +#$d_vfork HAS_VFORK /**/ /* VOIDSIG: * This symbol is defined if this system declares "void (*signal(...))()" in @@ -580,11 +775,33 @@ sed <config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' */ #$d_waitpid HAS_WAITPID /**/ -/* I_DBM: - * This symbol, if defined, indicates to the C program that it should - * include . +/* HAS_WCSTOMBS: + * This symbol, if defined, indicates that the wcstombs routine is + * available to convert wide character strings to multibyte strings. + */ +#$d_wcstombs HAS_WCSTOMBS /**/ + +/* HAS_WCTOMB: + * This symbol, if defined, indicates that the wctomb routine is available + * to covert a wide character to a multibyte. + */ +#$d_wctomb HAS_WCTOMB /**/ + +/* 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. */ -#$i_dbm I_DBM /**/ +#define Gid_t $gidtype /* Type for getgid(), etc... */ /* I_DIRENT: * This symbol, if defined, indicates to the C program that it should @@ -597,24 +814,32 @@ sed <config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' * 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. + */ #$i_dirent I_DIRENT /**/ #$d_dirnamlen DIRNAMLEN /**/ -#ifdef I_DIRENT -#define Direntry_t struct dirent -#else -#define Direntry_t struct direct -#endif +#define Direntry_t $direntrytype + +/* I_DLFCN: + * This symbol, if defined, indicates that exists and should + * be included. + */ +#$i_dlfcn I_DLFCN /**/ /* I_FCNTL: * This manifest constant tells the C program to include . */ #$i_fcntl I_FCNTL /**/ -/* I_GDBM: - * This symbol, if defined, indicates that gdbm.h exists and should - * be included. +/* 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. */ -#$i_gdbm I_GDBM /**/ +#$i_float I_FLOAT /**/ /* I_GRP: * This symbol, if defined, indicates to the C program that it should @@ -622,6 +847,25 @@ sed <config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' */ #$i_grp I_GRP /**/ +/* 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. + */ +#$i_limits I_LIMITS /**/ + +/* I_MATH: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +#$i_math I_MATH /**/ + +/* I_MEMORY: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +#$i_memory I_MEMORY /**/ + /* I_NDBM: * This symbol, if defined, indicates that ndbm.h exists and should * be included. @@ -632,18 +876,43 @@ sed <config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' * This symbol, if defined, indicates to the C program that it should * include . Otherwise, you may try . */ -/* I_SYS_IN: - * This symbol, if defined, indicates to the C program that it should - * include instead of . - */ #$i_niin I_NETINET_IN /**/ -#$i_sysin I_SYS_IN /**/ -/* I_STDARG: - * This symbol, if defined, indicates that exists and should - * be included. +/* I_PWD: + * This symbol, if defined, indicates to the C program that it should + * include . */ -#$i_stdarg I_STDARG /**/ +/* 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. + */ +#$i_pwd I_PWD /**/ +#$d_pwquota PWQUOTA /**/ +#$d_pwage PWAGE /**/ +#$d_pwchange PWCHANGE /**/ +#$d_pwclass PWCLASS /**/ +#$d_pwexpire PWEXPIRE /**/ +#$d_pwcomment PWCOMMENT /**/ /* I_STDDEF: * This symbol, if defined, indicates that exists and should @@ -651,7 +920,13 @@ sed <config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' */ #$i_stddef I_STDDEF /**/ -/* I_STRING: +/* I_STDLIB: + * This symbol, if defined, indicates that exists and should + * be included. + */ +#$i_stdlib I_STDLIB /**/ + +/* I_STRING: * This symbol, if defined, indicates to the C program that it should * include (USG systems) instead of (BSD systems). */ @@ -681,12 +956,44 @@ sed <config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' */ #$i_sysndir I_SYS_NDIR /**/ +/* I_SYS_PARAM: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +#$i_sysparam I_SYS_PARAM /**/ + /* I_SYS_SELECT: * This symbol, if defined, indicates to the C program that it should * include in order to get definition of struct timeval. */ #$i_sysselct I_SYS_SELECT /**/ +/* I_SYS_TIMES: + * This symbol, if defined, indicates to the C program that it should + * include . + */ +#$i_systimes I_SYS_TIMES /**/ + +/* 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. + */ +#$i_termio I_TERMIO /**/ +#$i_termios I_TERMIOS /**/ +#$i_sgtty I_SGTTY /**/ + /* I_TIME: * This symbol, if defined, indicates to the C program that it should * include . @@ -715,11 +1022,22 @@ sed <config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' */ #$i_utime I_UTIME /**/ +/* 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 . */ -#$i_varargs I_VARARGS /**/ +#$i_stdarg I_STDARG /**/ +#$i_varargs I_VARARGS /**/ + +/* I_VFORK: + * This symbol, if defined, indicates to the C program that it should + * include vfork.h. + */ +#$i_vfork I_VFORK /**/ /* INTSIZE: * This symbol contains the size of an int, so that the C preprocessor @@ -742,11 +1060,23 @@ sed <config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' */ #define PRIVLIB "$privlib" /**/ -/* PTRSIZE: - * This symbol contains the size of a pointer, so that the C preprocessor - * can make decisions based on it. +/* CAN_PROTOTYPE: + * If defined, this macro indicates that the C compiler can handle + * function prototypes. */ -#define PTRSIZE $ptrsize /**/ +/* _: + * 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[])); + */ +#$prototype CAN_PROTOTYPE /**/ +#ifdef CAN_PROTOTYPE +#define _(args) args +#else +#define _(args) () +#endif /* RANDBITS: * This symbol contains the number of bits of random number the rand() @@ -762,6 +1092,32 @@ sed <config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' */ #define SCRIPTDIR "$scriptdir" /**/ +/* 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 /**/ + +/* SIG_NAME: + * This symbol contains a list of signal names in order. 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". + */ +#define SIG_NAME "`echo $sig_name | sed 's/ /","/g'`" /**/ + +/* 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 $sizetype /* length paramater for string functions */ + /* STDCHAR: * This symbol is defined to be the type of char used in stdio.h. * It has the values "unsigned char" or "char". @@ -775,6 +1131,31 @@ sed <config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' */ #define Uid_t $uidtype /* UID type */ +/* 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 $defvoidused +#endif +#define VOIDFLAGS $voidflags +#if (VOIDFLAGS & VOIDUSED) != VOIDUSED +#define void int /* is void to be avoided? */ +#define M_VOID /* Xenix strikes again */ +#endif + /* EUNICE: * This symbol, if defined, indicates that the program is being compiled * under the EUNICE package under VMS. The program will need to handle @@ -789,73 +1170,158 @@ sed <config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' #$d_eunice EUNICE /**/ #$d_eunice VMS /**/ -/* MEM_ALIGNBYTES: - * This symbol contains the number of bytes required to align a - * double. Usual values are 2, 4 and 8. +/* LOC_SED: + * This symbol holds the complete pathname to the sed program. */ -#define MEM_ALIGNBYTES $memalignbytes /**/ +#define LOC_SED "$sed" /**/ -/* CASTI32: - * This symbol is defined if the C compiler can cast negative - * or large floating point numbers to 32-bit ints. +/* 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. + */ +#$d_archlib ARCHLIB "$archlib" /**/ + +/* 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 CAT3(a,b,c)a/**/b/**/c +#define CAT4(a,b,c,d)a/**/b/**/c/**/d +#define CAT5(a,b,c,d,e)a/**/b/**/c/**/d/**/e +#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 CAT3(a,b,c)a ## b ## c +#define CAT4(a,b,c,d)a ## b ## c ## d +#define CAT5(a,b,c,d,e)a ## b ## c ## d ## e +#define StGiFy(a)# a +#define STRINGIFY(a)StGiFy(a) +#define SCAT2(a,b)StGiFy(a) StGiFy(b) +#define SCAT3(a,b,c)StGiFy(a) StGiFy(b) StGiFy(c) +#define SCAT4(a,b,c,d)StGiFy(a) StGiFy(b) StGiFy(c) StGiFy(d) +#define SCAT5(a,b,c,d,e)StGiFy(a) StGiFy(b) StGiFy(c) StGiFy(d) StGiFy(e) +#endif +#ifndef CAT2 +#include "Bletch: How does this C preprocessor catenate tokens?" +#endif + +/* GNUC_ATTRIBUTE_CHECK: + * This symbol indicates the C compiler can check for function attributes, + * such as printf formats. */ -#$d_casti32 CASTI32 /**/ +#$d_attrib GNUC_ATTRIBUTE_CHECK /* */ -/* HAS_HTONL: - * This symbol, if defined, indicates that the htonl() routine (and - * friends htons() ntohl() ntohs()) are available to do network - * order byte swapping. +/* VOID_CLOSEDIR: + * This symbol, if defined, indicates that the closedir() routine + * does not return a value. */ -/* HAS_HTONS: - * This symbol, if defined, indicates that the htons() routine (and - * friends htonl() ntohl() ntohs()) are available to do network - * order byte swapping. +#$d_void_closedir VOID_CLOSEDIR /**/ + +/* HAS_DLERROR: + * This symbol, if defined, indicates that the dlerror routine is + * available. */ -/* HAS_NTOHL: - * This symbol, if defined, indicates that the ntohl() routine (and - * friends htonl() htons() ntohs()) are available to do network - * order byte swapping. +#$d_dlerror HAS_DLERROR /**/ + +/* 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. */ -/* HAS_NTOHS: - * This symbol, if defined, indicates that the ntohs() routine (and - * friends htonl() htons() ntohl()) are available to do network - * order byte swapping. +#$d_dlsymun DLSYM_NEEDS_UNDERSCORE /* */ + +/* 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. */ -#$d_htonl HAS_HTONL /**/ -#$d_htonl HAS_HTONS /**/ -#$d_htonl HAS_NTOHL /**/ -#$d_htonl HAS_NTOHS /**/ +/* 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. + */ +#$d_suidsafe SETUID_SCRIPTS_ARE_SECURE_NOW /**/ + +#$d_dosuid DOSUID /**/ + +/* HAS_DREM: + * This symbol, if defined, indicates that the drem routine is + * available. This is a Pyramid routine that is the same as + * fmod. + */ +#$d_drem HAS_DREM /**/ + +/* HAS_FMOD: + * This symbol, if defined, indicates that the fmod routine is + * available. + */ +#$d_fmod HAS_FMOD /**/ + +/* 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. + */ +#define Gconvert(x,n,t,b) $d_Gconvert /* HAS_ISASCII: - * This manifest constant lets the C program know that the - * isascii is available. + * This manifest constant lets the C program know that isascii + * is available. */ #$d_isascii HAS_ISASCII /**/ -/* 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. +/* USE_LINUX_STDIO: + * This symbol is defined if this system has a FILE structure declaring + * _IO_read_base, _IO_read_ptr, and _IO_read_end in stdio.h. */ -#$d_readdir HAS_READDIR /**/ +#$d_linuxstd USE_LINUX_STDIO /**/ -/* HAS_SEEKDIR: - * This symbol, if defined, indicates that the seekdir routine is - * available. You may have to include . See I_DIRENT. +/* HAS_LOCALECONV: + * This symbol, if defined, indicates that the localeconv routine is + * available for numeric and monetary formatting conventions. */ -#$d_seekdir HAS_SEEKDIR /**/ +#$d_locconv HAS_LOCALECONV /**/ -/* HAS_TELLDIR: - * This symbol, if defined, indicates that the telldir routine is - * available. You may have to include . See I_DIRENT. +/* HAS_MKFIFO: + * This symbol, if defined, indicates that the mkfifo routine is + * available. */ -#$d_telldir HAS_TELLDIR /**/ +#$d_mkfifo HAS_MKFIFO /**/ -/* HAS_REWINDDIR: - * This symbol, if defined, indicates that the rewinddir routine is - * available. You may have to include . See I_DIRENT. +/* HAS_PATHCONF: + * This symbol, if defined, indicates that pathconf() is available + * to determine file-system related limits and options associated + * with a given filename. */ -#$d_rewinddir HAS_REWINDDIR /**/ +/* 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. + */ +#$d_pathconf HAS_PATHCONF /**/ +#$d_fpathconf HAS_FPATHCONF /**/ /* HAS_SAFE_BCOPY: * This symbol, if defined, indicates that the bcopy routine is available @@ -873,51 +1339,30 @@ sed <config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' */ #$d_safemcpy HAS_SAFE_MEMCPY /**/ -/* HAS_SETLOCALE: - * This symbol, if defined, indicates that the setlocale routine is - * available to handle locale-specific ctype implementations. - */ -#$d_setlocale HAS_SETLOCALE /**/ - -/* HAS_SHMAT: - * This symbol, if defined, indicates that the shmat() routine is - * available to attach a shared memory segment to the process space. +/* HAS_SETPGRP: + * This symbol, if defined, indicates that the setpgrp routine is + * available to set the current process group. */ -#$d_shmat HAS_SHMAT /**/ - -/* VOIDSHMAT: - * This symbol, if defined, indicates that the shmat() routine - * returns a pointer of type void*. Otherwise, char* is assumed. +/* USE_BSDPGRP: + * This symbol, if defined, indicates that the BSD notion of process + * group is to be used. For instance, you have to say setpgrp(pid, pgrp) + * instead of the USG setpgrp(). */ -#$d_voidshmat VOIDSHMAT /**/ +#$d_setpgrp HAS_SETPGRP /**/ +#$d_bsdpgrp USE_BSDPGRP /**/ -/* 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. +/* HAS_SYSCONF: + * This symbol, if defined, indicates that sysconf() is available + * to determine system related limits and options. */ -#$d_strerror HAS_STRERROR /**/ -#$d_syserrlst HAS_SYS_ERRLIST /**/ -#ifdef HAS_STRERROR -# define Strerror strerror -#else -#$d_strerrm Strerror(e) ((e)<0||(e)>=sys_nerr?"unknown":sys_errlist[e]) /**/ -#endif +#$d_sysconf HAS_SYSCONF /**/ -/* HAS_VFORK: - * This symbol, if defined, indicates that vfork() exists. +/* 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). */ -#$d_vfork HAS_VFORK /**/ +#define Time_t $timetype /* Time type */ /* USE_DYNAMIC_LOADING: * This symbol, if defined, indicates that dynamic loading of @@ -925,16 +1370,7 @@ sed <config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' */ #$usedl USE_DYNAMIC_LOADING /**/ -/* 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... */ - -/* GROUPSTYPE: +/* Groups_t: * This symbol holds the type used for the second argument to * getgroups(). Usually, this is the same of gidtype, but * sometimes it isn't. It can be int, ushort, uid_t, etc... @@ -943,94 +1379,15 @@ sed <config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' * getgroups(). */ #ifdef HAS_GETGROUPS -#define GROUPSTYPE $groupstype /* Type for 2nd arg to getgroups() */ +#define Groups_t $groupstype /* Type for 2nd arg to getgroups() */ #endif -/* I_DLFCN: - * This symbol, if defined, indicates that exists and should - * be included. - */ -#$i_dlfcn I_DLFCN /**/ - -/* I_MEMORY: - * This symbol, if defined, indicates to the C program that it should - * include . - */ -#$i_memory I_MEMORY /**/ - /* I_NET_ERRNO: * This symbol, if defined, indicates that exists and * should be included. */ #$i_neterrno I_NET_ERRNO /**/ -/* 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. - */ -#$i_pwd I_PWD /**/ -#$d_pwquota PWQUOTA /**/ -#$d_pwage PWAGE /**/ -#$d_pwchange PWCHANGE /**/ -#$d_pwclass PWCLASS /**/ -#$d_pwexpire PWEXPIRE /**/ -#$d_pwcomment PWCOMMENT /**/ - -/* 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. - */ -#$i_termio I_TERMIO /**/ -#$i_termios I_TERMIOS /**/ -#$i_sgtty I_SGTTY /**/ - -/* I_VFORK: - * This symbol, if defined, indicates to the C program that it should - * include vfork.h. - */ -#$i_vfork I_VFORK /**/ - -/* LOC_SED: - * This symbol holds the complete pathname to the sed program. - */ -#define LOC_SED "$sed" /**/ - /* Malloc_t: * This symbol is the type of pointer returned by malloc and realloc. */ @@ -1041,123 +1398,23 @@ sed <config.h -e 's!^#undef!/\*#define!' -e 's!^#un-def!#undef!' */ #$d_mymalloc MYMALLOC /**/ -/* CAN_PROTOTYPE: - * If defined, this macro indicates that the C compiler can handle - * function prototypes. - */ -#$prototype CAN_PROTOTYPE /**/ -#ifdef CAN_PROTOTYPE -#else -#endif - -/* SIG_NAME: - * This symbol contains a list of signal names in order. 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". - */ -#define SIG_NAME "`echo $sig_name | sed 's/ /","/g'`" /**/ - -/* 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. +/* 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. */ -#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 */ -# define VOID -#else -# define VOID void -#endif +#define Mode_t $modetype /* file mode parameter for system calls*/ -/* - * The following symbols are obsolete. They are mapped to the the new - * symbols only to ease the transition process. The sources should be - * updated so as to use the new symbols only, as the support for these - * obsolete symbols may end without notice. +/* 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). */ - -#ifdef MEM_ALIGNBYTES -#define ALIGNBYTES MEM_ALIGNBYTES -#endif - -#ifdef USE_CHAR_VSPRINTF -#define CHARVSPRINTF USE_CHAR_VSPRINTF -#endif - -#ifdef Gid_t -#define GIDTYPE Gid_t -#endif - -#ifdef I_GDBM -#define HAS_GDBM I_GDBM -#endif - -#ifdef I_NDBM -#define HAS_NDBM I_NDBM -#endif - -#ifdef I_DBM -#define HAS_ODBM I_DBM -#endif - -#ifdef I_SYS_IOCTL -#define I_SYSIOCTL I_SYS_IOCTL -#endif - -#ifdef Malloc_t -#define MALLOCPTRTYPE Malloc_t -#endif - -#ifdef USE_OLDSOCKET -#define OLDSOCKET USE_OLDSOCKET -#endif - -#ifdef HAS_SAFE_BCOPY -#define SAFE_BCOPY HAS_SAFE_BCOPY -#endif - -#ifdef HAS_SAFE_MEMCPY -#define SAFE_MEMCPY HAS_SAFE_MEMCPY -#endif - -#ifdef USE_STAT_BLOCKS -#define STATBLOCKS USE_STAT_BLOCKS -#endif - -#ifdef USE_STD_STDIO -#define STDSTDIO USE_STD_STDIO -#endif - -#ifdef USE_STRUCT_COPY -#define STRUCTCOPY USE_STRUCT_COPY -#endif - -#ifdef HAS_SYSTEM -#define SYSTEM HAS_SYSTEM -#endif - -#ifdef Uid_t -#define UIDTYPE Uid_t -#endif +#define SSize_t $ssizetype /* signed count of bytes */ #endif !GROK!THIS! diff --git a/configpm b/configpm index 95fa949..117c445 100755 --- a/configpm +++ b/configpm @@ -1,11 +1,18 @@ -#!./miniperl +#!./miniperl -w @ARGV = "./config.sh"; +$config_pm = 'lib/Config.pm'; -open STDOUT, ">lib/Config.pm" - or die "Can't open lib/Config.pm: $!\n"; +# list names to put first (and hence lookup fastest) +@fast = qw(osname osvers so libpth archlib + sharpbang startsh shsharp + dynamic_ext static_ext extensions dl_src + sig_name ccflags cppflags intsize); + + +open CONFIG, ">$config_pm" or die "Can't open $config_pm: $!\n"; $myver = sprintf("%.3f", $]); -print <<"ENDOFBEG"; +print CONFIG <<"ENDOFBEG"; package Config; require Exporter; \@ISA = (Exporter); @@ -14,15 +21,101 @@ require Exporter; \$] == $myver or die sprintf "Perl lib version ($myver) doesn't match executable version (%.3f)\\n", \$]; +# This file was created by configpm when Perl was built. Any changes +# made to this file will be lost the next time perl is built. + ENDOFBEG +@fast{@fast} = @fast; +@non_v=(); +@v_fast=(); +@v_others=(); + while (<>) { - s:^#!/bin/sh::; - s/'undef'/undef/; # So we can say "if $Config{'foo'}". - s/=true$/='true'/; # Catch CONFIG=true line from Configure. - s/^(\w+)=/\$Config{'$1'} = /; - s/$/;/ unless (/^#/ || /^$/); - print $_; + next if m:^#!/bin/sh:; + # Catch CONFIG=true and PATCHLEVEL=n line from Configure. + s/^(\w+)=(true|\d+)\s*$/$1='$2'\n/; + unless (m/^(\w+)='(.*)'\s*$/){ + push(@non_v, "#$_"); # not a name='value' line + next; + } + if (!$fast{$1}){ push(@v_others, $_); next; } + push(@v_fast,$_); +} + +foreach(@non_v){ print CONFIG $_ } + +print CONFIG "\n", + "\$config_sh=<<'!END!OF!CONFIG!';\n", + join("", @v_fast, sort @v_others), + "!END!OF!CONFIG!\n\n"; + + +print CONFIG <<'ENDOFEND'; + +tie %Config, Config; +sub TIEHASH { bless {} } +sub FETCH { + # check for cached value (which maybe undef so we use exists not defined) + return $_[0]->{$_[1]} if (exists $_[0]->{$_[1]}); + + my($value); # search for the item in the big $config_sh string + return undef unless (($value) = $config_sh =~ m/^$_[1]='(.*)'\s*$/m); + + $value = undef if $value eq 'undef'; # So we can say "if $Config{'foo'}". + $_[0]->{$_[1]} = $value; # cache it + return $value; +} + +sub FIRSTKEY { + $prevpos = 0; + my $key; + ($key) = $config_sh =~ m/^(.*)=/; + $key; +} + +sub NEXTKEY { + my ($pos, $len); + $pos = $prevpos; + $pos = index( $config_sh, "\n", $pos) + 1; + $prevpos = $pos; + $len = index( $config_sh, "=", $pos) - $pos; + $len > 0 ? substr( $config_sh, $pos, $len) : undef; } -print "1;\n"; + +sub EXISTS{ + exists($_[0]->{$_[1]}) or $config_sh =~ m/^$_[1]=/m; +} + +sub readonly { die "\%Config::Config is read-only\n" } + +sub STORE { &readonly } +sub DELETE{ &readonly } +sub CLEAR { &readonly } + + +1; +ENDOFEND + +close(CONFIG); + +# Now do some simple tests on the Config.pm file we have created +unshift(@INC,'lib'); +require $config_pm; +import Config; + +die "$0: $config_pm not valid" + unless $Config{'CONFIG'} eq 'true'; + +die "$0: error processing $config_pm" + if defined($Config{'an impossible name'}) + or $Config{'CONFIG'} ne 'true' # test cache + ; + +die "$0: error processing $config_pm" + if eval '$Config{"cc"} = 1' + or eval 'delete $Config{"cc"}' + ; + + exit 0; diff --git a/cop.h b/cop.h index acf0fda..5a04e41 100644 --- a/cop.h +++ b/cop.h @@ -1,61 +1,20 @@ -/* $RCSfile: cmd.h,v $$Revision: 4.1 $$Date: 92/08/07 17:19:19 $ +/* cop.h * - * Copyright (c) 1991, Larry Wall + * Copyright (c) 1991-1994, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. * - * $Log: cmd.h,v $ - * Revision 4.1 92/08/07 17:19:19 lwall - * Stage 6 Snapshot - * - * Revision 4.0.1.2 92/06/08 12:01:02 lwall - * patch20: removed implicit int declarations on funcions - * - * Revision 4.0.1.1 91/06/07 10:28:50 lwall - * patch4: new copyright notice - * patch4: length($`), length($&), length($') now optimized to avoid string copy - * - * Revision 4.0 91/03/20 01:04:34 lwall - * 4.0 baseline. - * */ -struct acop { - GV *acop_gv; /* a symbol table entry */ - OP *acop_expr; /* any associated expression */ -}; - -struct ccop { - OP *ccop_true; /* normal code to do on if and while */ - OP *ccop_alt; /* else cmd ptr or continue code */ -}; - -struct scop { - OP **scop_next; /* array of pointers to commands */ - short scop_offset; /* first value - 1 */ - short scop_max; /* last value + 1 */ -}; - struct cop { BASEOP - OP *cop_expr; /* conditional expression */ - OP *cop_head; /* head of this command list */ - SV *cop_short; /* string to match as shortcut */ - GV *cop_gv; /* a symbol table entry, mostly for fp */ - char *cop_label; /* label for this construct */ - union uop { - struct acop acop; /* normal command */ - struct ccop ccop; /* compound command */ - struct scop scop; /* switch command */ - } uop; - U32 cop_seq; /* parse sequence number */ - short cop_slen; /* len of cop_short, if not null */ - VOL short cop_flags; /* optimization flags--see above */ + char * cop_label; /* label for this construct */ HV * cop_stash; /* package line was compiled in */ GV * cop_filegv; /* file the following line # is from */ + U32 cop_seq; /* parse sequence number */ + I32 cop_arybase; /* array base this line was compiled with */ line_t cop_line; /* line # of this command */ - char cop_type; /* what this command does */ }; #define Nullcop Null(COP*) @@ -92,8 +51,7 @@ struct block_sub { } \ if (cx->blk_sub.cv) { \ if (!(CvDEPTH(cx->blk_sub.cv) = cx->blk_sub.olddepth)) { \ - if (CvDELETED(cx->blk_sub.cv)) \ - SvREFCNT_dec((SV*)cx->blk_sub.cv); \ + SvREFCNT_dec((SV*)cx->blk_sub.cv); \ } \ } @@ -184,20 +142,20 @@ struct block { cx->blk_oldretsp = retstack_ix, \ cx->blk_oldpm = curpm, \ cx->blk_gimme = gimme; \ - DEBUG_l( fprintf(stderr,"Entering block %d, type %s\n", \ - cxstack_ix, block_type[t]); ) + DEBUG_l( fprintf(stderr,"Entering block %ld, type %s\n", \ + (long)cxstack_ix, block_type[t]); ) /* Exit a block (RETURN and LAST). */ -#define POPBLOCK(cx) cx = &cxstack[cxstack_ix--], \ +#define POPBLOCK(cx,pm) cx = &cxstack[cxstack_ix--], \ newsp = stack_base + cx->blk_oldsp, \ curcop = cx->blk_oldcop, \ markstack_ptr = markstack + cx->blk_oldmarksp, \ scopestack_ix = cx->blk_oldscopesp, \ retstack_ix = cx->blk_oldretsp, \ - curpm = cx->blk_oldpm, \ + pm = cx->blk_oldpm, \ gimme = cx->blk_gimme; \ - DEBUG_l( fprintf(stderr,"Leaving block %d, type %s\n", \ - cxstack_ix+1,block_type[cx->cx_type]); ) + DEBUG_l( fprintf(stderr,"Leaving block %ld, type %s\n", \ + (long)cxstack_ix+1,block_type[cx->cx_type]); ) /* Continue a block elsewhere (NEXT and REDO). */ #define TOPBLOCK(cx) cx = &cxstack[cxstack_ix], \ @@ -264,6 +222,10 @@ struct context { #define CXINC (cxstack_ix < cxstack_max ? ++cxstack_ix : (cxstack_ix = cxinc())) /* "gimme" values */ -#define G_SCALAR 0 -#define G_ARRAY 1 +#define G_SCALAR 0 +#define G_ARRAY 1 +/* extra flags for perl_call_* routines */ +#define G_DISCARD 2 /* Call FREETMPS. */ +#define G_EVAL 4 /* Assume eval {} around subroutine call. */ +#define G_NOARGS 8 /* Don't construct a @_ array. */ diff --git a/cppstdin b/cppstdin deleted file mode 100755 index 908d494..0000000 --- a/cppstdin +++ /dev/null @@ -1 +0,0 @@ -cat >.$$.c; cc -E ${1+"$@"} .$$.c; rm .$$.c diff --git a/cv.h b/cv.h index 2675ede..9d9c05f 100644 --- a/cv.h +++ b/cv.h @@ -1,18 +1,17 @@ -/* $RCSfile: cv.h,v $$Revision: 4.1 $$Date: 92/08/07 18:26:42 $ +/* cv.h * - * Copyright (c) 1991, Larry Wall + * Copyright (c) 1991-1994, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. * - * $Log: cv.h,v $ */ struct xpvcv { char * xpv_pv; /* pointer to malloced string */ STRLEN xpv_cur; /* length of xp_pv as a C string */ STRLEN xpv_len; /* allocated size */ - STRLEN xof_off; /* ptr is incremented by offset */ + IV xof_off; /* integer value */ double xnv_nv; /* numeric value, if any */ MAGIC* xmg_magic; /* magic for scalar array */ HV* xmg_stash; /* class package */ @@ -20,23 +19,23 @@ struct xpvcv { HV * xcv_stash; OP * xcv_start; OP * xcv_root; - I32 (*xcv_usersub)(); - I32 xcv_userindex; + void (*xcv_xsub) _((CV*)); + ANY xcv_xsubany; GV * xcv_gv; GV * xcv_filegv; long xcv_depth; /* >= 2 indicates recursive call */ AV * xcv_padlist; - bool xcv_deleted; + bool xcv_oldstyle; }; #define Nullcv Null(CV*) #define CvSTASH(sv) ((XPVCV*)SvANY(sv))->xcv_stash #define CvSTART(sv) ((XPVCV*)SvANY(sv))->xcv_start #define CvROOT(sv) ((XPVCV*)SvANY(sv))->xcv_root -#define CvUSERSUB(sv) ((XPVCV*)SvANY(sv))->xcv_usersub -#define CvUSERINDEX(sv) ((XPVCV*)SvANY(sv))->xcv_userindex +#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 CvDEPTH(sv) ((XPVCV*)SvANY(sv))->xcv_depth #define CvPADLIST(sv) ((XPVCV*)SvANY(sv))->xcv_padlist -#define CvDELETED(sv) ((XPVCV*)SvANY(sv))->xcv_deleted +#define CvOLDSTYLE(sv) ((XPVCV*)SvANY(sv))->xcv_oldstyle diff --git a/deb.c b/deb.c index f1b375f..d5627fa 100644 --- a/deb.c +++ b/deb.c @@ -1,45 +1,22 @@ -/* $RCSfile: op.c,v $$Revision: 4.1 $$Date: 92/08/07 17:19:16 $ +/* deb.c * - * Copyright (c) 1991, Larry Wall + * Copyright (c) 1991-1994, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. * - * $Log: op.c,v $ - * Revision 4.1 92/08/07 17:19:16 lwall - * Stage 6 Snapshot - * - * Revision 4.0.1.5 92/06/08 12:00:39 lwall - * patch20: the switch optimizer didn't do anything in subroutines - * patch20: removed implicit int declarations on funcions - * - * Revision 4.0.1.4 91/11/11 16:29:33 lwall - * patch19: do {$foo ne "bar";} returned wrong value - * patch19: some earlier patches weren't propagated to alternate 286 code - * - * Revision 4.0.1.3 91/11/05 16:07:43 lwall - * patch11: random cleanup - * patch11: "foo\0" eq "foo" was sometimes optimized to true - * patch11: foreach on null list could spring memory leak - * - * Revision 4.0.1.2 91/06/07 10:26:45 lwall - * patch4: new copyright notice - * patch4: made some allowances for "semi-standard" C - * - * Revision 4.0.1.1 91/04/11 17:36:16 lwall - * patch1: you may now use "die" and "caller" in a signal handler - * - * Revision 4.0 91/03/20 01:04:18 lwall - * 4.0 baseline. - * + */ + +/* + * "Didst thou think that the eyes of the White Tower were blind? Nay, I + * have seen more than thou knowest, Gray Fool." --Denethor */ #include "EXTERN.h" #include "perl.h" -void deb_growlevel(); - -#if !defined(STANDARD_C) && !defined(I_VARARGS) +#ifdef DEBUGGING +#if !defined(I_STDARG) && !defined(I_VARARGS) /* * Fallback on the old hackers way of doing varargs @@ -51,15 +28,17 @@ deb(pat,a1,a2,a3,a4,a5,a6,a7,a8) char *pat; { register I32 i; + GV* gv = curcop->cop_filegv; fprintf(stderr,"(%s:%ld)\t", - SvPVX(GvSV(curcop->cop_filegv)),(long)curcop->cop_line); + SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "", + (long)curcop->cop_line); for (i=0; icop_filegv; fprintf(stderr,"(%s:%ld)\t", - SvPVX(GvSV(curcop->cop_filegv)),(long)curcop->cop_line); + SvTYPE(gv) == SVt_PVGV ? SvPVX(GvSV(gv)) : "", + (long)curcop->cop_line); for (i=0; i markstack ? *markstack_ptr : -1; + I32 top = stack_sp - stack_base; + register I32 i = top - 30; + I32 *markscan = markstack; + + if (i < 0) + i = 0; + + while (++markscan <= markstack_ptr) + if (*markscan >= i) + break; - fprintf(stderr, " =>"); - if (stack_base[0] || stack_sp < stack_base) + fprintf(stderr, i ? " => ... " : " => "); + if (stack_base[0] != &sv_undef || stack_sp < stack_base) fprintf(stderr, " [STACK UNDERFLOW!!!]\n"); - for (i = 1; i <= 30; i++) { - if (stack_sp >= &stack_base[i]) - { - fprintf(stderr, "\t%-4s%s%s", SvPEEK(stack_base[i]), - markoff == i ? " [" : "", - stack_sp == &stack_base[i] ? - (markoff == i ? "]" : " ]") : ""); + do { + ++i; + if (markscan <= markstack_ptr && *markscan < i) { + do { + ++markscan; + putc('*', stderr); + } + while (markscan <= markstack_ptr && *markscan < i); + fprintf(stderr, " "); } + if (i > top) + break; + fprintf(stderr, "%-4s ", SvPEEK(stack_base[i])); } + while (1); fprintf(stderr, "\n"); return 0; } +#else +static int dummy; /* avoid totally empty deb.o file */ +#endif /* DEBUGGING */ diff --git a/dl.c b/dl.c deleted file mode 100644 index d514f81..0000000 --- a/dl.c +++ /dev/null @@ -1,54 +0,0 @@ -#include - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -static int -XS_DynamicLoader_bootstrap(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items < 1 || items > 1) { - croak("Usage: DynamicLoader::bootstrap(package)"); - } - { - char* package = SvPV(ST(1),na); - void* obj = 0; - int (*bootproc)(); - char tmpbuf[1024]; - char tmpbuf2[128]; - AV *av = GvAVn(incgv); - I32 i; - - for (i = 0; i <= AvFILL(av); i++) { - (void)sprintf(tmpbuf, "%s/auto/%s/%s.so", - SvPVx(*av_fetch(av, i, TRUE), na), package, package); - if (obj = dlopen(tmpbuf,1)) - break; - } - if (!obj) - croak("Can't find loadable object for package %s in @INC", package); - - sprintf(tmpbuf2, "boot_%s", package); - bootproc = (int (*)())dlsym(obj, tmpbuf2); - if (!bootproc) - croak("Shared object %s contains no %s function", tmpbuf, tmpbuf2); - bootproc(); - - ST(0) = sv_mortalcopy(&sv_yes); - } - return ax; -} - -int -boot_DynamicLoader(ix,sp,items) -int ix; -int sp; -int items; -{ - char* file = __FILE__; - - newXSUB("DynamicLoader::bootstrap", 0, XS_DynamicLoader_bootstrap, file); -} diff --git a/dl_sunos.c b/dl_sunos.c deleted file mode 100644 index badd66d..0000000 --- a/dl_sunos.c +++ /dev/null @@ -1,56 +0,0 @@ -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#ifdef I_DLFCN -# include -#endif - -static int -XS_DynamicLoader_bootstrap(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items < 1 || items > 1) { - croak("Usage: DynamicLoader::bootstrap(package)"); - } - { - char* package = SvPV(ST(1),na); - void* obj = 0; - int (*bootproc)(); - char tmpbuf[1024]; - char tmpbuf2[128]; - AV *av = GvAVn(incgv); - I32 i; - - for (i = 0; i <= AvFILL(av); i++) { - (void)sprintf(tmpbuf, "%s/auto/%s/%s.so", - SvPVx(*av_fetch(av, i, TRUE), na), package, package); - if (obj = dlopen(tmpbuf,1)) - break; - } - if (!obj) - croak("Can't find loadable object for package %s in @INC", package); - - sprintf(tmpbuf2, "boot_%s", package); - bootproc = (int (*)())dlsym(obj, tmpbuf2); - if (!bootproc) - croak("Shared object %s contains no %s function", tmpbuf, tmpbuf2); - bootproc(); - - ST(0) = sv_mortalcopy(&sv_yes); - } - return ax; -} - -int -boot_DynamicLoader(ix,sp,items) -int ix; -int sp; -int items; -{ - char* file = __FILE__; - - newXSUB("DynamicLoader::bootstrap", 0, XS_DynamicLoader_bootstrap, file); -} diff --git a/doio.c b/doio.c index d7b964c..7d8e617 100644 --- a/doio.c +++ b/doio.c @@ -1,54 +1,17 @@ -/* $RCSfile: doio.c,v $$Revision: 4.1 $$Date: 92/08/07 17:19:42 $ +/* doio.c * - * Copyright (c) 1991, Larry Wall + * Copyright (c) 1991-1994, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. * - * $Log: doio.c,v $ - * Revision 4.1 92/08/07 17:19:42 lwall - * Stage 6 Snapshot - * - * Revision 4.0.1.6 92/06/11 21:08:16 lwall - * patch34: some systems don't declare h_errno extern in header files - * - * Revision 4.0.1.5 92/06/08 13:00:21 lwall - * patch20: some machines don't define ENOTSOCK in errno.h - * patch20: new warnings for failed use of stat operators on filenames with \n - * patch20: wait failed when STDOUT or STDERR reopened to a pipe - * patch20: end of file latch not reset on reopen of STDIN - * patch20: seek(HANDLE, 0, 1) went to eof because of ancient Ultrix workaround - * patch20: fixed memory leak on system() for vfork() machines - * patch20: get*by* routines now return something useful in a scalar context - * patch20: h_errno now accessible via $? - * - * Revision 4.0.1.4 91/11/05 16:51:43 lwall - * patch11: prepared for ctype implementations that don't define isascii() - * patch11: perl mistook some streams for sockets because they return mode 0 too - * patch11: reopening STDIN, STDOUT and STDERR failed on some machines - * patch11: certain perl errors should set EBADF so that $! looks better - * patch11: truncate on a closed filehandle could dump - * patch11: stats of _ forgot whether prior stat was actually lstat - * patch11: -T returned true on NFS directory - * - * Revision 4.0.1.3 91/06/10 01:21:19 lwall - * patch10: read didn't work from character special files open for writing - * patch10: close-on-exec wrongly set on system file descriptors - * - * Revision 4.0.1.2 91/06/07 10:53:39 lwall - * patch4: new copyright notice - * patch4: system fd's are now treated specially - * patch4: added $^F variable to specify maximum system fd, default 2 - * patch4: character special files now opened with bidirectional stdio buffers - * patch4: taintchecks could improperly modify parent in vfork() - * patch4: many, many itty-bitty portability fixes - * - * Revision 4.0.1.1 91/04/11 17:41:06 lwall - * patch1: hopefully straightened out some of the Xenix mess - * - * Revision 4.0 91/03/20 01:07:06 lwall - * 4.0 baseline. - * + */ + +/* + * "Far below them they saw the white waters pour into a foaming bowl, and + * then swirl darkly about a deep oval basin in the rocks, until they found + * their way out again through a narrow gate, and flowed away, fuming and + * chattering, into calmer and more level reaches." */ #include "EXTERN.h" @@ -64,6 +27,9 @@ #endif #ifdef HAS_SHM #include +# ifndef HAS_SHMAT_PROTOTYPE + extern Shmat_t shmat _((int, char *, int)); +# endif #endif #endif @@ -77,18 +43,26 @@ #include #endif +/* Omit -- it causes too much grief on mixed systems. +#ifdef I_UNISTD +#include +#endif +*/ + bool -do_open(gv,name,len) +do_open(gv,name,len,supplied_fp) GV *gv; register char *name; I32 len; +FILE *supplied_fp; { FILE *fp; - register IO *io = GvIO(gv); - char *myname = savestr(name); + register IO *io = GvIOn(gv); + char *myname = savepv(name); int result; int fd; int writing = 0; + int dodup; char mode[3]; /* stdio file mode ("r\0" or "r+\0") */ FILE *saveifp = Nullfp; FILE *saveofp = Nullfp; @@ -100,9 +74,7 @@ I32 len; forkprocess = 1; /* assume true if no fork */ while (len && isSPACE(name[len-1])) name[--len] = '\0'; - if (!io) - io = GvIO(gv) = newIO(); - else if (IoIFP(io)) { + if (IoIFP(io)) { fd = fileno(IoIFP(io)); if (IoTYPE(io) == '-') result = 0; @@ -145,6 +117,8 @@ I32 len; if (strNE(name,"-")) TAINT_ENV(); TAINT_PROPER("piped open"); + if (dowarn && name[strlen(name)-1] == '|') + warn("Can't do bidirectional pipe"); fp = my_popen(name,"w"); writing = 1; } @@ -160,29 +134,41 @@ I32 len; writing = 1; if (*name == '&') { duplicity: + dodup = 1; name++; - while (isSPACE(*name)) + if (*name == '=') { + dodup = 0; name++; - if (isDIGIT(*name)) - fd = atoi(name); + } + if (!*name && supplied_fp) + fp = supplied_fp; else { - gv = gv_fetchpv(name,FALSE,SVt_PVIO); - if (!gv || !GvIO(gv)) { + while (isSPACE(*name)) + name++; + if (isDIGIT(*name)) + fd = atoi(name); + else { + IO* thatio; + gv = gv_fetchpv(name,FALSE,SVt_PVIO); + thatio = GvIO(gv); + if (!thatio) { #ifdef EINVAL - errno = EINVAL; + errno = EINVAL; #endif - goto say_false; - } - if (GvIO(gv) && IoIFP(GvIO(gv))) { - fd = fileno(IoIFP(GvIO(gv))); - if (IoTYPE(GvIO(gv)) == 's') - IoTYPE(io) = 's'; + goto say_false; + } + if (IoIFP(thatio)) { + fd = fileno(IoIFP(thatio)); + if (IoTYPE(thatio) == 's') + IoTYPE(io) = 's'; + } + else + fd = -1; } - else - fd = -1; - } - if (!(fp = fdopen(fd = dup(fd),mode))) { - close(fd); + if (dodup) + fd = dup(fd); + if (!(fp = fdopen(fd,mode))) + close(fd); } } else { @@ -243,7 +229,7 @@ I32 len; } if (IoTYPE(io) && IoTYPE(io) != '|' && IoTYPE(io) != '-') { - if (fstat(fileno(fp),&statbuf) < 0) { + if (Fstat(fileno(fp),&statbuf) < 0) { (void)fclose(fp); goto say_false; } @@ -257,8 +243,8 @@ I32 len; !statbuf.st_mode #endif ) { - I32 buflen = sizeof tokenbuf; - if (getsockname(fileno(fp), tokenbuf, &buflen) >= 0 + int buflen = sizeof tokenbuf; + if (getsockname(fileno(fp), (struct sockaddr *)tokenbuf, &buflen) >= 0 || errno != ENOTSOCK) IoTYPE(io) = 's'; /* some OS's return 0 on fstat()ed socket */ /* but some return 0 for streams too, sigh */ @@ -281,11 +267,11 @@ I32 len; dup2(fileno(fp), fd); sv = *av_fetch(fdpid,fileno(fp),TRUE); - SvUPGRADE(sv, SVt_IV); + (void)SvUPGRADE(sv, SVt_IV); pid = SvIVX(sv); SvIVX(sv) = 0; sv = *av_fetch(fdpid,fd,TRUE); - SvUPGRADE(sv, SVt_IV); + (void)SvUPGRADE(sv, SVt_IV); SvIVX(sv) = pid; fclose(fp); @@ -293,9 +279,9 @@ I32 len; fp = saveifp; clearerr(fp); } -#if defined(HAS_FCNTL) && defined(FFt_SETFD) +#if defined(HAS_FCNTL) && defined(F_SETFD) fd = fileno(fp); - fcntl(fd,FFt_SETFD,fd > maxsysfd); + fcntl(fd,F_SETFD,fd > maxsysfd); #endif IoIFP(io) = fp; if (writing) { @@ -334,7 +320,7 @@ register GV *gv; if (!argvoutgv) argvoutgv = gv_fetchpv("ARGVOUT",TRUE,SVt_PVIO); if (filemode & (S_ISUID|S_ISGID)) { - fflush(IoIFP(GvIO(argvoutgv))); /* chmod must follow last write */ + fflush(IoIFP(GvIOn(argvoutgv))); /* chmod must follow last write */ #ifdef HAS_FCHMOD (void)fchmod(lastfd,filemode); #else @@ -349,12 +335,12 @@ register GV *gv; sv_setsv(GvSV(gv),sv); SvSETMAGIC(GvSV(gv)); oldname = SvPVx(GvSV(gv), len); - if (do_open(gv,oldname,len)) { + if (do_open(gv,oldname,len,Nullfp)) { if (inplace) { TAINT_PROPER("inplace open"); if (strEQ(oldname,"-")) { defoutgv = gv_fetchpv("STDOUT",TRUE,SVt_PVIO); - return IoIFP(GvIO(gv)); + return IoIFP(GvIOp(gv)); } #ifndef FLEXFILENAMES filedev = statbuf.st_dev; @@ -376,7 +362,7 @@ register GV *gv; sv_catpv(sv,inplace); #endif #ifndef FLEXFILENAMES - if (stat(SvPVX(sv),&statbuf) >= 0 + if (Stat(SvPVX(sv),&statbuf) >= 0 && statbuf.st_dev == filedev && statbuf.st_ino == fileino ) { warn("Can't do inplace edit: %s > 14 characters", @@ -397,7 +383,7 @@ register GV *gv; do_close(gv,FALSE); (void)unlink(SvPVX(sv)); (void)rename(oldname,SvPVX(sv)); - do_open(gv,SvPVX(sv),SvCUR(GvSV(gv))); + do_open(gv,SvPVX(sv),SvCUR(GvSV(gv)),Nullfp); #endif /* MSDOS */ #else (void)UNLINK(SvPVX(sv)); @@ -426,15 +412,15 @@ register GV *gv; sv_setpvn(sv,">",1); sv_catpv(sv,oldname); errno = 0; /* in case sprintf set errno */ - if (!do_open(argvoutgv,SvPVX(sv),SvCUR(sv))) { + if (!do_open(argvoutgv,SvPVX(sv),SvCUR(sv),Nullfp)) { warn("Can't do inplace edit on %s: %s", oldname, Strerror(errno) ); do_close(gv,FALSE); continue; } defoutgv = argvoutgv; - lastfd = fileno(IoIFP(GvIO(argvoutgv))); - (void)fstat(lastfd,&statbuf); + lastfd = fileno(IoIFP(GvIOp(argvoutgv))); + (void)Fstat(lastfd,&statbuf); #ifdef HAS_FCHMOD (void)fchmod(lastfd,filemode); #else @@ -450,7 +436,7 @@ register GV *gv; #endif } } - return IoIFP(GvIO(gv)); + return IoIFP(GvIOp(gv)); } else fprintf(stderr,"Can't open %s: %s\n",SvPV(sv, na), Strerror(errno)); @@ -478,16 +464,12 @@ GV *wgv; if (!wgv) goto badexit; - rstio = GvIO(rgv); - wstio = GvIO(wgv); + rstio = GvIOn(rgv); + wstio = GvIOn(wgv); - if (!rstio) - rstio = GvIO(rgv) = newIO(); - else if (IoIFP(rstio)) + if (IoIFP(rstio)) do_close(rgv,FALSE); - if (!wstio) - wstio = GvIO(wgv) = newIO(); - else if (IoIFP(wstio)) + if (IoIFP(wstio)) do_close(wgv,FALSE); if (pipe(fd) < 0) @@ -515,13 +497,13 @@ badexit: #endif bool -#ifndef STANDARD_C +#ifndef CAN_PROTOTYPE do_close(gv,explicit) GV *gv; bool explicit; #else do_close(GV *gv, bool explicit) -#endif /* STANDARD_C */ +#endif /* CAN_PROTOTYPE */ { bool retval = FALSE; register IO *io; @@ -529,7 +511,7 @@ do_close(GV *gv, bool explicit) if (!gv) gv = argvgv; - if (!gv) { + if (!gv || SvTYPE(gv) != SVt_PVGV) { errno = EBADF; return FALSE; } @@ -660,79 +642,7 @@ nuts: return FALSE; } -I32 -do_ctl(optype,gv,func,argstr) -I32 optype; -GV *gv; -I32 func; -SV *argstr; -{ - register IO *io; - register char *s; - I32 retval; - - if (!gv || !argstr || !(io = GvIO(gv)) || !IoIFP(io)) { - errno = EBADF; /* well, sort of... */ - return -1; - } - - if (SvPOK(argstr) || !SvNIOK(argstr)) { - if (!SvPOK(argstr)) - s = SvPV(argstr, na); - -#ifdef IOCPARM_MASK -#ifndef IOCPARM_LEN -#define IOCPARM_LEN(x) (((x) >> 16) & IOCPARM_MASK) -#endif -#endif -#ifdef IOCPARM_LEN - retval = IOCPARM_LEN(func); /* on BSDish systes we're safe */ -#else - retval = 256; /* otherwise guess at what's safe */ -#endif - if (SvCUR(argstr) < retval) { - Sv_Grow(argstr,retval+1); - SvCUR_set(argstr, retval); - } - - s = SvPVX(argstr); - s[SvCUR(argstr)] = 17; /* a little sanity check here */ - } - else { - retval = SvIV(argstr); -#ifdef DOSISH - s = (char*)(long)retval; /* ouch */ -#else - s = (char*)retval; /* ouch */ -#endif - } - -#ifndef lint - if (optype == OP_IOCTL) - retval = ioctl(fileno(IoIFP(io)), func, s); - else -#ifdef DOSISH - croak("fcntl is not implemented"); -#else -#ifdef HAS_FCNTL - retval = fcntl(fileno(IoIFP(io)), func, s); -#else - croak("fcntl is not implemented"); -#endif -#endif -#else /* lint */ - retval = 0; -#endif /* lint */ - - if (SvPOK(argstr)) { - if (s[SvCUR(argstr)] != 17) - croak("Return value overflowed string"); - s[SvCUR(argstr)] = 0; /* put our null back */ - } - return retval; -} - -#if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(FFt_FREESP) +#if !defined(HAS_TRUNCATE) && !defined(HAS_CHSIZE) && defined(F_FREESP) /* code courtesy of William Kucharski */ #define HAS_CHSIZE @@ -744,7 +654,7 @@ Off_t length; /* length to set file to */ struct flock fl; struct stat filebuf; - if (fstat(fd, &filebuf) < 0) + if (Fstat(fd, &filebuf) < 0) return -1; if (filebuf.st_size < length) { @@ -765,24 +675,24 @@ Off_t length; /* length to set file to */ fl.l_whence = 0; fl.l_len = 0; fl.l_start = length; - fl.l_type = FFt_WRLCK; /* write lock on file space */ + fl.l_type = F_WRLCK; /* write lock on file space */ /* - * This relies on the UNDOCUMENTED FFt_FREESP argument to + * This relies on the UNDOCUMENTED F_FREESP argument to * fcntl(2), which truncates the file so that it ends at the * position indicated by fl.l_start. * * Will minor miracles never cease? */ - if (fcntl(fd, FFt_FREESP, &fl) < 0) + if (fcntl(fd, F_FREESP, &fl) < 0) return -1; } return 0; } -#endif /* FFt_FREESP */ +#endif /* F_FREESP */ I32 looks_like_number(sv) @@ -840,7 +750,6 @@ register SV *sv; FILE *fp; { register char *tmps; - SV* tmpstr; STRLEN len; /* assuming fp is checked earlier */ @@ -865,15 +774,18 @@ FILE *fp; warn(warn_uninit); return TRUE; case SVt_IV: - if (SvGMAGICAL(sv)) - mg_get(sv); - fprintf(fp, "%d", SvIVX(sv)); - return !ferror(fp); + if (SvIOK(sv)) { + if (SvGMAGICAL(sv)) + mg_get(sv); + fprintf(fp, "%ld", (long)SvIVX(sv)); + return !ferror(fp); + } + /* FALL THROUGH */ default: tmps = SvPV(sv, len); break; } - if (len && (fwrite(tmps,1,len,fp) == 0 || ferror(fp))) + if (len && (fwrite1(tmps,1,len,fp) == 0 || ferror(fp))) return FALSE; return TRUE; } @@ -885,14 +797,14 @@ dARGS dSP; IO *io; - if (op->op_flags & OPf_SPECIAL) { + if (op->op_flags & OPf_REF) { EXTEND(sp,1); io = GvIO(cGVOP->op_gv); if (io && IoIFP(io)) { statgv = cGVOP->op_gv; sv_setpv(statname,""); laststype = OP_STAT; - return (laststatval = fstat(fileno(IoIFP(io)), &statcache)); + return (laststatval = Fstat(fileno(IoIFP(io)), &statcache)); } else { if (cGVOP->op_gv == defgv) @@ -911,7 +823,7 @@ dARGS statgv = Nullgv; sv_setpv(statname,SvPV(sv, na)); laststype = OP_STAT; - laststatval = stat(SvPV(sv, na),&statcache); + laststatval = Stat(SvPV(sv, na),&statcache); if (laststatval < 0 && dowarn && strchr(SvPV(sv, na), '\n')) warn(warn_nl, "stat"); return laststatval; @@ -924,7 +836,7 @@ dARGS { dSP; SV *sv; - if (op->op_flags & OPf_SPECIAL) { + if (op->op_flags & OPf_REF) { EXTEND(sp,1); if (cGVOP->op_gv == defgv) { if (laststype != OP_LSTAT) @@ -942,7 +854,7 @@ dARGS #ifdef HAS_LSTAT laststatval = lstat(SvPV(sv, na),&statcache); #else - laststatval = stat(SvPV(sv, na),&statcache); + laststatval = Stat(SvPV(sv, na),&statcache); #endif if (laststatval < 0 && dowarn && strchr(SvPV(sv, na), '\n')) warn(warn_nl, "lstat"); @@ -974,6 +886,8 @@ register SV **sp; execvp(tmps,Argv); else execvp(Argv[0],Argv); + if (dowarn) + warn("Can't exec \"%s\": %s", Argv[0], Strerror(errno)); } do_execfree(); return FALSE; @@ -1047,7 +961,7 @@ char *cmd; } } New(402,Argv, (s - cmd) / 2 + 2, char*); - Cmd = nsavestr(cmd, s-cmd); + Cmd = savepvn(cmd, s-cmd); a = Argv; for (s = Cmd; *s;) { while (*s && isSPACE(*s)) s++; @@ -1064,6 +978,8 @@ char *cmd; do_execfree(); goto doshell; } + if (dowarn) + warn("Can't exec \"%s\": %s", Argv[0], Strerror(errno)); } do_execfree(); return FALSE; @@ -1104,9 +1020,9 @@ register SV **sp; case OP_CHOWN: TAINT_PROPER("chown"); if (sp - mark > 2) { - tot = sp - mark; val = SvIVx(*++mark); val2 = SvIVx(*++mark); + tot = sp - mark; while (++mark <= sp) { if (chown(SvPVx(*mark, na),val,val2)) tot--; @@ -1160,7 +1076,7 @@ register SV **sp; #ifdef HAS_LSTAT if (lstat(s,&statbuf) < 0 || S_ISDIR(statbuf.st_mode)) #else - if (stat(s,&statbuf) < 0 || S_ISDIR(statbuf.st_mode)) + if (Stat(s,&statbuf) < 0 || S_ISDIR(statbuf.st_mode)) #endif tot--; else { @@ -1170,6 +1086,7 @@ register SV **sp; } } break; +#ifdef HAS_UTIME case OP_UTIME: TAINT_PROPER("utime"); if (sp - mark > 2) { @@ -1194,12 +1111,13 @@ register SV **sp; else tot = 0; break; +#endif } return tot; } /* Do the permissions allow some operation? Assumes statcache already set. */ - +#ifndef VMS /* VMS' cando is in vms.c */ I32 cando(bit, effective, statbufp) I32 bit; @@ -1253,6 +1171,7 @@ register struct stat *statbufp; return FALSE; #endif /* ! MSDOS */ } +#endif /* ! VMS */ I32 ingroup(testgid,effective) @@ -1266,7 +1185,7 @@ I32 effective; #define NGROUPS 32 #endif { - GROUPSTYPE gary[NGROUPS]; + Groups_t gary[NGROUPS]; I32 anum; anum = getgroups(NGROUPS,gary); @@ -1323,7 +1242,8 @@ SV **sp; { SV *astr; char *a; - I32 id, n, cmd, infosize, getinfo, ret; + I32 id, n, cmd, infosize, getinfo; + I32 ret = -1; id = SvIVx(*++mark); n = (optype == OP_SEMCTL) ? SvIVx(*++mark) : 0; @@ -1370,20 +1290,14 @@ SV **sp; if (infosize) { + STRLEN len; if (getinfo) { - if (SvTHINKFIRST(astr)) { - if (SvREADONLY(astr)) - croak("Can't %s to readonly var", op_name[optype]); - if (SvROK(astr)) - sv_unref(astr); - } - SvGROW(astr, infosize+1); - a = SvPV(astr, na); + SvPV_force(astr, len); + a = SvGROW(astr, infosize+1); } else { - STRLEN len; a = SvPV(astr, len); if (len != infosize) croak("Bad arg length for %s, is %d, should be %d", @@ -1417,6 +1331,7 @@ SV **sp; if (getinfo && ret >= 0) { SvCUR_set(astr, infosize); *SvEND(astr) = '\0'; + SvSETMAGIC(astr); } return ret; } @@ -1468,11 +1383,9 @@ SV **sp; if (SvROK(mstr)) sv_unref(mstr); } - mbuf = SvPV(mstr, len); - if (len < sizeof(long)+msize+1) { - SvGROW(mstr, sizeof(long)+msize+1); - mbuf = SvPV(mstr, len); - } + SvPV_force(mstr, len); + mbuf = SvGROW(mstr, sizeof(long)+msize+1); + errno = 0; ret = msgrcv(id, (struct msgbuf *)mbuf, msize, mtype, flags); if (ret >= 0) { @@ -1523,9 +1436,6 @@ SV **sp; I32 id, mpos, msize; STRLEN len; struct shmid_ds shmds; -#ifndef VOIDSHMAT - extern char *shmat P((int, char *, int)); -#endif id = SvIVx(*++mark); mstr = *++mark; @@ -1538,28 +1448,22 @@ SV **sp; errno = EFAULT; /* can't do as caller requested */ return -1; } - shm = (char*)shmat(id, (char*)NULL, (optype == OP_SHMREAD) ? SHM_RDONLY : 0); + shm = (Shmat_t)shmat(id, (char*)NULL, (optype == OP_SHMREAD) ? SHM_RDONLY : 0); if (shm == (char *)-1) /* I hate System V IPC, I really do */ return -1; - mbuf = SvPV(mstr, len); if (optype == OP_SHMREAD) { - if (SvTHINKFIRST(mstr)) { - if (SvREADONLY(mstr)) - croak("Can't shmread to readonly var"); - if (SvROK(mstr)) - sv_unref(mstr); - } - if (len < msize) { - SvGROW(mstr, msize+1); - mbuf = SvPV(mstr, len); - } + SvPV_force(mstr, len); + mbuf = SvGROW(mstr, msize+1); + Copy(shm + mpos, mbuf, msize, char); SvCUR_set(mstr, msize); *SvEND(mstr) = '\0'; + SvSETMAGIC(mstr); } else { I32 n; + mbuf = SvPV(mstr, len); if ((n = len) > msize) n = msize; Copy(mbuf, shm + mpos, n, char); diff --git a/doop.c b/doop.c index 1a2ee51..42a5a0c 100644 --- a/doop.c +++ b/doop.c @@ -1,60 +1,14 @@ -/* $RCSfile: doarg.c,v $$Revision: 4.1 $$Date: 92/08/07 17:19:37 $ +/* doop.c * - * Copyright (c) 1991, Larry Wall + * Copyright (c) 1991-1994, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. * - * $Log: doarg.c,v $ - * Revision 4.1 92/08/07 17:19:37 lwall - * Stage 6 Snapshot - * - * Revision 4.0.1.7 92/06/11 21:07:11 lwall - * patch34: join with null list attempted negative allocation - * patch34: sprintf("%6.4s", "abcdefg") didn't print "abcd " - * - * Revision 4.0.1.6 92/06/08 12:34:30 lwall - * patch20: removed implicit int declarations on funcions - * patch20: pattern modifiers i and o didn't interact right - * patch20: join() now pre-extends target string to avoid excessive copying - * patch20: fixed confusion between a *var's real name and its effective name - * patch20: subroutines didn't localize $`, $&, $', $1 et al correctly - * patch20: usersub routines didn't reclaim temp values soon enough - * patch20: ($<,$>) = ... didn't work on some architectures - * patch20: added Atari ST portability - * - * Revision 4.0.1.5 91/11/11 16:31:58 lwall - * patch19: added little-endian pack/unpack options - * - * Revision 4.0.1.4 91/11/05 16:35:06 lwall - * patch11: /$foo/o optimizer could access deallocated data - * patch11: minimum match length calculation in regexp is now cumulative - * patch11: added some support for 64-bit integers - * patch11: prepared for ctype implementations that don't define isascii() - * patch11: sprintf() now supports any length of s field - * patch11: indirect subroutine calls through magic vars (e.g. &$1) didn't work - * patch11: defined(&$foo) and undef(&$foo) didn't work - * - * Revision 4.0.1.3 91/06/10 01:18:41 lwall - * patch10: pack(hh,1) dumped core - * - * Revision 4.0.1.2 91/06/07 10:42:17 lwall - * patch4: new copyright notice - * patch4: // wouldn't use previous pattern if it started with a null character - * patch4: //o and s///o now optimize themselves fully at runtime - * patch4: added global modifier for pattern matches - * patch4: undef @array disabled "@array" interpolation - * patch4: chop("") was returning "\0" rather than "" - * patch4: vector logical operations &, | and ^ sometimes returned null string - * patch4: syscall couldn't pass numbers with most significant bit set on sparcs - * - * Revision 4.0.1.1 91/04/11 17:40:14 lwall - * patch1: fixed undefined environ problem - * patch1: fixed debugger coredump on subroutines - * - * Revision 4.0 91/03/20 01:06:42 lwall - * 4.0 baseline. - * + */ + +/* + * "'So that was the job I felt I had to do when I started,' thought Sam." */ #include "EXTERN.h" @@ -68,8 +22,6 @@ #pragma function(memcmp) #endif /* BUGGY_MSC */ -static void doencodes(); - #ifdef BUGGY_MSC #pragma intrinsic(memcmp) #endif /* BUGGY_MSC */ @@ -88,8 +40,15 @@ OP *arg; register I32 squash = op->op_private & OPpTRANS_SQUASH; STRLEN len; + if (SvREADONLY(sv)) + croak(no_modify); tbl = (short*) cPVOP->op_pv; s = SvPV(sv, len); + if (!len) + return 0; + if (!SvPOKp(sv)) + s = SvPV_force(sv, len); + (void)SvPOK_only(sv); send = s + len; if (!tbl || !s) croak("panic: do_trans"); @@ -214,7 +173,7 @@ register SV **sarg; sv_setpv(sv,""); len--; /* don't count pattern string */ - t = s = SvPV(*sarg, arglen); + t = s = SvPV(*sarg, arglen); /* XXX Don't know t is writeable */ send = s + arglen; sarg++; for ( ; ; len--) { @@ -386,13 +345,23 @@ SV *sv; register unsigned char *s; register unsigned long lval; I32 mask; + STRLEN targlen; + STRLEN len; if (!targ) return; - s = (unsigned char*)SvPVX(targ); + s = (unsigned char*)SvPV_force(targ, targlen); lval = U_L(SvNV(sv)); offset = LvTARGOFF(sv); size = LvTARGLEN(sv); + + len = (offset + size + 7) / 8; + if (len > targlen) { + s = (unsigned char*)SvGROW(targ, len + 1); + (void)memzero(s + targlen, len - targlen + 1); + SvCUR_set(targ, len); + } + if (size < 8) { mask = (1 << size) - 1; size = offset & 7; @@ -402,6 +371,7 @@ SV *sv; s[offset] |= lval << size; } else { + offset >>= 3; if (size == 8) s[offset] = lval & 255; else if (size == 16) { @@ -422,49 +392,112 @@ do_chop(astr,sv) register SV *astr; register SV *sv; { - register char *tmps; - register I32 i; - AV *ary; - HV *hv; - HE *entry; STRLEN len; - - if (!sv) - return; - if (SvTHINKFIRST(sv)) { - if (SvREADONLY(sv)) - croak("Can't chop readonly value"); - if (SvROK(sv)) - sv_unref(sv); - } + char *s; + if (SvTYPE(sv) == SVt_PVAV) { - I32 max; - SV **array = AvARRAY(sv); - max = AvFILL(sv); - for (i = 0; i <= max; i++) - do_chop(astr,array[i]); - return; + register I32 i; + I32 max; + AV* av = (AV*)sv; + max = AvFILL(av); + for (i = 0; i <= max; i++) { + sv = (SV*)av_fetch(av, i, FALSE); + if (sv && ((sv = *(SV**)sv), sv != &sv_undef)) + do_chop(astr, sv); + } + return; } if (SvTYPE(sv) == SVt_PVHV) { - hv = (HV*)sv; - (void)hv_iterinit(hv); - /*SUPPRESS 560*/ - while (entry = hv_iternext(hv)) - do_chop(astr,hv_iterval(hv,entry)); - return; + HV* hv = (HV*)sv; + HE* entry; + (void)hv_iterinit(hv); + /*SUPPRESS 560*/ + while (entry = hv_iternext(hv)) + do_chop(astr,hv_iterval(hv,entry)); + return; } - tmps = SvPV(sv, len); - if (tmps && len) { - tmps += len - 1; - sv_setpvn(astr,tmps,1); /* remember last char */ - *tmps = '\0'; /* wipe it out */ - SvCUR_set(sv, tmps - SvPVX(sv)); - SvNOK_off(sv); - SvSETMAGIC(sv); + s = SvPV(sv, len); + if (len && !SvPOKp(sv)) + s = SvPV_force(sv, len); + if (s && len) { + s += --len; + sv_setpvn(astr, s, 1); + *s = '\0'; + SvCUR_set(sv, len); + SvNIOK_off(sv); } else - sv_setpvn(astr,"",0); -} + sv_setpvn(astr, "", 0); + SvSETMAGIC(sv); +} + +I32 +do_chomp(sv) +register SV *sv; +{ + register I32 count = 0; + STRLEN len; + char *s; + + if (SvTYPE(sv) == SVt_PVAV) { + register I32 i; + I32 max; + AV* av = (AV*)sv; + max = AvFILL(av); + for (i = 0; i <= max; i++) { + sv = (SV*)av_fetch(av, i, FALSE); + if (sv && ((sv = *(SV**)sv), sv != &sv_undef)) + count += do_chomp(sv); + } + return count; + } + if (SvTYPE(sv) == SVt_PVHV) { + HV* hv = (HV*)sv; + HE* entry; + (void)hv_iterinit(hv); + /*SUPPRESS 560*/ + while (entry = hv_iternext(hv)) + count += do_chomp(hv_iterval(hv,entry)); + return count; + } + s = SvPV(sv, len); + if (len && !SvPOKp(sv)) + s = SvPV_force(sv, len); + if (s && len) { + s += --len; + if (rspara) { + if (*s != '\n') + goto nope; + ++count; + while (len && s[-1] == '\n') { + --len; + --s; + ++count; + } + } + else if (rslen == 1) { + if (*s != rschar) + goto nope; + ++count; + } + else { + if (len < rslen - 1) + goto nope; + len -= rslen - 1; + s -= rslen - 1; + if (bcmp(s, rs, rslen)) + goto nope; + count += rslen; + } + + *s = '\0'; + SvCUR_set(sv, len); + SvNIOK_off(sv); + } + nope: + SvSETMAGIC(sv); + return count; +} void do_vop(optype,sv,left,right) @@ -484,29 +517,17 @@ SV *right; register char *lc = SvPV(left, leftlen); register char *rc = SvPV(right, rightlen); register I32 len; + I32 lensave; - if (SvTHINKFIRST(sv)) { - if (SvREADONLY(sv)) - croak("Can't do %s to readonly value", op_name[optype]); - if (SvROK(sv)) - sv_unref(sv); - } + dc = SvPV_force(sv,na); len = leftlen < rightlen ? leftlen : rightlen; - if (SvTYPE(sv) < SVt_PV) - sv_upgrade(sv, SVt_PV); - if (SvCUR(sv) > len) - SvCUR_set(sv, len); - else if (SvCUR(sv) < len) { - SvGROW(sv,len); - (void)memzero(SvPVX(sv) + SvCUR(sv), len - SvCUR(sv)); - SvCUR_set(sv, len); - } - SvPOK_only(sv); - dc = SvPVX(sv); - if (!dc) { - sv_setpvn(sv,"",0); - dc = SvPVX(sv); + lensave = len; + if (SvCUR(sv) < len) { + dc = SvGROW(sv,len + 1); + (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1); } + SvCUR_set(sv, len); + (void)SvPOK_only(sv); #ifdef LIBERAL if (len >= sizeof(long)*4 && !((long)dc % sizeof(long)) && @@ -529,7 +550,7 @@ SV *right; *dl++ = *ll++ & *rl++; } break; - case OP_XOR: + case OP_BIT_XOR: while (len--) { *dl++ = *ll++ ^ *rl++; *dl++ = *ll++ ^ *rl++; @@ -553,25 +574,30 @@ SV *right; len = remainder; } #endif - switch (optype) { - case OP_BIT_AND: - while (len--) - *dc++ = *lc++ & *rc++; - break; - case OP_XOR: - while (len--) - *dc++ = *lc++ ^ *rc++; - goto mop_up; - case OP_BIT_OR: - while (len--) - *dc++ = *lc++ | *rc++; - mop_up: - len = SvCUR(sv); - if (rightlen > len) - sv_catpvn(sv, SvPVX(right) + len, rightlen - len); - else if (leftlen > len) - sv_catpvn(sv, SvPVX(left) + len, leftlen - len); - break; + { + char *lsave = lc; + char *rsave = rc; + + switch (optype) { + case OP_BIT_AND: + while (len--) + *dc++ = *lc++ & *rc++; + break; + case OP_BIT_XOR: + while (len--) + *dc++ = *lc++ ^ *rc++; + goto mop_up; + case OP_BIT_OR: + while (len--) + *dc++ = *lc++ | *rc++; + mop_up: + len = lensave; + if (rightlen > len) + sv_catpvn(sv, rsave + len, rightlen - len); + else if (leftlen > len) + sv_catpvn(sv, lsave + len, leftlen - len); + break; + } } } @@ -581,13 +607,15 @@ dARGS { dSP; HV *hv = (HV*)POPs; - register AV *ary = stack; I32 i; register HE *entry; char *tmps; SV *tmpstr; - I32 dokeys = (op->op_type == OP_KEYS || op->op_type == OP_RV2HV); - I32 dovalues = (op->op_type == OP_VALUES || op->op_type == OP_RV2HV); + I32 dokeys = (op->op_type == OP_KEYS); + I32 dovalues = (op->op_type == OP_VALUES); + + if (op->op_type == OP_RV2HV || op->op_type == OP_PADHV) + dokeys = dovalues = TRUE; if (!hv) RETURN; diff --git a/dosish.h b/dosish.h index a7a498a..8747f2d 100644 --- a/dosish.h +++ b/dosish.h @@ -1 +1,14 @@ #define ABORT() abort(); + +/* + * fwrite1() should be a routine with the same calling sequence as fwrite(), + * but which outputs all of the bytes requested as a single stream (unlike + * fwrite() itself, which on some systems outputs several distinct records + * if the number_of_items parameter is >1). + */ +#define fwrite1 fwrite + +#define Stat(fname,bufptr) stat((fname),(bufptr)) +#define Fstat(fd,bufptr) fstat((fd),(bufptr)) + +#define my_getenv(var) getenv(var) diff --git a/dump.c b/dump.c index 932e1a2..e461abf 100644 --- a/dump.c +++ b/dump.c @@ -1,24 +1,15 @@ -/* $RCSfile: dump.c,v $$Revision: 4.1 $$Date: 92/08/07 17:20:03 $ +/* dump.c * - * Copyright (c) 1991, Larry Wall + * Copyright (c) 1991-1994, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. * - * $Log: dump.c,v $ - * Revision 4.1 92/08/07 17:20:03 lwall - * Stage 6 Snapshot - * - * Revision 4.0.1.2 92/06/08 13:14:22 lwall - * patch20: removed implicit int declarations on funcions - * patch20: fixed confusion between a *var's real name and its effective name - * - * Revision 4.0.1.1 91/06/07 10:58:44 lwall - * patch4: new copyright notice - * - * Revision 4.0 91/03/20 01:08:25 lwall - * 4.0 baseline. - * + */ + +/* + * "'You have talked long in your sleep, Frodo,' said Gandalf gently, 'and + * it has not been hard for me to read your mind and memory.'" */ #include "EXTERN.h" @@ -50,12 +41,12 @@ void dump_packsubs(stash) HV* stash; { - U32 i; + I32 i; HE *entry; if (!HvARRAY(stash)) return; - for (i = 0; i <= HvMAX(stash); i++) { + for (i = 0; i <= (I32) HvMAX(stash); i++) { for (entry = HvARRAY(stash)[i]; entry; entry = entry->hent_next) { GV *gv = (GV*)entry->hent_val; HV *hv; @@ -63,8 +54,8 @@ HV* stash; dump_sub(gv); if (GvFORM(gv)) dump_form(gv); - if (*entry->hent_key == '_' && (hv = GvHV(gv)) && HvNAME(hv) && - hv != defstash) + if (entry->hent_key[entry->hent_klen-1] == ':' && + (hv = GvHV(gv)) && HvNAME(hv) && hv != defstash) dump_packsubs(hv); /* nested package */ } } @@ -78,10 +69,10 @@ GV* gv; gv_fullname(sv,gv); dump("\nSUB %s = ", SvPVX(sv)); - if (CvUSERSUB(GvCV(gv))) + if (CvXSUB(GvCV(gv))) dump("(xsub 0x%x %d)\n", - (long)CvUSERSUB(GvCV(gv)), - CvUSERINDEX(GvCV(gv))); + (long)CvXSUB(GvCV(gv)), + CvXSUBANY(GvCV(gv)).any_i32); else if (CvROOT(GvCV(gv))) dump_op(CvROOT(GvCV(gv))); else @@ -105,10 +96,6 @@ GV* gv; void dump_eval() { - register I32 i; - register GV *gv; - register HE *entry; - dump_op(eval_root); } @@ -158,10 +145,10 @@ register OP *op; (void)strcat(buf,"PARENS,"); if (op->op_flags & OPf_STACKED) (void)strcat(buf,"STACKED,"); - if (op->op_flags & OPf_LVAL) - (void)strcat(buf,"LVAL,"); - if (op->op_flags & OPf_INTRO) - (void)strcat(buf,"INTRO,"); + if (op->op_flags & OPf_REF) + (void)strcat(buf,"REF,"); + if (op->op_flags & OPf_MOD) + (void)strcat(buf,"MOD,"); if (op->op_flags & OPf_SPECIAL) (void)strcat(buf,"SPECIAL,"); if (*buf) @@ -174,6 +161,10 @@ register OP *op; if (op->op_private & OPpASSIGN_COMMON) (void)strcat(buf,"COMMON,"); } + else if (op->op_type == OP_SASSIGN) { + if (op->op_private & OPpASSIGN_BACKWARDS) + (void)strcat(buf,"BACKWARDS,"); + } else if (op->op_type == OP_TRANS) { if (op->op_private & OPpTRANS_SQUASH) (void)strcat(buf,"SQUASH,"); @@ -186,7 +177,7 @@ register OP *op; if (op->op_private & OPpREPEAT_DOLIST) (void)strcat(buf,"DOLIST,"); } - else if (op->op_type == OP_ENTERSUBR || + else if (op->op_type == OP_ENTERSUB || op->op_type == OP_RV2SV || op->op_type == OP_RV2AV || op->op_type == OP_RV2HV || @@ -215,6 +206,8 @@ register OP *op; if (op->op_private & OPpFLIP_LINENUM) (void)strcat(buf,"LINENUM,"); } + if (op->op_flags & OPf_MOD && op->op_private & OPpLVAL_INTRO) + (void)strcat(buf,"INTRO,"); if (*buf) { buf[strlen(buf)-1] = '\0'; dump("PRIVATE = (%s)\n",buf); @@ -274,10 +267,10 @@ register OP *op; else fprintf(stderr, "DONE\n"); break; + case OP_MAPWHILE: case OP_GREPWHILE: case OP_OR: case OP_AND: - case OP_METHOD: dump("OTHER ===> "); if (cLOGOP->op_other) fprintf(stderr, "%d\n", cLOGOP->op_other->op_seq); @@ -289,6 +282,8 @@ register OP *op; case OP_SUBST: dump_pm((PMOP*)op); break; + default: + break; } if (op->op_flags & OPf_KIDS) { OP *kid; diff --git a/eg/relink b/eg/relink index 8c2b4c5..2c5793f 100644 --- a/eg/relink +++ b/eg/relink @@ -5,15 +5,6 @@ # $RCSfile: relink,v $$Revision: 4.1 $$Date: 92/08/07 17:20:29 $ # # $Log: relink,v $ -# Revision 4.1 92/08/07 17:20:29 lwall -# Stage 6 Snapshot -# -# Revision 4.0 91/03/20 01:11:40 lwall -# 4.0 baseline. -# -# Revision 3.0.1.2 90/08/09 03:17:44 lwall -# patch19: added man page for relink and rename -# ($op = shift) || die "Usage: relink perlexpr [filenames]\n"; if (!@ARGV) { diff --git a/eg/rename b/eg/rename index 0aedbb9..10e97f7 100755 --- a/eg/rename +++ b/eg/rename @@ -5,15 +5,6 @@ # $RCSfile: rename,v $$Revision: 4.1 $$Date: 92/08/07 17:20:30 $ # # $Log: rename,v $ -# Revision 4.1 92/08/07 17:20:30 lwall -# Stage 6 Snapshot -# -# Revision 4.0 91/03/20 01:11:53 lwall -# 4.0 baseline. -# -# Revision 3.0.1.2 90/08/09 03:17:57 lwall -# patch19: added man page for relink and rename -# ($op = shift) || die "Usage: rename perlexpr [filenames]\n"; if (!@ARGV) { diff --git a/eg/unuc.pats b/eg/unuc.pats deleted file mode 100644 index 6924dc6..0000000 --- a/eg/unuc.pats +++ /dev/null @@ -1,138 +0,0 @@ -A.M. -Air Force -Air Force Base -Air Force Station -American -Apr. -Ariane -Aug. -August -Bureau of Labor Statistics -CIT -Caltech -Cape Canaveral -Challenger -China -Corporation -Crippen -Daily News in Brief -Daniel Quayle -Dec. -Discovery -Edwards -Endeavour -Feb. -Ford Aerospace -Fri. -General Dynamics -George Bush -Headline News -HOTOL -I -II -III -IV -IX -Institute of Technology -JPL -Jan. -Jul. -Jun. -Kennedy Space Center -LDEF -Long Duration Exposure Facility -Long March -Mar. -March -Martin -Martin Marietta -Mercury -Mon. -in May -s/\bmay (\d)/May $1/g; -s/\boffice of (\w)/'Office of ' . (($tmp = $1) =~ y:a-z:A-Z:,$tmp)/eg; -National Science Foundation -NASA Select -New Mexico -Nov. -OMB -Oct. -Office of Management and Budget -President -President Bush -Richard Truly -Rocketdyne -Russian -Russians -Sat. -Sep. -Soviet -Soviet Union -Soviets -Space Shuttle -Sun. -Thu. -Tue. -U.S. -Union of Soviet Socialist Republics -United States -VI -VII -VIII -Vice President -Vice President Quayle -Wed. -White Sands -Kaman Aerospace -Aerospace Daily -Aviation Week -Space Technology -Washington Post -Los Angeles Times -New York Times -Aerospace Industries Association -president of -Johnson Space Center -Space Services -Inc. -Co. -Hughes Aircraft -Company -Orbital Sciences -Swedish Space -Arnauld -Nicogosian -Magellan -Galileo -Mir -Jet Propulsion Laboratory -University -Department of Defense -Orbital Science -OMS -United Press International -United Press -UPI -Associated Press -AP -Cable News Network -Cape York -Zenit -SYNCOM -Eastern -Western -Test Range -Jcsat -Japanese Satellite Communications -Defence Ministry -Defense Ministry -Skynet -Fixed Service Structure -Launch Processing System -Asiasat -Launch Control Center -Earth -CNES -Glavkosmos -Pacific -Atlantic diff --git a/eg/wrapsuid b/eg/wrapsuid new file mode 100755 index 0000000..3b1fc6e --- /dev/null +++ b/eg/wrapsuid @@ -0,0 +1,104 @@ +#!/usr/bin/perl +'di'; +'ig00'; +# +# $Header: wrapsuid,v 1.1 90/08/11 13:51:29 lwall Locked $ +# +# $Log: wrapsuid,v $ +# Revision 1.1 90/08/11 13:51:29 lwall +# Initial revision +# + +$xdev = '-xdev' unless -d '/dev/iop'; + +if ($#ARGV >= 0) { + @list = @ARGV; + foreach $name (@ARGV) { + die "You must use absolute pathnames.\n" unless $name =~ m|^/|; + } +} +else { + open(DF,"/etc/mount|") || die "Can't run /etc/mount"; + + while () { + chop; + $_ .= if length($_) < 50; + @ary = split; + push(@list,$ary[2]) if ($ary[0] =~ m|^/dev|); + } +} +$fslist = join(' ',@list); + +die "Can't find local filesystems" unless $fslist; + +open(FIND, + "find $fslist $xdev -type f \\( -perm -04000 -o -perm -02000 \\) -print|"); + +while () { + chop; + next unless -T; + print "Fixing ", $_, "\n"; + ($dir,$file) = m|(.*)/(.*)|; + chdir $dir || die "Can't chdir to $dir"; + ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, + $blksize,$blocks) = stat($file); + die "Can't stat $_" unless $ino; + chmod $mode & 01777, $file; # wipe out set[ug]id bits + rename($file,".$file"); + open(C,">.tmp$$.c") || die "Can't write C program for $_"; + $real = "$dir/.$file"; + print C ' +main(argc,argv) +int argc; +char **argv; +{ + execv("' . $real . '",argv); +} +'; + close C; + system '/bin/cc', ".tmp$$.c", '-o', $file; + die "Can't compile new $_" if $?; + chmod $mode, $file; + chown $uid, $gid, $file; + unlink ".tmp$$.c"; + chdir '/'; +} +############################################################################## + + # These next few lines are legal in both Perl and nroff. + +.00; # finish .ig + +'di \" finish diversion--previous line must be blank +.nr nl 0-1 \" fake up transition to first page again +.nr % 0 \" start at page 1 +'; __END__ ############# From here on it's a standard manual page ############ +.TH SUIDSCRIPT 1 "July 30, 1990" +.AT 3 +.SH NAME +wrapsuid \- puts a compiled C wrapper around a setuid or setgid script +.SH SYNOPSIS +.B wrapsuid [dirlist] +.SH DESCRIPTION +.I Wrapsuid +creates a small C program to execute a script with setuid or setgid privileges +without having to set the setuid or setgid bit on the script, which is +a security problem on many machines. +Specify the list of directories or files that you wish to process. +The names must be absolute pathnames. +With no arguments it will attempt to process all the local directories +for this machine. +The scripts to be processed must have the setuid or setgid bit set. +The wrapsuid program will delete the bits and set them on the wrapper. +.PP +Non-superusers may only process their own files. +.SH ENVIRONMENT +No environment variables are used. +.SH FILES +None. +.SH AUTHOR +Larry Wall +.SH "SEE ALSO" +.SH DIAGNOSTICS +.SH BUGS +.ex diff --git a/emacs/perldb.pl b/emacs/perldb.pl index 71c2d8c..958e58d 100644 --- a/emacs/perldb.pl +++ b/emacs/perldb.pl @@ -13,43 +13,6 @@ $header = '$RCSfile: perldb.pl,v $$Revision: 4.1 $$Date: 92/08/07 17:20:59 $'; # have a breakpoint. It also inserts a do 'perldb.pl' before the first line. # # $Log: perldb.pl,v $ -# Revision 4.1 92/08/07 17:20:59 lwall -# Stage 6 Snapshot -# -# Revision 4.0 91/03/20 01:18:58 lwall -# 4.0 baseline. -# -# Revision 3.0.1.6 91/01/11 18:08:58 lwall -# patch42: @_ couldn't be accessed from debugger -# -# Revision 3.0.1.5 90/11/10 01:40:26 lwall -# patch38: the debugger wouldn't stop correctly or do action routines -# -# Revision 3.0.1.4 90/10/15 17:40:38 lwall -# patch29: added caller -# patch29: the debugger now understands packages and evals -# patch29: scripts now run at almost full speed under the debugger -# patch29: more variables are settable from debugger -# -# Revision 3.0.1.3 90/08/09 04:00:58 lwall -# patch19: debugger now allows continuation lines -# patch19: debugger can now dump lists of variables -# patch19: debugger can now add aliases easily from prompt -# -# Revision 3.0.1.2 90/03/12 16:39:39 lwall -# patch13: perl -d didn't format stack traces of *foo right -# patch13: perl -d wiped out scalar return values of subroutines -# -# Revision 3.0.1.1 89/10/26 23:14:02 lwall -# patch1: RCS expanded an unintended $Header in lib/perldb.pl -# -# Revision 3.0 89/10/18 15:19:46 lwall -# 3.0 baseline -# -# Revision 2.0 88/06/05 00:09:45 root -# Baseline version 2.0. -# -# open(IN, "/dev/tty") || open(OUT, ">&STDOUT"); # so we don't dongle stdout diff --git a/embed.h b/embed.h index f797078..7ee837e 100644 --- a/embed.h +++ b/embed.h @@ -5,872 +5,978 @@ #ifdef EMBED /* globals we need to hide from the world */ -#define No perl_No -#define Sv perl_Sv -#define Xpv perl_Xpv -#define Yes perl_Yes -#define additem perl_additem -#define an perl_an -#define buf perl_buf -#define bufend perl_bufend -#define bufptr perl_bufptr -#define check perl_check -#define coeff perl_coeff -#define compiling perl_compiling -#define comppad perl_comppad -#define comppad_name perl_comppad_name -#define comppad_name_fill perl_comppad_name_fill -#define cop_seqmax perl_cop_seqmax -#define cryptseen perl_cryptseen -#define cshlen perl_cshlen -#define cshname perl_cshname -#define curinterp perl_curinterp -#define curpad perl_curpad -#define dc perl_dc -#define di perl_di -#define ds perl_ds -#define egid perl_egid -#define error_count perl_error_count -#define euid perl_euid -#define evalseq perl_evalseq -#define evstr perl_evstr -#define expect perl_expect -#define expectterm perl_expectterm -#define fold perl_fold -#define freq perl_freq -#define gid perl_gid -#define hexdigit perl_hexdigit -#define hints perl_hints -#define in_my perl_in_my -#define know_next perl_know_next -#define last_lop perl_last_lop -#define last_lop_op perl_last_lop_op -#define last_uni perl_last_uni -#define linestr perl_linestr -#define markstack perl_markstack -#define markstack_max perl_markstack_max -#define markstack_ptr perl_markstack_ptr -#define max_intro_pending perl_max_intro_pending -#define min_intro_pending perl_min_intro_pending -#define multi_close perl_multi_close -#define multi_end perl_multi_end -#define multi_open perl_multi_open -#define multi_start perl_multi_start -#define na perl_na -#define nexttype perl_nexttype -#define nextval perl_nextval -#define no_aelem perl_no_aelem -#define no_dir_func perl_no_dir_func -#define no_func perl_no_func -#define no_helem perl_no_helem -#define no_mem perl_no_mem -#define no_modify perl_no_modify -#define no_security perl_no_security -#define no_sock_func perl_no_sock_func -#define no_usym perl_no_usym -#define nointrp perl_nointrp -#define nomem perl_nomem -#define nomemok perl_nomemok -#define oldbufptr perl_oldbufptr -#define oldoldbufptr perl_oldoldbufptr -#define op perl_op -#define op_name perl_op_name -#define op_seqmax perl_op_seqmax -#define opargs perl_opargs -#define origalen perl_origalen -#define origenviron perl_origenviron -#define padix perl_padix -#define patleave perl_patleave -#define ppaddr perl_ppaddr -#define rcsid perl_rcsid -#define reall_srchlen perl_reall_srchlen -#define regarglen perl_regarglen -#define regbol perl_regbol -#define regcode perl_regcode -#define regdummy perl_regdummy -#define regendp perl_regendp -#define regeol perl_regeol -#define regfold perl_regfold -#define reginput perl_reginput -#define reglastparen perl_reglastparen -#define regmyendp perl_regmyendp -#define regmyp_size perl_regmyp_size -#define regmystartp perl_regmystartp -#define regnarrate perl_regnarrate -#define regnpar perl_regnpar -#define regparse perl_regparse -#define regprecomp perl_regprecomp -#define regprev perl_regprev -#define regsawback perl_regsawback -#define regsawbracket perl_regsawbracket -#define regsize perl_regsize -#define regstartp perl_regstartp -#define regtill perl_regtill -#define regxend perl_regxend -#define retstack perl_retstack -#define retstack_ix perl_retstack_ix -#define retstack_max perl_retstack_max -#define rsfp perl_rsfp -#define savestack perl_savestack -#define savestack_ix perl_savestack_ix -#define savestack_max perl_savestack_max -#define saw_return perl_saw_return -#define scopestack perl_scopestack -#define scopestack_ix perl_scopestack_ix -#define scopestack_max perl_scopestack_max -#define scrgv perl_scrgv -#define sig_name perl_sig_name -#define simple perl_simple -#define stack_base perl_stack_base -#define stack_max perl_stack_max -#define stack_sp perl_stack_sp -#define statbuf perl_statbuf -#define sub_generation perl_sub_generation -#define subline perl_subline -#define subname perl_subname -#define sv_no perl_sv_no -#define sv_undef perl_sv_undef -#define sv_yes perl_sv_yes -#define thisexpr perl_thisexpr -#define timesbuf perl_timesbuf -#define tokenbuf perl_tokenbuf -#define uid perl_uid -#define varies perl_varies -#define vert perl_vert -#define vtbl_arylen perl_vtbl_arylen -#define vtbl_bm perl_vtbl_bm -#define vtbl_dbline perl_vtbl_dbline -#define vtbl_env perl_vtbl_env -#define vtbl_envelem perl_vtbl_envelem -#define vtbl_glob perl_vtbl_glob -#define vtbl_isa perl_vtbl_isa -#define vtbl_isaelem perl_vtbl_isaelem -#define vtbl_mglob perl_vtbl_mglob -#define vtbl_pack perl_vtbl_pack -#define vtbl_packelem perl_vtbl_packelem -#define vtbl_sig perl_vtbl_sig -#define vtbl_sigelem perl_vtbl_sigelem -#define vtbl_substr perl_vtbl_substr -#define vtbl_sv perl_vtbl_sv -#define vtbl_taint perl_vtbl_taint -#define vtbl_uvar perl_vtbl_uvar -#define vtbl_vec perl_vtbl_vec -#define warn_nl perl_warn_nl -#define warn_nosemi perl_warn_nosemi -#define warn_reserved perl_warn_reserved -#define watchaddr perl_watchaddr -#define watchok perl_watchok -#define yychar perl_yychar -#define yycheck perl_yycheck -#define yydebug perl_yydebug -#define yydefred perl_yydefred -#define yydgoto perl_yydgoto -#define yyerrflag perl_yyerrflag -#define yygindex perl_yygindex -#define yylen perl_yylen -#define yylhs perl_yylhs -#define yylval perl_yylval -#define yyname perl_yyname -#define yynerrs perl_yynerrs -#define yyrindex perl_yyrindex -#define yyrule perl_yyrule -#define yysindex perl_yysindex -#define yytable perl_yytable -#define yyval perl_yyval -#define append_elem perl_append_elem -#define append_list perl_append_list -#define apply perl_apply -#define av_clear perl_av_clear -#define av_fake perl_av_fake -#define av_fetch perl_av_fetch -#define av_fill perl_av_fill -#define av_len perl_av_len -#define av_make perl_av_make -#define av_pop perl_av_pop -#define av_popnulls perl_av_popnulls -#define av_push perl_av_push -#define av_shift perl_av_shift -#define av_store perl_av_store -#define av_undef perl_av_undef -#define av_unshift perl_av_unshift -#define bind_match perl_bind_match -#define block_head perl_block_head -#define calllist perl_calllist -#define cando perl_cando -#define check_uni perl_check_uni -#define checkcomma perl_checkcomma -#define ck_aelem perl_ck_aelem -#define ck_chop perl_ck_chop -#define ck_concat perl_ck_concat -#define ck_eof perl_ck_eof -#define ck_eval perl_ck_eval -#define ck_exec perl_ck_exec -#define ck_formline perl_ck_formline -#define ck_ftst perl_ck_ftst -#define ck_fun perl_ck_fun -#define ck_glob perl_ck_glob -#define ck_grep perl_ck_grep -#define ck_gvconst perl_ck_gvconst -#define ck_index perl_ck_index -#define ck_lengthconst perl_ck_lengthconst -#define ck_lfun perl_ck_lfun -#define ck_listiob perl_ck_listiob -#define ck_match perl_ck_match -#define ck_null perl_ck_null -#define ck_repeat perl_ck_repeat -#define ck_retarget perl_ck_retarget -#define ck_rvconst perl_ck_rvconst -#define ck_select perl_ck_select -#define ck_shift perl_ck_shift -#define ck_sort perl_ck_sort -#define ck_split perl_ck_split -#define ck_subr perl_ck_subr -#define ck_trunc perl_ck_trunc -#define convert perl_convert -#define cpy7bit perl_cpy7bit -#define cpytill perl_cpytill -#define croak perl_croak -#define cv_undef perl_cv_undef -#define cxinc perl_cxinc -#define deb perl_deb -#define deb_growlevel perl_deb_growlevel -#define debop perl_debop -#define debstack perl_debstack -#define debstackptrs perl_debstackptrs -#define die perl_die -#define die_where perl_die_where -#define do_aexec perl_do_aexec -#define do_chop perl_do_chop -#define do_close perl_do_close -#define do_ctl perl_do_ctl -#define do_eof perl_do_eof -#define do_exec perl_do_exec -#define do_execfree perl_do_execfree -#define do_ipcctl perl_do_ipcctl -#define do_ipcget perl_do_ipcget -#define do_join perl_do_join -#define do_kv perl_do_kv -#define do_msgrcv perl_do_msgrcv -#define do_msgsnd perl_do_msgsnd -#define do_open perl_do_open -#define do_pipe perl_do_pipe -#define do_print perl_do_print -#define do_readline perl_do_readline -#define do_seek perl_do_seek -#define do_semop perl_do_semop -#define do_shmio perl_do_shmio -#define do_sprintf perl_do_sprintf -#define do_tell perl_do_tell -#define do_trans perl_do_trans -#define do_vecset perl_do_vecset -#define do_vop perl_do_vop -#define doeval perl_doeval -#define dofindlabel perl_dofindlabel -#define dopoptoeval perl_dopoptoeval -#define dump_all perl_dump_all -#define dump_eval perl_dump_eval -#define dump_gv perl_dump_gv -#define dump_op perl_dump_op -#define dump_packsubs perl_dump_packsubs -#define dump_pm perl_dump_pm -#define dump_sub perl_dump_sub -#define fbm_compile perl_fbm_compile -#define fbm_instr perl_fbm_instr -#define fetch_gv perl_fetch_gv -#define fetch_io perl_fetch_io -#define fetch_stash perl_fetch_stash -#define fold_constants perl_fold_constants -#define force_ident perl_force_ident -#define force_next perl_force_next -#define force_word perl_force_word -#define free_tmps perl_free_tmps -#define gen_constant_list perl_gen_constant_list -#define getgimme perl_getgimme -#define gp_free perl_gp_free -#define gp_ref perl_gp_ref -#define gv_AVadd perl_gv_AVadd -#define gv_HVadd perl_gv_HVadd -#define gv_check perl_gv_check -#define gv_efullname perl_gv_efullname -#define gv_fetchfile perl_gv_fetchfile -#define gv_fetchmeth perl_gv_fetchmeth -#define gv_fetchmethod perl_gv_fetchmethod -#define gv_fetchpv perl_gv_fetchpv -#define gv_fullname perl_gv_fullname -#define gv_init perl_gv_init -#define he_delayfree perl_he_delayfree -#define he_free perl_he_free -#define hint perl_hint -#define hoistmust perl_hoistmust -#define hv_clear perl_hv_clear -#define hv_delete perl_hv_delete -#define hv_fetch perl_hv_fetch -#define hv_iterinit perl_hv_iterinit -#define hv_iterkey perl_hv_iterkey -#define hv_iternext perl_hv_iternext -#define hv_iterval perl_hv_iterval -#define hv_magic perl_hv_magic -#define hv_store perl_hv_store -#define hv_undef perl_hv_undef -#define ibcmp perl_ibcmp -#define ingroup perl_ingroup -#define instr perl_instr -#define intuit_more perl_intuit_more -#define invert perl_invert -#define jmaybe perl_jmaybe -#define keyword perl_keyword -#define leave_scope perl_leave_scope -#define lex_end perl_lex_end -#define lex_start perl_lex_start -#define linklist perl_linklist -#define list perl_list -#define listkids perl_listkids -#define localize perl_localize -#define looks_like_number perl_looks_like_number -#define magic_clearpack perl_magic_clearpack -#define magic_get perl_magic_get -#define magic_getarylen perl_magic_getarylen -#define magic_getglob perl_magic_getglob -#define magic_getpack perl_magic_getpack -#define magic_gettaint perl_magic_gettaint -#define magic_getuvar perl_magic_getuvar -#define magic_len perl_magic_len -#define magic_nextpack perl_magic_nextpack -#define magic_set perl_magic_set -#define magic_setarylen perl_magic_setarylen -#define magic_setbm perl_magic_setbm -#define magic_setdbline perl_magic_setdbline -#define magic_setenv perl_magic_setenv -#define magic_setglob perl_magic_setglob -#define magic_setisa perl_magic_setisa -#define magic_setmglob perl_magic_setmglob -#define magic_setpack perl_magic_setpack -#define magic_setsig perl_magic_setsig -#define magic_setsubstr perl_magic_setsubstr -#define magic_settaint perl_magic_settaint -#define magic_setuvar perl_magic_setuvar -#define magic_setvec perl_magic_setvec -#define magicname perl_magicname -#define mess perl_mess -#define mg_clear perl_mg_clear -#define mg_copy perl_mg_copy -#define mg_find perl_mg_find -#define mg_free perl_mg_free -#define mg_get perl_mg_get -#define mg_len perl_mg_len -#define mg_magical perl_mg_magical -#define mg_set perl_mg_set -#define mod perl_mod -#define modkids perl_modkids -#define moreswitches perl_moreswitches -#define my perl_my -#define my_exit perl_my_exit -#define my_lstat perl_my_lstat -#define my_pclose perl_my_pclose -#define my_popen perl_my_popen -#define my_setenv perl_my_setenv -#define my_stat perl_my_stat -#define my_unexec perl_my_unexec -#define newANONHASH perl_newANONHASH -#define newANONLIST perl_newANONLIST -#define newASSIGNOP perl_newASSIGNOP -#define newAV perl_newAV -#define newAVREF perl_newAVREF -#define newBINOP perl_newBINOP -#define newCONDOP perl_newCONDOP -#define newCVOP perl_newCVOP -#define newCVREF perl_newCVREF -#define newFORM perl_newFORM -#define newFOROP perl_newFOROP -#define newGVOP perl_newGVOP -#define newGVREF perl_newGVREF -#define newGVgen perl_newGVgen -#define newHV perl_newHV -#define newHVREF perl_newHVREF -#define newIO perl_newIO -#define newLISTOP perl_newLISTOP -#define newLOGOP perl_newLOGOP -#define newLOOPEX perl_newLOOPEX -#define newLOOPOP perl_newLOOPOP -#define newMETHOD perl_newMETHOD -#define newNULLLIST perl_newNULLLIST -#define newOP perl_newOP -#define newPMOP perl_newPMOP -#define newPVOP perl_newPVOP -#define newRANGE perl_newRANGE -#define newSLICEOP perl_newSLICEOP -#define newSTATEOP perl_newSTATEOP -#define newSUB perl_newSUB -#define newSV perl_newSV -#define newSVOP perl_newSVOP -#define newSVREF perl_newSVREF -#define newSViv perl_newSViv -#define newSVnv perl_newSVnv -#define newSVpv perl_newSVpv -#define newSVsv perl_newSVsv -#define newUNOP perl_newUNOP -#define newWHILEOP perl_newWHILEOP -#define newXSUB perl_newXSUB -#define nextargv perl_nextargv -#define ninstr perl_ninstr -#define no_fh_allowed perl_no_fh_allowed -#define no_op perl_no_op -#define nsavestr perl_nsavestr -#define oopsAV perl_oopsAV -#define oopsCV perl_oopsCV -#define oopsHV perl_oopsHV -#define op_free perl_op_free -#define package perl_package -#define pad_alloc perl_pad_alloc -#define pad_allocmy perl_pad_allocmy -#define pad_findmy perl_pad_findmy -#define pad_free perl_pad_free -#define pad_leavemy perl_pad_leavemy -#define pad_reset perl_pad_reset -#define pad_sv perl_pad_sv -#define pad_swipe perl_pad_swipe -#define peep perl_peep -#define pidgone perl_pidgone -#define pmruntime perl_pmruntime -#define pmtrans perl_pmtrans -#define pop_return perl_pop_return -#define pop_scope perl_pop_scope -#define pp_aassign perl_pp_aassign -#define pp_accept perl_pp_accept -#define pp_add perl_pp_add -#define pp_aelem perl_pp_aelem -#define pp_aelemfast perl_pp_aelemfast -#define pp_alarm perl_pp_alarm -#define pp_and perl_pp_and -#define pp_andassign perl_pp_andassign -#define pp_anonhash perl_pp_anonhash -#define pp_anonlist perl_pp_anonlist -#define pp_aslice perl_pp_aslice -#define pp_atan2 perl_pp_atan2 -#define pp_av2arylen perl_pp_av2arylen -#define pp_backtick perl_pp_backtick -#define pp_bind perl_pp_bind -#define pp_binmode perl_pp_binmode -#define pp_bit_and perl_pp_bit_and -#define pp_bit_or perl_pp_bit_or -#define pp_bless perl_pp_bless -#define pp_caller perl_pp_caller -#define pp_chdir perl_pp_chdir -#define pp_chmod perl_pp_chmod -#define pp_chop perl_pp_chop -#define pp_chown perl_pp_chown -#define pp_chroot perl_pp_chroot -#define pp_close perl_pp_close -#define pp_closedir perl_pp_closedir -#define pp_complement perl_pp_complement -#define pp_concat perl_pp_concat -#define pp_cond_expr perl_pp_cond_expr -#define pp_connect perl_pp_connect -#define pp_const perl_pp_const -#define pp_cos perl_pp_cos -#define pp_crypt perl_pp_crypt -#define pp_cswitch perl_pp_cswitch -#define pp_dbmclose perl_pp_dbmclose -#define pp_dbmopen perl_pp_dbmopen -#define pp_dbstate perl_pp_dbstate -#define pp_defined perl_pp_defined -#define pp_delete perl_pp_delete -#define pp_die perl_pp_die -#define pp_divide perl_pp_divide -#define pp_dofile perl_pp_dofile -#define pp_done perl_pp_done -#define pp_dump perl_pp_dump -#define pp_each perl_pp_each -#define pp_egrent perl_pp_egrent -#define pp_ehostent perl_pp_ehostent -#define pp_enetent perl_pp_enetent -#define pp_enter perl_pp_enter -#define pp_entereval perl_pp_entereval -#define pp_enteriter perl_pp_enteriter -#define pp_enterloop perl_pp_enterloop -#define pp_entersubr perl_pp_entersubr -#define pp_entertry perl_pp_entertry -#define pp_enterwrite perl_pp_enterwrite -#define pp_eof perl_pp_eof -#define pp_eprotoent perl_pp_eprotoent -#define pp_epwent perl_pp_epwent -#define pp_eq perl_pp_eq -#define pp_eservent perl_pp_eservent -#define pp_evalonce perl_pp_evalonce -#define pp_exec perl_pp_exec -#define pp_exit perl_pp_exit -#define pp_exp perl_pp_exp -#define pp_fcntl perl_pp_fcntl -#define pp_fileno perl_pp_fileno -#define pp_flip perl_pp_flip -#define pp_flock perl_pp_flock -#define pp_flop perl_pp_flop -#define pp_fork perl_pp_fork -#define pp_formline perl_pp_formline -#define pp_ftatime perl_pp_ftatime -#define pp_ftbinary perl_pp_ftbinary -#define pp_ftblk perl_pp_ftblk -#define pp_ftchr perl_pp_ftchr -#define pp_ftctime perl_pp_ftctime -#define pp_ftdir perl_pp_ftdir -#define pp_fteexec perl_pp_fteexec -#define pp_fteowned perl_pp_fteowned -#define pp_fteread perl_pp_fteread -#define pp_ftewrite perl_pp_ftewrite -#define pp_ftfile perl_pp_ftfile -#define pp_ftis perl_pp_ftis -#define pp_ftlink perl_pp_ftlink -#define pp_ftmtime perl_pp_ftmtime -#define pp_ftpipe perl_pp_ftpipe -#define pp_ftrexec perl_pp_ftrexec -#define pp_ftrowned perl_pp_ftrowned -#define pp_ftrread perl_pp_ftrread -#define pp_ftrwrite perl_pp_ftrwrite -#define pp_ftsgid perl_pp_ftsgid -#define pp_ftsize perl_pp_ftsize -#define pp_ftsock perl_pp_ftsock -#define pp_ftsuid perl_pp_ftsuid -#define pp_ftsvtx perl_pp_ftsvtx -#define pp_fttext perl_pp_fttext -#define pp_fttty perl_pp_fttty -#define pp_ftzero perl_pp_ftzero -#define pp_ge perl_pp_ge -#define pp_getc perl_pp_getc -#define pp_getlogin perl_pp_getlogin -#define pp_getpeername perl_pp_getpeername -#define pp_getpgrp perl_pp_getpgrp -#define pp_getppid perl_pp_getppid -#define pp_getpriority perl_pp_getpriority -#define pp_getsockname perl_pp_getsockname -#define pp_ggrent perl_pp_ggrent -#define pp_ggrgid perl_pp_ggrgid -#define pp_ggrnam perl_pp_ggrnam -#define pp_ghbyaddr perl_pp_ghbyaddr -#define pp_ghbyname perl_pp_ghbyname -#define pp_ghostent perl_pp_ghostent -#define pp_glob perl_pp_glob -#define pp_gmtime perl_pp_gmtime -#define pp_gnbyaddr perl_pp_gnbyaddr -#define pp_gnbyname perl_pp_gnbyname -#define pp_gnetent perl_pp_gnetent -#define pp_goto perl_pp_goto -#define pp_gpbyname perl_pp_gpbyname -#define pp_gpbynumber perl_pp_gpbynumber -#define pp_gprotoent perl_pp_gprotoent -#define pp_gpwent perl_pp_gpwent -#define pp_gpwnam perl_pp_gpwnam -#define pp_gpwuid perl_pp_gpwuid -#define pp_grepstart perl_pp_grepstart -#define pp_grepwhile perl_pp_grepwhile -#define pp_gsbyname perl_pp_gsbyname -#define pp_gsbyport perl_pp_gsbyport -#define pp_gservent perl_pp_gservent -#define pp_gsockopt perl_pp_gsockopt -#define pp_gt perl_pp_gt -#define pp_gv perl_pp_gv -#define pp_gvsv perl_pp_gvsv -#define pp_helem perl_pp_helem -#define pp_hex perl_pp_hex -#define pp_hslice perl_pp_hslice -#define pp_index perl_pp_index -#define pp_indread perl_pp_indread -#define pp_int perl_pp_int -#define pp_interp perl_pp_interp -#define pp_ioctl perl_pp_ioctl -#define pp_iter perl_pp_iter -#define pp_join perl_pp_join -#define pp_keys perl_pp_keys -#define pp_kill perl_pp_kill -#define pp_last perl_pp_last -#define pp_lc perl_pp_lc -#define pp_lcfirst perl_pp_lcfirst -#define pp_le perl_pp_le -#define pp_leave perl_pp_leave -#define pp_leaveeval perl_pp_leaveeval -#define pp_leaveloop perl_pp_leaveloop -#define pp_leavesubr perl_pp_leavesubr -#define pp_leavetry perl_pp_leavetry -#define pp_leavewrite perl_pp_leavewrite -#define pp_left_shift perl_pp_left_shift -#define pp_length perl_pp_length -#define pp_lineseq perl_pp_lineseq -#define pp_link perl_pp_link -#define pp_list perl_pp_list -#define pp_listen perl_pp_listen -#define pp_localtime perl_pp_localtime -#define pp_log perl_pp_log -#define pp_lslice perl_pp_lslice -#define pp_lstat perl_pp_lstat -#define pp_lt perl_pp_lt -#define pp_match perl_pp_match -#define pp_method perl_pp_method -#define pp_mkdir perl_pp_mkdir -#define pp_modulo perl_pp_modulo -#define pp_msgctl perl_pp_msgctl -#define pp_msgget perl_pp_msgget -#define pp_msgrcv perl_pp_msgrcv -#define pp_msgsnd perl_pp_msgsnd -#define pp_multiply perl_pp_multiply -#define pp_ncmp perl_pp_ncmp -#define pp_ne perl_pp_ne -#define pp_negate perl_pp_negate -#define pp_next perl_pp_next -#define pp_nextstate perl_pp_nextstate -#define pp_not perl_pp_not -#define pp_nswitch perl_pp_nswitch -#define pp_null perl_pp_null -#define pp_oct perl_pp_oct -#define pp_open perl_pp_open -#define pp_open_dir perl_pp_open_dir -#define pp_or perl_pp_or -#define pp_orassign perl_pp_orassign -#define pp_ord perl_pp_ord -#define pp_pack perl_pp_pack -#define pp_padav perl_pp_padav -#define pp_padhv perl_pp_padhv -#define pp_padsv perl_pp_padsv -#define pp_pipe_op perl_pp_pipe_op -#define pp_pop perl_pp_pop -#define pp_postdec perl_pp_postdec -#define pp_postinc perl_pp_postinc -#define pp_pow perl_pp_pow -#define pp_predec perl_pp_predec -#define pp_preinc perl_pp_preinc -#define pp_print perl_pp_print -#define pp_prtf perl_pp_prtf -#define pp_push perl_pp_push -#define pp_pushmark perl_pp_pushmark -#define pp_pushre perl_pp_pushre -#define pp_rand perl_pp_rand -#define pp_range perl_pp_range -#define pp_rcatline perl_pp_rcatline -#define pp_read perl_pp_read -#define pp_readdir perl_pp_readdir -#define pp_readline perl_pp_readline -#define pp_readlink perl_pp_readlink -#define pp_recv perl_pp_recv -#define pp_redo perl_pp_redo -#define pp_ref perl_pp_ref -#define pp_refgen perl_pp_refgen -#define pp_regcmaybe perl_pp_regcmaybe -#define pp_regcomp perl_pp_regcomp -#define pp_rename perl_pp_rename -#define pp_repeat perl_pp_repeat -#define pp_require perl_pp_require -#define pp_reset perl_pp_reset -#define pp_return perl_pp_return -#define pp_reverse perl_pp_reverse -#define pp_rewinddir perl_pp_rewinddir -#define pp_right_shift perl_pp_right_shift -#define pp_rindex perl_pp_rindex -#define pp_rmdir perl_pp_rmdir -#define pp_rv2av perl_pp_rv2av -#define pp_rv2cv perl_pp_rv2cv -#define pp_rv2gv perl_pp_rv2gv -#define pp_rv2hv perl_pp_rv2hv -#define pp_rv2sv perl_pp_rv2sv -#define pp_sassign perl_pp_sassign -#define pp_scalar perl_pp_scalar -#define pp_schop perl_pp_schop -#define pp_scmp perl_pp_scmp -#define pp_scope perl_pp_scope -#define pp_seek perl_pp_seek -#define pp_seekdir perl_pp_seekdir -#define pp_select perl_pp_select -#define pp_semctl perl_pp_semctl -#define pp_semget perl_pp_semget -#define pp_semop perl_pp_semop -#define pp_send perl_pp_send -#define pp_seq perl_pp_seq -#define pp_setpgrp perl_pp_setpgrp -#define pp_setpriority perl_pp_setpriority -#define pp_sge perl_pp_sge -#define pp_sgrent perl_pp_sgrent -#define pp_sgt perl_pp_sgt -#define pp_shift perl_pp_shift -#define pp_shmctl perl_pp_shmctl -#define pp_shmget perl_pp_shmget -#define pp_shmread perl_pp_shmread -#define pp_shmwrite perl_pp_shmwrite -#define pp_shostent perl_pp_shostent -#define pp_shutdown perl_pp_shutdown -#define pp_sin perl_pp_sin -#define pp_sle perl_pp_sle -#define pp_sleep perl_pp_sleep -#define pp_slt perl_pp_slt -#define pp_sne perl_pp_sne -#define pp_snetent perl_pp_snetent -#define pp_socket perl_pp_socket -#define pp_sockpair perl_pp_sockpair -#define pp_sort perl_pp_sort -#define pp_splice perl_pp_splice -#define pp_split perl_pp_split -#define pp_sprintf perl_pp_sprintf -#define pp_sprotoent perl_pp_sprotoent -#define pp_spwent perl_pp_spwent -#define pp_sqrt perl_pp_sqrt -#define pp_srand perl_pp_srand -#define pp_sselect perl_pp_sselect -#define pp_sservent perl_pp_sservent -#define pp_ssockopt perl_pp_ssockopt -#define pp_stat perl_pp_stat -#define pp_stub perl_pp_stub -#define pp_study perl_pp_study -#define pp_subst perl_pp_subst -#define pp_substcont perl_pp_substcont -#define pp_substr perl_pp_substr -#define pp_subtract perl_pp_subtract -#define pp_sv2len perl_pp_sv2len -#define pp_symlink perl_pp_symlink -#define pp_syscall perl_pp_syscall -#define pp_sysread perl_pp_sysread -#define pp_system perl_pp_system -#define pp_syswrite perl_pp_syswrite -#define pp_tell perl_pp_tell -#define pp_telldir perl_pp_telldir -#define pp_tie perl_pp_tie -#define pp_time perl_pp_time -#define pp_tms perl_pp_tms -#define pp_trans perl_pp_trans -#define pp_truncate perl_pp_truncate -#define pp_uc perl_pp_uc -#define pp_ucfirst perl_pp_ucfirst -#define pp_umask perl_pp_umask -#define pp_undef perl_pp_undef -#define pp_unlink perl_pp_unlink -#define pp_unpack perl_pp_unpack -#define pp_unshift perl_pp_unshift -#define pp_unstack perl_pp_unstack -#define pp_untie perl_pp_untie -#define pp_utime perl_pp_utime -#define pp_values perl_pp_values -#define pp_vec perl_pp_vec -#define pp_wait perl_pp_wait -#define pp_waitpid perl_pp_waitpid -#define pp_wantarray perl_pp_wantarray -#define pp_warn perl_pp_warn -#define pp_xor perl_pp_xor -#define prepend_elem perl_prepend_elem -#define push_return perl_push_return -#define push_scope perl_push_scope -#define q perl_q -#define ref perl_ref -#define refkids perl_refkids -#define regcomp perl_regcomp -#define regdump perl_regdump -#define regexec perl_regexec -#define regfree perl_regfree -#define regnext perl_regnext -#define regprop perl_regprop -#define repeatcpy perl_repeatcpy -#define rninstr perl_rninstr -#define run perl_run -#define save_I32 perl_save_I32 -#define save_aptr perl_save_aptr -#define save_ary perl_save_ary -#define save_clearsv perl_save_clearsv -#define save_delete perl_save_delete -#define save_freeop perl_save_freeop -#define save_freepv perl_save_freepv -#define save_freesv perl_save_freesv -#define save_hash perl_save_hash -#define save_hptr perl_save_hptr -#define save_int perl_save_int -#define save_item perl_save_item -#define save_list perl_save_list -#define save_nogv perl_save_nogv -#define save_scalar perl_save_scalar -#define save_sptr perl_save_sptr -#define save_svref perl_save_svref -#define savestack_grow perl_savestack_grow -#define savestr perl_savestr -#define sawparens perl_sawparens -#define scalar perl_scalar -#define scalarkids perl_scalarkids -#define scalarseq perl_scalarseq -#define scalarvoid perl_scalarvoid -#define scan_const perl_scan_const -#define scan_formline perl_scan_formline -#define scan_heredoc perl_scan_heredoc -#define scan_hex perl_scan_hex -#define scan_ident perl_scan_ident -#define scan_inputsymbol perl_scan_inputsymbol -#define scan_num perl_scan_num -#define scan_oct perl_scan_oct -#define scan_pat perl_scan_pat -#define scan_prefix perl_scan_prefix -#define scan_str perl_scan_str -#define scan_subst perl_scan_subst -#define scan_trans perl_scan_trans -#define scan_word perl_scan_word -#define scope perl_scope -#define screaminstr perl_screaminstr -#define setenv_getix perl_setenv_getix -#define skipspace perl_skipspace -#define start_subparse perl_start_subparse -#define sublex_done perl_sublex_done -#define sublex_start perl_sublex_start -#define sv_2bool perl_sv_2bool -#define sv_2cv perl_sv_2cv -#define sv_2iv perl_sv_2iv -#define sv_2mortal perl_sv_2mortal -#define sv_2nv perl_sv_2nv -#define sv_2pv perl_sv_2pv -#define sv_backoff perl_sv_backoff -#define sv_catpv perl_sv_catpv -#define sv_catpvn perl_sv_catpvn -#define sv_catsv perl_sv_catsv -#define sv_chop perl_sv_chop -#define sv_clean_all perl_sv_clean_all -#define sv_clean_magic perl_sv_clean_magic -#define sv_clean_refs perl_sv_clean_refs -#define sv_clear perl_sv_clear -#define sv_cmp perl_sv_cmp -#define sv_dec perl_sv_dec -#define sv_dump perl_sv_dump -#define sv_eq perl_sv_eq -#define sv_free perl_sv_free -#define sv_gets perl_sv_gets -#define sv_grow perl_sv_grow -#define sv_inc perl_sv_inc -#define sv_insert perl_sv_insert -#define sv_isa perl_sv_isa -#define sv_len perl_sv_len -#define sv_magic perl_sv_magic -#define sv_mortalcopy perl_sv_mortalcopy -#define sv_newmortal perl_sv_newmortal -#define sv_peek perl_sv_peek -#define sv_ref perl_sv_ref -#define sv_replace perl_sv_replace -#define sv_report_used perl_sv_report_used -#define sv_reset perl_sv_reset -#define sv_setiv perl_sv_setiv -#define sv_setnv perl_sv_setnv -#define sv_setptrobj perl_sv_setptrobj -#define sv_setpv perl_sv_setpv -#define sv_setpvn perl_sv_setpvn -#define sv_setsv perl_sv_setsv -#define sv_unmagic perl_sv_unmagic -#define sv_upgrade perl_sv_upgrade -#define sv_usepvn perl_sv_usepvn -#define taint_env perl_taint_env -#define taint_not perl_taint_not -#define taint_proper perl_taint_proper -#define too_few_arguments perl_too_few_arguments -#define too_many_arguments perl_too_many_arguments -#define wait4pid perl_wait4pid -#define warn perl_warn -#define watch perl_watch -#define whichsig perl_whichsig -#define xiv_root perl_xiv_root -#define xnv_root perl_xnv_root -#define xpv_root perl_xpv_root -#define xrv_root perl_xrv_root -#define yyerror perl_yyerror -#define yyerror perl_yyerror -#define yylex perl_yylex -#define yyparse perl_yyparse -#define yywarn perl_yywarn +#define AMG_names Perl_AMG_names +#define No Perl_No +#define Sv Perl_Sv +#define Xpv Perl_Xpv +#define Yes Perl_Yes +#define abs_amg Perl_abs_amg +#define add_amg Perl_add_amg +#define add_ass_amg Perl_add_ass_amg +#define additem Perl_additem +#define amagic_generation Perl_amagic_generation +#define an Perl_an +#define atan2_amg Perl_atan2_amg +#define autoboot_preamble Perl_autoboot_preamble +#define band_amg Perl_band_amg +#define bool__amg Perl_bool__amg +#define bor_amg Perl_bor_amg +#define buf Perl_buf +#define bufend Perl_bufend +#define bufptr Perl_bufptr +#define bxor_amg Perl_bxor_amg +#define check Perl_check +#define coeff Perl_coeff +#define compiling Perl_compiling +#define compl_amg Perl_compl_amg +#define comppad Perl_comppad +#define comppad_name Perl_comppad_name +#define comppad_name_fill Perl_comppad_name_fill +#define concat_amg Perl_concat_amg +#define concat_ass_amg Perl_concat_ass_amg +#define cop_seqmax Perl_cop_seqmax +#define cos_amg Perl_cos_amg +#define cryptseen Perl_cryptseen +#define cryptswitch_add Perl_cryptswitch_add +#define cshlen Perl_cshlen +#define cshname Perl_cshname +#define curcop Perl_curcop +#define curinterp Perl_curinterp +#define curpad Perl_curpad +#define dc Perl_dc +#define dec_amg Perl_dec_amg +#define di Perl_di +#define div_amg Perl_div_amg +#define div_ass_amg Perl_div_ass_amg +#define ds Perl_ds +#define egid Perl_egid +#define envgv Perl_envgv +#define eq_amg Perl_eq_amg +#define error_count Perl_error_count +#define euid Perl_euid +#define evalseq Perl_evalseq +#define exp_amg Perl_exp_amg +#define expect Perl_expect +#define expectterm Perl_expectterm +#define fallback_amg Perl_fallback_amg +#define fold Perl_fold +#define freq Perl_freq +#define ge_amg Perl_ge_amg +#define gid Perl_gid +#define gt_amg Perl_gt_amg +#define hexdigit Perl_hexdigit +#define hints Perl_hints +#define in_my Perl_in_my +#define inc_amg Perl_inc_amg +#define know_next Perl_know_next +#define last_lop Perl_last_lop +#define last_lop_op Perl_last_lop_op +#define last_uni Perl_last_uni +#define le_amg Perl_le_amg +#define lex_state Perl_lex_state +#define lex_defer Perl_lex_defer +#define lex_expect Perl_lex_expect +#define lex_brackets Perl_lex_brackets +#define lex_formbrack Perl_lex_formbrack +#define lex_fakebrack Perl_lex_fakebrack +#define lex_casemods Perl_lex_casemods +#define lex_dojoin Perl_lex_dojoin +#define lex_starts Perl_lex_starts +#define lex_stuff Perl_lex_stuff +#define lex_repl Perl_lex_repl +#define lex_op Perl_lex_op +#define lex_inpat Perl_lex_inpat +#define lex_inwhat Perl_lex_inwhat +#define lex_brackstack Perl_lex_brackstack +#define lex_casestack Perl_lex_casestack +#define linestr Perl_linestr +#define log_amg Perl_log_amg +#define lshift_amg Perl_lshift_amg +#define lshift_ass_amg Perl_lshift_ass_amg +#define lt_amg Perl_lt_amg +#define markstack Perl_markstack +#define markstack_max Perl_markstack_max +#define markstack_ptr Perl_markstack_ptr +#define max_intro_pending Perl_max_intro_pending +#define min_intro_pending Perl_min_intro_pending +#define mod_amg Perl_mod_amg +#define mod_ass_amg Perl_mod_ass_amg +#define mult_amg Perl_mult_amg +#define mult_ass_amg Perl_mult_ass_amg +#define multi_close Perl_multi_close +#define multi_end Perl_multi_end +#define multi_open Perl_multi_open +#define multi_start Perl_multi_start +#define na Perl_na +#define ncmp_amg Perl_ncmp_amg +#define nextval Perl_nextval +#define nexttype Perl_nexttype +#define nexttoke Perl_nexttoke +#define ne_amg Perl_ne_amg +#define neg_amg Perl_neg_amg +#define nexttype Perl_nexttype +#define nextval Perl_nextval +#define no_aelem Perl_no_aelem +#define no_dir_func Perl_no_dir_func +#define no_func Perl_no_func +#define no_helem Perl_no_helem +#define no_mem Perl_no_mem +#define no_modify Perl_no_modify +#define no_security Perl_no_security +#define no_sock_func Perl_no_sock_func +#define no_usym Perl_no_usym +#define nointrp Perl_nointrp +#define nomem Perl_nomem +#define nomemok Perl_nomemok +#define nomethod_amg Perl_nomethod_amg +#define not_amg Perl_not_amg +#define numer_amg Perl_numer_amg +#define oldbufptr Perl_oldbufptr +#define oldoldbufptr Perl_oldoldbufptr +#define op Perl_op +#define op_name Perl_op_name +#define op_seqmax Perl_op_seqmax +#define opargs Perl_opargs +#define origalen Perl_origalen +#define origenviron Perl_origenviron +#define padix Perl_padix +#define patleave Perl_patleave +#define pow_amg Perl_pow_amg +#define pow_ass_amg Perl_pow_ass_amg +#define ppaddr Perl_ppaddr +#define profiledata Perl_profiledata +#define qrt_amg Perl_qrt_amg +#define rcsid Perl_rcsid +#define reall_srchlen Perl_reall_srchlen +#define regarglen Perl_regarglen +#define regbol Perl_regbol +#define regcode Perl_regcode +#define regdummy Perl_regdummy +#define regendp Perl_regendp +#define regeol Perl_regeol +#define regfold Perl_regfold +#define reginput Perl_reginput +#define reglastparen Perl_reglastparen +#define regmyendp Perl_regmyendp +#define regmyp_size Perl_regmyp_size +#define regmystartp Perl_regmystartp +#define regnarrate Perl_regnarrate +#define regnaughty Perl_regnaughty +#define regnpar Perl_regnpar +#define regparse Perl_regparse +#define regprecomp Perl_regprecomp +#define regprev Perl_regprev +#define regsawback Perl_regsawback +#define regsize Perl_regsize +#define regstartp Perl_regstartp +#define regtill Perl_regtill +#define regxend Perl_regxend +#define repeat_amg Perl_repeat_amg +#define repeat_ass_amg Perl_repeat_ass_amg +#define retstack Perl_retstack +#define retstack_ix Perl_retstack_ix +#define retstack_max Perl_retstack_max +#define rsfp Perl_rsfp +#define rshift_amg Perl_rshift_amg +#define rshift_ass_amg Perl_rshift_ass_amg +#define savestack Perl_savestack +#define savestack_ix Perl_savestack_ix +#define savestack_max Perl_savestack_max +#define saw_return Perl_saw_return +#define scmp_amg Perl_scmp_amg +#define scopestack Perl_scopestack +#define scopestack_ix Perl_scopestack_ix +#define scopestack_max Perl_scopestack_max +#define scrgv Perl_scrgv +#define seq_amg Perl_seq_amg +#define sge_amg Perl_sge_amg +#define sgt_amg Perl_sgt_amg +#define sig_name Perl_sig_name +#define siggv Perl_siggv +#define sighandler Perl_sighandler +#define simple Perl_simple +#define sin_amg Perl_sin_amg +#define sle_amg Perl_sle_amg +#define slt_amg Perl_slt_amg +#define sne_amg Perl_sne_amg +#define stack Perl_stack +#define stack_base Perl_stack_base +#define stack_max Perl_stack_max +#define stack_sp Perl_stack_sp +#define statbuf Perl_statbuf +#define string_amg Perl_string_amg +#define sub_generation Perl_sub_generation +#define subline Perl_subline +#define subname Perl_subname +#define subtr_amg Perl_subtr_amg +#define subtr_ass_amg Perl_subtr_ass_amg +#define sv_no Perl_sv_no +#define sv_undef Perl_sv_undef +#define sv_yes Perl_sv_yes +#define tainting Perl_tainting +#define thisexpr Perl_thisexpr +#define timesbuf Perl_timesbuf +#define tokenbuf Perl_tokenbuf +#define uid Perl_uid +#define varies Perl_varies +#define vert Perl_vert +#define vtbl_amagic Perl_vtbl_amagic +#define vtbl_amagicelem Perl_vtbl_amagicelem +#define vtbl_arylen Perl_vtbl_arylen +#define vtbl_bm Perl_vtbl_bm +#define vtbl_dbline Perl_vtbl_dbline +#define vtbl_env Perl_vtbl_env +#define vtbl_envelem Perl_vtbl_envelem +#define vtbl_glob Perl_vtbl_glob +#define vtbl_isa Perl_vtbl_isa +#define vtbl_isaelem Perl_vtbl_isaelem +#define vtbl_mglob Perl_vtbl_mglob +#define vtbl_pack Perl_vtbl_pack +#define vtbl_packelem Perl_vtbl_packelem +#define vtbl_pos Perl_vtbl_pos +#define vtbl_sig Perl_vtbl_sig +#define vtbl_sigelem Perl_vtbl_sigelem +#define vtbl_substr Perl_vtbl_substr +#define vtbl_sv Perl_vtbl_sv +#define vtbl_taint Perl_vtbl_taint +#define vtbl_uvar Perl_vtbl_uvar +#define vtbl_vec Perl_vtbl_vec +#define warn_nl Perl_warn_nl +#define warn_nosemi Perl_warn_nosemi +#define warn_reserved Perl_warn_reserved +#define watchaddr Perl_watchaddr +#define watchok Perl_watchok +#define yychar Perl_yychar +#define yycheck Perl_yycheck +#define yydebug Perl_yydebug +#define yydefred Perl_yydefred +#define yydgoto Perl_yydgoto +#define yyerrflag Perl_yyerrflag +#define yygindex Perl_yygindex +#define yylen Perl_yylen +#define yylhs Perl_yylhs +#define yylval Perl_yylval +#define yyname Perl_yyname +#define yynerrs Perl_yynerrs +#define yyrindex Perl_yyrindex +#define yyrule Perl_yyrule +#define yysindex Perl_yysindex +#define yytable Perl_yytable +#define yyval Perl_yyval +#define append_elem Perl_append_elem +#define append_list Perl_append_list +#define apply Perl_apply +#define av_clear Perl_av_clear +#define av_fake Perl_av_fake +#define av_fetch Perl_av_fetch +#define av_fill Perl_av_fill +#define av_len Perl_av_len +#define av_make Perl_av_make +#define av_pop Perl_av_pop +#define av_push Perl_av_push +#define av_shift Perl_av_shift +#define av_store Perl_av_store +#define av_undef Perl_av_undef +#define av_unshift Perl_av_unshift +#define bind_match Perl_bind_match +#define block_end Perl_block_end +#define block_start Perl_block_start +#define calllist Perl_calllist +#define cando Perl_cando +#define check_uni Perl_check_uni +#define checkcomma Perl_checkcomma +#define ck_aelem Perl_ck_aelem +#define ck_concat Perl_ck_concat +#define ck_eof Perl_ck_eof +#define ck_eval Perl_ck_eval +#define ck_exec Perl_ck_exec +#define ck_formline Perl_ck_formline +#define ck_ftst Perl_ck_ftst +#define ck_fun Perl_ck_fun +#define ck_glob Perl_ck_glob +#define ck_grep Perl_ck_grep +#define ck_gvconst Perl_ck_gvconst +#define ck_index Perl_ck_index +#define ck_lengthconst Perl_ck_lengthconst +#define ck_lfun Perl_ck_lfun +#define ck_listiob Perl_ck_listiob +#define ck_match Perl_ck_match +#define ck_null Perl_ck_null +#define ck_repeat Perl_ck_repeat +#define ck_retarget Perl_ck_retarget +#define ck_rvconst Perl_ck_rvconst +#define ck_select Perl_ck_select +#define ck_shift Perl_ck_shift +#define ck_sort Perl_ck_sort +#define ck_spair Perl_ck_spair +#define ck_split Perl_ck_split +#define ck_subr Perl_ck_subr +#define ck_trunc Perl_ck_trunc +#define convert Perl_convert +#define cpytill Perl_cpytill +#define croak Perl_croak +#define cv_undef Perl_cv_undef +#define cxinc Perl_cxinc +#define deb Perl_deb +#define deb_growlevel Perl_deb_growlevel +#define debop Perl_debop +#define debstack Perl_debstack +#define debstackptrs Perl_debstackptrs +#define deprecate Perl_deprecate +#define die Perl_die +#define die_where Perl_die_where +#define do_aexec Perl_do_aexec +#define do_chop Perl_do_chop +#define do_close Perl_do_close +#define do_eof Perl_do_eof +#define do_exec Perl_do_exec +#define do_execfree Perl_do_execfree +#define do_ipcctl Perl_do_ipcctl +#define do_ipcget Perl_do_ipcget +#define do_join Perl_do_join +#define do_kv Perl_do_kv +#define do_msgrcv Perl_do_msgrcv +#define do_msgsnd Perl_do_msgsnd +#define do_open Perl_do_open +#define do_pipe Perl_do_pipe +#define do_print Perl_do_print +#define do_readline Perl_do_readline +#define do_chomp Perl_do_chomp +#define do_seek Perl_do_seek +#define do_semop Perl_do_semop +#define do_shmio Perl_do_shmio +#define do_sprintf Perl_do_sprintf +#define do_tell Perl_do_tell +#define do_trans Perl_do_trans +#define do_vecset Perl_do_vecset +#define do_vop Perl_do_vop +#define doeval Perl_doeval +#define dofindlabel Perl_dofindlabel +#define dopoptoeval Perl_dopoptoeval +#define dump_all Perl_dump_all +#define dump_eval Perl_dump_eval +#define dump_gv Perl_dump_gv +#define dump_op Perl_dump_op +#define dump_packsubs Perl_dump_packsubs +#define dump_pm Perl_dump_pm +#define dump_sub Perl_dump_sub +#define fbm_compile Perl_fbm_compile +#define fbm_instr Perl_fbm_instr +#define fetch_gv Perl_fetch_gv +#define fetch_io Perl_fetch_io +#define fold_constants Perl_fold_constants +#define force_ident Perl_force_ident +#define force_next Perl_force_next +#define force_word Perl_force_word +#define free_tmps Perl_free_tmps +#define gen_constant_list Perl_gen_constant_list +#define gp_free Perl_gp_free +#define gp_ref Perl_gp_ref +#define gv_AVadd Perl_gv_AVadd +#define gv_HVadd Perl_gv_HVadd +#define gv_check Perl_gv_check +#define gv_efullname Perl_gv_efullname +#define gv_fetchfile Perl_gv_fetchfile +#define gv_fetchmeth Perl_gv_fetchmeth +#define gv_fetchmethod Perl_gv_fetchmethod +#define gv_fetchpv Perl_gv_fetchpv +#define gv_fullname Perl_gv_fullname +#define gv_init Perl_gv_init +#define gv_stashpv Perl_gv_stashpv +#define gv_stashsv Perl_gv_stashsv +#define he_delayfree Perl_he_delayfree +#define he_free Perl_he_free +#define hoistmust Perl_hoistmust +#define hv_clear Perl_hv_clear +#define hv_delete Perl_hv_delete +#define hv_exists Perl_hv_exists +#define hv_fetch Perl_hv_fetch +#define hv_stashpv Perl_hv_stashpv +#define hv_iterinit Perl_hv_iterinit +#define hv_iterkey Perl_hv_iterkey +#define hv_iternext Perl_hv_iternext +#define hv_iterval Perl_hv_iterval +#define hv_magic Perl_hv_magic +#define hv_store Perl_hv_store +#define hv_undef Perl_hv_undef +#define ibcmp Perl_ibcmp +#define ingroup Perl_ingroup +#define instr Perl_instr +#define intuit_more Perl_intuit_more +#define invert Perl_invert +#define jmaybe Perl_jmaybe +#define keyword Perl_keyword +#define leave_scope Perl_leave_scope +#define lex_end Perl_lex_end +#define lex_start Perl_lex_start +#define linklist Perl_linklist +#define list Perl_list +#define listkids Perl_listkids +#define localize Perl_localize +#define looks_like_number Perl_looks_like_number +#define magic_clearpack Perl_magic_clearpack +#define magic_get Perl_magic_get +#define magic_getarylen Perl_magic_getarylen +#define magic_getglob Perl_magic_getglob +#define magic_getpack Perl_magic_getpack +#define magic_getpos Perl_magic_getpos +#define magic_gettaint Perl_magic_gettaint +#define magic_getuvar Perl_magic_getuvar +#define magic_len Perl_magic_len +#define magic_nextpack Perl_magic_nextpack +#define magic_set Perl_magic_set +#define magic_setamagic Perl_magic_setamagic +#define magic_setarylen Perl_magic_setarylen +#define magic_setbm Perl_magic_setbm +#define magic_setdbline Perl_magic_setdbline +#define magic_setenv Perl_magic_setenv +#define magic_setglob Perl_magic_setglob +#define magic_setisa Perl_magic_setisa +#define magic_setmglob Perl_magic_setmglob +#define magic_setpack Perl_magic_setpack +#define magic_setpos Perl_magic_setpos +#define magic_setsig Perl_magic_setsig +#define magic_setsubstr Perl_magic_setsubstr +#define magic_settaint Perl_magic_settaint +#define magic_setuvar Perl_magic_setuvar +#define magic_setvec Perl_magic_setvec +#define magic_wipepack Perl_magic_wipepack +#define magicname Perl_magicname +#define markstack_grow Perl_markstack_grow +#define mess Perl_mess +#define mg_clear Perl_mg_clear +#define mg_copy Perl_mg_copy +#define mg_find Perl_mg_find +#define mg_free Perl_mg_free +#define mg_get Perl_mg_get +#define mg_len Perl_mg_len +#define mg_magical Perl_mg_magical +#define mg_set Perl_mg_set +#define mod Perl_mod +#define modkids Perl_modkids +#define moreswitches Perl_moreswitches +#define my Perl_my +#define my_exit Perl_my_exit +#define my_lstat Perl_my_lstat +#define my_pclose Perl_my_pclose +#define my_popen Perl_my_popen +#define my_setenv Perl_my_setenv +#define my_stat Perl_my_stat +#define my_unexec Perl_my_unexec +#define newANONHASH Perl_newANONHASH +#define newANONLIST Perl_newANONLIST +#define newASSIGNOP Perl_newASSIGNOP +#define newAV Perl_newAV +#define newAVREF Perl_newAVREF +#define newBINOP Perl_newBINOP +#define newCONDOP Perl_newCONDOP +#define newCVOP Perl_newCVOP +#define newCVREF Perl_newCVREF +#define newFORM Perl_newFORM +#define newFOROP Perl_newFOROP +#define newGVOP Perl_newGVOP +#define newGVREF Perl_newGVREF +#define newGVgen Perl_newGVgen +#define newHV Perl_newHV +#define newHVREF Perl_newHVREF +#define newIO Perl_newIO +#define newLISTOP Perl_newLISTOP +#define newLOGOP Perl_newLOGOP +#define newLOOPEX Perl_newLOOPEX +#define newLOOPOP Perl_newLOOPOP +#define newMETHOD Perl_newMETHOD +#define newNULLLIST Perl_newNULLLIST +#define newOP Perl_newOP +#define newPROG Perl_newPROG +#define newPMOP Perl_newPMOP +#define newPVOP Perl_newPVOP +#define newRANGE Perl_newRANGE +#define newRV Perl_newRV +#define newSLICEOP Perl_newSLICEOP +#define newSTATEOP Perl_newSTATEOP +#define newSUB Perl_newSUB +#define newSV Perl_newSV +#define newSVOP Perl_newSVOP +#define newSVREF Perl_newSVREF +#define newSViv Perl_newSViv +#define newSVnv Perl_newSVnv +#define newSVpv Perl_newSVpv +#define newSVsv Perl_newSVsv +#define newUNOP Perl_newUNOP +#define newWHILEOP Perl_newWHILEOP +#define newXSUB Perl_newXSUB +#define newXS Perl_newXS +#define nextargv Perl_nextargv +#define ninstr Perl_ninstr +#define no_fh_allowed Perl_no_fh_allowed +#define no_op Perl_no_op +#define oopsAV Perl_oopsAV +#define oopsCV Perl_oopsCV +#define oopsHV Perl_oopsHV +#define op_free Perl_op_free +#define package Perl_package +#define pad_alloc Perl_pad_alloc +#define pad_allocmy Perl_pad_allocmy +#define pad_findmy Perl_pad_findmy +#define pad_free Perl_pad_free +#define pad_leavemy Perl_pad_leavemy +#define pad_reset Perl_pad_reset +#define pad_sv Perl_pad_sv +#define pad_swipe Perl_pad_swipe +#define peep Perl_peep +#define pidgone Perl_pidgone +#define pmruntime Perl_pmruntime +#define pmtrans Perl_pmtrans +#define pop_return Perl_pop_return +#define pop_scope Perl_pop_scope +#define pp_aassign Perl_pp_aassign +#define pp_accept Perl_pp_accept +#define pp_add Perl_pp_add +#define pp_aelem Perl_pp_aelem +#define pp_aelemfast Perl_pp_aelemfast +#define pp_alarm Perl_pp_alarm +#define pp_and Perl_pp_and +#define pp_andassign Perl_pp_andassign +#define pp_anonhash Perl_pp_anonhash +#define pp_anonlist Perl_pp_anonlist +#define pp_aslice Perl_pp_aslice +#define pp_atan2 Perl_pp_atan2 +#define pp_av2arylen Perl_pp_av2arylen +#define pp_backtick Perl_pp_backtick +#define pp_bind Perl_pp_bind +#define pp_binmode Perl_pp_binmode +#define pp_bit_and Perl_pp_bit_and +#define pp_bit_or Perl_pp_bit_or +#define pp_bless Perl_pp_bless +#define pp_caller Perl_pp_caller +#define pp_chdir Perl_pp_chdir +#define pp_chmod Perl_pp_chmod +#define pp_chop Perl_pp_chop +#define pp_chown Perl_pp_chown +#define pp_chroot Perl_pp_chroot +#define pp_close Perl_pp_close +#define pp_closedir Perl_pp_closedir +#define pp_complement Perl_pp_complement +#define pp_concat Perl_pp_concat +#define pp_cond_expr Perl_pp_cond_expr +#define pp_connect Perl_pp_connect +#define pp_const Perl_pp_const +#define pp_cos Perl_pp_cos +#define pp_crypt Perl_pp_crypt +#define pp_cswitch Perl_pp_cswitch +#define pp_dbmclose Perl_pp_dbmclose +#define pp_dbmopen Perl_pp_dbmopen +#define pp_dbstate Perl_pp_dbstate +#define pp_defined Perl_pp_defined +#define pp_delete Perl_pp_delete +#define pp_die Perl_pp_die +#define pp_divide Perl_pp_divide +#define pp_dofile Perl_pp_dofile +#define pp_dump Perl_pp_dump +#define pp_each Perl_pp_each +#define pp_egrent Perl_pp_egrent +#define pp_ehostent Perl_pp_ehostent +#define pp_enetent Perl_pp_enetent +#define pp_enter Perl_pp_enter +#define pp_entereval Perl_pp_entereval +#define pp_enteriter Perl_pp_enteriter +#define pp_enterloop Perl_pp_enterloop +#define pp_entersub Perl_pp_entersub +#define pp_entersubr Perl_pp_entersubr +#define pp_entertry Perl_pp_entertry +#define pp_enterwrite Perl_pp_enterwrite +#define pp_eof Perl_pp_eof +#define pp_eprotoent Perl_pp_eprotoent +#define pp_epwent Perl_pp_epwent +#define pp_eq Perl_pp_eq +#define pp_eservent Perl_pp_eservent +#define pp_evalonce Perl_pp_evalonce +#define pp_exec Perl_pp_exec +#define pp_exists Perl_pp_exists +#define pp_exit Perl_pp_exit +#define pp_exp Perl_pp_exp +#define pp_fcntl Perl_pp_fcntl +#define pp_fileno Perl_pp_fileno +#define pp_flip Perl_pp_flip +#define pp_flock Perl_pp_flock +#define pp_flop Perl_pp_flop +#define pp_fork Perl_pp_fork +#define pp_formline Perl_pp_formline +#define pp_ftatime Perl_pp_ftatime +#define pp_ftbinary Perl_pp_ftbinary +#define pp_ftblk Perl_pp_ftblk +#define pp_ftchr Perl_pp_ftchr +#define pp_ftctime Perl_pp_ftctime +#define pp_ftdir Perl_pp_ftdir +#define pp_fteexec Perl_pp_fteexec +#define pp_fteowned Perl_pp_fteowned +#define pp_fteread Perl_pp_fteread +#define pp_ftewrite Perl_pp_ftewrite +#define pp_ftfile Perl_pp_ftfile +#define pp_ftis Perl_pp_ftis +#define pp_ftlink Perl_pp_ftlink +#define pp_ftmtime Perl_pp_ftmtime +#define pp_ftpipe Perl_pp_ftpipe +#define pp_ftrexec Perl_pp_ftrexec +#define pp_ftrowned Perl_pp_ftrowned +#define pp_ftrread Perl_pp_ftrread +#define pp_ftrwrite Perl_pp_ftrwrite +#define pp_ftsgid Perl_pp_ftsgid +#define pp_ftsize Perl_pp_ftsize +#define pp_ftsock Perl_pp_ftsock +#define pp_ftsuid Perl_pp_ftsuid +#define pp_ftsvtx Perl_pp_ftsvtx +#define pp_fttext Perl_pp_fttext +#define pp_fttty Perl_pp_fttty +#define pp_ftzero Perl_pp_ftzero +#define pp_ge Perl_pp_ge +#define pp_getc Perl_pp_getc +#define pp_getlogin Perl_pp_getlogin +#define pp_getpeername Perl_pp_getpeername +#define pp_getpgrp Perl_pp_getpgrp +#define pp_getppid Perl_pp_getppid +#define pp_getpriority Perl_pp_getpriority +#define pp_getsockname Perl_pp_getsockname +#define pp_ggrent Perl_pp_ggrent +#define pp_ggrgid Perl_pp_ggrgid +#define pp_ggrnam Perl_pp_ggrnam +#define pp_ghbyaddr Perl_pp_ghbyaddr +#define pp_ghbyname Perl_pp_ghbyname +#define pp_ghostent Perl_pp_ghostent +#define pp_glob Perl_pp_glob +#define pp_gmtime Perl_pp_gmtime +#define pp_gnbyaddr Perl_pp_gnbyaddr +#define pp_gnbyname Perl_pp_gnbyname +#define pp_gnetent Perl_pp_gnetent +#define pp_goto Perl_pp_goto +#define pp_gpbyname Perl_pp_gpbyname +#define pp_gpbynumber Perl_pp_gpbynumber +#define pp_gprotoent Perl_pp_gprotoent +#define pp_gpwent Perl_pp_gpwent +#define pp_gpwnam Perl_pp_gpwnam +#define pp_gpwuid Perl_pp_gpwuid +#define pp_grepstart Perl_pp_grepstart +#define pp_grepwhile Perl_pp_grepwhile +#define pp_gsbyname Perl_pp_gsbyname +#define pp_gsbyport Perl_pp_gsbyport +#define pp_gservent Perl_pp_gservent +#define pp_gsockopt Perl_pp_gsockopt +#define pp_gt Perl_pp_gt +#define pp_gv Perl_pp_gv +#define pp_gvsv Perl_pp_gvsv +#define pp_helem Perl_pp_helem +#define pp_hex Perl_pp_hex +#define pp_hslice Perl_pp_hslice +#define pp_index Perl_pp_index +#define pp_indread Perl_pp_indread +#define pp_int Perl_pp_int +#define pp_interp Perl_pp_interp +#define pp_ioctl Perl_pp_ioctl +#define pp_iter Perl_pp_iter +#define pp_join Perl_pp_join +#define pp_keys Perl_pp_keys +#define pp_kill Perl_pp_kill +#define pp_last Perl_pp_last +#define pp_lc Perl_pp_lc +#define pp_lcfirst Perl_pp_lcfirst +#define pp_le Perl_pp_le +#define pp_leave Perl_pp_leave +#define pp_leaveeval Perl_pp_leaveeval +#define pp_leaveloop Perl_pp_leaveloop +#define pp_leavesub Perl_pp_leavesub +#define pp_leavetry Perl_pp_leavetry +#define pp_leavewrite Perl_pp_leavewrite +#define pp_left_shift Perl_pp_left_shift +#define pp_length Perl_pp_length +#define pp_lineseq Perl_pp_lineseq +#define pp_link Perl_pp_link +#define pp_list Perl_pp_list +#define pp_listen Perl_pp_listen +#define pp_localtime Perl_pp_localtime +#define pp_log Perl_pp_log +#define pp_lslice Perl_pp_lslice +#define pp_lstat Perl_pp_lstat +#define pp_lt Perl_pp_lt +#define pp_map Perl_pp_map +#define pp_match Perl_pp_match +#define pp_method Perl_pp_method +#define pp_mkdir Perl_pp_mkdir +#define pp_modulo Perl_pp_modulo +#define pp_msgctl Perl_pp_msgctl +#define pp_msgget Perl_pp_msgget +#define pp_msgrcv Perl_pp_msgrcv +#define pp_msgsnd Perl_pp_msgsnd +#define pp_multiply Perl_pp_multiply +#define pp_ncmp Perl_pp_ncmp +#define pp_ne Perl_pp_ne +#define pp_negate Perl_pp_negate +#define pp_next Perl_pp_next +#define pp_nextstate Perl_pp_nextstate +#define pp_not Perl_pp_not +#define pp_nswitch Perl_pp_nswitch +#define pp_null Perl_pp_null +#define pp_oct Perl_pp_oct +#define pp_open Perl_pp_open +#define pp_open_dir Perl_pp_open_dir +#define pp_or Perl_pp_or +#define pp_orassign Perl_pp_orassign +#define pp_ord Perl_pp_ord +#define pp_pack Perl_pp_pack +#define pp_padav Perl_pp_padav +#define pp_padhv Perl_pp_padhv +#define pp_padsv Perl_pp_padsv +#define pp_pipe_op Perl_pp_pipe_op +#define pp_pop Perl_pp_pop +#define pp_pos Perl_pp_pos +#define pp_postdec Perl_pp_postdec +#define pp_postinc Perl_pp_postinc +#define pp_pow Perl_pp_pow +#define pp_predec Perl_pp_predec +#define pp_preinc Perl_pp_preinc +#define pp_print Perl_pp_print +#define pp_prtf Perl_pp_prtf +#define pp_push Perl_pp_push +#define pp_pushmark Perl_pp_pushmark +#define pp_pushre Perl_pp_pushre +#define pp_rand Perl_pp_rand +#define pp_range Perl_pp_range +#define pp_rcatline Perl_pp_rcatline +#define pp_read Perl_pp_read +#define pp_readdir Perl_pp_readdir +#define pp_readline Perl_pp_readline +#define pp_readlink Perl_pp_readlink +#define pp_recv Perl_pp_recv +#define pp_redo Perl_pp_redo +#define pp_ref Perl_pp_ref +#define pp_refgen Perl_pp_refgen +#define pp_regcmaybe Perl_pp_regcmaybe +#define pp_regcomp Perl_pp_regcomp +#define pp_rename Perl_pp_rename +#define pp_repeat Perl_pp_repeat +#define pp_require Perl_pp_require +#define pp_reset Perl_pp_reset +#define pp_return Perl_pp_return +#define pp_reverse Perl_pp_reverse +#define pp_rewinddir Perl_pp_rewinddir +#define pp_right_shift Perl_pp_right_shift +#define pp_rindex Perl_pp_rindex +#define pp_rmdir Perl_pp_rmdir +#define pp_rv2av Perl_pp_rv2av +#define pp_rv2cv Perl_pp_rv2cv +#define pp_rv2gv Perl_pp_rv2gv +#define pp_rv2hv Perl_pp_rv2hv +#define pp_rv2sv Perl_pp_rv2sv +#define pp_chomp Perl_pp_chomp +#define pp_sassign Perl_pp_sassign +#define pp_scalar Perl_pp_scalar +#define pp_schop Perl_pp_schop +#define pp_scmp Perl_pp_scmp +#define pp_scope Perl_pp_scope +#define pp_seek Perl_pp_seek +#define pp_seekdir Perl_pp_seekdir +#define pp_select Perl_pp_select +#define pp_semctl Perl_pp_semctl +#define pp_semget Perl_pp_semget +#define pp_semop Perl_pp_semop +#define pp_send Perl_pp_send +#define pp_seq Perl_pp_seq +#define pp_setpgrp Perl_pp_setpgrp +#define pp_setpriority Perl_pp_setpriority +#define pp_sge Perl_pp_sge +#define pp_sgrent Perl_pp_sgrent +#define pp_sgt Perl_pp_sgt +#define pp_shift Perl_pp_shift +#define pp_shmctl Perl_pp_shmctl +#define pp_shmget Perl_pp_shmget +#define pp_shmread Perl_pp_shmread +#define pp_shmwrite Perl_pp_shmwrite +#define pp_shostent Perl_pp_shostent +#define pp_shutdown Perl_pp_shutdown +#define pp_sin Perl_pp_sin +#define pp_sle Perl_pp_sle +#define pp_sleep Perl_pp_sleep +#define pp_slt Perl_pp_slt +#define pp_sne Perl_pp_sne +#define pp_snetent Perl_pp_snetent +#define pp_socket Perl_pp_socket +#define pp_sockpair Perl_pp_sockpair +#define pp_sort Perl_pp_sort +#define pp_splice Perl_pp_splice +#define pp_split Perl_pp_split +#define pp_sprintf Perl_pp_sprintf +#define pp_sprotoent Perl_pp_sprotoent +#define pp_spwent Perl_pp_spwent +#define pp_sqrt Perl_pp_sqrt +#define pp_srand Perl_pp_srand +#define pp_srefgen Perl_pp_srefgen +#define pp_schomp Perl_pp_schomp +#define pp_sselect Perl_pp_sselect +#define pp_sservent Perl_pp_sservent +#define pp_ssockopt Perl_pp_ssockopt +#define pp_stat Perl_pp_stat +#define pp_stub Perl_pp_stub +#define pp_study Perl_pp_study +#define pp_subst Perl_pp_subst +#define pp_substcont Perl_pp_substcont +#define pp_substr Perl_pp_substr +#define pp_subtract Perl_pp_subtract +#define pp_sv2len Perl_pp_sv2len +#define pp_symlink Perl_pp_symlink +#define pp_syscall Perl_pp_syscall +#define pp_sysread Perl_pp_sysread +#define pp_system Perl_pp_system +#define pp_syswrite Perl_pp_syswrite +#define pp_tell Perl_pp_tell +#define pp_telldir Perl_pp_telldir +#define pp_tie Perl_pp_tie +#define pp_time Perl_pp_time +#define pp_tms Perl_pp_tms +#define pp_trans Perl_pp_trans +#define pp_truncate Perl_pp_truncate +#define pp_uc Perl_pp_uc +#define pp_ucfirst Perl_pp_ucfirst +#define pp_umask Perl_pp_umask +#define pp_undef Perl_pp_undef +#define pp_unlink Perl_pp_unlink +#define pp_unpack Perl_pp_unpack +#define pp_unshift Perl_pp_unshift +#define pp_unstack Perl_pp_unstack +#define pp_untie Perl_pp_untie +#define pp_utime Perl_pp_utime +#define pp_values Perl_pp_values +#define pp_vec Perl_pp_vec +#define pp_wait Perl_pp_wait +#define pp_waitpid Perl_pp_waitpid +#define pp_wantarray Perl_pp_wantarray +#define pp_warn Perl_pp_warn +#define pp_xor Perl_pp_xor +#define prepend_elem Perl_prepend_elem +#define push_return Perl_push_return +#define push_scope Perl_push_scope +#define q Perl_q +#define ref Perl_ref +#define refkids Perl_refkids +#define regcomp Perl_regcomp +#define regdump Perl_regdump +#define regexec Perl_regexec +#define regfree Perl_regfree +#define regnext Perl_regnext +#define regprop Perl_regprop +#define repeatcpy Perl_repeatcpy +#define rninstr Perl_rninstr +#define run Perl_run +#define savepv Perl_savepv +#define savepvn Perl_savepvn +#define save_I32 Perl_save_I32 +#define save_aptr Perl_save_aptr +#define save_ary Perl_save_ary +#define save_clearsv Perl_save_clearsv +#define save_delete Perl_save_delete +#define save_freeop Perl_save_freeop +#define save_freepv Perl_save_freepv +#define save_freesv Perl_save_freesv +#define save_hash Perl_save_hash +#define save_hptr Perl_save_hptr +#define save_int Perl_save_int +#define save_item Perl_save_item +#define save_list Perl_save_list +#define save_nogv Perl_save_nogv +#define save_scalar Perl_save_scalar +#define save_sptr Perl_save_sptr +#define save_svref Perl_save_svref +#define savestack_grow Perl_savestack_grow +#define sawparens Perl_sawparens +#define scalar Perl_scalar +#define scalarkids Perl_scalarkids +#define scalarseq Perl_scalarseq +#define scalarvoid Perl_scalarvoid +#define scan_const Perl_scan_const +#define scan_formline Perl_scan_formline +#define scan_heredoc Perl_scan_heredoc +#define scan_hex Perl_scan_hex +#define scan_ident Perl_scan_ident +#define scan_inputsymbol Perl_scan_inputsymbol +#define scan_num Perl_scan_num +#define scan_oct Perl_scan_oct +#define scan_pat Perl_scan_pat +#define scan_prefix Perl_scan_prefix +#define scan_str Perl_scan_str +#define scan_subst Perl_scan_subst +#define scan_trans Perl_scan_trans +#define scan_word Perl_scan_word +#define scope Perl_scope +#define screaminstr Perl_screaminstr +#define setenv_getix Perl_setenv_getix +#define skipspace Perl_skipspace +#define stack_grow Perl_stack_grow +#define start_subparse Perl_start_subparse +#define sublex_done Perl_sublex_done +#define sublex_start Perl_sublex_start +#define sv_2bool Perl_sv_2bool +#define sv_2cv Perl_sv_2cv +#define sv_2io Perl_sv_2io +#define sv_2iv Perl_sv_2iv +#define sv_2mortal Perl_sv_2mortal +#define sv_2nv Perl_sv_2nv +#define sv_2pv Perl_sv_2pv +#define sv_backoff Perl_sv_backoff +#define sv_bless Perl_sv_bless +#define sv_catpv Perl_sv_catpv +#define sv_catpvn Perl_sv_catpvn +#define sv_catsv Perl_sv_catsv +#define sv_chop Perl_sv_chop +#define sv_clean_all Perl_sv_clean_all +#define sv_clean_objs Perl_sv_clean_objs +#define sv_clear Perl_sv_clear +#define sv_cmp Perl_sv_cmp +#define sv_dec Perl_sv_dec +#define sv_dump Perl_sv_dump +#define sv_eq Perl_sv_eq +#define sv_free Perl_sv_free +#define sv_gets Perl_sv_gets +#define sv_grow Perl_sv_grow +#define sv_inc Perl_sv_inc +#define sv_insert Perl_sv_insert +#define sv_isa Perl_sv_isa +#define sv_len Perl_sv_len +#define sv_magic Perl_sv_magic +#define sv_mortalcopy Perl_sv_mortalcopy +#define sv_newmortal Perl_sv_newmortal +#define sv_peek Perl_sv_peek +#define sv_ref Perl_sv_ref +#define sv_replace Perl_sv_replace +#define sv_report_used Perl_sv_report_used +#define sv_reset Perl_sv_reset +#define sv_setiv Perl_sv_setiv +#define sv_setnv Perl_sv_setnv +#define sv_setptrobj Perl_sv_setptrobj +#define sv_setpv Perl_sv_setpv +#define sv_setpvn Perl_sv_setpvn +#define sv_setref_iv Perl_sv_setref_iv +#define sv_setref_pv Perl_sv_setref_pv +#define sv_setsv Perl_sv_setsv +#define sv_unmagic Perl_sv_unmagic +#define sv_upgrade Perl_sv_upgrade +#define sv_usepvn Perl_sv_usepvn +#define taint_env Perl_taint_env +#define taint_not Perl_taint_not +#define taint_proper Perl_taint_proper +#define too_few_arguments Perl_too_few_arguments +#define too_many_arguments Perl_too_many_arguments +#define wait4pid Perl_wait4pid +#define warn Perl_warn +#define watch Perl_watch +#define whichsig Perl_whichsig +#define xiv_arenaroot Perl_xiv_arenaroot +#define xiv_root Perl_xiv_root +#define xnv_root Perl_xnv_root +#define xpv_root Perl_xpv_root +#define xrv_root Perl_xrv_root +#define yyerror Perl_yyerror +#define yyerror Perl_yyerror +#define yylex Perl_yylex +#define yyparse Perl_yyparse +#define yywarn Perl_yywarn #endif /* EMBED */ @@ -890,7 +996,6 @@ #define ampergv (curinterp->Iampergv) #define argvgv (curinterp->Iargvgv) #define argvoutgv (curinterp->Iargvoutgv) -#define arybase (curinterp->Iarybase) #define basetime (curinterp->Ibasetime) #define beginav (curinterp->Ibeginav) #define bodytarget (curinterp->Ibodytarget) @@ -900,7 +1005,6 @@ #define curblock (curinterp->Icurblock) #define curcop (curinterp->Icurcop) #define curcsv (curinterp->Icurcsv) -#define curoutgv (curinterp->Icuroutgv) #define curpm (curinterp->Icurpm) #define curstash (curinterp->Icurstash) #define curstname (curinterp->Icurstname) @@ -994,6 +1098,7 @@ #define rschar (curinterp->Irschar) #define rslen (curinterp->Irslen) #define rspara (curinterp->Irspara) +#define runlevel (curinterp->Irunlevel) #define sawampersand (curinterp->Isawampersand) #define sawi (curinterp->Isawi) #define sawstudy (curinterp->Isawstudy) @@ -1015,7 +1120,7 @@ #define stdingv (curinterp->Istdingv) #define strchop (curinterp->Istrchop) #define sv_count (curinterp->Isv_count) -#define sv_rvcount (curinterp->Isv_rvcount) +#define sv_objcount (curinterp->Isv_objcount) #define sv_root (curinterp->Isv_root) #define sv_arenaroot (curinterp->Isv_arenaroot) #define tainted (curinterp->Itainted) @@ -1042,7 +1147,6 @@ #define Iampergv ampergv #define Iargvgv argvgv #define Iargvoutgv argvoutgv -#define Iarybase arybase #define Ibasetime basetime #define Ibeginav beginav #define Ibodytarget bodytarget @@ -1052,7 +1156,6 @@ #define Icurblock curblock #define Icurcop curcop #define Icurcsv curcsv -#define Icuroutgv curoutgv #define Icurpm curpm #define Icurstash curstash #define Icurstname curstname @@ -1146,6 +1249,7 @@ #define Irschar rschar #define Irslen rslen #define Irspara rspara +#define Irunlevel runlevel #define Isawampersand sawampersand #define Isawi sawi #define Isawstudy sawstudy @@ -1167,7 +1271,7 @@ #define Istdingv stdingv #define Istrchop strchop #define Isv_count sv_count -#define Isv_rvcount sv_rvcount +#define Isv_objcount sv_objcount #define Isv_root sv_root #define Isv_arenaroot sv_arenaroot #define Itainted tainted diff --git a/embed_h.SH b/embed_h.SH index 2ba9fe2..159ab0e 100755 --- a/embed_h.SH +++ b/embed_h.SH @@ -13,7 +13,7 @@ END sed >embed.h \ -e 's/[ ]*#.*//' \ -e '/^[ ]*$/d' \ - -e 's/\(.*\)/#define \1 perl_\1/' \ + -e 's/\(.*\)/#define \1 Perl_\1/' \ -e 's/\(................ \) /\1/' cat <<'END' >> embed.h diff --git a/eval b/eval deleted file mode 100644 index 21cebaf..0000000 --- a/eval +++ /dev/null @@ -1,318 +0,0 @@ - -void -save_lines(array, sv) -AV *array; -SV *sv; -{ - register char *s = sv->sv_ptr; - register char *send = sv->sv_ptr + sv->sv_cur; - register char *t; - register int line = 1; - - while (s && s < send) { - SV *tmpstr = NEWSV(85,0); - - t = index(s, '\n'); - if (t) - t++; - else - t = send; - - sv_setpvn(tmpstr, s, t - s); - av_store(array, line++, tmpstr); - s = t; - } -} - -int -do_eval(sv,optype,stash,savecmd,gimme,arglast) -SV *sv; -int optype; -HV *stash; -int savecmd; -int gimme; -int *arglast; -{ - SV **st = stack->av_array; - int retval; - COP *myroot = Nullcop; - AV *ar; - int i; - COP * VOL oldcurcmd = curcmd; - VOL int oldtmps_floor = tmps_floor; - VOL int oldsave = savestack->av_fill; - VOL int oldperldb = perldb; - PM * VOL oldspat = curspat; - PM * VOL oldlspat = lastspat; - - VOL int sp = arglast[0]; - char *specfilename; - char *tmpfilename; - int parsing = 1; - - tmps_floor = tmps_ix; - if (curstash != stash) { - (void)save_hptr(&curstash); - curstash = stash; - } - sv_setpv(GvSV(gv_fetchpv("@",TRUE)),""); - if (curcmd->cop_line == 0) /* don't debug debugger... */ - perldb = FALSE; - curcmd = &compiling; - if (optype == OP_EVAL) { /* normal oldeval */ - curcmd->cop_filestab = gv_fetchfile("(oldeval)"); - curcmd->cop_line = 1; - sv_setsv(linestr,sv); - sv_catpv(linestr,";\n;\n"); /* be kind to them */ - if (perldb) - save_lines(GvAV(curcmd->cop_filestab), linestr); - } - else { - if (last_root && !in_eval) { - Safefree(last_eval); - last_eval = Nullch; - cop_free(last_root); - last_root = Nullcop; - } - specfilename = SvPV(sv); - sv_setpv(linestr,""); - if (optype == OP_REQUIRE && &sv_undef != - hv_fetch(GvHVn(incstab), specfilename, strlen(specfilename), 0)) { - curcmd = oldcurcmd; - tmps_floor = oldtmps_floor; - st[++sp] = &sv_yes; - perldb = oldperldb; - return sp; - } - tmpfilename = savestr(specfilename); - if (*tmpfilename == '/' || - (*tmpfilename == '.' && - (tmpfilename[1] == '/' || - (tmpfilename[1] == '.' && tmpfilename[2] == '/')))) - { - rsfp = fopen(tmpfilename,"r"); - } - else { - ar = GvAVn(incstab); - for (i = 0; i <= ar->av_fill; i++) { - (void)sprintf(buf, "%s/%s", - SvPV(av_fetch(ar,i,TRUE)), specfilename); - rsfp = fopen(buf,"r"); - if (rsfp) { - char *s = buf; - - if (*s == '.' && s[1] == '/') - s += 2; - Safefree(tmpfilename); - tmpfilename = savestr(s); - break; - } - } - } - curcmd->cop_filestab = gv_fetchfile(tmpfilename); - Safefree(tmpfilename); - tmpfilename = Nullch; - if (!rsfp) { - curcmd = oldcurcmd; - tmps_floor = oldtmps_floor; - if (optype == OP_REQUIRE) { - sprintf(tokenbuf,"Can't locate %s in @INC", specfilename); - if (instr(tokenbuf,".h ")) - strcat(tokenbuf," (change .h to .ph maybe?)"); - if (instr(tokenbuf,".ph ")) - strcat(tokenbuf," (did you run h2ph?)"); - fatal("%s",tokenbuf); - } - if (gimme != G_ARRAY) - st[++sp] = &sv_undef; - perldb = oldperldb; - return sp; - } - curcmd->cop_line = 0; - } - in_eval++; - oldoldbufptr = oldbufptr = bufptr = SvPV(linestr); - bufend = bufptr + linestr->sv_cur; - if (++cxstack_ix >= block_max) { - block_max += 128; - Renew(block_stack, block_max, struct loop); - } - block_stack[cxstack_ix].block_label = "_EVAL_"; - block_stack[cxstack_ix].block_sp = sp; -#ifdef DEBUGGING - if (debug & 4) { - deb("(Pushing label #%d _EVAL_)\n", cxstack_ix); - } -#endif - eval_root = Nullcop; - if (setjmp(block_stack[cxstack_ix].block_env)) { - retval = 1; - } - else { - error_count = 0; - if (rsfp) { - retval = yyparse(); - retval |= error_count; - } - else if (last_root && last_elen == bufend - bufptr - && *bufptr == *last_eval && !bcmp(bufptr,last_eval,last_elen)){ - retval = 0; - eval_root = last_root; /* no point in reparsing */ - } - else if (in_eval == 1 && !savecmd) { - if (last_root) { - Safefree(last_eval); - last_eval = Nullch; - cop_free(last_root); - } - last_root = Nullcop; - last_elen = bufend - bufptr; - last_eval = nsavestr(bufptr, last_elen); - retval = yyparse(); - retval |= error_count; - if (!retval) - last_root = eval_root; - if (!last_root) { - Safefree(last_eval); - last_eval = Nullch; - } - } - else - retval = yyparse(); - } - myroot = eval_root; /* in case cop_exec does another oldeval! */ - - if (retval || error_count) { - st = stack->av_array; - sp = arglast[0]; - if (gimme != G_ARRAY) - st[++sp] = &sv_undef; - if (parsing) { -#ifndef MANGLEDPARSE -#ifdef DEBUGGING - if (debug & 128) - fprintf(stderr,"Freeing eval_root %lx\n",(long)eval_root); -#endif - cop_free(eval_root); -#endif - /*SUPPRESS 29*/ /*SUPPRESS 30*/ - if ((COP*)eval_root == last_root) - last_root = Nullcop; - eval_root = myroot = Nullcop; - } - if (rsfp) { - fclose(rsfp); - rsfp = 0; - } - } - else { - parsing = 0; - sp = cop_exec(eval_root,gimme,sp); - st = stack->av_array; - for (i = arglast[0] + 1; i <= sp; i++) - st[i] = sv_mortalcopy(st[i]); - /* if we don't save result, free zaps it */ - if (savecmd) - eval_root = myroot; - else if (in_eval != 1 && myroot != last_root) - cop_free(myroot); - } - - perldb = oldperldb; - in_eval--; -#ifdef DEBUGGING - if (debug & 4) { - char *tmps = block_stack[cxstack_ix].block_label; - deb("(Popping label #%d %s)\n",cxstack_ix, - tmps ? tmps : "" ); - } -#endif - cxstack_ix--; - tmps_floor = oldtmps_floor; - curspat = oldspat; - lastspat = oldlspat; - if (savestack->av_fill > oldsave) /* let them use local() */ - leave_scope(oldsave); - - if (optype != OP_EVAL) { - if (retval) { - if (optype == OP_REQUIRE) - fatal("%s", SvPV(GvSV(gv_fetchpv("@",TRUE)))); - } - else { - curcmd = oldcurcmd; - if (gimme == G_SCALAR ? SvTRUE(st[sp]) : sp > arglast[0]) { - (void)hv_store(GvHVn(incstab), specfilename, - strlen(specfilename), newSVsv(GvSV(curcmd->cop_filestab)), - 0 ); - } - else if (optype == OP_REQUIRE) - fatal("%s did not return a true value", specfilename); - } - } - curcmd = oldcurcmd; - return sp; -} - -int -do_try(cmd,gimme,arglast) -COP *cmd; -int gimme; -int *arglast; -{ - SV **st = stack->av_array; - - COP * VOL oldcurcmd = curcmd; - VOL int oldtmps_floor = tmps_floor; - VOL int oldsave = savestack->av_fill; - PM * VOL oldspat = curspat; - PM * VOL oldlspat = lastspat; - VOL int sp = arglast[0]; - - tmps_floor = tmps_ix; - sv_setpv(GvSV(gv_fetchpv("@",TRUE)),""); - in_eval++; - if (++cxstack_ix >= block_max) { - block_max += 128; - Renew(block_stack, block_max, struct loop); - } - block_stack[cxstack_ix].block_label = "_EVAL_"; - block_stack[cxstack_ix].block_sp = sp; -#ifdef DEBUGGING - if (debug & 4) { - deb("(Pushing label #%d _EVAL_)\n", cxstack_ix); - } -#endif - if (setjmp(block_stack[cxstack_ix].block_env)) { - st = stack->av_array; - sp = arglast[0]; - if (gimme != G_ARRAY) - st[++sp] = &sv_undef; - } - else { - sp = cop_exec(cmd,gimme,sp); - st = stack->av_array; -/* for (i = arglast[0] + 1; i <= sp; i++) - st[i] = sv_mortalcopy(st[i]); not needed, I think */ - /* if we don't save result, free zaps it */ - } - - in_eval--; -#ifdef DEBUGGING - if (debug & 4) { - char *tmps = block_stack[cxstack_ix].block_label; - deb("(Popping label #%d %s)\n",cxstack_ix, - tmps ? tmps : "" ); - } -#endif - cxstack_ix--; - tmps_floor = oldtmps_floor; - curspat = oldspat; - lastspat = oldlspat; - curcmd = oldcurcmd; - if (savestack->av_fill > oldsave) /* let them use local() */ - leave_scope(oldsave); - - return sp; -} - diff --git a/eval.c.save b/eval.c.save deleted file mode 100644 index 964bc03..0000000 --- a/eval.c.save +++ /dev/null @@ -1,3048 +0,0 @@ -/* $RCSfile: eval.c,v $$Revision: 4.1 $$Date: 92/08/07 18:20:29 $ - * - * Copyright (c) 1991, Larry Wall - * - * You may distribute under the terms of either the GNU General Public - * License or the Artistic License, as specified in the README file. - * - * $Log: eval.c,v $ - * Revision 4.1 92/08/07 18:20:29 lwall - * - * Revision 4.0.1.4 92/06/08 13:20:20 lwall - * patch20: added explicit time_t support - * patch20: fixed confusion between a *var's real name and its effective name - * patch20: added Atari ST portability - * patch20: new warning for use of x with non-numeric right operand - * patch20: modulus with highest bit in left operand set didn't always work - * patch20: dbmclose(%array) didn't work - * patch20: added ... as variant on .. - * patch20: O_PIPE conflicted with Atari - * - * Revision 4.0.1.3 91/11/05 17:15:21 lwall - * patch11: prepared for ctype implementations that don't define isascii() - * patch11: various portability fixes - * patch11: added sort {} LIST - * patch11: added eval {} - * patch11: sysread() in socket was substituting recv() - * patch11: a last statement outside any block caused occasional core dumps - * patch11: missing arguments caused core dump in -D8 code - * patch11: eval 'stuff' now optimized to eval {stuff} - * - * Revision 4.0.1.2 91/06/07 11:07:23 lwall - * patch4: new copyright notice - * patch4: length($`), length($&), length($') now optimized to avoid string copy - * patch4: assignment wasn't correctly de-tainting the assigned variable. - * patch4: default top-of-form format is now FILEHANDLE_TOP - * patch4: added $^P variable to control calling of perldb routines - * patch4: taintchecks could improperly modify parent in vfork() - * patch4: many, many itty-bitty portability fixes - * - * Revision 4.0.1.1 91/04/11 17:43:48 lwall - * patch1: fixed failed fork to return undef as documented - * patch1: reduced maximum branch distance in eval.c - * - * Revision 4.0 91/03/20 01:16:48 lwall - * 4.0 baseline. - * - */ - -#include "EXTERN.h" -#include "perl.h" - -extern int (*ppaddr[])(); -extern int mark[]; - -#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) -#include -#endif - -#ifdef I_FCNTL -#include -#endif -#ifdef MSDOS -/* I_FCNTL *MUST* not be defined for MS-DOS and OS/2 - but fcntl.h is required for O_BINARY */ -#include -#endif -#ifdef I_SYS_FILE -#include -#endif -#ifdef I_VFORK -# include -#endif - -double sin(), cos(), atan2(), pow(); - -char *getlogin(); - -int -eval(arg,gimme,sp) -register ARG *arg; -int gimme; -register int sp; -{ - register STR *str; - register int anum; - register int optype; - register STR **st; - int maxarg; - double value; - register char *tmps; - char *tmps2; - int argflags; - int argtype; - union argptr argptr; - int arglast[8]; /* highest sp for arg--valid only for non-O_LIST args */ - unsigned long tmpulong; - long tmplong; - time_t when; - STRLEN tmplen; - FILE *fp; - STR *tmpstr; - FCMD *form; - STAB *stab; - STAB *stab2; - STIO *stio; - ARRAY *ary; - int old_rslen; - int old_rschar; - VOIDRET (*ihand)(); /* place to save signal during system() */ - VOIDRET (*qhand)(); /* place to save signal during system() */ - bool assigning = FALSE; - int mymarkbase = savestack->ary_fill; - - if (!arg) - goto say_undef; - optype = arg->arg_type; - maxarg = arg->arg_len; - arglast[0] = sp; - str = arg->arg_ptr.arg_str; - if (sp + maxarg > stack->ary_max) - astore(stack, sp + maxarg, Nullstr); - st = stack->ary_array; - -#ifdef DEBUGGING - if (debug) { - if (debug & 8) { - deb("%s (%lx) %d args:\n",opname[optype],arg,maxarg); - } - debname[dlevel] = opname[optype][0]; - debdelim[dlevel] = ':'; - if (++dlevel >= dlmax) - grow_dlevel(); - } -#endif - - if (mark[optype]) { - saveint(&markbase); - markbase = mymarkbase; - saveint(&stack_mark); - stack_mark = sp; - } - for (anum = 1; anum <= maxarg; anum++) { - argflags = arg[anum].arg_flags; - argtype = arg[anum].arg_type; - argptr = arg[anum].arg_ptr; - re_eval: - switch (argtype) { - default: - if (!ppaddr[optype] || optype == O_SUBR || optype == O_DBSUBR) { - st[++sp] = &str_undef; - } -#ifdef DEBUGGING - tmps = "NULL"; -#endif - break; - case A_EXPR: -#ifdef DEBUGGING - if (debug & 8) { - tmps = "EXPR"; - deb("%d.EXPR =>\n",anum); - } -#endif - sp = eval(argptr.arg_arg, - (argflags & AF_ARYOK) ? G_ARRAY : G_SCALAR, sp); - if (sp + (maxarg - anum) > stack->ary_max) - astore(stack, sp + (maxarg - anum), Nullstr); - st = stack->ary_array; /* possibly reallocated */ - break; - case A_CMD: -#ifdef DEBUGGING - if (debug & 8) { - tmps = "CMD"; - deb("%d.CMD (%lx) =>\n",anum,argptr.arg_cmd); - } -#endif - sp = cmd_exec(argptr.arg_cmd, gimme, sp); - if (sp + (maxarg - anum) > stack->ary_max) - astore(stack, sp + (maxarg - anum), Nullstr); - st = stack->ary_array; /* possibly reallocated */ - break; - case A_LARYSTAB: - ++sp; - switch (optype) { - case O_ITEM2: argtype = 2; break; - case O_ITEM3: argtype = 3; break; - default: argtype = anum; break; - } - str = afetch(stab_array(argptr.arg_stab), - arg[argtype].arg_len - arybase, TRUE); -#ifdef DEBUGGING - if (debug & 8) { - (void)sprintf(buf,"LARYSTAB $%s[%d]",stab_name(argptr.arg_stab), - arg[argtype].arg_len); - tmps = buf; - } -#endif - goto do_crement; - case A_ARYSTAB: - switch (optype) { - case O_ITEM2: argtype = 2; break; - case O_ITEM3: argtype = 3; break; - default: argtype = anum; break; - } - st[++sp] = afetch(stab_array(argptr.arg_stab), - arg[argtype].arg_len - arybase, FALSE); -#ifdef DEBUGGING - if (debug & 8) { - (void)sprintf(buf,"ARYSTAB $%s[%d]",stab_name(argptr.arg_stab), - arg[argtype].arg_len); - tmps = buf; - } -#endif - break; - case A_STAR: - stab = argptr.arg_stab; - st[++sp] = (STR*)stab; - if (!stab_xarray(stab)) - aadd(stab); - if (!stab_xhash(stab)) - hadd(stab); - if (!stab_io(stab)) - stab_io(stab) = stio_new(); -#ifdef DEBUGGING - if (debug & 8) { - (void)sprintf(buf,"STAR *%s -> *%s", - stab_name(argptr.arg_stab), stab_ename(argptr.arg_stab)); - tmps = buf; - } -#endif - break; - case A_LSTAR: - str = st[++sp] = (STR*)argptr.arg_stab; -#ifdef DEBUGGING - if (debug & 8) { - (void)sprintf(buf,"LSTAR *%s -> *%s", - stab_name(argptr.arg_stab), stab_ename(argptr.arg_stab)); - tmps = buf; - } -#endif - break; - case A_STAB: - st[++sp] = STAB_STR(argptr.arg_stab); -#ifdef DEBUGGING - if (debug & 8) { - (void)sprintf(buf,"STAB $%s",stab_name(argptr.arg_stab)); - tmps = buf; - } -#endif - break; - case A_LENSTAB: - str_numset(str, (double)STAB_LEN(argptr.arg_stab)); - st[++sp] = str; -#ifdef DEBUGGING - if (debug & 8) { - (void)sprintf(buf,"LENSTAB $%s",stab_name(argptr.arg_stab)); - tmps = buf; - } -#endif - break; - case A_LEXPR: -#ifdef DEBUGGING - if (debug & 8) { - tmps = "LEXPR"; - deb("%d.LEXPR =>\n",anum); - } -#endif - if (argflags & AF_ARYOK) { - sp = eval(argptr.arg_arg, G_ARRAY, sp); - if (sp + (maxarg - anum) > stack->ary_max) - astore(stack, sp + (maxarg - anum), Nullstr); - st = stack->ary_array; /* possibly reallocated */ - } - else { - sp = eval(argptr.arg_arg, G_SCALAR, sp); - st = stack->ary_array; /* possibly reallocated */ - str = st[sp]; - goto do_crement; - } - break; - case A_LVAL: -#ifdef DEBUGGING - if (debug & 8) { - (void)sprintf(buf,"LVAL $%s",stab_name(argptr.arg_stab)); - tmps = buf; - } -#endif - ++sp; - str = STAB_STR(argptr.arg_stab); - if (!str) - fatal("panic: A_LVAL"); - do_crement: - assigning = TRUE; - if (argflags & AF_PRE) { - if (argflags & AF_UP) - str_inc(str); - else - str_dec(str); - STABSET(str); - st[sp] = str; - str = arg->arg_ptr.arg_str; - } - else if (argflags & AF_POST) { - st[sp] = str_mortal(str); - if (argflags & AF_UP) - str_inc(str); - else - str_dec(str); - STABSET(str); - str = arg->arg_ptr.arg_str; - } - else - st[sp] = str; - break; - case A_LARYLEN: - ++sp; - stab = argptr.arg_stab; - str = stab_array(argptr.arg_stab)->ary_magic; - if (optype != O_SASSIGN || argflags & (AF_PRE|AF_POST)) - str_numset(str,(double)(stab_array(stab)->ary_fill+arybase)); -#ifdef DEBUGGING - tmps = "LARYLEN"; -#endif - if (!str) - fatal("panic: A_LEXPR"); - goto do_crement; - case A_ARYLEN: - stab = argptr.arg_stab; - st[++sp] = stab_array(stab)->ary_magic; - str_numset(st[sp],(double)(stab_array(stab)->ary_fill+arybase)); -#ifdef DEBUGGING - tmps = "ARYLEN"; -#endif - break; - case A_SINGLE: - st[++sp] = argptr.arg_str; -#ifdef DEBUGGING - tmps = "SINGLE"; -#endif - break; - case A_DOUBLE: - (void) interp(str,argptr.arg_str,sp); - st = stack->ary_array; - st[++sp] = str; -#ifdef DEBUGGING - tmps = "DOUBLE"; -#endif - break; - case A_BACKTICK: - tmps = str_get(interp(str,argptr.arg_str,sp)); - st = stack->ary_array; -#ifdef TAINT - TAINT_PROPER("``"); -#endif - fp = mypopen(tmps,"r"); - str_set(str,""); - if (fp) { - if (gimme == G_SCALAR) { - while (str_gets(str,fp,str->str_cur) != Nullch) - /*SUPPRESS 530*/ - ; - } - else { - for (;;) { - if (++sp > stack->ary_max) { - astore(stack, sp, Nullstr); - st = stack->ary_array; - } - str = st[sp] = Str_new(56,80); - if (str_gets(str,fp,0) == Nullch) { - sp--; - break; - } - if (str->str_len - str->str_cur > 20) { - str->str_len = str->str_cur+1; - Renew(str->str_ptr, str->str_len, char); - } - str_2mortal(str); - } - } - statusvalue = mypclose(fp); - } - else - statusvalue = -1; - - if (gimme == G_SCALAR) - st[++sp] = str; -#ifdef DEBUGGING - tmps = "BACK"; -#endif - break; - case A_WANTARRAY: - { - if (curcsv->wantarray == G_ARRAY) - st[++sp] = &str_yes; - else - st[++sp] = &str_no; - } -#ifdef DEBUGGING - tmps = "WANTARRAY"; -#endif - break; - case A_INDREAD: - last_in_stab = stabent(str_get(STAB_STR(argptr.arg_stab)),TRUE); - old_rschar = rschar; - old_rslen = rslen; - goto do_read; - case A_GLOB: - argflags |= AF_POST; /* enable newline chopping */ - last_in_stab = argptr.arg_stab; - old_rschar = rschar; - old_rslen = rslen; - rslen = 1; -#ifdef DOSISH - rschar = 0; -#else -#ifdef CSH - rschar = 0; -#else - rschar = '\n'; -#endif /* !CSH */ -#endif /* !MSDOS */ - goto do_read; - case A_READ: - last_in_stab = argptr.arg_stab; - old_rschar = rschar; - old_rslen = rslen; - do_read: - if (anum > 1) /* assign to scalar */ - gimme = G_SCALAR; /* force context to scalar */ - if (gimme == G_ARRAY) - str = Str_new(57,0); - ++sp; - fp = Nullfp; - if (stab_io(last_in_stab)) { - fp = stab_io(last_in_stab)->ifp; - if (!fp) { - if (stab_io(last_in_stab)->flags & IOF_ARGV) { - if (stab_io(last_in_stab)->flags & IOF_START) { - stab_io(last_in_stab)->flags &= ~IOF_START; - stab_io(last_in_stab)->lines = 0; - if (alen(stab_array(last_in_stab)) < 0) { - tmpstr = str_make("-",1); /* assume stdin */ - (void)apush(stab_array(last_in_stab), tmpstr); - } - } - fp = nextargv(last_in_stab); - if (!fp) { /* Note: fp != stab_io(last_in_stab)->ifp */ - (void)do_close(last_in_stab,FALSE); /* now it does*/ - stab_io(last_in_stab)->flags |= IOF_START; - } - } - else if (argtype == A_GLOB) { - (void) interp(str,stab_val(last_in_stab),sp); - st = stack->ary_array; - tmpstr = Str_new(55,0); -#ifdef DOSISH - str_set(tmpstr, "perlglob "); - str_scat(tmpstr,str); - str_cat(tmpstr," |"); -#else -#ifdef CSH - str_nset(tmpstr,cshname,cshlen); - str_cat(tmpstr," -cf 'set nonomatch; glob "); - str_scat(tmpstr,str); - str_cat(tmpstr,"'|"); -#else - str_set(tmpstr, "echo "); - str_scat(tmpstr,str); - str_cat(tmpstr, - "|tr -s ' \t\f\r' '\\012\\012\\012\\012'|"); -#endif /* !CSH */ -#endif /* !MSDOS */ - (void)do_open(last_in_stab,tmpstr->str_ptr, - tmpstr->str_cur); - fp = stab_io(last_in_stab)->ifp; - str_free(tmpstr); - } - } - } - if (!fp && dowarn) - warn("Read on closed filehandle <%s>",stab_ename(last_in_stab)); - tmplen = str->str_len; /* remember if already alloced */ - if (!tmplen) - Str_Grow(str,80); /* try short-buffering it */ - keepgoing: - if (!fp) - st[sp] = &str_undef; - else if (!str_gets(str,fp, optype == O_RCAT ? str->str_cur : 0)) { - clearerr(fp); - if (stab_io(last_in_stab)->flags & IOF_ARGV) { - fp = nextargv(last_in_stab); - if (fp) - goto keepgoing; - (void)do_close(last_in_stab,FALSE); - stab_io(last_in_stab)->flags |= IOF_START; - } - else if (argflags & AF_POST) { - (void)do_close(last_in_stab,FALSE); - } - st[sp] = &str_undef; - rschar = old_rschar; - rslen = old_rslen; - if (gimme == G_ARRAY) { - --sp; - str_2mortal(str); - goto array_return; - } - break; - } - else { - stab_io(last_in_stab)->lines++; - st[sp] = str; -#ifdef TAINT - str->str_tainted = 1; /* Anything from the outside world...*/ -#endif - if (argflags & AF_POST) { - if (str->str_cur > 0) - str->str_cur--; - if (str->str_ptr[str->str_cur] == rschar) - str->str_ptr[str->str_cur] = '\0'; - else - str->str_cur++; - for (tmps = str->str_ptr; *tmps; tmps++) - if (!isALPHA(*tmps) && !isDIGIT(*tmps) && - index("$&*(){}[]'\";\\|?<>~`",*tmps)) - break; - if (*tmps && stat(str->str_ptr,&statbuf) < 0) - goto keepgoing; /* unmatched wildcard? */ - } - if (gimme == G_ARRAY) { - if (str->str_len - str->str_cur > 20) { - str->str_len = str->str_cur+1; - Renew(str->str_ptr, str->str_len, char); - } - str_2mortal(str); - if (++sp > stack->ary_max) { - astore(stack, sp, Nullstr); - st = stack->ary_array; - } - str = Str_new(58,80); - goto keepgoing; - } - else if (!tmplen && str->str_len - str->str_cur > 80) { - /* try to reclaim a bit of scalar space on 1st alloc */ - if (str->str_cur < 60) - str->str_len = 80; - else - str->str_len = str->str_cur+40; /* allow some slop */ - Renew(str->str_ptr, str->str_len, char); - } - } - rschar = old_rschar; - rslen = old_rslen; -#ifdef DEBUGGING - tmps = "READ"; -#endif - break; - } -#ifdef DEBUGGING - if (debug & 8) { - if (strEQ(tmps, "NULL")) - deb("%d.%s\n",anum,tmps); - else - deb("%d.%s = '%s'\n",anum,tmps,str_peek(st[sp])); - } -#endif - if (anum < 8) - arglast[anum] = sp; - } - - if (ppaddr[optype]) { - int status; - - /* pretend like we've been maintaining stack_* all along */ - stack_ary = stack->ary_array; - stack_sp = stack_ary + sp; - if (mark[optype] && stack_mark != arglast[0]) - warn("Inconsistent stack mark %d != %d", stack_mark, arglast[0]); - stack_max = stack_ary + stack->ary_max; - - status = (*ppaddr[optype])(str, arg, gimme); - - if (savestack->ary_fill > mymarkbase) { - warn("Inconsistent stack base"); - restorelist(mymarkbase); - } - sp = stack_sp - stack_ary; - if (sp < arglast[0]) - warn("TOO MANY POPS"); - st += arglast[0]; - goto array_return; - } - - st += arglast[0]; - -#ifdef SMALLSWITCHES - if (optype < O_CHOWN) -#endif - switch (optype) { - case O_RCAT: - STABSET(str); - break; - case O_ITEM: - if (gimme == G_ARRAY) - goto array_return; - /* FALL THROUGH */ - case O_SCALAR: - STR_SSET(str,st[1]); - STABSET(str); - break; - case O_ITEM2: - if (gimme == G_ARRAY) - goto array_return; - --anum; - STR_SSET(str,st[arglast[anum]-arglast[0]]); - STABSET(str); - break; - case O_ITEM3: - if (gimme == G_ARRAY) - goto array_return; - --anum; - STR_SSET(str,st[arglast[anum]-arglast[0]]); - STABSET(str); - break; - case O_CONCAT: - STR_SSET(str,st[1]); - str_scat(str,st[2]); - STABSET(str); - break; - case O_REPEAT: - if (gimme == G_ARRAY && arg[1].arg_flags & AF_ARYOK) { - sp = do_repeatary(arglast); - goto array_return; - } - STR_SSET(str,st[1]); - anum = (int)str_gnum(st[2]); - if (anum >= 1) { - tmpstr = Str_new(50, 0); - tmps = str_get(str); - str_nset(tmpstr,tmps,str->str_cur); - tmps = str_get(tmpstr); /* force to be string */ - STR_GROW(str, (anum * str->str_cur) + 1); - repeatcpy(str->str_ptr, tmps, tmpstr->str_cur, anum); - str->str_cur *= anum; - str->str_ptr[str->str_cur] = '\0'; - str->str_nok = 0; - str_free(tmpstr); - } - else { - if (dowarn && st[2]->str_pok && !looks_like_number(st[2])) - warn("Right operand of x is not numeric"); - str_sset(str,&str_no); - } - STABSET(str); - break; - case O_MATCH: - sp = do_match(str,arg, - gimme,arglast); - if (gimme == G_ARRAY) - goto array_return; - STABSET(str); - break; - case O_NMATCH: - sp = do_match(str,arg, - G_SCALAR,arglast); - str_sset(str, str_true(str) ? &str_no : &str_yes); - STABSET(str); - break; - case O_SUBST: - sp = do_subst(str,arg,arglast[0]); - goto array_return; - case O_NSUBST: - sp = do_subst(str,arg,arglast[0]); - str = arg->arg_ptr.arg_str; - str_set(str, str_true(str) ? No : Yes); - goto array_return; - case O_ASSIGN: - if (arg[1].arg_flags & AF_ARYOK) { - if (arg->arg_len == 1) { - arg->arg_type = O_LOCAL; - goto local; - } - else { - arg->arg_type = O_AASSIGN; - goto aassign; - } - } - else { - arg->arg_type = O_SASSIGN; - goto sassign; - } - case O_LOCAL: - local: - arglast[2] = arglast[1]; /* push a null array */ - /* FALL THROUGH */ - case O_AASSIGN: - aassign: - sp = do_assign(arg, - gimme,arglast); - goto array_return; - case O_SASSIGN: - sassign: -#ifdef TAINT - if (tainted && !st[2]->str_tainted) - tainted = 0; -#endif - STR_SSET(str, st[2]); - STABSET(str); - break; - case O_CHOP: - st -= arglast[0]; - str = arg->arg_ptr.arg_str; - for (sp = arglast[0] + 1; sp <= arglast[1]; sp++) - do_chop(str,st[sp]); - st += arglast[0]; - break; - case O_DEFINED: - if (arg[1].arg_type & A_DONT) { - sp = do_defined(str,arg, - gimme,arglast); - goto array_return; - } - else if (str->str_pok || str->str_nok) - goto say_yes; - goto say_no; - case O_UNDEF: - if (arg[1].arg_type & A_DONT) { - sp = do_undef(str,arg, - gimme,arglast); - goto array_return; - } - else if (str != stab_val(defstab)) { - if (str->str_len) { - if (str->str_state == SS_INCR) - Str_Grow(str,0); - Safefree(str->str_ptr); - str->str_ptr = Nullch; - str->str_len = 0; - } - str->str_pok = str->str_nok = 0; - STABSET(str); - } - goto say_undef; - case O_STUDY: - sp = do_study(str,arg, - gimme,arglast); - goto array_return; - case O_POW: - value = str_gnum(st[1]); - value = pow(value,str_gnum(st[2])); - goto donumset; - case O_MULTIPLY: - value = str_gnum(st[1]); - value *= str_gnum(st[2]); - goto donumset; - case O_DIVIDE: - if ((value = str_gnum(st[2])) == 0.0) - fatal("Illegal division by zero"); -#ifdef SLOPPYDIVIDE - /* insure that 20./5. == 4. */ - { - double x; - int k; - x = str_gnum(st[1]); - if ((double)(int)x == x && - (double)(int)value == value && - (k = (int)x/(int)value)*(int)value == (int)x) { - value = k; - } else { - value = x/value; - } - } -#else - value = str_gnum(st[1]) / value; -#endif - goto donumset; - case O_MODULO: - tmpulong = (unsigned long) str_gnum(st[2]); - if (tmpulong == 0L) - fatal("Illegal modulus zero"); -#ifndef lint - value = str_gnum(st[1]); - if (value >= 0.0) - value = (double)(((unsigned long)value) % tmpulong); - else { - tmplong = (long)value; - value = (double)(tmpulong - ((-tmplong - 1) % tmpulong)) - 1; - } -#endif - goto donumset; - case O_ADD: - value = str_gnum(st[1]); - value += str_gnum(st[2]); - goto donumset; - case O_SUBTRACT: - value = str_gnum(st[1]); - value -= str_gnum(st[2]); - goto donumset; - case O_LEFT_SHIFT: - value = str_gnum(st[1]); - anum = (int)str_gnum(st[2]); -#ifndef lint - value = (double)(U_L(value) << anum); -#endif - goto donumset; - case O_RIGHT_SHIFT: - value = str_gnum(st[1]); - anum = (int)str_gnum(st[2]); -#ifndef lint - value = (double)(U_L(value) >> anum); -#endif - goto donumset; - case O_LT: - value = str_gnum(st[1]); - value = (value < str_gnum(st[2])) ? 1.0 : 0.0; - goto donumset; - case O_GT: - value = str_gnum(st[1]); - value = (value > str_gnum(st[2])) ? 1.0 : 0.0; - goto donumset; - case O_LE: - value = str_gnum(st[1]); - value = (value <= str_gnum(st[2])) ? 1.0 : 0.0; - goto donumset; - case O_GE: - value = str_gnum(st[1]); - value = (value >= str_gnum(st[2])) ? 1.0 : 0.0; - goto donumset; - case O_EQ: - if (dowarn) { - if ((!st[1]->str_nok && !looks_like_number(st[1])) || - (!st[2]->str_nok && !looks_like_number(st[2])) ) - warn("Possible use of == on string value"); - } - value = str_gnum(st[1]); - value = (value == str_gnum(st[2])) ? 1.0 : 0.0; - goto donumset; - case O_NE: - value = str_gnum(st[1]); - value = (value != str_gnum(st[2])) ? 1.0 : 0.0; - goto donumset; - case O_NCMP: - value = str_gnum(st[1]); - value -= str_gnum(st[2]); - if (value > 0.0) - value = 1.0; - else if (value < 0.0) - value = -1.0; - goto donumset; - case O_BIT_AND: - if (!sawvec || st[1]->str_nok || st[2]->str_nok) { - value = str_gnum(st[1]); -#ifndef lint - value = (double)(U_L(value) & U_L(str_gnum(st[2]))); -#endif - goto donumset; - } - else - do_vop(optype,str,st[1],st[2]); - break; - case O_XOR: - if (!sawvec || st[1]->str_nok || st[2]->str_nok) { - value = str_gnum(st[1]); -#ifndef lint - value = (double)(U_L(value) ^ U_L(str_gnum(st[2]))); -#endif - goto donumset; - } - else - do_vop(optype,str,st[1],st[2]); - break; - case O_BIT_OR: - if (!sawvec || st[1]->str_nok || st[2]->str_nok) { - value = str_gnum(st[1]); -#ifndef lint - value = (double)(U_L(value) | U_L(str_gnum(st[2]))); -#endif - goto donumset; - } - else - do_vop(optype,str,st[1],st[2]); - break; -/* use register in evaluating str_true() */ - case O_AND: - if (str_true(st[1])) { - anum = 2; - optype = O_ITEM2; - argflags = arg[anum].arg_flags; - if (gimme == G_ARRAY) - argflags |= AF_ARYOK; - argtype = arg[anum].arg_type & A_MASK; - argptr = arg[anum].arg_ptr; - maxarg = anum = 1; - sp = arglast[0]; - st -= sp; - goto re_eval; - } - else { - if (assigning) { - str_sset(str, st[1]); - STABSET(str); - } - else - str = st[1]; - break; - } - case O_OR: - if (str_true(st[1])) { - if (assigning) { - str_sset(str, st[1]); - STABSET(str); - } - else - str = st[1]; - break; - } - else { - anum = 2; - optype = O_ITEM2; - argflags = arg[anum].arg_flags; - if (gimme == G_ARRAY) - argflags |= AF_ARYOK; - argtype = arg[anum].arg_type & A_MASK; - argptr = arg[anum].arg_ptr; - maxarg = anum = 1; - sp = arglast[0]; - st -= sp; - goto re_eval; - } - case O_COND_EXPR: - anum = (str_true(st[1]) ? 2 : 3); - optype = (anum == 2 ? O_ITEM2 : O_ITEM3); - argflags = arg[anum].arg_flags; - if (gimme == G_ARRAY) - argflags |= AF_ARYOK; - argtype = arg[anum].arg_type & A_MASK; - argptr = arg[anum].arg_ptr; - maxarg = anum = 1; - sp = arglast[0]; - st -= sp; - goto re_eval; - case O_COMMA: - if (gimme == G_ARRAY) - goto array_return; - str = st[2]; - break; - case O_NEGATE: - value = -str_gnum(st[1]); - goto donumset; - case O_NOT: -#ifdef NOTNOT - { char xxx = str_true(st[1]); value = (double) !xxx; } -#else - value = (double) !str_true(st[1]); -#endif - goto donumset; - case O_COMPLEMENT: - if (!sawvec || st[1]->str_nok) { -#ifndef lint - value = (double) ~U_L(str_gnum(st[1])); -#endif - goto donumset; - } - else { - STR_SSET(str,st[1]); - tmps = str_get(str); - for (anum = str->str_cur; anum; anum--, tmps++) - *tmps = ~*tmps; - } - break; - case O_SELECT: - stab_efullname(str,defoutstab); - if (maxarg > 0) { - if ((arg[1].arg_type & A_MASK) == A_WORD) - defoutstab = arg[1].arg_ptr.arg_stab; - else - defoutstab = stabent(str_get(st[1]),TRUE); - if (!stab_io(defoutstab)) - stab_io(defoutstab) = stio_new(); - curoutstab = defoutstab; - } - STABSET(str); - break; - case O_WRITE: - if (maxarg == 0) - stab = defoutstab; - else if ((arg[1].arg_type & A_MASK) == A_WORD) { - if (!(stab = arg[1].arg_ptr.arg_stab)) - stab = defoutstab; - } - else - stab = stabent(str_get(st[1]),TRUE); - if (!stab_io(stab)) { - str_set(str, No); - STABSET(str); - break; - } - curoutstab = stab; - fp = stab_io(stab)->ofp; - if (stab_io(stab)->fmt_stab) - form = stab_form(stab_io(stab)->fmt_stab); - else - form = stab_form(stab); - if (!form || !fp) { - if (dowarn) { - if (form) - warn("No format for filehandle"); - else { - if (stab_io(stab)->ifp) - warn("Filehandle only opened for input"); - else - warn("Write on closed filehandle"); - } - } - str_set(str, No); - STABSET(str); - break; - } - format(&outrec,form,sp); - do_write(&outrec,stab,sp); - if (stab_io(stab)->flags & IOF_FLUSH) - (void)fflush(fp); - str_set(str, Yes); - STABSET(str); - break; - case O_DBMOPEN: -#ifdef SOME_DBM - anum = arg[1].arg_type & A_MASK; - if (anum == A_WORD || anum == A_STAB) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); - if (st[3]->str_nok || st[3]->str_pok) - anum = (int)str_gnum(st[3]); - else - anum = -1; - value = (double)hdbmopen(stab_hash(stab),str_get(st[2]),anum); - goto donumset; -#else - fatal("No dbm or ndbm on this machine"); -#endif - case O_DBMCLOSE: -#ifdef SOME_DBM - anum = arg[1].arg_type & A_MASK; - if (anum == A_WORD || anum == A_STAB) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); - hdbmclose(stab_hash(stab)); - goto say_yes; -#else - fatal("No dbm or ndbm on this machine"); -#endif - case O_OPEN: - if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); - tmps = str_get(st[2]); - if (do_open(stab,tmps,st[2]->str_cur)) { - value = (double)forkprocess; - stab_io(stab)->lines = 0; - goto donumset; - } - else if (forkprocess == 0) /* we are a new child */ - goto say_zero; - else - goto say_undef; - /* break; */ - case O_TRANS: - value = (double) do_trans(str,arg); - str = arg->arg_ptr.arg_str; - goto donumset; - case O_NTRANS: - str_set(arg->arg_ptr.arg_str, do_trans(str,arg) == 0 ? Yes : No); - str = arg->arg_ptr.arg_str; - break; - case O_CLOSE: - if (maxarg == 0) - stab = defoutstab; - else if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); - str_set(str, do_close(stab,TRUE) ? Yes : No ); - STABSET(str); - break; - case O_EACH: - sp = do_each(str,stab_hash(arg[1].arg_ptr.arg_stab), - gimme,arglast); - goto array_return; - case O_VALUES: - case O_KEYS: - sp = do_kv(str,stab_hash(arg[1].arg_ptr.arg_stab), optype, - gimme,arglast); - goto array_return; - case O_LARRAY: - str->str_nok = str->str_pok = 0; - str->str_u.str_stab = arg[1].arg_ptr.arg_stab; - str->str_state = SS_ARY; - break; - case O_ARRAY: - ary = stab_array(arg[1].arg_ptr.arg_stab); - maxarg = ary->ary_fill + 1; - if (gimme == G_ARRAY) { /* array wanted */ - sp = arglast[0]; - st -= sp; - if (maxarg > 0 && sp + maxarg > stack->ary_max) { - astore(stack,sp + maxarg, Nullstr); - st = stack->ary_array; - } - st += sp; - Copy(ary->ary_array, &st[1], maxarg, STR*); - sp += maxarg; - goto array_return; - } - else { - value = (double)maxarg; - goto donumset; - } - case O_AELEM: - anum = ((int)str_gnum(st[2])) - arybase; - str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,FALSE); - break; - case O_DELETE: - tmpstab = arg[1].arg_ptr.arg_stab; - tmps = str_get(st[2]); - str = hdelete(stab_hash(tmpstab),tmps,st[2]->str_cur); - if (tmpstab == envstab) - my_setenv(tmps,Nullch); - if (!str) - goto say_undef; - break; - case O_LHASH: - str->str_nok = str->str_pok = 0; - str->str_u.str_stab = arg[1].arg_ptr.arg_stab; - str->str_state = SS_HASH; - break; - case O_HASH: - if (gimme == G_ARRAY) { /* array wanted */ - sp = do_kv(str,stab_hash(arg[1].arg_ptr.arg_stab), optype, - gimme,arglast); - goto array_return; - } - else { - tmpstab = arg[1].arg_ptr.arg_stab; - if (!stab_hash(tmpstab)->tbl_fill) - goto say_zero; - sprintf(buf,"%d/%d",stab_hash(tmpstab)->tbl_fill, - stab_hash(tmpstab)->tbl_max+1); - str_set(str,buf); - } - break; - case O_HELEM: - tmpstab = arg[1].arg_ptr.arg_stab; - tmps = str_get(st[2]); - str = hfetch(stab_hash(tmpstab),tmps,st[2]->str_cur,FALSE); - break; - case O_LAELEM: - anum = ((int)str_gnum(st[2])) - arybase; - str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,TRUE); - if (!str || str == &str_undef) - fatal("Assignment to non-creatable value, subscript %d",anum); - break; - case O_LHELEM: - tmpstab = arg[1].arg_ptr.arg_stab; - tmps = str_get(st[2]); - anum = st[2]->str_cur; - str = hfetch(stab_hash(tmpstab),tmps,anum,TRUE); - if (!str || str == &str_undef) - fatal("Assignment to non-creatable value, subscript \"%s\"",tmps); - if (tmpstab == envstab) /* heavy wizardry going on here */ - str_magic(str, tmpstab, 'E', tmps, anum); /* str is now magic */ - /* he threw the brick up into the air */ - else if (tmpstab == sigstab) - str_magic(str, tmpstab, 'S', tmps, anum); -#ifdef SOME_DBM - else if (stab_hash(tmpstab)->tbl_dbm) - str_magic(str, tmpstab, 'D', tmps, anum); -#endif - else if (tmpstab == DBline) - str_magic(str, tmpstab, 'L', tmps, anum); - break; - case O_LSLICE: - anum = 2; - argtype = FALSE; - goto do_slice_already; - case O_ASLICE: - anum = 1; - argtype = FALSE; - goto do_slice_already; - case O_HSLICE: - anum = 0; - argtype = FALSE; - goto do_slice_already; - case O_LASLICE: - anum = 1; - argtype = TRUE; - goto do_slice_already; - case O_LHSLICE: - anum = 0; - argtype = TRUE; - do_slice_already: - sp = do_slice(arg[1].arg_ptr.arg_stab,str,anum,argtype, - gimme,arglast); - goto array_return; - case O_SPLICE: - sp = do_splice(stab_array(arg[1].arg_ptr.arg_stab),gimme,arglast); - goto array_return; - case O_PUSH: - if (arglast[2] - arglast[1] != 1) - str = do_push(stab_array(arg[1].arg_ptr.arg_stab),arglast); - else { - str = Str_new(51,0); /* must copy the STR */ - str_sset(str,st[2]); - (void)apush(stab_array(arg[1].arg_ptr.arg_stab),str); - } - break; - case O_POP: - str = apop(ary = stab_array(arg[1].arg_ptr.arg_stab)); - goto staticalization; - case O_SHIFT: - str = ashift(ary = stab_array(arg[1].arg_ptr.arg_stab)); - staticalization: - if (!str) - goto say_undef; - if (ary->ary_flags & ARF_REAL) - (void)str_2mortal(str); - break; - case O_UNPACK: - sp = do_unpack(str,gimme,arglast); - goto array_return; - case O_SPLIT: - value = str_gnum(st[3]); - sp = do_split(str, arg[2].arg_ptr.arg_spat, (int)value, - gimme,arglast); - goto array_return; - case O_LENGTH: - if (maxarg < 1) - value = (double)str_len(stab_val(defstab)); - else - value = (double)str_len(st[1]); - goto donumset; - case O_SPRINTF: - do_sprintf(str, sp-arglast[0], st+1); - break; - case O_SUBSTR: - anum = ((int)str_gnum(st[2])) - arybase; /* anum=where to start*/ - tmps = str_get(st[1]); /* force conversion to string */ - /*SUPPRESS 560*/ - if (argtype = (str == st[1])) - str = arg->arg_ptr.arg_str; - if (anum < 0) - anum += st[1]->str_cur + arybase; - if (anum < 0 || anum > st[1]->str_cur) - str_nset(str,"",0); - else { - optype = maxarg < 3 ? st[1]->str_cur : (int)str_gnum(st[3]); - if (optype < 0) - optype = 0; - tmps += anum; - anum = st[1]->str_cur - anum; /* anum=how many bytes left*/ - if (anum > optype) - anum = optype; - str_nset(str, tmps, anum); - if (argtype) { /* it's an lvalue! */ - Lstring *lstr = (Lstring*)str; - - str->str_magic = st[1]; - st[1]->str_rare = 's'; - lstr->lstr_offset = tmps - str_get(st[1]); - lstr->lstr_len = anum; - } - } - break; - case O_PACK: - /*SUPPRESS 701*/ - (void)do_pack(str,arglast); - break; - case O_GREP: - sp = do_grep(arg,str,gimme,arglast); - goto array_return; - case O_JOIN: - do_join(str,arglast); - break; - case O_SLT: - tmps = str_get(st[1]); - value = (double) (str_cmp(st[1],st[2]) < 0); - goto donumset; - case O_SGT: - tmps = str_get(st[1]); - value = (double) (str_cmp(st[1],st[2]) > 0); - goto donumset; - case O_SLE: - tmps = str_get(st[1]); - value = (double) (str_cmp(st[1],st[2]) <= 0); - goto donumset; - case O_SGE: - tmps = str_get(st[1]); - value = (double) (str_cmp(st[1],st[2]) >= 0); - goto donumset; - case O_SEQ: - tmps = str_get(st[1]); - value = (double) str_eq(st[1],st[2]); - goto donumset; - case O_SNE: - tmps = str_get(st[1]); - value = (double) !str_eq(st[1],st[2]); - goto donumset; - case O_SCMP: - tmps = str_get(st[1]); - value = (double) str_cmp(st[1],st[2]); - goto donumset; - case O_SUBR: - sp = do_subr(arg,gimme,arglast); - st = stack->ary_array + arglast[0]; /* maybe realloced */ - goto array_return; - case O_DBSUBR: - sp = do_subr(arg,gimme,arglast); - st = stack->ary_array + arglast[0]; /* maybe realloced */ - goto array_return; - case O_CALLER: - sp = do_caller(arg,maxarg,gimme,arglast); - st = stack->ary_array + arglast[0]; /* maybe realloced */ - goto array_return; - case O_SORT: - sp = do_sort(str,arg, - gimme,arglast); - goto array_return; - case O_REVERSE: - if (gimme == G_ARRAY) - sp = do_reverse(arglast); - else - sp = do_sreverse(str, arglast); - goto array_return; - case O_WARN: - if (arglast[2] - arglast[1] != 1) { - do_join(str,arglast); - tmps = str_get(str); - } - else { - str = st[2]; - tmps = str_get(st[2]); - } - if (!tmps || !*tmps) - tmps = "Warning: something's wrong"; - warn("%s",tmps); - goto say_yes; - case O_DIE: - if (arglast[2] - arglast[1] != 1) { - do_join(str,arglast); - tmps = str_get(str); - } - else { - str = st[2]; - tmps = str_get(st[2]); - } - if (!tmps || !*tmps) - tmps = "Died"; - fatal("%s",tmps); - goto say_zero; - case O_PRTF: - case O_PRINT: - if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); - if (!stab) - stab = defoutstab; - if (!stab_io(stab)) { - if (dowarn) - warn("Filehandle never opened"); - goto say_zero; - } - if (!(fp = stab_io(stab)->ofp)) { - if (dowarn) { - if (stab_io(stab)->ifp) - warn("Filehandle opened only for input"); - else - warn("Print on closed filehandle"); - } - goto say_zero; - } - else { - if (optype == O_PRTF || arglast[2] - arglast[1] != 1) - value = (double)do_aprint(arg,fp,arglast); - else { - value = (double)do_print(st[2],fp); - if (orslen && optype == O_PRINT) - if (fwrite(ors, 1, orslen, fp) == 0) - goto say_zero; - } - if (stab_io(stab)->flags & IOF_FLUSH) - if (fflush(fp) == EOF) - goto say_zero; - } - goto donumset; - case O_CHDIR: - if (maxarg < 1) - tmps = Nullch; - else - tmps = str_get(st[1]); - if (!tmps || !*tmps) { - tmpstr = hfetch(stab_hash(envstab),"HOME",4,FALSE); - tmps = str_get(tmpstr); - } - if (!tmps || !*tmps) { - tmpstr = hfetch(stab_hash(envstab),"LOGDIR",6,FALSE); - tmps = str_get(tmpstr); - } -#ifdef TAINT - TAINT_PROPER("chdir"); -#endif - value = (double)(chdir(tmps) >= 0); - goto donumset; - case O_EXIT: - if (maxarg < 1) - anum = 0; - else - anum = (int)str_gnum(st[1]); - my_exit(anum); - goto say_zero; - case O_RESET: - if (maxarg < 1) - tmps = ""; - else - tmps = str_get(st[1]); - str_reset(tmps,curcmd->c_stash); - value = 1.0; - goto donumset; - case O_LIST: - if (gimme == G_ARRAY) - goto array_return; - if (maxarg > 0) - str = st[sp - arglast[0]]; /* unwanted list, return last item */ - else - str = &str_undef; - break; - case O_EOF: - if (maxarg <= 0) - stab = last_in_stab; - else if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); - str_set(str, do_eof(stab) ? Yes : No); - STABSET(str); - break; - case O_GETC: - if (maxarg <= 0) - stab = stdinstab; - else if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); - if (!stab) - stab = argvstab; - if (!stab || do_eof(stab)) /* make sure we have fp with something */ - goto say_undef; - else { -#ifdef TAINT - tainted = 1; -#endif - str_set(str," "); - *str->str_ptr = getc(stab_io(stab)->ifp); /* should never be EOF */ - } - STABSET(str); - break; - case O_TELL: - if (maxarg <= 0) - stab = last_in_stab; - else if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); -#ifndef lint - value = (double)do_tell(stab); -#else - (void)do_tell(stab); -#endif - goto donumset; - case O_RECV: - case O_READ: - case O_SYSREAD: - if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); - tmps = str_get(st[2]); - anum = (int)str_gnum(st[3]); - errno = 0; - maxarg = sp - arglast[0]; - if (maxarg > 4) - warn("Too many args on read"); - if (maxarg == 4) - maxarg = (int)str_gnum(st[4]); - else - maxarg = 0; - if (!stab_io(stab) || !stab_io(stab)->ifp) - goto say_undef; -#ifdef HAS_SOCKET - if (optype == O_RECV) { - argtype = sizeof buf; - STR_GROW(st[2], anum+1), (tmps = str_get(st[2])); /* sneaky */ - anum = recvfrom(fileno(stab_io(stab)->ifp), tmps, anum, maxarg, - buf, &argtype); - if (anum >= 0) { - st[2]->str_cur = anum; - st[2]->str_ptr[anum] = '\0'; - str_nset(str,buf,argtype); - } - else - str_sset(str,&str_undef); - break; - } -#else - if (optype == O_RECV) - goto badsock; -#endif - STR_GROW(st[2], anum+maxarg+1), (tmps = str_get(st[2])); /* sneaky */ - if (optype == O_SYSREAD) { - anum = read(fileno(stab_io(stab)->ifp), tmps+maxarg, anum); - } - else -#ifdef HAS_SOCKET - if (stab_io(stab)->type == 's') { - argtype = sizeof buf; - anum = recvfrom(fileno(stab_io(stab)->ifp), tmps+maxarg, anum, 0, - buf, &argtype); - } - else -#endif - anum = fread(tmps+maxarg, 1, anum, stab_io(stab)->ifp); - if (anum < 0) - goto say_undef; - st[2]->str_cur = anum+maxarg; - st[2]->str_ptr[anum+maxarg] = '\0'; - value = (double)anum; - goto donumset; - case O_SYSWRITE: - case O_SEND: - if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); - tmps = str_get(st[2]); - anum = (int)str_gnum(st[3]); - errno = 0; - stio = stab_io(stab); - maxarg = sp - arglast[0]; - if (!stio || !stio->ifp) { - anum = -1; - if (dowarn) { - if (optype == O_SYSWRITE) - warn("Syswrite on closed filehandle"); - else - warn("Send on closed socket"); - } - } - else if (optype == O_SYSWRITE) { - if (maxarg > 4) - warn("Too many args on syswrite"); - if (maxarg == 4) - optype = (int)str_gnum(st[4]); - else - optype = 0; - anum = write(fileno(stab_io(stab)->ifp), tmps+optype, anum); - } -#ifdef HAS_SOCKET - else if (maxarg >= 4) { - if (maxarg > 4) - warn("Too many args on send"); - tmps2 = str_get(st[4]); - anum = sendto(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur, - anum, tmps2, st[4]->str_cur); - } - else - anum = send(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur, anum); -#else - else - goto badsock; -#endif - if (anum < 0) - goto say_undef; - value = (double)anum; - goto donumset; - case O_SEEK: - if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); - value = str_gnum(st[2]); - str_set(str, do_seek(stab, - (long)value, (int)str_gnum(st[3]) ) ? Yes : No); - STABSET(str); - break; - case O_RETURN: - tmps = "_SUB_"; /* just fake up a "last _SUB_" */ - optype = O_LAST; - if (curcsv && curcsv->wantarray == G_ARRAY) { - lastretstr = Nullstr; - lastspbase = arglast[1]; - lastsize = arglast[2] - arglast[1]; - } - else - lastretstr = str_mortal(st[arglast[2] - arglast[0]]); - goto dopop; - case O_REDO: - case O_NEXT: - case O_LAST: - tmps = Nullch; - if (maxarg > 0) { - tmps = str_get(arg[1].arg_ptr.arg_str); - dopop: - while (loop_ptr >= 0 && (!loop_stack[loop_ptr].loop_label || - strNE(tmps,loop_stack[loop_ptr].loop_label) )) { -#ifdef DEBUGGING - if (debug & 4) { - deb("(Skipping label #%d %s)\n",loop_ptr, - loop_stack[loop_ptr].loop_label); - } -#endif - loop_ptr--; - } -#ifdef DEBUGGING - if (debug & 4) { - deb("(Found label #%d %s)\n",loop_ptr, - loop_stack[loop_ptr].loop_label); - } -#endif - } - if (loop_ptr < 0) { - if (tmps && strEQ(tmps, "_SUB_")) - fatal("Can't return outside a subroutine"); - fatal("Bad label: %s", maxarg > 0 ? tmps : ""); - } - if (!lastretstr && optype == O_LAST && lastsize) { - st -= arglast[0]; - st += lastspbase + 1; - optype = loop_stack[loop_ptr].loop_sp - lastspbase; /* negative */ - if (optype) { - for (anum = lastsize; anum > 0; anum--,st++) - st[optype] = str_mortal(st[0]); - } - longjmp(loop_stack[loop_ptr].loop_env, O_LAST); - } - longjmp(loop_stack[loop_ptr].loop_env, optype); - case O_DUMP: - case O_GOTO:/* shudder */ - goto_targ = str_get(arg[1].arg_ptr.arg_str); - if (!*goto_targ) - goto_targ = Nullch; /* just restart from top */ - if (optype == O_DUMP) { - do_undump = TRUE; - my_unexec(); - } - longjmp(top_env, 1); - case O_INDEX: - tmps = str_get(st[1]); - if (maxarg < 3) - anum = 0; - else { - anum = (int) str_gnum(st[3]) - arybase; - if (anum < 0) - anum = 0; - else if (anum > st[1]->str_cur) - anum = st[1]->str_cur; - } -#ifndef lint - if (!(tmps2 = fbminstr((unsigned char*)tmps + anum, - (unsigned char*)tmps + st[1]->str_cur, st[2]))) -#else - if (tmps2 = fbminstr(Null(unsigned char*),Null(unsigned char*),Nullstr)) -#endif - value = (double)(-1 + arybase); - else - value = (double)(tmps2 - tmps + arybase); - goto donumset; - case O_RINDEX: - tmps = str_get(st[1]); - tmps2 = str_get(st[2]); - if (maxarg < 3) - anum = st[1]->str_cur; - else { - anum = (int) str_gnum(st[3]) - arybase + st[2]->str_cur; - if (anum < 0) - anum = 0; - else if (anum > st[1]->str_cur) - anum = st[1]->str_cur; - } -#ifndef lint - if (!(tmps2 = rninstr(tmps, tmps + anum, - tmps2, tmps2 + st[2]->str_cur))) -#else - if (tmps2 = rninstr(Nullch,Nullch,Nullch,Nullch)) -#endif - value = (double)(-1 + arybase); - else - value = (double)(tmps2 - tmps + arybase); - goto donumset; - case O_TIME: -#ifndef lint - value = (double) time(Null(long*)); -#endif - goto donumset; - case O_TMS: - sp = do_tms(str,gimme,arglast); - goto array_return; - case O_LOCALTIME: - if (maxarg < 1) - (void)time(&when); - else - when = (time_t)str_gnum(st[1]); - sp = do_time(str,localtime(&when), - gimme,arglast); - goto array_return; - case O_GMTIME: - if (maxarg < 1) - (void)time(&when); - else - when = (time_t)str_gnum(st[1]); - sp = do_time(str,gmtime(&when), - gimme,arglast); - goto array_return; - case O_TRUNCATE: - sp = do_truncate(str,arg, - gimme,arglast); - goto array_return; - case O_LSTAT: - case O_STAT: - sp = do_stat(str,arg, - gimme,arglast); - goto array_return; - case O_CRYPT: -#ifdef HAS_CRYPT - tmps = str_get(st[1]); -#ifdef FCRYPT - str_set(str,fcrypt(tmps,str_get(st[2]))); -#else - str_set(str,crypt(tmps,str_get(st[2]))); -#endif -#else - fatal( - "The crypt() function is unimplemented due to excessive paranoia."); -#endif - break; - case O_ATAN2: - value = str_gnum(st[1]); - value = atan2(value,str_gnum(st[2])); - goto donumset; - case O_SIN: - if (maxarg < 1) - value = str_gnum(stab_val(defstab)); - else - value = str_gnum(st[1]); - value = sin(value); - goto donumset; - case O_COS: - if (maxarg < 1) - value = str_gnum(stab_val(defstab)); - else - value = str_gnum(st[1]); - value = cos(value); - goto donumset; - case O_RAND: - if (maxarg < 1) - value = 1.0; - else - value = str_gnum(st[1]); - if (value == 0.0) - value = 1.0; -#if RANDBITS == 31 - value = rand() * value / 2147483648.0; -#else -#if RANDBITS == 16 - value = rand() * value / 65536.0; -#else -#if RANDBITS == 15 - value = rand() * value / 32768.0; -#else - value = rand() * value / (double)(((unsigned long)1) << RANDBITS); -#endif -#endif -#endif - goto donumset; - case O_SRAND: - if (maxarg < 1) { - (void)time(&when); - anum = when; - } - else - anum = (int)str_gnum(st[1]); - (void)srand(anum); - goto say_yes; - case O_EXP: - if (maxarg < 1) - value = str_gnum(stab_val(defstab)); - else - value = str_gnum(st[1]); - value = exp(value); - goto donumset; - case O_LOG: - if (maxarg < 1) - value = str_gnum(stab_val(defstab)); - else - value = str_gnum(st[1]); - if (value <= 0.0) - fatal("Can't take log of %g\n", value); - value = log(value); - goto donumset; - case O_SQRT: - if (maxarg < 1) - value = str_gnum(stab_val(defstab)); - else - value = str_gnum(st[1]); - if (value < 0.0) - fatal("Can't take sqrt of %g\n", value); - value = sqrt(value); - goto donumset; - case O_INT: - if (maxarg < 1) - value = str_gnum(stab_val(defstab)); - else - value = str_gnum(st[1]); - if (value >= 0.0) - (void)modf(value,&value); - else { - (void)modf(-value,&value); - value = -value; - } - goto donumset; - case O_ORD: - if (maxarg < 1) - tmps = str_get(stab_val(defstab)); - else - tmps = str_get(st[1]); -#ifndef I286 - value = (double) (*tmps & 255); -#else - anum = (int) *tmps; - value = (double) (anum & 255); -#endif - goto donumset; - case O_ALARM: -#ifdef HAS_ALARM - if (maxarg < 1) - tmps = str_get(stab_val(defstab)); - else - tmps = str_get(st[1]); - if (!tmps) - tmps = "0"; - anum = alarm((unsigned int)atoi(tmps)); - if (anum < 0) - goto say_undef; - value = (double)anum; - goto donumset; -#else - fatal("Unsupported function alarm"); - break; -#endif - case O_SLEEP: - if (maxarg < 1) - tmps = Nullch; - else - tmps = str_get(st[1]); - (void)time(&when); - if (!tmps || !*tmps) - sleep((32767<<16)+32767); - else - sleep((unsigned int)atoi(tmps)); -#ifndef lint - value = (double)when; - (void)time(&when); - value = ((double)when) - value; -#endif - goto donumset; - case O_RANGE: - sp = do_range(gimme,arglast); - goto array_return; - case O_F_OR_R: - if (gimme == G_ARRAY) { /* it's a range */ - /* can we optimize to constant array? */ - if ((arg[1].arg_type & A_MASK) == A_SINGLE && - (arg[2].arg_type & A_MASK) == A_SINGLE) { - st[2] = arg[2].arg_ptr.arg_str; - sp = do_range(gimme,arglast); - st = stack->ary_array; - maxarg = sp - arglast[0]; - str_free(arg[1].arg_ptr.arg_str); - arg[1].arg_ptr.arg_str = Nullstr; - str_free(arg[2].arg_ptr.arg_str); - arg[2].arg_ptr.arg_str = Nullstr; - arg->arg_type = O_ARRAY; - arg[1].arg_type = A_STAB|A_DONT; - arg->arg_len = 1; - stab = arg[1].arg_ptr.arg_stab = aadd(genstab()); - ary = stab_array(stab); - afill(ary,maxarg - 1); - anum = maxarg; - st += arglast[0]+1; - while (maxarg-- > 0) - ary->ary_array[maxarg] = str_smake(st[maxarg]); - st -= arglast[0]+1; - goto array_return; - } - arg->arg_type = optype = O_RANGE; - maxarg = arg->arg_len = 2; - anum = 2; - arg[anum].arg_flags &= ~AF_ARYOK; - argflags = arg[anum].arg_flags; - argtype = arg[anum].arg_type & A_MASK; - arg[anum].arg_type = argtype; - argptr = arg[anum].arg_ptr; - sp = arglast[0]; - st -= sp; - sp++; - goto re_eval; - } - arg->arg_type = O_FLIP; - /* FALL THROUGH */ - case O_FLIP: - if ((arg[1].arg_type & A_MASK) == A_SINGLE ? - last_in_stab && (int)str_gnum(st[1]) == stab_io(last_in_stab)->lines - : - str_true(st[1]) ) { - arg[2].arg_type &= ~A_DONT; - arg[1].arg_type |= A_DONT; - arg->arg_type = optype = O_FLOP; - if (arg->arg_flags & AF_COMMON) { - str_numset(str,0.0); - anum = 2; - argflags = arg[2].arg_flags; - argtype = arg[2].arg_type & A_MASK; - argptr = arg[2].arg_ptr; - sp = arglast[0]; - st -= sp++; - goto re_eval; - } - else { - str_numset(str,1.0); - break; - } - } - str_set(str,""); - break; - case O_FLOP: - str_inc(str); - if ((arg[2].arg_type & A_MASK) == A_SINGLE ? - last_in_stab && (int)str_gnum(st[2]) == stab_io(last_in_stab)->lines - : - str_true(st[2]) ) { - arg->arg_type = O_FLIP; - arg[1].arg_type &= ~A_DONT; - arg[2].arg_type |= A_DONT; - str_cat(str,"E0"); - } - break; - case O_FORK: -#ifdef HAS_FORK - anum = fork(); - if (anum < 0) - goto say_undef; - if (!anum) { - /*SUPPRESS 560*/ - if (tmpstab = stabent("$",allstabs)) - str_numset(STAB_STR(tmpstab),(double)getpid()); - hclear(pidstatus, FALSE); /* no kids, so don't wait for 'em */ - } - value = (double)anum; - goto donumset; -#else - fatal("Unsupported function fork"); - break; -#endif - case O_WAIT: -#ifdef HAS_WAIT -#ifndef lint - anum = wait(&argflags); - if (anum > 0) - pidgone(anum,argflags); - value = (double)anum; -#endif - statusvalue = (unsigned short)argflags; - goto donumset; -#else - fatal("Unsupported function wait"); - break; -#endif - case O_WAITPID: -#ifdef HAS_WAIT -#ifndef lint - anum = (int)str_gnum(st[1]); - optype = (int)str_gnum(st[2]); - anum = wait4pid(anum, &argflags,optype); - value = (double)anum; -#endif - statusvalue = (unsigned short)argflags; - goto donumset; -#else - fatal("Unsupported function wait"); - break; -#endif - case O_SYSTEM: -#ifdef HAS_FORK -#ifdef TAINT - if (arglast[2] - arglast[1] == 1) { - taintenv(); - tainted |= st[2]->str_tainted; - TAINT_PROPER("system"); - } -#endif - while ((anum = vfork()) == -1) { - if (errno != EAGAIN) { - value = -1.0; - goto donumset; - } - sleep(5); - } - if (anum > 0) { -#ifndef lint - ihand = signal(SIGINT, SIG_IGN); - qhand = signal(SIGQUIT, SIG_IGN); - argtype = wait4pid(anum, &argflags, 0); -#else - ihand = qhand = 0; -#endif - (void)signal(SIGINT, ihand); - (void)signal(SIGQUIT, qhand); - statusvalue = (unsigned short)argflags; - if (argtype < 0) - value = -1.0; - else { - value = (double)((unsigned int)argflags & 0xffff); - } - do_execfree(); /* free any memory child malloced on vfork */ - goto donumset; - } - if ((arg[1].arg_type & A_MASK) == A_STAB) - value = (double)do_aexec(st[1],arglast); - else if (arglast[2] - arglast[1] != 1) - value = (double)do_aexec(Nullstr,arglast); - else { - value = (double)do_exec(str_get(str_mortal(st[2]))); - } - _exit(-1); -#else /* ! FORK */ - if ((arg[1].arg_type & A_MASK) == A_STAB) - value = (double)do_aspawn(st[1],arglast); - else if (arglast[2] - arglast[1] != 1) - value = (double)do_aspawn(Nullstr,arglast); - else { - value = (double)do_spawn(str_get(str_mortal(st[2]))); - } - goto donumset; -#endif /* FORK */ - case O_EXEC_OP: - if ((arg[1].arg_type & A_MASK) == A_STAB) - value = (double)do_aexec(st[1],arglast); - else if (arglast[2] - arglast[1] != 1) - value = (double)do_aexec(Nullstr,arglast); - else { -#ifdef TAINT - taintenv(); - tainted |= st[2]->str_tainted; - TAINT_PROPER("exec"); -#endif - value = (double)do_exec(str_get(str_mortal(st[2]))); - } - goto donumset; - case O_HEX: - if (maxarg < 1) - tmps = str_get(stab_val(defstab)); - else - tmps = str_get(st[1]); - value = (double)scanhex(tmps, 99, &argtype); - goto donumset; - - case O_OCT: - if (maxarg < 1) - tmps = str_get(stab_val(defstab)); - else - tmps = str_get(st[1]); - while (*tmps && (isSPACE(*tmps) || *tmps == '0')) - tmps++; - if (*tmps == 'x') - value = (double)scanhex(++tmps, 99, &argtype); - else - value = (double)scanoct(tmps, 99, &argtype); - goto donumset; - -/* These common exits are hidden here in the middle of the switches for the - benefit of those machines with limited branch addressing. Sigh. */ - -array_return: -#ifdef DEBUGGING - if (debug) { - dlevel--; - if (debug & 8) { - anum = sp - arglast[0]; - switch (anum) { - case 0: - deb("%s RETURNS ()\n",opname[optype]); - break; - case 1: - deb("%s RETURNS (\"%s\")\n",opname[optype], - st[1] ? str_get(st[1]) : ""); - break; - default: - tmps = st[1] ? str_get(st[1]) : ""; - deb("%s RETURNS %d ARGS (\"%s\",%s\"%s\")\n",opname[optype], - anum,tmps,anum==2?"":"...,", - st[anum] ? str_get(st[anum]) : ""); - break; - } - } - } -#endif - stack_ary = stack->ary_array; - stack_max = stack_ary + stack->ary_max; - stack_sp = stack_ary + sp; - return sp; - -say_yes: - str = &str_yes; - goto normal_return; - -say_no: - str = &str_no; - goto normal_return; - -say_undef: - str = &str_undef; - goto normal_return; - -say_zero: - value = 0.0; - /* FALL THROUGH */ - -donumset: - str_numset(str,value); - STABSET(str); - st[1] = str; -#ifdef DEBUGGING - if (debug) { - dlevel--; - if (debug & 8) - deb("%s RETURNS \"%f\"\n",opname[optype],value); - } -#endif - stack_ary = stack->ary_array; - stack_max = stack_ary + stack->ary_max; - stack_sp = stack_ary + arglast[0] + 1; - return arglast[0] + 1; -#ifdef SMALLSWITCHES - } - else - switch (optype) { -#endif - case O_CHOWN: -#ifdef HAS_CHOWN - value = (double)apply(optype,arglast); - goto donumset; -#else - fatal("Unsupported function chown"); - break; -#endif - case O_KILL: -#ifdef HAS_KILL - value = (double)apply(optype,arglast); - goto donumset; -#else - fatal("Unsupported function kill"); - break; -#endif - case O_UNLINK: - case O_CHMOD: - case O_UTIME: - value = (double)apply(optype,arglast); - goto donumset; - case O_UMASK: -#ifdef HAS_UMASK - if (maxarg < 1) { - anum = umask(0); - (void)umask(anum); - } - else - anum = umask((int)str_gnum(st[1])); - value = (double)anum; -#ifdef TAINT - TAINT_PROPER("umask"); -#endif - goto donumset; -#else - fatal("Unsupported function umask"); - break; -#endif -#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) - case O_MSGGET: - case O_SHMGET: - case O_SEMGET: - if ((anum = do_ipcget(optype, arglast)) == -1) - goto say_undef; - value = (double)anum; - goto donumset; - case O_MSGCTL: - case O_SHMCTL: - case O_SEMCTL: - anum = do_ipcctl(optype, arglast); - if (anum == -1) - goto say_undef; - if (anum != 0) { - value = (double)anum; - goto donumset; - } - str_set(str,"0 but true"); - STABSET(str); - break; - case O_MSGSND: - value = (double)(do_msgsnd(arglast) >= 0); - goto donumset; - case O_MSGRCV: - value = (double)(do_msgrcv(arglast) >= 0); - goto donumset; - case O_SEMOP: - value = (double)(do_semop(arglast) >= 0); - goto donumset; - case O_SHMREAD: - case O_SHMWRITE: - value = (double)(do_shmio(optype, arglast) >= 0); - goto donumset; -#else /* not SYSVIPC */ - case O_MSGGET: - case O_MSGCTL: - case O_MSGSND: - case O_MSGRCV: - case O_SEMGET: - case O_SEMCTL: - case O_SEMOP: - case O_SHMGET: - case O_SHMCTL: - case O_SHMREAD: - case O_SHMWRITE: - fatal("System V IPC is not implemented on this machine"); -#endif /* not SYSVIPC */ - case O_RENAME: - tmps = str_get(st[1]); - tmps2 = str_get(st[2]); -#ifdef TAINT - TAINT_PROPER("rename"); -#endif -#ifdef HAS_RENAME - value = (double)(rename(tmps,tmps2) >= 0); -#else - if (same_dirent(tmps2, tmps)) /* can always rename to same name */ - anum = 1; - else { - if (euid || stat(tmps2,&statbuf) < 0 || !S_ISDIR(statbuf.st_mode)) - (void)UNLINK(tmps2); - if (!(anum = link(tmps,tmps2))) - anum = UNLINK(tmps); - } - value = (double)(anum >= 0); -#endif - goto donumset; - case O_LINK: -#ifdef HAS_LINK - tmps = str_get(st[1]); - tmps2 = str_get(st[2]); -#ifdef TAINT - TAINT_PROPER("link"); -#endif - value = (double)(link(tmps,tmps2) >= 0); - goto donumset; -#else - fatal("Unsupported function link"); - break; -#endif - case O_MKDIR: - tmps = str_get(st[1]); - anum = (int)str_gnum(st[2]); -#ifdef TAINT - TAINT_PROPER("mkdir"); -#endif -#ifdef HAS_MKDIR - value = (double)(mkdir(tmps,anum) >= 0); - goto donumset; -#else - (void)strcpy(buf,"mkdir "); -#endif -#if !defined(HAS_MKDIR) || !defined(HAS_RMDIR) - one_liner: - for (tmps2 = buf+6; *tmps; ) { - *tmps2++ = '\\'; - *tmps2++ = *tmps++; - } - (void)strcpy(tmps2," 2>&1"); - rsfp = mypopen(buf,"r"); - if (rsfp) { - *buf = '\0'; - tmps2 = fgets(buf,sizeof buf,rsfp); - (void)mypclose(rsfp); - if (tmps2 != Nullch) { - for (errno = 1; errno < sys_nerr; errno++) { - if (instr(buf,sys_errlist[errno])) /* you don't see this */ - goto say_zero; - } - errno = 0; -#ifndef EACCES -#define EACCES EPERM -#endif - if (instr(buf,"cannot make")) - errno = EEXIST; - else if (instr(buf,"existing file")) - errno = EEXIST; - else if (instr(buf,"ile exists")) - errno = EEXIST; - else if (instr(buf,"non-exist")) - errno = ENOENT; - else if (instr(buf,"does not exist")) - errno = ENOENT; - else if (instr(buf,"not empty")) - errno = EBUSY; - else if (instr(buf,"cannot access")) - errno = EACCES; - else - errno = EPERM; - goto say_zero; - } - else { /* some mkdirs return no failure indication */ - tmps = str_get(st[1]); - anum = (stat(tmps,&statbuf) >= 0); - if (optype == O_RMDIR) - anum = !anum; - if (anum) - errno = 0; - else - errno = EACCES; /* a guess */ - value = (double)anum; - } - goto donumset; - } - else - goto say_zero; -#endif - case O_RMDIR: - if (maxarg < 1) - tmps = str_get(stab_val(defstab)); - else - tmps = str_get(st[1]); -#ifdef TAINT - TAINT_PROPER("rmdir"); -#endif -#ifdef HAS_RMDIR - value = (double)(rmdir(tmps) >= 0); - goto donumset; -#else - (void)strcpy(buf,"rmdir "); - goto one_liner; /* see above in HAS_MKDIR */ -#endif - case O_GETPPID: -#ifdef HAS_GETPPID - value = (double)getppid(); - goto donumset; -#else - fatal("Unsupported function getppid"); - break; -#endif - case O_GETPGRP: -#ifdef HAS_GETPGRP - if (maxarg < 1) - anum = 0; - else - anum = (int)str_gnum(st[1]); -#ifdef _POSIX_SOURCE - if (anum != 0) - fatal("POSIX getpgrp can't take an argument"); - value = (double)getpgrp(); -#else - value = (double)getpgrp(anum); -#endif - goto donumset; -#else - fatal("The getpgrp() function is unimplemented on this machine"); - break; -#endif - case O_SETPGRP: -#ifdef HAS_SETPGRP - argtype = (int)str_gnum(st[1]); - anum = (int)str_gnum(st[2]); -#ifdef TAINT - TAINT_PROPER("setpgrp"); -#endif - value = (double)(setpgrp(argtype,anum) >= 0); - goto donumset; -#else - fatal("The setpgrp() function is unimplemented on this machine"); - break; -#endif - case O_GETPRIORITY: -#ifdef HAS_GETPRIORITY - argtype = (int)str_gnum(st[1]); - anum = (int)str_gnum(st[2]); - value = (double)getpriority(argtype,anum); - goto donumset; -#else - fatal("The getpriority() function is unimplemented on this machine"); - break; -#endif - case O_SETPRIORITY: -#ifdef HAS_SETPRIORITY - argtype = (int)str_gnum(st[1]); - anum = (int)str_gnum(st[2]); - optype = (int)str_gnum(st[3]); -#ifdef TAINT - TAINT_PROPER("setpriority"); -#endif - value = (double)(setpriority(argtype,anum,optype) >= 0); - goto donumset; -#else - fatal("The setpriority() function is unimplemented on this machine"); - break; -#endif - case O_CHROOT: -#ifdef HAS_CHROOT - if (maxarg < 1) - tmps = str_get(stab_val(defstab)); - else - tmps = str_get(st[1]); -#ifdef TAINT - TAINT_PROPER("chroot"); -#endif - value = (double)(chroot(tmps) >= 0); - goto donumset; -#else - fatal("Unsupported function chroot"); - break; -#endif - case O_FCNTL: - case O_IOCTL: - if (maxarg <= 0) - stab = last_in_stab; - else if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); - argtype = U_I(str_gnum(st[2])); -#ifdef TAINT - TAINT_PROPER("ioctl"); -#endif - anum = do_ctl(optype,stab,argtype,st[3]); - if (anum == -1) - goto say_undef; - if (anum != 0) { - value = (double)anum; - goto donumset; - } - str_set(str,"0 but true"); - STABSET(str); - break; - case O_FLOCK: -#ifdef HAS_FLOCK - if (maxarg <= 0) - stab = last_in_stab; - else if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); - if (stab && stab_io(stab)) - fp = stab_io(stab)->ifp; - else - fp = Nullfp; - if (fp) { - argtype = (int)str_gnum(st[2]); - value = (double)(flock(fileno(fp),argtype) >= 0); - } - else - value = 0; - goto donumset; -#else - fatal("The flock() function is unimplemented on this machine"); - break; -#endif - case O_UNSHIFT: - ary = stab_array(arg[1].arg_ptr.arg_stab); - if (arglast[2] - arglast[1] != 1) - do_unshift(ary,arglast); - else { - STR *tmpstr = Str_new(52,0); /* must copy the STR */ - str_sset(tmpstr,st[2]); - aunshift(ary,1); - (void)astore(ary,0,tmpstr); - } - value = (double)(ary->ary_fill + 1); - goto donumset; - - case O_TRY: - sp = do_try(arg[1].arg_ptr.arg_cmd, - gimme,arglast); - goto array_return; - - case O_EVALONCE: - sp = do_eval(st[1], O_EVAL, curcmd->c_stash, TRUE, - gimme,arglast); - if (eval_root) { - str_free(arg[1].arg_ptr.arg_str); - arg[1].arg_ptr.arg_cmd = eval_root; - arg[1].arg_type = (A_CMD|A_DONT); - arg[0].arg_type = O_TRY; - } - goto array_return; - - case O_REQUIRE: - case O_DOFILE: - case O_EVAL: - if (maxarg < 1) - tmpstr = stab_val(defstab); - else - tmpstr = - (arg[1].arg_type & A_MASK) != A_NULL ? st[1] : stab_val(defstab); -#ifdef TAINT - tainted |= tmpstr->str_tainted; - TAINT_PROPER("eval"); -#endif - sp = do_eval(tmpstr, optype, curcmd->c_stash, FALSE, - gimme,arglast); - goto array_return; - - case O_FTRREAD: - argtype = 0; - anum = S_IRUSR; - goto check_perm; - case O_FTRWRITE: - argtype = 0; - anum = S_IWUSR; - goto check_perm; - case O_FTREXEC: - argtype = 0; - anum = S_IXUSR; - goto check_perm; - case O_FTEREAD: - argtype = 1; - anum = S_IRUSR; - goto check_perm; - case O_FTEWRITE: - argtype = 1; - anum = S_IWUSR; - goto check_perm; - case O_FTEEXEC: - argtype = 1; - anum = S_IXUSR; - check_perm: - if (mystat(arg,st[1]) < 0) - goto say_undef; - if (cando(anum,argtype,&statcache)) - goto say_yes; - goto say_no; - - case O_FTIS: - if (mystat(arg,st[1]) < 0) - goto say_undef; - goto say_yes; - case O_FTEOWNED: - case O_FTROWNED: - if (mystat(arg,st[1]) < 0) - goto say_undef; - if (statcache.st_uid == (optype == O_FTEOWNED ? euid : uid) ) - goto say_yes; - goto say_no; - case O_FTZERO: - if (mystat(arg,st[1]) < 0) - goto say_undef; - if (!statcache.st_size) - goto say_yes; - goto say_no; - case O_FTSIZE: - if (mystat(arg,st[1]) < 0) - goto say_undef; - value = (double)statcache.st_size; - goto donumset; - - case O_FTMTIME: - if (mystat(arg,st[1]) < 0) - goto say_undef; - value = (double)(basetime - statcache.st_mtime) / 86400.0; - goto donumset; - case O_FTATIME: - if (mystat(arg,st[1]) < 0) - goto say_undef; - value = (double)(basetime - statcache.st_atime) / 86400.0; - goto donumset; - case O_FTCTIME: - if (mystat(arg,st[1]) < 0) - goto say_undef; - value = (double)(basetime - statcache.st_ctime) / 86400.0; - goto donumset; - - case O_FTSOCK: - if (mystat(arg,st[1]) < 0) - goto say_undef; - if (S_ISSOCK(statcache.st_mode)) - goto say_yes; - goto say_no; - case O_FTCHR: - if (mystat(arg,st[1]) < 0) - goto say_undef; - if (S_ISCHR(statcache.st_mode)) - goto say_yes; - goto say_no; - case O_FTBLK: - if (mystat(arg,st[1]) < 0) - goto say_undef; - if (S_ISBLK(statcache.st_mode)) - goto say_yes; - goto say_no; - case O_FTFILE: - if (mystat(arg,st[1]) < 0) - goto say_undef; - if (S_ISREG(statcache.st_mode)) - goto say_yes; - goto say_no; - case O_FTDIR: - if (mystat(arg,st[1]) < 0) - goto say_undef; - if (S_ISDIR(statcache.st_mode)) - goto say_yes; - goto say_no; - case O_FTPIPE: - if (mystat(arg,st[1]) < 0) - goto say_undef; - if (S_ISFIFO(statcache.st_mode)) - goto say_yes; - goto say_no; - case O_FTLINK: - if (mylstat(arg,st[1]) < 0) - goto say_undef; - if (S_ISLNK(statcache.st_mode)) - goto say_yes; - goto say_no; - case O_SYMLINK: -#ifdef HAS_SYMLINK - tmps = str_get(st[1]); - tmps2 = str_get(st[2]); -#ifdef TAINT - TAINT_PROPER("symlink"); -#endif - value = (double)(symlink(tmps,tmps2) >= 0); - goto donumset; -#else - fatal("Unsupported function symlink"); -#endif - case O_READLINK: -#ifdef HAS_SYMLINK - if (maxarg < 1) - tmps = str_get(stab_val(defstab)); - else - tmps = str_get(st[1]); - anum = readlink(tmps,buf,sizeof buf); - if (anum < 0) - goto say_undef; - str_nset(str,buf,anum); - break; -#else - goto say_undef; /* just pretend it's a normal file */ -#endif - case O_FTSUID: -#ifdef S_ISUID - anum = S_ISUID; - goto check_xid; -#else - goto say_no; -#endif - case O_FTSGID: -#ifdef S_ISGID - anum = S_ISGID; - goto check_xid; -#else - goto say_no; -#endif - case O_FTSVTX: -#ifdef S_ISVTX - anum = S_ISVTX; -#else - goto say_no; -#endif - check_xid: - if (mystat(arg,st[1]) < 0) - goto say_undef; - if (statcache.st_mode & anum) - goto say_yes; - goto say_no; - case O_FTTTY: - if (arg[1].arg_type & A_DONT) { - stab = arg[1].arg_ptr.arg_stab; - tmps = ""; - } - else - stab = stabent(tmps = str_get(st[1]),FALSE); - if (stab && stab_io(stab) && stab_io(stab)->ifp) - anum = fileno(stab_io(stab)->ifp); - else if (isDIGIT(*tmps)) - anum = atoi(tmps); - else - goto say_undef; - if (isatty(anum)) - goto say_yes; - goto say_no; - case O_FTTEXT: - case O_FTBINARY: - str = do_fttext(arg,st[1]); - break; -#ifdef HAS_SOCKET - case O_SOCKET: - if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); -#ifndef lint - value = (double)do_socket(stab,arglast); -#else - (void)do_socket(stab,arglast); -#endif - goto donumset; - case O_BIND: - if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); -#ifndef lint - value = (double)do_bind(stab,arglast); -#else - (void)do_bind(stab,arglast); -#endif - goto donumset; - case O_CONNECT: - if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); -#ifndef lint - value = (double)do_connect(stab,arglast); -#else - (void)do_connect(stab,arglast); -#endif - goto donumset; - case O_LISTEN: - if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); -#ifndef lint - value = (double)do_listen(stab,arglast); -#else - (void)do_listen(stab,arglast); -#endif - goto donumset; - case O_ACCEPT: - if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); - if ((arg[2].arg_type & A_MASK) == A_WORD) - stab2 = arg[2].arg_ptr.arg_stab; - else - stab2 = stabent(str_get(st[2]),TRUE); - do_accept(str,stab,stab2); - STABSET(str); - break; - case O_GHBYNAME: - if (maxarg < 1) - goto say_undef; - case O_GHBYADDR: - case O_GHOSTENT: - sp = do_ghent(optype, - gimme,arglast); - goto array_return; - case O_GNBYNAME: - if (maxarg < 1) - goto say_undef; - case O_GNBYADDR: - case O_GNETENT: - sp = do_gnent(optype, - gimme,arglast); - goto array_return; - case O_GPBYNAME: - if (maxarg < 1) - goto say_undef; - case O_GPBYNUMBER: - case O_GPROTOENT: - sp = do_gpent(optype, - gimme,arglast); - goto array_return; - case O_GSBYNAME: - if (maxarg < 1) - goto say_undef; - case O_GSBYPORT: - case O_GSERVENT: - sp = do_gsent(optype, - gimme,arglast); - goto array_return; - case O_SHOSTENT: - value = (double) sethostent((int)str_gnum(st[1])); - goto donumset; - case O_SNETENT: - value = (double) setnetent((int)str_gnum(st[1])); - goto donumset; - case O_SPROTOENT: - value = (double) setprotoent((int)str_gnum(st[1])); - goto donumset; - case O_SSERVENT: - value = (double) setservent((int)str_gnum(st[1])); - goto donumset; - case O_EHOSTENT: - value = (double) endhostent(); - goto donumset; - case O_ENETENT: - value = (double) endnetent(); - goto donumset; - case O_EPROTOENT: - value = (double) endprotoent(); - goto donumset; - case O_ESERVENT: - value = (double) endservent(); - goto donumset; - case O_SOCKPAIR: - if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); - if ((arg[2].arg_type & A_MASK) == A_WORD) - stab2 = arg[2].arg_ptr.arg_stab; - else - stab2 = stabent(str_get(st[2]),TRUE); -#ifndef lint - value = (double)do_spair(stab,stab2,arglast); -#else - (void)do_spair(stab,stab2,arglast); -#endif - goto donumset; - case O_SHUTDOWN: - if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); -#ifndef lint - value = (double)do_shutdown(stab,arglast); -#else - (void)do_shutdown(stab,arglast); -#endif - goto donumset; - case O_GSOCKOPT: - case O_SSOCKOPT: - if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); - sp = do_sopt(optype,stab,arglast); - goto array_return; - case O_GETSOCKNAME: - case O_GETPEERNAME: - if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); - if (!stab) - goto say_undef; - sp = do_getsockname(optype,stab,arglast); - goto array_return; - -#else /* HAS_SOCKET not defined */ - case O_SOCKET: - case O_BIND: - case O_CONNECT: - case O_LISTEN: - case O_ACCEPT: - case O_SOCKPAIR: - case O_GHBYNAME: - case O_GHBYADDR: - case O_GHOSTENT: - case O_GNBYNAME: - case O_GNBYADDR: - case O_GNETENT: - case O_GPBYNAME: - case O_GPBYNUMBER: - case O_GPROTOENT: - case O_GSBYNAME: - case O_GSBYPORT: - case O_GSERVENT: - case O_SHOSTENT: - case O_SNETENT: - case O_SPROTOENT: - case O_SSERVENT: - case O_EHOSTENT: - case O_ENETENT: - case O_EPROTOENT: - case O_ESERVENT: - case O_SHUTDOWN: - case O_GSOCKOPT: - case O_SSOCKOPT: - case O_GETSOCKNAME: - case O_GETPEERNAME: - badsock: - fatal("Unsupported socket function"); -#endif /* HAS_SOCKET */ - case O_SSELECT: -#ifdef HAS_SELECT - sp = do_select(gimme,arglast); - goto array_return; -#else - fatal("select not implemented"); -#endif - case O_FILENO: - if (maxarg < 1) - goto say_undef; - if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); - if (!stab || !(stio = stab_io(stab)) || !(fp = stio->ifp)) - goto say_undef; - value = fileno(fp); - goto donumset; - case O_BINMODE: - if (maxarg < 1) - goto say_undef; - if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); - if (!stab || !(stio = stab_io(stab)) || !(fp = stio->ifp)) - goto say_undef; -#ifdef DOSISH -#ifdef atarist - if(fflush(fp)) - str_set(str, No); - else - { - fp->_flag |= _IOBIN; - str_set(str, Yes); - } -#else - str_set(str, (setmode(fileno(fp), O_BINARY) != -1) ? Yes : No); -#endif -#else - str_set(str, Yes); -#endif - STABSET(str); - break; - case O_VEC: - sp = do_vec(str == st[1], arg->arg_ptr.arg_str, arglast); - goto array_return; - case O_GPWNAM: - case O_GPWUID: - case O_GPWENT: -#ifdef HAS_PASSWD - sp = do_gpwent(optype, - gimme,arglast); - goto array_return; - case O_SPWENT: - value = (double) setpwent(); - goto donumset; - case O_EPWENT: - value = (double) endpwent(); - goto donumset; -#else - case O_EPWENT: - case O_SPWENT: - fatal("Unsupported password function"); - break; -#endif - case O_GGRNAM: - case O_GGRGID: - case O_GGRENT: -#ifdef HAS_GROUP - sp = do_ggrent(optype, - gimme,arglast); - goto array_return; - case O_SGRENT: - value = (double) setgrent(); - goto donumset; - case O_EGRENT: - value = (double) endgrent(); - goto donumset; -#else - case O_EGRENT: - case O_SGRENT: - fatal("Unsupported group function"); - break; -#endif - case O_GETLOGIN: -#ifdef HAS_GETLOGIN - if (!(tmps = getlogin())) - goto say_undef; - str_set(str,tmps); -#else - fatal("Unsupported function getlogin"); -#endif - break; - case O_OPEN_DIR: - case O_READDIR: - case O_TELLDIR: - case O_SEEKDIR: - case O_REWINDDIR: - case O_CLOSEDIR: - if (maxarg < 1) - goto say_undef; - if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); - if (!stab) - goto say_undef; - sp = do_dirop(optype,stab,gimme,arglast); - goto array_return; - case O_SYSCALL: - value = (double)do_syscall(arglast); - goto donumset; - case O_PIPE_OP: -#ifdef HAS_PIPE - if ((arg[1].arg_type & A_MASK) == A_WORD) - stab = arg[1].arg_ptr.arg_stab; - else - stab = stabent(str_get(st[1]),TRUE); - if ((arg[2].arg_type & A_MASK) == A_WORD) - stab2 = arg[2].arg_ptr.arg_stab; - else - stab2 = stabent(str_get(st[2]),TRUE); - do_pipe(str,stab,stab2); - STABSET(str); -#else - fatal("Unsupported function pipe"); -#endif - break; - } - - normal_return: - st[1] = str; -#ifdef DEBUGGING - if (debug) { - dlevel--; - if (debug & 8) - deb("%s RETURNS \"%s\"\n",opname[optype],str_get(str)); - } -#endif - stack_ary = stack->ary_array; - stack_max = stack_ary + stack->ary_max; - stack_sp = stack_ary + arglast[0] + 1; - return arglast[0] + 1; -} diff --git a/ext/DB_File/DB_File.pm b/ext/DB_File/DB_File.pm new file mode 100644 index 0000000..d66ab2c --- /dev/null +++ b/ext/DB_File/DB_File.pm @@ -0,0 +1,248 @@ +# DB_File.pm -- Perl 5 interface to Berkeley DB +# +# written by Paul Marquess (pmarquess@bfsec.bt.co.uk) +# last modified 23rd June 1994 +# version 0.1 + +package DB_File::HASHINFO ; +use Carp; + +sub TIEHASH +{ + bless {} ; +} + +%elements = ( 'bsize' => 0, + 'ffactor' => 0, + 'nelem' => 0, + 'cachesize' => 0, + 'hash' => 0, + 'lorder' => 0 + ) ; + +sub FETCH +{ + return $_[0]{$_[1]} if defined $elements{$_[1]} ; + + croak "DB_File::HASHINFO::FETCH - Unknown element '$_[1]'" ; +} + + +sub STORE +{ + if ( defined $elements{$_[1]} ) + { + $_[0]{$_[1]} = $_[2] ; + return ; + } + + croak "DB_File::HASHINFO::STORE - Unknown element '$_[1]'" ; +} + +sub DELETE +{ + if ( defined $elements{$_[1]} ) + { + delete ${$_[0]}{$_[1]} ; + return ; + } + + croak "DB_File::HASHINFO::DELETE - Unknown element '$_[1]'" ; +} + + +sub DESTROY {undef %{$_[0]} } +sub FIRSTKEY { croak "DB_File::HASHINFO::FIRSTKEY is not implemented" } +sub NEXTKEY { croak "DB_File::HASHINFO::NEXTKEY is not implemented" } +sub EXISTS { croak "DB_File::HASHINFO::EXISTS is not implemented" } +sub CLEAR { croak "DB_File::HASHINFO::CLEAR is not implemented" } + +package DB_File::BTREEINFO ; +use Carp; + +sub TIEHASH +{ + bless {} ; +} + +%elements = ( 'flags' => 0, + 'cachesize' => 0, + 'maxkeypage' => 0, + 'minkeypage' => 0, + 'psize' => 0, + 'compare' => 0, + 'prefix' => 0, + 'lorder' => 0 + ) ; + +sub FETCH +{ + return $_[0]{$_[1]} if defined $elements{$_[1]} ; + + croak "DB_File::BTREEINFO::FETCH - Unknown element '$_[1]'" ; +} + + +sub STORE +{ + if ( defined $elements{$_[1]} ) + { + $_[0]{$_[1]} = $_[2] ; + return ; + } + + croak "DB_File::BTREEINFO::STORE - Unknown element '$_[1]'" ; +} + +sub DELETE +{ + if ( defined $elements{$_[1]} ) + { + delete ${$_[0]}{$_[1]} ; + return ; + } + + croak "DB_File::BTREEINFO::DELETE - Unknown element '$_[1]'" ; +} + + +sub DESTROY {undef %{$_[0]} } +sub FIRSTKEY { croak "DB_File::BTREEINFO::FIRSTKEY is not implemented" } +sub NEXTKEY { croak "DB_File::BTREEINFO::NEXTKEY is not implemented" } +sub EXISTS { croak "DB_File::BTREEINFO::EXISTS is not implemented" } +sub CLEAR { croak "DB_File::BTREEINFO::CLEAR is not implemented" } + +package DB_File::RECNOINFO ; +use Carp; + +sub TIEHASH +{ + bless {} ; +} + +%elements = ( 'bval' => 0, + 'cachesize' => 0, + 'psize' => 0, + 'flags' => 0, + 'lorder' => 0, + 'reclen' => 0, + 'bfname' => 0 + ) ; +sub FETCH +{ + return $_[0]{$_[1]} if defined $elements{$_[1]} ; + + croak "DB_File::RECNOINFO::FETCH - Unknown element '$_[1]'" ; +} + + +sub STORE +{ + if ( defined $elements{$_[1]} ) + { + $_[0]{$_[1]} = $_[2] ; + return ; + } + + croak "DB_File::RECNOINFO::STORE - Unknown element '$_[1]'" ; +} + +sub DELETE +{ + if ( defined $elements{$_[1]} ) + { + delete ${$_[0]}{$_[1]} ; + return ; + } + + croak "DB_File::RECNOINFO::DELETE - Unknown element '$_[1]'" ; +} + + +sub DESTROY {undef %{$_[0]} } +sub FIRSTKEY { croak "DB_File::RECNOINFO::FIRSTKEY is not implemented" } +sub NEXTKEY { croak "DB_File::RECNOINFO::NEXTKEY is not implemented" } +sub EXISTS { croak "DB_File::BTREEINFO::EXISTS is not implemented" } +sub CLEAR { croak "DB_File::BTREEINFO::CLEAR is not implemented" } + + + +package DB_File ; +use Carp; + +#typedef enum { DB_BTREE, DB_HASH, DB_RECNO } DBTYPE; +$DB_BTREE = TIEHASH DB_File::BTREEINFO ; +$DB_HASH = TIEHASH DB_File::HASHINFO ; +$DB_RECNO = TIEHASH DB_File::RECNOINFO ; + +require TieHash; +require Exporter; +require AutoLoader; +require DynaLoader; +@ISA = (TieHash, Exporter, AutoLoader, DynaLoader); +@EXPORT = qw( + $DB_BTREE $DB_HASH $DB_RECNO + BTREEMAGIC + BTREEVERSION + DB_LOCK + DB_SHMEM + DB_TXN + HASHMAGIC + HASHVERSION + MAX_PAGE_NUMBER + MAX_PAGE_OFFSET + MAX_REC_NUMBER + RET_ERROR + RET_SPECIAL + RET_SUCCESS + R_CURSOR + R_DUP + R_FIRST + R_FIXEDLEN + R_IAFTER + R_IBEFORE + R_LAST + R_NEXT + R_NOKEY + R_NOOVERWRITE + R_PREV + R_RECNOSYNC + R_SETCURSOR + R_SNAPSHOT + __R_UNUSED +); + +sub AUTOLOAD { + if (@_ > 1) { + $AutoLoader::AUTOLOAD = $AUTOLOAD; + goto &AutoLoader::AUTOLOAD; + } + local($constname); + ($constname = $AUTOLOAD) =~ s/.*:://; + $val = constant($constname, @_ ? $_[0] : 0); + if ($! != 0) { + if ($! =~ /Invalid/) { + $AutoLoader::AUTOLOAD = $AUTOLOAD; + goto &AutoLoader::AUTOLOAD; + } + else { + ($pack,$file,$line) = caller; + croak "Your vendor has not defined DB macro $constname, used at $file line $line. +"; + } + } + eval "sub $AUTOLOAD { $val }"; + goto &$AUTOLOAD; +} + +@liblist = (); +@liblist = split ' ', $Config::Config{"DB_File_loadlibs"} + if defined $Config::Config{"DB_File_loadlibs"}; + +bootstrap DB_File @liblist; + +# Preloaded methods go here. Autoload methods go after __END__, and are +# processed by the autosplit program. + +1; +__END__ diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs new file mode 100644 index 0000000..c83f976 --- /dev/null +++ b/ext/DB_File/DB_File.xs @@ -0,0 +1,945 @@ +/* + + DB_File.xs -- Perl 5 interface to Berkeley DB + + written by Paul Marquess (pmarquess@bfsec.bt.co.uk) + last modified 23rd June 1994 + version 0.1 + + All comments/suggestions/problems are welcome + +*/ + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#include + +#include + +#ifndef DBXS_HASH_TYPE +#define DBXS_HASH_TYPE u_int32_t +#endif + +#ifndef DBXS_PREFIX_TYPE +#define DBXS_PREFIX_TYPE size_t +#endif + +typedef DB * DB_File; +typedef DBT DBTKEY ; + +union INFO { + HASHINFO hash ; + RECNOINFO recno ; + BTREEINFO btree ; + } ; + +typedef struct { + SV * sub ; + } CallBackInfo ; + + +/* #define TRACE */ + +#define db_DESTROY(db) (db->close)(db) +#define db_DELETE(db, key, flags) (db->del)(db, &key, flags) +#define db_STORE(db, key, value, flags) (db->put)(db, &key, &value, flags) +#define db_FETCH(db, key, flags) (db->get)(db, &key, &value, flags) + +#define db_close(db) (db->close)(db) +#define db_del(db, key, flags) (db->del)(db, &key, flags) +#define db_fd(db) (db->fd)(db) +#define db_put(db, key, value, flags) (db->put)(db, &key, &value, flags) +#define db_get(db, key, value, flags) (db->get)(db, &key, &value, flags) +#define db_seq(db, key, value, flags) (db->seq)(db, &key, &value, flags) +#define db_sync(db, flags) (db->sync)(db, flags) + + +#define OutputValue(arg, name) \ + { if (RETVAL == 0) sv_setpvn(arg, name.data, name.size) ; } + +#define OutputKey(arg, name) \ + { if (RETVAL == 0) \ + { \ + if (db->close != DB_recno_close) \ + sv_setpvn(arg, name.data, name.size); \ + else \ + sv_setiv(arg, (I32)*(I32*)name.data - 1); \ + } \ + } + +/* Internal Global Data */ + +static recno_t Value ; +static int (*DB_recno_close)() = NULL ; + +static CallBackInfo hash_callback = { 0 } ; +static CallBackInfo compare_callback = { 0 } ; +static CallBackInfo prefix_callback = { 0 } ; + + +static int +btree_compare(key1, key2) +const DBT * key1 ; +const DBT * key2 ; +{ + dSP ; + void * data1, * data2 ; + int retval ; + int count ; + + data1 = key1->data ; + data2 = key2->data ; + + /* As newSVpv will assume that the data pointer is a null terminated C + string if the size parameter is 0, make sure that data points to an + empty string if the length is 0 + */ + if (key1->size == 0) + data1 = "" ; + if (key2->size == 0) + data2 = "" ; + + ENTER ; + SAVETMPS; + + PUSHMARK(sp) ; + EXTEND(sp,2) ; + PUSHs(sv_2mortal(newSVpv(data1,key1->size))); + PUSHs(sv_2mortal(newSVpv(data2,key2->size))); + PUTBACK ; + + count = perl_call_sv(compare_callback.sub, G_SCALAR); + + SPAGAIN ; + + if (count != 1) + croak ("DB_File btree_compare: expected 1 return value from %s, got %d\n", count) ; + + retval = POPi ; + + PUTBACK ; + FREETMPS ; + LEAVE ; + return (retval) ; + +} + +static DBXS_PREFIX_TYPE +btree_prefix(key1, key2) +const DBT * key1 ; +const DBT * key2 ; +{ + dSP ; + void * data1, * data2 ; + int retval ; + int count ; + + data1 = key1->data ; + data2 = key2->data ; + + /* As newSVpv will assume that the data pointer is a null terminated C + string if the size parameter is 0, make sure that data points to an + empty string if the length is 0 + */ + if (key1->size == 0) + data1 = "" ; + if (key2->size == 0) + data2 = "" ; + + ENTER ; + SAVETMPS; + + PUSHMARK(sp) ; + EXTEND(sp,2) ; + PUSHs(sv_2mortal(newSVpv(data1,key1->size))); + PUSHs(sv_2mortal(newSVpv(data2,key2->size))); + PUTBACK ; + + count = perl_call_sv(prefix_callback.sub, G_SCALAR); + + SPAGAIN ; + + if (count != 1) + croak ("DB_File btree_prefix: expected 1 return value from %s, got %d\n", count) ; + + retval = POPi ; + + PUTBACK ; + FREETMPS ; + LEAVE ; + + return (retval) ; +} + +static DBXS_HASH_TYPE +hash_cb(data, size) +const void * data ; +size_t size ; +{ + dSP ; + int retval ; + int count ; + + if (size == 0) + data = "" ; + + PUSHMARK(sp) ; + XPUSHs(sv_2mortal(newSVpv((char*)data,size))); + PUTBACK ; + + count = perl_call_sv(hash_callback.sub, G_SCALAR); + + SPAGAIN ; + + if (count != 1) + croak ("DB_File hash_cb: expected 1 return value from %s, got %d\n", count) ; + + retval = POPi ; + + PUTBACK ; + FREETMPS ; + LEAVE ; + + return (retval) ; +} + + +#ifdef TRACE + +static void +PrintHash(hash) +HASHINFO hash ; +{ + printf ("HASH Info\n") ; + printf (" hash = %s\n", (hash.hash != NULL ? "redefined" : "default")) ; + printf (" bsize = %d\n", hash.bsize) ; + printf (" ffactor = %d\n", hash.ffactor) ; + printf (" nelem = %d\n", hash.nelem) ; + printf (" cachesize = %d\n", hash.cachesize) ; + printf (" lorder = %d\n", hash.lorder) ; + +} + +static void +PrintRecno(recno) +RECNOINFO recno ; +{ + printf ("RECNO Info\n") ; + printf (" flags = %d\n", recno.flags) ; + printf (" cachesize = %d\n", recno.cachesize) ; + printf (" psize = %d\n", recno.psize) ; + printf (" lorder = %d\n", recno.lorder) ; + printf (" reclen = %d\n", recno.reclen) ; + printf (" bval = %d\n", recno.bval) ; + printf (" bfname = %s\n", recno.bfname) ; +} + +PrintBtree(btree) +BTREEINFO btree ; +{ + printf ("BTREE Info\n") ; + printf (" compare = %s\n", (btree.compare ? "redefined" : "default")) ; + printf (" prefix = %s\n", (btree.prefix ? "redefined" : "default")) ; + printf (" flags = %d\n", btree.flags) ; + printf (" cachesize = %d\n", btree.cachesize) ; + printf (" psize = %d\n", btree.psize) ; + printf (" maxkeypage = %d\n", btree.maxkeypage) ; + printf (" minkeypage = %d\n", btree.minkeypage) ; + printf (" lorder = %d\n", btree.lorder) ; +} + +#else + +#define PrintRecno(recno) +#define PrintHash(hash) +#define PrintBtree(btree) + +#endif /* TRACE */ + + +static I32 +GetArrayLength(db) +DB_File db ; +{ + DBT key ; + DBT value ; + int RETVAL ; + + RETVAL = (db->seq)(db, &key, &value, R_LAST) ; + if (RETVAL == 0) + RETVAL = *(I32 *)key.data ; + else if (RETVAL == 1) /* No key means empty file */ + RETVAL = 0 ; + + return (RETVAL) ; +} + +static DB_File +ParseOpenInfo(name, flags, mode, sv, string) +char * name ; +int flags ; +int mode ; +SV * sv ; +char * string ; +{ + SV ** svp; + HV * action ; + union INFO info ; + DB_File RETVAL ; + void * openinfo = NULL ; + DBTYPE type = DB_HASH ; + + + if (sv) + { + if (! SvROK(sv) ) + croak ("type parameter is not a reference") ; + + action = (HV*)SvRV(sv); + if (sv_isa(sv, "DB_File::HASHINFO")) + { + type = DB_HASH ; + openinfo = (void*)&info ; + + svp = hv_fetch(action, "hash", 4, FALSE); + + if (svp && SvOK(*svp)) + { + info.hash.hash = hash_cb ; + hash_callback.sub = *svp ; + } + else + info.hash.hash = NULL ; + + svp = hv_fetch(action, "bsize", 5, FALSE); + info.hash.bsize = svp ? SvIV(*svp) : 0; + + svp = hv_fetch(action, "ffactor", 7, FALSE); + info.hash.ffactor = svp ? SvIV(*svp) : 0; + + svp = hv_fetch(action, "nelem", 5, FALSE); + info.hash.nelem = svp ? SvIV(*svp) : 0; + + svp = hv_fetch(action, "cachesize", 9, FALSE); + info.hash.cachesize = svp ? SvIV(*svp) : 0; + + svp = hv_fetch(action, "lorder", 6, FALSE); + info.hash.lorder = svp ? SvIV(*svp) : 0; + + PrintHash(info) ; + } + else if (sv_isa(sv, "DB_File::BTREEINFO")) + { + type = DB_BTREE ; + openinfo = (void*)&info ; + + svp = hv_fetch(action, "compare", 7, FALSE); + if (svp && SvOK(*svp)) + { + info.btree.compare = btree_compare ; + compare_callback.sub = *svp ; + } + else + info.btree.compare = NULL ; + + svp = hv_fetch(action, "prefix", 6, FALSE); + if (svp && SvOK(*svp)) + { + info.btree.prefix = btree_prefix ; + prefix_callback.sub = *svp ; + } + else + info.btree.prefix = NULL ; + + svp = hv_fetch(action, "flags", 5, FALSE); + info.btree.flags = svp ? SvIV(*svp) : 0; + + svp = hv_fetch(action, "cachesize", 9, FALSE); + info.btree.cachesize = svp ? SvIV(*svp) : 0; + + svp = hv_fetch(action, "minkeypage", 10, FALSE); + info.btree.minkeypage = svp ? SvIV(*svp) : 0; + + svp = hv_fetch(action, "maxkeypage", 10, FALSE); + info.btree.maxkeypage = svp ? SvIV(*svp) : 0; + + svp = hv_fetch(action, "psize", 5, FALSE); + info.btree.psize = svp ? SvIV(*svp) : 0; + + svp = hv_fetch(action, "lorder", 6, FALSE); + info.btree.lorder = svp ? SvIV(*svp) : 0; + + PrintBtree(info) ; + + } + else if (sv_isa(sv, "DB_File::RECNOINFO")) + { + type = DB_RECNO ; + openinfo = (void *)&info ; + + svp = hv_fetch(action, "flags", 5, FALSE); + info.recno.flags = (u_long) svp ? SvIV(*svp) : 0; + + svp = hv_fetch(action, "cachesize", 9, FALSE); + info.recno.cachesize = (u_int) svp ? SvIV(*svp) : 0; + + svp = hv_fetch(action, "psize", 5, FALSE); + info.recno.psize = (int) svp ? SvIV(*svp) : 0; + + svp = hv_fetch(action, "lorder", 6, FALSE); + info.recno.lorder = (int) svp ? SvIV(*svp) : 0; + + svp = hv_fetch(action, "reclen", 6, FALSE); + info.recno.reclen = (size_t) svp ? SvIV(*svp) : 0; + + svp = hv_fetch(action, "bval", 4, FALSE); + if (svp && SvOK(*svp)) + { + if (SvPOK(*svp)) + info.recno.bval = (u_char)*SvPV(*svp, na) ; + else + info.recno.bval = (u_char)(unsigned long) SvIV(*svp) ; + } + else + { + if (info.recno.flags & R_FIXEDLEN) + info.recno.bval = (u_char) ' ' ; + else + info.recno.bval = (u_char) '\n' ; + } + + svp = hv_fetch(action, "bfname", 6, FALSE); + info.recno.bfname = (char *) svp ? SvPV(*svp,na) : 0; + + PrintRecno(info) ; + } + else + croak("type is not of type DB_File::HASHINFO, DB_File::BTREEINFO or DB_File::RECNOINFO"); + } + + + RETVAL = dbopen(name, flags, mode, type, openinfo) ; + + if (RETVAL == 0) + croak("DB_File::%s failed, reason: %s", string, Strerror(errno)) ; + + /* kludge mode on: RETVAL->type for DB_RECNO is set to DB_BTREE + so remember a DB_RECNO by saving the address + of one of it's internal routines + */ + if (type == DB_RECNO) + DB_recno_close = RETVAL->close ; + + + return (RETVAL) ; +} + + +static int +not_here(s) +char *s; +{ + croak("DB_File::%s not implemented on this architecture", s); + return -1; +} + +static double +constant(name, arg) +char *name; +int arg; +{ + errno = 0; + switch (*name) { + case 'A': + break; + case 'B': + if (strEQ(name, "BTREEMAGIC")) +#ifdef BTREEMAGIC + return BTREEMAGIC; +#else + goto not_there; +#endif + if (strEQ(name, "BTREEVERSION")) +#ifdef BTREEVERSION + return BTREEVERSION; +#else + goto not_there; +#endif + break; + case 'C': + break; + case 'D': + if (strEQ(name, "DB_LOCK")) +#ifdef DB_LOCK + return DB_LOCK; +#else + goto not_there; +#endif + if (strEQ(name, "DB_SHMEM")) +#ifdef DB_SHMEM + return DB_SHMEM; +#else + goto not_there; +#endif + if (strEQ(name, "DB_TXN")) +#ifdef DB_TXN + return (U32)DB_TXN; +#else + goto not_there; +#endif + break; + case 'E': + break; + case 'F': + break; + case 'G': + break; + case 'H': + if (strEQ(name, "HASHMAGIC")) +#ifdef HASHMAGIC + return HASHMAGIC; +#else + goto not_there; +#endif + if (strEQ(name, "HASHVERSION")) +#ifdef HASHVERSION + return HASHVERSION; +#else + goto not_there; +#endif + break; + case 'I': + break; + case 'J': + break; + case 'K': + break; + case 'L': + break; + case 'M': + if (strEQ(name, "MAX_PAGE_NUMBER")) +#ifdef MAX_PAGE_NUMBER + return (U32)MAX_PAGE_NUMBER; +#else + goto not_there; +#endif + if (strEQ(name, "MAX_PAGE_OFFSET")) +#ifdef MAX_PAGE_OFFSET + return MAX_PAGE_OFFSET; +#else + goto not_there; +#endif + if (strEQ(name, "MAX_REC_NUMBER")) +#ifdef MAX_REC_NUMBER + return (U32)MAX_REC_NUMBER; +#else + goto not_there; +#endif + break; + case 'N': + break; + case 'O': + break; + case 'P': + break; + case 'Q': + break; + case 'R': + if (strEQ(name, "RET_ERROR")) +#ifdef RET_ERROR + return RET_ERROR; +#else + goto not_there; +#endif + if (strEQ(name, "RET_SPECIAL")) +#ifdef RET_SPECIAL + return RET_SPECIAL; +#else + goto not_there; +#endif + if (strEQ(name, "RET_SUCCESS")) +#ifdef RET_SUCCESS + return RET_SUCCESS; +#else + goto not_there; +#endif + if (strEQ(name, "R_CURSOR")) +#ifdef R_CURSOR + return R_CURSOR; +#else + goto not_there; +#endif + if (strEQ(name, "R_DUP")) +#ifdef R_DUP + return R_DUP; +#else + goto not_there; +#endif + if (strEQ(name, "R_FIRST")) +#ifdef R_FIRST + return R_FIRST; +#else + goto not_there; +#endif + if (strEQ(name, "R_FIXEDLEN")) +#ifdef R_FIXEDLEN + return R_FIXEDLEN; +#else + goto not_there; +#endif + if (strEQ(name, "R_IAFTER")) +#ifdef R_IAFTER + return R_IAFTER; +#else + goto not_there; +#endif + if (strEQ(name, "R_IBEFORE")) +#ifdef R_IBEFORE + return R_IBEFORE; +#else + goto not_there; +#endif + if (strEQ(name, "R_LAST")) +#ifdef R_LAST + return R_LAST; +#else + goto not_there; +#endif + if (strEQ(name, "R_NEXT")) +#ifdef R_NEXT + return R_NEXT; +#else + goto not_there; +#endif + if (strEQ(name, "R_NOKEY")) +#ifdef R_NOKEY + return R_NOKEY; +#else + goto not_there; +#endif + if (strEQ(name, "R_NOOVERWRITE")) +#ifdef R_NOOVERWRITE + return R_NOOVERWRITE; +#else + goto not_there; +#endif + if (strEQ(name, "R_PREV")) +#ifdef R_PREV + return R_PREV; +#else + goto not_there; +#endif + if (strEQ(name, "R_RECNOSYNC")) +#ifdef R_RECNOSYNC + return R_RECNOSYNC; +#else + goto not_there; +#endif + if (strEQ(name, "R_SETCURSOR")) +#ifdef R_SETCURSOR + return R_SETCURSOR; +#else + goto not_there; +#endif + if (strEQ(name, "R_SNAPSHOT")) +#ifdef R_SNAPSHOT + return R_SNAPSHOT; +#else + goto not_there; +#endif + break; + case 'S': + break; + case 'T': + break; + case 'U': + break; + case 'V': + break; + case 'W': + break; + case 'X': + break; + case 'Y': + break; + case 'Z': + break; + case '_': + if (strEQ(name, "__R_UNUSED")) +#ifdef __R_UNUSED + return __R_UNUSED; +#else + goto not_there; +#endif + break; + } + errno = EINVAL; + return 0; + +not_there: + errno = ENOENT; + return 0; +} + +MODULE = DB_File PACKAGE = DB_File PREFIX = db_ + +double +constant(name,arg) + char * name + int arg + + +DB_File +db_TIEHASH(dbtype, name=undef, flags=O_RDWR, mode=0640, type=DB_HASH) + char * dbtype + int flags + int mode + CODE: + { + char * name = (char *) NULL ; + SV * sv = (SV *) NULL ; + + if (items >= 2 && SvOK(ST(1))) + name = (char*) SvPV(ST(1), na) ; + + if (items == 5) + sv = ST(4) ; + + RETVAL = ParseOpenInfo(name, flags, mode, sv, "new") ; + } + OUTPUT: + RETVAL + +BOOT: + newXS("DB_File::TIEARRAY", XS_DB_File_db_TIEHASH, file); + +int +db_DESTROY(db) + DB_File db + + +int +db_DELETE(db, key, flags=0) + DB_File db + DBTKEY key + u_int flags + +int +db_FETCH(db, key, flags=0) + DB_File db + DBTKEY key + u_int flags + CODE: + { + DBT value ; + + RETVAL = (db->get)(db, &key, &value, flags) ; + ST(0) = sv_newmortal(); + if (RETVAL == 0) + sv_setpvn(ST(0), value.data, value.size); + } + +int +db_STORE(db, key, value, flags=0) + DB_File db + DBTKEY key + DBT value + u_int flags + + +int +db_FIRSTKEY(db) + DB_File db + CODE: + { + DBTKEY key ; + DBT value ; + + RETVAL = (db->seq)(db, &key, &value, R_FIRST) ; + ST(0) = sv_newmortal(); + if (RETVAL == 0) + { + if (db->type != DB_RECNO) + sv_setpvn(ST(0), key.data, key.size); + else + sv_setiv(ST(0), (I32)*(I32*)key.data - 1); + } + } + +int +db_NEXTKEY(db, key) + DB_File db + DBTKEY key + CODE: + { + DBT value ; + + RETVAL = (db->seq)(db, &key, &value, R_NEXT) ; + ST(0) = sv_newmortal(); + if (RETVAL == 0) + { + if (db->type != DB_RECNO) + sv_setpvn(ST(0), key.data, key.size); + else + sv_setiv(ST(0), (I32)*(I32*)key.data - 1); + } + } + +# +# These would be nice for RECNO +# + +int +unshift(db, ...) + DB_File db + CODE: + { + DBTKEY key ; + DBT value ; + int i ; + int One ; + + RETVAL = -1 ; + for (i = items-1 ; i > 0 ; --i) + { + value.data = SvPV(ST(i), na) ; + value.size = na ; + One = 1 ; + key.data = &One ; + key.size = sizeof(int) ; + RETVAL = (db->put)(db, &key, &value, R_IBEFORE) ; + if (RETVAL != 0) + break; + } + } + OUTPUT: + RETVAL + +I32 +pop(db) + DB_File db + CODE: + { + DBTKEY key ; + DBT value ; + + /* First get the final value */ + RETVAL = (db->seq)(db, &key, &value, R_LAST) ; + ST(0) = sv_newmortal(); + /* Now delete it */ + if (RETVAL == 0) + { + RETVAL = (db->del)(db, &key, R_CURSOR) ; + if (RETVAL == 0) + sv_setpvn(ST(0), value.data, value.size); + } + } + +I32 +shift(db) + DB_File db + CODE: + { + DBTKEY key ; + DBT value ; + + /* get the first value */ + RETVAL = (db->seq)(db, &key, &value, R_FIRST) ; + ST(0) = sv_newmortal(); + /* Now delete it */ + if (RETVAL == 0) + { + RETVAL = (db->del)(db, &key, R_CURSOR) ; + if (RETVAL == 0) + sv_setpvn(ST(0), value.data, value.size); + } + } + + +I32 +push(db, ...) + DB_File db + CODE: + { + DBTKEY key ; + DBT value ; + int i ; + + /* Set the Cursor to the Last element */ + RETVAL = (db->seq)(db, &key, &value, R_LAST) ; + if (RETVAL == 0) + { + /* for (i = 1 ; i < items ; ++i) */ + for (i = items - 1 ; i > 0 ; --i) + { + value.data = SvPV(ST(i), na) ; + value.size = na ; + RETVAL = (db->put)(db, &key, &value, R_IAFTER) ; + if (RETVAL != 0) + break; + } + } + } + OUTPUT: + RETVAL + + +I32 +length(db) + DB_File db + CODE: + RETVAL = GetArrayLength(db) ; + OUTPUT: + RETVAL + + +# +# Now provide an interface to the rest of the DB functionality +# + +int +db_del(db, key, flags=0) + DB_File db + DBTKEY key + u_int flags + + +int +db_get(db, key, value, flags=0) + DB_File db + DBTKEY key + DBT value + u_int flags + OUTPUT: + value + +int +db_put(db, key, value, flags=0) + DB_File db + DBTKEY key + DBT value + u_int flags + OUTPUT: + key if (flags & (R_IAFTER|R_IBEFORE)) OutputKey(ST(1), key); + +int +db_fd(db) + DB_File db + +int +db_sync(db, flags=0) + DB_File db + u_int flags + + +int +db_seq(db, key, value, flags) + DB_File db + DBTKEY key + DBT value + u_int flags + OUTPUT: + key + value diff --git a/ext/DB_File/DB_File_BS b/ext/DB_File/DB_File_BS new file mode 100644 index 0000000..9282c49 --- /dev/null +++ b/ext/DB_File/DB_File_BS @@ -0,0 +1,6 @@ +# NeXT needs /usr/lib/libposix.a to load along with DB_File.so +if ( $dlsrc eq "dl_next.xs" ) { + @DynaLoader::dl_resolve_using = ( '/usr/lib/libposix.a' ); +} + +1; diff --git a/ext/DB_File/Makefile.SH b/ext/DB_File/Makefile.SH new file mode 100644 index 0000000..7422b00 --- /dev/null +++ b/ext/DB_File/Makefile.SH @@ -0,0 +1,207 @@ +: This forces SH files to create target in same directory as SH file. +: This is so that make depend always knows where to find SH derivatives. + +case "$0" in +*/*) cd `expr X$0 : 'X\(.*\)/'` ;; +esac + +if test -f config.sh; then TOP=.; +elif test -f ../config.sh; then TOP=..; +elif test -f ../../config.sh; then TOP=../..; +elif test -f ../../../config.sh; then TOP=../../..; +elif test -f ../../../../config.sh; then TOP=../../../..; +else + echo "Can't find config.sh."; exit 1 +fi + +: Find absolute path name for TOP. This is needed when we cd to TOP +: to run perl on autosplit. +oldpwd=`pwd`; cd $TOP; ABSTOP=`pwd`; cd $oldpwd + +case $CONFIG in +'') + . $TOP/config.sh + ;; +esac + +: Find out directory name. This is also the extension name. +ext=`pwd | $sed -e 's@.*/@@'` + +: This extension might have its own typemap +if test -f typemap; then + exttypemap='typemap' +else + exttypemap='' +fi + +: This extension might need additional libraries. +potential_libs="-ldb " +. $TOP/ext/util/extliblist + +: This extension might need bootstrap support +if test -f ${ext}_BS; then + bootdep=${ext}_BS +else + bootdep='' +fi + +case "$dlsrc" in +dl_aix*) + echo "#!" > $ext.exp + echo "boot_$ext" >> $ext.exp + ;; +esac + +echo "Extracting ext/$ext/Makefile (with variable substitutions)" +: This section of the file will have variable substitutions done on it. +: Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!. +: Protect any dollar signs and backticks that you do not want interpreted +: by putting a backslash in front. You may delete these comments. +$spitshell >Makefile << !GROK!THIS! +# +# This Makefile is for the $ext extension to perl. +# +CC = $cc +RANLIB = $ranlib +TOP = $TOP +ABSTOP = $ABSTOP +LDFLAGS = $ldflags +CLDFLAGS = $ldflags +SMALL = $small +LARGE = $large $split + +# To use an alternate make, set \$altmake in config.sh. +MAKE = ${altmake-make} + +EXT = $ext + +# $ext might have its own typemap +EXTTYPEMAP = $exttypemap + +# $ext might have its own bootstrap support +BOOTDEP = $bootdep +BOOTSTRAP = $ext.bs + +# The following are used to build and install shared libraries for +# dynamic loading. +LDDLFLAGS = $lddlflags +CCDLFLAGS = $ccdlflags +CCCDLFLAGS = $cccdlflags +SO = $so +DLEXT = $dlext + +# $ext might need to be linked with some extra libraries. +# EXTRALIBS = full list of libraries needed for static linking. +# Only those libraries that actually exist are included. +# DYNLOADLIBS = list of those libraries that are needed but can be +# linked in dynamically on this platform. On SunOS, for +# example, this would be .so* libraries, but not archive +# libraries. The bootstrap file is installed only if +# this list is not empty. +# STATLOADLIBS = list of those libraries which must be statically +# linked into the shared library. On SunOS 4.1.3, +# for example, I have only an archive version of +# -lm, and it must be linked in statically. +EXTRALIBS = $extralibs +DYNALOADLIBS = $dynaloadlibs +STATLOADLIBS = $statloadlibs + +!GROK!THIS! + +$spitshell >>Makefile <<'!NO!SUBS!' + +# Where to put things: +AUTO = $(TOP)/lib/auto +INSTALLBOOT = $(AUTO)/$(EXT)/$(EXT).bs +INSTALLDYNAMIC = $(AUTO)/$(EXT)/$(EXT).$(DLEXT) +INSTALLSTATIC = $(EXT).a +INSTALLPM = $(TOP)/lib/$(EXT).pm + +PERL = $(ABSTOP)/miniperl +XSUBPP = $(TOP)/ext/xsubpp +SHELL = /bin/sh +CCCMD = `sh $(shellflags) $(TOP)/cflags $@` + +.c.o: + $(CCCMD) $(CCCDLFLAGS) -I$(TOP) $*.c + +all: dynamic +# Phony target to force checking subdirectories. +FORCE: + +config: + +# Target for Dynamic Loading: +dynamic: $(INSTALLDYNAMIC) $(INSTALLPM) $(INSTALLBOOT) + +$(INSTALLDYNAMIC): $(EXT).o + @test -d $(AUTO) || mkdir $(AUTO) + @test -d $(AUTO)/$(EXT) || mkdir $(AUTO)/$(EXT) + ld $(LDDLFLAGS) -o $@ $(EXT).o $(STATLOADLIBS) + +$(BOOTSTRAP): Makefile $(BOOTDEP) + $(PERL) -I$(TOP)/lib $(TOP)/ext/util/mkbootstrap $(DYNALOADLIBS) + touch $(BOOTSTRAP) + +$(INSTALLBOOT): $(BOOTSTRAP) + @test ! -s $(BOOTSTRAP) || cp $(BOOTSTRAP) $@ + +# Target for Static Loading: +static: $(INSTALLSTATIC) $(INSTALLPM) + +$(INSTALLSTATIC): $(EXT).o + ar cr $@ $(EXT).o + $(RANLIB) $@ + echo $(EXTRALIBS) >> $(TOP)/ext.libs + +$(EXT).c: $(EXT).xs $(XSUBPP) $(TOP)/ext/typemap $(EXTTYPEMAP) $(TOP)/cflags Makefile + $(PERL) $(XSUBPP) $(EXT).xs >tmp + mv tmp $@ + +$(INSTALLPM): $(EXT).pm + rm -f $@ + cp $(EXT).pm $@ + cd $(TOP); $(PERL) autosplit $(EXT) + +clean: + rm -f *.o *.a mon.out core $(EXT).c so_locations $(BOOTSTRAP) $(EXT).exp + +realclean: clean + rm -f makefile Makefile + rm -f $(INSTALLPM) $(INSTALLDYNAMIC) $(INSTALLSTATIC) $(INSTALLBOOT) + rm -rf $(AUTO)/$(EXT) + +purge: realclean + +$(EXT).o : $(TOP)/EXTERN.h +$(EXT).o : $(TOP)/perl.h +$(EXT).o : $(TOP)/embed.h +$(EXT).o : $(TOP)/config.h +$(EXT).o : $(TOP)/unixish.h +$(EXT).o : $(TOP)/handy.h +$(EXT).o : $(TOP)/regexp.h +$(EXT).o : $(TOP)/sv.h +$(EXT).o : $(TOP)/util.h +$(EXT).o : $(TOP)/form.h +$(EXT).o : $(TOP)/gv.h +$(EXT).o : $(TOP)/cv.h +$(EXT).o : $(TOP)/opcode.h +$(EXT).o : $(TOP)/op.h +$(EXT).o : $(TOP)/cop.h +$(EXT).o : $(TOP)/av.h +$(EXT).o : $(TOP)/hv.h +$(EXT).o : $(TOP)/mg.h +$(EXT).o : $(TOP)/scope.h +$(EXT).o : $(TOP)/pp.h +$(EXT).o : $(TOP)/proto.h +$(EXT).o : $(TOP)/XSUB.h + +Makefile: Makefile.SH $(TOP)/config.sh ; /bin/sh Makefile.SH +$(TOP)/config.h: $(TOP)/config.sh; cd $(TOP); /bin/sh config_h.SH +$(TOP)/embed.h: $(TOP)/config.sh; cd $(TOP); /bin/sh embed_h.SH +$(TOP)/cflags: $(TOP)/config.sh; cd $(TOP); /bin/sh cflags.SH + +!NO!SUBS! +chmod 644 Makefile +$eunicefix Makefile + diff --git a/ext/DB_File/typemap b/ext/DB_File/typemap new file mode 100644 index 0000000..242fa04 --- /dev/null +++ b/ext/DB_File/typemap @@ -0,0 +1,39 @@ +# typemap for Perl 5 interface to Berkeley DB +# +# written by Paul Marquess (pmarquess@bfsec.bt.co.uk) +# last modified 23rd June 1994 +# version 0.1 +# +#################################### DB SECTION +# +# + +u_int T_U_INT +DB_File T_PTROBJ +DBT T_dbtdatum +DBTKEY T_dbtkeydatum + +INPUT +T_dbtkeydatum + if (db->close != DB_recno_close) + { + $var.data = SvPV($arg, na); + $var.size = (int)na; + } + else + { + Value = SvIV($arg) ; + ++ Value ; + $var.data = & Value; + $var.size = (int)sizeof(recno_t); + } +T_dbtdatum + $var.data = SvPV($arg, na); + $var.size = (int)na; + +OUTPUT + +T_dbtkeydatum + OutputKey($arg, $var) +T_dbtdatum + OutputValue($arg, $var) diff --git a/ext/DynaLoader/DynaLoader.doc b/ext/DynaLoader/DynaLoader.doc new file mode 100644 index 0000000..85d606f --- /dev/null +++ b/ext/DynaLoader/DynaLoader.doc @@ -0,0 +1,257 @@ +======================================================================= +Specification for the Generic Dynamic Linking 'DynaLoader' Module + +This specification defines a standard generic interface to the dynamic +linking mechanisms available on many platforms. Its primary purpose is +to implement automatic dynamic loading of perl modules. + +The DynaLoader is designed to be a very simple high-level +interface that is sufficiently general to cover the requirements +of SunOS, HP-UX, NeXT, Linux, VMS and other platforms. + +It is also hoped that the interface will cover the needs of OS/2, +NT etc and allow pseudo-dynamic linking (using ld -A at runtime). + +This document serves as both a specification for anyone wishing to +implement the DynaLoader for a new platform and as a guide for +anyone wishing to use the DynaLoader directly in an application. + +It must be stressed that the DynaLoader, by itself, is practically +useless for accessing non-perl libraries because it provides almost no +perl-to-C 'glue'. There is, for example, no mechanism for calling a C +library function or supplying arguments. It is anticipated that any +glue that may be developed in the future will be implemented in a +seperate dynamically loaded module. + +This interface is based on the work and comments of (in no particular +order): Larry Wall, Robert Sanders, Dean Roehrich, Jeff Okamoto, Anno +Siegel, Thomas Neumann, Paul Marquess, Charles Bailey and others. + +Larry Wall designed the elegant inherited bootstrap mechanism and +implemented the first perl 5 dynamic loader using it. + +Tim Bunce +11th August 1994 + +---------------------------------------------------------------------- +DynaLoader Interface Summary + + @dl_library_path + @dl_resolve_using + @dl_require_symbols + $dl_debug + Implemented in: + bootstrap($modulename) Perl + @filepaths = dl_findfile(@names) Perl + + $libref = dl_load_file($filename) C + $symref = dl_find_symbol($libref, $symbol) C + @symbols = dl_undef_symbols() C + dl_install_xsub($name, $symref [, $filename]) C + $message = dl_error C + + +---------------------------------------------------------------------- +@dl_library_path + +The standard/default list of directories in which dl_findfile() will +search for libraries etc. Directories are searched in order: +$dl_library_path[0], [1], ... etc + +@dl_library_path is initialised to hold the list of 'normal' directories +(/usr/lib etc) determined by Configure ($Config{'libpth'}). This should +ensure portability across a wide range of platforms. + +@dl_library_path should also be initialised with any other directories +that can be determined from the environment at runtime (such as +LD_LIBRARY_PATH for SunOS). + +After initialisation @dl_library_path can be manipulated by an +application using push and unshift before calling dl_findfile(). +Unshift can be used to add directories to the front of the search order +either to save search time or to override libraries with the same name +in the 'normal' directories. + +The load function that dl_load_file() calls may require an absolute +pathname. The dl_findfile() function and @dl_library_path can be +used to search for and return the absolute pathname for the +library/object that you wish to load. + + +---------------------------------------------------------------------- +@dl_resolve_using + +A list of additional libraries or other shared objects which can be +used to resolve any undefined symbols that might be generated by a +later call to load_file(). + +This is only required on some platforms which do not handle dependent +libraries automatically. For example the Socket perl extension library +(auto/Socket/Socket.so) contains references to many socket functions +which need to be resolved when it's loaded. Most platforms will +automatically know where to find the 'dependent' library (e.g., +/usr/lib/libsocket.so). A few platforms need to to be told the location +of the dependent library explicitly. Use @dl_resolve_using for this. + +Example usage: @dl_resolve_using = dl_findfile('-lsocket'); + + +---------------------------------------------------------------------- +@dl_require_symbols + +A list of one or more symbol names that are in the library/object file +to be dynamically loaded. This is only required on some platforms. + + +---------------------------------------------------------------------- +$message = dl_error + +Error message text from the last failed DynaLoader function. Note +that, similar to errno in unix, a successful function call does not +reset this message. + +Implementations should detect the error as soon as it occurs in any of +the other functions and save the corresponding message for later +retrieval. This will avoid problems on some platforms (such as SunOS) +where the error message is very temporary (e.g., dlerror()). + + +---------------------------------------------------------------------- +$dl_debug + +Internal debugging messages are enabled when $dl_debug is set true. +Currently setting $dl_debug only affects the perl side of the +DynaLoader. These messages should help an application developer to +resolve any DynaLoader usage problems. + +$dl_debug is set to $ENV{'PERL_DL_DEBUG'} if defined. + +For the DynaLoader developer/porter there is a similar debugging +variable added to the C code (see dlutils.c) and enabled if perl is +compiled with the -DDEBUGGING flag. This can also be set via the +PERL_DL_DEBUG environment variable. Set to 1 for minimal information or +higher for more. + + +---------------------------------------------------------------------- +@filepaths = dl_findfile(@names) + +Determine the full paths (including file suffix) of one or more +loadable files given their generic names and optionally one or more +directories. Searches directories in @dl_library_path by default and +returns an empty list if no files were found. + +Names can be specified in a variety of platform independent forms. Any +names in the form '-lname' are converted into 'libname.*', where .* is +an appropriate suffix for the platform. + +If a name does not already have a suitable prefix and/or suffix then +the corresponding file will be searched for by trying combinations of +prefix and suffix appropriate to the platform: "$name.o", "lib$name.*" +and "$name". + +If any directories are included in @names they are searched before +@dl_library_path. Directories may be specified as -Ldir. Any other names +are treated as filenames to be searched for. + +Using arguments of the form -Ldir and -lname is recommended. + +Example: @dl_resolve_using = dl_findfile(qw(-L/usr/5lib -lposix)); + + +---------------------------------------------------------------------- +$filepath = dl_expandspec($spec) + +Some unusual systems, such as VMS, require special filename handling in +order to deal with symbolic names for files (i.e., VMS's Logical Names). + +To support these systems a dl_expandspec function can be implemented +either in the dl_*.xs file or code can be added to the autoloadable +dl_expandspec function in DynaLoader.pm. See DynaLoader.pm for more +information. + + + +---------------------------------------------------------------------- +$libref = dl_load_file($filename) + +Dynamically load $filename, which must be the path to a shared object +or library. An opaque 'library reference' is returned as a handle for +the loaded object. Returns undef on error. + +(On systems that provide a handle for the loaded object such as SunOS +and HPUX, $libref will be that handle. On other systems $libref will +typically be $filename or a pointer to a buffer containing $filename. +The application should not examine or alter $libref in any way.) + +This is function that does the real work. It should use the current +values of @dl_require_symbols and @dl_resolve_using if required. + +SunOS: dlopen($filename) +HP-UX: shl_load($filename) +Linux: dld_create_reference(@dl_require_symbols); dld_link($filename) +NeXT: rld_load($filename, @dl_resolve_using) +VMS: lib$find_image_symbol($filename,$dl_require_symbols[0]) + + +---------------------------------------------------------------------- +$symref = dl_find_symbol($libref, $symbol) + +Return the address of the symbol $symbol or undef if not found. If the +target system has separate functions to search for symbols of different +types then dl_find_symbol should search for function symbols first and +then other types. + +The exact manner in which the address is returned in $symref is not +currently defined. The only initial requirement is that $symref can +be passed to, and understood by, dl_install_xsub(). + +SunOS: dlsym($libref, $symbol) +HP-UX: shl_findsym($libref, $symbol) +Linux: dld_get_func($symbol) and/or dld_get_symbol($symbol) +NeXT: rld_lookup("_$symbol") +VMS: lib$find_image_symbol($libref,$symbol) + + +---------------------------------------------------------------------- +@symbols = dl_undef_symbols() + +Return a list of symbol names which remain undefined after load_file(). +Returns () if not known. Don't worry if your platform does not provide +a mechanism for this. Most do not need it and hence do not provide it. + + +---------------------------------------------------------------------- +dl_install_xsub($perl_name, $symref [, $filename]) + +Create a new Perl external subroutine named $perl_name using $symref as +a pointer to the function which implements the routine. This is simply +a direct call to newXSUB(). Returns a reference to the installed +function. + +The $filename parameter is used by Perl to identify the source file for +the function if required by die(), caller() or the debugger. If +$filename is not defined then "DynaLoader" will be used. + + +---------------------------------------------------------------------- +bootstrap($module) + +This is the normal entry point for automatic dynamic loading in Perl. + +It performs the following actions: + 1. locates an auto/$module directory by searching @INC + 2. uses dl_findfile() to determine the filename to load + 3. sets @dl_require_symbols to ("boot_$module") + 4. executes an auto/$module/$^R/$module.bs file if it exists + (typically used to add to @dl_resolve_using any files which + are required to load the module on the current platform) + 5. calls dl_load_file() to load the file + 6. calls dl_undef_symbols() and warns if any symbols are undefined + 7. calls dl_find_symbol() for "boot_$module" + 8. calls dl_install_xsub() to install it as "${module}::bootstrap" + 9. calls &{"${module}::bootstrap"} to bootstrap the module + + +====================================================================== +End. diff --git a/ext/DynaLoader/DynaLoader.pm b/ext/DynaLoader/DynaLoader.pm new file mode 100644 index 0000000..61d9a85 --- /dev/null +++ b/ext/DynaLoader/DynaLoader.pm @@ -0,0 +1,243 @@ +package DynaLoader; + +# +# 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. +# +# Read ext/DynaLoader/README and DynaLoader.doc for +# detailed information. +# +# Tim.Bunce@ig.co.uk, August 1994 + +use Config; +use Carp; +use AutoLoader; + +@ISA=(AutoLoader); + + +# enable messages from DynaLoader perl code +$dl_debug = 0 unless $dl_debug; +$dl_debug = $ENV{'PERL_DL_DEBUG'} if $ENV{'PERL_DL_DEBUG'}; + +$dl_so = $dl_dlext = ""; # avoid typo warnings +$dl_so = $Config{'so'}; # suffix for shared libraries +$dl_dlext = $Config{'dlext'}; # suffix for dynamic modules + +# Some systems need special handling to expand file specifications +# (VMS support by Charles Bailey ) +# See dl_expandspec() for more details. Should be harmless but +# inefficient to define on systems that don't need it. +$do_expand = ($Config{'osname'} eq 'VMS'); + +@dl_require_symbols = (); # names of symbols we need +@dl_resolve_using = (); # names of files to link with +@dl_library_path = (); # path to look for files + +# This is a fix to support DLD's unfortunate desire to relink -lc +@dl_resolve_using = dl_findfile('-lc') if $Config{'dlsrc'} eq "dl_dld.xs"; + +# Initialise @dl_library_path with the 'standard' library path +# for this platform as determined by Configure +push(@dl_library_path, split(' ',$Config{'libpth'})); + +# Add to @dl_library_path any extra directories we can gather from +# environment variables. So far LD_LIBRARY_PATH is the only known +# variable used for this purpose. Others may be added later. +push(@dl_library_path, split(/:/, $ENV{'LD_LIBRARY_PATH'})) + if $ENV{'LD_LIBRARY_PATH'}; + + +# No prizes for guessing why we don't say 'bootstrap DynaLoader;' here. +&boot_DynaLoader if defined &boot_DynaLoader; + +print STDERR "DynaLoader.pm loaded (@dl_library_path)\n" + if ($dl_debug >= 2); + +# Temporary interface checks for recent changes (Aug 1994) +if (defined(&dl_load_file)){ +die "dl_error not defined" unless defined (&dl_error); +die "dl_undef_symbols not defined" unless defined (&dl_undef_symbols); +} + +1; # End of main code + + +# The bootstrap function cannot be autoloaded (without complications) +# so we define it here: + +sub bootstrap { + # use local vars to enable $module.bs script to edit values + local(@args) = @_; + local($module) = $args[0]; + local(@dirs, $file); + + croak "Usage: DynaLoader::bootstrap(module)" + unless ($module); + + croak "Can't load module $module, DynaLoader not linked into this perl" + unless defined(&dl_load_file); + + print STDERR "DynaLoader::bootstrap($module)\n" if $dl_debug; + + my(@modparts) = split(/::/,$module); + my($modfname) = $modparts[-1]; + my($modpname) = join('/',@modparts); + foreach (@INC) { + my $dir = "$_/auto/$modpname"; + next unless -d $dir; # skip over uninteresting directories + + # check for common cases to avoid autoload of dl_findfile + last if ($file=_check_file("$dir/$modfname.$dl_dlext")); + + # no luck here, save dir for possible later dl_findfile search + push(@dirs, "-L$dir"); + } + # last resort, let dl_findfile have a go in all known locations + $file = dl_findfile(@dirs, map("-L$_",@INC), $modfname) unless $file; + + croak "Can't find loadable object for module $module in \@INC" + unless $file; + + my($bootname) = "boot_$module"; + $bootname =~ s/\W/_/g; + @dl_require_symbols = ($bootname); + + # Execute optional '.bootstrap' perl script for this module. + # The .bs file can be used to configure @dl_resolve_using etc to + # match the needs of the individual module on this architecture. + my $bs = $file; + $bs =~ s/\.$dl_dlext$/\.bs/o; # look for .bs 'beside' the library + if (-f $bs) { + local($osname, $dlsrc) = @Config{'osname','dlsrc'}; + print STDERR "$bs ($osname, $dlsrc)\n" if $dl_debug; + $@ = ""; + do $bs; + warn "$bs: $@\n" if $@; + } + + my $libref = DynaLoader::dl_load_file($file) or + croak "Can't load '$file' for module $module: ".&dl_error."\n"; + + my(@unresolved) = dl_undef_symbols(); + carp "Undefined symbols present after loading $file: @unresolved\n" + if (@unresolved); + + my $boot_symbol_ref = dl_find_symbol($libref, $bootname) or + croak "Can't find '$bootname' symbol in $file\n"; + + dl_install_xsub("${module}::bootstrap", $boot_symbol_ref, $file); + &{"${module}::bootstrap"}(@args); +} + + +sub _check_file{ # private utility to handle dl_expandspec vs -f tests + my($file) = @_; + return $file if (!$do_expand && -f $file); # the common case + return $file if ( $do_expand && ($file=dl_expandspec($file))); + return undef; +} + + +# Let autosplit and the autoloader deal with these functions: +__END__ + + +sub dl_findfile { + # Read ext/DynaLoader/DynaLoader.doc for detailed information. + # This function does not automatically consider the architecture + # or the perl library auto directories. + my (@args) = @_; + my (@dirs, $dir); # which directories to search + my (@found); # full paths to real files we have found + my ($vms) = ($Config{'osname'} eq 'VMS'); + + print STDERR "dl_findfile(@args)\n" if $dl_debug; + + # accumulate directories but process files as they appear + arg: foreach(@args) { + # Special fast case: full filepath requires no search + if (m:/: && -f $_ && !$do_expand){ + push(@found,$_); + last arg unless wantarray; + next; + } + + # Deal with directories first: + # Using a -L prefix is the preferred option (faster and more robust) + if (m:^-L:){ s/^-L//; push(@dirs, $_); next; } + # Otherwise we try to try to spot directories by a heuristic + # (this is a more complicated issue than it first appears) + if (m:/: && -d $_){ push(@dirs, $_); next; } + # VMS: we may be using native VMS directry syntax instead of + # Unix emulation, so check this as well + if ($vms && /[:>\]]/ && -d $_){ push(@dirs, $_); next; } + + # Only files should get this far... + my(@names, $name); # what filenames to look for + if (m:-l: ){ # convert -lname to appropriate library name + s/-l//; + push(@names,"lib$_.$dl_so"); + push(@names,"lib$_.a"); + }else{ # Umm, a bare name. Try various alternatives: + # these should be ordered with the most likely first + push(@names,"$_.$dl_so") unless m/\.$dl_so$/o; + push(@names,"lib$_.$dl_so") unless m:/:; + push(@names,"$_.o") unless m/\.(o|$dl_so)$/o; + push(@names,"$_.a") unless m/\.a$/; + push(@names, $_); + } + foreach $dir (@dirs, @dl_library_path) { + next unless -d $dir; + foreach $name (@names) { + my($file) = "$dir/$name"; + print STDERR " checking in $dir for $name\n" if $dl_debug; + $file = _check_file($file); + if ($file){ + push(@found, $file); + next arg; # no need to look any further + } + } + } + } + if ($dl_debug) { + foreach(@dirs) { + print STDERR " dl_findfile ignored non-existent directory: $_\n" unless -d $_; + } + print STDERR "dl_findfile found: @found\n"; + } + return $found[0] unless wantarray; + @found; +} + + +sub dl_expandspec{ + my($spec) = @_; + # Optional function invoked if DynaLoader.pm sets $do_expand. + # Most systems do not require or use this function. + # Some systems may implement it in the dl_*.xs file in which case + # this autoload version will not be called but is harmless. + + # This function is designed to deal with systems which treat some + # 'filenames' in a special way. For example VMS 'Logical Names' + # (something like unix environment variables - but different). + # This function should recognise such names and expand them into + # full file paths. + # Must return undef if $spec is invalid or file does not exist. + + my($file) = $spec; # default output to input + my($osname) = $Config{'osname'}; + + if ($osname eq 'VMS'){ # dl_expandspec should be defined in dl_vms.xs + croak "dl_expandspec: should be defined in XS file!\n"; + }else{ + return undef unless -f $file; + } + print STDERR "dl_expandspec($spec) => $file\n" if $dl_debug; + $file; +} diff --git a/ext/DynaLoader/Makefile.SH b/ext/DynaLoader/Makefile.SH new file mode 100644 index 0000000..2b10fef --- /dev/null +++ b/ext/DynaLoader/Makefile.SH @@ -0,0 +1,185 @@ +: This forces SH files to create target in same directory as SH file. +: This is so that make depend always knows where to find SH derivatives. + +case "$0" in +*/*) cd `expr X$0 : 'X\(.*\)/'` ;; +esac + +if test -f config.sh; then TOP=.; +elif test -f ../config.sh; then TOP=..; +elif test -f ../../config.sh; then TOP=../..; +elif test -f ../../../config.sh; then TOP=../../..; +elif test -f ../../../../config.sh; then TOP=../../../..; +else + echo "Can't find config.sh."; exit 1 +fi + +: Find absolute path name for TOP. This is needed when we cd to TOP +: to run perl on autosplit. +oldpwd=`pwd`; cd $TOP; ABSTOP=`pwd`; cd $oldpwd + +case $CONFIG in +'') + . $TOP/config.sh + ;; +esac + +: Find out directory name. This is also the extension name. +ext=`pwd | $sed -e 's@.*/@@'` + +: This extension might have its own typemap +if test -f typemap; then + exttypemap='typemap' +else + exttypemap='' +fi + +: This extension might need additional libraries. +potential_libs="" +. $TOP/ext/util/extliblist + +echo "Extracting ext/$ext/Makefile (with variable substitutions)" +: This section of the file will have variable substitutions done on it. +: Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!. +: Protect any dollar signs and backticks that you do not want interpreted +: by putting a backslash in front. You may delete these comments. +$spitshell >Makefile << !GROK!THIS! +# +# This Makefile is for the $ext extension to perl. +# + +DLSRC = $dlsrc +CC = $cc +RANLIB = $ranlib +TOP = $TOP +ABSTOP = $ABSTOP +LDFLAGS = $ldflags +CLDFLAGS = $ldflags +SMALL = $small +LARGE = $large $split + +# To use an alternate make, set \$altmake in config.sh. +MAKE = ${altmake-make} + +EXT = $ext + +# $ext might have its own typemap +EXTTYPEMAP = $exttypemap + +# The following are used to build and install shared libraries for +# dynamic loading. +LDDLFLAGS = $lddlflags +CCDLFLAGS = $ccdlflags +CCCDLFLAGS = $cccdlflags +SO = $so +DLEXT = $dlext + +# $ext might need to be linked with some extra libraries. +# EXTRALIBS = full list of libraries needed for static linking. +# Only those libraries that actually exist are included. +# DYNLOADLIBS = list of those libraries that are needed but can be +# linked in dynamically on this platform. On SunOS, for +# example, this would be .so* libraries, but not archive +# libraries. The bootstrap file is installed only if +# this list is not empty. +# STATLOADLIBS = list of those libraries which must be statically +# linked into the shared library. On SunOS 4.1.3, +# for example, I have only an archive version of +# -lm, and it must be linked in statically. +EXTRALIBS = $extralibs +DYNALOADLIBS = $dynaloadlibs +STATLOADLIBS = $statloadlibs + +!GROK!THIS! + +$spitshell >>Makefile <<'!NO!SUBS!' + +# Where to put things: +AUTO = $(TOP)/lib/auto +INSTALLSTATIC = $(EXT).a +INSTALLPM = $(TOP)/lib/$(EXT).pm + +PERL = $(ABSTOP)/miniperl +XSUBPP = $(TOP)/ext/xsubpp +SHELL = /bin/sh +CCCMD = `sh $(shellflags) $(TOP)/cflags $@` + +.c.o: + $(CCCMD) $(CCCDLFLAGS) -I$(TOP) $*.c + +all: static +# Phony target to force checking subdirectories. +FORCE: + +config: + +# Target for Dynamic Loading: +# If we hit here, there's a mistake somewhere. +dynamic: static + @echo "The DynaLoader extension must be built for static linking" + false + +# Target for Static Loading: +static: $(INSTALLSTATIC) $(INSTALLPM) + +$(INSTALLSTATIC): $(EXT).o + ar cr $@ $(EXT).o + $(RANLIB) $@ + echo $(EXTRALIBS) >> $(TOP)/ext.libs + +$(EXT).c: $(DLSRC) dlutils.c $(XSUBPP) $(TOP)/ext/typemap $(EXTTYPEMAP) $(TOP)/cflags Makefile + $(PERL) $(XSUBPP) $(DLSRC) >tmp + mv tmp $@ + +$(INSTALLPM): $(EXT).pm + rm -f $@ + cp $(EXT).pm $@ + cd $(TOP); $(PERL) autosplit $(EXT) + +# Perform very simple tests just to check for major gaffs. +# We can't do much more for platforms we are not executing on. +test-xs: + for i in dl_*xs; do $(PERL) $(XSUBPP) $$i > /dev/null; done + +clean: + rm -f *.o *.a mon.out core $(EXT).c so_locations $(BOOTSTRAP) + +realclean: clean + rm -f makefile Makefile + rm -f $(INSTALLPM) $(INSTALLSTATIC) + rm -rf $(AUTO)/$(EXT) + +purge: realclean + +$(EXT).o : $(TOP)/EXTERN.h +$(EXT).o : $(TOP)/perl.h +$(EXT).o : $(TOP)/embed.h +$(EXT).o : $(TOP)/config.h +$(EXT).o : $(TOP)/unixish.h +$(EXT).o : $(TOP)/handy.h +$(EXT).o : $(TOP)/regexp.h +$(EXT).o : $(TOP)/sv.h +$(EXT).o : $(TOP)/util.h +$(EXT).o : $(TOP)/form.h +$(EXT).o : $(TOP)/gv.h +$(EXT).o : $(TOP)/cv.h +$(EXT).o : $(TOP)/opcode.h +$(EXT).o : $(TOP)/op.h +$(EXT).o : $(TOP)/cop.h +$(EXT).o : $(TOP)/av.h +$(EXT).o : $(TOP)/hv.h +$(EXT).o : $(TOP)/mg.h +$(EXT).o : $(TOP)/scope.h +$(EXT).o : $(TOP)/pp.h +$(EXT).o : $(TOP)/proto.h +$(EXT).o : $(TOP)/XSUB.h + +Makefile: Makefile.SH $(TOP)/config.sh ; /bin/sh Makefile.SH +$(TOP)/config.h: $(TOP)/config.sh; cd $(TOP); /bin/sh config_h.SH +$(TOP)/embed.h: $(TOP)/config.sh; cd $(TOP); /bin/sh embed_h.SH +$(TOP)/cflags: $(TOP)/config.sh; cd $(TOP); /bin/sh cflags.SH + +!NO!SUBS! +chmod 644 Makefile +$eunicefix Makefile + diff --git a/ext/DynaLoader/README b/ext/DynaLoader/README new file mode 100644 index 0000000..19dd8e7 --- /dev/null +++ b/ext/DynaLoader/README @@ -0,0 +1,53 @@ +Perl 5 DynaLoader + +See DynaLoader.doc for detailed specification. + +This module is very similar to the other Perl 5 modules except that +Configure selects which dl_*.xs file to use. + +After Configure has been run the Makefile.SH will generate a Makefile +which will run xsubpp on a specific dl_*.xs file and write the output +to DynaLoader.c + +After that the processing is the same as any other module. + +Note that, to be effective, the DynaLoader module must be _statically_ +linked into perl! Configure should arrange this. + +This interface is based on the work and comments of (in no particular +order): Larry Wall, Robert Sanders, Dean Roehrich, Jeff Okamoto, Anno +Siegel, Thomas Neumann, Paul Marquess, Charles Bailey and others. + +The dl_*.xs files should either be named after the dynamic linking +operating system interface used if that interface is available on more +than one type of system, e.g.: + dlopen for dlopen()/dlsym() type functions (SunOS, BSD) + dld for the GNU dld library functions (linux, ?) +or else the osname, e.g., hpux, next, vms etc. + +Both are determined by Configure and so only those specific names that +Configure knows/uses will work. + +If porting the DynaLoader to a platform that has a core dynamic linking +interface similar to an existing generic type, e.g., dlopen or dld, +please try to port the corresponding dl_*.xs file (using #ifdef's if +required). + +Otherwise, or if that proves too messy, create a new dl_*.xs file named +after your osname. Configure will give preference to a dl_$osname.xs +file if one exists. + +The file dl_dlopen.xs is a reference implementation by Paul Marquess +which is a good place to start if porting from scratch. For more complex +platforms take a look at dl_dld.xs. The dlutils.c file holds some +common definitions that are #included into the dl_*.xs files. + +After the initial implementation of a new DynaLoader dl_*.xs file +you may need to edit or create ext/MODULE/MODULE.bs files to reflect +the needs of your platform and linking software. + +Refer to DynaLoader.doc, ext/utils/mkbootstrap and any existing +ext/MODULE/MODULE.bs files for more information. + +Tim Bunce. +August 1994 diff --git a/ext/DynaLoader/dl_aix.xs b/ext/DynaLoader/dl_aix.xs new file mode 100644 index 0000000..f8bace1 --- /dev/null +++ b/ext/DynaLoader/dl_aix.xs @@ -0,0 +1,582 @@ +/* dl_aix.xs + * + * Written: 8/31/94 by Wayne Scott (wscott@ichips.intel.com) + * + * All I did was take Jens-Uwe Mager's libdl emulation library for + * AIX and merged it with the dl_dlopen.xs file to create a dynamic library + * package that works for AIX. + * + * I did change all malloc's, free's, strdup's, calloc's to use the perl + * equilvant. I also removed some stuff we will not need. Call fini() + * on statup... It can probably be trimmed more. + */ + +/* + * @(#)dlfcn.c 1.5 revision of 93/02/14 20:14:17 + * This is an unpublished work copyright (c) 1992 Helios Software GmbH + * 3000 Hannover 1, Germany + */ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#include +#include +#include +#include +#include +#include +#include +#include + +/* + * We simulate dlopen() et al. through a call to load. Because AIX has + * no call to find an exported symbol we read the loader section of the + * loaded module and build a list of exported symbols and their virtual + * address. + */ + +typedef struct { + char *name; /* the symbols's name */ + void *addr; /* its relocated virtual address */ +} Export, *ExportPtr; + +/* + * The void * handle returned from dlopen is actually a ModulePtr. + */ +typedef struct Module { + struct Module *next; + char *name; /* module name for refcounting */ + int refCnt; /* the number of references */ + void *entry; /* entry point from load */ + int nExports; /* the number of exports found */ + ExportPtr exports; /* the array of exports */ +} Module, *ModulePtr; + +/* + * We keep a list of all loaded modules to be able to call the fini + * handlers at atexit() time. + */ +static ModulePtr modList; + +/* + * The last error from one of the dl* routines is kept in static + * variables here. Each error is returned only once to the caller. + */ +static char errbuf[BUFSIZ]; +static int errvalid; + +static void caterr(char *); +static int readExports(ModulePtr); +static void terminate(void); +static void *findMain(void); + + +/* ARGSUSED */ +void *dlopen(char *path, int mode) +{ + register ModulePtr mp; + static void *mainModule; + + /* + * Upon the first call register a terminate handler that will + * close all libraries. Also get a reference to the main module + * for use with loadbind. + */ + if (!mainModule) { + if ((mainModule = findMain()) == NULL) + return NULL; + atexit(terminate); + } + /* + * Scan the list of modules if have the module already loaded. + */ + for (mp = modList; mp; mp = mp->next) + if (strcmp(mp->name, path) == 0) { + mp->refCnt++; + return mp; + } + Newz(1000,mp,1,Module); + if (mp == NULL) { + errvalid++; + strcpy(errbuf, "Newz: "); + strcat(errbuf, strerror(errno)); + return NULL; + } + + if ((mp->name = savepv(path)) == NULL) { + errvalid++; + strcpy(errbuf, "savepv: "); + strcat(errbuf, strerror(errno)); + safefree(mp); + return NULL; + } + /* + * load should be declared load(const char *...). Thus we + * cast the path to a normal char *. Ugly. + */ + if ((mp->entry = (void *)load((char *)path, L_NOAUTODEFER, NULL)) == NULL) { + safefree(mp->name); + safefree(mp); + errvalid++; + strcpy(errbuf, "dlopen: "); + strcat(errbuf, path); + strcat(errbuf, ": "); + /* + * If AIX says the file is not executable, the error + * can be further described by querying the loader about + * the last error. + */ + if (errno == ENOEXEC) { + char *tmp[BUFSIZ/sizeof(char *)]; + if (loadquery(L_GETMESSAGES, tmp, sizeof(tmp)) == -1) + strcpy(errbuf, strerror(errno)); + else { + char **p; + for (p = tmp; *p; p++) + caterr(*p); + } + } else + strcat(errbuf, strerror(errno)); + return NULL; + } + mp->refCnt = 1; + mp->next = modList; + modList = mp; + if (loadbind(0, mainModule, mp->entry) == -1) { + dlclose(mp); + errvalid++; + strcpy(errbuf, "loadbind: "); + strcat(errbuf, strerror(errno)); + return NULL; + } + if (readExports(mp) == -1) { + dlclose(mp); + return NULL; + } + return mp; +} + +/* + * Attempt to decipher an AIX loader error message and append it + * to our static error message buffer. + */ +static void caterr(char *s) +{ + register char *p = s; + + while (*p >= '0' && *p <= '9') + p++; + switch(atoi(s)) { + case L_ERROR_TOOMANY: + strcat(errbuf, "to many errors"); + break; + case L_ERROR_NOLIB: + strcat(errbuf, "can't load library"); + strcat(errbuf, p); + break; + case L_ERROR_UNDEF: + strcat(errbuf, "can't find symbol"); + strcat(errbuf, p); + break; + case L_ERROR_RLDBAD: + strcat(errbuf, "bad RLD"); + strcat(errbuf, p); + break; + case L_ERROR_FORMAT: + strcat(errbuf, "bad exec format in"); + strcat(errbuf, p); + break; + case L_ERROR_ERRNO: + strcat(errbuf, strerror(atoi(++p))); + break; + default: + strcat(errbuf, s); + break; + } +} + +void *dlsym(void *handle, const char *symbol) +{ + register ModulePtr mp = (ModulePtr)handle; + register ExportPtr ep; + register int i; + + /* + * Could speed up search, but I assume that one assigns + * the result to function pointers anyways. + */ + for (ep = mp->exports, i = mp->nExports; i; i--, ep++) + if (strcmp(ep->name, symbol) == 0) + return ep->addr; + errvalid++; + strcpy(errbuf, "dlsym: undefined symbol "); + strcat(errbuf, symbol); + return NULL; +} + +char *dlerror(void) +{ + if (errvalid) { + errvalid = 0; + return errbuf; + } + return NULL; +} + +int dlclose(void *handle) +{ + register ModulePtr mp = (ModulePtr)handle; + int result; + register ModulePtr mp1; + + if (--mp->refCnt > 0) + return 0; + result = unload(mp->entry); + if (result == -1) { + errvalid++; + strcpy(errbuf, strerror(errno)); + } + if (mp->exports) { + register ExportPtr ep; + register int i; + for (ep = mp->exports, i = mp->nExports; i; i--, ep++) + if (ep->name) + safefree(ep->name); + safefree(mp->exports); + } + if (mp == modList) + modList = mp->next; + else { + for (mp1 = modList; mp1; mp1 = mp1->next) + if (mp1->next == mp) { + mp1->next = mp->next; + break; + } + } + safefree(mp->name); + safefree(mp); + return result; +} + +static void terminate(void) +{ + while (modList) + dlclose(modList); +} + +/* Added by Wayne Scott + * This is needed because the ldopen system call calls + * calloc to allocated a block of date. The ldclose call calls free. + * Without this we get this system calloc and perl's free, resulting + * in a "Bad free" message. This way we always use perl's malloc. + */ +void *calloc(size_t ne, size_t sz) +{ + void *out; + + out = (void *) safemalloc(ne*sz); + memzero(out, ne*sz); + return(out); +} + +/* + * Build the export table from the XCOFF .loader section. + */ +static int readExports(ModulePtr mp) +{ + LDFILE *ldp = NULL; + SCNHDR sh; + LDHDR *lhp; + char *ldbuf; + LDSYM *ls; + int i; + ExportPtr ep; + + if ((ldp = ldopen(mp->name, ldp)) == NULL) { + struct ld_info *lp; + char *buf; + int size = 4*1024; + if (errno != ENOENT) { + errvalid++; + strcpy(errbuf, "readExports: "); + strcat(errbuf, strerror(errno)); + return -1; + } + /* + * The module might be loaded due to the LIBPATH + * environment variable. Search for the loaded + * module using L_GETINFO. + */ + if ((buf = safemalloc(size)) == NULL) { + errvalid++; + strcpy(errbuf, "readExports: "); + strcat(errbuf, strerror(errno)); + return -1; + } + while ((i = loadquery(L_GETINFO, buf, size)) == -1 && errno == ENOMEM) { + safefree(buf); + size += 4*1024; + if ((buf = safemalloc(size)) == NULL) { + errvalid++; + strcpy(errbuf, "readExports: "); + strcat(errbuf, strerror(errno)); + return -1; + } + } + if (i == -1) { + errvalid++; + strcpy(errbuf, "readExports: "); + strcat(errbuf, strerror(errno)); + safefree(buf); + return -1; + } + /* + * Traverse the list of loaded modules. The entry point + * returned by load() does actually point to the data + * segment origin. + */ + lp = (struct ld_info *)buf; + while (lp) { + if (lp->ldinfo_dataorg == mp->entry) { + ldp = ldopen(lp->ldinfo_filename, ldp); + break; + } + if (lp->ldinfo_next == 0) + lp = NULL; + else + lp = (struct ld_info *)((char *)lp + lp->ldinfo_next); + } + safefree(buf); + if (!ldp) { + errvalid++; + strcpy(errbuf, "readExports: "); + strcat(errbuf, strerror(errno)); + return -1; + } + } + if (TYPE(ldp) != U802TOCMAGIC) { + errvalid++; + strcpy(errbuf, "readExports: bad magic"); + while(ldclose(ldp) == FAILURE) + ; + return -1; + } + if (ldnshread(ldp, _LOADER, &sh) != SUCCESS) { + errvalid++; + strcpy(errbuf, "readExports: cannot read loader section header"); + while(ldclose(ldp) == FAILURE) + ; + return -1; + } + /* + * We read the complete loader section in one chunk, this makes + * finding long symbol names residing in the string table easier. + */ + if ((ldbuf = (char *)safemalloc(sh.s_size)) == NULL) { + errvalid++; + strcpy(errbuf, "readExports: "); + strcat(errbuf, strerror(errno)); + while(ldclose(ldp) == FAILURE) + ; + return -1; + } + if (FSEEK(ldp, sh.s_scnptr, BEGINNING) != OKFSEEK) { + errvalid++; + strcpy(errbuf, "readExports: cannot seek to loader section"); + safefree(ldbuf); + while(ldclose(ldp) == FAILURE) + ; + return -1; + } + if (FREAD(ldbuf, sh.s_size, 1, ldp) != 1) { + errvalid++; + strcpy(errbuf, "readExports: cannot read loader section"); + safefree(ldbuf); + while(ldclose(ldp) == FAILURE) + ; + return -1; + } + lhp = (LDHDR *)ldbuf; + ls = (LDSYM *)(ldbuf+LDHDRSZ); + /* + * Count the number of exports to include in our export table. + */ + for (i = lhp->l_nsyms; i; i--, ls++) { + if (!LDR_EXPORT(*ls)) + continue; + mp->nExports++; + } + Newz(1001, mp->exports, mp->nExports, Export); + if (mp->exports == NULL) { + errvalid++; + strcpy(errbuf, "readExports: "); + strcat(errbuf, strerror(errno)); + safefree(ldbuf); + while(ldclose(ldp) == FAILURE) + ; + return -1; + } + /* + * Fill in the export table. All entries are relative to + * the entry point we got from load. + */ + ep = mp->exports; + ls = (LDSYM *)(ldbuf+LDHDRSZ); + for (i = lhp->l_nsyms; i; i--, ls++) { + char *symname; + if (!LDR_EXPORT(*ls)) + continue; + if (ls->l_zeroes == 0) + symname = ls->l_offset+lhp->l_stoff+ldbuf; + else + symname = ls->l_name; + ep->name = savepv(symname); + ep->addr = (void *)((unsigned long)mp->entry + ls->l_value); + ep++; + } + safefree(ldbuf); + while(ldclose(ldp) == FAILURE) + ; + return 0; +} + +/* + * Find the main modules entry point. This is used as export pointer + * for loadbind() to be able to resolve references to the main part. + */ +static void * findMain(void) +{ + struct ld_info *lp; + char *buf; + int size = 4*1024; + int i; + void *ret; + + if ((buf = safemalloc(size)) == NULL) { + errvalid++; + strcpy(errbuf, "findMain: "); + strcat(errbuf, strerror(errno)); + return NULL; + } + while ((i = loadquery(L_GETINFO, buf, size)) == -1 && errno == ENOMEM) { + safefree(buf); + size += 4*1024; + if ((buf = safemalloc(size)) == NULL) { + errvalid++; + strcpy(errbuf, "findMain: "); + strcat(errbuf, strerror(errno)); + return NULL; + } + } + if (i == -1) { + errvalid++; + strcpy(errbuf, "findMain: "); + strcat(errbuf, strerror(errno)); + safefree(buf); + return NULL; + } + /* + * The first entry is the main module. The entry point + * returned by load() does actually point to the data + * segment origin. + */ + lp = (struct ld_info *)buf; + ret = lp->ldinfo_dataorg; + safefree(buf); + return ret; +} + +/* dl_dlopen.xs + * + * Platform: SunOS/Solaris, possibly others which use dlopen. + * Author: Paul Marquess (pmarquess@bfsec.bt.co.uk) + * Created: 10th July 1994 + * + * Modified: + * 15th July 1994 - Added code to explicitly save any error messages. + * 3rd August 1994 - Upgraded to v3 spec. + * 9th August 1994 - Changed to use IV + * 10th August 1994 - Tim Bunce: Added RTLD_LAZY, switchable debugging, + * basic FreeBSD support, removed ClearError + * + */ + +/* Porting notes: + + see dl_dlopen.xs + +*/ + +#include "dlutils.c" /* SaveError() etc */ + + +static void +dl_private_init() +{ + (void)dl_generic_private_init(); +} + +MODULE = DynaLoader PACKAGE = DynaLoader + +BOOT: + (void)dl_private_init(); + + +void * +dl_load_file(filename) + char * filename + CODE: + DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename)); + RETVAL = dlopen(filename, 1) ; + DLDEBUG(2,fprintf(stderr," libref=%x\n", RETVAL)); + ST(0) = sv_newmortal() ; + if (RETVAL == NULL) + SaveError("%s",dlerror()) ; + else + sv_setiv( ST(0), (IV)RETVAL); + + +void * +dl_find_symbol(libhandle, symbolname) + void * libhandle + char * symbolname + CODE: + DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n", + libhandle, symbolname)); + RETVAL = dlsym(libhandle, symbolname); + DLDEBUG(2,fprintf(stderr," symbolref = %x\n", RETVAL)); + ST(0) = sv_newmortal() ; + if (RETVAL == NULL) + SaveError("%s",dlerror()) ; + else + sv_setiv( ST(0), (IV)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,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n", + perl_name, symref)); + ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())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 new file mode 100644 index 0000000..31f625a --- /dev/null +++ b/ext/DynaLoader/dl_dld.xs @@ -0,0 +1,173 @@ +/* + * Written 3/1/94, Robert Sanders + * + * based upon the file "dl.c", which is + * Copyright (c) 1994, Larry Wall + * + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. + * + * $Date: 1994/03/07 00:21:43 $ + * $Source: /home/rsanders/src/perl5alpha6/RCS/dld_dl.c,v $ + * $Revision: 1.4 $ + * $State: Exp $ + * + * $Log: dld_dl.c,v $ + * Removed implicit link against libc. 1994/09/14 William Setzer. + * + * Integrated other DynaLoader changes. 1994/06/08 Tim Bunce. + * + * rewrote dl_load_file, misc updates. 1994/09/03 William Setzer. + * + * Revision 1.4 1994/03/07 00:21:43 rsanders + * added min symbol count for load_libs and switched order so system libs + * are loaded after app-specified libs. + * + * Revision 1.3 1994/03/05 01:17:26 rsanders + * added path searching. + * + * Revision 1.2 1994/03/05 00:52:39 rsanders + * added package-specified libraries. + * + * Revision 1.1 1994/03/05 00:33:40 rsanders + * Initial revision + * + * + */ + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#include /* GNU DLD header file */ +#include + +#include "dlutils.c" /* for SaveError() etc */ + +static void +dl_private_init() +{ + int dlderr; + dl_generic_private_init(); +#ifdef __linux__ + dlderr = dld_init("/proc/self/exe"); + if (dlderr) { +#endif + dlderr = dld_init(dld_find_executable(origargv[0])); + if (dlderr) { + char *msg = dld_strerror(dlderr); + SaveError("dld_init(%s) failed: %s", origargv[0], msg); + DLDEBUG(1,fprintf(stderr,"%s", LastError)); + } +#ifdef __linux__ + } +#endif +} + + +MODULE = DynaLoader PACKAGE = DynaLoader + +BOOT: + (void)dl_private_init(); + + +char * +dl_load_file(filename) + char * filename + CODE: + int dlderr,x,max; + GV *gv; + AV *av; + RETVAL = filename; + DLDEBUG(1,fprintf(stderr,"dl_load_file(%s)\n", filename)); + gv = gv_fetchpv("DynaLoader::dl_require_symbols", FALSE, SVt_PVAV); + if (gv) { + av = GvAV(gv); + max = AvFILL(av); + for (x = 0; x <= max; x++) { + char *sym = SvPVX(*av_fetch(av, x, 0)); + DLDEBUG(1,fprintf(stderr, "dld_create_ref(%s)\n", sym)); + if (dlderr = dld_create_reference(sym)) { + SaveError("dld_create_reference(%s): %s", sym, + dld_strerror(dlderr)); + goto haverror; + } + } + } + DLDEBUG(1,fprintf(stderr, "dld_link(%s)\n", filename)); + if (dlderr = dld_link(filename)) { + SaveError("dld_link(%s): %s", filename, dld_strerror(dlderr)); + goto haverror; + } + gv = gv_fetchpv("DynaLoader::dl_resolve_using", FALSE, SVt_PVAV); + if (gv) { + av = GvAV(gv); + max = AvFILL(av); + for (x = 0; x <= max; x++) { + char *sym = SvPVX(*av_fetch(av, x, 0)); + DLDEBUG(1,fprintf(stderr, "dld_link(%s)\n", sym)); + if (dlderr = dld_link(sym)) { + SaveError("dld_link(%s): %s", sym, dld_strerror(dlderr)); + goto haverror; + } + } + } + DLDEBUG(2,fprintf(stderr,"libref=%s\n", RETVAL)); +haverror: + ST(0) = sv_newmortal() ; + if (dlderr == 0) + sv_setiv(ST(0), (IV)RETVAL); + + +void * +dl_find_symbol(libhandle, symbolname) + void * libhandle + char * symbolname + CODE: + DLDEBUG(2,fprintf(stderr,"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,fprintf(stderr," symbolref = %x\n", RETVAL)); + ST(0) = sv_newmortal() ; + if (RETVAL == NULL) + SaveError("dl_find_symbol: Unable to find '%s' symbol", symbolname) ; + else + sv_setiv(ST(0), (IV)RETVAL); + + +void +dl_undef_symbols() + PPCODE: + if (dld_undefined_sym_count) { + int x; + char **undef_syms = dld_list_undefined_sym(); + EXTEND(sp, dld_undefined_sym_count); + for (x=0; x < dld_undefined_sym_count; x++) + PUSHs(sv_2mortal(newSVpv(undef_syms[x]+1, 0))); + free(undef_syms); + } + + + +# 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,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n", + perl_name, symref)); + ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename))); + + +char * +dl_error() + CODE: + RETVAL = LastError ; + OUTPUT: + RETVAL + +# end. diff --git a/ext/DynaLoader/dl_dlopen.xs b/ext/DynaLoader/dl_dlopen.xs new file mode 100644 index 0000000..ffd3dbc --- /dev/null +++ b/ext/DynaLoader/dl_dlopen.xs @@ -0,0 +1,201 @@ +/* dl_dlopen.xs + * + * Platform: SunOS/Solaris, possibly others which use dlopen. + * Author: Paul Marquess (pmarquess@bfsec.bt.co.uk) + * Created: 10th July 1994 + * + * Modified: + * 15th July 1994 - Added code to explicitly save any error messages. + * 3rd August 1994 - Upgraded to v3 spec. + * 9th August 1994 - Changed to use IV + * 10th August 1994 - Tim Bunce: Added RTLD_LAZY, switchable debugging, + * basic FreeBSD support, removed ClearError + * + */ + +/* Porting notes: + + + Definition of Sunos dynamic Linking functions + ============================================= + In order to make this implementation easier to understand here is a + quick definition of the SunOS Dynamic Linking functions which are + used here. + + dlopen + ------ + void * + dlopen(path, mode) + char * path; + int mode; + + This function takes the name of a dynamic object file and returns + a descriptor which can be used by dlsym later. It returns NULL on + error. + + The mode parameter must be set to 1 for Solaris 1 and to + RTLD_LAZY on Solaris 2. + + + dlsym + ------ + void * + dlsym(handle, symbol) + void * handle; + char * symbol; + + Takes the handle returned from dlopen and the name of a symbol to + get the address of. If the symbol was found a pointer is + returned. It returns NULL on error. If DL_PREPEND_UNDERSCORE is + defined an underscore will be added to the start of symbol. This + is required on some platforms (freebsd). + + dlerror + ------ + char * dlerror() + + Returns a null-terminated string which describes the last error + that occurred with either dlopen or dlsym. After each call to + dlerror the error message will be reset to a null pointer. The + SaveError function is used to save the error as soo as it happens. + + + Return Types + ============ + In this implementation the two functions, dl_load_file & + dl_find_symbol, return void *. This is because the underlying SunOS + dynamic linker calls also return void *. This is not necessarily + the case for all architectures. For example, some implementation + will want to return a char * for dl_load_file. + + If void * is not appropriate for your architecture, you will have to + change the void * to whatever you require. If you are not certain of + how Perl handles C data types, I suggest you start by consulting + Dean Roerich's Perl 5 API document. Also, have a look in the typemap + file (in the ext directory) for a fairly comprehensive list of types + that are already supported. If you are completely stuck, I suggest you + post a message to perl5-porters, comp.lang.perl or if you are really + desperate to me. + + Remember when you are making any changes that the return value from + dl_load_file is used as a parameter in the dl_find_symbol + function. Also the return value from find_symbol is used as a parameter + to install_xsub. + + + Dealing with Error Messages + ============================ + In order to make the handling of dynamic linking errors as generic as + possible you should store any error messages associated with your + implementation with the StoreError function. + + In the case of SunOS the function dlerror returns the error message + associated with the last dynamic link error. As the SunOS dynamic + linker functions dlopen & dlsym both return NULL on error every call + to a SunOS dynamic link routine is coded like this + + RETVAL = dlopen(filename, 1) ; + if (RETVAL == NULL) + SaveError("%s",dlerror()) ; + + Note that SaveError() takes a printf format string. Use a "%s" as + the first parameter if the error may contain and % characters. + +*/ + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#ifdef I_DLFCN +#include /* the dynamic linker include file for Sunos/Solaris */ +#else +#include +#include +#endif + +#ifndef HAS_DLERROR +#define dlerror() "Unknown error - dlerror() not implemented" +#endif + + +#include "dlutils.c" /* SaveError() etc */ + + +static void +dl_private_init() +{ + (void)dl_generic_private_init(); +} + +MODULE = DynaLoader PACKAGE = DynaLoader + +BOOT: + (void)dl_private_init(); + + +void * +dl_load_file(filename) + char * filename + CODE: + int mode = 1; /* Solaris 1 */ +#ifdef RTLD_LAZY + mode = RTLD_LAZY; /* Solaris 2 */ +#endif + DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename)); + RETVAL = dlopen(filename, mode) ; + DLDEBUG(2,fprintf(stderr," libref=%x\n", RETVAL)); + ST(0) = sv_newmortal() ; + if (RETVAL == NULL) + SaveError("%s",dlerror()) ; + else + sv_setiv( ST(0), (IV)RETVAL); + + +void * +dl_find_symbol(libhandle, symbolname) + void * libhandle + char * symbolname + CODE: +#ifdef DLSYM_NEEDS_UNDERSCORE + char symbolname_buf[1024]; + symbolname = dl_add_underscore(symbolname, symbolname_buf); +#endif + DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n", + libhandle, symbolname)); + RETVAL = dlsym(libhandle, symbolname); + DLDEBUG(2,fprintf(stderr," symbolref = %x\n", RETVAL)); + ST(0) = sv_newmortal() ; + if (RETVAL == NULL) + SaveError("%s",dlerror()) ; + else + sv_setiv( ST(0), (IV)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,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n", + perl_name, symref)); + ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename))); + + +char * +dl_error() + CODE: + RETVAL = LastError ; + OUTPUT: + RETVAL + +# end. diff --git a/ext/DynaLoader/dl_hpux.xs b/ext/DynaLoader/dl_hpux.xs new file mode 100644 index 0000000..0558e40 --- /dev/null +++ b/ext/DynaLoader/dl_hpux.xs @@ -0,0 +1,101 @@ +/* + * Author: Jeff Okamoto (okamoto@corp.hp.com) + */ + +#ifdef __hp9000s300 +#define magic hpux_magic +#define MAGIC HPUX_MAGIC +#endif + +#include +#ifdef __hp9000s300 +#undef magic +#undef MAGIC +#endif + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + + +#include "dlutils.c" /* for SaveError() etc */ + + +static void +dl_private_init() +{ + (void)dl_generic_private_init(); +} + +MODULE = DynaLoader PACKAGE = DynaLoader + +BOOT: + (void)dl_private_init(); + + +void * +dl_load_file(filename) + char * filename + CODE: + shl_t obj = NULL; + DLDEBUG(1,fprintf(stderr,"dl_load_file(%s): ", filename)); + obj = shl_load(filename, + BIND_IMMEDIATE | BIND_NONFATAL | BIND_NOSTART | BIND_VERBOSE, 0L); + DLDEBUG(2,fprintf(stderr," libref=%x\n", obj)); + ST(0) = sv_newmortal() ; + if (obj == NULL) + SaveError("%s",Strerror(errno)) ; + else + sv_setiv( ST(0), (IV)obj); + + +void * +dl_find_symbol(libhandle, symbolname) + void * libhandle + char * symbolname + CODE: + shl_t obj = (shl_t) libhandle; + void *symaddr = NULL; + int status; +#ifdef __hp9000s300 + char symbolname_buf[MAXPATHLEN]; + symbolname = dl_add_underscore(symbolname, symbolname_buf); +#endif + DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n", + libhandle, symbolname)); + status = shl_findsym(&obj, symbolname, TYPE_PROCEDURE, &symaddr); + DLDEBUG(2,fprintf(stderr," symbolref = %x\n", symaddr)); + ST(0) = sv_newmortal() ; + if (status == -1) + SaveError("%s",(errno) ? Strerror(errno) : "Symbol not found") ; + else + sv_setiv( ST(0), (IV)symaddr); + + +int +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,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n", + perl_name, symref)); + ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename))); + + +char * +dl_error() + CODE: + RETVAL = LastError ; + OUTPUT: + RETVAL + +# end. diff --git a/ext/DynaLoader/dl_next.xs b/ext/DynaLoader/dl_next.xs new file mode 100644 index 0000000..9bc5cd8 --- /dev/null +++ b/ext/DynaLoader/dl_next.xs @@ -0,0 +1,213 @@ +/* dl_next.xs + * + * Platform: NeXT NS 3.2 + * Author: Anno Siegel (siegel@zrz.TU-Berlin.DE) + * Based on: dl_dlopen.xs by Paul Marquess + * Created: Aug 15th, 1994 + * + */ + +/* + 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.' +*/ + +/* Porting notes: + +dl_next.xs is itself a port from dl_dlopen.xs by Paul Marquess. It +should not be used as a base for further ports though it may be used +as an example for how dl_dlopen.xs can be ported to other platforms. + +The method used here is just to supply the sun style dlopen etc. +functions in terms of NeXTs rld_*. The xs code proper is unchanged +from Paul's original. + +The port could use some streamlining. For one, error handling could +be simplified. + +Anno Siegel + +*/ + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#include "dlutils.c" /* SaveError() etc */ + + +#include +#include + +static char * dl_last_error = (char *) 0; + +NXStream * +OpenError() +{ + return NXOpenMemory( (char *) 0, 0, NX_WRITEONLY); +} + +void +TransferError( s) +NXStream *s; +{ + char *buffer; + int len, maxlen; + + if ( dl_last_error ) { + safefree(dl_last_error); + } + NXGetMemoryBuffer(s, &buffer, &len, &maxlen); + dl_last_error = safemalloc(len); + strcpy(dl_last_error, buffer); +} + +void +CloseError( s) +NXStream *s; +{ + if ( s ) { + NXCloseMemory( s, NX_FREEBUFFER); + } +} + +char *dlerror() +{ + return dl_last_error; +} + +char * +dlopen(path, mode) +char * path; +int mode; /* mode is ignored */ +{ + int rld_success; + NXStream *nxerr = OpenError(); + AV * av_resolve; + I32 i, psize; + char *result; + char **p; + + av_resolve = GvAVn(gv_fetchpv( + "DynaLoader::dl_resolve_using", FALSE, SVt_PVAV)); + psize = AvFILL(av_resolve) + 3; + p = (char **) safemalloc(psize * sizeof(char*)); + p[0] = path; + for(i=1; i +#include +#include +#include +#include + +typedef unsigned long int vmssts; + +struct libref { + struct dsc$descriptor_s name; + struct dsc$descriptor_s defspec; +}; + +/* Static data for dl_expand_filespec() - This is static to save + * initialization on each call; if you need context-independence, + * just make these auto variables in dl_expandspec() and dl_load_file() + */ +static char dlesa[NAM$C_MAXRSS], dlrsa[NAM$C_MAXRSS]; +static struct FAB dlfab; +static struct NAM dlnam; + +/* $PutMsg action routine - records error message in LastError */ +static vmssts +copy_errmsg(msg,unused) + struct dsc$descriptor_s * msg; + vmssts unused; +{ + if (*(msg->dsc$a_pointer) = '%') { /* first line */ + if (LastError) + strncpy((LastError = saferealloc(LastError,msg->dsc$w_length)), + msg->dsc$a_pointer, msg->dsc$w_length); + else + strncpy((LastError = safemalloc(msg->dsc$w_length)), + msg->dsc$a_pointer, msg->dsc$w_length); + return 0; + } + else { /* continuation line */ + int errlen = strlen(LastError); + LastError = saferealloc(LastError, errlen + msg->dsc$w_length + 1); + LastError[errlen] = '\n'; LastError[errlen+1] = '\0'; + strncat(LastError, msg->dsc$a_pointer, msg->dsc$w_length); + } +} + +/* Use $PutMsg to retrieve error message for failure status code */ +static void +dl_set_error(sts,stv) + vmssts sts; + vmssts stv; +{ + vmssts vec[3],pmsts; + + vec[0] = stv ? 2 : 1; + vec[1] = sts; vec[2] = stv; + if (!(pmsts = sys$putmsg(vec,copy_errmsg,0,0)) & 1) + croak("Fatal $PUTMSG error: %d",pmsts); +} + +static void +dl_private_init() +{ + dl_generic_private_init(); + /* Set up the static control blocks for dl_expand_filespec() */ + dlfab = cc$rms_fab; + dlnam = cc$rms_nam; + dlfab.fab$l_nam = &dlnam; + dlnam.nam$l_esa = dlesa; + dlnam.nam$b_ess = sizeof dlesa; + dlnam.nam$l_rsa = dlrsa; + dlnam.nam$b_rss = sizeof dlrsa; +} +MODULE = DynaLoader PACKAGE = DynaLoader + +BOOT: + (void)dl_private_init(); + +SV * +dl_expandspec(filespec) + char * filespec + CODE: + char vmsspec[NAM$C_MAXRSS], defspec[NAM$C_MAXRSS]; + size_t deflen; + vmssts sts; + + tovmsspec(filespec,vmsspec); + dlfab.fab$l_fna = vmsspec; + dlfab.fab$b_fns = strlen(vmsspec); + dlfab.fab$l_dna = 0; + dlfab.fab$b_dns = 0; + DLDEBUG(1,fprintf(stderr,"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,fprintf(stderr,"\tSYNCHK sys$parse = %d\n",sts)); + if (!(sts & 1)) { + dl_set_error(dlfab.fab$l_sts,dlfab.fab$l_stv); + ST(0) = &sv_undef; + } + else { + /* Now set up a default spec - everything but the name */ + deflen = dlnam.nam$l_type - dlesa; + memcpy(defspec,dlesa,deflen); + memcpy(defspec+deflen,dlnam.nam$l_type, + 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,fprintf(stderr,"\tsplit filespec: name = %.*s, default = %.*s\n", + dlnam.nam$b_name,vmsspec,defspec,deflen)); + /* . . . and go back to expand it */ + dlnam.nam$b_nop = 0; + dlfab.fab$l_dna = defspec; + dlfab.fab$b_dns = deflen; + dlfab.fab$b_fns = dlnam.nam$b_name; + sts = sys$parse(&dlfab); + DLDEBUG(2,fprintf(stderr,"\tname/default sys$parse = %d\n",sts)); + if (!(sts & 1)) { + dl_set_error(dlfab.fab$l_sts,dlfab.fab$l_stv); + ST(0) = &sv_undef; + } + else { + /* Now find the actual file */ + sts = sys$search(&dlfab); + DLDEBUG(2,fprintf(stderr,"\tsys$search = %d\n",sts)); + if (!(sts & 1) && sts != RMS$_FNF) { + dl_set_error(dlfab.fab$l_sts,dlfab.fab$l_stv); + ST(0) = &sv_undef; + } + else { + ST(0) = sv_2mortal(newSVpv(dlnam.nam$l_rsa,dlnam.nam$b_rsl)); + DLDEBUG(1,fprintf(stderr,"\tresult = \\%.*s\\\n", + dlnam.nam$b_rsl,dlnam.nam$l_rsa)); + } + } + } + +void * +dl_load_file(filespec) + char * filespec + CODE: + char vmsspec[NAM$C_MAXRSS]; + AV *reqAV; + SV *reqSV, **reqSVhndl; + STRLEN deflen; + struct dsc$descriptor_s + specdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0}, + symdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0}; + struct fscnlst { + unsigned short int len; + unsigned short int code; + char *string; + } namlst[2] = {0,FSCN$_NAME,0, 0,0,0}; + struct libref *dlptr; + vmssts sts, failed = 0; + void *entry; + + DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n",filespec)); + specdsc.dsc$a_pointer = tovmsspec(filespec,vmsspec); + specdsc.dsc$w_length = strlen(specdsc.dsc$a_pointer); + DLDEBUG(2,fprintf(stderr,"\tVMS-ified filespec is %s\n", + specdsc.dsc$a_pointer)); + dlptr = safemalloc(sizeof(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,fprintf(stderr,"\tsys$filescan: returns %d, name is %.*s\n", + sts,namlst[0].len,namlst[0].string)); + if (!(sts & 1)) { + failed = 1; + dl_set_error(sts,0); + } + else { + dlptr->name.dsc$w_length = namlst[0].len; + dlptr->name.dsc$a_pointer = savepvn(namlst[0].string,namlst[0].len); + dlptr->defspec.dsc$w_length = specdsc.dsc$w_length - namlst[0].len; + dlptr->defspec.dsc$a_pointer = safemalloc(dlptr->defspec.dsc$w_length + 1); + deflen = namlst[0].string - specdsc.dsc$a_pointer; + memcpy(dlptr->defspec.dsc$a_pointer,specdsc.dsc$a_pointer,deflen); + memcpy(dlptr->defspec.dsc$a_pointer + deflen, + namlst[0].string + namlst[0].len, + dlptr->defspec.dsc$w_length - deflen); + DLDEBUG(2,fprintf(stderr,"\tlibref = name: %s, defspec: %.*s\n", + dlptr->name.dsc$a_pointer, + dlptr->defspec.dsc$w_length, + dlptr->defspec.dsc$a_pointer)); + if (!(reqAV = GvAV(gv_fetchpv("DynaLoader::dl_require_symbols", + FALSE,SVt_PVAV))) + || !(reqSVhndl = av_fetch(reqAV,0,FALSE)) || !(reqSV = *reqSVhndl)) { + DLDEBUG(2,fprintf(stderr,"\t@dl_require_symbols empty, returning untested libref\n")); + } + else { + symdsc.dsc$w_length = SvCUR(reqSV); + symdsc.dsc$a_pointer = SvPVX(reqSV); + DLDEBUG(2,fprintf(stderr,"\t$dl_require_symbols[0] = %.*s\n", + symdsc.dsc$w_length, symdsc.dsc$a_pointer)); + sts = lib$find_image_symbol(&(dlptr->name),&symdsc, + &entry,&(dlptr->defspec)); + DLDEBUG(2,fprintf(stderr,"\tlib$find_image_symbol returns %d\n",sts)); + if (!(sts&1)) { + failed = 1; + dl_set_error(sts,0); + } + } + } + + if (failed) { + Safefree(dlptr->name.dsc$a_pointer); + Safefree(dlptr->defspec.dsc$a_pointer); + Safefree(dlptr); + ST(0) = &sv_undef; + } + else { + ST(0) = sv_2mortal(newSViv(dlptr)); + } + + +void * +dl_find_symbol(librefptr,symname) + void * librefptr + SV * symname + CODE: + struct libref thislib = *((struct libref *)librefptr); + struct dsc$descriptor_s + symdsc = {SvCUR(symname),DSC$K_DTYPE_T,DSC$K_CLASS_S,SvPVX(symname)}; + void (*entry)(); + vmssts sts; + + DLDEBUG(1,fprintf(stderr,"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 = lib$find_image_symbol(&(thislib.name),&symdsc, + &entry,&(thislib.defspec)); + DLDEBUG(2,fprintf(stderr,"\tlib$find_image_symbol returns %d\n",sts)); + DLDEBUG(2,fprintf(stderr,"\tentry point is %d\n", + (unsigned long int) entry)); + if (!(sts & 1)) { + dl_set_error(sts,0); + ST(0) = &sv_undef; + } + else ST(0) = sv_2mortal(newSViv(entry)); + + +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,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n", + perl_name, symref)); + ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename))); + + +char * +dl_error() + CODE: + RETVAL = LastError ; + OUTPUT: + RETVAL + +# end. diff --git a/ext/DynaLoader/dlutils.c b/ext/DynaLoader/dlutils.c new file mode 100644 index 0000000..0ce0821 --- /dev/null +++ b/ext/DynaLoader/dlutils.c @@ -0,0 +1,85 @@ +/* dlutils.c - handy functions and definitions for dl_*.xs files + * + * Currently this file is simply #included into dl_*.xs/.c files. + * It should really be split into a dlutils.h and dlutils.c + * + */ + + +/* pointer to allocated memory for last error message */ +static char *LastError = (char*)NULL; + + + +#ifdef DEBUGGING +/* currently not connected to $DynaLoader::dl_error but should be */ +static int dl_debug = 0; +#define DLDEBUG(level,code) if(dl_debug>=level){ code; } +#else +#define DLDEBUG(level,code) +#endif + + +static void +dl_generic_private_init() /* called by dl_*.xs dl_private_init() */ +{ +#ifdef DEBUGGING + char *perl_dl_debug = getenv("PERL_DL_DEBUG"); + if (perl_dl_debug) + dl_debug = atoi(perl_dl_debug); +#endif +} + + +/* SaveError() takes printf style args and saves the result in LastError */ +#ifdef STANDARD_C +static void +SaveError(char* pat, ...) +#else +/*VARARGS0*/ +static void +SaveError(pat, va_alist) + char *pat; + va_dcl +#endif +{ + va_list args; + char *message; + int len; + + /* This code is based on croak/warn but I'm not sure where mess() */ + /* gets its buffer space from! */ + +#ifdef I_STDARG + va_start(args, pat); +#else + va_start(args); +#endif + message = mess(pat, &args); + va_end(args); + + len = strlen(message) + 1 ; /* include terminating null char */ + + /* Allocate some memory for the error message */ + if (LastError) + LastError = (char*)saferealloc(LastError, len) ; + else + LastError = safemalloc(len) ; + + /* Copy message into LastError (including terminating null char) */ + strncpy(LastError, message, len) ; + DLDEBUG(2,fprintf(stderr,"DynaLoader: stored error msg '%s'\n",LastError)); +} + + +/* prepend underscore to s. write into buf. return buf. */ +char * +dl_add_underscore(s, buf) +char *s; +char *buf; +{ + *buf = '_'; + (void)strcpy(buf + 1, s); + return buf; +} + diff --git a/ext/Fcntl/Fcntl.pm b/ext/Fcntl/Fcntl.pm new file mode 100644 index 0000000..c4fd2ff --- /dev/null +++ b/ext/Fcntl/Fcntl.pm @@ -0,0 +1,51 @@ +package Fcntl; + +require Exporter; +require AutoLoader; +require DynaLoader; +@ISA = (Exporter, AutoLoader, DynaLoader); +# Items to export into callers namespace by default +# (move infrequently used names to @EXPORT_OK below) +@EXPORT = + qw( + F_DUPFD F_GETFD F_GETLK F_SETFD F_GETFL F_SETFL F_SETLK F_SETLKW + FD_CLOEXEC F_RDLCK F_UNLCK F_WRLCK + O_CREAT O_EXCL O_NOCTTY O_TRUNC + O_APPEND O_NONBLOCK + O_NDELAY + O_RDONLY O_RDWR O_WRONLY + ); +# Other items we are prepared to export if requested +@EXPORT_OK = qw( +); + +sub AUTOLOAD { + if (@_ > 1) { + $AutoLoader::AUTOLOAD = $AUTOLOAD; + goto &AutoLoader::AUTOLOAD; + } + local($constname); + ($constname = $AUTOLOAD) =~ s/.*:://; + $val = constant($constname, @_ ? $_[0] : 0); + if ($! != 0) { + if ($! =~ /Invalid/) { + $AutoLoader::AUTOLOAD = $AUTOLOAD; + goto &AutoLoader::AUTOLOAD; + } + else { + ($pack,$file,$line) = caller; + die "Your vendor has not defined Fcntl macro $constname, used at $file line $line. +"; + } + } + eval "sub $AUTOLOAD { $val }"; + goto &$AUTOLOAD; +} + +bootstrap Fcntl; + +# Preloaded methods go here. Autoload methods go after __END__, and are +# processed by the autosplit program. +package Fcntl; # return to package Fcntl so AutoSplit is happy +1; +__END__ diff --git a/ext/Fcntl/Fcntl.xs b/ext/Fcntl/Fcntl.xs new file mode 100644 index 0000000..2a36095 --- /dev/null +++ b/ext/Fcntl/Fcntl.xs @@ -0,0 +1,181 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#include + +static int +not_here(s) +char *s; +{ + croak("%s not implemented on this architecture", s); + return -1; +} + +static double +constant(name, arg) +char *name; +int arg; +{ + errno = 0; + switch (*name) { + case 'F': + if (strnEQ(name, "F_", 2)) { + if (strEQ(name, "F_DUPFD")) +#ifdef F_DUPFD + return F_DUPFD; +#else + goto not_there; +#endif + if (strEQ(name, "F_GETFD")) +#ifdef F_GETFD + return F_GETFD; +#else + goto not_there; +#endif + if (strEQ(name, "F_GETLK")) +#ifdef F_GETLK + return F_GETLK; +#else + goto not_there; +#endif + if (strEQ(name, "F_SETFD")) +#ifdef F_SETFD + return F_SETFD; +#else + goto not_there; +#endif + if (strEQ(name, "F_GETFL")) +#ifdef F_GETFL + return F_GETFL; +#else + goto not_there; +#endif + if (strEQ(name, "SETFL")) +#ifdef SETFL + return SETFL; +#else + goto not_there; +#endif + if (strEQ(name, "F_SETLK")) +#ifdef F_SETLK + return F_SETLK; +#else + goto not_there; +#endif + if (strEQ(name, "F_SETLKW")) +#ifdef F_SETLKW + return F_SETLKW; +#else + goto not_there; +#endif + if (strEQ(name, "F_RDLCK")) +#ifdef F_RDLCK + return F_RDLCK; +#else + goto not_there; +#endif + if (strEQ(name, "F_UNLCK")) +#ifdef F_UNLCK + return F_UNLCK; +#else + goto not_there; +#endif + if (strEQ(name, "F_WRLCK")) +#ifdef F_WRLCK + return F_WRLCK; +#else + goto not_there; +#endif + errno = EINVAL; + return 0; + } else + if (strEQ(name, "FD_CLOEXEC")) +#ifdef FD_CLOEXEC + return FD_CLOEXEC; +#else + goto not_there; +#endif + break; + case 'O': + if (strnEQ(name, "O_", 2)) { + if (strEQ(name, "O_CREAT")) +#ifdef O_CREAT + return O_CREAT; +#else + goto not_there; +#endif + if (strEQ(name, "O_EXCL")) +#ifdef O_EXCL + return O_EXCL; +#else + goto not_there; +#endif + if (strEQ(name, "O_NOCTTY")) +#ifdef O_NOCTTY + return O_NOCTTY; +#else + goto not_there; +#endif + if (strEQ(name, "O_TRUNC")) +#ifdef O_TRUNC + return O_TRUNC; +#else + goto not_there; +#endif + if (strEQ(name, "O_APPEND")) +#ifdef O_APPEND + return O_APPEND; +#else + goto not_there; +#endif + if (strEQ(name, "O_NONBLOCK")) +#ifdef O_NONBLOCK + return O_NONBLOCK; +#else + goto not_there; +#endif + if (strEQ(name, "O_NDELAY")) +#ifdef O_NDELAY + return O_NDELAY; +#else + goto not_there; +#endif + if (strEQ(name, "O_RDONLY")) +#ifdef O_RDONLY + return O_RDONLY; +#else + goto not_there; +#endif + if (strEQ(name, "O_RDWR")) +#ifdef O_RDWR + return O_RDWR; +#else + goto not_there; +#endif + if (strEQ(name, "O_WRONLY")) +#ifdef O_WRONLY + return O_WRONLY; +#else + goto not_there; +#endif + } else + goto not_there; + break; + } + errno = EINVAL; + return 0; + +not_there: + errno = ENOENT; + return 0; +} + + +MODULE = Fcntl PACKAGE = Fcntl + +double +constant(name,arg) + char * name + int arg + diff --git a/ext/Fcntl/MANIFEST b/ext/Fcntl/MANIFEST new file mode 100644 index 0000000..e5ff6bf --- /dev/null +++ b/ext/Fcntl/MANIFEST @@ -0,0 +1,4 @@ +Fcntl.pm +Fcntl.xs +MANIFEST +Makefile.PL diff --git a/ext/Fcntl/Makefile.SH b/ext/Fcntl/Makefile.SH new file mode 100644 index 0000000..064228e --- /dev/null +++ b/ext/Fcntl/Makefile.SH @@ -0,0 +1,207 @@ +: This forces SH files to create target in same directory as SH file. +: This is so that make depend always knows where to find SH derivatives. + +case "$0" in +*/*) cd `expr X$0 : 'X\(.*\)/'` ;; +esac + +if test -f config.sh; then TOP=.; +elif test -f ../config.sh; then TOP=..; +elif test -f ../../config.sh; then TOP=../..; +elif test -f ../../../config.sh; then TOP=../../..; +elif test -f ../../../../config.sh; then TOP=../../../..; +else + echo "Can't find config.sh."; exit 1 +fi + +: Find absolute path name for TOP. This is needed when we cd to TOP +: to run perl on autosplit. +oldpwd=`pwd`; cd $TOP; ABSTOP=`pwd`; cd $oldpwd + +case $CONFIG in +'') + . $TOP/config.sh + ;; +esac + +: Find out directory name. This is also the extension name. +ext=`pwd | $sed -e 's@.*/@@'` + +: This extension might have its own typemap +if test -f typemap; then + exttypemap='typemap' +else + exttypemap='' +fi + +: This extension might need additional libraries. +potential_libs=" " +. $TOP/ext/util/extliblist + +: This extension might need bootstrap support +if test -f ${ext}_BS; then + bootdep=${ext}_BS +else + bootdep='' +fi + +case "$dlsrc" in +dl_aix*) + echo "#!" > $ext.exp + echo "boot_$ext" >> $ext.exp + ;; +esac + +echo "Extracting ext/$ext/Makefile (with variable substitutions)" +: This section of the file will have variable substitutions done on it. +: Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!. +: Protect any dollar signs and backticks that you do not want interpreted +: by putting a backslash in front. You may delete these comments. +$spitshell >Makefile << !GROK!THIS! +# +# This Makefile is for the $ext extension to perl. +# +CC = $cc +RANLIB = $ranlib +TOP = $TOP +ABSTOP = $ABSTOP +LDFLAGS = $ldflags +CLDFLAGS = $ldflags +SMALL = $small +LARGE = $large $split + +# To use an alternate make, set \$altmake in config.sh. +MAKE = ${altmake-make} + +EXT = $ext + +# $ext might have its own typemap +EXTTYPEMAP = $exttypemap + +# $ext might have its own bootstrap support +BOOTDEP = $bootdep +BOOTSTRAP = $ext.bs + +# The following are used to build and install shared libraries for +# dynamic loading. +LDDLFLAGS = $lddlflags +CCDLFLAGS = $ccdlflags +CCCDLFLAGS = $cccdlflags +SO = $so +DLEXT = $dlext + +# $ext might need to be linked with some extra libraries. +# EXTRALIBS = full list of libraries needed for static linking. +# Only those libraries that actually exist are included. +# DYNLOADLIBS = list of those libraries that are needed but can be +# linked in dynamically on this platform. On SunOS, for +# example, this would be .so* libraries, but not archive +# libraries. The bootstrap file is installed only if +# this list is not empty. +# STATLOADLIBS = list of those libraries which must be statically +# linked into the shared library. On SunOS 4.1.3, +# for example, I have only an archive version of +# -lm, and it must be linked in statically. +EXTRALIBS = $extralibs +DYNALOADLIBS = $dynaloadlibs +STATLOADLIBS = $statloadlibs + +!GROK!THIS! + +$spitshell >>Makefile <<'!NO!SUBS!' + +# Where to put things: +AUTO = $(TOP)/lib/auto +INSTALLBOOT = $(AUTO)/$(EXT)/$(EXT).bs +INSTALLDYNAMIC = $(AUTO)/$(EXT)/$(EXT).$(DLEXT) +INSTALLSTATIC = $(EXT).a +INSTALLPM = $(TOP)/lib/$(EXT).pm + +PERL = $(ABSTOP)/miniperl +XSUBPP = $(TOP)/ext/xsubpp +SHELL = /bin/sh +CCCMD = `sh $(shellflags) $(TOP)/cflags $@` + +.c.o: + $(CCCMD) $(CCCDLFLAGS) -I$(TOP) $*.c + +all: dynamic +# Phony target to force checking subdirectories. +FORCE: + +config: + +# Target for Dynamic Loading: +dynamic: $(INSTALLDYNAMIC) $(INSTALLPM) $(INSTALLBOOT) + +$(INSTALLDYNAMIC): $(EXT).o + @test -d $(AUTO) || mkdir $(AUTO) + @test -d $(AUTO)/$(EXT) || mkdir $(AUTO)/$(EXT) + ld $(LDDLFLAGS) -o $@ $(EXT).o $(STATLOADLIBS) + +$(BOOTSTRAP): Makefile $(BOOTDEP) + $(PERL) -I$(TOP)/lib $(TOP)/ext/util/mkbootstrap $(DYNALOADLIBS) + touch $(BOOTSTRAP) + +$(INSTALLBOOT): $(BOOTSTRAP) + @test ! -s $(BOOTSTRAP) || cp $(BOOTSTRAP) $@ + +# Target for Static Loading: +static: $(INSTALLSTATIC) $(INSTALLPM) + +$(INSTALLSTATIC): $(EXT).o + ar cr $@ $(EXT).o + $(RANLIB) $@ + echo $(EXTRALIBS) >> $(TOP)/ext.libs + +$(EXT).c: $(EXT).xs $(XSUBPP) $(TOP)/ext/typemap $(EXTTYPEMAP) $(TOP)/cflags Makefile + $(PERL) $(XSUBPP) $(EXT).xs >tmp + mv tmp $@ + +$(INSTALLPM): $(EXT).pm + rm -f $@ + cp $(EXT).pm $@ + cd $(TOP); $(PERL) autosplit $(EXT) + +clean: + rm -f *.o *.a mon.out core $(EXT).c so_locations $(BOOTSTRAP) $(EXT).exp + +realclean: clean + rm -f makefile Makefile + rm -f $(INSTALLPM) $(INSTALLDYNAMIC) $(INSTALLSTATIC) $(INSTALLBOOT) + rm -rf $(AUTO)/$(EXT) + +purge: realclean + +$(EXT).o : $(TOP)/EXTERN.h +$(EXT).o : $(TOP)/perl.h +$(EXT).o : $(TOP)/embed.h +$(EXT).o : $(TOP)/config.h +$(EXT).o : $(TOP)/unixish.h +$(EXT).o : $(TOP)/handy.h +$(EXT).o : $(TOP)/regexp.h +$(EXT).o : $(TOP)/sv.h +$(EXT).o : $(TOP)/util.h +$(EXT).o : $(TOP)/form.h +$(EXT).o : $(TOP)/gv.h +$(EXT).o : $(TOP)/cv.h +$(EXT).o : $(TOP)/opcode.h +$(EXT).o : $(TOP)/op.h +$(EXT).o : $(TOP)/cop.h +$(EXT).o : $(TOP)/av.h +$(EXT).o : $(TOP)/hv.h +$(EXT).o : $(TOP)/mg.h +$(EXT).o : $(TOP)/scope.h +$(EXT).o : $(TOP)/pp.h +$(EXT).o : $(TOP)/proto.h +$(EXT).o : $(TOP)/XSUB.h + +Makefile: Makefile.SH $(TOP)/config.sh ; /bin/sh Makefile.SH +$(TOP)/config.h: $(TOP)/config.sh; cd $(TOP); /bin/sh config_h.SH +$(TOP)/embed.h: $(TOP)/config.sh; cd $(TOP); /bin/sh embed_h.SH +$(TOP)/cflags: $(TOP)/config.sh; cd $(TOP); /bin/sh cflags.SH + +!NO!SUBS! +chmod 644 Makefile +$eunicefix Makefile + diff --git a/ext/GDBM_File/GDBM_File.pm b/ext/GDBM_File/GDBM_File.pm new file mode 100644 index 0000000..23422f7 --- /dev/null +++ b/ext/GDBM_File/GDBM_File.pm @@ -0,0 +1,47 @@ +package GDBM_File; + +require Carp; +require TieHash; +require Exporter; +require AutoLoader; +require DynaLoader; +@ISA = (TieHash, Exporter, AutoLoader, DynaLoader); +@EXPORT = qw( + GDBM_CACHESIZE + GDBM_FAST + GDBM_INSERT + GDBM_NEWDB + GDBM_READER + GDBM_REPLACE + GDBM_WRCREAT + GDBM_WRITER +); + +sub AUTOLOAD { + if (@_ > 1) { + $AutoLoader::AUTOLOAD = $AUTOLOAD; + goto &AutoLoader::AUTOLOAD; + } + local($constname); + ($constname = $AUTOLOAD) =~ s/.*:://; + $val = constant($constname, @_ ? $_[0] : 0); + if ($! != 0) { + if ($! =~ /Invalid/) { + $AutoLoader::AUTOLOAD = $AUTOLOAD; + goto &AutoLoader::AUTOLOAD; + } + else { + Carp::croak("Your vendor has not defined GDBM_File macro $constname, used"); + } + } + eval "sub $AUTOLOAD { $val }"; + goto &$AUTOLOAD; +} + +bootstrap GDBM_File; + +# Preloaded methods go here. Autoload methods go after __END__, and are +# processed by the autosplit program. + +1; +__END__ diff --git a/ext/GDBM_File/GDBM_File.xs b/ext/GDBM_File/GDBM_File.xs new file mode 100644 index 0000000..c6dc484 --- /dev/null +++ b/ext/GDBM_File/GDBM_File.xs @@ -0,0 +1,218 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#include +#include + +typedef GDBM_FILE GDBM_File; + +#define GDBM_BLOCKSIZE 0 /* gdbm defaults to stat blocksize */ +#define gdbm_TIEHASH(dbtype, name, read_write, mode, fatal_func) \ + gdbm_open(name, GDBM_BLOCKSIZE, read_write, mode, fatal_func) + +#define gdbm_FETCH(db,key) gdbm_fetch(db,key) +#define gdbm_STORE(db,key,value,flags) gdbm_store(db,key,value,flags) +#define gdbm_DELETE(db,key) gdbm_delete(db,key) +#define gdbm_FIRSTKEY(db) gdbm_firstkey(db) +#define gdbm_NEXTKEY(db,key) gdbm_nextkey(db,key) + +typedef datum gdatum; + +typedef void (*FATALFUNC)(); + +static int +not_here(s) +char *s; +{ + croak("GDBM_File::%s not implemented on this architecture", s); + return -1; +} + +static double +constant(name, arg) +char *name; +int arg; +{ + errno = 0; + switch (*name) { + case 'A': + break; + case 'B': + break; + case 'C': + break; + case 'D': + break; + case 'E': + break; + case 'F': + break; + case 'G': + if (strEQ(name, "GDBM_CACHESIZE")) +#ifdef GDBM_CACHESIZE + return GDBM_CACHESIZE; +#else + goto not_there; +#endif + if (strEQ(name, "GDBM_FAST")) +#ifdef GDBM_FAST + return GDBM_FAST; +#else + goto not_there; +#endif + if (strEQ(name, "GDBM_FASTMODE")) +#ifdef GDBM_FASTMODE + return GDBM_FASTMODE; +#else + goto not_there; +#endif + if (strEQ(name, "GDBM_INSERT")) +#ifdef GDBM_INSERT + return GDBM_INSERT; +#else + goto not_there; +#endif + if (strEQ(name, "GDBM_NEWDB")) +#ifdef GDBM_NEWDB + return GDBM_NEWDB; +#else + goto not_there; +#endif + if (strEQ(name, "GDBM_READER")) +#ifdef GDBM_READER + return GDBM_READER; +#else + goto not_there; +#endif + if (strEQ(name, "GDBM_REPLACE")) +#ifdef GDBM_REPLACE + return GDBM_REPLACE; +#else + goto not_there; +#endif + if (strEQ(name, "GDBM_WRCREAT")) +#ifdef GDBM_WRCREAT + return GDBM_WRCREAT; +#else + goto not_there; +#endif + if (strEQ(name, "GDBM_WRITER")) +#ifdef GDBM_WRITER + return GDBM_WRITER; +#else + goto not_there; +#endif + break; + case 'H': + break; + case 'I': + break; + case 'J': + break; + case 'K': + break; + case 'L': + break; + case 'M': + break; + case 'N': + break; + case 'O': + break; + case 'P': + break; + case 'Q': + break; + case 'R': + break; + case 'S': + break; + case 'T': + 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; +} + +MODULE = GDBM_File PACKAGE = GDBM_File PREFIX = gdbm_ + +double +constant(name,arg) + char * name + int arg + + +GDBM_File +gdbm_TIEHASH(dbtype, name, read_write, mode, fatal_func = (FATALFUNC)croak) + char * dbtype + char * name + int read_write + int mode + FATALFUNC fatal_func + +void +gdbm_close(db) + GDBM_File db + CLEANUP: + +void +gdbm_DESTROY(db) + GDBM_File db + CODE: + gdbm_close(db); + +gdatum +gdbm_FETCH(db, key) + GDBM_File db + datum key + +int +gdbm_STORE(db, key, value, flags = GDBM_REPLACE) + GDBM_File db + datum key + datum value + int flags + CLEANUP: + if (RETVAL) { + if (RETVAL < 0 && errno == EPERM) + croak("No write permission to gdbm file"); + warn("gdbm store returned %d, errno %d, key \"%.*s\"", + RETVAL,errno,key.dsize,key.dptr); + /* gdbm_clearerr(db); */ + } + +int +gdbm_DELETE(db, key) + GDBM_File db + datum key + +gdatum +gdbm_FIRSTKEY(db) + GDBM_File db + +gdatum +gdbm_NEXTKEY(db, key) + GDBM_File db + datum key + +int +gdbm_reorganize(db) + GDBM_File db + diff --git a/ext/GDBM_File/Makefile.SH b/ext/GDBM_File/Makefile.SH new file mode 100644 index 0000000..974c8de --- /dev/null +++ b/ext/GDBM_File/Makefile.SH @@ -0,0 +1,213 @@ +: This forces SH files to create target in same directory as SH file. +: This is so that make depend always knows where to find SH derivatives. + +case "$0" in +*/*) cd `expr X$0 : 'X\(.*\)/'` ;; +esac + +if test -f config.sh; then TOP=.; +elif test -f ../config.sh; then TOP=..; +elif test -f ../../config.sh; then TOP=../..; +elif test -f ../../../config.sh; then TOP=../../..; +elif test -f ../../../../config.sh; then TOP=../../../..; +else + echo "Can't find config.sh."; exit 1 +fi + +: Find absolute path name for TOP. This is needed when we cd to TOP +: to run perl on autosplit. +oldpwd=`pwd`; cd $TOP; ABSTOP=`pwd`; cd $oldpwd + +case $CONFIG in +'') + . $TOP/config.sh + ;; +esac + +: Find out directory name. This is also the extension name. +ext=`pwd | $sed -e 's@.*/@@'` + +: This extension might have its own typemap +if test -f typemap; then + exttypemap='typemap' +else + exttypemap='' +fi + +: This extension might need additional libraries. +potential_libs="-lgdbm" +. $TOP/ext/util/extliblist +case "${extralibs}${dynaloadlibs}${statloadlibs}" in +'') : Try again. Maybe they have -ldbm instead + potential_libs='-ldbm' + . $TOP/ext/util/extliblist + ;; +esac + +: This extension might need bootstrap support +if test -f ${ext}_BS; then + bootdep=${ext}_BS +else + bootdep='' +fi + +case "$dlsrc" in +dl_aix*) + echo "#!" > $ext.exp + echo "boot_$ext" >> $ext.exp + ;; +esac + +echo "Extracting ext/$ext/Makefile (with variable substitutions)" +: This section of the file will have variable substitutions done on it. +: Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!. +: Protect any dollar signs and backticks that you do not want interpreted +: by putting a backslash in front. You may delete these comments. +$spitshell >Makefile << !GROK!THIS! +# +# This Makefile is for the $ext extension to perl. +# +CC = $cc +RANLIB = $ranlib +TOP = $TOP +ABSTOP = $ABSTOP +LDFLAGS = $ldflags +CLDFLAGS = $ldflags +SMALL = $small +LARGE = $large $split + +# To use an alternate make, set \$altmake in config.sh. +MAKE = ${altmake-make} + +EXT = $ext + +# $ext might have its own typemap +EXTTYPEMAP = $exttypemap + +# $ext might have its own bootstrap support +BOOTDEP = $bootdep +BOOTSTRAP = $ext.bs + +# The following are used to build and install shared libraries for +# dynamic loading. +LDDLFLAGS = $lddlflags +CCDLFLAGS = $ccdlflags +CCCDLFLAGS = $cccdlflags +SO = $so +DLEXT = $dlext + +# $ext might need to be linked with some extra libraries. +# EXTRALIBS = full list of libraries needed for static linking. +# Only those libraries that actually exist are included. +# DYNLOADLIBS = list of those libraries that are needed but can be +# linked in dynamically on this platform. On SunOS, for +# example, this would be .so* libraries, but not archive +# libraries. The bootstrap file is installed only if +# this list is not empty. +# STATLOADLIBS = list of those libraries which must be statically +# linked into the shared library. On SunOS 4.1.3, +# for example, I have only an archive version of +# -lm, and it must be linked in statically. +EXTRALIBS = $extralibs +DYNALOADLIBS = $dynaloadlibs +STATLOADLIBS = $statloadlibs + +!GROK!THIS! + +$spitshell >>Makefile <<'!NO!SUBS!' + +# Where to put things: +AUTO = $(TOP)/lib/auto +INSTALLBOOT = $(AUTO)/$(EXT)/$(EXT).bs +INSTALLDYNAMIC = $(AUTO)/$(EXT)/$(EXT).$(DLEXT) +INSTALLSTATIC = $(EXT).a +INSTALLPM = $(TOP)/lib/$(EXT).pm + +PERL = $(ABSTOP)/miniperl +XSUBPP = $(TOP)/ext/xsubpp +SHELL = /bin/sh +CCCMD = `sh $(shellflags) $(TOP)/cflags $@` + +.c.o: + $(CCCMD) $(CCCDLFLAGS) -I$(TOP) $*.c + +all: dynamic +# Phony target to force checking subdirectories. +FORCE: + +config: + +# Target for Dynamic Loading: +dynamic: $(INSTALLDYNAMIC) $(INSTALLPM) $(INSTALLBOOT) + +$(INSTALLDYNAMIC): $(EXT).o + @test -d $(AUTO) || mkdir $(AUTO) + @test -d $(AUTO)/$(EXT) || mkdir $(AUTO)/$(EXT) + ld $(LDDLFLAGS) -o $@ $(EXT).o $(STATLOADLIBS) + +$(BOOTSTRAP): Makefile $(BOOTDEP) + $(PERL) -I$(TOP)/lib $(TOP)/ext/util/mkbootstrap $(DYNALOADLIBS) + touch $(BOOTSTRAP) + +$(INSTALLBOOT): $(BOOTSTRAP) + @test ! -s $(BOOTSTRAP) || cp $(BOOTSTRAP) $@ + +# Target for Static Loading: +static: $(INSTALLSTATIC) $(INSTALLPM) + +$(INSTALLSTATIC): $(EXT).o + ar cr $@ $(EXT).o + $(RANLIB) $@ + echo $(EXTRALIBS) >> $(TOP)/ext.libs + +$(EXT).c: $(EXT).xs $(XSUBPP) $(TOP)/ext/typemap $(EXTTYPEMAP) $(TOP)/cflags Makefile + $(PERL) $(XSUBPP) $(EXT).xs >tmp + mv tmp $@ + +$(INSTALLPM): $(EXT).pm + rm -f $@ + cp $(EXT).pm $@ + cd $(TOP); $(PERL) autosplit $(EXT) + +clean: + rm -f *.o *.a mon.out core $(EXT).c so_locations $(BOOTSTRAP) $(EXT).exp + +realclean: clean + rm -f makefile Makefile + rm -f $(INSTALLPM) $(INSTALLDYNAMIC) $(INSTALLSTATIC) $(INSTALLBOOT) + rm -rf $(AUTO)/$(EXT) + +purge: realclean + +$(EXT).o : $(TOP)/EXTERN.h +$(EXT).o : $(TOP)/perl.h +$(EXT).o : $(TOP)/embed.h +$(EXT).o : $(TOP)/config.h +$(EXT).o : $(TOP)/unixish.h +$(EXT).o : $(TOP)/handy.h +$(EXT).o : $(TOP)/regexp.h +$(EXT).o : $(TOP)/sv.h +$(EXT).o : $(TOP)/util.h +$(EXT).o : $(TOP)/form.h +$(EXT).o : $(TOP)/gv.h +$(EXT).o : $(TOP)/cv.h +$(EXT).o : $(TOP)/opcode.h +$(EXT).o : $(TOP)/op.h +$(EXT).o : $(TOP)/cop.h +$(EXT).o : $(TOP)/av.h +$(EXT).o : $(TOP)/hv.h +$(EXT).o : $(TOP)/mg.h +$(EXT).o : $(TOP)/scope.h +$(EXT).o : $(TOP)/pp.h +$(EXT).o : $(TOP)/proto.h +$(EXT).o : $(TOP)/XSUB.h + +Makefile: Makefile.SH $(TOP)/config.sh ; /bin/sh Makefile.SH +$(TOP)/config.h: $(TOP)/config.sh; cd $(TOP); /bin/sh config_h.SH +$(TOP)/embed.h: $(TOP)/config.sh; cd $(TOP); /bin/sh embed_h.SH +$(TOP)/cflags: $(TOP)/config.sh; cd $(TOP); /bin/sh cflags.SH + +!NO!SUBS! +chmod 644 Makefile +$eunicefix Makefile + diff --git a/ext/dbm/typemap b/ext/GDBM_File/typemap similarity index 100% copy from ext/dbm/typemap copy to ext/GDBM_File/typemap diff --git a/ext/NDBM_File/Makefile.SH b/ext/NDBM_File/Makefile.SH new file mode 100644 index 0000000..56016ca --- /dev/null +++ b/ext/NDBM_File/Makefile.SH @@ -0,0 +1,213 @@ +: This forces SH files to create target in same directory as SH file. +: This is so that make depend always knows where to find SH derivatives. + +case "$0" in +*/*) cd `expr X$0 : 'X\(.*\)/'` ;; +esac + +if test -f config.sh; then TOP=.; +elif test -f ../config.sh; then TOP=..; +elif test -f ../../config.sh; then TOP=../..; +elif test -f ../../../config.sh; then TOP=../../..; +elif test -f ../../../../config.sh; then TOP=../../../..; +else + echo "Can't find config.sh."; exit 1 +fi + +: Find absolute path name for TOP. This is needed when we cd to TOP +: to run perl on autosplit. +oldpwd=`pwd`; cd $TOP; ABSTOP=`pwd`; cd $oldpwd + +case $CONFIG in +'') + . $TOP/config.sh + ;; +esac + +: Find out directory name. This is also the extension name. +ext=`pwd | $sed -e 's@.*/@@'` + +: This extension might have its own typemap +if test -f typemap; then + exttypemap='typemap' +else + exttypemap='' +fi + +: This extension might need additional libraries. +potential_libs="-lndbm" +. $TOP/ext/util/extliblist +case "${extralibs}${dynaloadlibs}${statloadlibs}" in +'') : Try again. Maybe they have -ldbm instead + potential_libs='-ldbm' + . $TOP/ext/util/extliblist + ;; +esac + +: This extension might need bootstrap support +if test -f ${ext}_BS; then + bootdep=${ext}_BS +else + bootdep='' +fi + +case "$dlsrc" in +dl_aix*) + echo "#!" > $ext.exp + echo "boot_$ext" >> $ext.exp + ;; +esac + +echo "Extracting ext/$ext/Makefile (with variable substitutions)" +: This section of the file will have variable substitutions done on it. +: Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!. +: Protect any dollar signs and backticks that you do not want interpreted +: by putting a backslash in front. You may delete these comments. +$spitshell >Makefile << !GROK!THIS! +# +# This Makefile is for the $ext extension to perl. +# +CC = $cc +RANLIB = $ranlib +TOP = $TOP +ABSTOP = $ABSTOP +LDFLAGS = $ldflags +CLDFLAGS = $ldflags +SMALL = $small +LARGE = $large $split + +# To use an alternate make, set \$altmake in config.sh. +MAKE = ${altmake-make} + +EXT = $ext + +# $ext might have its own typemap +EXTTYPEMAP = $exttypemap + +# $ext might have its own bootstrap support +BOOTDEP = $bootdep +BOOTSTRAP = $ext.bs + +# The following are used to build and install shared libraries for +# dynamic loading. +LDDLFLAGS = $lddlflags +CCDLFLAGS = $ccdlflags +CCCDLFLAGS = $cccdlflags +SO = $so +DLEXT = $dlext + +# $ext might need to be linked with some extra libraries. +# EXTRALIBS = full list of libraries needed for static linking. +# Only those libraries that actually exist are included. +# DYNLOADLIBS = list of those libraries that are needed but can be +# linked in dynamically on this platform. On SunOS, for +# example, this would be .so* libraries, but not archive +# libraries. The bootstrap file is installed only if +# this list is not empty. +# STATLOADLIBS = list of those libraries which must be statically +# linked into the shared library. On SunOS 4.1.3, +# for example, I have only an archive version of +# -lm, and it must be linked in statically. +EXTRALIBS = $extralibs +DYNALOADLIBS = $dynaloadlibs +STATLOADLIBS = $statloadlibs + +!GROK!THIS! + +$spitshell >>Makefile <<'!NO!SUBS!' + +# Where to put things: +AUTO = $(TOP)/lib/auto +INSTALLBOOT = $(AUTO)/$(EXT)/$(EXT).bs +INSTALLDYNAMIC = $(AUTO)/$(EXT)/$(EXT).$(DLEXT) +INSTALLSTATIC = $(EXT).a +INSTALLPM = $(TOP)/lib/$(EXT).pm + +PERL = $(ABSTOP)/miniperl +XSUBPP = $(TOP)/ext/xsubpp +SHELL = /bin/sh +CCCMD = `sh $(shellflags) $(TOP)/cflags $@` + +.c.o: + $(CCCMD) $(CCCDLFLAGS) -I$(TOP) $*.c + +all: dynamic +# Phony target to force checking subdirectories. +FORCE: + +config: + +# Target for Dynamic Loading: +dynamic: $(INSTALLDYNAMIC) $(INSTALLPM) $(INSTALLBOOT) + +$(INSTALLDYNAMIC): $(EXT).o + @test -d $(AUTO) || mkdir $(AUTO) + @test -d $(AUTO)/$(EXT) || mkdir $(AUTO)/$(EXT) + ld $(LDDLFLAGS) -o $@ $(EXT).o $(STATLOADLIBS) + +$(BOOTSTRAP): Makefile $(BOOTDEP) + $(PERL) -I$(TOP)/lib $(TOP)/ext/util/mkbootstrap $(DYNALOADLIBS) + touch $(BOOTSTRAP) + +$(INSTALLBOOT): $(BOOTSTRAP) + @test ! -s $(BOOTSTRAP) || cp $(BOOTSTRAP) $@ + +# Target for Static Loading: +static: $(INSTALLSTATIC) $(INSTALLPM) + +$(INSTALLSTATIC): $(EXT).o + ar cr $@ $(EXT).o + $(RANLIB) $@ + echo $(EXTRALIBS) >> $(TOP)/ext.libs + +$(EXT).c: $(EXT).xs $(XSUBPP) $(TOP)/ext/typemap $(EXTTYPEMAP) $(TOP)/cflags Makefile + $(PERL) $(XSUBPP) $(EXT).xs >tmp + mv tmp $@ + +$(INSTALLPM): $(EXT).pm + rm -f $@ + cp $(EXT).pm $@ + cd $(TOP); $(PERL) autosplit $(EXT) + +clean: + rm -f *.o *.a mon.out core $(EXT).c so_locations $(BOOTSTRAP) $(EXT).exp + +realclean: clean + rm -f makefile Makefile + rm -f $(INSTALLPM) $(INSTALLDYNAMIC) $(INSTALLSTATIC) $(INSTALLBOOT) + rm -rf $(AUTO)/$(EXT) + +purge: realclean + +$(EXT).o : $(TOP)/EXTERN.h +$(EXT).o : $(TOP)/perl.h +$(EXT).o : $(TOP)/embed.h +$(EXT).o : $(TOP)/config.h +$(EXT).o : $(TOP)/unixish.h +$(EXT).o : $(TOP)/handy.h +$(EXT).o : $(TOP)/regexp.h +$(EXT).o : $(TOP)/sv.h +$(EXT).o : $(TOP)/util.h +$(EXT).o : $(TOP)/form.h +$(EXT).o : $(TOP)/gv.h +$(EXT).o : $(TOP)/cv.h +$(EXT).o : $(TOP)/opcode.h +$(EXT).o : $(TOP)/op.h +$(EXT).o : $(TOP)/cop.h +$(EXT).o : $(TOP)/av.h +$(EXT).o : $(TOP)/hv.h +$(EXT).o : $(TOP)/mg.h +$(EXT).o : $(TOP)/scope.h +$(EXT).o : $(TOP)/pp.h +$(EXT).o : $(TOP)/proto.h +$(EXT).o : $(TOP)/XSUB.h + +Makefile: Makefile.SH $(TOP)/config.sh ; /bin/sh Makefile.SH +$(TOP)/config.h: $(TOP)/config.sh; cd $(TOP); /bin/sh config_h.SH +$(TOP)/embed.h: $(TOP)/config.sh; cd $(TOP); /bin/sh embed_h.SH +$(TOP)/cflags: $(TOP)/config.sh; cd $(TOP); /bin/sh cflags.SH + +!NO!SUBS! +chmod 644 Makefile +$eunicefix Makefile + diff --git a/ext/NDBM_File/NDBM_File.pm b/ext/NDBM_File/NDBM_File.pm new file mode 100644 index 0000000..e40fe85 --- /dev/null +++ b/ext/NDBM_File/NDBM_File.pm @@ -0,0 +1,11 @@ +package NDBM_File; + +require TieHash; +require DynaLoader; +@ISA = qw(TieHash DynaLoader); + +bootstrap NDBM_File; + +1; + +__END__ diff --git a/ext/NDBM_File/NDBM_File.xs b/ext/NDBM_File/NDBM_File.xs new file mode 100644 index 0000000..52c08eb --- /dev/null +++ b/ext/NDBM_File/NDBM_File.xs @@ -0,0 +1,70 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" +#include + +typedef DBM* NDBM_File; +#define dbm_TIEHASH(dbtype,filename,flags,mode) dbm_open(filename,flags,mode) +#define dbm_FETCH(db,key) dbm_fetch(db,key) +#define dbm_STORE(db,key,value,flags) dbm_store(db,key,value,flags) +#define dbm_DELETE(db,key) dbm_delete(db,key) +#define dbm_FIRSTKEY(db) dbm_firstkey(db) +#define dbm_NEXTKEY(db,key) dbm_nextkey(db) + +MODULE = NDBM_File PACKAGE = NDBM_File PREFIX = dbm_ + +NDBM_File +dbm_TIEHASH(dbtype, filename, flags, mode) + char * dbtype + char * filename + int flags + int mode + +void +dbm_DESTROY(db) + NDBM_File db + CODE: + dbm_close(db); + +datum +dbm_FETCH(db, key) + NDBM_File db + datum key + +int +dbm_STORE(db, key, value, flags = DBM_REPLACE) + NDBM_File db + datum key + datum value + int flags + CLEANUP: + if (RETVAL) { + if (RETVAL < 0 && errno == EPERM) + croak("No write permission to ndbm file"); + warn("ndbm store returned %d, errno %d, key \"%s\"", + RETVAL,errno,key.dptr); + dbm_clearerr(db); + } + +int +dbm_DELETE(db, key) + NDBM_File db + datum key + +datum +dbm_FIRSTKEY(db) + NDBM_File db + +datum +dbm_NEXTKEY(db, key) + NDBM_File db + datum key + +int +dbm_error(db) + NDBM_File db + +void +dbm_clearerr(db) + NDBM_File db + diff --git a/ext/dbm/typemap b/ext/NDBM_File/typemap similarity index 100% copy from ext/dbm/typemap copy to ext/NDBM_File/typemap diff --git a/ext/ODBM_File/Makefile.SH b/ext/ODBM_File/Makefile.SH new file mode 100644 index 0000000..02cf6e1 --- /dev/null +++ b/ext/ODBM_File/Makefile.SH @@ -0,0 +1,213 @@ +: This forces SH files to create target in same directory as SH file. +: This is so that make depend always knows where to find SH derivatives. + +case "$0" in +*/*) cd `expr X$0 : 'X\(.*\)/'` ;; +esac + +if test -f config.sh; then TOP=.; +elif test -f ../config.sh; then TOP=..; +elif test -f ../../config.sh; then TOP=../..; +elif test -f ../../../config.sh; then TOP=../../..; +elif test -f ../../../../config.sh; then TOP=../../../..; +else + echo "Can't find config.sh."; exit 1 +fi + +: Find absolute path name for TOP. This is needed when we cd to TOP +: to run perl on autosplit. +oldpwd=`pwd`; cd $TOP; ABSTOP=`pwd`; cd $oldpwd + +case $CONFIG in +'') + . $TOP/config.sh + ;; +esac + +: Find out directory name. This is also the extension name. +ext=`pwd | $sed -e 's@.*/@@'` + +: This extension might have its own typemap +if test -f typemap; then + exttypemap='typemap' +else + exttypemap='' +fi + +: This extension might need additional libraries. +: dbm.nfs is an SCO library. +potential_libs="-ldbm.nfs" +. $TOP/ext/util/extliblist +case "${extralibs}${dynaloadlibs}${statloadlibs}" in +'') : Try again. Most systems have -ldbm instead + potential_libs='-ldbm' + . $TOP/ext/util/extliblist + ;; +esac + +: This extension might need bootstrap support +if test -f ${ext}_BS; then + bootdep=${ext}_BS +else + bootdep='' +fi + +case "$dlsrc" in +dl_aix*) + echo "#!" > $ext.exp + echo "boot_$ext" >> $ext.exp + ;; +esac + +echo "Extracting ext/$ext/Makefile (with variable substitutions)" +: This section of the file will have variable substitutions done on it. +: Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!. +: Protect any dollar signs and backticks that you do not want interpreted +: by putting a backslash in front. You may delete these comments. +$spitshell >Makefile << !GROK!THIS! +# +# This Makefile is for the $ext extension to perl. +# +CC = $cc +RANLIB = $ranlib +TOP = $TOP +ABSTOP = $ABSTOP +LDFLAGS = $ldflags +CLDFLAGS = $ldflags +SMALL = $small +LARGE = $large $split + +# To use an alternate make, set \$altmake in config.sh. +MAKE = ${altmake-make} + +EXT = $ext + +# $ext might have its own typemap +EXTTYPEMAP = $exttypemap + +# $ext might have its own bootstrap support +BOOTDEP = $bootdep +BOOTSTRAP = $ext.bs + +# The following are used to build and install shared libraries for +# dynamic loading. +LDDLFLAGS = $lddlflags +CCDLFLAGS = $ccdlflags +CCCDLFLAGS = $cccdlflags +SO = $so +DLEXT = $dlext + +# $ext might need to be linked with some extra libraries. +# EXTRALIBS = full list of libraries needed for static linking. +# Only those libraries that actually exist are included. +# DYNLOADLIBS = list of those libraries that are needed but can be +# linked in dynamically on this platform. On SunOS, for +# example, this would be .so* libraries, but not archive +# libraries. The bootstrap file is installed only if +# this list is not empty. +# STATLOADLIBS = list of those libraries which must be statically +# linked into the shared library. On SunOS 4.1.3, +# for example, I have only an archive version of +# -lm, and it must be linked in statically. +EXTRALIBS = $extralibs +DYNALOADLIBS = $dynaloadlibs +STATLOADLIBS = $statloadlibs + +!GROK!THIS! + +$spitshell >>Makefile <<'!NO!SUBS!' + +# Where to put things: +AUTO = $(TOP)/lib/auto +INSTALLBOOT = $(AUTO)/$(EXT)/$(EXT).bs +INSTALLDYNAMIC = $(AUTO)/$(EXT)/$(EXT).$(DLEXT) +INSTALLSTATIC = $(EXT).a +INSTALLPM = $(TOP)/lib/$(EXT).pm + +PERL = $(ABSTOP)/miniperl +XSUBPP = $(TOP)/ext/xsubpp +SHELL = /bin/sh +CCCMD = `sh $(shellflags) $(TOP)/cflags $@` + +.c.o: + $(CCCMD) $(CCCDLFLAGS) -I$(TOP) $*.c + +all: dynamic +# Phony target to force checking subdirectories. +FORCE: + +config: + +# Target for Dynamic Loading: +dynamic: $(INSTALLDYNAMIC) $(INSTALLPM) $(INSTALLBOOT) + +$(INSTALLDYNAMIC): $(EXT).o + @test -d $(AUTO) || mkdir $(AUTO) + @test -d $(AUTO)/$(EXT) || mkdir $(AUTO)/$(EXT) + ld $(LDDLFLAGS) -o $@ $(EXT).o $(STATLOADLIBS) + +$(BOOTSTRAP): Makefile $(BOOTDEP) + $(PERL) -I$(TOP)/lib $(TOP)/ext/util/mkbootstrap $(DYNALOADLIBS) + touch $(BOOTSTRAP) + +$(INSTALLBOOT): $(BOOTSTRAP) + @test ! -s $(BOOTSTRAP) || cp $(BOOTSTRAP) $@ + +# Target for Static Loading: +static: $(INSTALLSTATIC) $(INSTALLPM) + +$(INSTALLSTATIC): $(EXT).o + ar cr $@ $(EXT).o + $(RANLIB) $@ + echo $(EXTRALIBS) >> $(TOP)/ext.libs + +$(EXT).c: $(EXT).xs $(XSUBPP) $(TOP)/ext/typemap $(EXTTYPEMAP) $(TOP)/cflags Makefile + $(PERL) $(XSUBPP) $(EXT).xs >tmp + mv tmp $@ + +$(INSTALLPM): $(EXT).pm + rm -f $@ + cp $(EXT).pm $@ + cd $(TOP); $(PERL) autosplit $(EXT) + +clean: + rm -f *.o *.a mon.out core $(EXT).c so_locations $(BOOTSTRAP) $(EXT).exp + +realclean: clean + rm -f makefile Makefile + rm -f $(INSTALLPM) $(INSTALLDYNAMIC) $(INSTALLSTATIC) $(INSTALLBOOT) + rm -rf $(AUTO)/$(EXT) + +purge: realclean + +$(EXT).o : $(TOP)/EXTERN.h +$(EXT).o : $(TOP)/perl.h +$(EXT).o : $(TOP)/embed.h +$(EXT).o : $(TOP)/config.h +$(EXT).o : $(TOP)/unixish.h +$(EXT).o : $(TOP)/handy.h +$(EXT).o : $(TOP)/regexp.h +$(EXT).o : $(TOP)/sv.h +$(EXT).o : $(TOP)/util.h +$(EXT).o : $(TOP)/form.h +$(EXT).o : $(TOP)/gv.h +$(EXT).o : $(TOP)/cv.h +$(EXT).o : $(TOP)/opcode.h +$(EXT).o : $(TOP)/op.h +$(EXT).o : $(TOP)/cop.h +$(EXT).o : $(TOP)/av.h +$(EXT).o : $(TOP)/hv.h +$(EXT).o : $(TOP)/mg.h +$(EXT).o : $(TOP)/scope.h +$(EXT).o : $(TOP)/pp.h +$(EXT).o : $(TOP)/proto.h +$(EXT).o : $(TOP)/XSUB.h + +Makefile: Makefile.SH $(TOP)/config.sh ; /bin/sh Makefile.SH +$(TOP)/config.h: $(TOP)/config.sh; cd $(TOP); /bin/sh config_h.SH +$(TOP)/embed.h: $(TOP)/config.sh; cd $(TOP); /bin/sh embed_h.SH +$(TOP)/cflags: $(TOP)/config.sh; cd $(TOP); /bin/sh cflags.SH + +!NO!SUBS! +chmod 644 Makefile +$eunicefix Makefile diff --git a/ext/ODBM_File/ODBM_File.pm b/ext/ODBM_File/ODBM_File.pm new file mode 100644 index 0000000..d844c67 --- /dev/null +++ b/ext/ODBM_File/ODBM_File.pm @@ -0,0 +1,11 @@ +package ODBM_File; + +require TieHash; +require DynaLoader; +@ISA = qw(TieHash DynaLoader); + +bootstrap ODBM_File; + +1; + +__END__ diff --git a/ext/ODBM_File/ODBM_File.xs b/ext/ODBM_File/ODBM_File.xs new file mode 100644 index 0000000..15737a0 --- /dev/null +++ b/ext/ODBM_File/ODBM_File.xs @@ -0,0 +1,95 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#ifdef NULL +#undef NULL +#endif +#include + +#include + +typedef void* ODBM_File; + +#define odbm_FETCH(db,key) fetch(key) +#define odbm_STORE(db,key,value,flags) store(key,value) +#define odbm_DELETE(db,key) delete(key) +#define odbm_FIRSTKEY(db) firstkey() +#define odbm_NEXTKEY(db,key) nextkey(key) + +static int dbmrefcnt; + +#ifndef DBM_REPLACE +#define DBM_REPLACE 0 +#endif + +MODULE = ODBM_File PACKAGE = ODBM_File PREFIX = odbm_ + +ODBM_File +odbm_TIEHASH(dbtype, filename, flags, mode) + char * dbtype + char * filename + int flags + int mode + CODE: + { + char tmpbuf[1025]; + if (dbmrefcnt++) + croak("Old dbm can only open one database"); + sprintf(tmpbuf,"%s.dir",filename); + if (stat(tmpbuf, &statbuf) < 0) { + if (flags & O_CREAT) { + if (mode < 0 || close(creat(tmpbuf,mode)) < 0) + croak("ODBM_File: Can't create %s", filename); + sprintf(tmpbuf,"%s.pag",filename); + if (close(creat(tmpbuf,mode)) < 0) + croak("ODBM_File: Can't create %s", filename); + } + else + croak("ODBM_FILE: Can't open %s", filename); + } + RETVAL = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0); + ST(0) = sv_mortalcopy(&sv_undef); + sv_setptrobj(ST(0), RETVAL, "ODBM_File"); + } + +void +DESTROY(db) + ODBM_File db + CODE: + dbmrefcnt--; + dbmclose(); + +datum +odbm_FETCH(db, key) + ODBM_File db + datum key + +int +odbm_STORE(db, key, value, flags = DBM_REPLACE) + ODBM_File db + datum key + datum value + int flags + CLEANUP: + if (RETVAL) { + if (RETVAL < 0 && errno == EPERM) + croak("No write permission to odbm file"); + warn("odbm store returned %d, errno %d, key \"%s\"", + RETVAL,errno,key.dptr); + } + +int +odbm_DELETE(db, key) + ODBM_File db + datum key + +datum +odbm_FIRSTKEY(db) + ODBM_File db + +datum +odbm_NEXTKEY(db, key) + ODBM_File db + datum key + diff --git a/ext/dbm/typemap b/ext/ODBM_File/typemap similarity index 100% copy from ext/dbm/typemap copy to ext/ODBM_File/typemap diff --git a/ext/POSIX/Makefile.SH b/ext/POSIX/Makefile.SH new file mode 100644 index 0000000..13a8faa --- /dev/null +++ b/ext/POSIX/Makefile.SH @@ -0,0 +1,207 @@ +: This forces SH files to create target in same directory as SH file. +: This is so that make depend always knows where to find SH derivatives. + +case "$0" in +*/*) cd `expr X$0 : 'X\(.*\)/'` ;; +esac + +if test -f config.sh; then TOP=.; +elif test -f ../config.sh; then TOP=..; +elif test -f ../../config.sh; then TOP=../..; +elif test -f ../../../config.sh; then TOP=../../..; +elif test -f ../../../../config.sh; then TOP=../../../..; +else + echo "Can't find config.sh."; exit 1 +fi + +: Find absolute path name for TOP. This is needed when we cd to TOP +: to run perl on autosplit. +oldpwd=`pwd`; cd $TOP; ABSTOP=`pwd`; cd $oldpwd + +case $CONFIG in +'') + . $TOP/config.sh + ;; +esac + +: Find out directory name. This is also the extension name. +ext=`pwd | $sed -e 's@.*/@@'` + +: This extension might have its own typemap +if test -f typemap; then + exttypemap='typemap' +else + exttypemap='' +fi + +: This extension might need additional libraries. +potential_libs="-lm -lposix -lcposix " +. $TOP/ext/util/extliblist + +: This extension might need bootstrap support +if test -f ${ext}_BS; then + bootdep=${ext}_BS +else + bootdep='' +fi + +case "$dlsrc" in +dl_aix*) + echo "#!" > $ext.exp + echo "boot_$ext" >> $ext.exp + ;; +esac + +echo "Extracting ext/$ext/Makefile (with variable substitutions)" +: This section of the file will have variable substitutions done on it. +: Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!. +: Protect any dollar signs and backticks that you do not want interpreted +: by putting a backslash in front. You may delete these comments. +$spitshell >Makefile << !GROK!THIS! +# +# This Makefile is for the $ext extension to perl. +# +CC = $cc +RANLIB = $ranlib +TOP = $TOP +ABSTOP = $ABSTOP +LDFLAGS = $ldflags +CLDFLAGS = $ldflags +SMALL = $small +LARGE = $large $split + +# To use an alternate make, set \$altmake in config.sh. +MAKE = ${altmake-make} + +EXT = $ext + +# $ext might have its own typemap +EXTTYPEMAP = $exttypemap + +# $ext might have its own bootstrap support +BOOTDEP = $bootdep +BOOTSTRAP = $ext.bs + +# The following are used to build and install shared libraries for +# dynamic loading. +LDDLFLAGS = $lddlflags +CCDLFLAGS = $ccdlflags +CCCDLFLAGS = $cccdlflags +SO = $so +DLEXT = $dlext + +# $ext might need to be linked with some extra libraries. +# EXTRALIBS = full list of libraries needed for static linking. +# Only those libraries that actually exist are included. +# DYNLOADLIBS = list of those libraries that are needed but can be +# linked in dynamically on this platform. On SunOS, for +# example, this would be .so* libraries, but not archive +# libraries. The bootstrap file is installed only if +# this list is not empty. +# STATLOADLIBS = list of those libraries which must be statically +# linked into the shared library. On SunOS 4.1.3, +# for example, I have only an archive version of +# -lm, and it must be linked in statically. +EXTRALIBS = $extralibs +DYNALOADLIBS = $dynaloadlibs +STATLOADLIBS = $statloadlibs + +!GROK!THIS! + +$spitshell >>Makefile <<'!NO!SUBS!' + +# Where to put things: +AUTO = $(TOP)/lib/auto +INSTALLBOOT = $(AUTO)/$(EXT)/$(EXT).bs +INSTALLDYNAMIC = $(AUTO)/$(EXT)/$(EXT).$(DLEXT) +INSTALLSTATIC = $(EXT).a +INSTALLPM = $(TOP)/lib/$(EXT).pm + +PERL = $(ABSTOP)/miniperl +XSUBPP = $(TOP)/ext/xsubpp +SHELL = /bin/sh +CCCMD = `sh $(shellflags) $(TOP)/cflags $@` + +.c.o: + $(CCCMD) $(CCCDLFLAGS) -I$(TOP) $*.c + +all: dynamic +# Phony target to force checking subdirectories. +FORCE: + +config: + +# Target for Dynamic Loading: +dynamic: $(INSTALLDYNAMIC) $(INSTALLPM) $(INSTALLBOOT) + +$(INSTALLDYNAMIC): $(EXT).o + @test -d $(AUTO) || mkdir $(AUTO) + @test -d $(AUTO)/$(EXT) || mkdir $(AUTO)/$(EXT) + ld $(LDDLFLAGS) -o $@ $(EXT).o $(STATLOADLIBS) + +$(BOOTSTRAP): Makefile $(BOOTDEP) + $(PERL) -I$(TOP)/lib $(TOP)/ext/util/mkbootstrap $(DYNALOADLIBS) + touch $(BOOTSTRAP) + +$(INSTALLBOOT): $(BOOTSTRAP) + @test ! -s $(BOOTSTRAP) || cp $(BOOTSTRAP) $@ + +# Target for Static Loading: +static: $(INSTALLSTATIC) $(INSTALLPM) + +$(INSTALLSTATIC): $(EXT).o + ar cr $@ $(EXT).o + $(RANLIB) $@ + echo $(EXTRALIBS) >> $(TOP)/ext.libs + +$(EXT).c: $(EXT).xs $(XSUBPP) $(TOP)/ext/typemap $(EXTTYPEMAP) $(TOP)/cflags Makefile + $(PERL) $(XSUBPP) $(EXT).xs >tmp + mv tmp $@ + +$(INSTALLPM): $(EXT).pm + rm -f $@ + cp $(EXT).pm $@ + cd $(TOP); $(PERL) autosplit $(EXT) + +clean: + rm -f *.o *.a mon.out core $(EXT).c so_locations $(BOOTSTRAP) $(EXT).exp + +realclean: clean + rm -f makefile Makefile + rm -f $(INSTALLPM) $(INSTALLDYNAMIC) $(INSTALLSTATIC) $(INSTALLBOOT) + rm -rf $(AUTO)/$(EXT) + +purge: realclean + +$(EXT).o : $(TOP)/EXTERN.h +$(EXT).o : $(TOP)/perl.h +$(EXT).o : $(TOP)/embed.h +$(EXT).o : $(TOP)/config.h +$(EXT).o : $(TOP)/unixish.h +$(EXT).o : $(TOP)/handy.h +$(EXT).o : $(TOP)/regexp.h +$(EXT).o : $(TOP)/sv.h +$(EXT).o : $(TOP)/util.h +$(EXT).o : $(TOP)/form.h +$(EXT).o : $(TOP)/gv.h +$(EXT).o : $(TOP)/cv.h +$(EXT).o : $(TOP)/opcode.h +$(EXT).o : $(TOP)/op.h +$(EXT).o : $(TOP)/cop.h +$(EXT).o : $(TOP)/av.h +$(EXT).o : $(TOP)/hv.h +$(EXT).o : $(TOP)/mg.h +$(EXT).o : $(TOP)/scope.h +$(EXT).o : $(TOP)/pp.h +$(EXT).o : $(TOP)/proto.h +$(EXT).o : $(TOP)/XSUB.h + +Makefile: Makefile.SH $(TOP)/config.sh ; /bin/sh Makefile.SH +$(TOP)/config.h: $(TOP)/config.sh; cd $(TOP); /bin/sh config_h.SH +$(TOP)/embed.h: $(TOP)/config.sh; cd $(TOP); /bin/sh embed_h.SH +$(TOP)/cflags: $(TOP)/config.sh; cd $(TOP); /bin/sh cflags.SH + +!NO!SUBS! +chmod 644 Makefile +$eunicefix Makefile + diff --git a/ext/POSIX/POSIX.pm b/ext/POSIX/POSIX.pm new file mode 100644 index 0000000..3fa292d --- /dev/null +++ b/ext/POSIX/POSIX.pm @@ -0,0 +1,1023 @@ +package POSIX; + +use Carp; +require Exporter; +require AutoLoader; +require DynaLoader; +require Config; +@ISA = (Exporter, AutoLoader, DynaLoader); + +$H{assert_h} = [qw(assert NDEBUG)]; + +$H{ctype_h} = [qw(isalnum isalpha iscntrl isdigit isgraph islower + isprint ispunct isspace isupper isxdigit tolower toupper)]; + +$H{dirent_h} = [qw()]; + +$H{errno_h} = [qw(E2BIG EACCES EAGAIN EBADF EBUSY ECHILD EDEADLK EDOM + EEXIST EFAULT EFBIG EINTR EINVAL EIO EISDIR EMFILE + EMLINK ENAMETOOLONG ENFILE ENODEV ENOENT ENOEXEC ENOLCK + ENOMEM ENOSPC ENOSYS ENOTDIR ENOTEMPTY ENOTTY ENXIO + EPERM EPIPE ERANGE EROFS ESPIPE ESRCH EXDEV errno)]; + +$H{fcntl_h} = [qw(FD_CLOEXEC F_DUPFD F_GETFD F_GETFL F_GETLK F_RDLCK + F_SETFD F_SETFL F_SETLK F_SETLKW F_UNLCK F_WRLCK + O_ACCMODE O_APPEND O_CREAT O_EXCL O_NOCTTY O_NONBLOCK + O_RDONLY O_RDWR O_TRUNC O_WRONLY + creat + SEEK_CUR SEEK_END SEEK_SET + S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU + S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISGID S_ISREG S_ISUID + S_IWGRP S_IWOTH S_IWUSR)]; + +$H{float_h} = [qw(DBL_DIG DBL_EPSILON DBL_MANT_DIG + DBL_MAX DBL_MAX_10_EXP DBL_MAX_EXP + DBL_MIN DBL_MIN_10_EXP DBL_MIN_EXP + FLT_DIG FLT_EPSILON FLT_MANT_DIG + FLT_MAX FLT_MAX_10_EXP FLT_MAX_EXP + FLT_MIN FLT_MIN_10_EXP FLT_MIN_EXP + FLT_RADIX FLT_ROUNDS + LDBL_DIG LDBL_EPSILON LDBL_MANT_DIG + LDBL_MAX LDBL_MAX_10_EXP LDBL_MAX_EXP + LDBL_MIN LDBL_MIN_10_EXP LDBL_MIN_EXP)]; + +$H{grp_h} = [qw()]; + +$H{limits_h} = [qw( ARG_MAX CHAR_BIT CHAR_MAX CHAR_MIN CHILD_MAX + INT_MAX INT_MIN LINK_MAX LONG_MAX LONG_MIN MAX_CANON + MAX_INPUT MB_LEN_MAX NAME_MAX NGROUPS_MAX OPEN_MAX + PATH_MAX PIPE_BUF SCHAR_MAX SCHAR_MIN SHRT_MAX SHRT_MIN + SSIZE_MAX STREAM_MAX TZNAME_MAX UCHAR_MAX UINT_MAX + ULONG_MAX USHRT_MAX _POSIX_ARG_MAX _POSIX_CHILD_MAX + _POSIX_LINK_MAX _POSIX_MAX_CANON _POSIX_MAX_INPUT + _POSIX_NAME_MAX _POSIX_NGROUPS_MAX _POSIX_OPEN_MAX + _POSIX_PATH_MAX _POSIX_PIPE_BUF _POSIX_SSIZE_MAX + _POSIX_STREADM_MAX _POSIX_TZNAME_MAX)]; + +$H{locale_h} = [qw(LC_ALL LC_COLLATE LC_CTYPE LC_MONETARY LC_NUMERIC + LC_TIME NULL localeconv setlocale)]; + +$H{math_h} = [qw(HUGE_VAL acos asin atan ceil cosh fabs floor fmod + frexp ldexp log10 modf pow sinh tanh)]; + +$H{pwd_h} = [qw()]; + +$H{setjmp_h} = [qw(longjmp setjmp siglongjmp sigsetjmp)]; + +$H{signal_h} = [qw(SA_NOCLDSTOP SIGABRT SIGALRM SIGCHLD SIGCONT SIGFPE + SIGHUP SIGILL SIGINT SIGKILL SIGPIPE SIGQUIT SIGSEGV + SIGSTOP SIGTERM SIGTSTP SIGTTIN SIGTTOU SIGUSR1 SIGUSR2 + SIG_BLOCK SIG_DFL SIG_ERR SIG_IGN SIG_SETMASK SIG_UNBLOCK + raise sigaction signal sigpending sigprocmask + sigsuspend)]; + +$H{stdarg_h} = [qw()]; + +$H{stddef_h} = [qw(NULL offsetof)]; + +$H{stdio_h} = [qw(BUFSIZ EOF FILENAME_MAX L_ctermid L_cuserid + L_tmpname NULL SEEK_CUR SEEK_END SEEK_SET STREAM_MAX + TMP_MAX stderr stdin stdout _IOFBF _IOLBF _IONBF + clearerr fclose fdopen feof ferror fflush fgetc fgetpos + fgets fopen fprintf fputc fputs fread freopen + fscanf fseek fsetpos ftell fwrite getchar gets + perror putc putchar puts remove rewind + scanf setbuf setvbuf sscanf tmpfile tmpnam + ungetc vfprintf vprintf vsprintf)]; + +$H{stdlib_h} = [qw(EXIT_FAILURE EXIT_SUCCESS MB_CUR_MAX NULL RAND_MAX + abort atexit atof atoi atol bsearch calloc div + free getenv labs ldiv malloc mblen mbstowcs mbtowc + qsort realloc strtod strtol stroul wcstombs wctomb)]; + +$H{string_h} = [qw(NULL memchr memcmp memcpy memmove memset strcat + strchr strcmp strcoll strcpy strcspn strerror strlen + strncat strncmp strncpy strpbrk strrchr strspn strstr + strtok strxfrm)]; + +$H{sys_stat_h} = [qw(S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU + S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISGID S_ISREG + S_ISUID S_IWGRP S_IWOTH S_IWUSR S_IXGRP S_IXOTH S_IXUSR + fstat mkfifo)]; + +$H{sys_times_h} = [qw()]; + +$H{sys_types_h} = [qw()]; + +$H{sys_utsname_h} = [qw(uname)]; + +$H{sys_wait_h} = [qw(WEXITSTATUS WIFEXITED WIFSIGNALED WIFSTOPPED + WNOHANG WSTOPSIG WTERMSIG WUNTRACED)]; + +$H{termios_h} = [qw( B0 B110 B1200 B134 B150 B1800 B19200 B200 B2400 + B300 B38400 B4800 B50 B600 B75 B9600 BRKINT CLOCAL + CREAD CS5 CS6 CS7 CS8 CSIZE CSTOPB ECHO ECHOE ECHOK + ECHONL HUPCL ICANON ICRNL IEXTEN IGNBRK IGNCR IGNPAR + INLCR INPCK ISIG ISTRIP IXOFF IXON NCCS NOFLSH OPOST + PARENB PARMRK PARODD TCIFLUSH TCIOFF TCIOFLUSH TCION + TCOFLUSH TCOOFF TCOON TCSADRAIN TCSAFLUSH TCSANOW + TOSTOP VEOF VEOL VERASE VINTR VKILL VMIN VQUIT VSTART + VSTOP VSUSP VTIME + cfgetispeed cfgetospeed cfsetispeed cfsetospeed tcdrain + tcflow tcflush tcgetattr tcsendbreak tcsetattr )]; + +$H{time_h} = [qw(CLK_TCK CLOCKS_PER_SEC NULL asctime clock ctime + difftime mktime strftime tzset tzname)]; + +$H{unistd_h} = [qw(F_OK NULL R_OK SEEK_CUR SEEK_END SEEK_SET + STRERR_FILENO STDIN_FILENO STDOUT_FILENO W_OK X_OK + _PC_CHOWN_RESTRICTED _PC_LINK_MAX _PC_MAX_CANON + _PC_MAX_INPUT _PC_NAME_MAX _PC_NO_TRUNC _PC_PATH_MAX + _PC_PIPE_BUF _PC_VDISABLE _POSIX_CHOWN_RESTRICTED + _POSIX_JOB_CONTROL _POSIX_NO_TRUNC _POSIX_SAVED_IDS + _POSIX_VDISABLE _POSIX_VERSION _SC_ARG_MAX + _SC_CHILD_MAX _SC_CLK_TCK _SC_JOB_CONTROL + _SC_NGROUPS_MAX _SC_OPEN_MAX _SC_SAVED_IDS + _SC_STREAM_MAX _SC_TZNAME_MAX _SC_VERSION + _exit access ctermid cuserid + dup2 dup execl execle execlp execv execve execvp + fpathconf getcwd getegid geteuid getgid getgroups + getpid getuid isatty lseek pathconf pause setgid setpgid + setsid setuid sysconf tcgetpgrp tcsetpgrp ttyname)]; + +$H{utime_h} = [qw()]; + +sub expand { + local (@mylist); + foreach $entry (@_) { + if ($H{$entry}) { + push(@mylist, @{$H{$entry}}); + } + else { + push(@mylist, $entry); + } + } + @mylist; +} + +@EXPORT = expand qw(assert_h ctype_h dirent_h errno_h fcntl_h float_h + grp_h limits_h locale_h math_h pwd_h setjmp_h signal_h + stdarg_h stddef_h stdio_h stdlib_h string_h sys_stat_h + sys_times_h sys_types_h sys_utsname_h sys_wait_h + termios_h time_h unistd_h utime_h); + +@EXPORT_OK = qw( + closedir opendir readdir rewinddir + fcntl open + getgrgid getgrnam + atan2 cos exp log sin sqrt tan + getpwnam getpwuid + kill + fileno getc printf rename sprintf + abs exit rand srand system + chmod mkdir stat umask + times + wait waitpid + gmtime localtime time + alarm chdir chown close fork getlogin getppid getpgrp link + pipe read rmdir sleep unlink write + utime +); + +sub import { + my $this = shift; + my @list = expand @_; + local $Exporter::ExportLevel = 1; + Exporter::import($this,@list); +} + +sub AUTOLOAD { + if ($AUTOLOAD =~ /::(_?[a-z])/) { + $AutoLoader::AUTOLOAD = $AUTOLOAD; + goto &AutoLoader::AUTOLOAD + } + local $constname = $AUTOLOAD; + $constname =~ s/.*:://; + $val = constant($constname, $_[0]); + if ($! != 0) { + if ($! =~ /Invalid/) { + croak "$constname is not a valid POSIX macro"; + } + else { + croak "Your vendor has not defined POSIX macro $constname, used"; + } + } + eval "sub $AUTOLOAD { $val }"; + goto &$AUTOLOAD; +} + + +@liblist = (); +@liblist = split ' ', $Config::Config{"POSIX_loadlibs"} + if defined $Config::Config{"POSIX_loadlibs"}; +bootstrap POSIX @liblist; + +sub usage { + local ($mess) = @_; + croak "Usage: POSIX::$mess"; +} + +sub redef { + local ($mess) = @_; + croak "Use method $mess instead"; +} + +sub unimpl { + local ($mess) = @_; + $mess =~ s/xxx//; + croak "Unimplemented: POSIX::$mess"; +} + +$gensym = "SYM000"; + +sub gensym { + *{"POSIX::" . $gensym++}; +} + +sub ungensym { + local($x) = shift; + $x =~ s/.*:://; + delete $::_POSIX{$x}; +} + +############################ +package POSIX::SigAction; + +sub new { + bless {HANDLER => $_[1], MASK => $_[2], FLAGS => $_[3]}; +} + +############################ +package FileHandle; + +sub new { + POSIX::usage "FileHandle->new(filename, posixmode)" if @_ != 3; + local($class,$filename,$mode) = @_; + local($glob) = &POSIX::gensym; + $mode =~ s/a.*/>>/ || + $mode =~ s/w.*/>/ || + ($mode = '<'); + open($glob, "$mode $filename"); + bless \$glob; +} + +sub new_from_fd { + POSIX::usage "FileHandle->new_from_fd(fd,mode)" if @_ != 3; + local($class,$fd,$mode) = @_; + local($glob) = &POSIX::gensym; + $mode =~ s/a.*/>>/ || + $mode =~ s/w.*/>/ || + ($mode = '<'); + open($glob, "$mode&=$fd"); + bless \$glob; +} + +sub clearerr { + POSIX::usage "clearerr(filehandle)" if @_ != 1; + seek($_[0], 0, 1); +} + +sub close { + POSIX::usage "close(filehandle)" if @_ != 1; + close($_[0]); + ungensym($_[0]); +} + +sub eof { + POSIX::usage "eof(filehandle)" if @_ != 1; + eof($_[0]); +} + +sub getc { + POSIX::usage "getc(filehandle)" if @_ != 1; + getc($_[0]); +} + +sub gets { + POSIX::usage "gets(filehandle)" if @_ != 1; + local($handle) = @_; + scalar <$handle>; +} + +sub fileno { + POSIX::usage "fileno(filehandle)" if @_ != 1; + fileno($_[0]); +} + +sub seek { + POSIX::usage "seek(filehandle,pos,whence)" if @_ != 3; + seek($_[0], $_[1], $_[2]); +} + +sub tell { + POSIX::usage "tell(filehandle)" if @_ != 1; + tell($_[0]); +} +############################ +package POSIX; # return to package POSIX so AutoSplit is happy +1; +__END__ + +sub assert { + usage "assert(expr)" if @_ != 1; + if (!$_[0]) { + croak "Assertion failed"; + } +} + +sub tolower { + usage "tolower(string)" if @_ != 1; + lc($_[0]); +} + +sub toupper { + usage "toupper(string)" if @_ != 1; + uc($_[0]); +} + +sub closedir { + usage "closedir(dirhandle)" if @_ != 1; + closedir($_[0]); + ungensym($_[0]); +} + +sub opendir { + usage "opendir(directory)" if @_ != 1; + local($dirhandle) = &gensym; + opendir($dirhandle, $_[0]) + ? $dirhandle + : (ungensym($dirhandle), undef); +} + +sub readdir { + usage "readdir(dirhandle)" if @_ != 1; + readdir($_[0]); +} + +sub rewinddir { + usage "rewinddir(dirhandle)" if @_ != 1; + rewinddir($_[0]); +} + +sub errno { + usage "errno()" if @_ != 0; + $! + 0; +} + +sub creat { + usage "creat(filename, mode)" if @_ != 2; + &open($_[0], &O_WRONLY | &O_CREAT | &O_TRUNC, $_[2]); +} + +sub fcntl { + usage "fcntl(filehandle, cmd, arg)" if @_ != 3; + fcntl($_[0], $_[1], $_[2]); +} + +sub getgrgid { + usage "getgrgid(gid)" if @_ != 1; + getgrgid($_[0]); +} + +sub getgrnam { + usage "getgrnam(name)" if @_ != 1; + getgrnam($_[0]); +} + +sub atan2 { + usage "atan2(x,y)" if @_ != 2; + atan2($_[0], $_[1]); +} + +sub cos { + usage "cos(x)" if @_ != 1; + cos($_[0]); +} + +sub exp { + usage "exp(x)" if @_ != 1; + exp($_[0]); +} + +sub fabs { + usage "fabs(x)" if @_ != 1; + abs($_[0]); +} + +sub log { + usage "log(x)" if @_ != 1; + log($_[0]); +} + +sub pow { + usage "pow(x,exponent)" if @_ != 2; + $_[0] ** $_[1]; +} + +sub sin { + usage "sin(x)" if @_ != 1; + sin($_[0]); +} + +sub sqrt { + usage "sqrt(x)" if @_ != 1; + sqrt($_[0]); +} + +sub tan { + usage "tan(x)" if @_ != 1; + tan($_[0]); +} + +sub getpwnam { + usage "getpwnam(name)" if @_ != 1; + getpwnam($_[0]); +} + +sub getpwuid { + usage "getpwuid(uid)" if @_ != 1; + getpwuid($_[0]); +} + +sub longjmp { + unimpl "longjmp() is C-specific: use die instead"; +} + +sub setjmp { + unimpl "setjmp() is C-specific: use eval {} instead"; +} + +sub siglongjmp { + unimpl "siglongjmp() is C-specific: use die instead"; +} + +sub sigsetjmp { + unimpl "sigsetjmp() is C-specific: use eval {} instead"; +} + +sub kill { + usage "kill(pid, sig)" if @_ != 2; + kill $_[1], $_[0]; +} + +sub raise { + usage "raise(sig)" if @_ != 1; + kill $$, $_[0]; # Is this good enough? +} + +sub offsetof { + unimpl "offsetof() is C-specific, stopped"; +} + +sub clearerr { + redef "$filehandle->clearerr(filehandle)"; +} + +sub fclose { + redef "$filehandle->fclose(filehandle)"; +} + +sub fdopen { + redef "FileHandle->new_from_fd(fd,mode)"; +} + +sub feof { + redef "$filehandle->eof()"; +} + +sub fgetc { + redef "$filehandle->getc()"; +} + +sub fgets { + redef "$filehandle->gets()"; +} + +sub fileno { + redef "$filehandle->fileno()"; +} + +sub fopen { + redef "FileHandle->open()"; +} + +sub fprintf { + unimpl "fprintf() is C-specific--use printf instead"; +} + +sub fputc { + unimpl "fputc() is C-specific--use print instead"; +} + +sub fputs { + unimpl "fputs() is C-specific--use print instead"; +} + +sub fread { + unimpl "fread() is C-specific--use read instead"; +} + +sub freopen { + unimpl "freopen() is C-specific--use open instead"; +} + +sub fscanf { + unimpl "fscanf() is C-specific--use <> and regular expressions instead"; +} + +sub fseek { + redef "$filehandle->seek(pos,whence)"; +} + +sub ferror { + redef "$filehandle->error()"; +} + +sub fflush { + redef "$filehandle->flush()"; +} + +sub fgetpos { + redef "$filehandle->getpos()"; +} + +sub fsetpos { + redef "$filehandle->setpos(pos)"; +} + +sub ftell { + redef "$filehandle->tell()"; +} + +sub fwrite { + unimpl "fwrite() is C-specific--use print instead"; +} + +sub getc { + usage "getc(handle)" if @_ != 1; + getc($_[0]); +} + +sub getchar { + usage "getchar()" if @_ != 0; + getc(STDIN); +} + +sub gets { + usage "gets()" if @_ != 0; + scalar ; +} + +sub perror { + print STDERR "@_: " if @_; + print STDERR $!,"\n"; +} + +sub printf { + usage "printf(pattern, args...)" if @_ < 1; + printf STDOUT @_; +} + +sub putc { + unimpl "putc() is C-specific--use print instead"; +} + +sub putchar { + unimpl "putchar() is C-specific--use print instead"; +} + +sub puts { + unimpl "puts() is C-specific--use print instead"; +} + +sub remove { + usage "remove(filename)" if @_ != 1; + unlink($_[0]); +} + +sub rename { + usage "rename(oldfilename, newfilename)" if @_ != 2; + rename($_[0], $_[1]); +} + +sub rewind { + usage "rewind(filehandle)" if @_ != 1; + seek($_[0],0,0); +} + +sub scanf { + unimpl "scanf() is C-specific--use <> and regular expressions instead"; +} + +sub sprintf { + usage "sprintf(pattern,args)" if @_ == 0; + sprintf(shift,@_); +} + +sub sscanf { + unimpl "sscanf() is C-specific--use regular expressions instead"; +} + +sub tmpfile { + redef "FileHandle->new_tmpfile()"; +} + +sub ungetc { + redef "$filehandle->ungetc(char)"; +} + +sub vfprintf { + unimpl "vfprintf() is C-specific"; +} + +sub vprintf { + unimpl "vprintf() is C-specific"; +} + +sub vsprintf { + unimpl "vsprintf() is C-specific"; +} + +sub abs { + usage "abs(x)" if @_ != 1; + abs($_[0]); +} + +sub atexit { + unimpl "atexit() is C-specific: use END {} instead"; +} + +sub atof { + unimpl "atof() is C-specific, stopped"; +} + +sub atoi { + unimpl "atoi() is C-specific, stopped"; +} + +sub atol { + unimpl "atol() is C-specific, stopped"; +} + +sub bsearch { + unimpl "bsearch(xxx)" if @_ != 123; + bsearch($_[0]); +} + +sub calloc { + unimpl "calloc() is C-specific, stopped"; +} + +sub div { + unimpl "div() is C-specific, stopped"; +} + +sub exit { + usage "exit(status)" if @_ != 1; + exit($_[0]); +} + +sub free { + unimpl "free() is C-specific, stopped"; + free($_[0]); +} + +sub getenv { + usage "getenv(name)" if @_ != 1; + $ENV{$_[0]}; +} + +sub labs { + unimpl "labs() is C-specific, use abs instead"; +} + +sub ldiv { + unimpl "ldiv() is C-specific, use / and int instead"; +} + +sub malloc { + unimpl "malloc() is C-specific, stopped"; +} + +sub qsort { + unimpl "qsort() is C-specific, use sort instead"; +} + +sub rand { + unimpl "rand() is non-portable, use Perl's rand instead"; +} + +sub realloc { + unimpl "realloc() is C-specific, stopped"; +} + +sub srand { + unimpl "srand()"; +} + +sub strtod { + unimpl "strtod() is C-specific, stopped"; +} + +sub strtol { + unimpl "strtol() is C-specific, stopped"; +} + +sub stroul { + unimpl "stroul() is C-specific, stopped"; +} + +sub system { + usage "system(command)" if @_ != 1; + system($_[0]); +} + +sub memchr { + unimpl "memchr() is C-specific, use index() instead"; +} + +sub memcmp { + unimpl "memcmp() is C-specific, use eq instead"; +} + +sub memcpy { + unimpl "memcpy() is C-specific, use = instead"; + memcpy($_[0]); + +sub memmove { + unimpl "memmove() is C-specific, use = instead"; +} + +sub memset { + unimpl "memset() is C-specific, use x instead"; +} + +sub strcat { + unimpl "strcat() is C-specific, use .= instead"; +} + +sub strchr { + unimpl "strchr() is C-specific, use index() instead"; +} + +sub strcmp { + unimpl "strcmp() is C-specific, use eq instead"; +} + +sub strcpy { + unimpl "strcpy() is C-specific, use = instead"; +} + +sub strcspn { + unimpl "strcspn() is C-specific, use regular expressions instead"; +} + +sub strerror { + usage "strerror(errno)" if @_ != 1; + local $! = $_[0]; + $! . ""; +} + +sub strlen { + unimpl "strlen() is C-specific, use length instead"; +} + +sub strncat { + unimpl "strncat() is C-specific, use .= instead"; +} + +sub strncmp { + unimpl "strncmp() is C-specific, use eq instead"; +} + +sub strncpy { + unimpl "strncpy() is C-specific, use = instead"; +} + +sub strpbrk { + unimpl "strpbrk() is C-specific, stopped"; +} + +sub strrchr { + unimpl "strrchr() is C-specific, use rindex() instead"; +} + +sub strspn { + unimpl "strspn() is C-specific, stopped"; +} + +sub strstr { + usage "strstr(big, little)" if @_ != 2; + index($_[0], $_[1]); +} + +sub strtok { + unimpl "strtok() is C-specific, stopped"; +} + +sub chmod { + usage "chmod(filename, mode)" if @_ != 2; + chmod($_[0], $_[1]); +} + +sub fstat { + usage "fstat(fd)" if @_ != 1; + local(*TMP); + open(TMP, "<&$_[0]"); # Gross. + local(@l) = stat(TMP); + close(TMP); + @l; +} + +sub mkdir { + usage "mkdir(directoryname, mode)" if @_ != 2; + mkdir($_[0], $_[1]); +} + +sub stat { + usage "stat(filename)" if @_ != 1; + stat($_[0]); +} + +sub umask { + usage "umask(mask)" if @_ != 1; + umask($_[0]); +} + +sub times { + usage "times()" if @_ != 0; + times(); +} + +sub wait { + usage "wait(statusvariable)" if @_ != 1; + local $result = wait(); + $_[0] = $?; + $result; +} + +sub waitpid { + usage "waitpid(pid, statusvariable, options)" if @_ != 3; + local $result = waitpid($_[0], $_[2]); + $_[1] = $?; + $result; +} + +sub gmtime { + usage "gmtime(time)" if @_ != 1; + gmtime($_[0]); +} + +sub localtime { + usage "localtime(time)" if @_ != 1; + localtime($_[0]); +} + +sub time { + unimpl "time()" if @_ != 0; + time; +} + +sub alarm { + usage "alarm(seconds)" if @_ != 1; + alarm($_[0]); +} + +sub chdir { + usage "chdir(directory)" if @_ != 1; + chdir($_[0]); +} + +sub chown { + usage "chown(filename, uid, gid)" if @_ != 3; + chown($_[0], $_[1], $_[2]); +} + +sub execl { + unimpl "execl() is C-specific, stopped"; + execl($_[0]); +} + +sub execle { + unimpl "execle() is C-specific, stopped"; + execle($_[0]); +} + +sub execlp { + unimpl "execlp() is C-specific, stopped"; + execlp($_[0]); +} + +sub execv { + unimpl "execv() is C-specific, stopped"; + execv($_[0]); +} + +sub execve { + unimpl "execve() is C-specific, stopped"; + execve($_[0]); +} + +sub execvp { + unimpl "execvp() is C-specific, stopped"; + execvp($_[0]); +} + +sub fork { + usage "fork()" if @_ != 0; + fork; +} + +sub getcwd +{ + usage "getcwd()" if @_ != 0; + chop($cwd = `pwd`); + $cwd; +} + +sub getegid { + usage "getegid()" if @_ != 0; + $) + 0; +} + +sub geteuid { + usage "geteuid()" if @_ != 0; + $> + 0; +} + +sub getgid { + usage "getgid()" if @_ != 0; + $( + 0; +} + +sub getgroups { + usage "getgroups()" if @_ != 0; + local(%seen) = (); + grep(!$seen{$_}++, split(' ', $) )); +} + +sub getlogin { + usage "getlogin()" if @_ != 0; + getlogin(); +} + +sub getpgrp { + usage "getpgrp()" if @_ != 0; + getpgrp($_[0]); +} + +sub getpid { + usage "getpid()" if @_ != 0; + $$; +} + +sub getppid { + usage "getppid()" if @_ != 0; + getppid; +} + +sub getuid { + usage "getuid()" if @_ != 0; + $<; +} + +sub isatty { + usage "isatty(filehandle)" if @_ != 1; + -t $_[0]; +} + +sub link { + usage "link(oldfilename, newfilename)" if @_ != 2; + link($_[0], $_[1]); +} + +sub rmdir { + usage "rmdir(directoryname)" if @_ != 1; + rmdir($_[0]); +} + +sub setgid { + usage "setgid(gid)" if @_ != 1; + $( = $_[0]; +} + +sub setuid { + usage "setuid(uid)" if @_ != 1; + $< = $_[0]; +} + +sub sleep { + usage "sleep(seconds)" if @_ != 1; + sleep($_[0]); +} + +sub unlink { + usage "unlink(filename)" if @_ != 1; + unlink($_[0]); +} + +sub utime { + usage "utime(filename, atime, mtime)" if @_ != 3; + utime($_[1], $_[2], $_[0]); +} + diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs new file mode 100644 index 0000000..941e59a --- /dev/null +++ b/ext/POSIX/POSIX.xs @@ -0,0 +1,3148 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" +#include +#ifdef I_DIRENT /* XXX maybe better to just rely on perl.h? */ +#include +#endif +#include +#include +#ifdef I_FLOAT +#include +#endif +#include +#ifdef I_LIMITS +#include +#endif +#include +#include +#ifdef I_PWD +#include +#endif +#include +#include +#ifdef I_STDARG +#include +#endif +#ifdef I_STDDEF +#include +#endif +/* XXX This comment is just to make I_TERMIO and I_SGTTY visible to + metaconfig for future extension writers. We don't use them in POSIX. + (This is really sneaky :-) --AD +*/ +#if defined(I_TERMIOS) +#include +#endif +#include +#ifdef I_STDLIB +#include +#endif +#include +#include +#include +#include +#ifdef HAS_UNAME +#include +#endif +#include +#include +#include +#ifdef I_UTIME +#include +#endif + +typedef FILE * InputStream; +typedef FILE * OutputStream; +typedef int SysRet; +typedef long SysRetLong; +typedef sigset_t* POSIX__SigSet; +typedef HV* POSIX__SigAction; +#ifdef I_TERMIOS +typedef struct termios* POSIX__Termios; +#else /* Define termios types to int, and call not_here for the functions.*/ +#define POSIX__Termios int +#define speed_t int +#define tcflag_t int +#define cc_t int +#define cfgetispeed(x) not_here("cfgetispeed") +#define cfgetospeed(x) not_here("cfgetospeed") +#define tcdrain(x) not_here("tcdrain") +#define tcflush(x,y) not_here("tcflush") +#define tcsendbreak(x,y) not_here("tcsendbreak") +#define cfsetispeed(x,y) not_here("cfsetispeed") +#define cfsetospeed(x,y) not_here("cfsetospeed") +#define ctermid(x) (char *) not_here("ctermid") +#define tcflow(x,y) not_here("tcflow") +#define tcgetattr(x,y) not_here("tcgetattr") +#define tcsetattr(x,y,z) not_here("tcsetattr") +#endif + +/* Possibly needed prototypes */ +char *cuserid _((char *)); + +#ifndef HAS_CUSERID +#define cuserid(a) (char *) not_here("cuserid") +#endif +#ifndef HAS_DIFFTIME +#ifndef difftime +#define difftime(a,b) not_here("difftime") +#endif +#endif +#ifndef HAS_FPATHCONF +#define fpathconf(f,n) (SysRetLong) not_here("fpathconf") +#endif +#ifndef HAS_MKTIME +#define mktime(a) not_here("mktime") +#endif +#ifndef HAS_NICE +#define nice(a) not_here("nice") +#endif +#ifndef HAS_PATHCONF +#define pathconf(f,n) (SysRetLong) not_here("pathconf") +#endif +#ifndef HAS_SYSCONF +#define sysconf(n) (SysRetLong) not_here("sysconf") +#endif +#ifndef HAS_READLINK +#define readlink(a,b,c) not_here("readlink") +#endif +#ifndef HAS_SETPGID +#define setpgid(a,b) not_here("setpgid") +#endif +#ifndef HAS_SETSID +#define setsid() not_here("setsid") +#endif +#ifndef HAS_STRCOLL +#define strcoll(s1,s2) not_here("strcoll") +#endif +#ifndef HAS_STRXFRM +#define strxfrm(s1,s2,n) not_here("strxfrm") +#endif +#ifndef HAS_TCGETPGRP +#define tcgetpgrp(a) not_here("tcgetpgrp") +#endif +#ifndef HAS_TCSETPGRP +#define tcsetpgrp(a,b) not_here("tcsetpgrp") +#endif +#ifndef HAS_TIMES +#define times(a) not_here("times") +#endif +#ifndef HAS_UNAME +#define uname(a) not_here("uname") +#endif +#ifndef HAS_WAITPID +#define waitpid(a,b,c) not_here("waitpid") +#endif + +#ifndef HAS_FGETPOS +#define fgetpos(a,b) not_here("fgetpos") +#endif +#ifndef HAS_FSETPOS +#define fsetpos(a,b) not_here("fsetpos") +#endif + +#ifndef HAS_MBLEN +#ifndef mblen +#define mblen(a,b) not_here("mblen") +#endif +#endif +#ifndef HAS_MBSTOWCS +#define mbstowcs(s, pwcs, n) not_here("mbstowcs") +#endif +#ifndef HAS_MBTOWC +#define mbtowc(pwc, s, n) not_here("mbtowc") +#endif +#ifndef HAS_WCSTOMBS +#define wcstombs(s, pwcs, n) not_here("wcstombs") +#endif +#ifndef HAS_WCTOMB +#define wctomb(s, wchar) not_here("wcstombs") +#endif +#if !defined(HAS_MBLEN) && !defined(HAS_MBSTOWCS) && !defined(HAS_MBTOWC) && !defined(HAS_WCSTOMBS) && !defined(HAS_WCTOMB) +/* If we don't have these functions, then we wouldn't have gotten a typedef + for wchar_t, the wide character type. Defining wchar_t allows the + functions referencing it to compile. Its actual type is then meaningless, + since without the above functions, all sections using it end up calling + not_here() and croak. --Kaveh Ghazi (ghazi@noc.rutgers.edu) 9/18/94. */ +#ifndef wchar_t +#define wchar_t char +#endif +#endif + +#ifndef HAS_LOCALECONV +#define localeconv() not_here("localeconv") +#endif + +#ifdef HAS_TZNAME +extern char *tzname[]; +#else +char *tzname[] = { "" , "" }; +#endif + +#ifndef HAS_LONG_DOUBLE /* XXX What to do about long doubles? */ +#ifdef LDBL_MAX +#undef LDBL_MAX +#endif +#ifdef LDBL_MIN +#undef LDBL_MIN +#endif +#ifdef LDBL_EPSILON +#undef LDBL_EPSILON +#endif +#endif + +static int +not_here(s) +char *s; +{ + croak("POSIX::%s not implemented on this architecture", s); + return -1; +} + +static double +constant(name, arg) +char *name; +int arg; +{ + errno = 0; + switch (*name) { + case 'A': + if (strEQ(name, "ARG_MAX")) +#ifdef ARG_MAX + return ARG_MAX; +#else + goto not_there; +#endif + break; + case 'B': + if (strEQ(name, "BUFSIZ")) +#ifdef BUFSIZ + return BUFSIZ; +#else + goto not_there; +#endif + if (strEQ(name, "BRKINT")) +#ifdef BRKINT + return BRKINT; +#else + goto not_there; +#endif + if (strEQ(name, "B9600")) +#ifdef B9600 + return B9600; +#else + goto not_there; +#endif + if (strEQ(name, "B19200")) +#ifdef B19200 + return B19200; +#else + goto not_there; +#endif + if (strEQ(name, "B38400")) +#ifdef B38400 + return B38400; +#else + goto not_there; +#endif + if (strEQ(name, "B0")) +#ifdef B0 + return B0; +#else + goto not_there; +#endif + if (strEQ(name, "B110")) +#ifdef B110 + return B110; +#else + goto not_there; +#endif + if (strEQ(name, "B1200")) +#ifdef B1200 + return B1200; +#else + goto not_there; +#endif + if (strEQ(name, "B134")) +#ifdef B134 + return B134; +#else + goto not_there; +#endif + if (strEQ(name, "B150")) +#ifdef B150 + return B150; +#else + goto not_there; +#endif + if (strEQ(name, "B1800")) +#ifdef B1800 + return B1800; +#else + goto not_there; +#endif + if (strEQ(name, "B200")) +#ifdef B200 + return B200; +#else + goto not_there; +#endif + if (strEQ(name, "B2400")) +#ifdef B2400 + return B2400; +#else + goto not_there; +#endif + if (strEQ(name, "B300")) +#ifdef B300 + return B300; +#else + goto not_there; +#endif + if (strEQ(name, "B4800")) +#ifdef B4800 + return B4800; +#else + goto not_there; +#endif + if (strEQ(name, "B50")) +#ifdef B50 + return B50; +#else + goto not_there; +#endif + if (strEQ(name, "B600")) +#ifdef B600 + return B600; +#else + goto not_there; +#endif + if (strEQ(name, "B75")) +#ifdef B75 + return B75; +#else + goto not_there; +#endif + break; + case 'C': + if (strEQ(name, "CHAR_BIT")) +#ifdef CHAR_BIT + return CHAR_BIT; +#else + goto not_there; +#endif + if (strEQ(name, "CHAR_MAX")) +#ifdef CHAR_MAX + return CHAR_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "CHAR_MIN")) +#ifdef CHAR_MIN + return CHAR_MIN; +#else + goto not_there; +#endif + if (strEQ(name, "CHILD_MAX")) +#ifdef CHILD_MAX + return CHILD_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "CLK_TCK")) +#ifdef CLK_TCK + return CLK_TCK; +#else + goto not_there; +#endif + if (strEQ(name, "CLOCAL")) +#ifdef CLOCAL + return CLOCAL; +#else + goto not_there; +#endif + if (strEQ(name, "CLOCKS_PER_SEC")) +#ifdef CLOCKS_PER_SEC + return CLOCKS_PER_SEC; +#else + goto not_there; +#endif + if (strEQ(name, "CREAD")) +#ifdef CREAD + return CREAD; +#else + goto not_there; +#endif + if (strEQ(name, "CS5")) +#ifdef CS5 + return CS5; +#else + goto not_there; +#endif + if (strEQ(name, "CS6")) +#ifdef CS6 + return CS6; +#else + goto not_there; +#endif + if (strEQ(name, "CS7")) +#ifdef CS7 + return CS7; +#else + goto not_there; +#endif + if (strEQ(name, "CS8")) +#ifdef CS8 + return CS8; +#else + goto not_there; +#endif + if (strEQ(name, "CSIZE")) +#ifdef CSIZE + return CSIZE; +#else + goto not_there; +#endif + if (strEQ(name, "CSTOPB")) +#ifdef CSTOPB + return CSTOPB; +#else + goto not_there; +#endif + break; + case 'D': + if (strEQ(name, "DBL_MAX")) +#ifdef DBL_MAX + return DBL_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "DBL_MIN")) +#ifdef DBL_MIN + return DBL_MIN; +#else + goto not_there; +#endif + if (strEQ(name, "DBL_DIG")) +#ifdef DBL_DIG + return DBL_DIG; +#else + goto not_there; +#endif + if (strEQ(name, "DBL_EPSILON")) +#ifdef DBL_EPSILON + return DBL_EPSILON; +#else + goto not_there; +#endif + if (strEQ(name, "DBL_MANT_DIG")) +#ifdef DBL_MANT_DIG + return DBL_MANT_DIG; +#else + goto not_there; +#endif + if (strEQ(name, "DBL_MAX_10_EXP")) +#ifdef DBL_MAX_10_EXP + return DBL_MAX_10_EXP; +#else + goto not_there; +#endif + if (strEQ(name, "DBL_MAX_EXP")) +#ifdef DBL_MAX_EXP + return DBL_MAX_EXP; +#else + goto not_there; +#endif + if (strEQ(name, "DBL_MIN_10_EXP")) +#ifdef DBL_MIN_10_EXP + return DBL_MIN_10_EXP; +#else + goto not_there; +#endif + if (strEQ(name, "DBL_MIN_EXP")) +#ifdef DBL_MIN_EXP + return DBL_MIN_EXP; +#else + goto not_there; +#endif + break; + case 'E': + switch (name[1]) { + case 'A': + if (strEQ(name, "EACCES")) +#ifdef EACCES + return EACCES; +#else + goto not_there; +#endif + if (strEQ(name, "EAGAIN")) +#ifdef EAGAIN + return EAGAIN; +#else + goto not_there; +#endif + break; + case 'B': + if (strEQ(name, "EBADF")) +#ifdef EBADF + return EBADF; +#else + goto not_there; +#endif + if (strEQ(name, "EBUSY")) +#ifdef EBUSY + return EBUSY; +#else + goto not_there; +#endif + break; + case 'C': + if (strEQ(name, "ECHILD")) +#ifdef ECHILD + return ECHILD; +#else + goto not_there; +#endif + if (strEQ(name, "ECHO")) +#ifdef ECHO + return ECHO; +#else + goto not_there; +#endif + if (strEQ(name, "ECHOE")) +#ifdef ECHOE + return ECHOE; +#else + goto not_there; +#endif + if (strEQ(name, "ECHOK")) +#ifdef ECHOK + return ECHOK; +#else + goto not_there; +#endif + if (strEQ(name, "ECHONL")) +#ifdef ECHONL + return ECHONL; +#else + goto not_there; +#endif + break; + case 'D': + if (strEQ(name, "EDEADLK")) +#ifdef EDEADLK + return EDEADLK; +#else + goto not_there; +#endif + if (strEQ(name, "EDOM")) +#ifdef EDOM + return EDOM; +#else + goto not_there; +#endif + break; + case 'E': + if (strEQ(name, "EEXIST")) +#ifdef EEXIST + return EEXIST; +#else + goto not_there; +#endif + break; + case 'F': + if (strEQ(name, "EFAULT")) +#ifdef EFAULT + return EFAULT; +#else + goto not_there; +#endif + if (strEQ(name, "EFBIG")) +#ifdef EFBIG + return EFBIG; +#else + goto not_there; +#endif + break; + case 'I': + if (strEQ(name, "EINTR")) +#ifdef EINTR + return EINTR; +#else + goto not_there; +#endif + if (strEQ(name, "EINVAL")) +#ifdef EINVAL + return EINVAL; +#else + goto not_there; +#endif + if (strEQ(name, "EIO")) +#ifdef EIO + return EIO; +#else + goto not_there; +#endif + if (strEQ(name, "EISDIR")) +#ifdef EISDIR + return EISDIR; +#else + goto not_there; +#endif + break; + case 'M': + if (strEQ(name, "EMFILE")) +#ifdef EMFILE + return EMFILE; +#else + goto not_there; +#endif + if (strEQ(name, "EMLINK")) +#ifdef EMLINK + return EMLINK; +#else + goto not_there; +#endif + break; + case 'N': + if (strEQ(name, "ENOMEM")) +#ifdef ENOMEM + return ENOMEM; +#else + goto not_there; +#endif + if (strEQ(name, "ENOSPC")) +#ifdef ENOSPC + return ENOSPC; +#else + goto not_there; +#endif + if (strEQ(name, "ENOEXEC")) +#ifdef ENOEXEC + return ENOEXEC; +#else + goto not_there; +#endif + if (strEQ(name, "ENOTTY")) +#ifdef ENOTTY + return ENOTTY; +#else + goto not_there; +#endif + if (strEQ(name, "ENOTDIR")) +#ifdef ENOTDIR + return ENOTDIR; +#else + goto not_there; +#endif + if (strEQ(name, "ENOTEMPTY")) +#ifdef ENOTEMPTY + return ENOTEMPTY; +#else + goto not_there; +#endif + if (strEQ(name, "ENFILE")) +#ifdef ENFILE + return ENFILE; +#else + goto not_there; +#endif + if (strEQ(name, "ENODEV")) +#ifdef ENODEV + return ENODEV; +#else + goto not_there; +#endif + if (strEQ(name, "ENOENT")) +#ifdef ENOENT + return ENOENT; +#else + goto not_there; +#endif + if (strEQ(name, "ENOLCK")) +#ifdef ENOLCK + return ENOLCK; +#else + goto not_there; +#endif + if (strEQ(name, "ENOSYS")) +#ifdef ENOSYS + return ENOSYS; +#else + goto not_there; +#endif + if (strEQ(name, "ENXIO")) +#ifdef ENXIO + return ENXIO; +#else + goto not_there; +#endif + if (strEQ(name, "ENAMETOOLONG")) +#ifdef ENAMETOOLONG + return ENAMETOOLONG; +#else + goto not_there; +#endif + break; + case 'O': + if (strEQ(name, "EOF")) +#ifdef EOF + return EOF; +#else + goto not_there; +#endif + break; + case 'P': + if (strEQ(name, "EPERM")) +#ifdef EPERM + return EPERM; +#else + goto not_there; +#endif + if (strEQ(name, "EPIPE")) +#ifdef EPIPE + return EPIPE; +#else + goto not_there; +#endif + break; + case 'R': + if (strEQ(name, "ERANGE")) +#ifdef ERANGE + return ERANGE; +#else + goto not_there; +#endif + if (strEQ(name, "EROFS")) +#ifdef EROFS + return EROFS; +#else + goto not_there; +#endif + break; + case 'S': + if (strEQ(name, "ESPIPE")) +#ifdef ESPIPE + return ESPIPE; +#else + goto not_there; +#endif + if (strEQ(name, "ESRCH")) +#ifdef ESRCH + return ESRCH; +#else + goto not_there; +#endif + break; + case 'X': + if (strEQ(name, "EXIT_FAILURE")) +#ifdef EXIT_FAILURE + return EXIT_FAILURE; +#else + return 1; +#endif + if (strEQ(name, "EXIT_SUCCESS")) +#ifdef EXIT_SUCCESS + return EXIT_SUCCESS; +#else + return 0; +#endif + if (strEQ(name, "EXDEV")) +#ifdef EXDEV + return EXDEV; +#else + goto not_there; +#endif + break; + } + if (strEQ(name, "E2BIG")) +#ifdef E2BIG + return E2BIG; +#else + goto not_there; +#endif + break; + case 'F': + if (strnEQ(name, "FLT_", 4)) { + if (strEQ(name, "FLT_MAX")) +#ifdef FLT_MAX + return FLT_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "FLT_MIN")) +#ifdef FLT_MIN + return FLT_MIN; +#else + goto not_there; +#endif + if (strEQ(name, "FLT_ROUNDS")) +#ifdef FLT_ROUNDS + return FLT_ROUNDS; +#else + goto not_there; +#endif + if (strEQ(name, "FLT_DIG")) +#ifdef FLT_DIG + return FLT_DIG; +#else + goto not_there; +#endif + if (strEQ(name, "FLT_EPSILON")) +#ifdef FLT_EPSILON + return FLT_EPSILON; +#else + goto not_there; +#endif + if (strEQ(name, "FLT_MANT_DIG")) +#ifdef FLT_MANT_DIG + return FLT_MANT_DIG; +#else + goto not_there; +#endif + if (strEQ(name, "FLT_MAX_10_EXP")) +#ifdef FLT_MAX_10_EXP + return FLT_MAX_10_EXP; +#else + goto not_there; +#endif + if (strEQ(name, "FLT_MAX_EXP")) +#ifdef FLT_MAX_EXP + return FLT_MAX_EXP; +#else + goto not_there; +#endif + if (strEQ(name, "FLT_MIN_10_EXP")) +#ifdef FLT_MIN_10_EXP + return FLT_MIN_10_EXP; +#else + goto not_there; +#endif + if (strEQ(name, "FLT_MIN_EXP")) +#ifdef FLT_MIN_EXP + return FLT_MIN_EXP; +#else + goto not_there; +#endif + if (strEQ(name, "FLT_RADIX")) +#ifdef FLT_RADIX + return FLT_RADIX; +#else + goto not_there; +#endif + break; + } + if (strnEQ(name, "F_", 2)) { + if (strEQ(name, "F_DUPFD")) +#ifdef F_DUPFD + return F_DUPFD; +#else + goto not_there; +#endif + if (strEQ(name, "F_GETFD")) +#ifdef F_GETFD + return F_GETFD; +#else + goto not_there; +#endif + if (strEQ(name, "F_GETFL")) +#ifdef F_GETFL + return F_GETFL; +#else + goto not_there; +#endif + if (strEQ(name, "F_GETLK")) +#ifdef F_GETLK + return F_GETLK; +#else + goto not_there; +#endif + if (strEQ(name, "F_OK")) +#ifdef F_OK + return F_OK; +#else + goto not_there; +#endif + if (strEQ(name, "F_RDLCK")) +#ifdef F_RDLCK + return F_RDLCK; +#else + goto not_there; +#endif + if (strEQ(name, "F_SETFD")) +#ifdef F_SETFD + return F_SETFD; +#else + goto not_there; +#endif + if (strEQ(name, "F_SETFL")) +#ifdef F_SETFL + return F_SETFL; +#else + goto not_there; +#endif + if (strEQ(name, "F_SETLK")) +#ifdef F_SETLK + return F_SETLK; +#else + goto not_there; +#endif + if (strEQ(name, "F_SETLKW")) +#ifdef F_SETLKW + return F_SETLKW; +#else + goto not_there; +#endif + if (strEQ(name, "F_UNLCK")) +#ifdef F_UNLCK + return F_UNLCK; +#else + goto not_there; +#endif + if (strEQ(name, "F_WRLCK")) +#ifdef F_WRLCK + return F_WRLCK; +#else + goto not_there; +#endif + break; + } + if (strEQ(name, "FD_CLOEXEC")) return FD_CLOEXEC; + if (strEQ(name, "FILENAME_MAX")) +#ifdef FILENAME_MAX + return FILENAME_MAX; +#else + goto not_there; +#endif + break; + case 'H': + if (strEQ(name, "HUGE_VAL")) +#ifdef HUGE_VAL + return HUGE_VAL; +#else + goto not_there; +#endif + if (strEQ(name, "HUPCL")) +#ifdef HUPCL + return HUPCL; +#else + goto not_there; +#endif + break; + case 'I': + if (strEQ(name, "INT_MAX")) +#ifdef INT_MAX + return INT_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "INT_MIN")) +#ifdef INT_MIN + return INT_MIN; +#else + goto not_there; +#endif + if (strEQ(name, "ICANON")) +#ifdef ICANON + return ICANON; +#else + goto not_there; +#endif + if (strEQ(name, "ICRNL")) +#ifdef ICRNL + return ICRNL; +#else + goto not_there; +#endif + if (strEQ(name, "IEXTEN")) +#ifdef IEXTEN + return IEXTEN; +#else + goto not_there; +#endif + if (strEQ(name, "IGNBRK")) +#ifdef IGNBRK + return IGNBRK; +#else + goto not_there; +#endif + if (strEQ(name, "IGNCR")) +#ifdef IGNCR + return IGNCR; +#else + goto not_there; +#endif + if (strEQ(name, "IGNPAR")) +#ifdef IGNPAR + return IGNPAR; +#else + goto not_there; +#endif + if (strEQ(name, "INLCR")) +#ifdef INLCR + return INLCR; +#else + goto not_there; +#endif + if (strEQ(name, "INPCK")) +#ifdef INPCK + return INPCK; +#else + goto not_there; +#endif + if (strEQ(name, "ISIG")) +#ifdef ISIG + return ISIG; +#else + goto not_there; +#endif + if (strEQ(name, "ISTRIP")) +#ifdef ISTRIP + return ISTRIP; +#else + goto not_there; +#endif + if (strEQ(name, "IXOFF")) +#ifdef IXOFF + return IXOFF; +#else + goto not_there; +#endif + if (strEQ(name, "IXON")) +#ifdef IXON + return IXON; +#else + goto not_there; +#endif + break; + case 'L': + if (strnEQ(name, "LC_", 3)) { + if (strEQ(name, "LC_ALL")) +#ifdef LC_ALL + return LC_ALL; +#else + goto not_there; +#endif + if (strEQ(name, "LC_COLLATE")) +#ifdef LC_COLLATE + return LC_COLLATE; +#else + goto not_there; +#endif + if (strEQ(name, "LC_CTYPE")) +#ifdef LC_CTYPE + return LC_CTYPE; +#else + goto not_there; +#endif + if (strEQ(name, "LC_MONETARY")) +#ifdef LC_MONETARY + return LC_MONETARY; +#else + goto not_there; +#endif + if (strEQ(name, "LC_NUMERIC")) +#ifdef LC_NUMERIC + return LC_NUMERIC; +#else + goto not_there; +#endif + if (strEQ(name, "LC_TIME")) +#ifdef LC_TIME + return LC_TIME; +#else + goto not_there; +#endif + break; + } + if (strnEQ(name, "LDBL_", 5)) { + if (strEQ(name, "LDBL_MAX")) +#ifdef LDBL_MAX + return LDBL_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "LDBL_MIN")) +#ifdef LDBL_MIN + return LDBL_MIN; +#else + goto not_there; +#endif + if (strEQ(name, "LDBL_DIG")) +#ifdef LDBL_DIG + return LDBL_DIG; +#else + goto not_there; +#endif + if (strEQ(name, "LDBL_EPSILON")) +#ifdef LDBL_EPSILON + return LDBL_EPSILON; +#else + goto not_there; +#endif + if (strEQ(name, "LDBL_MANT_DIG")) +#ifdef LDBL_MANT_DIG + return LDBL_MANT_DIG; +#else + goto not_there; +#endif + if (strEQ(name, "LDBL_MAX_10_EXP")) +#ifdef LDBL_MAX_10_EXP + return LDBL_MAX_10_EXP; +#else + goto not_there; +#endif + if (strEQ(name, "LDBL_MAX_EXP")) +#ifdef LDBL_MAX_EXP + return LDBL_MAX_EXP; +#else + goto not_there; +#endif + if (strEQ(name, "LDBL_MIN_10_EXP")) +#ifdef LDBL_MIN_10_EXP + return LDBL_MIN_10_EXP; +#else + goto not_there; +#endif + if (strEQ(name, "LDBL_MIN_EXP")) +#ifdef LDBL_MIN_EXP + return LDBL_MIN_EXP; +#else + goto not_there; +#endif + break; + } + if (strnEQ(name, "L_", 2)) { + if (strEQ(name, "L_ctermid")) +#ifdef L_ctermid + return L_ctermid; +#else + goto not_there; +#endif + if (strEQ(name, "L_cuserid")) +#ifdef L_cuserid + return L_cuserid; +#else + goto not_there; +#endif + if (strEQ(name, "L_tmpname")) +#ifdef L_tmpname + return L_tmpname; +#else + goto not_there; +#endif + break; + } + if (strEQ(name, "LONG_MAX")) +#ifdef LONG_MAX + return LONG_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "LONG_MIN")) +#ifdef LONG_MIN + return LONG_MIN; +#else + goto not_there; +#endif + if (strEQ(name, "LINK_MAX")) +#ifdef LINK_MAX + return LINK_MAX; +#else + goto not_there; +#endif + break; + case 'M': + if (strEQ(name, "MAX_CANON")) +#ifdef MAX_CANON + return MAX_CANON; +#else + goto not_there; +#endif + if (strEQ(name, "MAX_INPUT")) +#ifdef MAX_INPUT + return MAX_INPUT; +#else + goto not_there; +#endif + if (strEQ(name, "MB_CUR_MAX")) +#ifdef MB_CUR_MAX + return MB_CUR_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "MB_LEN_MAX")) +#ifdef MB_LEN_MAX + return MB_LEN_MAX; +#else + goto not_there; +#endif + break; + case 'N': + if (strEQ(name, "NULL")) return 0; + if (strEQ(name, "NAME_MAX")) +#ifdef NAME_MAX + return NAME_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "NCCS")) +#ifdef NCCS + return NCCS; +#else + goto not_there; +#endif + if (strEQ(name, "NGROUPS_MAX")) +#ifdef NGROUPS_MAX + return NGROUPS_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "NOFLSH")) +#ifdef NOFLSH + return NOFLSH; +#else + goto not_there; +#endif + break; + case 'O': + if (strnEQ(name, "O_", 2)) { + if (strEQ(name, "O_APPEND")) +#ifdef O_APPEND + return O_APPEND; +#else + goto not_there; +#endif + if (strEQ(name, "O_CREAT")) +#ifdef O_CREAT + return O_CREAT; +#else + goto not_there; +#endif + if (strEQ(name, "O_TRUNC")) +#ifdef O_TRUNC + return O_TRUNC; +#else + goto not_there; +#endif + if (strEQ(name, "O_RDONLY")) +#ifdef O_RDONLY + return O_RDONLY; +#else + goto not_there; +#endif + if (strEQ(name, "O_RDWR")) +#ifdef O_RDWR + return O_RDWR; +#else + goto not_there; +#endif + if (strEQ(name, "O_WRONLY")) +#ifdef O_WRONLY + return O_WRONLY; +#else + goto not_there; +#endif + if (strEQ(name, "O_EXCL")) +#ifdef O_EXCL + return O_EXCL; +#else + goto not_there; +#endif + if (strEQ(name, "O_NOCTTY")) +#ifdef O_NOCTTY + return O_NOCTTY; +#else + goto not_there; +#endif + if (strEQ(name, "O_NONBLOCK")) +#ifdef O_NONBLOCK + return O_NONBLOCK; +#else + goto not_there; +#endif + if (strEQ(name, "O_ACCMODE")) +#ifdef O_ACCMODE + return O_ACCMODE; +#else + goto not_there; +#endif + break; + } + if (strEQ(name, "OPEN_MAX")) +#ifdef OPEN_MAX + return OPEN_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "OPOST")) +#ifdef OPOST + return OPOST; +#else + goto not_there; +#endif + break; + case 'P': + if (strEQ(name, "PATH_MAX")) +#ifdef PATH_MAX + return PATH_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "PARENB")) +#ifdef PARENB + return PARENB; +#else + goto not_there; +#endif + if (strEQ(name, "PARMRK")) +#ifdef PARMRK + return PARMRK; +#else + goto not_there; +#endif + if (strEQ(name, "PARODD")) +#ifdef PARODD + return PARODD; +#else + goto not_there; +#endif + if (strEQ(name, "PIPE_BUF")) +#ifdef PIPE_BUF + return PIPE_BUF; +#else + goto not_there; +#endif + break; + case 'R': + if (strEQ(name, "RAND_MAX")) +#ifdef RAND_MAX + return RAND_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "R_OK")) +#ifdef R_OK + return R_OK; +#else + goto not_there; +#endif + break; + case 'S': + if (strnEQ(name, "SIG", 3)) { + if (name[3] == '_') { + if (strEQ(name, "SIG_BLOCK")) +#ifdef SIG_BLOCK + return SIG_BLOCK; +#else + goto not_there; +#endif +#ifdef SIG_DFL + if (strEQ(name, "SIG_DFL")) return (int)SIG_DFL; +#endif +#ifdef SIG_ERR + if (strEQ(name, "SIG_ERR")) return (int)SIG_ERR; +#endif +#ifdef SIG_IGN + if (strEQ(name, "SIG_IGN")) return (int)SIG_IGN; +#endif + if (strEQ(name, "SIG_SETMASK")) +#ifdef SIG_SETMASK + return SIG_SETMASK; +#else + goto not_there; +#endif + if (strEQ(name, "SIG_UNBLOCK")) +#ifdef SIG_UNBLOCK + return SIG_UNBLOCK; +#else + goto not_there; +#endif + break; + } + if (strEQ(name, "SIGABRT")) +#ifdef SIGABRT + return SIGABRT; +#else + goto not_there; +#endif + if (strEQ(name, "SIGALRM")) +#ifdef SIGALRM + return SIGALRM; +#else + goto not_there; +#endif + if (strEQ(name, "SIGCHLD")) +#ifdef SIGCHLD + return SIGCHLD; +#else + goto not_there; +#endif + if (strEQ(name, "SIGCONT")) +#ifdef SIGCONT + return SIGCONT; +#else + goto not_there; +#endif + if (strEQ(name, "SIGFPE")) +#ifdef SIGFPE + return SIGFPE; +#else + goto not_there; +#endif + if (strEQ(name, "SIGHUP")) +#ifdef SIGHUP + return SIGHUP; +#else + goto not_there; +#endif + if (strEQ(name, "SIGILL")) +#ifdef SIGILL + return SIGILL; +#else + goto not_there; +#endif + if (strEQ(name, "SIGINT")) +#ifdef SIGINT + return SIGINT; +#else + goto not_there; +#endif + if (strEQ(name, "SIGKILL")) +#ifdef SIGKILL + return SIGKILL; +#else + goto not_there; +#endif + if (strEQ(name, "SIGPIPE")) +#ifdef SIGPIPE + return SIGPIPE; +#else + goto not_there; +#endif + if (strEQ(name, "SIGQUIT")) +#ifdef SIGQUIT + return SIGQUIT; +#else + goto not_there; +#endif + if (strEQ(name, "SIGSEGV")) +#ifdef SIGSEGV + return SIGSEGV; +#else + goto not_there; +#endif + if (strEQ(name, "SIGSTOP")) +#ifdef SIGSTOP + return SIGSTOP; +#else + goto not_there; +#endif + if (strEQ(name, "SIGTERM")) +#ifdef SIGTERM + return SIGTERM; +#else + goto not_there; +#endif + if (strEQ(name, "SIGTSTP")) +#ifdef SIGTSTP + return SIGTSTP; +#else + goto not_there; +#endif + if (strEQ(name, "SIGTTIN")) +#ifdef SIGTTIN + return SIGTTIN; +#else + goto not_there; +#endif + if (strEQ(name, "SIGTTOU")) +#ifdef SIGTTOU + return SIGTTOU; +#else + goto not_there; +#endif + if (strEQ(name, "SIGUSR1")) +#ifdef SIGUSR1 + return SIGUSR1; +#else + goto not_there; +#endif + if (strEQ(name, "SIGUSR2")) +#ifdef SIGUSR2 + return SIGUSR2; +#else + goto not_there; +#endif + break; + } + if (name[1] == '_') { +#ifdef S_ISBLK + if (strEQ(name, "S_ISBLK")) return S_ISBLK(arg); +#endif +#ifdef S_ISCHR + if (strEQ(name, "S_ISCHR")) return S_ISCHR(arg); +#endif +#ifdef S_ISDIR + if (strEQ(name, "S_ISDIR")) return S_ISDIR(arg); +#endif +#ifdef S_ISFIFO + if (strEQ(name, "S_ISFIFO")) return S_ISFIFO(arg); +#endif +#ifdef S_ISREG + if (strEQ(name, "S_ISREG")) return S_ISREG(arg); +#endif + if (strEQ(name, "S_ISGID")) +#ifdef S_ISGID + return S_ISGID; +#else + goto not_there; +#endif + if (strEQ(name, "S_ISUID")) +#ifdef S_ISUID + return S_ISUID; +#else + goto not_there; +#endif + if (strEQ(name, "S_IRGRP")) +#ifdef S_IRGRP + return S_IRGRP; +#else + goto not_there; +#endif + if (strEQ(name, "S_IROTH")) +#ifdef S_IROTH + return S_IROTH; +#else + goto not_there; +#endif + if (strEQ(name, "S_IRUSR")) +#ifdef S_IRUSR + return S_IRUSR; +#else + goto not_there; +#endif + if (strEQ(name, "S_IRWXG")) +#ifdef S_IRWXG + return S_IRWXG; +#else + goto not_there; +#endif + if (strEQ(name, "S_IRWXO")) +#ifdef S_IRWXO + return S_IRWXO; +#else + goto not_there; +#endif + if (strEQ(name, "S_IRWXU")) +#ifdef S_IRWXU + return S_IRWXU; +#else + goto not_there; +#endif + if (strEQ(name, "S_IWGRP")) +#ifdef S_IWGRP + return S_IWGRP; +#else + goto not_there; +#endif + if (strEQ(name, "S_IWOTH")) +#ifdef S_IWOTH + return S_IWOTH; +#else + goto not_there; +#endif + if (strEQ(name, "S_IWUSR")) +#ifdef S_IWUSR + return S_IWUSR; +#else + goto not_there; +#endif + if (strEQ(name, "S_IXGRP")) +#ifdef S_IXGRP + return S_IXGRP; +#else + goto not_there; +#endif + if (strEQ(name, "S_IXOTH")) +#ifdef S_IXOTH + return S_IXOTH; +#else + goto not_there; +#endif + if (strEQ(name, "S_IXUSR")) +#ifdef S_IXUSR + return S_IXUSR; +#else + goto not_there; +#endif + break; + } + if (strEQ(name, "SEEK_CUR")) +#ifdef SEEK_CUR + return SEEK_CUR; +#else + goto not_there; +#endif + if (strEQ(name, "SEEK_END")) +#ifdef SEEK_END + return SEEK_END; +#else + goto not_there; +#endif + if (strEQ(name, "SEEK_SET")) +#ifdef SEEK_SET + return SEEK_SET; +#else + goto not_there; +#endif + if (strEQ(name, "STREAM_MAX")) +#ifdef STREAM_MAX + return STREAM_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "SHRT_MAX")) +#ifdef SHRT_MAX + return SHRT_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "SHRT_MIN")) +#ifdef SHRT_MIN + return SHRT_MIN; +#else + goto not_there; +#endif + if (strEQ(name, "SA_NOCLDSTOP")) +#ifdef SA_NOCLDSTOP + return SA_NOCLDSTOP; +#else + goto not_there; +#endif + if (strEQ(name, "SCHAR_MAX")) +#ifdef SCHAR_MAX + return SCHAR_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "SCHAR_MIN")) +#ifdef SCHAR_MIN + return SCHAR_MIN; +#else + goto not_there; +#endif + if (strEQ(name, "SSIZE_MAX")) +#ifdef SSIZE_MAX + return SSIZE_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "STDIN_FILENO")) +#ifdef STDIN_FILENO + return STDIN_FILENO; +#else + goto not_there; +#endif + if (strEQ(name, "STDOUT_FILENO")) +#ifdef STDOUT_FILENO + return STDOUT_FILENO; +#else + goto not_there; +#endif + if (strEQ(name, "STRERR_FILENO")) +#ifdef STRERR_FILENO + return STRERR_FILENO; +#else + goto not_there; +#endif + break; + case 'T': + if (strEQ(name, "TCIFLUSH")) +#ifdef TCIFLUSH + return TCIFLUSH; +#else + goto not_there; +#endif + if (strEQ(name, "TCIOFF")) +#ifdef TCIOFF + return TCIOFF; +#else + goto not_there; +#endif + if (strEQ(name, "TCIOFLUSH")) +#ifdef TCIOFLUSH + return TCIOFLUSH; +#else + goto not_there; +#endif + if (strEQ(name, "TCION")) +#ifdef TCION + return TCION; +#else + goto not_there; +#endif + if (strEQ(name, "TCOFLUSH")) +#ifdef TCOFLUSH + return TCOFLUSH; +#else + goto not_there; +#endif + if (strEQ(name, "TCOOFF")) +#ifdef TCOOFF + return TCOOFF; +#else + goto not_there; +#endif + if (strEQ(name, "TCOON")) +#ifdef TCOON + return TCOON; +#else + goto not_there; +#endif + if (strEQ(name, "TCSADRAIN")) +#ifdef TCSADRAIN + return TCSADRAIN; +#else + goto not_there; +#endif + if (strEQ(name, "TCSAFLUSH")) +#ifdef TCSAFLUSH + return TCSAFLUSH; +#else + goto not_there; +#endif + if (strEQ(name, "TCSANOW")) +#ifdef TCSANOW + return TCSANOW; +#else + goto not_there; +#endif + if (strEQ(name, "TMP_MAX")) +#ifdef TMP_MAX + return TMP_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "TOSTOP")) +#ifdef TOSTOP + return TOSTOP; +#else + goto not_there; +#endif + if (strEQ(name, "TZNAME_MAX")) +#ifdef TZNAME_MAX + return TZNAME_MAX; +#else + goto not_there; +#endif + break; + case 'U': + if (strEQ(name, "UCHAR_MAX")) +#ifdef UCHAR_MAX + return UCHAR_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "UINT_MAX")) +#ifdef UINT_MAX + return UINT_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "ULONG_MAX")) +#ifdef ULONG_MAX + return ULONG_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "USHRT_MAX")) +#ifdef USHRT_MAX + return USHRT_MAX; +#else + goto not_there; +#endif + break; + case 'V': + if (strEQ(name, "VEOF")) +#ifdef VEOF + return VEOF; +#else + goto not_there; +#endif + if (strEQ(name, "VEOL")) +#ifdef VEOL + return VEOL; +#else + goto not_there; +#endif + if (strEQ(name, "VERASE")) +#ifdef VERASE + return VERASE; +#else + goto not_there; +#endif + if (strEQ(name, "VINTR")) +#ifdef VINTR + return VINTR; +#else + goto not_there; +#endif + if (strEQ(name, "VKILL")) +#ifdef VKILL + return VKILL; +#else + goto not_there; +#endif + if (strEQ(name, "VMIN")) +#ifdef VMIN + return VMIN; +#else + goto not_there; +#endif + if (strEQ(name, "VQUIT")) +#ifdef VQUIT + return VQUIT; +#else + goto not_there; +#endif + if (strEQ(name, "VSTART")) +#ifdef VSTART + return VSTART; +#else + goto not_there; +#endif + if (strEQ(name, "VSTOP")) +#ifdef VSTOP + return VSTOP; +#else + goto not_there; +#endif + if (strEQ(name, "VSUSP")) +#ifdef VSUSP + return VSUSP; +#else + goto not_there; +#endif + if (strEQ(name, "VTIME")) +#ifdef VTIME + return VTIME; +#else + goto not_there; +#endif + break; + case 'W': + if (strEQ(name, "W_OK")) +#ifdef W_OK + return W_OK; +#else + goto not_there; +#endif +#ifdef WEXITSTATUS + if (strEQ(name, "WEXITSTATUS")) return WEXITSTATUS(arg); +#endif +#ifdef WIFEXITED + if (strEQ(name, "WIFEXITED")) return WIFEXITED(arg); +#endif +#ifdef WIFSIGNALED + if (strEQ(name, "WIFSIGNALED")) return WIFSIGNALED(arg); +#endif +#ifdef WIFSTOPPED + if (strEQ(name, "WIFSTOPPED")) return WIFSTOPPED(arg); +#endif + if (strEQ(name, "WNOHANG")) +#ifdef WNOHANG + return WNOHANG; +#else + goto not_there; +#endif +#ifdef WSTOPSIG + if (strEQ(name, "WSTOPSIG")) return WSTOPSIG(arg); +#endif +#ifdef WTERMSIG + if (strEQ(name, "WTERMSIG")) return WTERMSIG(arg); +#endif + if (strEQ(name, "WUNTRACED")) +#ifdef WUNTRACED + return WUNTRACED; +#else + goto not_there; +#endif + break; + case 'X': + if (strEQ(name, "X_OK")) +#ifdef X_OK + return X_OK; +#else + goto not_there; +#endif + break; + case '_': + if (strnEQ(name, "_PC_", 4)) { + if (strEQ(name, "_PC_CHOWN_RESTRICTED")) +#ifdef _PC_CHOWN_RESTRICTED + return _PC_CHOWN_RESTRICTED; +#else + goto not_there; +#endif + if (strEQ(name, "_PC_LINK_MAX")) +#ifdef _PC_LINK_MAX + return _PC_LINK_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "_PC_MAX_CANON")) +#ifdef _PC_MAX_CANON + return _PC_MAX_CANON; +#else + goto not_there; +#endif + if (strEQ(name, "_PC_MAX_INPUT")) +#ifdef _PC_MAX_INPUT + return _PC_MAX_INPUT; +#else + goto not_there; +#endif + if (strEQ(name, "_PC_NAME_MAX")) +#ifdef _PC_NAME_MAX + return _PC_NAME_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "_PC_NO_TRUNC")) +#ifdef _PC_NO_TRUNC + return _PC_NO_TRUNC; +#else + goto not_there; +#endif + if (strEQ(name, "_PC_PATH_MAX")) +#ifdef _PC_PATH_MAX + return _PC_PATH_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "_PC_PIPE_BUF")) +#ifdef _PC_PIPE_BUF + return _PC_PIPE_BUF; +#else + goto not_there; +#endif + if (strEQ(name, "_PC_VDISABLE")) +#ifdef _PC_VDISABLE + return _PC_VDISABLE; +#else + goto not_there; +#endif + break; + } + if (strnEQ(name, "_POSIX_", 7)) { + if (strEQ(name, "_POSIX_ARG_MAX")) +#ifdef _POSIX_ARG_MAX + return _POSIX_ARG_MAX; +#else + return 0; +#endif + if (strEQ(name, "_POSIX_CHILD_MAX")) +#ifdef _POSIX_CHILD_MAX + return _POSIX_CHILD_MAX; +#else + return 0; +#endif + if (strEQ(name, "_POSIX_CHOWN_RESTRICTED")) +#ifdef _POSIX_CHOWN_RESTRICTED + return _POSIX_CHOWN_RESTRICTED; +#else + return 0; +#endif + if (strEQ(name, "_POSIX_JOB_CONTROL")) +#ifdef _POSIX_JOB_CONTROL + return _POSIX_JOB_CONTROL; +#else + return 0; +#endif + if (strEQ(name, "_POSIX_LINK_MAX")) +#ifdef _POSIX_LINK_MAX + return _POSIX_LINK_MAX; +#else + return 0; +#endif + if (strEQ(name, "_POSIX_MAX_CANON")) +#ifdef _POSIX_MAX_CANON + return _POSIX_MAX_CANON; +#else + return 0; +#endif + if (strEQ(name, "_POSIX_MAX_INPUT")) +#ifdef _POSIX_MAX_INPUT + return _POSIX_MAX_INPUT; +#else + return 0; +#endif + if (strEQ(name, "_POSIX_NAME_MAX")) +#ifdef _POSIX_NAME_MAX + return _POSIX_NAME_MAX; +#else + return 0; +#endif + if (strEQ(name, "_POSIX_NGROUPS_MAX")) +#ifdef _POSIX_NGROUPS_MAX + return _POSIX_NGROUPS_MAX; +#else + return 0; +#endif + if (strEQ(name, "_POSIX_NO_TRUNC")) +#ifdef _POSIX_NO_TRUNC + return _POSIX_NO_TRUNC; +#else + return 0; +#endif + if (strEQ(name, "_POSIX_OPEN_MAX")) +#ifdef _POSIX_OPEN_MAX + return _POSIX_OPEN_MAX; +#else + return 0; +#endif + if (strEQ(name, "_POSIX_PATH_MAX")) +#ifdef _POSIX_PATH_MAX + return _POSIX_PATH_MAX; +#else + return 0; +#endif + if (strEQ(name, "_POSIX_PIPE_BUF")) +#ifdef _POSIX_PIPE_BUF + return _POSIX_PIPE_BUF; +#else + return 0; +#endif + if (strEQ(name, "_POSIX_SAVED_IDS")) +#ifdef _POSIX_SAVED_IDS + return _POSIX_SAVED_IDS; +#else + return 0; +#endif + if (strEQ(name, "_POSIX_SSIZE_MAX")) +#ifdef _POSIX_SSIZE_MAX + return _POSIX_SSIZE_MAX; +#else + return 0; +#endif + if (strEQ(name, "_POSIX_STREAM_MAX")) +#ifdef _POSIX_STREAM_MAX + return _POSIX_STREAM_MAX; +#else + return 0; +#endif + if (strEQ(name, "_POSIX_TZNAME_MAX")) +#ifdef _POSIX_TZNAME_MAX + return _POSIX_TZNAME_MAX; +#else + return 0; +#endif + if (strEQ(name, "_POSIX_VDISABLE")) +#ifdef _POSIX_VDISABLE + return _POSIX_VDISABLE; +#else + return 0; +#endif + if (strEQ(name, "_POSIX_VERSION")) +#ifdef _POSIX_VERSION + return _POSIX_VERSION; +#else + return 0; +#endif + break; + } + if (strnEQ(name, "_SC_", 4)) { + if (strEQ(name, "_SC_ARG_MAX")) +#ifdef _SC_ARG_MAX + return _SC_ARG_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "_SC_CHILD_MAX")) +#ifdef _SC_CHILD_MAX + return _SC_CHILD_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "_SC_CLK_TCK")) +#ifdef _SC_CLK_TCK + return _SC_CLK_TCK; +#else + goto not_there; +#endif + if (strEQ(name, "_SC_JOB_CONTROL")) +#ifdef _SC_JOB_CONTROL + return _SC_JOB_CONTROL; +#else + goto not_there; +#endif + if (strEQ(name, "_SC_NGROUPS_MAX")) +#ifdef _SC_NGROUPS_MAX + return _SC_NGROUPS_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "_SC_OPEN_MAX")) +#ifdef _SC_OPEN_MAX + return _SC_OPEN_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "_SC_SAVED_IDS")) +#ifdef _SC_SAVED_IDS + return _SC_SAVED_IDS; +#else + goto not_there; +#endif + if (strEQ(name, "_SC_STREAM_MAX")) +#ifdef _SC_STREAM_MAX + return _SC_STREAM_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "_SC_TZNAME_MAX")) +#ifdef _SC_TZNAME_MAX + return _SC_TZNAME_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "_SC_VERSION")) +#ifdef _SC_VERSION + return _SC_VERSION; +#else + goto not_there; +#endif + break; + } + if (strEQ(name, "_IOFBF")) +#ifdef _IOFBF + return _IOFBF; +#else + goto not_there; +#endif + if (strEQ(name, "_IOLBF")) +#ifdef _IOLBF + return _IOLBF; +#else + goto not_there; +#endif + if (strEQ(name, "_IONBF")) +#ifdef _IONBF + return _IONBF; +#else + goto not_there; +#endif + break; + } + errno = EINVAL; + return 0; + +not_there: + errno = ENOENT; + return 0; +} + +MODULE = SigSet PACKAGE = POSIX::SigSet PREFIX = sig + +POSIX::SigSet +new(packname = "POSIX::SigSet", ...) + char * packname + CODE: + { + int i; + RETVAL = (sigset_t*)safemalloc(sizeof(sigset_t)); + sigemptyset(RETVAL); + for (i = 1; i < items; i++) + sigaddset(RETVAL, SvIV(ST(i))); + } + OUTPUT: + RETVAL + +void +DESTROY(sigset) + POSIX::SigSet sigset + CODE: + safefree((char *)sigset); + +SysRet +sigaddset(sigset, sig) + POSIX::SigSet sigset + int sig + +SysRet +sigdelset(sigset, sig) + POSIX::SigSet sigset + int sig + +SysRet +sigemptyset(sigset) + POSIX::SigSet sigset + +SysRet +sigfillset(sigset) + POSIX::SigSet sigset + +int +sigismember(sigset, sig) + POSIX::SigSet sigset + int sig + + +MODULE = Termios PACKAGE = POSIX::Termios PREFIX = cf + +POSIX::Termios +new(packname = "POSIX::Termios", ...) + char * packname + CODE: + { +#ifdef I_TERMIOS + RETVAL = (struct termios*)safemalloc(sizeof(struct termios)); +#else + not_here("termios"); +#endif + } + OUTPUT: + RETVAL + +void +DESTROY(termios_ref) + POSIX::Termios termios_ref + CODE: +#ifdef I_TERMIOS + safefree((char *)termios_ref); +#else + not_here("termios"); +#endif + +SysRet +getattr(termios_ref, fd = 0) + POSIX::Termios termios_ref + int fd + CODE: + RETVAL = tcgetattr(fd, termios_ref); + OUTPUT: + RETVAL + +SysRet +setattr(termios_ref, fd = 0, optional_actions = 0) + POSIX::Termios termios_ref + int fd + int optional_actions + CODE: + RETVAL = tcsetattr(fd, optional_actions, termios_ref); + OUTPUT: + RETVAL + +speed_t +cfgetispeed(termios_ref) + POSIX::Termios termios_ref + +speed_t +cfgetospeed(termios_ref) + POSIX::Termios termios_ref + +tcflag_t +getiflag(termios_ref) + POSIX::Termios termios_ref + CODE: +#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ + RETVAL = termios_ref->c_iflag; +#else + not_here("getiflag"); +#endif + OUTPUT: + RETVAL + +tcflag_t +getoflag(termios_ref) + POSIX::Termios termios_ref + CODE: +#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ + RETVAL = termios_ref->c_oflag; +#else + not_here("getoflag"); +#endif + OUTPUT: + RETVAL + +tcflag_t +getcflag(termios_ref) + POSIX::Termios termios_ref + CODE: +#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ + RETVAL = termios_ref->c_cflag; +#else + not_here("getcflag"); +#endif + OUTPUT: + RETVAL + +tcflag_t +getlflag(termios_ref) + POSIX::Termios termios_ref + CODE: +#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ + RETVAL = termios_ref->c_lflag; +#else + not_here("getlflag"); +#endif + OUTPUT: + RETVAL + +cc_t +getcc(termios_ref, ccix) + POSIX::Termios termios_ref + int ccix + CODE: +#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ + if (ccix >= NCCS) + croak("Bad getcc subscript"); + RETVAL = termios_ref->c_cc[ccix]; +#else + not_here("getcc"); +#endif + OUTPUT: + RETVAL + +SysRet +cfsetispeed(termios_ref, speed) + POSIX::Termios termios_ref + speed_t speed + +SysRet +cfsetospeed(termios_ref, speed) + POSIX::Termios termios_ref + speed_t speed + +void +setiflag(termios_ref, iflag) + POSIX::Termios termios_ref + tcflag_t iflag + CODE: +#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ + termios_ref->c_iflag = iflag; +#else + not_here("setiflag"); +#endif + +void +setoflag(termios_ref, oflag) + POSIX::Termios termios_ref + tcflag_t oflag + CODE: +#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ + termios_ref->c_oflag = oflag; +#else + not_here("setoflag"); +#endif + +void +setcflag(termios_ref, cflag) + POSIX::Termios termios_ref + tcflag_t cflag + CODE: +#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ + termios_ref->c_cflag = cflag; +#else + not_here("setcflag"); +#endif + +void +setlflag(termios_ref, lflag) + POSIX::Termios termios_ref + tcflag_t lflag + CODE: +#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ + termios_ref->c_lflag = lflag; +#else + not_here("setlflag"); +#endif + +void +setcc(termios_ref, ccix, cc) + POSIX::Termios termios_ref + int ccix + cc_t cc + CODE: +#ifdef I_TERMIOS /* References a termios structure member so ifdef it out. */ + if (ccix >= NCCS) + croak("Bad setcc subscript"); + termios_ref->c_cc[ccix] = cc; +#else + not_here("setcc"); +#endif + + + +MODULE = FileHandle PACKAGE = FileHandle PREFIX = f + +SV * +fgetpos(handle) + InputStream handle + CODE: + { + Fpos_t pos; + fgetpos(handle, &pos); + ST(0) = sv_2mortal(newSVpv((char*)&pos, sizeof(Fpos_t))); + } + +SysRet +fsetpos(handle, pos) + InputStream handle + SV * pos + CODE: + RETVAL = fsetpos(handle, (Fpos_t*)SvPVX(pos)); + OUTPUT: + RETVAL + +int +ungetc(handle, c) + InputStream handle + int c + CODE: + RETVAL = ungetc(c, handle); + OUTPUT: + RETVAL + +OutputStream +new_tmpfile() + CODE: + RETVAL = tmpfile(); + OUTPUT: + RETVAL + +int +ferror(handle) + InputStream handle + +SysRet +fflush(handle) + OutputStream handle + +void +setbuf(handle, buf) + OutputStream handle + char * buf = SvPOK(ST(1)) ? sv_grow(ST(1), BUFSIZ) : 0; + +SysRet +setvbuf(handle, buf, type, size) + OutputStream handle + char * buf = SvPOK(ST(1)) ? sv_grow(ST(1), SvIV(ST(3))) : 0; + int type + int size + +MODULE = POSIX PACKAGE = POSIX + +double +constant(name,arg) + char * name + int arg + +int +isalnum(charstring) + char * charstring + CODE: + char *s; + RETVAL = 1; + for (s = charstring; *s && RETVAL; s++) + if (!isalnum(*s)) + RETVAL = 0; + OUTPUT: + RETVAL + +int +isalpha(charstring) + char * charstring + CODE: + char *s; + RETVAL = 1; + for (s = charstring; *s && RETVAL; s++) + if (!isalpha(*s)) + RETVAL = 0; + OUTPUT: + RETVAL + +int +iscntrl(charstring) + char * charstring + CODE: + char *s; + RETVAL = 1; + for (s = charstring; *s && RETVAL; s++) + if (!iscntrl(*s)) + RETVAL = 0; + OUTPUT: + RETVAL + +int +isdigit(charstring) + char * charstring + CODE: + char *s; + RETVAL = 1; + for (s = charstring; *s && RETVAL; s++) + if (!isdigit(*s)) + RETVAL = 0; + OUTPUT: + RETVAL + +int +isgraph(charstring) + char * charstring + CODE: + char *s; + RETVAL = 1; + for (s = charstring; *s && RETVAL; s++) + if (!isgraph(*s)) + RETVAL = 0; + OUTPUT: + RETVAL + +int +islower(charstring) + char * charstring + CODE: + char *s; + RETVAL = 1; + for (s = charstring; *s && RETVAL; s++) + if (!islower(*s)) + RETVAL = 0; + OUTPUT: + RETVAL + +int +isprint(charstring) + char * charstring + CODE: + char *s; + RETVAL = 1; + for (s = charstring; *s && RETVAL; s++) + if (!isprint(*s)) + RETVAL = 0; + OUTPUT: + RETVAL + +int +ispunct(charstring) + char * charstring + CODE: + char *s; + RETVAL = 1; + for (s = charstring; *s && RETVAL; s++) + if (!ispunct(*s)) + RETVAL = 0; + OUTPUT: + RETVAL + +int +isspace(charstring) + char * charstring + CODE: + char *s; + RETVAL = 1; + for (s = charstring; *s && RETVAL; s++) + if (!isspace(*s)) + RETVAL = 0; + OUTPUT: + RETVAL + +int +isupper(charstring) + char * charstring + CODE: + char *s; + RETVAL = 1; + for (s = charstring; *s && RETVAL; s++) + if (!isupper(*s)) + RETVAL = 0; + OUTPUT: + RETVAL + +int +isxdigit(charstring) + char * charstring + CODE: + char *s; + RETVAL = 1; + for (s = charstring; *s && RETVAL; s++) + if (!isxdigit(*s)) + RETVAL = 0; + OUTPUT: + RETVAL + +SysRet +open(filename, flags = O_RDONLY, mode = 0666) + char * filename + int flags + Mode_t mode + +HV * +localeconv() + CODE: +#ifdef HAS_LOCALECONV + struct lconv *lcbuf; + RETVAL = newHV(); + if (lcbuf = localeconv()) { + /* the strings */ + if (lcbuf->decimal_point && *lcbuf->decimal_point) + hv_store(RETVAL, "decimal_point", 13, + newSVpv(lcbuf->decimal_point, 0), 0); + if (lcbuf->thousands_sep && *lcbuf->thousands_sep) + hv_store(RETVAL, "thousands_sep", 13, + newSVpv(lcbuf->thousands_sep, 0), 0); + if (lcbuf->grouping && *lcbuf->grouping) + hv_store(RETVAL, "grouping", 8, + newSVpv(lcbuf->grouping, 0), 0); + if (lcbuf->int_curr_symbol && *lcbuf->int_curr_symbol) + hv_store(RETVAL, "int_curr_symbol", 15, + newSVpv(lcbuf->int_curr_symbol, 0), 0); + if (lcbuf->currency_symbol && *lcbuf->currency_symbol) + hv_store(RETVAL, "currency_symbol", 15, + newSVpv(lcbuf->currency_symbol, 0), 0); + if (lcbuf->mon_decimal_point && *lcbuf->mon_decimal_point) + hv_store(RETVAL, "mon_decimal_point", 17, + newSVpv(lcbuf->mon_decimal_point, 0), 0); + if (lcbuf->mon_thousands_sep && *lcbuf->mon_thousands_sep) + hv_store(RETVAL, "mon_thousands_sep", 17, + newSVpv(lcbuf->mon_thousands_sep, 0), 0); + if (lcbuf->mon_grouping && *lcbuf->mon_grouping) + hv_store(RETVAL, "mon_grouping", 12, + newSVpv(lcbuf->mon_grouping, 0), 0); + if (lcbuf->positive_sign && *lcbuf->positive_sign) + hv_store(RETVAL, "positive_sign", 13, + newSVpv(lcbuf->positive_sign, 0), 0); + if (lcbuf->negative_sign && *lcbuf->negative_sign) + hv_store(RETVAL, "negative_sign", 13, + newSVpv(lcbuf->negative_sign, 0), 0); + /* the integers */ + if (lcbuf->int_frac_digits != CHAR_MAX) + hv_store(RETVAL, "int_frac_digits", 15, + newSViv(lcbuf->int_frac_digits), 0); + if (lcbuf->frac_digits != CHAR_MAX) + hv_store(RETVAL, "frac_digits", 11, + newSViv(lcbuf->frac_digits), 0); + if (lcbuf->p_cs_precedes != CHAR_MAX) + hv_store(RETVAL, "p_cs_precedes", 13, + newSViv(lcbuf->p_cs_precedes), 0); + if (lcbuf->p_sep_by_space != CHAR_MAX) + hv_store(RETVAL, "p_sep_by_space", 14, + newSViv(lcbuf->p_sep_by_space), 0); + if (lcbuf->n_cs_precedes != CHAR_MAX) + hv_store(RETVAL, "n_cs_precedes", 13, + newSViv(lcbuf->n_cs_precedes), 0); + if (lcbuf->n_sep_by_space != CHAR_MAX) + hv_store(RETVAL, "n_sep_by_space", 14, + newSViv(lcbuf->n_sep_by_space), 0); + if (lcbuf->p_sign_posn != CHAR_MAX) + hv_store(RETVAL, "p_sign_posn", 11, + newSViv(lcbuf->p_sign_posn), 0); + if (lcbuf->n_sign_posn != CHAR_MAX) + hv_store(RETVAL, "n_sign_posn", 11, + newSViv(lcbuf->n_sign_posn), 0); + } +#else + localeconv(); /* A stub to call not_here(). */ +#endif + OUTPUT: + RETVAL + +char * +setlocale(category, locale) + int category + char * locale + +double +acos(x) + double x + +double +asin(x) + double x + +double +atan(x) + double x + +double +ceil(x) + double x + +double +cosh(x) + double x + +double +floor(x) + double x + +double +fmod(x,y) + double x + double y + +void +frexp(x) + double x + PPCODE: + int expvar; + /* (We already know stack is long enough.) */ + PUSHs(sv_2mortal(newSVnv(frexp(x,&expvar)))); + PUSHs(sv_2mortal(newSViv(expvar))); + +double +ldexp(x,exp) + double x + int exp + +double +log10(x) + double x + +void +modf(x) + double x + PPCODE: + double intvar; + /* (We already know stack is long enough.) */ + PUSHs(sv_2mortal(newSVnv(modf(x,&intvar)))); + PUSHs(sv_2mortal(newSVnv(intvar))); + +double +sinh(x) + double x + +double +tanh(x) + double x + +SysRet +sigaction(sig, action, oldaction = 0) + int sig + POSIX::SigAction action + POSIX::SigAction oldaction + CODE: + +# This code is really grody because we're trying to make the signal +# interface look beautiful, which is hard. + + if (!siggv) + gv_fetchpv("SIG", TRUE, SVt_PVHV); + + { + struct sigaction act; + struct sigaction oact; + POSIX__SigSet sigset; + SV** svp; + SV** sigsvp = hv_fetch(GvHVn(siggv), + sig_name[sig], + strlen(sig_name[sig]), + TRUE); + + /* Remember old handler name if desired. */ + if (oldaction) { + char *hand = SvPVx(*sigsvp, na); + svp = hv_fetch(oldaction, "HANDLER", 7, TRUE); + sv_setpv(*svp, *hand ? hand : "DEFAULT"); + } + + if (action) { + /* Vector new handler through %SIG. (We always use sighandler + for the C signal handler, which reads %SIG to dispatch.) */ + svp = hv_fetch(action, "HANDLER", 7, FALSE); + if (!svp) + croak("Can't supply an action without a HANDLER"); + sv_setpv(*sigsvp, SvPV(*svp, na)); + mg_set(*sigsvp); /* handles DEFAULT and IGNORE */ + act.sa_handler = sighandler; + + /* Set up any desired mask. */ + svp = hv_fetch(action, "MASK", 4, FALSE); + if (svp && sv_isa(*svp, "POSIX::SigSet")) { + unsigned long tmp; + tmp = (unsigned long)SvNV((SV*)SvRV(*svp)); + sigset = (sigset_t*) tmp; + act.sa_mask = *sigset; + } + else + sigemptyset(& act.sa_mask); + + /* Set up any desired flags. */ + svp = hv_fetch(action, "FLAGS", 5, FALSE); + act.sa_flags = svp ? SvIV(*svp) : 0; + } + + /* Now work around sigaction oddities */ + if (action && oldaction) + RETVAL = sigaction(sig, & act, & oact); + else if (action) + RETVAL = sigaction(sig, & act, (struct sigaction*)0); + else if (oldaction) + RETVAL = sigaction(sig, (struct sigaction*)0, & oact); + else + RETVAL = -1; + + if (oldaction) { + /* Get back the mask. */ + svp = hv_fetch(oldaction, "MASK", 4, TRUE); + if (sv_isa(*svp, "POSIX::SigSet")) { + unsigned long tmp; + tmp = (unsigned long)SvNV((SV*)SvRV(*svp)); + sigset = (sigset_t*) tmp; + } + else { + sigset = (sigset_t*)safemalloc(sizeof(sigset_t)); + sv_setptrobj(*svp, sigset, "POSIX::SigSet"); + } + *sigset = oact.sa_mask; + + /* Get back the flags. */ + svp = hv_fetch(oldaction, "FLAGS", 5, TRUE); + sv_setiv(*svp, oact.sa_flags); + } + } + OUTPUT: + RETVAL + +SysRet +sigpending(sigset) + POSIX::SigSet sigset + +SysRet +sigprocmask(how, sigset, oldsigset = 0) + int how + POSIX::SigSet sigset + POSIX::SigSet oldsigset + +SysRet +sigsuspend(signal_mask) + POSIX::SigSet signal_mask + +void +_exit(status) + int status + +SysRet +close(fd) + int fd + +SysRet +dup(fd) + int fd + +SysRet +dup2(fd1, fd2) + int fd1 + int fd2 + +SysRet +lseek(fd, offset, whence) + int fd + Off_t offset + int whence + +SysRet +nice(incr) + int incr + +int +pipe() + PPCODE: + int fds[2]; + if (pipe(fds) != -1) { + EXTEND(sp,2); + PUSHs(sv_2mortal(newSViv(fds[0]))); + PUSHs(sv_2mortal(newSViv(fds[1]))); + } + +SysRet +read(fd, buffer, nbytes) + int fd + char * buffer = sv_grow(ST(1),SvIV(ST(2))+1); + size_t nbytes + CLEANUP: + if (RETVAL >= 0) { + SvCUR(ST(1)) = RETVAL; + SvPOK_only(ST(1)); + *SvEND(ST(1)) = '\0'; + if (tainting) + sv_magic(ST(1), 0, 't', 0, 0); + } + +SysRet +setgid(gid) + Gid_t gid + +SysRet +setpgid(pid, pgid) + pid_t pid + pid_t pgid + +pid_t +setsid() + +SysRet +setuid(uid) + Uid_t uid + +pid_t +tcgetpgrp(fd) + int fd + +SysRet +tcsetpgrp(fd, pgrp_id) + int fd + pid_t pgrp_id + +int +uname() + PPCODE: +#ifdef HAS_UNAME + struct utsname buf; + if (uname(&buf) >= 0) { + EXTEND(sp, 5); + PUSHs(sv_2mortal(newSVpv(buf.sysname, 0))); + PUSHs(sv_2mortal(newSVpv(buf.nodename, 0))); + PUSHs(sv_2mortal(newSVpv(buf.release, 0))); + PUSHs(sv_2mortal(newSVpv(buf.version, 0))); + PUSHs(sv_2mortal(newSVpv(buf.machine, 0))); + } +#else + uname((char *) 0); /* A stub to call not_here(). */ +#endif + +SysRet +write(fd, buffer, nbytes) + int fd + char * buffer + size_t nbytes + +char * +tmpnam(s = 0) + char * s = 0; + +void +abort() + +int +mblen(s, n) + char * s + size_t n + +size_t +mbstowcs(s, pwcs, n) + wchar_t * s + char * pwcs + size_t n + +int +mbtowc(pwc, s, n) + wchar_t * pwc + char * s + size_t n + +int +wcstombs(s, pwcs, n) + char * s + wchar_t * pwcs + size_t n + +int +wctomb(s, wchar) + char * s + wchar_t wchar + +int +strcoll(s1, s2) + char * s1 + char * s2 + +SV * +strxfrm(src) + SV * src + CODE: + { + STRLEN srclen; + STRLEN dstlen; + char *p = SvPV(src,srclen); + srclen++; + ST(0) = sv_2mortal(newSV(srclen)); + dstlen = strxfrm(SvPVX(ST(0)), p, (size_t)srclen); + if (dstlen > srclen) { + dstlen++; + SvGROW(ST(0), dstlen); + strxfrm(SvPVX(ST(0)), p, (size_t)dstlen); + dstlen--; + } + SvCUR(ST(0)) = dstlen; + SvPOK_only(ST(0)); + } + +SysRet +mkfifo(filename, mode) + char * filename + Mode_t mode + +SysRet +tcdrain(fd) + int fd + + +SysRet +tcflow(fd, action) + int fd + int action + + +SysRet +tcflush(fd, queue_selector) + int fd + int queue_selector + +SysRet +tcsendbreak(fd, duration) + int fd + int duration + +char * +asctime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0) + int sec + int min + int hour + int mday + int mon + int year + int wday + int yday + int isdst + CODE: + { + struct tm mytm; + mytm.tm_sec = sec; + mytm.tm_min = min; + mytm.tm_hour = hour; + mytm.tm_mday = mday; + mytm.tm_mon = mon; + mytm.tm_year = year; + mytm.tm_wday = wday; + mytm.tm_yday = yday; + mytm.tm_isdst = isdst; + RETVAL = asctime(&mytm); + } + OUTPUT: + RETVAL + +long +clock() + +char * +ctime(time) + Time_t * time + +double +difftime(time1, time2) + Time_t time1 + Time_t time2 + +SysRetLong +mktime(sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0) + int sec + int min + int hour + int mday + int mon + int year + int wday + int yday + int isdst + CODE: + { + struct tm mytm; + mytm.tm_sec = sec; + mytm.tm_min = min; + mytm.tm_hour = hour; + mytm.tm_mday = mday; + mytm.tm_mon = mon; + mytm.tm_year = year; + mytm.tm_wday = wday; + mytm.tm_yday = yday; + mytm.tm_isdst = isdst; + RETVAL = mktime(&mytm); + } + OUTPUT: + RETVAL + +char * +strftime(fmt, sec, min, hour, mday, mon, year, wday = 0, yday = 0, isdst = 0) + char * fmt + int sec + int min + int hour + int mday + int mon + int year + int wday + int yday + int isdst + CODE: + { + char tmpbuf[128]; + struct tm mytm; + int len; + mytm.tm_sec = sec; + mytm.tm_min = min; + mytm.tm_hour = hour; + mytm.tm_mday = mday; + mytm.tm_mon = mon; + mytm.tm_year = year; + mytm.tm_wday = wday; + mytm.tm_yday = yday; + mytm.tm_isdst = isdst; + len = strftime(tmpbuf, sizeof tmpbuf, fmt, &mytm); + ST(0) = sv_2mortal(newSVpv(tmpbuf, len)); + } + +void +tzset() + +void +tzname() + PPCODE: + EXTEND(sp,2); + PUSHs(sv_2mortal(newSVpv(tzname[0],strlen(tzname[0])))); + PUSHs(sv_2mortal(newSVpv(tzname[1],strlen(tzname[1])))); + +SysRet +access(filename, mode) + char * filename + Mode_t mode + +char * +ctermid(s = 0) + char * s = 0; + +char * +cuserid(s = 0) + char * s = 0; + +SysRetLong +fpathconf(fd, name) + int fd + int name + +SysRetLong +pathconf(filename, name) + char * filename + int name + +SysRet +pause() + +SysRetLong +sysconf(name) + int name + +char * +ttyname(fd) + int fd diff --git a/ext/POSIX/typemap b/ext/POSIX/typemap new file mode 100644 index 0000000..45e0862 --- /dev/null +++ b/ext/POSIX/typemap @@ -0,0 +1,13 @@ +Mode_t T_NV +pid_t T_NV +Uid_t T_NV +Time_t T_NV +Gid_t T_NV +Off_t T_NV +fd T_IV +speed_t T_IV +tcflag_t T_IV +cc_t T_IV +POSIX::SigSet T_PTROBJ +POSIX::Termios T_PTROBJ +POSIX::SigAction T_HVREF diff --git a/ext/README b/ext/README deleted file mode 100644 index a80a650..0000000 --- a/ext/README +++ /dev/null @@ -1,114 +0,0 @@ -This directory contains an example of how you might link in C subroutines -with perl to make your own special copy of perl. In the perl distribution -directory, there will be (after make is run) a file called uperl.o, which -is all of perl except for a single undefined subroutine, named userinit(). -See usersub.c. - -The sole purpose of the userinit() routine is to call the initialization -routines for any modules that you want to link in. In this example, we just -call init_curses(), which sets up to link in the System V curses routines. -You'll find this in the file curses.c, which is the processed output of -curses.mus. (To get BSD curses, replace curses.mus with bsdcurses.mus.) - -The magicname() routine adds variable names into the symbol table. Along -with the name of the variable as Perl knows it, we pass a structure containing -an index identifying the variable, and the names of two C functions that -know how to set or evaluate a variable given the index of the variable. -Our example uses a macro to handle this conveniently. - -The init routine calls make_usub() to add user-defined subroutine names -into the symbol table. The arguments are - - make_usub(subname, subindex, subfunc, filename); - char *subname; - int subindex; - int subfunc(); - char *filename; - -The subname is the name that will be used in the Perl program. The subindex -will be passed to subfunc() when it is called to tell it which C function -is desired. subfunc() is a glue routine that translates the arguments -from Perl internal stack form to the form required by the routine in -question, calls the desired C function, and then translates any return -value back into the stack format. The glue routine used by curses just -has a large switch statement, each branch of which does the processing -for a particular C function. The subindex could, however, be used to look -up a function in a dynamically linked library. No example of this is -provided. - -As a help in producing the glue routine, a preprocessor called "mus" lets -you specify argument and return value types in a tabular format. An entry -such as: - - CASE int waddstr - I WINDOW* win - I char* str - END - -indicates that waddstr takes two input arguments, the first of which is a -pointer to a window, and the second of which is an ordinary C string. It -also indicates that an integer is returned. The mus program turns this into: - - case US_waddstr: - if (items != 2) - fatal("Usage: &waddstr($win, $str)"); - else { - int retval; - WINDOW* win = *(WINDOW**) str_get(st[1]); - char* str = (char*) str_get(st[2]); - - retval = waddstr(win, str); - str_numset(st[0], (double) retval); - } - return sp; - -It's also possible to have output parameters, indicated by O, and input/ouput -parameters indicated by IO. - -The mus program isn't perfect. You'll note that curses.mus has some -cases which are hand coded. They'll be passed straight through unmodified. -You can produce similar cases by analogy to what's in curses.c, as well -as similar routines in the doarg.c, dolist.c and doio.c routines of Perl. -The mus program is only intended to get you about 90% there. It's not clear, -for instance, how a given structure should be passed to Perl. But that -shouldn't bother you--if you've gotten this far, it's already obvious -that you are totally mad. - -Here's an example of how to return an array value: - - case US_appl_errlist: - if (!wantarray) { - str_numset(st[0], (double) appl_nerr); - return sp; - } - astore(stack, sp + appl_nerr, Nullstr); /* extend stack */ - st = stack->ary_array + sp; /* possibly realloced */ - for (i = 0; i < appl_nerr; i++) { - tmps = appl_errlist[i]; - st[i] = str_2mortal(str_make(tmps,strlen(tmps))); - } - return sp + appl_nerr - 1; - - -In addition, there is a program, man2mus, that will scan a man page for -function prototypes and attempt to construct a mus CASE entry for you. It has -to guess about input/output parameters, so you'll have to tidy up after it. -But it can save you a lot of time if the man pages for a library are -reasonably well formed. - -If you happen to have curses on your machine, you might try compiling -a copy of curseperl. The "pager" program in this directory is a rudimentary -start on writing a pager--don't believe the help message, which is stolen -from the less program. - -User-defined subroutines may not currently be called as a signal handler, -though a signal handler may itself call a user-defined subroutine. - -There are now glue routines to call back from C into Perl. In usersub.c -in this directory, you'll find callback() and callv(). The callback() -routine presumes that any arguments to pass to the Perl subroutine -have already been pushed onto the Perl stack. The callv() routine -is a wrapper that pushes an argv-style array of strings onto the -stack for you, and then calls callback(). Be sure to recheck your -stack pointer after returning from these routine, since the Perl code -may have reallocated it. diff --git a/ext/SDBM_File/Makefile.SH b/ext/SDBM_File/Makefile.SH new file mode 100644 index 0000000..1f181e3 --- /dev/null +++ b/ext/SDBM_File/Makefile.SH @@ -0,0 +1,216 @@ +: This forces SH files to create target in same directory as SH file. +: This is so that make depend always knows where to find SH derivatives. + +case "$0" in +*/*) cd `expr X$0 : 'X\(.*\)/'` ;; +esac + +if test -f config.sh; then TOP=.; +elif test -f ../config.sh; then TOP=..; +elif test -f ../../config.sh; then TOP=../..; +elif test -f ../../../config.sh; then TOP=../../..; +elif test -f ../../../../config.sh; then TOP=../../../..; +else + echo "Can't find config.sh."; exit 1 +fi + +: Find absolute path name for TOP. This is needed when we cd to TOP +: to run perl on autosplit. +oldpwd=`pwd`; cd $TOP; ABSTOP=`pwd`; cd $oldpwd + +case $CONFIG in +'') + . $TOP/config.sh + ;; +esac + +: Find out directory name. This is also the extension name. +ext=`pwd | $sed -e 's@.*/@@'` + +: This extension might have its own typemap +if test -f typemap; then + exttypemap='typemap' +else + exttypemap='' +fi + +: This extension might need additional libraries. +potential_libs=" " +. $TOP/ext/util/extliblist + +: This extension might need bootstrap support +if test -f ${ext}_BS; then + bootdep=${ext}_BS +else + bootdep='' +fi + +case "$dlsrc" in +dl_aix*) + echo "#!" > $ext.exp + echo "boot_$ext" >> $ext.exp + ;; +esac + +echo "Extracting ext/$ext/Makefile (with variable substitutions)" +: This section of the file will have variable substitutions done on it. +: Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!. +: Protect any dollar signs and backticks that you do not want interpreted +: by putting a backslash in front. You may delete these comments. +$spitshell >Makefile << !GROK!THIS! +# +# This Makefile is for the $ext extension to perl. +# +CC = $cc +RANLIB = $ranlib +TOP = $TOP +ABSTOP = $ABSTOP +LDFLAGS = $ldflags +CLDFLAGS = $ldflags +SMALL = $small +LARGE = $large $split + +# To use an alternate make, set \$altmake in config.sh. +MAKE = ${altmake-make} + +EXT = $ext + +# $ext might have its own typemap +EXTTYPEMAP = $exttypemap + +# $ext might have its own bootstrap support +BOOTDEP = $bootdep +BOOTSTRAP = $ext.bs + +# The following are used to build and install shared libraries for +# dynamic loading. +LDDLFLAGS = $lddlflags +CCDLFLAGS = $ccdlflags +CCCDLFLAGS = $cccdlflags +SO = $so +DLEXT = $dlext + +# $ext might need to be linked with some extra libraries. +# EXTRALIBS = full list of libraries needed for static linking. +# Only those libraries that actually exist are included. +# DYNLOADLIBS = list of those libraries that are needed but can be +# linked in dynamically on this platform. On SunOS, for +# example, this would be .so* libraries, but not archive +# libraries. The bootstrap file is installed only if +# this list is not empty. +# STATLOADLIBS = list of those libraries which must be statically +# linked into the shared library. On SunOS 4.1.3, +# for example, I have only an archive version of +# -lm, and it must be linked in statically. +EXTRALIBS = $extralibs +DYNALOADLIBS = $dynaloadlibs +STATLOADLIBS = $statloadlibs + +!GROK!THIS! + +$spitshell >>Makefile <<'!NO!SUBS!' + +# Where to put things: +AUTO = $(TOP)/lib/auto +INSTALLBOOT = $(AUTO)/$(EXT)/$(EXT).bs +INSTALLDYNAMIC = $(AUTO)/$(EXT)/$(EXT).$(DLEXT) +INSTALLSTATIC = $(EXT).a +INSTALLPM = $(TOP)/lib/$(EXT).pm + +PERL = $(ABSTOP)/miniperl +XSUBPP = $(TOP)/ext/xsubpp +SHELL = /bin/sh +CCCMD = `sh $(shellflags) $(TOP)/cflags $@` + +.c.o: + $(CCCMD) $(CCCDLFLAGS) -I$(TOP) $*.c + +all: dynamic +# Phony target to force checking subdirectories. +FORCE: + +config: + +# Target for Dynamic Loading: +dynamic: $(INSTALLDYNAMIC) $(INSTALLPM) $(INSTALLBOOT) + +$(INSTALLDYNAMIC): $(EXT).o sdbm/libsdbm.a + @test -d $(AUTO) || mkdir $(AUTO) + @test -d $(AUTO)/$(EXT) || mkdir $(AUTO)/$(EXT) + ld $(LDDLFLAGS) -o $@ $(EXT).o sdbm/libsdbm.a $(STATLOADLIBS) + +$(BOOTSTRAP): Makefile $(BOOTDEP) + $(PERL) -I$(TOP)/lib $(TOP)/ext/util/mkbootstrap $(DYNALOADLIBS) + touch $(BOOTSTRAP) + +$(INSTALLBOOT): $(BOOTSTRAP) + @test ! -s $(BOOTSTRAP) || cp $(BOOTSTRAP) $@ + +# Target for Static Loading: +static: $(INSTALLSTATIC) $(INSTALLPM) + +$(INSTALLSTATIC): $(EXT).o sdbm/libsdbm.a + cp sdbm/libsdbm.a $@ + ar r $@ $(EXT).o + $(RANLIB) $@ + echo $(EXTRALIBS) >> $(TOP)/ext.libs + +$(EXT).c: $(EXT).xs $(XSUBPP) $(TOP)/ext/typemap $(EXTTYPEMAP) $(TOP)/cflags Makefile + $(PERL) $(XSUBPP) $(EXT).xs >tmp + mv tmp $@ + +sdbm/libsdbm.a: FORCE + @cd sdbm; \ + if test ! -f Makefile ; then \ + test -f Makefile.SH && sh Makefile.SH ; \ + fi ; $(MAKE) + +$(INSTALLPM): $(EXT).pm + rm -f $@ + cp $(EXT).pm $@ + cd $(TOP); $(PERL) autosplit $(EXT) + +clean: + -cd sdbm; $(MAKE) clean + rm -f *.o *.a mon.out core $(EXT).c so_locations $(BOOTSTRAP) $(EXT).exp + +realclean: clean + -cd sdbm; $(MAKE) realclean + rm -f makefile Makefile + rm -f $(INSTALLPM) $(INSTALLDYNAMIC) $(INSTALLSTATIC) $(INSTALLBOOT) + rm -rf $(AUTO)/$(EXT) + +purge: realclean + +$(EXT).o : $(TOP)/EXTERN.h +$(EXT).o : $(TOP)/perl.h +$(EXT).o : $(TOP)/embed.h +$(EXT).o : $(TOP)/config.h +$(EXT).o : $(TOP)/unixish.h +$(EXT).o : $(TOP)/handy.h +$(EXT).o : $(TOP)/regexp.h +$(EXT).o : $(TOP)/sv.h +$(EXT).o : $(TOP)/util.h +$(EXT).o : $(TOP)/form.h +$(EXT).o : $(TOP)/gv.h +$(EXT).o : $(TOP)/cv.h +$(EXT).o : $(TOP)/opcode.h +$(EXT).o : $(TOP)/op.h +$(EXT).o : $(TOP)/cop.h +$(EXT).o : $(TOP)/av.h +$(EXT).o : $(TOP)/hv.h +$(EXT).o : $(TOP)/mg.h +$(EXT).o : $(TOP)/scope.h +$(EXT).o : $(TOP)/pp.h +$(EXT).o : $(TOP)/proto.h +$(EXT).o : $(TOP)/XSUB.h + +Makefile: Makefile.SH $(TOP)/config.sh ; /bin/sh Makefile.SH +$(TOP)/config.h: $(TOP)/config.sh; cd $(TOP); /bin/sh config_h.SH +$(TOP)/embed.h: $(TOP)/config.sh; cd $(TOP); /bin/sh embed_h.SH +$(TOP)/cflags: $(TOP)/config.sh; cd $(TOP); /bin/sh cflags.SH + +!NO!SUBS! +chmod 644 Makefile +$eunicefix Makefile + diff --git a/ext/SDBM_File/SDBM_File.pm b/ext/SDBM_File/SDBM_File.pm new file mode 100644 index 0000000..1f93e52 --- /dev/null +++ b/ext/SDBM_File/SDBM_File.pm @@ -0,0 +1,11 @@ +package SDBM_File; + +require TieHash; +require DynaLoader; +@ISA = qw(TieHash DynaLoader); + +bootstrap SDBM_File; + +1; + +__END__ diff --git a/ext/SDBM_File/SDBM_File.xs b/ext/SDBM_File/SDBM_File.xs new file mode 100644 index 0000000..97f9c1f --- /dev/null +++ b/ext/SDBM_File/SDBM_File.xs @@ -0,0 +1,71 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" +#include "sdbm/sdbm.h" + +typedef DBM* SDBM_File; +#define sdbm_TIEHASH(dbtype,filename,flags,mode) sdbm_open(filename,flags,mode) +#define sdbm_FETCH(db,key) sdbm_fetch(db,key) +#define sdbm_STORE(db,key,value,flags) sdbm_store(db,key,value,flags) +#define sdbm_DELETE(db,key) sdbm_delete(db,key) +#define sdbm_FIRSTKEY(db) sdbm_firstkey(db) +#define sdbm_NEXTKEY(db,key) sdbm_nextkey(db) + + +MODULE = SDBM_File PACKAGE = SDBM_File PREFIX = sdbm_ + +SDBM_File +sdbm_TIEHASH(dbtype, filename, flags, mode) + char * dbtype + char * filename + int flags + int mode + +void +sdbm_DESTROY(db) + SDBM_File db + CODE: + sdbm_close(db); + +datum +sdbm_FETCH(db, key) + SDBM_File db + datum key + +int +sdbm_STORE(db, key, value, flags = DBM_REPLACE) + SDBM_File db + datum key + datum value + int flags + CLEANUP: + if (RETVAL) { + if (RETVAL < 0 && errno == EPERM) + croak("No write permission to sdbm file"); + warn("sdbm store returned %d, errno %d, key \"%s\"", + RETVAL,errno,key.dptr); + sdbm_clearerr(db); + } + +int +sdbm_DELETE(db, key) + SDBM_File db + datum key + +datum +sdbm_FIRSTKEY(db) + SDBM_File db + +datum +sdbm_NEXTKEY(db, key) + SDBM_File db + datum key + +int +sdbm_error(db) + SDBM_File db + +int +sdbm_clearerr(db) + SDBM_File db + diff --git a/ext/dbm/sdbm/CHANGES b/ext/SDBM_File/sdbm/CHANGES similarity index 100% rename from ext/dbm/sdbm/CHANGES rename to ext/SDBM_File/sdbm/CHANGES diff --git a/ext/dbm/sdbm/COMPARE b/ext/SDBM_File/sdbm/COMPARE similarity index 100% rename from ext/dbm/sdbm/COMPARE rename to ext/SDBM_File/sdbm/COMPARE diff --git a/ext/SDBM_File/sdbm/Makefile.SH b/ext/SDBM_File/sdbm/Makefile.SH new file mode 100644 index 0000000..521c972 --- /dev/null +++ b/ext/SDBM_File/sdbm/Makefile.SH @@ -0,0 +1,99 @@ +: This forces SH files to create target in same directory as SH file. +: This is so that make depend always knows where to find SH derivatives. + +case "$0" in +*/*) cd `expr X$0 : 'X\(.*\)/'` ;; +esac + +if test -f config.sh; then TOP=.; +elif test -f ../config.sh; then TOP=..; +elif test -f ../../config.sh; then TOP=../..; +elif test -f ../../../config.sh; then TOP=../../..; +elif test -f ../../../../config.sh; then TOP=../../../..; +else + echo "Can't find config.sh."; exit 1 +fi + +: Find absolute path name for TOP. This is needed when we cd to TOP +: to run perl on autosplit. +oldpwd=`pwd`; cd $TOP; ABSTOP=`pwd`; cd $oldpwd + +case $CONFIG in +'') + . $TOP/config.sh + ;; +esac + +echo "Extracting ext/SDBM_File/sdbm/Makefile (with variable substitutions)" +: This section of the file will have variable substitutions done on it. +: Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!. +: Protect any dollar signs and backticks that you do not want interpreted +: by putting a backslash in front. You may delete these comments. +$spitshell >Makefile <>Makefile <<'!NO!SUBS!' +SHELL = /bin/sh +CCCMD = `sh $(shellflags) $(TOP)/cflags $@` + +.c.o: + $(CCCMD) $(CCCDLFLAGS) -I$(TOP) -DSDBM -DDUFF $*.c + +LIBOBJS = sdbm.o pair.o hash.o +LIBSRCS = sdbm.c pair.c hash.c +HDRS = tune.h sdbm.h pair.h $(TOP)/config.h + +all: libsdbm.a + +libsdbm.a: $(LIBOBJS) + ar cr libsdbm.a $(LIBOBJS) + $(RANLIB) libsdbm.a + +$(LIBOBJS): $(HDRS) + +lint: + lint -abchx $(LIBSRCS) + +clean: + rm -f *.o *.a mon.out core + +realclean: clean + rm -f dbu libsdbm.a dbd dba dbe x-dbu *.dir *.pag + rm -f makefile Makefile + +purge: realclean + +sdbm.o : sdbm.c $(TOP)/config.h sdbm.h tune.h pair.h +hash.o : hash.c $(TOP)/config.h sdbm.h +pair.o : pair.c $(TOP)/config.h sdbm.h tune.h pair.h + +!NO!SUBS! +chmod 755 Makefile +$eunicefix Makefile diff --git a/ext/dbm/sdbm/README b/ext/SDBM_File/sdbm/README similarity index 100% rename from ext/dbm/sdbm/README rename to ext/SDBM_File/sdbm/README diff --git a/ext/dbm/sdbm/README.too b/ext/SDBM_File/sdbm/README.too similarity index 100% rename from ext/dbm/sdbm/README.too rename to ext/SDBM_File/sdbm/README.too diff --git a/ext/dbm/sdbm/biblio b/ext/SDBM_File/sdbm/biblio similarity index 100% rename from ext/dbm/sdbm/biblio rename to ext/SDBM_File/sdbm/biblio diff --git a/ext/dbm/sdbm/dba.c b/ext/SDBM_File/sdbm/dba.c similarity index 100% rename from ext/dbm/sdbm/dba.c rename to ext/SDBM_File/sdbm/dba.c diff --git a/ext/dbm/sdbm/dbd.c b/ext/SDBM_File/sdbm/dbd.c similarity index 100% rename from ext/dbm/sdbm/dbd.c rename to ext/SDBM_File/sdbm/dbd.c diff --git a/ext/dbm/sdbm/dbe.1 b/ext/SDBM_File/sdbm/dbe.1 similarity index 100% rename from ext/dbm/sdbm/dbe.1 rename to ext/SDBM_File/sdbm/dbe.1 diff --git a/ext/dbm/sdbm/dbe.c b/ext/SDBM_File/sdbm/dbe.c similarity index 100% rename from ext/dbm/sdbm/dbe.c rename to ext/SDBM_File/sdbm/dbe.c diff --git a/ext/dbm/sdbm/dbm.c b/ext/SDBM_File/sdbm/dbm.c similarity index 100% rename from ext/dbm/sdbm/dbm.c rename to ext/SDBM_File/sdbm/dbm.c diff --git a/ext/dbm/sdbm/dbm.h b/ext/SDBM_File/sdbm/dbm.h similarity index 100% rename from ext/dbm/sdbm/dbm.h rename to ext/SDBM_File/sdbm/dbm.h diff --git a/ext/dbm/sdbm/dbu.c b/ext/SDBM_File/sdbm/dbu.c similarity index 100% rename from ext/dbm/sdbm/dbu.c rename to ext/SDBM_File/sdbm/dbu.c diff --git a/ext/dbm/sdbm/grind b/ext/SDBM_File/sdbm/grind similarity index 100% rename from ext/dbm/sdbm/grind rename to ext/SDBM_File/sdbm/grind diff --git a/ext/dbm/sdbm/hash.c b/ext/SDBM_File/sdbm/hash.c similarity index 100% rename from ext/dbm/sdbm/hash.c rename to ext/SDBM_File/sdbm/hash.c diff --git a/ext/dbm/sdbm/linux.patches b/ext/SDBM_File/sdbm/linux.patches similarity index 100% rename from ext/dbm/sdbm/linux.patches rename to ext/SDBM_File/sdbm/linux.patches diff --git a/ext/dbm/sdbm/makefile.sdbm b/ext/SDBM_File/sdbm/makefile.sdbm similarity index 100% rename from ext/dbm/sdbm/makefile.sdbm rename to ext/SDBM_File/sdbm/makefile.sdbm diff --git a/ext/SDBM_File/sdbm/pair.c b/ext/SDBM_File/sdbm/pair.c new file mode 100644 index 0000000..a02c73f --- /dev/null +++ b/ext/SDBM_File/sdbm/pair.c @@ -0,0 +1,307 @@ +/* + * sdbm - ndbm work-alike hashed database library + * based on Per-Aake Larson's Dynamic Hashing algorithms. BIT 18 (1978). + * author: oz@nexus.yorku.ca + * status: public domain. + * + * page-level routines + */ + +#ifndef lint +static char rcsid[] = "$Id: pair.c,v 1.10 90/12/13 13:00:35 oz Exp $"; +#endif + +#include "config.h" +#include "sdbm.h" +#include "tune.h" +#include "pair.h" + +#define exhash(item) sdbm_hash((item).dptr, (item).dsize) + +/* + * forward + */ +static int seepair proto((char *, int, char *, int)); + +/* + * page format: + * +------------------------------+ + * ino | n | keyoff | datoff | keyoff | + * +------------+--------+--------+ + * | datoff | - - - ----> | + * +--------+---------------------+ + * | F R E E A R E A | + * +--------------+---------------+ + * | <---- - - - | data | + * +--------+-----+----+----------+ + * | key | data | key | + * +--------+----------+----------+ + * + * calculating the offsets for free area: if the number + * of entries (ino[0]) is zero, the offset to the END of + * the free area is the block size. Otherwise, it is the + * nth (ino[ino[0]]) entry's offset. + */ + +int +fitpair(pag, need) +char *pag; +int need; +{ + register int n; + register int off; + register int free; + register short *ino = (short *) pag; + + off = ((n = ino[0]) > 0) ? ino[n] : PBLKSIZ; + free = off - (n + 1) * sizeof(short); + need += 2 * sizeof(short); + + debug(("free %d need %d\n", free, need)); + + return need <= free; +} + +void +putpair(pag, key, val) +char *pag; +datum key; +datum val; +{ + register int n; + register int off; + register short *ino = (short *) pag; + + off = ((n = ino[0]) > 0) ? ino[n] : PBLKSIZ; +/* + * enter the key first + */ + off -= key.dsize; + (void) memcpy(pag + off, key.dptr, key.dsize); + ino[n + 1] = off; +/* + * now the data + */ + off -= val.dsize; + (void) memcpy(pag + off, val.dptr, val.dsize); + ino[n + 2] = off; +/* + * adjust item count + */ + ino[0] += 2; +} + +datum +getpair(pag, key) +char *pag; +datum key; +{ + register int i; + register int n; + datum val; + register short *ino = (short *) pag; + + if ((n = ino[0]) == 0) + return nullitem; + + if ((i = seepair(pag, n, key.dptr, key.dsize)) == 0) + return nullitem; + + val.dptr = pag + ino[i + 1]; + val.dsize = ino[i] - ino[i + 1]; + return val; +} + +#ifdef SEEDUPS +int +duppair(pag, key) +char *pag; +datum key; +{ + register short *ino = (short *) pag; + return ino[0] > 0 && seepair(pag, ino[0], key.dptr, key.dsize) > 0; +} +#endif + +datum +getnkey(pag, num) +char *pag; +int num; +{ + datum key; + register int off; + register short *ino = (short *) pag; + + num = num * 2 - 1; + if (ino[0] == 0 || num > ino[0]) + return nullitem; + + off = (num > 1) ? ino[num - 1] : PBLKSIZ; + + key.dptr = pag + ino[num]; + key.dsize = off - ino[num]; + + return key; +} + +int +delpair(pag, key) +char *pag; +datum key; +{ + register int n; + register int i; + register short *ino = (short *) pag; + + if ((n = ino[0]) == 0) + return 0; + + if ((i = seepair(pag, n, key.dptr, key.dsize)) == 0) + return 0; +/* + * found the key. if it is the last entry + * [i.e. i == n - 1] we just adjust the entry count. + * hard case: move all data down onto the deleted pair, + * shift offsets onto deleted offsets, and adjust them. + * [note: 0 < i < n] + */ + if (i < n - 1) { + register int m; + register char *dst = pag + (i == 1 ? PBLKSIZ : ino[i - 1]); + register char *src = pag + ino[i + 1]; + register int zoo = dst - src; + + debug(("free-up %d ", zoo)); +/* + * shift data/keys down + */ + m = ino[i + 1] - ino[n]; +#ifdef DUFF +#define MOVB *--dst = *--src + + if (m > 0) { + register int loop = (m + 8 - 1) >> 3; + + switch (m & (8 - 1)) { + case 0: do { + MOVB; case 7: MOVB; + case 6: MOVB; case 5: MOVB; + case 4: MOVB; case 3: MOVB; + case 2: MOVB; case 1: MOVB; + } while (--loop); + } + } +#else +#ifdef HAS_MEMMOVE + dst -= m; + src -= m; + memmove(dst, src, m); +#else + while (m--) + *--dst = *--src; +#endif +#endif +/* + * adjust offset index up + */ + while (i < n - 1) { + ino[i] = ino[i + 2] + zoo; + i++; + } + } + ino[0] -= 2; + return 1; +} + +/* + * search for the key in the page. + * return offset index in the range 0 < i < n. + * return 0 if not found. + */ +static int +seepair(pag, n, key, siz) +char *pag; +register int n; +register char *key; +register int siz; +{ + register int i; + register int off = PBLKSIZ; + register short *ino = (short *) pag; + + for (i = 1; i < n; i += 2) { + if (siz == off - ino[i] && + memcmp(key, pag + ino[i], siz) == 0) + return i; + off = ino[i + 1]; + } + return 0; +} + +void +splpage(pag, new, sbit) +char *pag; +char *new; +long sbit; +{ + datum key; + datum val; + + register int n; + register int off = PBLKSIZ; + char cur[PBLKSIZ]; + register short *ino = (short *) cur; + + (void) memcpy(cur, pag, PBLKSIZ); + (void) memset(pag, 0, PBLKSIZ); + (void) memset(new, 0, PBLKSIZ); + + n = ino[0]; + for (ino++; n > 0; ino += 2) { + key.dptr = cur + ino[0]; + key.dsize = off - ino[0]; + val.dptr = cur + ino[1]; + val.dsize = ino[0] - ino[1]; +/* + * select the page pointer (by looking at sbit) and insert + */ + (void) putpair((exhash(key) & sbit) ? new : pag, key, val); + + off = ino[1]; + n -= 2; + } + + debug(("%d split %d/%d\n", ((short *) cur)[0] / 2, + ((short *) new)[0] / 2, + ((short *) pag)[0] / 2)); +} + +/* + * check page sanity: + * number of entries should be something + * reasonable, and all offsets in the index should be in order. + * this could be made more rigorous. + */ +int +chkpage(pag) +char *pag; +{ + register int n; + register int off; + register short *ino = (short *) pag; + + if ((n = ino[0]) < 0 || n > PBLKSIZ / sizeof(short)) + return 0; + + if (n > 0) { + off = PBLKSIZ; + for (ino++; n > 0; ino += 2) { + if (ino[0] > off || ino[1] > off || + ino[1] > ino[0]) + return 0; + off = ino[1]; + n -= 2; + } + } + return 1; +} diff --git a/ext/dbm/sdbm/pair.h b/ext/SDBM_File/sdbm/pair.h similarity index 100% rename from ext/dbm/sdbm/pair.h rename to ext/SDBM_File/sdbm/pair.h diff --git a/ext/dbm/sdbm/readme.ms b/ext/SDBM_File/sdbm/readme.ms similarity index 100% rename from ext/dbm/sdbm/readme.ms rename to ext/SDBM_File/sdbm/readme.ms diff --git a/ext/dbm/sdbm/readme.ps b/ext/SDBM_File/sdbm/readme.ps similarity index 100% rename from ext/dbm/sdbm/readme.ps rename to ext/SDBM_File/sdbm/readme.ps diff --git a/ext/dbm/sdbm/sdbm.3 b/ext/SDBM_File/sdbm/sdbm.3 similarity index 100% rename from ext/dbm/sdbm/sdbm.3 rename to ext/SDBM_File/sdbm/sdbm.3 diff --git a/ext/dbm/sdbm/sdbm.c b/ext/SDBM_File/sdbm/sdbm.c similarity index 100% rename from ext/dbm/sdbm/sdbm.c rename to ext/SDBM_File/sdbm/sdbm.c diff --git a/ext/SDBM_File/sdbm/sdbm.h b/ext/SDBM_File/sdbm/sdbm.h new file mode 100644 index 0000000..927e2c2 --- /dev/null +++ b/ext/SDBM_File/sdbm/sdbm.h @@ -0,0 +1,234 @@ +/* + * sdbm - ndbm work-alike hashed database library + * based on Per-Ake Larson's Dynamic Hashing algorithms. BIT 18 (1978). + * author: oz@nexus.yorku.ca + * status: public domain. + */ +#define DBLKSIZ 4096 +#define PBLKSIZ 1024 +#define PAIRMAX 1008 /* arbitrary on PBLKSIZ-N */ +#define SPLTMAX 10 /* maximum allowed splits */ + /* for a single insertion */ +#define DIRFEXT ".dir" +#define PAGFEXT ".pag" + +typedef struct { + int dirf; /* directory file descriptor */ + int pagf; /* page file descriptor */ + int flags; /* status/error flags, see below */ + long maxbno; /* size of dirfile in bits */ + long curbit; /* current bit number */ + long hmask; /* current hash mask */ + long blkptr; /* current block for nextkey */ + int keyptr; /* current key for nextkey */ + long blkno; /* current page to read/write */ + long pagbno; /* current page in pagbuf */ + char pagbuf[PBLKSIZ]; /* page file block buffer */ + long dirbno; /* current block in dirbuf */ + char dirbuf[DBLKSIZ]; /* directory file block buffer */ +} DBM; + +#define DBM_RDONLY 0x1 /* data base open read-only */ +#define DBM_IOERR 0x2 /* data base I/O error */ + +/* + * utility macros + */ +#define sdbm_rdonly(db) ((db)->flags & DBM_RDONLY) +#define sdbm_error(db) ((db)->flags & DBM_IOERR) + +#define sdbm_clearerr(db) ((db)->flags &= ~DBM_IOERR) /* ouch */ + +#define sdbm_dirfno(db) ((db)->dirf) +#define sdbm_pagfno(db) ((db)->pagf) + +typedef struct { + char *dptr; + int dsize; +} datum; + +extern datum nullitem; + +#ifdef __STDC__ +#define proto(p) p +#else +#define proto(p) () +#endif + +/* + * flags to sdbm_store + */ +#define DBM_INSERT 0 +#define DBM_REPLACE 1 + +/* + * ndbm interface + */ +extern DBM *sdbm_open proto((char *, int, int)); +extern void sdbm_close proto((DBM *)); +extern datum sdbm_fetch proto((DBM *, datum)); +extern int sdbm_delete proto((DBM *, datum)); +extern int sdbm_store proto((DBM *, datum, datum, int)); +extern datum sdbm_firstkey proto((DBM *)); +extern datum sdbm_nextkey proto((DBM *)); + +/* + * other + */ +extern DBM *sdbm_prep proto((char *, char *, int, int)); +extern long sdbm_hash proto((char *, int)); + +#ifndef SDBM_ONLY +#define dbm_open sdbm_open; +#define dbm_close sdbm_close; +#define dbm_fetch sdbm_fetch; +#define dbm_store sdbm_store; +#define dbm_delete sdbm_delete; +#define dbm_firstkey sdbm_firstkey; +#define dbm_nextkey sdbm_nextkey; +#define dbm_error sdbm_error; +#define dbm_clearerr sdbm_clearerr; +#endif + +/* Most of the following is stolen from perl.h. */ +#ifndef H_PERL /* Include guard */ + +/* + * The following contortions are brought to you on behalf of all the + * standards, semi-standards, de facto standards, not-so-de-facto standards + * of the world, as well as all the other botches anyone ever thought of. + * The basic theory is that if we work hard enough here, the rest of the + * code can be a lot prettier. Well, so much for theory. Sorry, Henry... + */ + +#include +#ifdef HAS_SOCKET +# ifdef I_NET_ERRNO +# include +# endif +#endif + +#ifdef MYMALLOC +# ifdef HIDEMYMALLOC +# define malloc Mymalloc +# define realloc Myremalloc +# define free Myfree +# endif +# define safemalloc malloc +# define saferealloc realloc +# define safefree free +#endif + +#if defined(__STDC__) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus) +# define STANDARD_C 1 +#endif + +#include +#include +#include + +#ifdef I_UNISTD +#include +#endif + +#ifndef MSDOS +# ifdef PARAM_NEEDS_TYPES +# include +# endif +# include +#endif + +#ifndef _TYPES_ /* If types.h defines this it's easy. */ +# ifndef major /* Does everyone's types.h define this? */ +# include +# endif +#endif + +#include + +#ifndef SEEK_SET +# ifdef L_SET +# define SEEK_SET L_SET +# else +# define SEEK_SET 0 /* Wild guess. */ +# endif +#endif + +/* Use all the "standard" definitions? */ +#ifdef STANDARD_C +# include +#endif /* STANDARD_C */ + +#define MEM_SIZE Size_t + +#ifdef I_STRING +#include +#else +#include +#endif + +#ifdef I_MEMORY +#include +#endif + +#if defined(mips) && defined(ultrix) && !defined(__STDC__) +# undef HAS_MEMCMP +#endif + +#ifdef HAS_MEMCPY +# if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY) +# ifndef memcpy + extern char * memcpy _((char*, char*, int)); +# endif +# endif +#else +# ifndef memcpy +# ifdef HAS_BCOPY +# define memcpy(d,s,l) bcopy(s,d,l) +# else +# define memcpy(d,s,l) my_bcopy(s,d,l) +# endif +# endif +#endif /* HAS_MEMCPY */ + +#ifdef HAS_MEMSET +# if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY) +# ifndef memset + extern char *memset _((char*, int, int)); +# endif +# endif +# define memzero(d,l) memset(d,0,l) +#else +# ifndef memzero +# ifdef HAS_BZERO +# define memzero(d,l) bzero(d,l) +# else +# define memzero(d,l) my_bzero(d,l) +# endif +# endif +#endif /* HAS_MEMSET */ + +#ifdef HAS_MEMCMP +# if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY) +# ifndef memcmp + extern int memcmp _((char*, char*, int)); +# endif +# endif +#else +# ifndef memcmp +# define memcmp(s1,s2,l) my_memcmp(s1,s2,l) +# endif +#endif /* HAS_MEMCMP */ + +/* we prefer bcmp slightly for comparisons that don't care about ordering */ +#ifndef HAS_BCMP +# ifndef bcmp +# define bcmp(s1,s2,l) memcmp(s1,s2,l) +# endif +#endif /* HAS_BCMP */ + +#ifdef I_NETINET_IN +# include +#endif + +#endif /* Include guard */ diff --git a/ext/dbm/sdbm/tune.h b/ext/SDBM_File/sdbm/tune.h similarity index 100% rename from ext/dbm/sdbm/tune.h rename to ext/SDBM_File/sdbm/tune.h diff --git a/ext/dbm/sdbm/util.c b/ext/SDBM_File/sdbm/util.c similarity index 100% rename from ext/dbm/sdbm/util.c rename to ext/SDBM_File/sdbm/util.c diff --git a/ext/dbm/typemap b/ext/SDBM_File/typemap similarity index 100% rename from ext/dbm/typemap rename to ext/SDBM_File/typemap diff --git a/ext/Socket/Makefile.SH b/ext/Socket/Makefile.SH new file mode 100644 index 0000000..064228e --- /dev/null +++ b/ext/Socket/Makefile.SH @@ -0,0 +1,207 @@ +: This forces SH files to create target in same directory as SH file. +: This is so that make depend always knows where to find SH derivatives. + +case "$0" in +*/*) cd `expr X$0 : 'X\(.*\)/'` ;; +esac + +if test -f config.sh; then TOP=.; +elif test -f ../config.sh; then TOP=..; +elif test -f ../../config.sh; then TOP=../..; +elif test -f ../../../config.sh; then TOP=../../..; +elif test -f ../../../../config.sh; then TOP=../../../..; +else + echo "Can't find config.sh."; exit 1 +fi + +: Find absolute path name for TOP. This is needed when we cd to TOP +: to run perl on autosplit. +oldpwd=`pwd`; cd $TOP; ABSTOP=`pwd`; cd $oldpwd + +case $CONFIG in +'') + . $TOP/config.sh + ;; +esac + +: Find out directory name. This is also the extension name. +ext=`pwd | $sed -e 's@.*/@@'` + +: This extension might have its own typemap +if test -f typemap; then + exttypemap='typemap' +else + exttypemap='' +fi + +: This extension might need additional libraries. +potential_libs=" " +. $TOP/ext/util/extliblist + +: This extension might need bootstrap support +if test -f ${ext}_BS; then + bootdep=${ext}_BS +else + bootdep='' +fi + +case "$dlsrc" in +dl_aix*) + echo "#!" > $ext.exp + echo "boot_$ext" >> $ext.exp + ;; +esac + +echo "Extracting ext/$ext/Makefile (with variable substitutions)" +: This section of the file will have variable substitutions done on it. +: Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!. +: Protect any dollar signs and backticks that you do not want interpreted +: by putting a backslash in front. You may delete these comments. +$spitshell >Makefile << !GROK!THIS! +# +# This Makefile is for the $ext extension to perl. +# +CC = $cc +RANLIB = $ranlib +TOP = $TOP +ABSTOP = $ABSTOP +LDFLAGS = $ldflags +CLDFLAGS = $ldflags +SMALL = $small +LARGE = $large $split + +# To use an alternate make, set \$altmake in config.sh. +MAKE = ${altmake-make} + +EXT = $ext + +# $ext might have its own typemap +EXTTYPEMAP = $exttypemap + +# $ext might have its own bootstrap support +BOOTDEP = $bootdep +BOOTSTRAP = $ext.bs + +# The following are used to build and install shared libraries for +# dynamic loading. +LDDLFLAGS = $lddlflags +CCDLFLAGS = $ccdlflags +CCCDLFLAGS = $cccdlflags +SO = $so +DLEXT = $dlext + +# $ext might need to be linked with some extra libraries. +# EXTRALIBS = full list of libraries needed for static linking. +# Only those libraries that actually exist are included. +# DYNLOADLIBS = list of those libraries that are needed but can be +# linked in dynamically on this platform. On SunOS, for +# example, this would be .so* libraries, but not archive +# libraries. The bootstrap file is installed only if +# this list is not empty. +# STATLOADLIBS = list of those libraries which must be statically +# linked into the shared library. On SunOS 4.1.3, +# for example, I have only an archive version of +# -lm, and it must be linked in statically. +EXTRALIBS = $extralibs +DYNALOADLIBS = $dynaloadlibs +STATLOADLIBS = $statloadlibs + +!GROK!THIS! + +$spitshell >>Makefile <<'!NO!SUBS!' + +# Where to put things: +AUTO = $(TOP)/lib/auto +INSTALLBOOT = $(AUTO)/$(EXT)/$(EXT).bs +INSTALLDYNAMIC = $(AUTO)/$(EXT)/$(EXT).$(DLEXT) +INSTALLSTATIC = $(EXT).a +INSTALLPM = $(TOP)/lib/$(EXT).pm + +PERL = $(ABSTOP)/miniperl +XSUBPP = $(TOP)/ext/xsubpp +SHELL = /bin/sh +CCCMD = `sh $(shellflags) $(TOP)/cflags $@` + +.c.o: + $(CCCMD) $(CCCDLFLAGS) -I$(TOP) $*.c + +all: dynamic +# Phony target to force checking subdirectories. +FORCE: + +config: + +# Target for Dynamic Loading: +dynamic: $(INSTALLDYNAMIC) $(INSTALLPM) $(INSTALLBOOT) + +$(INSTALLDYNAMIC): $(EXT).o + @test -d $(AUTO) || mkdir $(AUTO) + @test -d $(AUTO)/$(EXT) || mkdir $(AUTO)/$(EXT) + ld $(LDDLFLAGS) -o $@ $(EXT).o $(STATLOADLIBS) + +$(BOOTSTRAP): Makefile $(BOOTDEP) + $(PERL) -I$(TOP)/lib $(TOP)/ext/util/mkbootstrap $(DYNALOADLIBS) + touch $(BOOTSTRAP) + +$(INSTALLBOOT): $(BOOTSTRAP) + @test ! -s $(BOOTSTRAP) || cp $(BOOTSTRAP) $@ + +# Target for Static Loading: +static: $(INSTALLSTATIC) $(INSTALLPM) + +$(INSTALLSTATIC): $(EXT).o + ar cr $@ $(EXT).o + $(RANLIB) $@ + echo $(EXTRALIBS) >> $(TOP)/ext.libs + +$(EXT).c: $(EXT).xs $(XSUBPP) $(TOP)/ext/typemap $(EXTTYPEMAP) $(TOP)/cflags Makefile + $(PERL) $(XSUBPP) $(EXT).xs >tmp + mv tmp $@ + +$(INSTALLPM): $(EXT).pm + rm -f $@ + cp $(EXT).pm $@ + cd $(TOP); $(PERL) autosplit $(EXT) + +clean: + rm -f *.o *.a mon.out core $(EXT).c so_locations $(BOOTSTRAP) $(EXT).exp + +realclean: clean + rm -f makefile Makefile + rm -f $(INSTALLPM) $(INSTALLDYNAMIC) $(INSTALLSTATIC) $(INSTALLBOOT) + rm -rf $(AUTO)/$(EXT) + +purge: realclean + +$(EXT).o : $(TOP)/EXTERN.h +$(EXT).o : $(TOP)/perl.h +$(EXT).o : $(TOP)/embed.h +$(EXT).o : $(TOP)/config.h +$(EXT).o : $(TOP)/unixish.h +$(EXT).o : $(TOP)/handy.h +$(EXT).o : $(TOP)/regexp.h +$(EXT).o : $(TOP)/sv.h +$(EXT).o : $(TOP)/util.h +$(EXT).o : $(TOP)/form.h +$(EXT).o : $(TOP)/gv.h +$(EXT).o : $(TOP)/cv.h +$(EXT).o : $(TOP)/opcode.h +$(EXT).o : $(TOP)/op.h +$(EXT).o : $(TOP)/cop.h +$(EXT).o : $(TOP)/av.h +$(EXT).o : $(TOP)/hv.h +$(EXT).o : $(TOP)/mg.h +$(EXT).o : $(TOP)/scope.h +$(EXT).o : $(TOP)/pp.h +$(EXT).o : $(TOP)/proto.h +$(EXT).o : $(TOP)/XSUB.h + +Makefile: Makefile.SH $(TOP)/config.sh ; /bin/sh Makefile.SH +$(TOP)/config.h: $(TOP)/config.sh; cd $(TOP); /bin/sh config_h.SH +$(TOP)/embed.h: $(TOP)/config.sh; cd $(TOP); /bin/sh embed_h.SH +$(TOP)/cflags: $(TOP)/config.sh; cd $(TOP); /bin/sh cflags.SH + +!NO!SUBS! +chmod 644 Makefile +$eunicefix Makefile + diff --git a/ext/Socket/Socket.pm b/ext/Socket/Socket.pm new file mode 100644 index 0000000..a05c0a0 --- /dev/null +++ b/ext/Socket/Socket.pm @@ -0,0 +1,116 @@ +package Socket; +use Carp; + +require Exporter; +require AutoLoader; +require DynaLoader; +@ISA = (Exporter, AutoLoader, DynaLoader); +@EXPORT = qw( + AF_802 + AF_APPLETALK + AF_CCITT + AF_CHAOS + AF_DATAKIT + AF_DECnet + AF_DLI + AF_ECMA + AF_GOSIP + AF_HYLINK + AF_IMPLINK + AF_INET + AF_LAT + AF_MAX + AF_NBS + AF_NIT + AF_NS + AF_OSI + AF_OSINET + AF_PUP + AF_SNA + AF_UNIX + AF_UNSPEC + AF_X25 + MSG_DONTROUTE + MSG_MAXIOVLEN + MSG_OOB + MSG_PEEK + PF_802 + PF_APPLETALK + PF_CCITT + PF_CHAOS + PF_DATAKIT + PF_DECnet + PF_DLI + PF_ECMA + PF_GOSIP + PF_HYLINK + PF_IMPLINK + PF_INET + PF_LAT + PF_MAX + PF_NBS + PF_NIT + PF_NS + PF_OSI + PF_OSINET + PF_PUP + PF_SNA + PF_UNIX + PF_UNSPEC + PF_X25 + SOCK_DGRAM + SOCK_RAW + SOCK_RDM + SOCK_SEQPACKET + SOCK_STREAM + SOL_SOCKET + SOMAXCONN + SO_ACCEPTCONN + SO_BROADCAST + SO_DEBUG + SO_DONTLINGER + SO_DONTROUTE + SO_ERROR + SO_KEEPALIVE + SO_LINGER + SO_OOBINLINE + SO_RCVBUF + SO_RCVLOWAT + SO_RCVTIMEO + SO_REUSEADDR + SO_SNDBUF + SO_SNDLOWAT + SO_SNDTIMEO + SO_TYPE + SO_USELOOPBACK +); + +sub AUTOLOAD { + if (@_ > 1) { + $AutoLoader::AUTOLOAD = $AUTOLOAD; + goto &AutoLoader::AUTOLOAD; + } + local($constname); + ($constname = $AUTOLOAD) =~ s/.*:://; + $val = constant($constname, @_ ? $_[0] : 0); + if ($! != 0) { + if ($! =~ /Invalid/) { + $AutoLoader::AUTOLOAD = $AUTOLOAD; + goto &AutoLoader::AUTOLOAD; + } + else { + ($pack,$file,$line) = caller; + croak "Your vendor has not defined Socket macro $constname, used"; + } + } + eval "sub $AUTOLOAD { $val }"; + goto &$AUTOLOAD; +} + +bootstrap Socket; + +# Preloaded methods go here. Autoload methods go after __END__, and are +# processed by the autosplit program. + +1; +__END__ diff --git a/ext/Socket/Socket.xs b/ext/Socket/Socket.xs new file mode 100644 index 0000000..7a0bf46 --- /dev/null +++ b/ext/Socket/Socket.xs @@ -0,0 +1,565 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#include + +#ifndef AF_NBS +#undef PF_NBS +#endif + +#ifndef AF_X25 +#undef PF_X25 +#endif + +static int +not_here(s) +char *s; +{ + croak("Socket::%s not implemented on this architecture", s); + return -1; +} + +static double +constant(name, arg) +char *name; +int arg; +{ + errno = 0; + switch (*name) { + case 'A': + if (strEQ(name, "AF_802")) +#ifdef AF_802 + return AF_802; +#else + goto not_there; +#endif + if (strEQ(name, "AF_APPLETALK")) +#ifdef AF_APPLETALK + return AF_APPLETALK; +#else + goto not_there; +#endif + if (strEQ(name, "AF_CCITT")) +#ifdef AF_CCITT + return AF_CCITT; +#else + goto not_there; +#endif + if (strEQ(name, "AF_CHAOS")) +#ifdef AF_CHAOS + return AF_CHAOS; +#else + goto not_there; +#endif + if (strEQ(name, "AF_DATAKIT")) +#ifdef AF_DATAKIT + return AF_DATAKIT; +#else + goto not_there; +#endif + if (strEQ(name, "AF_DECnet")) +#ifdef AF_DECnet + return AF_DECnet; +#else + goto not_there; +#endif + if (strEQ(name, "AF_DLI")) +#ifdef AF_DLI + return AF_DLI; +#else + goto not_there; +#endif + if (strEQ(name, "AF_ECMA")) +#ifdef AF_ECMA + return AF_ECMA; +#else + goto not_there; +#endif + if (strEQ(name, "AF_GOSIP")) +#ifdef AF_GOSIP + return AF_GOSIP; +#else + goto not_there; +#endif + if (strEQ(name, "AF_HYLINK")) +#ifdef AF_HYLINK + return AF_HYLINK; +#else + goto not_there; +#endif + if (strEQ(name, "AF_IMPLINK")) +#ifdef AF_IMPLINK + return AF_IMPLINK; +#else + goto not_there; +#endif + if (strEQ(name, "AF_INET")) +#ifdef AF_INET + return AF_INET; +#else + goto not_there; +#endif + if (strEQ(name, "AF_LAT")) +#ifdef AF_LAT + return AF_LAT; +#else + goto not_there; +#endif + if (strEQ(name, "AF_MAX")) +#ifdef AF_MAX + return AF_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "AF_NBS")) +#ifdef AF_NBS + return AF_NBS; +#else + goto not_there; +#endif + if (strEQ(name, "AF_NIT")) +#ifdef AF_NIT + return AF_NIT; +#else + goto not_there; +#endif + if (strEQ(name, "AF_NS")) +#ifdef AF_NS + return AF_NS; +#else + goto not_there; +#endif + if (strEQ(name, "AF_OSI")) +#ifdef AF_OSI + return AF_OSI; +#else + goto not_there; +#endif + if (strEQ(name, "AF_OSINET")) +#ifdef AF_OSINET + return AF_OSINET; +#else + goto not_there; +#endif + if (strEQ(name, "AF_PUP")) +#ifdef AF_PUP + return AF_PUP; +#else + goto not_there; +#endif + if (strEQ(name, "AF_SNA")) +#ifdef AF_SNA + return AF_SNA; +#else + goto not_there; +#endif + if (strEQ(name, "AF_UNIX")) +#ifdef AF_UNIX + return AF_UNIX; +#else + goto not_there; +#endif + if (strEQ(name, "AF_UNSPEC")) +#ifdef AF_UNSPEC + return AF_UNSPEC; +#else + goto not_there; +#endif + if (strEQ(name, "AF_X25")) +#ifdef AF_X25 + return AF_X25; +#else + goto not_there; +#endif + break; + case 'B': + break; + case 'C': + break; + case 'D': + break; + case 'E': + 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, "MSG_DONTROUTE")) +#ifdef MSG_DONTROUTE + return MSG_DONTROUTE; +#else + goto not_there; +#endif + if (strEQ(name, "MSG_MAXIOVLEN")) +#ifdef MSG_MAXIOVLEN + return MSG_MAXIOVLEN; +#else + goto not_there; +#endif + if (strEQ(name, "MSG_OOB")) +#ifdef MSG_OOB + return MSG_OOB; +#else + goto not_there; +#endif + if (strEQ(name, "MSG_PEEK")) +#ifdef MSG_PEEK + return MSG_PEEK; +#else + goto not_there; +#endif + break; + case 'N': + break; + case 'O': + break; + case 'P': + if (strEQ(name, "PF_802")) +#ifdef PF_802 + return PF_802; +#else + goto not_there; +#endif + if (strEQ(name, "PF_APPLETALK")) +#ifdef PF_APPLETALK + return PF_APPLETALK; +#else + goto not_there; +#endif + if (strEQ(name, "PF_CCITT")) +#ifdef PF_CCITT + return PF_CCITT; +#else + goto not_there; +#endif + if (strEQ(name, "PF_CHAOS")) +#ifdef PF_CHAOS + return PF_CHAOS; +#else + goto not_there; +#endif + if (strEQ(name, "PF_DATAKIT")) +#ifdef PF_DATAKIT + return PF_DATAKIT; +#else + goto not_there; +#endif + if (strEQ(name, "PF_DECnet")) +#ifdef PF_DECnet + return PF_DECnet; +#else + goto not_there; +#endif + if (strEQ(name, "PF_DLI")) +#ifdef PF_DLI + return PF_DLI; +#else + goto not_there; +#endif + if (strEQ(name, "PF_ECMA")) +#ifdef PF_ECMA + return PF_ECMA; +#else + goto not_there; +#endif + if (strEQ(name, "PF_GOSIP")) +#ifdef PF_GOSIP + return PF_GOSIP; +#else + goto not_there; +#endif + if (strEQ(name, "PF_HYLINK")) +#ifdef PF_HYLINK + return PF_HYLINK; +#else + goto not_there; +#endif + if (strEQ(name, "PF_IMPLINK")) +#ifdef PF_IMPLINK + return PF_IMPLINK; +#else + goto not_there; +#endif + if (strEQ(name, "PF_INET")) +#ifdef PF_INET + return PF_INET; +#else + goto not_there; +#endif + if (strEQ(name, "PF_LAT")) +#ifdef PF_LAT + return PF_LAT; +#else + goto not_there; +#endif + if (strEQ(name, "PF_MAX")) +#ifdef PF_MAX + return PF_MAX; +#else + goto not_there; +#endif + if (strEQ(name, "PF_NBS")) +#ifdef PF_NBS + return PF_NBS; +#else + goto not_there; +#endif + if (strEQ(name, "PF_NIT")) +#ifdef PF_NIT + return PF_NIT; +#else + goto not_there; +#endif + if (strEQ(name, "PF_NS")) +#ifdef PF_NS + return PF_NS; +#else + goto not_there; +#endif + if (strEQ(name, "PF_OSI")) +#ifdef PF_OSI + return PF_OSI; +#else + goto not_there; +#endif + if (strEQ(name, "PF_OSINET")) +#ifdef PF_OSINET + return PF_OSINET; +#else + goto not_there; +#endif + if (strEQ(name, "PF_PUP")) +#ifdef PF_PUP + return PF_PUP; +#else + goto not_there; +#endif + if (strEQ(name, "PF_SNA")) +#ifdef PF_SNA + return PF_SNA; +#else + goto not_there; +#endif + if (strEQ(name, "PF_UNIX")) +#ifdef PF_UNIX + return PF_UNIX; +#else + goto not_there; +#endif + if (strEQ(name, "PF_UNSPEC")) +#ifdef PF_UNSPEC + return PF_UNSPEC; +#else + goto not_there; +#endif + if (strEQ(name, "PF_X25")) +#ifdef PF_X25 + return PF_X25; +#else + goto not_there; +#endif + break; + case 'Q': + break; + case 'R': + break; + case 'S': + if (strEQ(name, "SOCK_DGRAM")) +#ifdef SOCK_DGRAM + return SOCK_DGRAM; +#else + goto not_there; +#endif + if (strEQ(name, "SOCK_RAW")) +#ifdef SOCK_RAW + return SOCK_RAW; +#else + goto not_there; +#endif + if (strEQ(name, "SOCK_RDM")) +#ifdef SOCK_RDM + return SOCK_RDM; +#else + goto not_there; +#endif + if (strEQ(name, "SOCK_SEQPACKET")) +#ifdef SOCK_SEQPACKET + return SOCK_SEQPACKET; +#else + goto not_there; +#endif + if (strEQ(name, "SOCK_STREAM")) +#ifdef SOCK_STREAM + return SOCK_STREAM; +#else + goto not_there; +#endif + if (strEQ(name, "SOL_SOCKET")) +#ifdef SOL_SOCKET + return SOL_SOCKET; +#else + goto not_there; +#endif + if (strEQ(name, "SOMAXCONN")) +#ifdef SOMAXCONN + return SOMAXCONN; +#else + goto not_there; +#endif + if (strEQ(name, "SO_ACCEPTCONN")) +#ifdef SO_ACCEPTCONN + return SO_ACCEPTCONN; +#else + goto not_there; +#endif + if (strEQ(name, "SO_BROADCAST")) +#ifdef SO_BROADCAST + return SO_BROADCAST; +#else + goto not_there; +#endif + if (strEQ(name, "SO_DEBUG")) +#ifdef SO_DEBUG + return SO_DEBUG; +#else + goto not_there; +#endif + if (strEQ(name, "SO_DONTLINGER")) +#ifdef SO_DONTLINGER + return SO_DONTLINGER; +#else + goto not_there; +#endif + if (strEQ(name, "SO_DONTROUTE")) +#ifdef SO_DONTROUTE + return SO_DONTROUTE; +#else + goto not_there; +#endif + if (strEQ(name, "SO_ERROR")) +#ifdef SO_ERROR + return SO_ERROR; +#else + goto not_there; +#endif + if (strEQ(name, "SO_KEEPALIVE")) +#ifdef SO_KEEPALIVE + return SO_KEEPALIVE; +#else + goto not_there; +#endif + if (strEQ(name, "SO_LINGER")) +#ifdef SO_LINGER + return SO_LINGER; +#else + goto not_there; +#endif + if (strEQ(name, "SO_OOBINLINE")) +#ifdef SO_OOBINLINE + return SO_OOBINLINE; +#else + goto not_there; +#endif + if (strEQ(name, "SO_RCVBUF")) +#ifdef SO_RCVBUF + return SO_RCVBUF; +#else + goto not_there; +#endif + if (strEQ(name, "SO_RCVLOWAT")) +#ifdef SO_RCVLOWAT + return SO_RCVLOWAT; +#else + goto not_there; +#endif + if (strEQ(name, "SO_RCVTIMEO")) +#ifdef SO_RCVTIMEO + return SO_RCVTIMEO; +#else + goto not_there; +#endif + if (strEQ(name, "SO_REUSEADDR")) +#ifdef SO_REUSEADDR + return SO_REUSEADDR; +#else + goto not_there; +#endif + if (strEQ(name, "SO_REUSEPORT")) +#ifdef SO_REUSEPORT + return SO_REUSEPORT; +#else + goto not_there; +#endif + if (strEQ(name, "SO_SNDBUF")) +#ifdef SO_SNDBUF + return SO_SNDBUF; +#else + goto not_there; +#endif + if (strEQ(name, "SO_SNDLOWAT")) +#ifdef SO_SNDLOWAT + return SO_SNDLOWAT; +#else + goto not_there; +#endif + if (strEQ(name, "SO_SNDTIMEO")) +#ifdef SO_SNDTIMEO + return SO_SNDTIMEO; +#else + goto not_there; +#endif + if (strEQ(name, "SO_TYPE")) +#ifdef SO_TYPE + return SO_TYPE; +#else + goto not_there; +#endif + if (strEQ(name, "SO_USELOOPBACK")) +#ifdef SO_USELOOPBACK + return SO_USELOOPBACK; +#else + goto not_there; +#endif + break; + case 'T': + 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; +} + +MODULE = Socket PACKAGE = Socket + +double +constant(name,arg) + char * name + int arg + diff --git a/ext/curses/Makefile b/ext/curses/Makefile deleted file mode 100644 index 107702f..0000000 --- a/ext/curses/Makefile +++ /dev/null @@ -1,16 +0,0 @@ -SRC = .. -GLOBINCS = -LOCINCS = -LIBS = -lcurses -ltermlib `. $(SRC)/config.sh; echo $$libs` - -curseperl: $(SRC)/uperl.o usersub.o curses.o - cc $(SRC)/uperl.o usersub.o curses.o $(LIBS) -o curseperl - -usersub.o: usersub.c - cc -c -I$(SRC) $(GLOBINCS) -DDEBUGGING -g usersub.c - -curses.o: curses.c - cc -c -I$(SRC) $(GLOBINCS) -DDEBUGGING -g curses.c - -curses.c: curses.mus - mus curses.mus >curses.c diff --git a/ext/curses/bsdcurses.mus b/ext/curses/bsdcurses.mus deleted file mode 100644 index 7129418..0000000 --- a/ext/curses/bsdcurses.mus +++ /dev/null @@ -1,698 +0,0 @@ -/* $RCSfile: bsdcurses.mus,v $$Revision: 4.1 $$Date: 92/08/07 18:28:50 $ - * - * $Log: bsdcurses.mus,v $ - * Revision 4.1 92/08/07 18:28:50 lwall - * - * Revision 4.0.1.2 92/06/08 16:05:28 lwall - * patch20: &getcap eventually dumped core in bsdcurses - * - * Revision 4.0.1.1 91/11/05 19:04:53 lwall - * initial checkin - * - * Revision 4.0 91/03/20 01:56:13 lwall - * 4.0 baseline. - * - * Revision 3.0.1.1 90/08/09 04:05:21 lwall - * patch19: Initial revision - * - */ - -#include "EXTERN.h" -#include "perl.h" - -char *savestr(); - -#include - -static enum uservars { - UV_curscr, - UV_stdscr, - UV_Def_term, - UV_My_term, - UV_ttytype, - UV_LINES, - UV_COLS, - UV_ERR, - UV_OK, -}; - -static enum usersubs { - US_addch, - US_waddch, - US_addstr, - US_waddstr, - US_box, - US_clear, - US_wclear, - US_clearok, - US_clrtobot, - US_wclrtobot, - US_clrtoeol, - US_wclrtoeol, - US_delch, - US_wdelch, - US_deleteln, - US_wdeleteln, - US_erase, - US_werase, - US_flushok, - US_idlok, - US_insch, - US_winsch, - US_insertln, - US_winsertln, - US_move, - US_wmove, - US_overlay, - US_overwrite, - US_printw, - US_wprintw, - US_refresh, - US_wrefresh, - US_standout, - US_wstandout, - US_standend, - US_wstandend, - US_cbreak, - US_nocbreak, - US_echo, - US_noecho, - US_getch, - US_wgetch, - US_getstr, - US_wgetstr, - US_raw, - US_noraw, - US_scanw, - US_wscanw, - US_baudrate, - US_delwin, - US_endwin, - US_erasechar, - US_getcap, - US_getyx, - US_inch, - US_winch, - US_initscr, - US_killchar, - US_leaveok, - US_longname, - US_fullname, - US_mvwin, - US_newwin, - US_nl, - US_nonl, - US_scrollok, - US_subwin, - US_touchline, - US_touchoverlap, - US_touchwin, - US_unctrl, - US_gettmode, - US_mvcur, - US_scroll, - US_savetty, - US_resetty, - US_setterm, - US_tstp, - US__putchar, - US_testcallback, -}; - -static int usersub(); -static int userset(); -static int userval(); - -int -init_curses() -{ - struct ufuncs uf; - char *filename = "curses.c"; - - uf.uf_set = userset; - uf.uf_val = userval; - -#define MAGICVAR(name, ix) uf.uf_index = ix, magicname(name, &uf, sizeof uf) - - MAGICVAR("curscr", UV_curscr); - MAGICVAR("stdscr", UV_stdscr); - MAGICVAR("Def_term",UV_Def_term); - MAGICVAR("My_term", UV_My_term); - MAGICVAR("ttytype", UV_ttytype); - MAGICVAR("LINES", UV_LINES); - MAGICVAR("COLS", UV_COLS); - MAGICVAR("ERR", UV_ERR); - MAGICVAR("OK", UV_OK); - - make_usub("addch", US_addch, usersub, filename); - make_usub("waddch", US_waddch, usersub, filename); - make_usub("addstr", US_addstr, usersub, filename); - make_usub("waddstr", US_waddstr, usersub, filename); - make_usub("box", US_box, usersub, filename); - make_usub("clear", US_clear, usersub, filename); - make_usub("wclear", US_wclear, usersub, filename); - make_usub("clearok", US_clearok, usersub, filename); - make_usub("clrtobot", US_clrtobot, usersub, filename); - make_usub("wclrtobot", US_wclrtobot, usersub, filename); - make_usub("clrtoeol", US_clrtoeol, usersub, filename); - make_usub("wclrtoeol", US_wclrtoeol, usersub, filename); - make_usub("delch", US_delch, usersub, filename); - make_usub("wdelch", US_wdelch, usersub, filename); - make_usub("deleteln", US_deleteln, usersub, filename); - make_usub("wdeleteln", US_wdeleteln, usersub, filename); - make_usub("erase", US_erase, usersub, filename); - make_usub("werase", US_werase, usersub, filename); - make_usub("flushok", US_flushok, usersub, filename); - make_usub("idlok", US_idlok, usersub, filename); - make_usub("insch", US_insch, usersub, filename); - make_usub("winsch", US_winsch, usersub, filename); - make_usub("insertln", US_insertln, usersub, filename); - make_usub("winsertln", US_winsertln, usersub, filename); - make_usub("move", US_move, usersub, filename); - make_usub("wmove", US_wmove, usersub, filename); - make_usub("overlay", US_overlay, usersub, filename); - make_usub("overwrite", US_overwrite, usersub, filename); - make_usub("printw", US_printw, usersub, filename); - make_usub("wprintw", US_wprintw, usersub, filename); - make_usub("refresh", US_refresh, usersub, filename); - make_usub("wrefresh", US_wrefresh, usersub, filename); - make_usub("standout", US_standout, usersub, filename); - make_usub("wstandout", US_wstandout, usersub, filename); - make_usub("standend", US_standend, usersub, filename); - make_usub("wstandend", US_wstandend, usersub, filename); - make_usub("cbreak", US_cbreak, usersub, filename); - make_usub("nocbreak", US_nocbreak, usersub, filename); - make_usub("echo", US_echo, usersub, filename); - make_usub("noecho", US_noecho, usersub, filename); - make_usub("getch", US_getch, usersub, filename); - make_usub("wgetch", US_wgetch, usersub, filename); - make_usub("getstr", US_getstr, usersub, filename); - make_usub("wgetstr", US_wgetstr, usersub, filename); - make_usub("raw", US_raw, usersub, filename); - make_usub("noraw", US_noraw, usersub, filename); - make_usub("scanw", US_scanw, usersub, filename); - make_usub("wscanw", US_wscanw, usersub, filename); - make_usub("baudrate", US_baudrate, usersub, filename); - make_usub("delwin", US_delwin, usersub, filename); - make_usub("endwin", US_endwin, usersub, filename); - make_usub("erasechar", US_erasechar, usersub, filename); - make_usub("getcap", US_getcap, usersub, filename); - make_usub("getyx", US_getyx, usersub, filename); - make_usub("inch", US_inch, usersub, filename); - make_usub("winch", US_winch, usersub, filename); - make_usub("initscr", US_initscr, usersub, filename); - make_usub("killchar", US_killchar, usersub, filename); - make_usub("leaveok", US_leaveok, usersub, filename); - make_usub("longname", US_longname, usersub, filename); - make_usub("fullname", US_fullname, usersub, filename); - make_usub("mvwin", US_mvwin, usersub, filename); - make_usub("newwin", US_newwin, usersub, filename); - make_usub("nl", US_nl, usersub, filename); - make_usub("nonl", US_nonl, usersub, filename); - make_usub("scrollok", US_scrollok, usersub, filename); - make_usub("subwin", US_subwin, usersub, filename); - make_usub("touchline", US_touchline, usersub, filename); - make_usub("touchoverlap", US_touchoverlap,usersub, filename); - make_usub("touchwin", US_touchwin, usersub, filename); - make_usub("unctrl", US_unctrl, usersub, filename); - make_usub("gettmode", US_gettmode, usersub, filename); - make_usub("mvcur", US_mvcur, usersub, filename); - make_usub("scroll", US_scroll, usersub, filename); - make_usub("savetty", US_savetty, usersub, filename); - make_usub("resetty", US_resetty, usersub, filename); - make_usub("setterm", US_setterm, usersub, filename); - make_usub("tstp", US_tstp, usersub, filename); - make_usub("_putchar", US__putchar, usersub, filename); - make_usub("testcallback", US_testcallback,usersub, filename); -}; - -static int -usersub(ix, sp, items) -int ix; -register int sp; -register int items; -{ - STR **st = stack->ary_array + sp; - register int i; - register char *tmps; - register STR *Str; /* used in str_get and str_gnum macros */ - - switch (ix) { -CASE int addch -I char ch -END - -CASE int waddch -I WINDOW* win -I char ch -END - -CASE int addstr -I char* str -END - -CASE int waddstr -I WINDOW* win -I char* str -END - -CASE int box -I WINDOW* win -I char vert -I char hor -END - -CASE int clear -END - -CASE int wclear -I WINDOW* win -END - -CASE int clearok -I WINDOW* win -I bool boolf -END - -CASE int clrtobot -END - -CASE int wclrtobot -I WINDOW* win -END - -CASE int clrtoeol -END - -CASE int wclrtoeol -I WINDOW* win -END - -CASE int delch -END - -CASE int wdelch -I WINDOW* win -END - -CASE int deleteln -END - -CASE int wdeleteln -I WINDOW* win -END - -CASE int erase -END - -CASE int werase -I WINDOW* win -END - -CASE int flushok -I WINDOW* win -I bool boolf -END - -CASE int idlok -I WINDOW* win -I bool boolf -END - -CASE int insch -I char c -END - -CASE int winsch -I WINDOW* win -I char c -END - -CASE int insertln -END - -CASE int winsertln -I WINDOW* win -END - -CASE int move -I int y -I int x -END - -CASE int wmove -I WINDOW* win -I int y -I int x -END - -CASE int overlay -I WINDOW* win1 -I WINDOW* win2 -END - -CASE int overwrite -I WINDOW* win1 -I WINDOW* win2 -END - - case US_printw: - if (items < 1) - fatal("Usage: &printw($fmt, $arg1, $arg2, ... )"); - else { - int retval; - STR* str = str_new(0); - - do_sprintf(str, items, st + 1); - retval = addstr(str->str_ptr); - str_numset(st[0], (double) retval); - str_free(str); - } - return sp; - - case US_wprintw: - if (items < 2) - fatal("Usage: &wprintw($win, $fmt, $arg1, $arg2, ... )"); - else { - int retval; - STR* str = str_new(0); - WINDOW* win = *(WINDOW**) str_get(st[1]); - - do_sprintf(str, items - 1, st + 1); - retval = waddstr(win, str->str_ptr); - str_numset(st[0], (double) retval); - str_free(str); - } - return sp; - -CASE int refresh -END - -CASE int wrefresh -I WINDOW* win -END - -CASE int standout -END - -CASE int wstandout -I WINDOW* win -END - -CASE int standend -END - -CASE int wstandend -I WINDOW* win -END - -CASE int cbreak -END - -CASE int nocbreak -END - -CASE int echo -END - -CASE int noecho -END - - case US_getch: - if (items != 0) - fatal("Usage: &getch()"); - else { - int retval; - char retch; - - retval = getch(); - if (retval == EOF) - st[0] = &str_undef; - else { - retch = retval; - str_nset(st[0], &retch, 1); - } - } - return sp; - - case US_wgetch: - if (items != 1) - fatal("Usage: &wgetch($win)"); - else { - int retval; - char retch; - WINDOW* win = *(WINDOW**) str_get(st[1]); - - retval = wgetch(win); - if (retval == EOF) - st[0] = &str_undef; - else { - retch = retval; - str_nset(st[0], &retch, 1); - } - } - return sp; - -CASE int getstr -IO char* str -END - -CASE int wgetstr -I WINDOW* win -IO char* str -END - -CASE int raw -END - -CASE int noraw -END - -CASE int baudrate -END - -CASE int delwin -I WINDOW* win -END - -CASE int endwin -END - -CASE int erasechar -END - - case US_getcap: - if (items != 1) - fatal("Usage: &getcap($str)"); - else { - char* retval; - char* str = (char*) str_get(st[1]); - char output[50], *outputp = output; - - retval = tgetstr(str, &outputp); - str_set(st[0], (char*) retval); - } - return sp; - - case US_getyx: - if (items != 3) - fatal("Usage: &getyx($win, $y, $x)"); - else { - int retval; - STR* str = str_new(0); - WINDOW* win = *(WINDOW**) str_get(st[1]); - int y; - int x; - - do_sprintf(str, items - 1, st + 1); - retval = getyx(win, y, x); - str_numset(st[2], (double)y); - str_numset(st[3], (double)x); - str_numset(st[0], (double) retval); - str_free(str); - } - return sp; - - -CASE int inch -END - -CASE int winch -I WINDOW* win -END - -CASE WINDOW* initscr -END - -CASE int killchar -END - -CASE int leaveok -I WINDOW* win -I bool boolf -END - -CASE char* longname -I char* termbuf -IO char* name -END - -CASE int fullname -I char* termbuf -IO char* name -END - -CASE int mvwin -I WINDOW* win -I int y -I int x -END - -CASE WINDOW* newwin -I int lines -I int cols -I int begin_y -I int begin_x -END - -CASE int nl -END - -CASE int nonl -END - -CASE int scrollok -I WINDOW* win -I bool boolf -END - -CASE WINDOW* subwin -I WINDOW* win -I int lines -I int cols -I int begin_y -I int begin_x -END - -CASE int touchline -I WINDOW* win -I int y -I int startx -I int endx -END - -CASE int touchoverlap -I WINDOW* win1 -I WINDOW* win2 -END - -CASE int touchwin -I WINDOW* win -END - -CASE char* unctrl -I char ch -END - -CASE int gettmode -END - -CASE int mvcur -I int lasty -I int lastx -I int newy -I int newx -END - -CASE int scroll -I WINDOW* win -END - -CASE int savetty -END - -CASE void resetty -END - -CASE int setterm -I char* name -END - -CASE int tstp -END - -CASE int _putchar -I char ch -END - - case US_testcallback: - sp = callback("callback", sp + items, curcsv->wantarray, 1, items); - break; - - default: - fatal("Unimplemented user-defined subroutine"); - } - return sp; -} - -static int -userval(ix, str) -int ix; -STR *str; -{ - switch (ix) { - case UV_COLS: - str_numset(str, (double)COLS); - break; - case UV_Def_term: - str_set(str, Def_term); - break; - case UV_ERR: - str_numset(str, (double)ERR); - break; - case UV_LINES: - str_numset(str, (double)LINES); - break; - case UV_My_term: - str_numset(str, (double)My_term); - break; - case UV_OK: - str_numset(str, (double)OK); - break; - case UV_curscr: - str_nset(str, &curscr, sizeof(WINDOW*)); - break; - case UV_stdscr: - str_nset(str, &stdscr, sizeof(WINDOW*)); - break; - case UV_ttytype: - str_set(str, ttytype); - break; - } - return 0; -} - -static int -userset(ix, str) -int ix; -STR *str; -{ - switch (ix) { - case UV_COLS: - COLS = (int)str_gnum(str); - break; - case UV_Def_term: - Def_term = savestr(str_get(str)); /* never freed */ - break; - case UV_LINES: - LINES = (int)str_gnum(str); - break; - case UV_My_term: - My_term = (bool)str_gnum(str); - break; - case UV_ttytype: - strcpy(ttytype, str_get(str)); /* hope it fits */ - break; - } - return 0; -} diff --git a/ext/curses/curses.mus b/ext/curses/curses.mus deleted file mode 100644 index 35510f4..0000000 --- a/ext/curses/curses.mus +++ /dev/null @@ -1,889 +0,0 @@ -/* $RCSfile: curses.mus,v $$Revision: 4.1 $$Date: 92/08/07 18:28:53 $ - * - * $Log: curses.mus,v $ - * Revision 4.1 92/08/07 18:28:53 lwall - * - * Revision 4.0.1.2 92/06/08 16:06:12 lwall - * patch20: function key support added to curses.mus - * - * Revision 4.0.1.1 91/11/05 19:06:19 lwall - * patch11: usub/curses.mus now supports SysV curses - * - * Revision 4.0 91/03/20 01:56:13 lwall - * 4.0 baseline. - * - * Revision 3.0.1.1 90/08/09 04:05:21 lwall - * patch19: Initial revision - * - */ - -#include "EXTERN.h" -#include "perl.h" - -char *savestr(); - -#undef bool -#include - -#ifndef A_UNDERLINE -#define NOSETATTR -#define A_STANDOUT 0x0200 -#define A_UNDERLINE 0x0100 -#define A_REVERSE 0x0200 -#define A_BLINK 0x0400 -#define A_BOLD 0x0800 -#define A_ALTCHARSET 0x1000 -#define A_NORMAL 0 -#endif - -#ifdef USG -static char *tcbuf = NULL; -#endif - -#ifdef NOSETATTR -static unsigned curattr = NORMAL; -#endif - -static enum uservars { - UV_curscr, - UV_stdscr, - UV_ttytype, - UV_LINES, - UV_COLS, - UV_ERR, - UV_OK, -#ifdef BSD - UV_Def_term, - UV_My_term, -#endif - UV_A_STANDOUT, - UV_A_UNDERLINE, - UV_A_REVERSE, - UV_A_BLINK, - UV_A_DIM, - UV_A_BOLD, - UV_A_NORMAL, -}; - -static enum usersubs { - US_addch, - US_waddch, - US_addstr, - US_waddstr, - US_box, - US_clear, - US_wclear, - US_clearok, - US_clrtobot, - US_wclrtobot, - US_clrtoeol, - US_wclrtoeol, - US_delch, - US_wdelch, - US_deleteln, - US_wdeleteln, - US_erase, - US_werase, - US_idlok, - US_insch, - US_winsch, - US_insertln, - US_winsertln, - US_move, - US_wmove, - US_overlay, - US_overwrite, - US_refresh, - US_wrefresh, - US_standout, - US_wstandout, - US_standend, - US_wstandend, - US_cbreak, - US_nocbreak, - US_echo, - US_noecho, - US_getch, - US_wgetch, - US_getstr, - US_wgetstr, - US_raw, - US_noraw, - US_baudrate, - US_delwin, - US_endwin, - US_erasechar, - US_getyx, - US_inch, - US_winch, - US_initscr, - US_killchar, - US_leaveok, - US_longname, - US_mvwin, - US_newwin, - US_nl, - US_nonl, - US_scrollok, - US_subwin, - US_touchline, - US_touchwin, - US_unctrl, - US_gettmode, - US_mvcur, - US_scroll, - US_savetty, - US_resetty, - US_setterm, - US_attroff, - US_wattroff, - US_attron, - US_wattron, - US_attrset, - US_wattrset, -#ifdef CURSEFMT - US_printw, /* remove */ - US_wprintw, /* remove */ - US_scanw, /* delete */ - US_wscanw, /* delete */ -#endif - US_getcap, -#ifdef BSD - US_flushok, - US_fullname, - US_touchoverlap, - US_tstp, - US__putchar, -#endif - US_mysub, - US_testcallback, -}; - -static int usersub(); -static int userset(); -static int userval(); - -int -init_curses() -{ - struct ufuncs uf; - char *filename = "curses.c"; - - uf.uf_set = userset; - uf.uf_val = userval; - -#define MAGICVAR(name, ix) uf.uf_index = ix, magicname(name, &uf, sizeof uf) - - MAGICVAR("curscr", UV_curscr); - MAGICVAR("stdscr", UV_stdscr); - MAGICVAR("ttytype", UV_ttytype); - MAGICVAR("LINES", UV_LINES); - MAGICVAR("COLS", UV_COLS); - MAGICVAR("ERR", UV_ERR); - MAGICVAR("OK", UV_OK); -#ifdef BSD - MAGICVAR("Def_term",UV_Def_term); - MAGICVAR("My_term", UV_My_term); -#endif - MAGICVAR("A_STANDOUT", UV_A_STANDOUT); - MAGICVAR("A_UNDERLINE", UV_A_UNDERLINE); - MAGICVAR("A_REVERSE", UV_A_REVERSE); - MAGICVAR("A_BLINK", UV_A_BLINK); - MAGICVAR("A_DIM", UV_A_DIM); - MAGICVAR("A_BOLD", UV_A_BOLD); - MAGICVAR("A_NORMAL", UV_A_NORMAL); - - make_usub("addch", US_addch, usersub, filename); - make_usub("waddch", US_waddch, usersub, filename); - make_usub("addstr", US_addstr, usersub, filename); - make_usub("waddstr", US_waddstr, usersub, filename); - make_usub("box", US_box, usersub, filename); - make_usub("clear", US_clear, usersub, filename); - make_usub("wclear", US_wclear, usersub, filename); - make_usub("clearok", US_clearok, usersub, filename); - make_usub("clrtobot", US_clrtobot, usersub, filename); - make_usub("wclrtobot", US_wclrtobot, usersub, filename); - make_usub("clrtoeol", US_clrtoeol, usersub, filename); - make_usub("wclrtoeol", US_wclrtoeol, usersub, filename); - make_usub("delch", US_delch, usersub, filename); - make_usub("wdelch", US_wdelch, usersub, filename); - make_usub("deleteln", US_deleteln, usersub, filename); - make_usub("wdeleteln", US_wdeleteln, usersub, filename); - make_usub("erase", US_erase, usersub, filename); - make_usub("werase", US_werase, usersub, filename); - make_usub("idlok", US_idlok, usersub, filename); - make_usub("insch", US_insch, usersub, filename); - make_usub("winsch", US_winsch, usersub, filename); - make_usub("insertln", US_insertln, usersub, filename); - make_usub("winsertln", US_winsertln, usersub, filename); - make_usub("move", US_move, usersub, filename); - make_usub("wmove", US_wmove, usersub, filename); - make_usub("overlay", US_overlay, usersub, filename); - make_usub("overwrite", US_overwrite, usersub, filename); - make_usub("refresh", US_refresh, usersub, filename); - make_usub("wrefresh", US_wrefresh, usersub, filename); - make_usub("standout", US_standout, usersub, filename); - make_usub("wstandout", US_wstandout, usersub, filename); - make_usub("standend", US_standend, usersub, filename); - make_usub("wstandend", US_wstandend, usersub, filename); - make_usub("cbreak", US_cbreak, usersub, filename); - make_usub("nocbreak", US_nocbreak, usersub, filename); - make_usub("echo", US_echo, usersub, filename); - make_usub("noecho", US_noecho, usersub, filename); - make_usub("getch", US_getch, usersub, filename); - make_usub("wgetch", US_wgetch, usersub, filename); - make_usub("getstr", US_getstr, usersub, filename); - make_usub("wgetstr", US_wgetstr, usersub, filename); - make_usub("raw", US_raw, usersub, filename); - make_usub("noraw", US_noraw, usersub, filename); - make_usub("baudrate", US_baudrate, usersub, filename); - make_usub("delwin", US_delwin, usersub, filename); - make_usub("endwin", US_endwin, usersub, filename); - make_usub("erasechar", US_erasechar, usersub, filename); - make_usub("getyx", US_getyx, usersub, filename); - make_usub("inch", US_inch, usersub, filename); - make_usub("winch", US_winch, usersub, filename); - make_usub("initscr", US_initscr, usersub, filename); - make_usub("killchar", US_killchar, usersub, filename); - make_usub("leaveok", US_leaveok, usersub, filename); - make_usub("longname", US_longname, usersub, filename); - make_usub("mvwin", US_mvwin, usersub, filename); - make_usub("newwin", US_newwin, usersub, filename); - make_usub("nl", US_nl, usersub, filename); - make_usub("nonl", US_nonl, usersub, filename); - make_usub("scrollok", US_scrollok, usersub, filename); - make_usub("subwin", US_subwin, usersub, filename); - make_usub("touchline", US_touchline, usersub, filename); - make_usub("touchwin", US_touchwin, usersub, filename); - make_usub("unctrl", US_unctrl, usersub, filename); - make_usub("gettmode", US_gettmode, usersub, filename); - make_usub("mvcur", US_mvcur, usersub, filename); - make_usub("scroll", US_scroll, usersub, filename); - make_usub("savetty", US_savetty, usersub, filename); - make_usub("resetty", US_resetty, usersub, filename); - make_usub("setterm", US_setterm, usersub, filename); - make_usub("getcap", US_getcap, usersub, filename); - make_usub("attroff", US_attroff, usersub, filename); - make_usub("wattroff", US_wattroff, usersub, filename); - make_usub("attron", US_attron, usersub, filename); - make_usub("wattron", US_wattron, usersub, filename); - make_usub("attrset", US_attrset, usersub, filename); - make_usub("wattrset", US_wattrset, usersub, filename); -#ifdef CURSEFMT - make_usub("printw", US_printw, usersub, filename); - make_usub("wprintw", US_wprintw, usersub, filename); - make_usub("scanw", US_scanw, usersub, filename); - make_usub("wscanw", US_wscanw, usersub, filename); -#endif -#ifdef BSD - make_usub("flushok", US_flushok, usersub, filename); - make_usub("fullname", US_fullname, usersub, filename); - make_usub("touchoverlap", US_touchoverlap,usersub, filename); - make_usub("tstp", US_tstp, usersub, filename); - make_usub("_putchar", US__putchar, usersub, filename); -#endif - make_usub("testcallback", US_testcallback,usersub, filename); - }; - -#ifdef USG -static char -*getcap(cap) -register char *cap; -{ - static char nocaperr[] = "Cannot read termcap entry."; - - extern char *tgetstr(); - - if (tcbuf == NULL) { - if ((tcbuf = malloc(1024)) == NULL) { - fatal(nocaperr); - } - if (tgetent(tcbuf, ttytype) == -1) { - fatal(nocaperr); - } - } - - return (tgetstr(cap, NULL)); -} -#endif - -#ifdef NOSETATTR -#define attron(attr) wattron(stdscr, attr) -#define attroff(attr) wattroff(stdscr, attr) -#define attset(attr) wattset(stdscr, attr) - -int -wattron(win, attr) -WINDOW *win; -chtype attr; -{ - curattr |= attr; - if (curattr & A_STANDOUT) { - return(wstandout(win)); - } else { - return(wstandend(win)); - } -} - -int -wattroff(win, attr) -WINDOW *win; -chtype attr; -{ - curattr &= (~attr); - if (curattr & A_STANDOUT) { - return(wstandout(win)); - } else { - return(wstandend(win)); - } -} - -int -wattrset(win, attr) -WINDOW *win; -chtype attr; -{ - curattr = attr; - if (curattr & A_STANDOUT) { - return(wstandout(win)); - } else { - return(wstandend(win)); - } -} - -#endif - -static int -usersub(ix, sp, items) -int ix; -register int sp; -register int items; -{ - STR **st = stack->ary_array + sp; - register int i; - register char *tmps; - register STR *Str; /* used in str_get and str_gnum macros */ - - switch (ix) { -CASE int addch -I char ch -END - -CASE int waddch -I WINDOW* win -I char ch -END - -CASE int addstr -I char* str -END - -CASE int waddstr -I WINDOW* win -I char* str -END - -CASE int box -I WINDOW* win -I char vert -I char hor -END - -CASE int clear -END - -CASE int wclear -I WINDOW* win -END - -CASE int clearok -I WINDOW* win -I bool boolf -END - -CASE int clrtobot -END - -CASE int wclrtobot -I WINDOW* win -END - -CASE int clrtoeol -END - -CASE int wclrtoeol -I WINDOW* win -END - -CASE int delch -END - -CASE int wdelch -I WINDOW* win -END - -CASE int deleteln -END - -CASE int wdeleteln -I WINDOW* win -END - -CASE int erase -END - -CASE int werase -I WINDOW* win -END - -CASE int idlok -I WINDOW* win -I bool boolf -END - -CASE int insch -I char c -END - -CASE int winsch -I WINDOW* win -I char c -END - -CASE int insertln -END - -CASE int winsertln -I WINDOW* win -END - -CASE int move -I int y -I int x -END - -CASE int wmove -I WINDOW* win -I int y -I int x -END - -CASE int overlay -I WINDOW* win1 -I WINDOW* win2 -END - -CASE int overwrite -I WINDOW* win1 -I WINDOW* win2 -END - -CASE int refresh -END - -CASE int wrefresh -I WINDOW* win -END - -CASE int standout -END - -CASE int wstandout -I WINDOW* win -END - -CASE int standend -END - -CASE int wstandend -I WINDOW* win -END - -CASE int cbreak -END - -CASE int nocbreak -END - -CASE int echo -END - -CASE int noecho -END - - case US_getch: - if (items != 0) - fatal("Usage: &getch()"); - else { - int retval; - char retch; - - retval = getch(); - if (retval == EOF) - st[0] = &str_undef; - else { - retch = retval; - if (retval > 0377) - str_numset(st[0], (double) retval); - else - str_nset(st[0], &retch, 1); - } - } - return sp; - - case US_wgetch: - if (items != 1) - fatal("Usage: &wgetch($win)"); - else { - int retval; - char retch; - WINDOW* win = *(WINDOW**) str_get(st[1]); - - retval = wgetch(win); - if (retval == EOF) - st[0] = &str_undef; - else { - retch = retval; - if (retval > 0377) - str_numset(st[0], (double) retval); - else - str_nset(st[0], &retch, 1); - } - } - return sp; - -CASE int getstr -O char* str -END - -CASE int wgetstr -I WINDOW* win -O char* str -END - -CASE int raw -END - -CASE int noraw -END - -CASE int baudrate -END - -CASE int delwin -I WINDOW* win -END - -CASE int endwin -END - -CASE int erasechar -END - - case US_getyx: - if (items != 3) - fatal("Usage: &getyx($win, $y, $x)"); - else { - int retval; - STR* str = str_new(0); - WINDOW* win = *(WINDOW**) str_get(st[1]); - int y; - int x; - - do_sprintf(str, items - 1, st + 1); - retval = getyx(win, y, x); - str_numset(st[2], (double)y); - str_numset(st[3], (double)x); - str_numset(st[0], (double) retval); - str_free(str); - } - return sp; - -CASE int inch -END - -CASE int winch -I WINDOW* win -END - -CASE WINDOW* initscr -END - -CASE int killchar -END - -CASE int leaveok -I WINDOW* win -I bool boolf -END - -#ifdef BSD -CASE char* longname -I char* termbuf -IO char* name -END -#else -CASE char* longname -I char* termbug -I char* name -END -#endif - -CASE int mvwin -I WINDOW* win -I int y -I int x -END - -CASE WINDOW* newwin -I int lines -I int cols -I int begin_y -I int begin_x -END - -CASE int nl -END - -CASE int nonl -END - -CASE int scrollok -I WINDOW* win -I bool boolf -END - -CASE WINDOW* subwin -I WINDOW* win -I int lines -I int cols -I int begin_y -I int begin_x -END - -CASE int touchline -I WINDOW* win -I int y -I int startx -I int endx -END - -CASE int touchwin -I WINDOW* win -END - -CASE char* unctrl -I char ch -END - -CASE int gettmode -END - -CASE int mvcur -I int lasty -I int lastx -I int newy -I int newx -END - -CASE int scroll -I WINDOW* win -END - -CASE int savetty -END - -CASE void resetty -END - -CASE int setterm -I char* name -END - -CASE int attroff -I chtype str -END - -CASE int wattroff -I chtype str -END - -CASE int wattron -I chtype str -END - -CASE int attron -I chtype str -END - -CASE int attrset -I chtype str -END - -CASE int wattrset -I chtype str -END - -#ifdef CURSEFMT - case US_printw: - if (items < 1) - fatal("Usage: &printw($fmt, $arg1, $arg2, ... )"); - else { - int retval; - STR* str = str_new(0); - - do_sprintf(str, items, st + 1); - retval = addstr(str->str_ptr); - str_numset(st[0], (double) retval); - str_free(str); - } - return sp; - - case US_wprintw: - if (items < 2) - fatal("Usage: &wprintw($win, $fmt, $arg1, $arg2, ... )"); - else { - int retval; - STR* str = str_new(0); - WINDOW* win = *(WINDOW**) str_get(st[1]); - - do_sprintf(str, items - 1, st + 1); - retval = waddstr(win, str->str_ptr); - str_numset(st[0], (double) retval); - str_free(str); - } - return sp; - -#endif - -CASE char* getcap -I char* str -END - -#ifdef BSD -CASE int flushok -I WINDOW* win -I bool boolf -END - -CASE int fullname -I char* termbuf -IO char* name -END - -CASE int touchoverlap -I WINDOW* win1 -I WINDOW* win2 -END - -CASE int tstp -END - -CASE int _putchar -I char ch -END - - case US_testcallback: - sp = callback("callback", sp + items, curcsv->wantarray, 1, items); - break; - -#endif - - default: - fatal("Unimplemented user-defined subroutine"); - } - return sp; -} - -static int -userval(ix, str) -int ix; -STR *str; -{ - switch (ix) { - case UV_COLS: - str_numset(str, (double)COLS); - break; - case UV_ERR: - str_numset(str, (double)ERR); - break; - case UV_LINES: - str_numset(str, (double)LINES); - break; - case UV_OK: - str_numset(str, (double)OK); - break; - case UV_curscr: - str_nset(str, &curscr, sizeof(WINDOW*)); - break; - case UV_stdscr: - str_nset(str, &stdscr, sizeof(WINDOW*)); - break; - case UV_ttytype: - str_set(str, ttytype); - break; -#ifdef BSD - case UV_Def_term: - str_set(str, Def_term); - break; - case UV_My_term: - str_numset(str, (double)My_term); - break; -#endif - case UV_A_STANDOUT: - str_numset(str, (double)A_STANDOUT); - break; - case UV_A_UNDERLINE: - str_numset(str, (double)A_UNDERLINE); - break; - case UV_A_REVERSE: - str_numset(str, (double)A_REVERSE); - break; - case UV_A_BLINK: - str_numset(str, (double)A_BLINK); - break; - case UV_A_DIM: - str_numset(str, (double)A_DIM); - break; - case UV_A_BOLD: - str_numset(str, (double)A_BOLD); - break; - case UV_A_NORMAL: - str_numset(str, (double)A_NORMAL); - break; - } - return 0; -} - -static int -userset(ix, str) -int ix; -STR *str; -{ - switch (ix) { - case UV_COLS: - COLS = (int)str_gnum(str); - break; - case UV_LINES: - LINES = (int)str_gnum(str); - break; - case UV_ttytype: - strcpy(ttytype, str_get(str)); /* hope it fits */ -#ifdef USG - if (tcbuf != NULL) { - free(tcbuf); - tcbuf = NULL; - } -#endif - break; -#ifdef BSD - case UV_Def_term: - Def_term = savestr(str_get(str)); /* never freed */ - break; - case UV_My_term: - My_term = (bool)str_gnum(str); - break; -#endif - } - return 0; -} diff --git a/ext/curses/pager b/ext/curses/pager deleted file mode 100644 index 407bc50..0000000 --- a/ext/curses/pager +++ /dev/null @@ -1,190 +0,0 @@ -#!./curseperl - -eval <<'EndOfMain'; $evaloffset = __LINE__; - - $SIG{'INT'} = 'endit'; - $| = 1; # command buffering on stdout - &initterm; - &inithelp; - &slurpfile && &pagearray; - -EndOfMain - -&endit; - -################################################################################ - -sub initterm { - - &initscr; &cbreak; &noecho; &scrollok($stdscr, 1); - &defbell unless defined &bell; - - $lines = $LINES; $lines1 = $lines - 1; $lines2 = $lines - 2; - $cols = $COLS; $cols1 = $cols - 1; $cols2 = $cols - 2;; - - $dl = &getcap('dl'); - $al = &getcap('al'); - $ho = &getcap('ho'); - $ce = &getcap('ce'); -} - -sub slurpfile { - while (<>) { - s/^(\t+)/' ' x length($1)/e; - &expand($_) if /\t/; - if (length($_) < $cols) { - push(@lines, $_); - } - else { - while ($_ && $_ ne "\n") { - push(@lines, substr($_,0,$cols)); - substr($_,0,$cols) = ''; - } - } - } - 1; -} - -sub drawscreen { - &move(0,0); - for ($line .. $line + $lines2) { - &addstr($lines[$_]); - } - &clrtobot; - &percent; - &refresh; -} - -sub expand { - while (($off = index($_[0],"\t")) >= 0) { - substr($_[0], $off, 1) = ' ' x (8 - $off % 8); - } -} - -sub pagearray { - $line = 0; - - $| = 1; - - for (&drawscreen;;&drawscreen) { - - $ch = &getch; - $ch = 'j' if $ch eq "\n"; - - if ($ch eq ' ') { - last if $percent >= 100; - &move(0,0); - $line += $lines1; - } - elsif ($ch eq 'b') { - $line -= $lines1; - &move(0,0); - $line = 0 if $line < 0; - } - elsif ($ch eq 'j') { - next if $percent >= 100; - $line += 1; - if ($dl && $ho) { - print $ho, $dl; - &mvcur(0,0,$lines2,0); - print $ce,$lines[$line+$lines2],$ce; - &wmove($curscr,0,0); - &wdeleteln($curscr); - &wmove($curscr,$lines2,0); - &waddstr($curscr,$lines[$line+$lines2]); - } - &wmove($stdscr,0,0); - &wdeleteln($stdscr); - &wmove($stdscr,$lines2,0); - &waddstr($stdscr,$lines[$line+$lines2]); - &percent; - &refresh; - redo; - } - elsif ($ch eq 'k') { - next if $line <= 0; - $line -= 1; - if ($al && $ho && $ce) { - print $ho, $al, $ce, $lines[$line]; - &wmove($curscr,0,0); - &winsertln($curscr); - &waddstr($curscr,$lines[$line]); - } - &wmove($stdscr,0,0); - &winsertln($stdscr); - &waddstr($stdscr,$lines[$line]); - &percent; - &refresh; - redo; - } - elsif ($ch eq "\f") { - &clear; - } - elsif ($ch eq 'q') { - last; - } - elsif ($ch eq 'h') { - &clear; - &help; - &clear; - } - else { - &bell; - } - } -} - -sub defbell { - eval q# - sub bell { - print "\007"; - } - #; -} - -sub help { - local(*lines) = *helplines; - local($line); - &pagearray; -} - -sub inithelp { - @helplines = split(/\n/,<<'EOT'); - - h Display this help. - q Exit. - - SPACE Forward screen. - b Backward screen. - j, CR Forward 1 line. - k Backward 1 line. - FF Repaint screen. -EOT - for (@helplines) { - s/$/\n/; - } -} - -sub percent { - &standout; - $percent = int(($line + $lines1) * 100 / @lines); - &move($lines1,0); - &addstr("($percent%)"); - &standend; - &clrtoeol; -} - -sub endit { - &move($lines1,0); - &clrtoeol; - &refresh; - &endwin; - - if ($@) { - print ""; # force flush of stdout - $@ =~ s/\(eval\)/$0/ && $@ =~ s/line (\d+)/'line ' . ($1 + $evaloffset)/e; - die $@; - } - - exit; -} diff --git a/ext/dbm/GDBM_File.c b/ext/dbm/GDBM_File.c deleted file mode 100644 index f940a59..0000000 --- a/ext/dbm/GDBM_File.c +++ /dev/null @@ -1,310 +0,0 @@ -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" -#include - -#include - -typedef GDBM_FILE GDBM_File; - -#define gdbm_new(dbtype, name, block_size, read_write, mode, fatal_func) \ - gdbm_open(name, block_size, read_write, mode, fatal_func) - -typedef datum gdatum; - -typedef void (*FATALFUNC)(); - -static int -XS_GDBM_File_gdbm_new(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 5 || items > 6) { - croak("Usage: GDBM_File::new(dbtype, name, block_size, read_write, mode, fatal_func = (FATALFUNC)croak)"); - } - { - char * dbtype = SvPV(ST(1),na); - char * name = SvPV(ST(2),na); - int block_size = (int)SvIV(ST(3)); - int read_write = (int)SvIV(ST(4)); - int mode = (int)SvIV(ST(5)); - FATALFUNC fatal_func; - GDBM_File RETVAL; - - if (items < 6) - fatal_func = (FATALFUNC)croak; - else { - fatal_func = (FATALFUNC)SvPV(ST(6),na); - } - - RETVAL = gdbm_new(dbtype, name, block_size, read_write, mode, fatal_func); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setptrobj(ST(0), RETVAL, "GDBM_File"); - } - return sp; -} - -static int -XS_GDBM_File_gdbm_open(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 4 || items > 5) { - croak("Usage: GDBM_File::open(name, block_size, read_write, mode, fatal_func = (FATALFUNC)croak)"); - } - { - char * name = SvPV(ST(1),na); - int block_size = (int)SvIV(ST(2)); - int read_write = (int)SvIV(ST(3)); - int mode = (int)SvIV(ST(4)); - FATALFUNC fatal_func; - GDBM_File RETVAL; - - if (items < 5) - fatal_func = (FATALFUNC)croak; - else { - fatal_func = (FATALFUNC)SvPV(ST(5),na); - } - - RETVAL = gdbm_open(name, block_size, read_write, mode, fatal_func); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setptrobj(ST(0), RETVAL, "GDBM_File"); - } - return sp; -} - -static int -XS_GDBM_File_gdbm_close(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 1 || items > 1) { - croak("Usage: GDBM_File::close(db)"); - } - { - GDBM_File db; - - if (sv_isa(ST(1), "GDBM_File")) - db = (GDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); - else - croak("db is not of type GDBM_File"); - - gdbm_close(db); - } - return sp; -} - -static int -XS_GDBM_File_gdbm_DESTROY(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 1 || items > 1) { - croak("Usage: GDBM_File::DESTROY(db)"); - } - { - GDBM_File db; - - if (sv_isa(ST(1), "GDBM_File")) - db = (GDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); - else - croak("db is not of type GDBM_File"); - gdbm_close(db); - } - return sp; -} - -static int -XS_GDBM_File_gdbm_fetch(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 2 || items > 2) { - croak("Usage: GDBM_File::fetch(db, key)"); - } - { - GDBM_File db; - datum key; - gdatum RETVAL; - - if (sv_isa(ST(1), "GDBM_File")) - db = (GDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); - else - croak("db is not of type GDBM_File"); - - key.dptr = SvPV(ST(2), key.dsize);; - - RETVAL = gdbm_fetch(db, key); - ST(0) = sv_mortalcopy(&sv_undef); - sv_usepvn(ST(0), RETVAL.dptr, RETVAL.dsize); - } - return sp; -} - -static int -XS_GDBM_File_gdbm_store(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 3 || items > 4) { - croak("Usage: GDBM_File::store(db, key, value, flags = GDBM_REPLACE)"); - } - { - GDBM_File db; - datum key; - datum value; - int flags; - int RETVAL; - - if (sv_isa(ST(1), "GDBM_File")) - db = (GDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); - else - croak("db is not of type GDBM_File"); - - key.dptr = SvPV(ST(2), key.dsize);; - - value.dptr = SvPV(ST(3), value.dsize);; - - if (items < 4) - flags = GDBM_REPLACE; - else { - flags = (int)SvIV(ST(4)); - } - - RETVAL = gdbm_store(db, key, value, flags); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setiv(ST(0), (I32)RETVAL); - } - return sp; -} - -static int -XS_GDBM_File_gdbm_delete(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 2 || items > 2) { - croak("Usage: GDBM_File::delete(db, key)"); - } - { - GDBM_File db; - datum key; - int RETVAL; - - if (sv_isa(ST(1), "GDBM_File")) - db = (GDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); - else - croak("db is not of type GDBM_File"); - - key.dptr = SvPV(ST(2), key.dsize);; - - RETVAL = gdbm_delete(db, key); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setiv(ST(0), (I32)RETVAL); - } - return sp; -} - -static int -XS_GDBM_File_gdbm_firstkey(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 1 || items > 1) { - croak("Usage: GDBM_File::firstkey(db)"); - } - { - GDBM_File db; - gdatum RETVAL; - - if (sv_isa(ST(1), "GDBM_File")) - db = (GDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); - else - croak("db is not of type GDBM_File"); - - RETVAL = gdbm_firstkey(db); - ST(0) = sv_mortalcopy(&sv_undef); - sv_usepvn(ST(0), RETVAL.dptr, RETVAL.dsize); - } - return sp; -} - -static int -XS_GDBM_File_gdbm_nextkey(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 2 || items > 2) { - croak("Usage: GDBM_File::nextkey(db, key)"); - } - { - GDBM_File db; - datum key; - gdatum RETVAL; - - if (sv_isa(ST(1), "GDBM_File")) - db = (GDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); - else - croak("db is not of type GDBM_File"); - - key.dptr = SvPV(ST(2), key.dsize);; - - RETVAL = gdbm_nextkey(db, key); - ST(0) = sv_mortalcopy(&sv_undef); - sv_usepvn(ST(0), RETVAL.dptr, RETVAL.dsize); - } - return sp; -} - -static int -XS_GDBM_File_gdbm_reorganize(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 1 || items > 1) { - croak("Usage: GDBM_File::reorganize(db)"); - } - { - GDBM_File db; - int RETVAL; - - if (sv_isa(ST(1), "GDBM_File")) - db = (GDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); - else - croak("db is not of type GDBM_File"); - - RETVAL = gdbm_reorganize(db); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setiv(ST(0), (I32)RETVAL); - } - return sp; -} - -int boot_GDBM_File(ix,sp,items) -int ix; -int sp; -int items; -{ - char* file = __FILE__; - - newXSUB("GDBM_File::new", 0, XS_GDBM_File_gdbm_new, file); - newXSUB("GDBM_File::open", 0, XS_GDBM_File_gdbm_open, file); - newXSUB("GDBM_File::close", 0, XS_GDBM_File_gdbm_close, file); - newXSUB("GDBM_File::DESTROY", 0, XS_GDBM_File_gdbm_DESTROY, file); - newXSUB("GDBM_File::fetch", 0, XS_GDBM_File_gdbm_fetch, file); - newXSUB("GDBM_File::store", 0, XS_GDBM_File_gdbm_store, file); - newXSUB("GDBM_File::delete", 0, XS_GDBM_File_gdbm_delete, file); - newXSUB("GDBM_File::firstkey", 0, XS_GDBM_File_gdbm_firstkey, file); - newXSUB("GDBM_File::nextkey", 0, XS_GDBM_File_gdbm_nextkey, file); - newXSUB("GDBM_File::reorganize", 0, XS_GDBM_File_gdbm_reorganize, file); -} diff --git a/ext/dbm/GDBM_File.xs b/ext/dbm/GDBM_File.xs deleted file mode 100644 index 2c619cb..0000000 --- a/ext/dbm/GDBM_File.xs +++ /dev/null @@ -1,76 +0,0 @@ -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" -#include - -#include - -typedef GDBM_FILE GDBM_File; - -#define gdbm_new(dbtype, name, block_size, read_write, mode, fatal_func) \ - gdbm_open(name, block_size, read_write, mode, fatal_func) - -typedef datum gdatum; - -typedef void (*FATALFUNC)(); - -MODULE = GDBM_File PACKAGE = GDBM_File PREFIX = gdbm_ - -GDBM_File -gdbm_new(dbtype, name, block_size, read_write, mode, fatal_func = (FATALFUNC)croak) - char * dbtype - char * name - int block_size - int read_write - int mode - FATALFUNC fatal_func - -GDBM_File -gdbm_open(name, block_size, read_write, mode, fatal_func = (FATALFUNC)croak) - char * name - int block_size - int read_write - int mode - FATALFUNC fatal_func - -void -gdbm_close(db) - GDBM_File db - CLEANUP: - -void -gdbm_DESTROY(db) - GDBM_File db - CODE: - gdbm_close(db); - -gdatum -gdbm_fetch(db, key) - GDBM_File db - datum key - -int -gdbm_store(db, key, value, flags = GDBM_REPLACE) - GDBM_File db - datum key - datum value - int flags - -int -gdbm_delete(db, key) - GDBM_File db - datum key - -gdatum -gdbm_firstkey(db) - GDBM_File db - -gdatum -gdbm_nextkey(db, key) - GDBM_File db - datum key - -int -gdbm_reorganize(db) - GDBM_File db - diff --git a/ext/dbm/GDBM_File.xs.bak b/ext/dbm/GDBM_File.xs.bak deleted file mode 100644 index 03b86c5..0000000 --- a/ext/dbm/GDBM_File.xs.bak +++ /dev/null @@ -1,122 +0,0 @@ -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" -#include - -#include - -typedef GDBM_FILE GDBM_File; - -#define gdbm_new(dbtype,filename,flags,mode) \ - gdbm_open(filename, 0, flags & O_CREAT ? GDBM_WRCREAT : GDBM_WRITER, \ - mode, fatal) - -typedef datum gdatum; - -typedef struct gdbm_file_desc { - GDBM_File ptr; - SV* curkey; -} GDBM_FILE_DESC; - -GDBM_FILE_DESC* GDBM_File_desc; - -GDBM_FILE_DESC* -newGDBM_FILE_DESC(ptr) -void* ptr; -{ - New(0, GDBM_File_desc, 1, GDBM_FILE_DESC); - GDBM_File_desc->ptr = ptr; - GDBM_File_desc->curkey = 0; - return GDBM_File_desc; -} - -void -deleteGDBM_FILE_DESC() -{ - sv_free(GDBM_File_desc->curkey); - Safefree(GDBM_File_desc); -} - -typedef void (*FATALFUNC)(); - -static datum -get_current_key() -{ - datum key; - key.dptr = SvPVn( GDBM_File_desc->curkey, key.dsize); - return key; -} - -static void -set_current_key(sv) -SV *sv; -{ - sv_free(GDBM_File_desc->curkey); - GDBM_File_desc->curkey = sv_ref(sv); -} - - -MODULE = GDBM_File PACKAGE = GDBM_File PREFIX = gdbm_ - -GDBM_File -gdbm_new(dbtype, filename, flags, mode) - char * dbtype - char * filename - int flags - int mode - -GDBM_File -gdbm_open(name, block_size, read_write, mode, fatal_func = (FATALFUNC)fatal) - char * name - int block_size - int read_write - int mode - FATALFUNC fatal_func - -void -gdbm_close(db) - GDBM_File db - CLEANUP: - deleteGDBM_FILE_DESC(); - -void -gdbm_DESTROY(db) - GDBM_File db - CODE: - gdbm_close(db); - deleteGDBM_FILE_DESC(); - -gdatum -gdbm_fetch(db, key) - GDBM_File db - datum key - -int -gdbm_store(db, key, value, flags = GDBM_REPLACE) - GDBM_File db - datum key - datum value - int flags - -int -gdbm_delete(db, key) - GDBM_File db - datum key - -gdatum -gdbm_firstkey(db) - GDBM_File db - CLEANUP: - set_current_key(ST(0)); - -gdatum -gdbm_nextkey(db, key = get_current_key()) - GDBM_File db - datum key - CLEANUP: - set_current_key(ST(0)); - -int -gdbm_reorganize(db) - GDBM_File db - diff --git a/ext/dbm/Makefile b/ext/dbm/Makefile deleted file mode 100644 index 970724d..0000000 --- a/ext/dbm/Makefile +++ /dev/null @@ -1,20 +0,0 @@ -all: NDBM_File.c ODBM_File.c GDBM_File.c SDBM_File.c - -NDBM_File.c: NDBM_File.xs - ../xsubpp NDBM_File.xs >NDBM_File.c - -SDBM_File.c: SDBM_File.xs - ../xsubpp SDBM_File.xs >SDBM_File.c - -SDBM_File.o: SDBM_File.c - cc -g -I../.. -pic -c SDBM_File.c - -SDBM_File.so: SDBM_File.o sdbm/libsdbm.a - ld -o SDBM_File.so SDBM_File.o sdbm/libsdbm.a - -ODBM_File.c: ODBM_File.xs - ../xsubpp ODBM_File.xs >ODBM_File.c - -GDBM_File.c: GDBM_File.xs - ../xsubpp GDBM_File.xs >GDBM_File.c - diff --git a/ext/dbm/NDBM_File.c b/ext/dbm/NDBM_File.c deleted file mode 100644 index b321ac4..0000000 --- a/ext/dbm/NDBM_File.c +++ /dev/null @@ -1,267 +0,0 @@ -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" -#include - -typedef DBM* NDBM_File; -#define dbm_new(dbtype,filename,flags,mode) dbm_open(filename,flags,mode) -#define nextkey(db,key) dbm_nextkey(db) - -static int -XS_NDBM_File_dbm_new(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 4 || items > 4) { - fatal("Usage: NDBM_File::new(dbtype, filename, flags, mode)"); - } - { - char * dbtype = SvPV(ST(1),na); - char * filename = SvPV(ST(2),na); - int flags = (int)SvIV(ST(3)); - int mode = (int)SvIV(ST(4)); - NDBM_File RETVAL; - - RETVAL = dbm_new(dbtype, filename, flags, mode); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setptrobj(ST(0), RETVAL, "NDBM_File"); - } - return sp; -} - -static int -XS_NDBM_File_dbm_DESTROY(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 1 || items > 1) { - fatal("Usage: NDBM_File::DESTROY(db)"); - } - { - NDBM_File db; - - if (sv_isa(ST(1), "NDBM_File")) - db = (NDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); - else - fatal("db is not of type NDBM_File"); - dbm_close(db); - } - return sp; -} - -static int -XS_NDBM_File_dbm_fetch(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 2 || items > 2) { - fatal("Usage: NDBM_File::fetch(db, key)"); - } - { - NDBM_File db; - datum key; - datum RETVAL; - - if (sv_isa(ST(1), "NDBM_File")) - db = (NDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); - else - fatal("db is not of type NDBM_File"); - - key.dptr = SvPV(ST(2), key.dsize);; - - RETVAL = dbm_fetch(db, key); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); - } - return sp; -} - -static int -XS_NDBM_File_dbm_store(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 3 || items > 4) { - fatal("Usage: NDBM_File::store(db, key, value, flags = DBM_REPLACE)"); - } - { - NDBM_File db; - datum key; - datum value; - int flags; - int RETVAL; - - if (sv_isa(ST(1), "NDBM_File")) - db = (NDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); - else - fatal("db is not of type NDBM_File"); - - key.dptr = SvPV(ST(2), key.dsize);; - - value.dptr = SvPV(ST(3), value.dsize);; - - if (items < 4) - flags = DBM_REPLACE; - else { - flags = (int)SvIV(ST(4)); - } - - RETVAL = dbm_store(db, key, value, flags); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setiv(ST(0), (I32)RETVAL); - } - return sp; -} - -static int -XS_NDBM_File_dbm_delete(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 2 || items > 2) { - fatal("Usage: NDBM_File::delete(db, key)"); - } - { - NDBM_File db; - datum key; - int RETVAL; - - if (sv_isa(ST(1), "NDBM_File")) - db = (NDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); - else - fatal("db is not of type NDBM_File"); - - key.dptr = SvPV(ST(2), key.dsize);; - - RETVAL = dbm_delete(db, key); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setiv(ST(0), (I32)RETVAL); - } - return sp; -} - -static int -XS_NDBM_File_dbm_firstkey(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 1 || items > 1) { - fatal("Usage: NDBM_File::firstkey(db)"); - } - { - NDBM_File db; - datum RETVAL; - - if (sv_isa(ST(1), "NDBM_File")) - db = (NDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); - else - fatal("db is not of type NDBM_File"); - - RETVAL = dbm_firstkey(db); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); - } - return sp; -} - -static int -XS_NDBM_File_nextkey(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 2 || items > 2) { - fatal("Usage: NDBM_File::nextkey(db, key)"); - } - { - NDBM_File db; - datum key; - datum RETVAL; - - if (sv_isa(ST(1), "NDBM_File")) - db = (NDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); - else - fatal("db is not of type NDBM_File"); - - key.dptr = SvPV(ST(2), key.dsize);; - - RETVAL = nextkey(db, key); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); - } - return sp; -} - -static int -XS_NDBM_File_dbm_error(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 1 || items > 1) { - fatal("Usage: NDBM_File::error(db)"); - } - { - NDBM_File db; - int RETVAL; - - if (sv_isa(ST(1), "NDBM_File")) - db = (NDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); - else - fatal("db is not of type NDBM_File"); - - RETVAL = dbm_error(db); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setiv(ST(0), (I32)RETVAL); - } - return sp; -} - -static int -XS_NDBM_File_dbm_clearerr(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 1 || items > 1) { - fatal("Usage: NDBM_File::clearerr(db)"); - } - { - NDBM_File db; - int RETVAL; - - if (sv_isa(ST(1), "NDBM_File")) - db = (NDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1))); - else - fatal("db is not of type NDBM_File"); - - RETVAL = dbm_clearerr(db); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setiv(ST(0), (I32)RETVAL); - } - return sp; -} - -int init_NDBM_File(ix,sp,items) -int ix; -int sp; -int items; -{ - char* file = __FILE__; - - newXSUB("NDBM_File::new", 0, XS_NDBM_File_dbm_new, file); - newXSUB("NDBM_File::DESTROY", 0, XS_NDBM_File_dbm_DESTROY, file); - newXSUB("NDBM_File::fetch", 0, XS_NDBM_File_dbm_fetch, file); - newXSUB("NDBM_File::store", 0, XS_NDBM_File_dbm_store, file); - newXSUB("NDBM_File::delete", 0, XS_NDBM_File_dbm_delete, file); - newXSUB("NDBM_File::firstkey", 0, XS_NDBM_File_dbm_firstkey, file); - newXSUB("NDBM_File::nextkey", 0, XS_NDBM_File_nextkey, file); - newXSUB("NDBM_File::error", 0, XS_NDBM_File_dbm_error, file); - newXSUB("NDBM_File::clearerr", 0, XS_NDBM_File_dbm_clearerr, file); -} diff --git a/ext/dbm/NDBM_File.xs b/ext/dbm/NDBM_File.xs deleted file mode 100644 index 5f4f78b..0000000 --- a/ext/dbm/NDBM_File.xs +++ /dev/null @@ -1,58 +0,0 @@ -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" -#include - -typedef DBM* NDBM_File; -#define dbm_new(dbtype,filename,flags,mode) dbm_open(filename,flags,mode) -#define nextkey(db,key) dbm_nextkey(db) - -MODULE = NDBM_File PACKAGE = NDBM_File PREFIX = dbm_ - -NDBM_File -dbm_new(dbtype, filename, flags, mode) - char * dbtype - char * filename - int flags - int mode - -void -dbm_DESTROY(db) - NDBM_File db - CODE: - dbm_close(db); - -datum -dbm_fetch(db, key) - NDBM_File db - datum key - -int -dbm_store(db, key, value, flags = DBM_REPLACE) - NDBM_File db - datum key - datum value - int flags - -int -dbm_delete(db, key) - NDBM_File db - datum key - -datum -dbm_firstkey(db) - NDBM_File db - -datum -nextkey(db, key) - NDBM_File db - datum key - -int -dbm_error(db) - NDBM_File db - -int -dbm_clearerr(db) - NDBM_File db - diff --git a/ext/dbm/ODBM_File.c b/ext/dbm/ODBM_File.c deleted file mode 100644 index 1aea2ce..0000000 --- a/ext/dbm/ODBM_File.c +++ /dev/null @@ -1,246 +0,0 @@ -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#ifdef NULL -#undef NULL -#endif -#include - -#include - -typedef void* ODBM_File; - -#define odbm_fetch(db,key) fetch(key) -#define odbm_store(db,key,value,flags) store(key,value) -#define odbm_delete(db,key) delete(key) -#define odbm_firstkey(db) firstkey() -#define odbm_nextkey(db,key) nextkey(key) - -static int dbmrefcnt; - -#define DBM_REPLACE 0 - -static int -XS_ODBM_File_odbm_new(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 4 || items > 4) { - croak("Usage: ODBM_File::new(dbtype, filename, flags, mode)"); - } - { - char * dbtype = SvPV(ST(1),na); - char * filename = SvPV(ST(2),na); - int flags = (int)SvIV(ST(3)); - int mode = (int)SvIV(ST(4)); - ODBM_File RETVAL; - { - char tmpbuf[1025]; - if (dbmrefcnt++) - croak("Old dbm can only open one database"); - sprintf(tmpbuf,"%s.dir",filename); - if (stat(tmpbuf, &statbuf) < 0) { - if (flags & O_CREAT) { - if (mode < 0 || close(creat(tmpbuf,mode)) < 0) - croak("ODBM_File: Can't create %s", filename); - sprintf(tmpbuf,"%s.pag",filename); - if (close(creat(tmpbuf,mode)) < 0) - croak("ODBM_File: Can't create %s", filename); - } - else - croak("ODBM_FILE: Can't open %s", filename); - } - RETVAL = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setptrobj(ST(0), RETVAL, "ODBM_File"); - } - } - return sp; -} - -static int -XS_ODBM_File_DESTROY(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 1 || items > 1) { - croak("Usage: ODBM_File::DESTROY(db)"); - } - { - ODBM_File db; - - if (sv_isa(ST(1), "ODBM_File")) - db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); - else - croak("db is not of type ODBM_File"); - dbmrefcnt--; - dbmclose(); - } - return sp; -} - -static int -XS_ODBM_File_odbm_fetch(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 2 || items > 2) { - croak("Usage: ODBM_File::fetch(db, key)"); - } - { - ODBM_File db; - datum key; - datum RETVAL; - - if (sv_isa(ST(1), "ODBM_File")) - db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); - else - croak("db is not of type ODBM_File"); - - key.dptr = SvPV(ST(2), key.dsize);; - - RETVAL = odbm_fetch(db, key); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); - } - return sp; -} - -static int -XS_ODBM_File_odbm_store(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 3 || items > 4) { - croak("Usage: ODBM_File::store(db, key, value, flags = DBM_REPLACE)"); - } - { - ODBM_File db; - datum key; - datum value; - int flags; - int RETVAL; - - if (sv_isa(ST(1), "ODBM_File")) - db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); - else - croak("db is not of type ODBM_File"); - - key.dptr = SvPV(ST(2), key.dsize);; - - value.dptr = SvPV(ST(3), value.dsize);; - - if (items < 4) - flags = DBM_REPLACE; - else { - flags = (int)SvIV(ST(4)); - } - - RETVAL = odbm_store(db, key, value, flags); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setiv(ST(0), (I32)RETVAL); - } - return sp; -} - -static int -XS_ODBM_File_odbm_delete(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 2 || items > 2) { - croak("Usage: ODBM_File::delete(db, key)"); - } - { - ODBM_File db; - datum key; - int RETVAL; - - if (sv_isa(ST(1), "ODBM_File")) - db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); - else - croak("db is not of type ODBM_File"); - - key.dptr = SvPV(ST(2), key.dsize);; - - RETVAL = odbm_delete(db, key); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setiv(ST(0), (I32)RETVAL); - } - return sp; -} - -static int -XS_ODBM_File_odbm_firstkey(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 1 || items > 1) { - croak("Usage: ODBM_File::firstkey(db)"); - } - { - ODBM_File db; - datum RETVAL; - - if (sv_isa(ST(1), "ODBM_File")) - db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); - else - croak("db is not of type ODBM_File"); - - RETVAL = odbm_firstkey(db); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); - } - return sp; -} - -static int -XS_ODBM_File_odbm_nextkey(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 2 || items > 2) { - croak("Usage: ODBM_File::nextkey(db, key)"); - } - { - ODBM_File db; - datum key; - datum RETVAL; - - if (sv_isa(ST(1), "ODBM_File")) - db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); - else - croak("db is not of type ODBM_File"); - - key.dptr = SvPV(ST(2), key.dsize);; - - RETVAL = odbm_nextkey(db, key); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); - } - return sp; -} - -int boot_ODBM_File(ix,sp,items) -int ix; -int sp; -int items; -{ - char* file = __FILE__; - - newXSUB("ODBM_File::new", 0, XS_ODBM_File_odbm_new, file); - newXSUB("ODBM_File::DESTROY", 0, XS_ODBM_File_DESTROY, file); - newXSUB("ODBM_File::fetch", 0, XS_ODBM_File_odbm_fetch, file); - newXSUB("ODBM_File::store", 0, XS_ODBM_File_odbm_store, file); - newXSUB("ODBM_File::delete", 0, XS_ODBM_File_odbm_delete, file); - newXSUB("ODBM_File::firstkey", 0, XS_ODBM_File_odbm_firstkey, file); - newXSUB("ODBM_File::nextkey", 0, XS_ODBM_File_odbm_nextkey, file); -} diff --git a/ext/dbm/ODBM_File.xs b/ext/dbm/ODBM_File.xs deleted file mode 100644 index 04d7b9e..0000000 --- a/ext/dbm/ODBM_File.xs +++ /dev/null @@ -1,88 +0,0 @@ -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#ifdef NULL -#undef NULL -#endif -#include - -#include - -typedef void* ODBM_File; - -#define odbm_fetch(db,key) fetch(key) -#define odbm_store(db,key,value,flags) store(key,value) -#define odbm_delete(db,key) delete(key) -#define odbm_firstkey(db) firstkey() -#define odbm_nextkey(db,key) nextkey(key) - -static int dbmrefcnt; - -#ifndef DBM_REPLACE -#define DBM_REPLACE 0 -#endif - -MODULE = ODBM_File PACKAGE = ODBM_File PREFIX = odbm_ - -ODBM_File -odbm_new(dbtype, filename, flags, mode) - char * dbtype - char * filename - int flags - int mode - CODE: - { - char tmpbuf[1025]; - if (dbmrefcnt++) - croak("Old dbm can only open one database"); - sprintf(tmpbuf,"%s.dir",filename); - if (stat(tmpbuf, &statbuf) < 0) { - if (flags & O_CREAT) { - if (mode < 0 || close(creat(tmpbuf,mode)) < 0) - croak("ODBM_File: Can't create %s", filename); - sprintf(tmpbuf,"%s.pag",filename); - if (close(creat(tmpbuf,mode)) < 0) - croak("ODBM_File: Can't create %s", filename); - } - else - croak("ODBM_FILE: Can't open %s", filename); - } - RETVAL = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setptrobj(ST(0), RETVAL, "ODBM_File"); - } - -void -DESTROY(db) - ODBM_File db - CODE: - dbmrefcnt--; - dbmclose(); - -datum -odbm_fetch(db, key) - ODBM_File db - datum key - -int -odbm_store(db, key, value, flags = DBM_REPLACE) - ODBM_File db - datum key - datum value - int flags - -int -odbm_delete(db, key) - ODBM_File db - datum key - -datum -odbm_firstkey(db) - ODBM_File db - -datum -odbm_nextkey(db, key) - ODBM_File db - datum key - diff --git a/ext/dbm/SDBM_File.c.bak b/ext/dbm/SDBM_File.c.bak deleted file mode 100644 index 06fedb3..0000000 --- a/ext/dbm/SDBM_File.c.bak +++ /dev/null @@ -1,267 +0,0 @@ -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" -#include "ext/dbm/sdbm/sdbm.h" - -typedef DBM* SDBM_File; -#define sdbm_new(dbtype,filename,flags,mode) sdbm_open(filename,flags,mode) -#define nextkey(db,key) sdbm_nextkey(db) - -static int -XS_SDBM_File_sdbm_new(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 4 || items > 4) { - croak("Usage: SDBM_File::new(dbtype, filename, flags, mode)"); - } - { - char * dbtype = SvPV(ST(1),na); - char * filename = SvPV(ST(2),na); - int flags = (int)SvIV(ST(3)); - int mode = (int)SvIV(ST(4)); - SDBM_File RETVAL; - - RETVAL = sdbm_new(dbtype, filename, flags, mode); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setptrobj(ST(0), RETVAL, "SDBM_File"); - } - return sp; -} - -static int -XS_SDBM_File_sdbm_DESTROY(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 1 || items > 1) { - croak("Usage: SDBM_File::DESTROY(db)"); - } - { - SDBM_File db; - - if (SvROK(ST(1))) - db = (SDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); - else - croak("db is not a reference"); - sdbm_close(db); - } - return sp; -} - -static int -XS_SDBM_File_sdbm_fetch(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 2 || items > 2) { - croak("Usage: SDBM_File::fetch(db, key)"); - } - { - SDBM_File db; - datum key; - datum RETVAL; - - if (sv_isa(ST(1), "SDBM_File")) - db = (SDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); - else - croak("db is not of type SDBM_File"); - - key.dptr = SvPV(ST(2), key.dsize);; - - RETVAL = sdbm_fetch(db, key); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); - } - return sp; -} - -static int -XS_SDBM_File_sdbm_store(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 3 || items > 4) { - croak("Usage: SDBM_File::store(db, key, value, flags = DBM_REPLACE)"); - } - { - SDBM_File db; - datum key; - datum value; - int flags; - int RETVAL; - - if (sv_isa(ST(1), "SDBM_File")) - db = (SDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); - else - croak("db is not of type SDBM_File"); - - key.dptr = SvPV(ST(2), key.dsize);; - - value.dptr = SvPV(ST(3), value.dsize);; - - if (items < 4) - flags = DBM_REPLACE; - else { - flags = (int)SvIV(ST(4)); - } - - RETVAL = sdbm_store(db, key, value, flags); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setiv(ST(0), (I32)RETVAL); - } - return sp; -} - -static int -XS_SDBM_File_sdbm_delete(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 2 || items > 2) { - croak("Usage: SDBM_File::delete(db, key)"); - } - { - SDBM_File db; - datum key; - int RETVAL; - - if (sv_isa(ST(1), "SDBM_File")) - db = (SDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); - else - croak("db is not of type SDBM_File"); - - key.dptr = SvPV(ST(2), key.dsize);; - - RETVAL = sdbm_delete(db, key); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setiv(ST(0), (I32)RETVAL); - } - return sp; -} - -static int -XS_SDBM_File_sdbm_firstkey(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 1 || items > 1) { - croak("Usage: SDBM_File::firstkey(db)"); - } - { - SDBM_File db; - datum RETVAL; - - if (sv_isa(ST(1), "SDBM_File")) - db = (SDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); - else - croak("db is not of type SDBM_File"); - - RETVAL = sdbm_firstkey(db); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); - } - return sp; -} - -static int -XS_SDBM_File_nextkey(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 2 || items > 2) { - croak("Usage: SDBM_File::nextkey(db, key)"); - } - { - SDBM_File db; - datum key; - datum RETVAL; - - if (sv_isa(ST(1), "SDBM_File")) - db = (SDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); - else - croak("db is not of type SDBM_File"); - - key.dptr = SvPV(ST(2), key.dsize);; - - RETVAL = nextkey(db, key); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize); - } - return sp; -} - -static int -XS_SDBM_File_sdbm_error(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 1 || items > 1) { - croak("Usage: SDBM_File::error(db)"); - } - { - SDBM_File db; - int RETVAL; - - if (sv_isa(ST(1), "SDBM_File")) - db = (SDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); - else - croak("db is not of type SDBM_File"); - - RETVAL = sdbm_error(db); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setiv(ST(0), (I32)RETVAL); - } - return sp; -} - -static int -XS_SDBM_File_sdbm_clearerr(ix, sp, items) -register int ix; -register int sp; -register int items; -{ - if (items < 1 || items > 1) { - croak("Usage: SDBM_File::clearerr(db)"); - } - { - SDBM_File db; - int RETVAL; - - if (sv_isa(ST(1), "SDBM_File")) - db = (SDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1))); - else - croak("db is not of type SDBM_File"); - - RETVAL = sdbm_clearerr(db); - ST(0) = sv_mortalcopy(&sv_undef); - sv_setiv(ST(0), (I32)RETVAL); - } - return sp; -} - -int boot_SDBM_File(ix,sp,items) -int ix; -int sp; -int items; -{ - char* file = __FILE__; - - newXSUB("SDBM_File::new", 0, XS_SDBM_File_sdbm_new, file); - newXSUB("SDBM_File::DESTROY", 0, XS_SDBM_File_sdbm_DESTROY, file); - newXSUB("SDBM_File::fetch", 0, XS_SDBM_File_sdbm_fetch, file); - newXSUB("SDBM_File::store", 0, XS_SDBM_File_sdbm_store, file); - newXSUB("SDBM_File::delete", 0, XS_SDBM_File_sdbm_delete, file); - newXSUB("SDBM_File::firstkey", 0, XS_SDBM_File_sdbm_firstkey, file); - newXSUB("SDBM_File::nextkey", 0, XS_SDBM_File_nextkey, file); - newXSUB("SDBM_File::error", 0, XS_SDBM_File_sdbm_error, file); - newXSUB("SDBM_File::clearerr", 0, XS_SDBM_File_sdbm_clearerr, file); -} diff --git a/ext/dbm/SDBM_File.so b/ext/dbm/SDBM_File.so deleted file mode 100755 index 87f4749..0000000 Binary files a/ext/dbm/SDBM_File.so and /dev/null differ diff --git a/ext/dbm/SDBM_File.xs b/ext/dbm/SDBM_File.xs deleted file mode 100644 index 25cb67c..0000000 --- a/ext/dbm/SDBM_File.xs +++ /dev/null @@ -1,58 +0,0 @@ -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" -#include "ext/dbm/sdbm/sdbm.h" - -typedef DBM* SDBM_File; -#define sdbm_new(dbtype,filename,flags,mode) sdbm_open(filename,flags,mode) -#define nextkey(db,key) sdbm_nextkey(db) - -MODULE = SDBM_File PACKAGE = SDBM_File PREFIX = sdbm_ - -SDBM_File -sdbm_new(dbtype, filename, flags, mode) - char * dbtype - char * filename - int flags - int mode - -void -sdbm_DESTROY(db) - SDBM_File db - CODE: - sdbm_close(db); - -datum -sdbm_fetch(db, key) - SDBM_File db - datum key - -int -sdbm_store(db, key, value, flags = DBM_REPLACE) - SDBM_File db - datum key - datum value - int flags - -int -sdbm_delete(db, key) - SDBM_File db - datum key - -datum -sdbm_firstkey(db) - SDBM_File db - -datum -nextkey(db, key) - SDBM_File db - datum key - -int -sdbm_error(db) - SDBM_File db - -int -sdbm_clearerr(db) - SDBM_File db - diff --git a/ext/dbm/perl b/ext/dbm/perl deleted file mode 120000 index 899dc46..0000000 --- a/ext/dbm/perl +++ /dev/null @@ -1 +0,0 @@ -../../perl \ No newline at end of file diff --git a/ext/dbm/sdbm/.pure b/ext/dbm/sdbm/.pure deleted file mode 100644 index e69de29..0000000 diff --git a/ext/dbm/sdbm/.r b/ext/dbm/sdbm/.r deleted file mode 100755 index c72dbf1..0000000 --- a/ext/dbm/sdbm/.r +++ /dev/null @@ -1,5884 +0,0 @@ -if test -f 'CHANGES' -a "${1}" != "-c" ; then - echo shar: Will not clobber existing file \"'CHANGES'\" -else -echo shar: Extracting \"'CHANGES'\" \(900 characters\) -sed "s/^X//" >'CHANGES' <<'END_OF_FILE' -XChanges from the earlier BETA releases. -X -Xo dbm_prep does everything now, so dbm_open is just a simple -X wrapper that builds the default filenames. dbm_prep no longer -X requires a (DBM *) db parameter: it allocates one itself. It -X returns (DBM *) db or (DBM *) NULL. -X -Xo makroom is now reliable. In the common-case optimization of the page -X split, the page into which the incoming key/value pair is to be inserted -X is write-deferred (if the split is successful), thereby saving a cosly -X write. BUT, if the split does not make enough room (unsuccessful), the -X deferred page is written out, as the failure-window is now dependent on -X the number of split attempts. -X -Xo if -DDUFF is defined, hash function will also use the DUFF construct. -X This may look like a micro-performance tweak (maybe it is), but in fact, -X the hash function is the third most-heavily used function, after read -X and write. -END_OF_FILE -if test 900 -ne `wc -c <'CHANGES'`; then - echo shar: \"'CHANGES'\" unpacked with wrong size! -fi -# end of 'CHANGES' -fi -if test -f 'COMPARE' -a "${1}" != "-c" ; then - echo shar: Will not clobber existing file \"'COMPARE'\" -else -echo shar: Extracting \"'COMPARE'\" \(2832 characters\) -sed "s/^X//" >'COMPARE' <<'END_OF_FILE' -X -XScript started on Thu Sep 28 15:41:06 1989 -X% uname -a -Xtitan titan 4_0 UMIPS mips -X% make all x-dbm -X cc -O -DSDBM -DDUFF -DDUPERROR -DSPLITFAIL -c dbm.c -X cc -O -DSDBM -DDUFF -DDUPERROR -DSPLITFAIL -c sdbm.c -X cc -O -DSDBM -DDUFF -DDUPERROR -DSPLITFAIL -c pair.c -X cc -O -DSDBM -DDUFF -DDUPERROR -DSPLITFAIL -c hash.c -X ar cr libsdbm.a sdbm.o pair.o hash.o -X ranlib libsdbm.a -X cc -o dbm dbm.o libsdbm.a -X cc -O -DSDBM -DDUFF -DDUPERROR -DSPLITFAIL -c dba.c -X cc -o dba dba.o -X cc -O -DSDBM -DDUFF -DDUPERROR -DSPLITFAIL -c dbd.c -X cc -o dbd dbd.o -X cc -O -DSDBM -DDUFF -DDUPERROR -DSPLITFAIL -o x-dbm dbm.o -X% -X% -X% wc history -X 65110 218344 3204883 history -X% -X% /bin/time dbm build foo 'README' <<'END_OF_FILE' -X -X -X -X -X -X -X sdbm - Substitute DBM -X or -X Berkeley ndbm for Every UN*X[1] Made Simple -X -X Ozan (oz) Yigit -X -X The Guild of PD Software Toolmakers -X Toronto - Canada -X -X oz@nexus.yorku.ca -X -X -X -XImplementation is the sincerest form of flattery. - L. Peter -XDeutsch -X -XA The Clone of the ndbm library -X -X The sources accompanying this notice - sdbm - consti- -Xtute the first public release (Dec. 1990) of a complete -Xclone of the Berkeley UN*X ndbm library. The sdbm library is -Xmeant to clone the proven functionality of ndbm as closely -Xas possible, including a few improvements. It is practical, -Xeasy to understand, and compatible. The sdbm library is not -Xderived from any licensed, proprietary or copyrighted -Xsoftware. -X -X The sdbm implementation is based on a 1978 algorithm -X[Lar78] by P.-A. (Paul) Larson known as ``Dynamic Hashing''. -XIn the course of searching for a substitute for ndbm, I pro- -Xtotyped three different external-hashing algorithms [Lar78, -XFag79, Lit80] and ultimately chose Larson's algorithm as a -Xbasis of the sdbm implementation. The Bell Labs dbm (and -Xtherefore ndbm) is based on an algorithm invented by Ken -XThompson, [Tho90, Tor87] and predates Larson's work. -X -X The sdbm programming interface is totally compatible -Xwith ndbm and includes a slight improvement in database ini- -Xtialization. It is also expected to be binary-compatible -Xunder most UN*X versions that support the ndbm library. -X -X The sdbm implementation shares the shortcomings of the -Xndbm library, as a side effect of various simplifications to -Xthe original Larson algorithm. It does produce holes in the -Xpage file as it writes pages past the end of file. (Larson's -Xpaper include a clever solution to this problem that is a -Xresult of using the hash value directly as a block address.) -XOn the other hand, extensive tests seem to indicate that -Xsdbm creates fewer holes in general, and the resulting page- -Xfiles are smaller. The sdbm implementation is also faster -Xthan ndbm in database creation. Unlike the ndbm, the sdbm -X_________________________ -X -X [1] UN*X is not a trademark of any (dis)organization. -X -X -X -X -X -X -X -X -X -X - 2 - -X -X -Xstore operation will not ``wander away'' trying to split its -Xdata pages to insert a datum that cannot (due to elaborate -Xworst-case situations) be inserted. (It will fail after a -Xpre-defined number of attempts.) -X -XImportant Compatibility Warning -X -X The sdbm and ndbm libraries cannot share databases: one -Xcannot read the (dir/pag) database created by the other. -XThis is due to the differences between the ndbm and sdbm -Xalgorithms[2], and the hash functions used. It is easy to -Xconvert between the dbm/ndbm databases and sdbm by ignoring -Xthe index completely: see dbd, dbu etc. -X -X -XNotice of Intellectual Property -X -XThe entire sdbm library package, as authored by me, Ozan S. -XYigit, is hereby placed in the public domain. As such, the -Xauthor is not responsible for the consequences of use of -Xthis software, no matter how awful, even if they arise from -Xdefects in it. There is no expressed or implied warranty for -Xthe sdbm library. -X -X Since the sdbm library package is in the public domain, -Xthis original release or any additional public-domain -Xreleases of the modified original cannot possibly (by defin- -Xition) be withheld from you. Also by definition, You (singu- -Xlar) have all the rights to this code (including the right -Xto sell without permission, the right to hoard[3] and the -Xright to do other icky things as you see fit) but those -Xrights are also granted to everyone else. -X -X Please note that all previous distributions of this -Xsoftware contained a copyright (which is now dropped) to -Xprotect its origins and its current public domain status -Xagainst any possible claims and/or challenges. -X -XAcknowledgments -X -X Many people have been very helpful and supportive. A -Xpartial list would necessarily include Rayan Zacherissen -X(who contributed the man page, and also hacked a MMAP -X_________________________ -X -X [2] Torek's discussion [Tor87] indicates that -Xdbm/ndbm implementations use the hash value to traverse -Xthe radix trie differently than sdbm and as a result, -Xthe page indexes are generated in different order. For -Xmore information, send e-mail to the author. -X [3] You cannot really hoard something that is avail- -Xable to the public at large, but try if it makes you -Xfeel any better. -X -X -X -X -X -X -X -X -X -X -X - 3 - -X -X -Xversion of sdbm), Arnold Robbins, Chris Lewis, Bill David- -Xsen, Henry Spencer, Geoff Collyer, Rich Salz (who got me -Xstarted in the first place), Johannes Ruschein (who did the -Xminix port) and David Tilbrook. I thank you all. -X -XDistribution Manifest and Notes -X -XThis distribution of sdbm includes (at least) the following: -X -X CHANGES change log -X README this file. -X biblio a small bibliography on external hashing -X dba.c a crude (n/s)dbm page file analyzer -X dbd.c a crude (n/s)dbm page file dumper (for conversion) -X dbe.1 man page for dbe.c -X dbe.c Janick's database editor -X dbm.c a dbm library emulation wrapper for ndbm/sdbm -X dbm.h header file for the above -X dbu.c a crude db management utility -X hash.c hashing function -X makefile guess. -X pair.c page-level routines (posted earlier) -X pair.h header file for the above -X readme.ms troff source for the README file -X sdbm.3 man page -X sdbm.c the real thing -X sdbm.h header file for the above -X tune.h place for tuning & portability thingies -X util.c miscellaneous -X -X dbu is a simple database manipulation program[4] that -Xtries to look like Bell Labs' cbt utility. It is currently -Xincomplete in functionality. I use dbu to test out the rou- -Xtines: it takes (from stdin) tab separated key/value pairs -Xfor commands like build or insert or takes keys for commands -Xlike delete or look. -X -X dbu dbmfile -X -X dba is a crude analyzer of dbm/sdbm/ndbm page files. It -Xscans the entire page file, reporting page level statistics, -Xand totals at the end. -X -X dbd is a crude dump program for dbm/ndbm/sdbm data- -Xbases. It ignores the bitmap, and dumps the data pages in -Xsequence. It can be used to create input for the dbu util- -Xity. Note that dbd will skip any NULLs in the key and data -Xfields, thus is unsuitable to convert some peculiar -X_________________________ -X -X [4] The dbd, dba, dbu utilities are quick hacks and -Xare not fit for production use. They were developed -Xlate one night, just to test out sdbm, and convert some -Xdatabases. -X -X -X -X -X -X -X -X -X -X - 4 - -X -X -Xdatabases that insist in including the terminating null. -X -X I have also included a copy of the dbe (ndbm DataBase -XEditor) by Janick Bergeron [janick@bnr.ca] for your pleas- -Xure. You may find it more useful than the little dbu util- -Xity. -X -X dbm.[ch] is a dbm library emulation on top of ndbm (and -Xhence suitable for sdbm). Written by Robert Elz. -X -X The sdbm library has been around in beta test for quite -Xa long time, and from whatever little feedback I received -X(maybe no news is good news), I believe it has been func- -Xtioning without any significant problems. I would, of -Xcourse, appreciate all fixes and/or improvements. Portabil- -Xity enhancements would especially be useful. -X -XImplementation Issues -X -X Hash functions: The algorithm behind sdbm implementa- -Xtion needs a good bit-scrambling hash function to be effec- -Xtive. I ran into a set of constants for a simple hash func- -Xtion that seem to help sdbm perform better than ndbm for -Xvarious inputs: -X -X /* -X * polynomial conversion ignoring overflows -X * 65599 nice. 65587 even better. -X */ -X long -X dbm_hash(char *str, int len) { -X register unsigned long n = 0; -X -X while (len--) -X n = n * 65599 + *str++; -X return n; -X } -X -X There may be better hash functions for the purposes of -Xdynamic hashing. Try your favorite, and check the pagefile. -XIf it contains too many pages with too many holes, (in rela- -Xtion to this one for example) or if sdbm simply stops work- -Xing (fails after SPLTMAX attempts to split) when you feed -Xyour NEWS history file to it, you probably do not have a -Xgood hashing function. If you do better (for different -Xtypes of input), I would like to know about the function you -Xuse. -X -X Block sizes: It seems (from various tests on a few -Xmachines) that a page file block size PBLKSIZ of 1024 is by -Xfar the best for performance, but this also happens to limit -Xthe size of a key/value pair. Depending on your needs, you -Xmay wish to increase the page size, and also adjust PAIRMAX -X(the maximum size of a key/value pair allowed: should always -X -X -X -X -X -X -X -X -X -X - 5 - -X -X -Xbe at least three words smaller than PBLKSIZ.) accordingly. -XThe system-wide version of the library should probably be -Xconfigured with 1024 (distribution default), as this appears -Xto be sufficient for most common uses of sdbm. -X -XPortability -X -X This package has been tested in many different UN*Xes -Xeven including minix, and appears to be reasonably portable. -XThis does not mean it will port easily to non-UN*X systems. -X -XNotes and Miscellaneous -X -X The sdbm is not a very complicated package, at least -Xnot after you familiarize yourself with the literature on -Xexternal hashing. There are other interesting algorithms in -Xexistence that ensure (approximately) single-read access to -Xa data value associated with any key. These are directory- -Xless schemes such as linear hashing [Lit80] (+ Larson varia- -Xtions), spiral storage [Mar79] or directory schemes such as -Xextensible hashing [Fag79] by Fagin et al. I do hope these -Xsources provide a reasonable playground for experimentation -Xwith other algorithms. See the June 1988 issue of ACM Com- -Xputing Surveys [Enb88] for an excellent overview of the -Xfield. -X -XReferences -X -X -X[Lar78] -X P.-A. Larson, ``Dynamic Hashing'', BIT, vol. 18, pp. -X 184-201, 1978. -X -X[Tho90] -X Ken Thompson, private communication, Nov. 1990 -X -X[Lit80] -X W. Litwin, `` Linear Hashing: A new tool for file and -X table addressing'', Proceedings of the 6th Conference on -X Very Large Dabatases (Montreal), pp. 212-223, Very -X Large Database Foundation, Saratoga, Calif., 1980. -X -X[Fag79] -X R. Fagin, J. Nievergelt, N. Pippinger, and H. R. -X Strong, ``Extendible Hashing - A Fast Access Method for -X Dynamic Files'', ACM Trans. Database Syst., vol. 4, -X no.3, pp. 315-344, Sept. 1979. -X -X[Wal84] -X Rich Wales, ``Discussion of "dbm" data base system'', -X USENET newsgroup unix.wizards, Jan. 1984. -X -X[Tor87] -X Chris Torek, ``Re: dbm.a and ndbm.a archives'', -X -X -X -X -X -X -X -X -X -X - 6 - -X -X -X USENET newsgroup comp.unix, 1987. -X -X[Mar79] -X G. N. Martin, ``Spiral Storage: Incrementally Augment- -X able Hash Addressed Storage'', Technical Report #27, -X University of Varwick, Coventry, U.K., 1979. -X -X[Enb88] -X R. J. Enbody and H. C. Du, ``Dynamic Hashing -X Schemes'',ACM Computing Surveys, vol. 20, no. 2, pp. -X 85-113, June 1988. -X -X -X -X -X -X -X -X -X -X -X -X -X -X -X -X -X -X -X -X -X -X -X -X -X -X -X -X -X -X -X -X -X -X -X -X -X -X -X -X -X -X -X -X -X -X -X -X -X -END_OF_FILE -if test 11457 -ne `wc -c <'README'`; then - echo shar: \"'README'\" unpacked with wrong size! -fi -# end of 'README' -fi -if test -f 'biblio' -a "${1}" != "-c" ; then - echo shar: Will not clobber existing file \"'biblio'\" -else -echo shar: Extracting \"'biblio'\" \(1012 characters\) -sed "s/^X//" >'biblio' <<'END_OF_FILE' -X%A R. J. Enbody -X%A H. C. Du -X%T Dynamic Hashing Schemes -X%J ACM Computing Surveys -X%V 20 -X%N 2 -X%D June 1988 -X%P 85-113 -X%K surveys -X -X%A P.-A. Larson -X%T Dynamic Hashing -X%J BIT -X%V 18 -X%P 184-201 -X%D 1978 -X%K dynamic -X -X%A W. Litwin -X%T Linear Hashing: A new tool for file and table addressing -X%J Proceedings of the 6th Conference on Very Large Dabatases (Montreal) -X%I Very Large Database Foundation -X%C Saratoga, Calif. -X%P 212-223 -X%D 1980 -X%K linear -X -X%A R. Fagin -X%A J. Nievergelt -X%A N. Pippinger -X%A H. R. Strong -X%T Extendible Hashing - A Fast Access Method for Dynamic Files -X%J ACM Trans. Database Syst. -X%V 4 -X%N 3 -X%D Sept. 1979 -X%P 315-344 -X%K extend -X -X%A G. N. Martin -X%T Spiral Storage: Incrementally Augmentable Hash Addressed Storage -X%J Technical Report #27 -X%I University of Varwick -X%C Coventry, U.K. -X%D 1979 -X%K spiral -X -X%A Chris Torek -X%T Re: dbm.a and ndbm.a archives -X%B USENET newsgroup comp.unix -X%D 1987 -X%K torek -X -X%A Rich Wales -X%T Discusson of "dbm" data base system -X%B USENET newsgroup unix.wizards -X%D Jan. 1984 -X%K rich -X -X -X -X -X -X -END_OF_FILE -if test 1012 -ne `wc -c <'biblio'`; then - echo shar: \"'biblio'\" unpacked with wrong size! -fi -# end of 'biblio' -fi -if test -f 'dba.c' -a "${1}" != "-c" ; then - echo shar: Will not clobber existing file \"'dba.c'\" -else -echo shar: Extracting \"'dba.c'\" \(1273 characters\) -sed "s/^X//" >'dba.c' <<'END_OF_FILE' -X/* -X * dba dbm analysis/recovery -X */ -X -X#include -X#include -X#include "sdbm.h" -X -Xchar *progname; -Xextern void oops(); -X -Xint -Xmain(argc, argv) -Xchar **argv; -X{ -X int n; -X char *p; -X char *name; -X int pagf; -X -X progname = argv[0]; -X -X if (p = argv[1]) { -X name = (char *) malloc((n = strlen(p)) + 5); -X strcpy(name, p); -X strcpy(name + n, ".pag"); -X -X if ((pagf = open(name, O_RDONLY)) < 0) -X oops("cannot open %s.", name); -X -X sdump(pagf); -X } -X else -X oops("usage: %s dbname", progname); -X -X return 0; -X} -X -Xsdump(pagf) -Xint pagf; -X{ -X register b; -X register n = 0; -X register t = 0; -X register o = 0; -X register e; -X char pag[PBLKSIZ]; -X -X while ((b = read(pagf, pag, PBLKSIZ)) > 0) { -X printf("#%d: ", n); -X if (!okpage(pag)) -X printf("bad\n"); -X else { -X printf("ok. "); -X if (!(e = pagestat(pag))) -X o++; -X else -X t += e; -X } -X n++; -X } -X -X if (b == 0) -X printf("%d pages (%d holes): %d entries\n", n, o, t); -X else -X oops("read failed: block %d", n); -X} -X -Xpagestat(pag) -Xchar *pag; -X{ -X register n; -X register free; -X register short *ino = (short *) pag; -X -X if (!(n = ino[0])) -X printf("no entries.\n"); -X else { -X free = ino[n] - (n + 1) * sizeof(short); -X printf("%3d entries %2d%% used free %d.\n", -X n / 2, ((PBLKSIZ - free) * 100) / PBLKSIZ, free); -X } -X return n / 2; -X} -END_OF_FILE -if test 1273 -ne `wc -c <'dba.c'`; then - echo shar: \"'dba.c'\" unpacked with wrong size! -fi -# end of 'dba.c' -fi -if test -f 'dbd.c' -a "${1}" != "-c" ; then - echo shar: Will not clobber existing file \"'dbd.c'\" -else -echo shar: Extracting \"'dbd.c'\" \(1719 characters\) -sed "s/^X//" >'dbd.c' <<'END_OF_FILE' -X/* -X * dbd - dump a dbm data file -X */ -X -X#include -X#include -X#include "sdbm.h" -X -Xchar *progname; -Xextern void oops(); -X -X -X#define empty(page) (((short *) page)[0] == 0) -X -Xint -Xmain(argc, argv) -Xchar **argv; -X{ -X int n; -X char *p; -X char *name; -X int pagf; -X -X progname = argv[0]; -X -X if (p = argv[1]) { -X name = (char *) malloc((n = strlen(p)) + 5); -X strcpy(name, p); -X strcpy(name + n, ".pag"); -X -X if ((pagf = open(name, O_RDONLY)) < 0) -X oops("cannot open %s.", name); -X -X sdump(pagf); -X } -X else -X oops("usage: %s dbname", progname); -X return 0; -X} -X -Xsdump(pagf) -Xint pagf; -X{ -X register r; -X register n = 0; -X register o = 0; -X char pag[PBLKSIZ]; -X -X while ((r = read(pagf, pag, PBLKSIZ)) > 0) { -X if (!okpage(pag)) -X fprintf(stderr, "%d: bad page.\n", n); -X else if (empty(pag)) -X o++; -X else -X dispage(pag); -X n++; -X } -X -X if (r == 0) -X fprintf(stderr, "%d pages (%d holes).\n", n, o); -X else -X oops("read failed: block %d", n); -X} -X -X -X#ifdef OLD -Xdispage(pag) -Xchar *pag; -X{ -X register i, n; -X register off; -X register short *ino = (short *) pag; -X -X off = PBLKSIZ; -X for (i = 1; i < ino[0]; i += 2) { -X printf("\t[%d]: ", ino[i]); -X for (n = ino[i]; n < off; n++) -X putchar(pag[n]); -X putchar(' '); -X off = ino[i]; -X printf("[%d]: ", ino[i + 1]); -X for (n = ino[i + 1]; n < off; n++) -X putchar(pag[n]); -X off = ino[i + 1]; -X putchar('\n'); -X } -X} -X#else -Xdispage(pag) -Xchar *pag; -X{ -X register i, n; -X register off; -X register short *ino = (short *) pag; -X -X off = PBLKSIZ; -X for (i = 1; i < ino[0]; i += 2) { -X for (n = ino[i]; n < off; n++) -X if (pag[n] != 0) -X putchar(pag[n]); -X putchar('\t'); -X off = ino[i]; -X for (n = ino[i + 1]; n < off; n++) -X if (pag[n] != 0) -X putchar(pag[n]); -X putchar('\n'); -X off = ino[i + 1]; -X } -X} -X#endif -END_OF_FILE -if test 1719 -ne `wc -c <'dbd.c'`; then - echo shar: \"'dbd.c'\" unpacked with wrong size! -fi -# end of 'dbd.c' -fi -if test -f 'dbe.1' -a "${1}" != "-c" ; then - echo shar: Will not clobber existing file \"'dbe.1'\" -else -echo shar: Extracting \"'dbe.1'\" \(1454 characters\) -sed "s/^X//" >'dbe.1' <<'END_OF_FILE' -X.TH dbe 1 "ndbm(3) EDITOR" -X.SH NAME -Xdbe \- Edit a ndbm(3) database -X.SH USAGE -Xdbe [-m r|w|rw] [-crtvx] -a|-d|-f|-F|-s [ []] -X.SH DESCRIPTION -X\fIdbme\fP operates on ndbm(3) databases. -XIt can be used to create them, look at them or change them. -XWhen specifying the value of a key or the content of its associated entry, -X\\nnn, \\0, \\n, \\t, \\f and \\r are interpreted as usual. -XWhen displaying key/content pairs, non-printable characters are displayed -Xusing the \\nnn notation. -X.SH OPTIONS -X.IP -a -XList all entries in the database. -X.IP -c -XCreate the database if it does not exist. -X.IP -d -XDelete the entry associated with the specified key. -X.IP -f -XFetch and display the entry associated with the specified key. -X.IP -F -XFetch and display all the entries whose key match the specified -Xregular-expression -X.IP "-m r|w|rw" -XOpen the database in read-only, write-only or read-write mode -X.IP -r -XReplace the entry associated with the specified key if it already exists. -XSee option -s. -X.IP -s -XStore an entry under a specific key. -XAn error occurs if the key already exists and the option -r was not specified. -X.IP -t -XRe-initialize the database before executing the command. -X.IP -v -XVerbose mode. -XConfirm stores and deletions. -X.IP -x -XIf option -x is used with option -c, then if the database already exists, -Xan error occurs. -XThis can be used to implement a simple exclusive access locking mechanism. -X.SH SEE ALSO -Xndbm(3) -X.SH AUTHOR -Xjanick@bnr.ca -X -END_OF_FILE -if test 1454 -ne `wc -c <'dbe.1'`; then - echo shar: \"'dbe.1'\" unpacked with wrong size! -fi -# end of 'dbe.1' -fi -if test -f 'dbe.c' -a "${1}" != "-c" ; then - echo shar: Will not clobber existing file \"'dbe.c'\" -else -echo shar: Extracting \"'dbe.c'\" \(9799 characters\) -sed "s/^X//" >'dbe.c' <<'END_OF_FILE' -X#include -X#ifndef VMS -X#include -X#include -X#else -X#include "file.h" -X#include "ndbm.h" -X#endif -X#include -X -X/***************************************************************************\ -X** ** -X** Function name: getopt() ** -X** Author: Henry Spencer, UofT ** -X** Coding date: 84/04/28 ** -X** ** -X** Description: ** -X** ** -X** Parses argv[] for arguments. ** -X** Works with Whitesmith's C compiler. ** -X** ** -X** Inputs - The number of arguments ** -X** - The base address of the array of arguments ** -X** - A string listing the valid options (':' indicates an ** -X** argument to the preceding option is required, a ';' ** -X** indicates an argument to the preceding option is optional) ** -X** ** -X** Outputs - Returns the next option character, ** -X** '?' for non '-' arguments ** -X** or ':' when there is no more arguments. ** -X** ** -X** Side Effects + The argument to an option is pointed to by 'optarg' ** -X** ** -X***************************************************************************** -X** ** -X** REVISION HISTORY: ** -X** ** -X** DATE NAME DESCRIPTION ** -X** YY/MM/DD ------------------ ------------------------------------ ** -X** 88/10/20 Janick Bergeron Returns '?' on unamed arguments ** -X** returns '!' on unknown options ** -X** and 'EOF' only when exhausted. ** -X** 88/11/18 Janick Bergeron Return ':' when no more arguments ** -X** 89/08/11 Janick Bergeron Optional optarg when ';' in optstring ** -X** ** -X\***************************************************************************/ -X -Xchar *optarg; /* Global argument pointer. */ -X -X#ifdef VMS -X#define index strchr -X#endif -X -Xchar -Xgetopt(argc, argv, optstring) -Xint argc; -Xchar **argv; -Xchar *optstring; -X{ -X register int c; -X register char *place; -X extern char *index(); -X static int optind = 0; -X static char *scan = NULL; -X -X optarg = NULL; -X -X if (scan == NULL || *scan == '\0') { -X -X if (optind == 0) -X optind++; -X if (optind >= argc) -X return ':'; -X -X optarg = place = argv[optind++]; -X if (place[0] != '-' || place[1] == '\0') -X return '?'; -X if (place[1] == '-' && place[2] == '\0') -X return '?'; -X scan = place + 1; -X } -X -X c = *scan++; -X place = index(optstring, c); -X if (place == NULL || c == ':' || c == ';') { -X -X (void) fprintf(stderr, "%s: unknown option %c\n", argv[0], c); -X scan = NULL; -X return '!'; -X } -X if (*++place == ':') { -X -X if (*scan != '\0') { -X -X optarg = scan; -X scan = NULL; -X -X } -X else { -X -X if (optind >= argc) { -X -X (void) fprintf(stderr, "%s: %c requires an argument\n", -X argv[0], c); -X return '!'; -X } -X optarg = argv[optind]; -X optind++; -X } -X } -X else if (*place == ';') { -X -X if (*scan != '\0') { -X -X optarg = scan; -X scan = NULL; -X -X } -X else { -X -X if (optind >= argc || *argv[optind] == '-') -X optarg = NULL; -X else { -X optarg = argv[optind]; -X optind++; -X } -X } -X } -X return c; -X} -X -X -Xvoid -Xprint_datum(db) -Xdatum db; -X{ -X int i; -X -X putchar('"'); -X for (i = 0; i < db.dsize; i++) { -X if (isprint(db.dptr[i])) -X putchar(db.dptr[i]); -X else { -X putchar('\\'); -X putchar('0' + ((db.dptr[i] >> 6) & 0x07)); -X putchar('0' + ((db.dptr[i] >> 3) & 0x07)); -X putchar('0' + (db.dptr[i] & 0x07)); -X } -X } -X putchar('"'); -X} -X -X -Xdatum -Xread_datum(s) -Xchar *s; -X{ -X datum db; -X char *p; -X int i; -X -X db.dsize = 0; -X db.dptr = (char *) malloc(strlen(s) * sizeof(char)); -X for (p = db.dptr; *s != '\0'; p++, db.dsize++, s++) { -X if (*s == '\\') { -X if (*++s == 'n') -X *p = '\n'; -X else if (*s == 'r') -X *p = '\r'; -X else if (*s == 'f') -X *p = '\f'; -X else if (*s == 't') -X *p = '\t'; -X else if (isdigit(*s) && isdigit(*(s + 1)) && isdigit(*(s + 2))) { -X i = (*s++ - '0') << 6; -X i |= (*s++ - '0') << 3; -X i |= *s - '0'; -X *p = i; -X } -X else if (*s == '0') -X *p = '\0'; -X else -X *p = *s; -X } -X else -X *p = *s; -X } -X -X return db; -X} -X -X -Xchar * -Xkey2s(db) -Xdatum db; -X{ -X char *buf; -X char *p1, *p2; -X -X buf = (char *) malloc((db.dsize + 1) * sizeof(char)); -X for (p1 = buf, p2 = db.dptr; *p2 != '\0'; *p1++ = *p2++); -X *p1 = '\0'; -X return buf; -X} -X -X -Xmain(argc, argv) -Xint argc; -Xchar **argv; -X{ -X typedef enum { -X YOW, FETCH, STORE, DELETE, SCAN, REGEXP -X } commands; -X char opt; -X int flags; -X int giveusage = 0; -X int verbose = 0; -X commands what = YOW; -X char *comarg[3]; -X int st_flag = DBM_INSERT; -X int argn; -X DBM *db; -X datum key; -X datum content; -X -X flags = O_RDWR; -X argn = 0; -X -X while ((opt = getopt(argc, argv, "acdfFm:rstvx")) != ':') { -X switch (opt) { -X case 'a': -X what = SCAN; -X break; -X case 'c': -X flags |= O_CREAT; -X break; -X case 'd': -X what = DELETE; -X break; -X case 'f': -X what = FETCH; -X break; -X case 'F': -X what = REGEXP; -X break; -X case 'm': -X flags &= ~(000007); -X if (strcmp(optarg, "r") == 0) -X flags |= O_RDONLY; -X else if (strcmp(optarg, "w") == 0) -X flags |= O_WRONLY; -X else if (strcmp(optarg, "rw") == 0) -X flags |= O_RDWR; -X else { -X fprintf(stderr, "Invalid mode: \"%s\"\n", optarg); -X giveusage = 1; -X } -X break; -X case 'r': -X st_flag = DBM_REPLACE; -X break; -X case 's': -X what = STORE; -X break; -X case 't': -X flags |= O_TRUNC; -X break; -X case 'v': -X verbose = 1; -X break; -X case 'x': -X flags |= O_EXCL; -X break; -X case '!': -X giveusage = 1; -X break; -X case '?': -X if (argn < 3) -X comarg[argn++] = optarg; -X else { -X fprintf(stderr, "Too many arguments.\n"); -X giveusage = 1; -X } -X break; -X } -X } -X -X if (giveusage | what == YOW | argn < 1) { -X fprintf(stderr, "Usage: %s databse [-m r|w|rw] [-crtx] -a|-d|-f|-F|-s [key [content]]\n", argv[0]); -X exit(-1); -X } -X -X if ((db = dbm_open(comarg[0], flags, 0777)) == NULL) { -X fprintf(stderr, "Error opening database \"%s\"\n", comarg[0]); -X exit(-1); -X } -X -X if (argn > 1) -X key = read_datum(comarg[1]); -X if (argn > 2) -X content = read_datum(comarg[2]); -X -X switch (what) { -X -X case SCAN: -X key = dbm_firstkey(db); -X if (dbm_error(db)) { -X fprintf(stderr, "Error when fetching first key\n"); -X goto db_exit; -X } -X while (key.dptr != NULL) { -X content = dbm_fetch(db, key); -X if (dbm_error(db)) { -X fprintf(stderr, "Error when fetching "); -X print_datum(key); -X printf("\n"); -X goto db_exit; -X } -X print_datum(key); -X printf(": "); -X print_datum(content); -X printf("\n"); -X if (dbm_error(db)) { -X fprintf(stderr, "Error when fetching next key\n"); -X goto db_exit; -X } -X key = dbm_nextkey(db); -X } -X break; -X -X case REGEXP: -X if (argn < 2) { -X fprintf(stderr, "Missing regular expression.\n"); -X goto db_exit; -X } -X if (re_comp(comarg[1])) { -X fprintf(stderr, "Invalid regular expression\n"); -X goto db_exit; -X } -X key = dbm_firstkey(db); -X if (dbm_error(db)) { -X fprintf(stderr, "Error when fetching first key\n"); -X goto db_exit; -X } -X while (key.dptr != NULL) { -X if (re_exec(key2s(key))) { -X content = dbm_fetch(db, key); -X if (dbm_error(db)) { -X fprintf(stderr, "Error when fetching "); -X print_datum(key); -X printf("\n"); -X goto db_exit; -X } -X print_datum(key); -X printf(": "); -X print_datum(content); -X printf("\n"); -X if (dbm_error(db)) { -X fprintf(stderr, "Error when fetching next key\n"); -X goto db_exit; -X } -X } -X key = dbm_nextkey(db); -X } -X break; -X -X case FETCH: -X if (argn < 2) { -X fprintf(stderr, "Missing fetch key.\n"); -X goto db_exit; -X } -X content = dbm_fetch(db, key); -X if (dbm_error(db)) { -X fprintf(stderr, "Error when fetching "); -X print_datum(key); -X printf("\n"); -X goto db_exit; -X } -X if (content.dptr == NULL) { -X fprintf(stderr, "Cannot find "); -X print_datum(key); -X printf("\n"); -X goto db_exit; -X } -X print_datum(key); -X printf(": "); -X print_datum(content); -X printf("\n"); -X break; -X -X case DELETE: -X if (argn < 2) { -X fprintf(stderr, "Missing delete key.\n"); -X goto db_exit; -X } -X if (dbm_delete(db, key) || dbm_error(db)) { -X fprintf(stderr, "Error when deleting "); -X print_datum(key); -X printf("\n"); -X goto db_exit; -X } -X if (verbose) { -X print_datum(key); -X printf(": DELETED\n"); -X } -X break; -X -X case STORE: -X if (argn < 3) { -X fprintf(stderr, "Missing key and/or content.\n"); -X goto db_exit; -X } -X if (dbm_store(db, key, content, st_flag) || dbm_error(db)) { -X fprintf(stderr, "Error when storing "); -X print_datum(key); -X printf("\n"); -X goto db_exit; -X } -X if (verbose) { -X print_datum(key); -X printf(": "); -X print_datum(content); -X printf(" STORED\n"); -X } -X break; -X } -X -Xdb_exit: -X dbm_clearerr(db); -X dbm_close(db); -X if (dbm_error(db)) { -X fprintf(stderr, "Error closing database \"%s\"\n", comarg[0]); -X exit(-1); -X } -X} -END_OF_FILE -if test 9799 -ne `wc -c <'dbe.c'`; then - echo shar: \"'dbe.c'\" unpacked with wrong size! -fi -# end of 'dbe.c' -fi -if test -f 'dbm.c' -a "${1}" != "-c" ; then - echo shar: Will not clobber existing file \"'dbm.c'\" -else -echo shar: Extracting \"'dbm.c'\" \(2426 characters\) -sed "s/^X//" >'dbm.c' <<'END_OF_FILE' -X/* -X * Copyright (c) 1985 The Regents of the University of California. -X * All rights reserved. -X * -X * Redistribution and use in source and binary forms are permitted -X * provided that the above copyright notice and this paragraph are -X * duplicated in all such forms and that any documentation, -X * advertising materials, and other materials related to such -X * distribution and use acknowledge that the software was developed -X * by the University of California, Berkeley. The name of the -X * University may not be used to endorse or promote products derived -X * from this software without specific prior written permission. -X * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR -X * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED -X * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. -X */ -X -X#ifndef lint -Xstatic char sccsid[] = "@(#)dbm.c 5.4 (Berkeley) 5/24/89"; -X#endif /* not lint */ -X -X#include "dbm.h" -X -X#define NODB ((DBM *)0) -X -Xstatic DBM *cur_db = NODB; -X -Xstatic char no_db[] = "dbm: no open database\n"; -X -Xdbminit(file) -X char *file; -X{ -X if (cur_db != NODB) -X dbm_close(cur_db); -X -X cur_db = dbm_open(file, 2, 0); -X if (cur_db == NODB) { -X cur_db = dbm_open(file, 0, 0); -X if (cur_db == NODB) -X return (-1); -X } -X return (0); -X} -X -Xlong -Xforder(key) -Xdatum key; -X{ -X if (cur_db == NODB) { -X printf(no_db); -X return (0L); -X } -X return (dbm_forder(cur_db, key)); -X} -X -Xdatum -Xfetch(key) -Xdatum key; -X{ -X datum item; -X -X if (cur_db == NODB) { -X printf(no_db); -X item.dptr = 0; -X return (item); -X } -X return (dbm_fetch(cur_db, key)); -X} -X -Xdelete(key) -Xdatum key; -X{ -X if (cur_db == NODB) { -X printf(no_db); -X return (-1); -X } -X if (dbm_rdonly(cur_db)) -X return (-1); -X return (dbm_delete(cur_db, key)); -X} -X -Xstore(key, dat) -Xdatum key, dat; -X{ -X if (cur_db == NODB) { -X printf(no_db); -X return (-1); -X } -X if (dbm_rdonly(cur_db)) -X return (-1); -X -X return (dbm_store(cur_db, key, dat, DBM_REPLACE)); -X} -X -Xdatum -Xfirstkey() -X{ -X datum item; -X -X if (cur_db == NODB) { -X printf(no_db); -X item.dptr = 0; -X return (item); -X } -X return (dbm_firstkey(cur_db)); -X} -X -Xdatum -Xnextkey(key) -Xdatum key; -X{ -X datum item; -X -X if (cur_db == NODB) { -X printf(no_db); -X item.dptr = 0; -X return (item); -X } -X return (dbm_nextkey(cur_db, key)); -X} -END_OF_FILE -if test 2426 -ne `wc -c <'dbm.c'`; then - echo shar: \"'dbm.c'\" unpacked with wrong size! -fi -# end of 'dbm.c' -fi -if test -f 'dbm.h' -a "${1}" != "-c" ; then - echo shar: Will not clobber existing file \"'dbm.h'\" -else -echo shar: Extracting \"'dbm.h'\" \(1186 characters\) -sed "s/^X//" >'dbm.h' <<'END_OF_FILE' -X/* -X * Copyright (c) 1983 The Regents of the University of California. -X * All rights reserved. -X * -X * Redistribution and use in source and binary forms are permitted -X * provided that the above copyright notice and this paragraph are -X * duplicated in all such forms and that any documentation, -X * advertising materials, and other materials related to such -X * distribution and use acknowledge that the software was developed -X * by the University of California, Berkeley. The name of the -X * University may not be used to endorse or promote products derived -X * from this software without specific prior written permission. -X * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR -X * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED -X * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. -X * -X * @(#)dbm.h 5.2 (Berkeley) 5/24/89 -X */ -X -X#ifndef NULL -X/* -X * this is lunacy, we no longer use it (and never should have -X * unconditionally defined it), but, this whole file is for -X * backwards compatability - someone may rely on this. -X */ -X#define NULL ((char *) 0) -X#endif -X -X#include -X -Xdatum fetch(); -Xdatum firstkey(); -Xdatum nextkey(); -END_OF_FILE -if test 1186 -ne `wc -c <'dbm.h'`; then - echo shar: \"'dbm.h'\" unpacked with wrong size! -fi -# end of 'dbm.h' -fi -if test -f 'dbu.c' -a "${1}" != "-c" ; then - echo shar: Will not clobber existing file \"'dbu.c'\" -else -echo shar: Extracting \"'dbu.c'\" \(4408 characters\) -sed "s/^X//" >'dbu.c' <<'END_OF_FILE' -X#include -X#include -X#ifdef SDBM -X#include "sdbm.h" -X#else -X#include -X#endif -X#include -X -X#ifdef BSD42 -X#define strchr index -X#endif -X -Xextern int getopt(); -Xextern char *strchr(); -Xextern void oops(); -X -Xchar *progname; -X -Xstatic int rflag; -Xstatic char *usage = "%s [-R] cat | look |... dbmname"; -X -X#define DERROR 0 -X#define DLOOK 1 -X#define DINSERT 2 -X#define DDELETE 3 -X#define DCAT 4 -X#define DBUILD 5 -X#define DPRESS 6 -X#define DCREAT 7 -X -X#define LINEMAX 8192 -X -Xtypedef struct { -X char *sname; -X int scode; -X int flags; -X} cmd; -X -Xstatic cmd cmds[] = { -X -X "fetch", DLOOK, O_RDONLY, -X "get", DLOOK, O_RDONLY, -X "look", DLOOK, O_RDONLY, -X "add", DINSERT, O_RDWR, -X "insert", DINSERT, O_RDWR, -X "store", DINSERT, O_RDWR, -X "delete", DDELETE, O_RDWR, -X "remove", DDELETE, O_RDWR, -X "dump", DCAT, O_RDONLY, -X "list", DCAT, O_RDONLY, -X "cat", DCAT, O_RDONLY, -X "creat", DCREAT, O_RDWR | O_CREAT | O_TRUNC, -X "new", DCREAT, O_RDWR | O_CREAT | O_TRUNC, -X "build", DBUILD, O_RDWR | O_CREAT, -X "squash", DPRESS, O_RDWR, -X "compact", DPRESS, O_RDWR, -X "compress", DPRESS, O_RDWR -X}; -X -X#define CTABSIZ (sizeof (cmds)/sizeof (cmd)) -X -Xstatic cmd *parse(); -Xstatic void badk(), doit(), prdatum(); -X -Xint -Xmain(argc, argv) -Xint argc; -Xchar *argv[]; -X{ -X int c; -X register cmd *act; -X extern int optind; -X extern char *optarg; -X -X progname = argv[0]; -X -X while ((c = getopt(argc, argv, "R")) != EOF) -X switch (c) { -X case 'R': /* raw processing */ -X rflag++; -X break; -X -X default: -X oops("usage: %s", usage); -X break; -X } -X -X if ((argc -= optind) < 2) -X oops("usage: %s", usage); -X -X if ((act = parse(argv[optind])) == NULL) -X badk(argv[optind]); -X optind++; -X doit(act, argv[optind]); -X return 0; -X} -X -Xstatic void -Xdoit(act, file) -Xregister cmd *act; -Xchar *file; -X{ -X datum key; -X datum val; -X register DBM *db; -X register char *op; -X register int n; -X char *line; -X#ifdef TIME -X long start; -X extern long time(); -X#endif -X -X if ((db = dbm_open(file, act->flags, 0644)) == NULL) -X oops("cannot open: %s", file); -X -X if ((line = (char *) malloc(LINEMAX)) == NULL) -X oops("%s: cannot get memory", "line alloc"); -X -X switch (act->scode) { -X -X case DLOOK: -X while (fgets(line, LINEMAX, stdin) != NULL) { -X n = strlen(line) - 1; -X line[n] = 0; -X key.dptr = line; -X key.dsize = n; -X val = dbm_fetch(db, key); -X if (val.dptr != NULL) { -X prdatum(stdout, val); -X putchar('\n'); -X continue; -X } -X prdatum(stderr, key); -X fprintf(stderr, ": not found.\n"); -X } -X break; -X case DINSERT: -X break; -X case DDELETE: -X while (fgets(line, LINEMAX, stdin) != NULL) { -X n = strlen(line) - 1; -X line[n] = 0; -X key.dptr = line; -X key.dsize = n; -X if (dbm_delete(db, key) == -1) { -X prdatum(stderr, key); -X fprintf(stderr, ": not found.\n"); -X } -X } -X break; -X case DCAT: -X for (key = dbm_firstkey(db); key.dptr != 0; -X key = dbm_nextkey(db)) { -X prdatum(stdout, key); -X putchar('\t'); -X prdatum(stdout, dbm_fetch(db, key)); -X putchar('\n'); -X } -X break; -X case DBUILD: -X#ifdef TIME -X start = time(0); -X#endif -X while (fgets(line, LINEMAX, stdin) != NULL) { -X n = strlen(line) - 1; -X line[n] = 0; -X key.dptr = line; -X if ((op = strchr(line, '\t')) != 0) { -X key.dsize = op - line; -X *op++ = 0; -X val.dptr = op; -X val.dsize = line + n - op; -X } -X else -X oops("bad input; %s", line); -X -X if (dbm_store(db, key, val, DBM_REPLACE) < 0) { -X prdatum(stderr, key); -X fprintf(stderr, ": "); -X oops("store: %s", "failed"); -X } -X } -X#ifdef TIME -X printf("done: %d seconds.\n", time(0) - start); -X#endif -X break; -X case DPRESS: -X break; -X case DCREAT: -X break; -X } -X -X dbm_close(db); -X} -X -Xstatic void -Xbadk(word) -Xchar *word; -X{ -X register int i; -X -X if (progname) -X fprintf(stderr, "%s: ", progname); -X fprintf(stderr, "bad keywd %s. use one of\n", word); -X for (i = 0; i < (int)CTABSIZ; i++) -X fprintf(stderr, "%-8s%c", cmds[i].sname, -X ((i + 1) % 6 == 0) ? '\n' : ' '); -X fprintf(stderr, "\n"); -X exit(1); -X /*NOTREACHED*/ -X} -X -Xstatic cmd * -Xparse(str) -Xregister char *str; -X{ -X register int i = CTABSIZ; -X register cmd *p; -X -X for (p = cmds; i--; p++) -X if (strcmp(p->sname, str) == 0) -X return p; -X return NULL; -X} -X -Xstatic void -Xprdatum(stream, d) -XFILE *stream; -Xdatum d; -X{ -X register int c; -X register char *p = d.dptr; -X register int n = d.dsize; -X -X while (n--) { -X c = *p++ & 0377; -X if (c & 0200) { -X fprintf(stream, "M-"); -X c &= 0177; -X } -X if (c == 0177 || c < ' ') -X fprintf(stream, "^%c", (c == 0177) ? '?' : c + '@'); -X else -X putc(c, stream); -X } -X} -X -X -END_OF_FILE -if test 4408 -ne `wc -c <'dbu.c'`; then - echo shar: \"'dbu.c'\" unpacked with wrong size! -fi -# end of 'dbu.c' -fi -if test -f 'grind' -a "${1}" != "-c" ; then - echo shar: Will not clobber existing file \"'grind'\" -else -echo shar: Extracting \"'grind'\" \(201 characters\) -sed "s/^X//" >'grind' <<'END_OF_FILE' -X#!/bin/sh -Xrm -f /tmp/*.dir /tmp/*.pag -Xawk -e '{ -X printf "%s\t", $0 -X for (i = 0; i < 40; i++) -X printf "%s.", $0 -X printf "\n" -X}' < /usr/dict/words | $1 build /tmp/$2 -X -END_OF_FILE -if test 201 -ne `wc -c <'grind'`; then - echo shar: \"'grind'\" unpacked with wrong size! -fi -chmod +x 'grind' -# end of 'grind' -fi -if test -f 'hash.c' -a "${1}" != "-c" ; then - echo shar: Will not clobber existing file \"'hash.c'\" -else -echo shar: Extracting \"'hash.c'\" \(922 characters\) -sed "s/^X//" >'hash.c' <<'END_OF_FILE' -X/* -X * sdbm - ndbm work-alike hashed database library -X * based on Per-Aake Larson's Dynamic Hashing algorithms. BIT 18 (1978). -X * author: oz@nexus.yorku.ca -X * status: public domain. keep it that way. -X * -X * hashing routine -X */ -X -X#include "sdbm.h" -X/* -X * polynomial conversion ignoring overflows -X * [this seems to work remarkably well, in fact better -X * then the ndbm hash function. Replace at your own risk] -X * use: 65599 nice. -X * 65587 even better. -X */ -Xlong -Xdbm_hash(str, len) -Xregister char *str; -Xregister int len; -X{ -X register unsigned long n = 0; -X -X#ifdef DUFF -X -X#define HASHC n = *str++ + 65599 * n -X -X if (len > 0) { -X register int loop = (len + 8 - 1) >> 3; -X -X switch(len & (8 - 1)) { -X case 0: do { -X HASHC; case 7: HASHC; -X case 6: HASHC; case 5: HASHC; -X case 4: HASHC; case 3: HASHC; -X case 2: HASHC; case 1: HASHC; -X } while (--loop); -X } -X -X } -X#else -X while (len--) -X n = *str++ + 65599 * n; -X#endif -X return n; -X} -END_OF_FILE -if test 922 -ne `wc -c <'hash.c'`; then - echo shar: \"'hash.c'\" unpacked with wrong size! -fi -# end of 'hash.c' -fi -if test -f 'makefile' -a "${1}" != "-c" ; then - echo shar: Will not clobber existing file \"'makefile'\" -else -echo shar: Extracting \"'makefile'\" \(1147 characters\) -sed "s/^X//" >'makefile' <<'END_OF_FILE' -X# -X# makefile for public domain ndbm-clone: sdbm -X# DUFF: use duff's device (loop unroll) in parts of the code -X# -XCFLAGS = -O -DSDBM -DDUFF -DBSD42 -X#LDFLAGS = -p -X -XOBJS = sdbm.o pair.o hash.o -XSRCS = sdbm.c pair.c hash.c dbu.c dba.c dbd.c util.c -XHDRS = tune.h sdbm.h pair.h -XMISC = README CHANGES COMPARE sdbm.3 dbe.c dbe.1 dbm.c dbm.h biblio \ -X readme.ms readme.ps -X -Xall: dbu dba dbd dbe -X -Xdbu: dbu.o sdbm util.o -X cc $(LDFLAGS) -o dbu dbu.o util.o libsdbm.a -X -Xdba: dba.o util.o -X cc $(LDFLAGS) -o dba dba.o util.o -Xdbd: dbd.o util.o -X cc $(LDFLAGS) -o dbd dbd.o util.o -Xdbe: dbe.o sdbm -X cc $(LDFLAGS) -o dbe dbe.o libsdbm.a -X -Xsdbm: $(OBJS) -X ar cr libsdbm.a $(OBJS) -X ranlib libsdbm.a -X### cp libsdbm.a /usr/lib/libsdbm.a -X -Xdba.o: sdbm.h -Xdbu.o: sdbm.h -Xutil.o:sdbm.h -X -X$(OBJS): sdbm.h tune.h pair.h -X -X# -X# dbu using berkelezoid ndbm routines [if you have them] for testing -X# -X#x-dbu: dbu.o util.o -X# cc $(CFLAGS) -o x-dbu dbu.o util.o -Xlint: -X lint -abchx $(SRCS) -X -Xclean: -X rm -f *.o mon.out core -X -Xpurge: clean -X rm -f dbu libsdbm.a dbd dba dbe x-dbu *.dir *.pag -X -Xshar: -X shar $(MISC) makefile $(SRCS) $(HDRS) >SDBM.SHAR -X -Xreadme: -X nroff -ms readme.ms | col -b >README -END_OF_FILE -if test 1147 -ne `wc -c <'makefile'`; then - echo shar: \"'makefile'\" unpacked with wrong size! -fi -# end of 'makefile' -fi -if test -f 'pair.c' -a "${1}" != "-c" ; then - echo shar: Will not clobber existing file \"'pair.c'\" -else -echo shar: Extracting \"'pair.c'\" \(5720 characters\) -sed "s/^X//" >'pair.c' <<'END_OF_FILE' -X/* -X * sdbm - ndbm work-alike hashed database library -X * based on Per-Aake Larson's Dynamic Hashing algorithms. BIT 18 (1978). -X * author: oz@nexus.yorku.ca -X * status: public domain. -X * -X * page-level routines -X */ -X -X#ifndef lint -Xstatic char rcsid[] = "$Id: pair.c,v 1.10 90/12/13 13:00:35 oz Exp $"; -X#endif -X -X#include "sdbm.h" -X#include "tune.h" -X#include "pair.h" -X -X#ifndef BSD42 -X#include -X#endif -X -X#define exhash(item) dbm_hash((item).dptr, (item).dsize) -X -X/* -X * forward -X */ -Xstatic int seepair proto((char *, int, char *, int)); -X -X/* -X * page format: -X * +------------------------------+ -X * ino | n | keyoff | datoff | keyoff | -X * +------------+--------+--------+ -X * | datoff | - - - ----> | -X * +--------+---------------------+ -X * | F R E E A R E A | -X * +--------------+---------------+ -X * | <---- - - - | data | -X * +--------+-----+----+----------+ -X * | key | data | key | -X * +--------+----------+----------+ -X * -X * calculating the offsets for free area: if the number -X * of entries (ino[0]) is zero, the offset to the END of -X * the free area is the block size. Otherwise, it is the -X * nth (ino[ino[0]]) entry's offset. -X */ -X -Xint -Xfitpair(pag, need) -Xchar *pag; -Xint need; -X{ -X register int n; -X register int off; -X register int free; -X register short *ino = (short *) pag; -X -X off = ((n = ino[0]) > 0) ? ino[n] : PBLKSIZ; -X free = off - (n + 1) * sizeof(short); -X need += 2 * sizeof(short); -X -X debug(("free %d need %d\n", free, need)); -X -X return need <= free; -X} -X -Xvoid -Xputpair(pag, key, val) -Xchar *pag; -Xdatum key; -Xdatum val; -X{ -X register int n; -X register int off; -X register short *ino = (short *) pag; -X -X off = ((n = ino[0]) > 0) ? ino[n] : PBLKSIZ; -X/* -X * enter the key first -X */ -X off -= key.dsize; -X (void) memcpy(pag + off, key.dptr, key.dsize); -X ino[n + 1] = off; -X/* -X * now the data -X */ -X off -= val.dsize; -X (void) memcpy(pag + off, val.dptr, val.dsize); -X ino[n + 2] = off; -X/* -X * adjust item count -X */ -X ino[0] += 2; -X} -X -Xdatum -Xgetpair(pag, key) -Xchar *pag; -Xdatum key; -X{ -X register int i; -X register int n; -X datum val; -X register short *ino = (short *) pag; -X -X if ((n = ino[0]) == 0) -X return nullitem; -X -X if ((i = seepair(pag, n, key.dptr, key.dsize)) == 0) -X return nullitem; -X -X val.dptr = pag + ino[i + 1]; -X val.dsize = ino[i] - ino[i + 1]; -X return val; -X} -X -X#ifdef SEEDUPS -Xint -Xduppair(pag, key) -Xchar *pag; -Xdatum key; -X{ -X register short *ino = (short *) pag; -X return ino[0] > 0 && seepair(pag, ino[0], key.dptr, key.dsize) > 0; -X} -X#endif -X -Xdatum -Xgetnkey(pag, num) -Xchar *pag; -Xint num; -X{ -X datum key; -X register int off; -X register short *ino = (short *) pag; -X -X num = num * 2 - 1; -X if (ino[0] == 0 || num > ino[0]) -X return nullitem; -X -X off = (num > 1) ? ino[num - 1] : PBLKSIZ; -X -X key.dptr = pag + ino[num]; -X key.dsize = off - ino[num]; -X -X return key; -X} -X -Xint -Xdelpair(pag, key) -Xchar *pag; -Xdatum key; -X{ -X register int n; -X register int i; -X register short *ino = (short *) pag; -X -X if ((n = ino[0]) == 0) -X return 0; -X -X if ((i = seepair(pag, n, key.dptr, key.dsize)) == 0) -X return 0; -X/* -X * found the key. if it is the last entry -X * [i.e. i == n - 1] we just adjust the entry count. -X * hard case: move all data down onto the deleted pair, -X * shift offsets onto deleted offsets, and adjust them. -X * [note: 0 < i < n] -X */ -X if (i < n - 1) { -X register int m; -X register char *dst = pag + (i == 1 ? PBLKSIZ : ino[i - 1]); -X register char *src = pag + ino[i + 1]; -X register int zoo = dst - src; -X -X debug(("free-up %d ", zoo)); -X/* -X * shift data/keys down -X */ -X m = ino[i + 1] - ino[n]; -X#ifdef DUFF -X#define MOVB *--dst = *--src -X -X if (m > 0) { -X register int loop = (m + 8 - 1) >> 3; -X -X switch (m & (8 - 1)) { -X case 0: do { -X MOVB; case 7: MOVB; -X case 6: MOVB; case 5: MOVB; -X case 4: MOVB; case 3: MOVB; -X case 2: MOVB; case 1: MOVB; -X } while (--loop); -X } -X } -X#else -X#ifdef MEMMOVE -X memmove(dst, src, m); -X#else -X while (m--) -X *--dst = *--src; -X#endif -X#endif -X/* -X * adjust offset index up -X */ -X while (i < n - 1) { -X ino[i] = ino[i + 2] + zoo; -X i++; -X } -X } -X ino[0] -= 2; -X return 1; -X} -X -X/* -X * search for the key in the page. -X * return offset index in the range 0 < i < n. -X * return 0 if not found. -X */ -Xstatic int -Xseepair(pag, n, key, siz) -Xchar *pag; -Xregister int n; -Xregister char *key; -Xregister int siz; -X{ -X register int i; -X register int off = PBLKSIZ; -X register short *ino = (short *) pag; -X -X for (i = 1; i < n; i += 2) { -X if (siz == off - ino[i] && -X memcmp(key, pag + ino[i], siz) == 0) -X return i; -X off = ino[i + 1]; -X } -X return 0; -X} -X -Xvoid -Xsplpage(pag, new, sbit) -Xchar *pag; -Xchar *new; -Xlong sbit; -X{ -X datum key; -X datum val; -X -X register int n; -X register int off = PBLKSIZ; -X char cur[PBLKSIZ]; -X register short *ino = (short *) cur; -X -X (void) memcpy(cur, pag, PBLKSIZ); -X (void) memset(pag, 0, PBLKSIZ); -X (void) memset(new, 0, PBLKSIZ); -X -X n = ino[0]; -X for (ino++; n > 0; ino += 2) { -X key.dptr = cur + ino[0]; -X key.dsize = off - ino[0]; -X val.dptr = cur + ino[1]; -X val.dsize = ino[0] - ino[1]; -X/* -X * select the page pointer (by looking at sbit) and insert -X */ -X (void) putpair((exhash(key) & sbit) ? new : pag, key, val); -X -X off = ino[1]; -X n -= 2; -X } -X -X debug(("%d split %d/%d\n", ((short *) cur)[0] / 2, -X ((short *) new)[0] / 2, -X ((short *) pag)[0] / 2)); -X} -X -X/* -X * check page sanity: -X * number of entries should be something -X * reasonable, and all offsets in the index should be in order. -X * this could be made more rigorous. -X */ -Xint -Xchkpage(pag) -Xchar *pag; -X{ -X register int n; -X register int off; -X register short *ino = (short *) pag; -X -X if ((n = ino[0]) < 0 || n > PBLKSIZ / sizeof(short)) -X return 0; -X -X if (n > 0) { -X off = PBLKSIZ; -X for (ino++; n > 0; ino += 2) { -X if (ino[0] > off || ino[1] > off || -X ino[1] > ino[0]) -X return 0; -X off = ino[1]; -X n -= 2; -X } -X } -X return 1; -X} -END_OF_FILE -if test 5720 -ne `wc -c <'pair.c'`; then - echo shar: \"'pair.c'\" unpacked with wrong size! -fi -# end of 'pair.c' -fi -if test -f 'pair.h' -a "${1}" != "-c" ; then - echo shar: Will not clobber existing file \"'pair.h'\" -else -echo shar: Extracting \"'pair.h'\" \(378 characters\) -sed "s/^X//" >'pair.h' <<'END_OF_FILE' -Xextern int fitpair proto((char *, int)); -Xextern void putpair proto((char *, datum, datum)); -Xextern datum getpair proto((char *, datum)); -Xextern int delpair proto((char *, datum)); -Xextern int chkpage proto((char *)); -Xextern datum getnkey proto((char *, int)); -Xextern void splpage proto((char *, char *, long)); -X#ifdef SEEDUPS -Xextern int duppair proto((char *, datum)); -X#endif -END_OF_FILE -if test 378 -ne `wc -c <'pair.h'`; then - echo shar: \"'pair.h'\" unpacked with wrong size! -fi -# end of 'pair.h' -fi -if test -f 'readme.ms' -a "${1}" != "-c" ; then - echo shar: Will not clobber existing file \"'readme.ms'\" -else -echo shar: Extracting \"'readme.ms'\" \(11691 characters\) -sed "s/^X//" >'readme.ms' <<'END_OF_FILE' -X.\" tbl | readme.ms | [tn]roff -ms | ... -X.\" note the "C" (courier) and "CB" fonts: you will probably have to -X.\" change these. -X.\" $Id: readme.ms,v 1.1 90/12/13 13:09:15 oz Exp Locker: oz $ -X -X.de P1 -X.br -X.nr dT 4 -X.nf -X.ft C -X.sp .5 -X.nr t \\n(dT*\\w'x'u -X.ta 1u*\\ntu 2u*\\ntu 3u*\\ntu 4u*\\ntu 5u*\\ntu 6u*\\ntu 7u*\\ntu 8u*\\ntu 9u*\\ntu 10u*\\ntu 11u*\\ntu 12u*\\ntu 13u*\\ntu 14u*\\ntu -X.. -X.de P2 -X.br -X.ft 1 -X.br -X.sp .5 -X.br -X.fi -X.. -X.\" CW uses the typewriter/courier font. -X.de CW -X\fC\\$1\\fP\\$2 -X.. -X -X.\" Footnote numbering [by Henry Spencer] -X.\" \*f for a footnote number.. -X.\" .FS -X.\" \*F -X.\" .FE -X.\" -X.ds f \\u\\s-2\\n+f\\s+2\\d -X.nr f 0 1 -X.ds F \\n+F. -X.nr F 0 1 -X -X.ND -X.LP -X.TL -X\fIsdbm\fP \(em Substitute DBM -X.br -Xor -X.br -XBerkeley \fIndbm\fP for Every UN*X\** Made Simple -X.AU -XOzan (oz) Yigit -X.AI -XThe Guild of PD Software Toolmakers -XToronto - Canada -X.sp -Xoz@nexus.yorku.ca -X.LP -X.FS -XUN*X is not a trademark of any (dis)organization. -X.FE -X.sp 2 -X\fIImplementation is the sincerest form of flattery. \(em L. Peter Deutsch\fP -X.SH -XA The Clone of the \fIndbm\fP library -X.PP -XThe sources accompanying this notice \(em \fIsdbm\fP \(em constitute -Xthe first public release (Dec. 1990) of a complete clone of -Xthe Berkeley UN*X \fIndbm\fP library. The \fIsdbm\fP library is meant to -Xclone the proven functionality of \fIndbm\fP as closely as possible, -Xincluding a few improvements. It is practical, easy to understand, and -Xcompatible. -XThe \fIsdbm\fP library is not derived from any licensed, proprietary or -Xcopyrighted software. -X.PP -XThe \fIsdbm\fP implementation is based on a 1978 algorithm -X[Lar78] by P.-A. (Paul) Larson known as ``Dynamic Hashing''. -XIn the course of searching for a substitute for \fIndbm\fP, I -Xprototyped three different external-hashing algorithms [Lar78, Fag79, Lit80] -Xand ultimately chose Larson's algorithm as a basis of the \fIsdbm\fP -Ximplementation. The Bell Labs -X\fIdbm\fP (and therefore \fIndbm\fP) is based on an algorithm invented by -XKen Thompson, [Tho90, Tor87] and predates Larson's work. -X.PP -XThe \fIsdbm\fR programming interface is totally compatible -Xwith \fIndbm\fP and includes a slight improvement in database initialization. -XIt is also expected to be binary-compatible under most UN*X versions that -Xsupport the \fIndbm\fP library. -X.PP -XThe \fIsdbm\fP implementation shares the shortcomings of the \fIndbm\fP -Xlibrary, as a side effect of various simplifications to the original Larson -Xalgorithm. It does produce \fIholes\fP in the page file as it writes -Xpages past the end of file. (Larson's paper include a clever solution to -Xthis problem that is a result of using the hash value directly as a block -Xaddress.) On the other hand, extensive tests seem to indicate that \fIsdbm\fP -Xcreates fewer holes in general, and the resulting pagefiles are -Xsmaller. The \fIsdbm\fP implementation is also faster than \fIndbm\fP -Xin database creation. -XUnlike the \fIndbm\fP, the \fIsdbm\fP -X.CW store -Xoperation will not ``wander away'' trying to split its -Xdata pages to insert a datum that \fIcannot\fP (due to elaborate worst-case -Xsituations) be inserted. (It will fail after a pre-defined number of attempts.) -X.SH -XImportant Compatibility Warning -X.PP -XThe \fIsdbm\fP and \fIndbm\fP -Xlibraries \fIcannot\fP share databases: one cannot read the (dir/pag) -Xdatabase created by the other. This is due to the differences -Xbetween the \fIndbm\fP and \fIsdbm\fP algorithms\**, -X.FS -XTorek's discussion [Tor87] -Xindicates that \fIdbm/ndbm\fP implementations use the hash -Xvalue to traverse the radix trie differently than \fIsdbm\fP -Xand as a result, the page indexes are generated in \fIdifferent\fP order. -XFor more information, send e-mail to the author. -X.FE -Xand the hash functions -Xused. -XIt is easy to convert between the \fIdbm/ndbm\fP databases and \fIsdbm\fP -Xby ignoring the index completely: see -X.CW dbd , -X.CW dbu -Xetc. -X.R -X.LP -X.SH -XNotice of Intellectual Property -X.LP -X\fIThe entire\fP sdbm \fIlibrary package, as authored by me,\fP Ozan S. Yigit, -X\fIis hereby placed in the public domain.\fP As such, the author is not -Xresponsible for the consequences of use of this software, no matter how -Xawful, even if they arise from defects in it. There is no expressed or -Ximplied warranty for the \fIsdbm\fP library. -X.PP -XSince the \fIsdbm\fP -Xlibrary package is in the public domain, this \fIoriginal\fP -Xrelease or any additional public-domain releases of the modified original -Xcannot possibly (by definition) be withheld from you. Also by definition, -XYou (singular) have all the rights to this code (including the right to -Xsell without permission, the right to hoard\** -X.FS -XYou cannot really hoard something that is available to the public at -Xlarge, but try if it makes you feel any better. -X.FE -Xand the right to do other icky things as -Xyou see fit) but those rights are also granted to everyone else. -X.PP -XPlease note that all previous distributions of this software contained -Xa copyright (which is now dropped) to protect its -Xorigins and its current public domain status against any possible claims -Xand/or challenges. -X.SH -XAcknowledgments -X.PP -XMany people have been very helpful and supportive. A partial list would -Xnecessarily include Rayan Zacherissen (who contributed the man page, -Xand also hacked a MMAP version of \fIsdbm\fP), -XArnold Robbins, Chris Lewis, -XBill Davidsen, Henry Spencer, Geoff Collyer, Rich Salz (who got me started -Xin the first place), Johannes Ruschein -X(who did the minix port) and David Tilbrook. I thank you all. -X.SH -XDistribution Manifest and Notes -X.LP -XThis distribution of \fIsdbm\fP includes (at least) the following: -X.P1 -X CHANGES change log -X README this file. -X biblio a small bibliography on external hashing -X dba.c a crude (n/s)dbm page file analyzer -X dbd.c a crude (n/s)dbm page file dumper (for conversion) -X dbe.1 man page for dbe.c -X dbe.c Janick's database editor -X dbm.c a dbm library emulation wrapper for ndbm/sdbm -X dbm.h header file for the above -X dbu.c a crude db management utility -X hash.c hashing function -X makefile guess. -X pair.c page-level routines (posted earlier) -X pair.h header file for the above -X readme.ms troff source for the README file -X sdbm.3 man page -X sdbm.c the real thing -X sdbm.h header file for the above -X tune.h place for tuning & portability thingies -X util.c miscellaneous -X.P2 -X.PP -X.CW dbu -Xis a simple database manipulation program\** that tries to look -X.FS -XThe -X.CW dbd , -X.CW dba , -X.CW dbu -Xutilities are quick hacks and are not fit for production use. They were -Xdeveloped late one night, just to test out \fIsdbm\fP, and convert some -Xdatabases. -X.FE -Xlike Bell Labs' -X.CW cbt -Xutility. It is currently incomplete in functionality. -XI use -X.CW dbu -Xto test out the routines: it takes (from stdin) tab separated -Xkey/value pairs for commands like -X.CW build -Xor -X.CW insert -Xor takes keys for -Xcommands like -X.CW delete -Xor -X.CW look . -X.P1 -X dbu dbmfile -X.P2 -X.PP -X.CW dba -Xis a crude analyzer of \fIdbm/sdbm/ndbm\fP -Xpage files. It scans the entire -Xpage file, reporting page level statistics, and totals at the end. -X.PP -X.CW dbd -Xis a crude dump program for \fIdbm/ndbm/sdbm\fP -Xdatabases. It ignores the -Xbitmap, and dumps the data pages in sequence. It can be used to create -Xinput for the -X.CW dbu -Xutility. -XNote that -X.CW dbd -Xwill skip any NULLs in the key and data -Xfields, thus is unsuitable to convert some peculiar databases that -Xinsist in including the terminating null. -X.PP -XI have also included a copy of the -X.CW dbe -X(\fIndbm\fP DataBase Editor) by Janick Bergeron [janick@bnr.ca] for -Xyour pleasure. You may find it more useful than the little -X.CW dbu -Xutility. -X.PP -X.CW dbm.[ch] -Xis a \fIdbm\fP library emulation on top of \fIndbm\fP -X(and hence suitable for \fIsdbm\fP). Written by Robert Elz. -X.PP -XThe \fIsdbm\fP -Xlibrary has been around in beta test for quite a long time, and from whatever -Xlittle feedback I received (maybe no news is good news), I believe it has been -Xfunctioning without any significant problems. I would, of course, appreciate -Xall fixes and/or improvements. Portability enhancements would especially be -Xuseful. -X.SH -XImplementation Issues -X.PP -XHash functions: -XThe algorithm behind \fIsdbm\fP implementation needs a good bit-scrambling -Xhash function to be effective. I ran into a set of constants for a simple -Xhash function that seem to help \fIsdbm\fP perform better than \fIndbm\fP -Xfor various inputs: -X.P1 -X /* -X * polynomial conversion ignoring overflows -X * 65599 nice. 65587 even better. -X */ -X long -X dbm_hash(char *str, int len) { -X register unsigned long n = 0; -X -X while (len--) -X n = n * 65599 + *str++; -X return n; -X } -X.P2 -X.PP -XThere may be better hash functions for the purposes of dynamic hashing. -XTry your favorite, and check the pagefile. If it contains too many pages -Xwith too many holes, (in relation to this one for example) or if -X\fIsdbm\fP -Xsimply stops working (fails after -X.CW SPLTMAX -Xattempts to split) when you feed your -XNEWS -X.CW history -Xfile to it, you probably do not have a good hashing function. -XIf you do better (for different types of input), I would like to know -Xabout the function you use. -X.PP -XBlock sizes: It seems (from various tests on a few machines) that a page -Xfile block size -X.CW PBLKSIZ -Xof 1024 is by far the best for performance, but -Xthis also happens to limit the size of a key/value pair. Depending on your -Xneeds, you may wish to increase the page size, and also adjust -X.CW PAIRMAX -X(the maximum size of a key/value pair allowed: should always be at least -Xthree words smaller than -X.CW PBLKSIZ .) -Xaccordingly. The system-wide version of the library -Xshould probably be -Xconfigured with 1024 (distribution default), as this appears to be sufficient -Xfor most common uses of \fIsdbm\fP. -X.SH -XPortability -X.PP -XThis package has been tested in many different UN*Xes even including minix, -Xand appears to be reasonably portable. This does not mean it will port -Xeasily to non-UN*X systems. -X.SH -XNotes and Miscellaneous -X.PP -XThe \fIsdbm\fP is not a very complicated package, at least not after you -Xfamiliarize yourself with the literature on external hashing. There are -Xother interesting algorithms in existence that ensure (approximately) -Xsingle-read access to a data value associated with any key. These are -Xdirectory-less schemes such as \fIlinear hashing\fP [Lit80] (+ Larson -Xvariations), \fIspiral storage\fP [Mar79] or directory schemes such as -X\fIextensible hashing\fP [Fag79] by Fagin et al. I do hope these sources -Xprovide a reasonable playground for experimentation with other algorithms. -XSee the June 1988 issue of ACM Computing Surveys [Enb88] for an -Xexcellent overview of the field. -X.PG -X.SH -XReferences -X.LP -X.IP [Lar78] 4m -XP.-A. Larson, -X``Dynamic Hashing'', \fIBIT\fP, vol. 18, pp. 184-201, 1978. -X.IP [Tho90] 4m -XKen Thompson, \fIprivate communication\fP, Nov. 1990 -X.IP [Lit80] 4m -XW. Litwin, -X`` Linear Hashing: A new tool for file and table addressing'', -X\fIProceedings of the 6th Conference on Very Large Dabatases (Montreal)\fP, -Xpp. 212-223, Very Large Database Foundation, Saratoga, Calif., 1980. -X.IP [Fag79] 4m -XR. Fagin, J. Nievergelt, N. Pippinger, and H. R. Strong, -X``Extendible Hashing - A Fast Access Method for Dynamic Files'', -X\fIACM Trans. Database Syst.\fP, vol. 4, no.3, pp. 315-344, Sept. 1979. -X.IP [Wal84] 4m -XRich Wales, -X``Discussion of "dbm" data base system'', \fIUSENET newsgroup unix.wizards\fP, -XJan. 1984. -X.IP [Tor87] 4m -XChris Torek, -X``Re: dbm.a and ndbm.a archives'', \fIUSENET newsgroup comp.unix\fP, -X1987. -X.IP [Mar79] 4m -XG. N. Martin, -X``Spiral Storage: Incrementally Augmentable Hash Addressed Storage'', -X\fITechnical Report #27\fP, University of Varwick, Coventry, U.K., 1979. -X.IP [Enb88] 4m -XR. J. Enbody and H. C. Du, -X``Dynamic Hashing Schemes'',\fIACM Computing Surveys\fP, -Xvol. 20, no. 2, pp. 85-113, June 1988. -END_OF_FILE -if test 11691 -ne `wc -c <'readme.ms'`; then - echo shar: \"'readme.ms'\" unpacked with wrong size! -fi -# end of 'readme.ms' -fi -if test -f 'readme.ps' -a "${1}" != "-c" ; then - echo shar: Will not clobber existing file \"'readme.ps'\" -else -echo shar: Extracting \"'readme.ps'\" \(33302 characters\) -sed "s/^X//" >'readme.ps' <<'END_OF_FILE' -X%!PS-Adobe-1.0 -X%%Creator: yetti:oz (Ozan Yigit) -X%%Title: stdin (ditroff) -X%%CreationDate: Thu Dec 13 15:56:08 1990 -X%%EndComments -X% lib/psdit.pro -- prolog for psdit (ditroff) files -X% Copyright (c) 1984, 1985 Adobe Systems Incorporated. All Rights Reserved. -X% last edit: shore Sat Nov 23 20:28:03 1985 -X% RCSID: $Header: psdit.pro,v 2.1 85/11/24 12:19:43 shore Rel $ -X -X/$DITroff 140 dict def $DITroff begin -X/fontnum 1 def /fontsize 10 def /fontheight 10 def /fontslant 0 def -X/xi {0 72 11 mul translate 72 resolution div dup neg scale 0 0 moveto -X /fontnum 1 def /fontsize 10 def /fontheight 10 def /fontslant 0 def F -X /pagesave save def}def -X/PB{save /psv exch def currentpoint translate -X resolution 72 div dup neg scale 0 0 moveto}def -X/PE{psv restore}def -X/arctoobig 90 def /arctoosmall .05 def -X/m1 matrix def /m2 matrix def /m3 matrix def /oldmat matrix def -X/tan{dup sin exch cos div}def -X/point{resolution 72 div mul}def -X/dround {transform round exch round exch itransform}def -X/xT{/devname exch def}def -X/xr{/mh exch def /my exch def /resolution exch def}def -X/xp{}def -X/xs{docsave restore end}def -X/xt{}def -X/xf{/fontname exch def /slotno exch def fontnames slotno get fontname eq not -X {fonts slotno fontname findfont put fontnames slotno fontname put}if}def -X/xH{/fontheight exch def F}def -X/xS{/fontslant exch def F}def -X/s{/fontsize exch def /fontheight fontsize def F}def -X/f{/fontnum exch def F}def -X/F{fontheight 0 le {/fontheight fontsize def}if -X fonts fontnum get fontsize point 0 0 fontheight point neg 0 0 m1 astore -X fontslant 0 ne{1 0 fontslant tan 1 0 0 m2 astore m3 concatmatrix}if -X makefont setfont .04 fontsize point mul 0 dround pop setlinewidth}def -X/X{exch currentpoint exch pop moveto show}def -X/N{3 1 roll moveto show}def -X/Y{exch currentpoint pop exch moveto show}def -X/S{show}def -X/ditpush{}def/ditpop{}def -X/AX{3 -1 roll currentpoint exch pop moveto 0 exch ashow}def -X/AN{4 2 roll moveto 0 exch ashow}def -X/AY{3 -1 roll currentpoint pop exch moveto 0 exch ashow}def -X/AS{0 exch ashow}def -X/MX{currentpoint exch pop moveto}def -X/MY{currentpoint pop exch moveto}def -X/MXY{moveto}def -X/cb{pop}def % action on unknown char -- nothing for now -X/n{}def/w{}def -X/p{pop showpage pagesave restore /pagesave save def}def -X/abspoint{currentpoint exch pop add exch currentpoint pop add exch}def -X/distance{dup mul exch dup mul add sqrt}def -X/dstroke{currentpoint stroke moveto}def -X/Dl{2 copy gsave rlineto stroke grestore rmoveto}def -X/arcellipse{/diamv exch def /diamh exch def oldmat currentmatrix pop -X currentpoint translate 1 diamv diamh div scale /rad diamh 2 div def -X currentpoint exch rad add exch rad -180 180 arc oldmat setmatrix}def -X/Dc{dup arcellipse dstroke}def -X/De{arcellipse dstroke}def -X/Da{/endv exch def /endh exch def /centerv exch def /centerh exch def -X /cradius centerv centerv mul centerh centerh mul add sqrt def -X /eradius endv endv mul endh endh mul add sqrt def -X /endang endv endh atan def -X /startang centerv neg centerh neg atan def -X /sweep startang endang sub dup 0 lt{360 add}if def -X sweep arctoobig gt -X {/midang startang sweep 2 div sub def /midrad cradius eradius add 2 div def -X /midh midang cos midrad mul def /midv midang sin midrad mul def -X midh neg midv neg endh endv centerh centerv midh midv Da -X currentpoint moveto Da} -X {sweep arctoosmall ge -X {/controldelt 1 sweep 2 div cos sub 3 sweep 2 div sin mul div 4 mul def -X centerv neg controldelt mul centerh controldelt mul -X endv neg controldelt mul centerh add endh add -X endh controldelt mul centerv add endv add -X centerh endh add centerv endv add rcurveto dstroke} -X {centerh endh add centerv endv add rlineto dstroke}ifelse}ifelse}def -X -X/Barray 200 array def % 200 values in a wiggle -X/D~{mark}def -X/D~~{counttomark Barray exch 0 exch getinterval astore /Bcontrol exch def pop -X /Blen Bcontrol length def Blen 4 ge Blen 2 mod 0 eq and -X {Bcontrol 0 get Bcontrol 1 get abspoint /Ycont exch def /Xcont exch def -X Bcontrol 0 2 copy get 2 mul put Bcontrol 1 2 copy get 2 mul put -X Bcontrol Blen 2 sub 2 copy get 2 mul put -X Bcontrol Blen 1 sub 2 copy get 2 mul put -X /Ybi /Xbi currentpoint 3 1 roll def def 0 2 Blen 4 sub -X {/i exch def -X Bcontrol i get 3 div Bcontrol i 1 add get 3 div -X Bcontrol i get 3 mul Bcontrol i 2 add get add 6 div -X Bcontrol i 1 add get 3 mul Bcontrol i 3 add get add 6 div -X /Xbi Xcont Bcontrol i 2 add get 2 div add def -X /Ybi Ycont Bcontrol i 3 add get 2 div add def -X /Xcont Xcont Bcontrol i 2 add get add def -X /Ycont Ycont Bcontrol i 3 add get add def -X Xbi currentpoint pop sub Ybi currentpoint exch pop sub rcurveto -X }for dstroke}if}def -Xend -X/ditstart{$DITroff begin -X /nfonts 60 def % NFONTS makedev/ditroff dependent! -X /fonts[nfonts{0}repeat]def -X /fontnames[nfonts{()}repeat]def -X/docsave save def -X}def -X -X% character outcalls -X/oc {/pswid exch def /cc exch def /name exch def -X /ditwid pswid fontsize mul resolution mul 72000 div def -X /ditsiz fontsize resolution mul 72 div def -X ocprocs name known{ocprocs name get exec}{name cb} -X ifelse}def -X/fractm [.65 0 0 .6 0 0] def -X/fraction -X {/fden exch def /fnum exch def gsave /cf currentfont def -X cf fractm makefont setfont 0 .3 dm 2 copy neg rmoveto -X fnum show rmoveto currentfont cf setfont(\244)show setfont fden show -X grestore ditwid 0 rmoveto} def -X/oce {grestore ditwid 0 rmoveto}def -X/dm {ditsiz mul}def -X/ocprocs 50 dict def ocprocs begin -X(14){(1)(4)fraction}def -X(12){(1)(2)fraction}def -X(34){(3)(4)fraction}def -X(13){(1)(3)fraction}def -X(23){(2)(3)fraction}def -X(18){(1)(8)fraction}def -X(38){(3)(8)fraction}def -X(58){(5)(8)fraction}def -X(78){(7)(8)fraction}def -X(sr){gsave 0 .06 dm rmoveto(\326)show oce}def -X(is){gsave 0 .15 dm rmoveto(\362)show oce}def -X(->){gsave 0 .02 dm rmoveto(\256)show oce}def -X(<-){gsave 0 .02 dm rmoveto(\254)show oce}def -X(==){gsave 0 .05 dm rmoveto(\272)show oce}def -Xend -X -X% an attempt at a PostScript FONT to implement ditroff special chars -X% this will enable us to -X% cache the little buggers -X% generate faster, more compact PS out of psdit -X% confuse everyone (including myself)! -X50 dict dup begin -X/FontType 3 def -X/FontName /DIThacks def -X/FontMatrix [.001 0 0 .001 0 0] def -X/FontBBox [-260 -260 900 900] def% a lie but ... -X/Encoding 256 array def -X0 1 255{Encoding exch /.notdef put}for -XEncoding -X dup 8#040/space put %space -X dup 8#110/rc put %right ceil -X dup 8#111/lt put %left top curl -X dup 8#112/bv put %bold vert -X dup 8#113/lk put %left mid curl -X dup 8#114/lb put %left bot curl -X dup 8#115/rt put %right top curl -X dup 8#116/rk put %right mid curl -X dup 8#117/rb put %right bot curl -X dup 8#120/rf put %right floor -X dup 8#121/lf put %left floor -X dup 8#122/lc put %left ceil -X dup 8#140/sq put %square -X dup 8#141/bx put %box -X dup 8#142/ci put %circle -X dup 8#143/br put %box rule -X dup 8#144/rn put %root extender -X dup 8#145/vr put %vertical rule -X dup 8#146/ob put %outline bullet -X dup 8#147/bu put %bullet -X dup 8#150/ru put %rule -X dup 8#151/ul put %underline -X pop -X/DITfd 100 dict def -X/BuildChar{0 begin -X /cc exch def /fd exch def -X /charname fd /Encoding get cc get def -X /charwid fd /Metrics get charname get def -X /charproc fd /CharProcs get charname get def -X charwid 0 fd /FontBBox get aload pop setcachedevice -X 2 setlinejoin 40 setlinewidth -X newpath 0 0 moveto gsave charproc grestore -X end}def -X/BuildChar load 0 DITfd put -X%/UniqueID 5 def -X/CharProcs 50 dict def -XCharProcs begin -X/space{}def -X/.notdef{}def -X/ru{500 0 rls}def -X/rn{0 840 moveto 500 0 rls}def -X/vr{0 800 moveto 0 -770 rls}def -X/bv{0 800 moveto 0 -1000 rls}def -X/br{0 750 moveto 0 -1000 rls}def -X/ul{0 -140 moveto 500 0 rls}def -X/ob{200 250 rmoveto currentpoint newpath 200 0 360 arc closepath stroke}def -X/bu{200 250 rmoveto currentpoint newpath 200 0 360 arc closepath fill}def -X/sq{80 0 rmoveto currentpoint dround newpath moveto -X 640 0 rlineto 0 640 rlineto -640 0 rlineto closepath stroke}def -X/bx{80 0 rmoveto currentpoint dround newpath moveto -X 640 0 rlineto 0 640 rlineto -640 0 rlineto closepath fill}def -X/ci{500 360 rmoveto currentpoint newpath 333 0 360 arc -X 50 setlinewidth stroke}def -X -X/lt{0 -200 moveto 0 550 rlineto currx 800 2cx s4 add exch s4 a4p stroke}def -X/lb{0 800 moveto 0 -550 rlineto currx -200 2cx s4 add exch s4 a4p stroke}def -X/rt{0 -200 moveto 0 550 rlineto currx 800 2cx s4 sub exch s4 a4p stroke}def -X/rb{0 800 moveto 0 -500 rlineto currx -200 2cx s4 sub exch s4 a4p stroke}def -X/lk{0 800 moveto 0 300 -300 300 s4 arcto pop pop 1000 sub -X 0 300 4 2 roll s4 a4p 0 -200 lineto stroke}def -X/rk{0 800 moveto 0 300 s2 300 s4 arcto pop pop 1000 sub -X 0 300 4 2 roll s4 a4p 0 -200 lineto stroke}def -X/lf{0 800 moveto 0 -1000 rlineto s4 0 rls}def -X/rf{0 800 moveto 0 -1000 rlineto s4 neg 0 rls}def -X/lc{0 -200 moveto 0 1000 rlineto s4 0 rls}def -X/rc{0 -200 moveto 0 1000 rlineto s4 neg 0 rls}def -Xend -X -X/Metrics 50 dict def Metrics begin -X/.notdef 0 def -X/space 500 def -X/ru 500 def -X/br 0 def -X/lt 416 def -X/lb 416 def -X/rt 416 def -X/rb 416 def -X/lk 416 def -X/rk 416 def -X/rc 416 def -X/lc 416 def -X/rf 416 def -X/lf 416 def -X/bv 416 def -X/ob 350 def -X/bu 350 def -X/ci 750 def -X/bx 750 def -X/sq 750 def -X/rn 500 def -X/ul 500 def -X/vr 0 def -Xend -X -XDITfd begin -X/s2 500 def /s4 250 def /s3 333 def -X/a4p{arcto pop pop pop pop}def -X/2cx{2 copy exch}def -X/rls{rlineto stroke}def -X/currx{currentpoint pop}def -X/dround{transform round exch round exch itransform} def -Xend -Xend -X/DIThacks exch definefont pop -Xditstart -X(psc)xT -X576 1 1 xr -X1(Times-Roman)xf 1 f -X2(Times-Italic)xf 2 f -X3(Times-Bold)xf 3 f -X4(Times-BoldItalic)xf 4 f -X5(Helvetica)xf 5 f -X6(Helvetica-Bold)xf 6 f -X7(Courier)xf 7 f -X8(Courier-Bold)xf 8 f -X9(Symbol)xf 9 f -X10(DIThacks)xf 10 f -X10 s -X1 f -Xxi -X%%EndProlog -X -X%%Page: 1 1 -X10 s 0 xH 0 xS 1 f -X8 s -X2 f -X12 s -X1778 672(sdbm)N -X3 f -X2004(\320)X -X2124(Substitute)X -X2563(DBM)X -X2237 768(or)N -X1331 864(Berkeley)N -X2 f -X1719(ndbm)X -X3 f -X1956(for)X -X2103(Every)X -X2373(UN*X)X -X1 f -X10 s -X2628 832(1)N -X3 f -X12 s -X2692 864(Made)N -X2951(Simple)X -X2 f -X10 s -X2041 1056(Ozan)N -X2230(\(oz\))X -X2375(Yigit)X -X1 f -X1658 1200(The)N -X1803(Guild)X -X2005(of)X -X2092(PD)X -X2214(Software)X -X2524(Toolmakers)X -X2000 1296(Toronto)N -X2278(-)X -X2325(Canada)X -X1965 1488(oz@nexus.yorku.ca)N -X2 f -X555 1804(Implementation)N -X1078(is)X -X1151(the)X -X1269(sincerest)X -X1574(form)X -X1745(of)X -X1827(\257attery.)X -X2094(\320)X -X2185(L.)X -X2269(Peter)X -X2463(Deutsch)X -X3 f -X555 1996(A)N -X633(The)X -X786(Clone)X -X1006(of)X -X1093(the)X -X2 f -X1220(ndbm)X -X3 f -X1418(library)X -X1 f -X755 2120(The)N -X903(sources)X -X1167(accompanying)X -X1658(this)X -X1796(notice)X -X2015(\320)X -X2 f -X2118(sdbm)X -X1 f -X2309(\320)X -X2411(constitute)X -X2744(the)X -X2864(\256rst)X -X3010(public)X -X3232(release)X -X3478(\(Dec.)X -X3677(1990\))X -X3886(of)X -X3975(a)X -X555 2216(complete)N -X874(clone)X -X1073(of)X -X1165(the)X -X1288(Berkeley)X -X1603(UN*X)X -X2 f -X1842(ndbm)X -X1 f -X2045(library.)X -X2304(The)X -X2 f -X2454(sdbm)X -X1 f -X2648(library)X -X2887(is)X -X2965(meant)X -X3186(to)X -X3273(clone)X -X3472(the)X -X3594(proven)X -X3841(func-)X -X555 2312(tionality)N -X846(of)X -X2 f -X938(ndbm)X -X1 f -X1141(as)X -X1233(closely)X -X1485(as)X -X1576(possible,)X -X1882(including)X -X2208(a)X -X2268(few)X -X2413(improvements.)X -X2915(It)X -X2988(is)X -X3065(practical,)X -X3386(easy)X -X3553(to)X -X3639(understand,)X -X555 2408(and)N -X691(compatible.)X -X1107(The)X -X2 f -X1252(sdbm)X -X1 f -X1441(library)X -X1675(is)X -X1748(not)X -X1870(derived)X -X2131(from)X -X2307(any)X -X2443(licensed,)X -X2746(proprietary)X -X3123(or)X -X3210(copyrighted)X -X3613(software.)X -X755 2532(The)N -X2 f -X910(sdbm)X -X1 f -X1109(implementation)X -X1641(is)X -X1723(based)X -X1935(on)X -X2044(a)X -X2109(1978)X -X2298(algorithm)X -X2638([Lar78])X -X2913(by)X -X3022(P.-A.)X -X3220(\(Paul\))X -X3445(Larson)X -X3697(known)X -X3944(as)X -X555 2628(``Dynamic)N -X934(Hashing''.)X -X1326(In)X -X1424(the)X -X1553(course)X -X1794(of)X -X1892(searching)X -X2231(for)X -X2355(a)X -X2421(substitute)X -X2757(for)X -X2 f -X2881(ndbm)X -X1 f -X3059(,)X -X3109(I)X -X3166(prototyped)X -X3543(three)X -X3734(different)X -X555 2724(external-hashing)N -X1119(algorithms)X -X1490([Lar78,)X -X1758(Fag79,)X -X2007(Lit80])X -X2236(and)X -X2381(ultimately)X -X2734(chose)X -X2946(Larson's)X -X3256(algorithm)X -X3596(as)X -X3692(a)X -X3756(basis)X -X3944(of)X -X555 2820(the)N -X2 f -X680(sdbm)X -X1 f -X875(implementation.)X -X1423(The)X -X1574(Bell)X -X1733(Labs)X -X2 f -X1915(dbm)X -X1 f -X2079(\(and)X -X2248(therefore)X -X2 f -X2565(ndbm)X -X1 f -X2743(\))X -X2796(is)X -X2875(based)X -X3084(on)X -X3190(an)X -X3292(algorithm)X -X3629(invented)X -X3931(by)X -X555 2916(Ken)N -X709(Thompson,)X -X1091([Tho90,)X -X1367(Tor87])X -X1610(and)X -X1746(predates)X -X2034(Larson's)X -X2335(work.)X -X755 3040(The)N -X2 f -X903(sdbm)X -X1 f -X1095(programming)X -X1553(interface)X -X1857(is)X -X1932(totally)X -X2158(compatible)X -X2536(with)X -X2 f -X2700(ndbm)X -X1 f -X2900(and)X -X3038(includes)X -X3327(a)X -X3385(slight)X -X3584(improvement)X -X555 3136(in)N -X641(database)X -X942(initialization.)X -X1410(It)X -X1483(is)X -X1560(also)X -X1713(expected)X -X2023(to)X -X2109(be)X -X2208(binary-compatible)X -X2819(under)X -X3025(most)X -X3203(UN*X)X -X3440(versions)X -X3730(that)X -X3873(sup-)X -X555 3232(port)N -X704(the)X -X2 f -X822(ndbm)X -X1 f -X1020(library.)X -X755 3356(The)N -X2 f -X909(sdbm)X -X1 f -X1107(implementation)X -X1638(shares)X -X1868(the)X -X1995(shortcomings)X -X2455(of)X -X2551(the)X -X2 f -X2678(ndbm)X -X1 f -X2885(library,)X -X3148(as)X -X3244(a)X -X3309(side)X -X3467(effect)X -X3680(of)X -X3775(various)X -X555 3452(simpli\256cations)N -X1046(to)X -X1129(the)X -X1248(original)X -X1518(Larson)X -X1762(algorithm.)X -X2114(It)X -X2183(does)X -X2350(produce)X -X2 f -X2629(holes)X -X1 f -X2818(in)X -X2900(the)X -X3018(page)X -X3190(\256le)X -X3312(as)X -X3399(it)X -X3463(writes)X -X3679(pages)X -X3882(past)X -X555 3548(the)N -X680(end)X -X823(of)X -X917(\256le.)X -X1066(\(Larson's)X -X1400(paper)X -X1605(include)X -X1867(a)X -X1929(clever)X -X2152(solution)X -X2435(to)X -X2523(this)X -X2664(problem)X -X2957(that)X -X3103(is)X -X3182(a)X -X3244(result)X -X3448(of)X -X3541(using)X -X3740(the)X -X3864(hash)X -X555 3644(value)N -X758(directly)X -X1032(as)X -X1128(a)X -X1193(block)X -X1400(address.\))X -X1717(On)X -X1844(the)X -X1971(other)X -X2165(hand,)X -X2370(extensive)X -X2702(tests)X -X2873(seem)X -X3067(to)X -X3158(indicate)X -X3441(that)X -X2 f -X3590(sdbm)X -X1 f -X3787(creates)X -X555 3740(fewer)N -X762(holes)X -X954(in)X -X1039(general,)X -X1318(and)X -X1456(the)X -X1576(resulting)X -X1878(page\256les)X -X2185(are)X -X2306(smaller.)X -X2584(The)X -X2 f -X2731(sdbm)X -X1 f -X2922(implementation)X -X3446(is)X -X3521(also)X -X3672(faster)X -X3873(than)X -X2 f -X555 3836(ndbm)N -X1 f -X757(in)X -X843(database)X -X1144(creation.)X -X1467(Unlike)X -X1709(the)X -X2 f -X1831(ndbm)X -X1 f -X2009(,)X -X2053(the)X -X2 f -X2175(sdbm)X -X7 f -X2396(store)X -X1 f -X2660(operation)X -X2987(will)X -X3134(not)X -X3259(``wander)X -X3573(away'')X -X3820(trying)X -X555 3932(to)N -X642(split)X -X804(its)X -X904(data)X -X1063(pages)X -X1271(to)X -X1358(insert)X -X1561(a)X -X1622(datum)X -X1847(that)X -X2 f -X1992(cannot)X -X1 f -X2235(\(due)X -X2403(to)X -X2490(elaborate)X -X2810(worst-case)X -X3179(situations\))X -X3537(be)X -X3637(inserted.)X -X3935(\(It)X -X555 4028(will)N -X699(fail)X -X826(after)X -X994(a)X -X1050(pre-de\256ned)X -X1436(number)X -X1701(of)X -X1788(attempts.\))X -X3 f -X555 4220(Important)N -X931(Compatibility)X -X1426(Warning)X -X1 f -X755 4344(The)N -X2 f -X904(sdbm)X -X1 f -X1097(and)X -X2 f -X1237(ndbm)X -X1 f -X1439(libraries)X -X2 f -X1726(cannot)X -X1 f -X1968(share)X -X2162(databases:)X -X2515(one)X -X2654(cannot)X -X2891(read)X -X3053(the)X -X3174(\(dir/pag\))X -X3478(database)X -X3778(created)X -X555 4440(by)N -X657(the)X -X777(other.)X -X984(This)X -X1148(is)X -X1222(due)X -X1359(to)X -X1442(the)X -X1561(differences)X -X1940(between)X -X2229(the)X -X2 f -X2348(ndbm)X -X1 f -X2547(and)X -X2 f -X2684(sdbm)X -X1 f -X2874(algorithms)X -X8 s -X3216 4415(2)N -X10 s -X4440(,)Y -X3289(and)X -X3426(the)X -X3545(hash)X -X3713(functions)X -X555 4536(used.)N -X769(It)X -X845(is)X -X925(easy)X -X1094(to)X -X1182(convert)X -X1449(between)X -X1743(the)X -X2 f -X1867(dbm/ndbm)X -X1 f -X2231(databases)X -X2565(and)X -X2 f -X2707(sdbm)X -X1 f -X2902(by)X -X3008(ignoring)X -X3305(the)X -X3429(index)X -X3633(completely:)X -X555 4632(see)N -X7 f -X706(dbd)X -X1 f -X(,)S -X7 f -X918(dbu)X -X1 f -X1082(etc.)X -X3 f -X555 4852(Notice)N -X794(of)X -X881(Intellectual)X -X1288(Property)X -X2 f -X555 4976(The)N -X696(entire)X -X1 f -X904(sdbm)X -X2 f -X1118(library)X -X1361(package,)X -X1670(as)X -X1762(authored)X -X2072(by)X -X2169(me,)X -X1 f -X2304(Ozan)X -X2495(S.)X -X2580(Yigit,)X -X2 f -X2785(is)X -X2858(hereby)X -X3097(placed)X -X3331(in)X -X3413(the)X -X3531(public)X -X3751(domain.)X -X1 f -X555 5072(As)N -X670(such,)X -X863(the)X -X987(author)X -X1218(is)X -X1297(not)X -X1425(responsible)X -X1816(for)X -X1936(the)X -X2060(consequences)X -X2528(of)X -X2621(use)X -X2754(of)X -X2847(this)X -X2988(software,)X -X3310(no)X -X3415(matter)X -X3645(how)X -X3808(awful,)X -X555 5168(even)N -X727(if)X -X796(they)X -X954(arise)X -X1126(from)X -X1302(defects)X -X1550(in)X -X1632(it.)X -X1716(There)X -X1924(is)X -X1997(no)X -X2097(expressed)X -X2434(or)X -X2521(implied)X -X2785(warranty)X -X3091(for)X -X3205(the)X -X2 f -X3323(sdbm)X -X1 f -X3512(library.)X -X8 s -X10 f -X555 5316(hhhhhhhhhhhhhhhhhh)N -X6 s -X1 f -X635 5391(1)N -X8 s -X691 5410(UN*X)N -X877(is)X -X936(not)X -X1034(a)X -X1078(trademark)X -X1352(of)X -X1421(any)X -X1529(\(dis\)organization.)X -X6 s -X635 5485(2)N -X8 s -X691 5504(Torek's)N -X908(discussion)X -X1194([Tor87])X -X1411(indicates)X -X1657(that)X -X2 f -X1772(dbm/ndbm)X -X1 f -X2061(implementations)X -X2506(use)X -X2609(the)X -X2705(hash)X -X2840(value)X -X2996(to)X -X3064(traverse)X -X3283(the)X -X3379(radix)X -X3528(trie)X -X3631(dif-)X -X555 5584(ferently)N -X772(than)X -X2 f -X901(sdbm)X -X1 f -X1055(and)X -X1166(as)X -X1238(a)X -X1285(result,)X -X1462(the)X -X1559(page)X -X1698(indexes)X -X1912(are)X -X2008(generated)X -X2274(in)X -X2 f -X2343(different)X -X1 f -X2579(order.)X -X2764(For)X -X2872(more)X -X3021(information,)X -X3357(send)X -X3492(e-mail)X -X3673(to)X -X555 5664(the)N -X649(author.)X -X -X2 p -X%%Page: 2 2 -X8 s 0 xH 0 xS 1 f -X10 s -X2216 384(-)N -X2263(2)X -X2323(-)X -X755 672(Since)N -X971(the)X -X2 f -X1107(sdbm)X -X1 f -X1314(library)X -X1566(package)X -X1868(is)X -X1959(in)X -X2058(the)X -X2193(public)X -X2430(domain,)X -X2727(this)X -X2 f -X2879(original)X -X1 f -X3173(release)X -X3434(or)X -X3538(any)X -X3691(additional)X -X555 768(public-domain)N -X1045(releases)X -X1323(of)X -X1413(the)X -X1534(modi\256ed)X -X1841(original)X -X2112(cannot)X -X2348(possibly)X -X2636(\(by)X -X2765(de\256nition\))X -X3120(be)X -X3218(withheld)X -X3520(from)X -X3698(you.)X -X3860(Also)X -X555 864(by)N -X659(de\256nition,)X -X1009(You)X -X1170(\(singular\))X -X1505(have)X -X1680(all)X -X1783(the)X -X1904(rights)X -X2109(to)X -X2194(this)X -X2332(code)X -X2507(\(including)X -X2859(the)X -X2980(right)X -X3154(to)X -X3239(sell)X -X3373(without)X -X3640(permission,)X -X555 960(the)N -X679(right)X -X856(to)X -X944(hoard)X -X8 s -X1127 935(3)N -X10 s -X1185 960(and)N -X1327(the)X -X1451(right)X -X1628(to)X -X1716(do)X -X1821(other)X -X2011(icky)X -X2174(things)X -X2394(as)X -X2486(you)X -X2631(see)X -X2759(\256t\))X -X2877(but)X -X3004(those)X -X3198(rights)X -X3405(are)X -X3529(also)X -X3683(granted)X -X3949(to)X -X555 1056(everyone)N -X870(else.)X -X755 1180(Please)N -X997(note)X -X1172(that)X -X1329(all)X -X1446(previous)X -X1759(distributions)X -X2195(of)X -X2298(this)X -X2449(software)X -X2762(contained)X -X3110(a)X -X3182(copyright)X -X3525(\(which)X -X3784(is)X -X3873(now)X -X555 1276(dropped\))N -X868(to)X -X953(protect)X -X1199(its)X -X1297(origins)X -X1542(and)X -X1681(its)X -X1779(current)X -X2030(public)X -X2253(domain)X -X2516(status)X -X2721(against)X -X2970(any)X -X3108(possible)X -X3392(claims)X -X3623(and/or)X -X3850(chal-)X -X555 1372(lenges.)N -X3 f -X555 1564(Acknowledgments)N -X1 f -X755 1688(Many)N -X966(people)X -X1204(have)X -X1380(been)X -X1556(very)X -X1723(helpful)X -X1974(and)X -X2114(supportive.)X -X2515(A)X -X2596(partial)X -X2824(list)X -X2944(would)X -X3167(necessarily)X -X3547(include)X -X3806(Rayan)X -X555 1784(Zacherissen)N -X963(\(who)X -X1152(contributed)X -X1541(the)X -X1663(man)X -X1824(page,)X -X2019(and)X -X2158(also)X -X2310(hacked)X -X2561(a)X -X2620(MMAP)X -X2887(version)X -X3146(of)X -X2 f -X3236(sdbm)X -X1 f -X3405(\),)X -X3475(Arnold)X -X3725(Robbins,)X -X555 1880(Chris)N -X763(Lewis,)X -X1013(Bill)X -X1166(Davidsen,)X -X1523(Henry)X -X1758(Spencer,)X -X2071(Geoff)X -X2293(Collyer,)X -X2587(Rich)X -X2772(Salz)X -X2944(\(who)X -X3143(got)X -X3279(me)X -X3411(started)X -X3659(in)X -X3755(the)X -X3887(\256rst)X -X555 1976(place\),)N -X792(Johannes)X -X1106(Ruschein)X -X1424(\(who)X -X1609(did)X -X1731(the)X -X1849(minix)X -X2055(port\))X -X2231(and)X -X2367(David)X -X2583(Tilbrook.)X -X2903(I)X -X2950(thank)X -X3148(you)X -X3288(all.)X -X3 f -X555 2168(Distribution)N -X992(Manifest)X -X1315(and)X -X1463(Notes)X -X1 f -X555 2292(This)N -X717(distribution)X -X1105(of)X -X2 f -X1192(sdbm)X -X1 f -X1381(includes)X -X1668(\(at)X -X1773(least\))X -X1967(the)X -X2085(following:)X -X7 f -X747 2436(CHANGES)N -X1323(change)X -X1659(log)X -X747 2532(README)N -X1323(this)X -X1563(file.)X -X747 2628(biblio)N -X1323(a)X -X1419(small)X -X1707(bibliography)X -X2331(on)X -X2475(external)X -X2907(hashing)X -X747 2724(dba.c)N -X1323(a)X -X1419(crude)X -X1707(\(n/s\)dbm)X -X2139(page)X -X2379(file)X -X2619(analyzer)X -X747 2820(dbd.c)N -X1323(a)X -X1419(crude)X -X1707(\(n/s\)dbm)X -X2139(page)X -X2379(file)X -X2619(dumper)X -X2955(\(for)X -X3195(conversion\))X -X747 2916(dbe.1)N -X1323(man)X -X1515(page)X -X1755(for)X -X1947(dbe.c)X -X747 3012(dbe.c)N -X1323(Janick's)X -X1755(database)X -X2187(editor)X -X747 3108(dbm.c)N -X1323(a)X -X1419(dbm)X -X1611(library)X -X1995(emulation)X -X2475(wrapper)X -X2859(for)X -X3051(ndbm/sdbm)X -X747 3204(dbm.h)N -X1323(header)X -X1659(file)X -X1899(for)X -X2091(the)X -X2283(above)X -X747 3300(dbu.c)N -X1323(a)X -X1419(crude)X -X1707(db)X -X1851(management)X -X2379(utility)X -X747 3396(hash.c)N -X1323(hashing)X -X1707(function)X -X747 3492(makefile)N -X1323(guess.)X -X747 3588(pair.c)N -X1323(page-level)X -X1851(routines)X -X2283(\(posted)X -X2667(earlier\))X -X747 3684(pair.h)N -X1323(header)X -X1659(file)X -X1899(for)X -X2091(the)X -X2283(above)X -X747 3780(readme.ms)N -X1323(troff)X -X1611(source)X -X1947(for)X -X2139(the)X -X2331(README)X -X2667(file)X -X747 3876(sdbm.3)N -X1323(man)X -X1515(page)X -X747 3972(sdbm.c)N -X1323(the)X -X1515(real)X -X1755(thing)X -X747 4068(sdbm.h)N -X1323(header)X -X1659(file)X -X1899(for)X -X2091(the)X -X2283(above)X -X747 4164(tune.h)N -X1323(place)X -X1611(for)X -X1803(tuning)X -X2139(&)X -X2235(portability)X -X2811(thingies)X -X747 4260(util.c)N -X1323(miscellaneous)X -X755 4432(dbu)N -X1 f -X924(is)X -X1002(a)X -X1063(simple)X -X1301(database)X -X1603(manipulation)X -X2050(program)X -X8 s -X2322 4407(4)N -X10 s -X2379 4432(that)N -X2524(tries)X -X2687(to)X -X2774(look)X -X2941(like)X -X3086(Bell)X -X3244(Labs')X -X7 f -X3480(cbt)X -X1 f -X3649(utility.)X -X3884(It)X -X3958(is)X -X555 4528(currently)N -X867(incomplete)X -X1245(in)X -X1329(functionality.)X -X1800(I)X -X1849(use)X -X7 f -X2006(dbu)X -X1 f -X2172(to)X -X2255(test)X -X2387(out)X -X2510(the)X -X2629(routines:)X -X2930(it)X -X2995(takes)X -X3181(\(from)X -X3385(stdin\))X -X3588(tab)X -X3707(separated)X -X555 4624(key/value)N -X898(pairs)X -X1085(for)X -X1210(commands)X -X1587(like)X -X7 f -X1765(build)X -X1 f -X2035(or)X -X7 f -X2160(insert)X -X1 f -X2478(or)X -X2575(takes)X -X2770(keys)X -X2947(for)X -X3071(commands)X -X3448(like)X -X7 f -X3626(delete)X -X1 f -X3944(or)X -X7 f -X555 4720(look)N -X1 f -X(.)S -X7 f -X747 4864(dbu)N -X939()X -X2715(dbmfile)X -X755 5036(dba)N -X1 f -X927(is)X -X1008(a)X -X1072(crude)X -X1279(analyzer)X -X1580(of)X -X2 f -X1675(dbm/sdbm/ndbm)X -X1 f -X2232(page)X -X2412(\256les.)X -X2593(It)X -X2670(scans)X -X2872(the)X -X2998(entire)X -X3209(page)X -X3389(\256le,)X -X3538(reporting)X -X3859(page)X -X555 5132(level)N -X731(statistics,)X -X1046(and)X -X1182(totals)X -X1375(at)X -X1453(the)X -X1571(end.)X -X7 f -X755 5256(dbd)N -X1 f -X925(is)X -X1004(a)X -X1066(crude)X -X1271(dump)X -X1479(program)X -X1777(for)X -X2 f -X1897(dbm/ndbm/sdbm)X -X1 f -X2452(databases.)X -X2806(It)X -X2881(ignores)X -X3143(the)X -X3267(bitmap,)X -X3534(and)X -X3675(dumps)X -X3913(the)X -X555 5352(data)N -X717(pages)X -X928(in)X -X1018(sequence.)X -X1361(It)X -X1437(can)X -X1576(be)X -X1679(used)X -X1853(to)X -X1942(create)X -X2162(input)X -X2353(for)X -X2474(the)X -X7 f -X2627(dbu)X -X1 f -X2798(utility.)X -X3055(Note)X -X3238(that)X -X7 f -X3413(dbd)X -X1 f -X3584(will)X -X3735(skip)X -X3895(any)X -X8 s -X10 f -X555 5432(hhhhhhhhhhhhhhhhhh)N -X6 s -X1 f -X635 5507(3)N -X8 s -X691 5526(You)N -X817(cannot)X -X1003(really)X -X1164(hoard)X -X1325(something)X -X1608(that)X -X1720(is)X -X1779(available)X -X2025(to)X -X2091(the)X -X2185(public)X -X2361(at)X -X2423(large,)X -X2582(but)X -X2680(try)X -X2767(if)X -X2822(it)X -X2874(makes)X -X3053(you)X -X3165(feel)X -X3276(any)X -X3384(better.)X -X6 s -X635 5601(4)N -X8 s -X691 5620(The)N -X7 f -X829(dbd)X -X1 f -X943(,)X -X7 f -X998(dba)X -X1 f -X1112(,)X -X7 f -X1167(dbu)X -X1 f -X1298(utilities)X -X1508(are)X -X1602(quick)X -X1761(hacks)X -X1923(and)X -X2032(are)X -X2126(not)X -X2225(\256t)X -X2295(for)X -X2385(production)X -X2678(use.)X -X2795(They)X -X2942(were)X -X3081(developed)X -X3359(late)X -X3467(one)X -X3575(night,)X -X555 5700(just)N -X664(to)X -X730(test)X -X835(out)X -X2 f -X933(sdbm)X -X1 f -X1068(,)X -X1100(and)X -X1208(convert)X -X1415(some)X -X1566(databases.)X -X -X3 p -X%%Page: 3 3 -X8 s 0 xH 0 xS 1 f -X10 s -X2216 384(-)N -X2263(3)X -X2323(-)X -X555 672(NULLs)N -X821(in)X -X903(the)X -X1021(key)X -X1157(and)X -X1293(data)X -X1447(\256elds,)X -X1660(thus)X -X1813(is)X -X1886(unsuitable)X -X2235(to)X -X2317(convert)X -X2578(some)X -X2767(peculiar)X -X3046(databases)X -X3374(that)X -X3514(insist)X -X3702(in)X -X3784(includ-)X -X555 768(ing)N -X677(the)X -X795(terminating)X -X1184(null.)X -X755 892(I)N -X841(have)X -X1052(also)X -X1240(included)X -X1575(a)X -X1670(copy)X -X1885(of)X -X2011(the)X -X7 f -X2195(dbe)X -X1 f -X2397(\()X -X2 f -X2424(ndbm)X -X1 f -X2660(DataBase)X -X3026(Editor\))X -X3311(by)X -X3449(Janick)X -X3712(Bergeron)X -X555 988([janick@bnr.ca])N -X1098(for)X -X1212(your)X -X1379(pleasure.)X -X1687(You)X -X1845(may)X -X2003(\256nd)X -X2147(it)X -X2211(more)X -X2396(useful)X -X2612(than)X -X2770(the)X -X2888(little)X -X7 f -X3082(dbu)X -X1 f -X3246(utility.)X -X7 f -X755 1112(dbm.[ch])N -X1 f -X1169(is)X -X1252(a)X -X2 f -X1318(dbm)X -X1 f -X1486(library)X -X1730(emulation)X -X2079(on)X -X2188(top)X -X2319(of)X -X2 f -X2415(ndbm)X -X1 f -X2622(\(and)X -X2794(hence)X -X3011(suitable)X -X3289(for)X -X2 f -X3412(sdbm)X -X1 f -X3581(\).)X -X3657(Written)X -X3931(by)X -X555 1208(Robert)N -X793(Elz.)X -X755 1332(The)N -X2 f -X901(sdbm)X -X1 f -X1090(library)X -X1324(has)X -X1451(been)X -X1623(around)X -X1866(in)X -X1948(beta)X -X2102(test)X -X2233(for)X -X2347(quite)X -X2527(a)X -X2583(long)X -X2745(time,)X -X2927(and)X -X3063(from)X -X3239(whatever)X -X3554(little)X -X3720(feedback)X -X555 1428(I)N -X609(received)X -X909(\(maybe)X -X1177(no)X -X1284(news)X -X1476(is)X -X1555(good)X -X1741(news\),)X -X1979(I)X -X2032(believe)X -X2290(it)X -X2360(has)X -X2493(been)X -X2671(functioning)X -X3066(without)X -X3336(any)X -X3478(signi\256cant)X -X3837(prob-)X -X555 1524(lems.)N -X752(I)X -X805(would,)X -X1051(of)X -X1144(course,)X -X1400(appreciate)X -X1757(all)X -X1863(\256xes)X -X2040(and/or)X -X2271(improvements.)X -X2774(Portability)X -X3136(enhancements)X -X3616(would)X -X3841(espe-)X -X555 1620(cially)N -X753(be)X -X849(useful.)X -X3 f -X555 1812(Implementation)N -X1122(Issues)X -X1 f -X755 1936(Hash)N -X944(functions:)X -X1288(The)X -X1437(algorithm)X -X1772(behind)X -X2 f -X2014(sdbm)X -X1 f -X2207(implementation)X -X2733(needs)X -X2939(a)X -X2998(good)X -X3181(bit-scrambling)X -X3671(hash)X -X3841(func-)X -X555 2032(tion)N -X702(to)X -X787(be)X -X886(effective.)X -X1211(I)X -X1261(ran)X -X1387(into)X -X1534(a)X -X1593(set)X -X1705(of)X -X1795(constants)X -X2116(for)X -X2233(a)X -X2292(simple)X -X2528(hash)X -X2698(function)X -X2988(that)X -X3130(seem)X -X3317(to)X -X3401(help)X -X2 f -X3561(sdbm)X -X1 f -X3752(perform)X -X555 2128(better)N -X758(than)X -X2 f -X916(ndbm)X -X1 f -X1114(for)X -X1228(various)X -X1484(inputs:)X -X7 f -X747 2272(/*)N -X795 2368(*)N -X891(polynomial)X -X1419(conversion)X -X1947(ignoring)X -X2379(overflows)X -X795 2464(*)N -X891(65599)X -X1179(nice.)X -X1467(65587)X -X1755(even)X -X1995(better.)X -X795 2560(*/)N -X747 2656(long)N -X747 2752(dbm_hash\(char)N -X1419(*str,)X -X1707(int)X -X1899(len\))X -X2139({)X -X939 2848(register)N -X1371(unsigned)X -X1803(long)X -X2043(n)X -X2139(=)X -X2235(0;)X -X939 3040(while)N -X1227(\(len--\))X -X1131 3136(n)N -X1227(=)X -X1323(n)X -X1419(*)X -X1515(65599)X -X1803(+)X -X1899(*str++;)X -X939 3232(return)N -X1275(n;)X -X747 3328(})N -X1 f -X755 3500(There)N -X975(may)X -X1145(be)X -X1253(better)X -X1467(hash)X -X1645(functions)X -X1974(for)X -X2099(the)X -X2228(purposes)X -X2544(of)X -X2642(dynamic)X -X2949(hashing.)X -X3269(Try)X -X3416(your)X -X3594(favorite,)X -X3895(and)X -X555 3596(check)N -X766(the)X -X887(page\256le.)X -X1184(If)X -X1261(it)X -X1328(contains)X -X1618(too)X -X1743(many)X -X1944(pages)X -X2150(with)X -X2315(too)X -X2440(many)X -X2641(holes,)X -X2853(\(in)X -X2965(relation)X -X3233(to)X -X3318(this)X -X3456(one)X -X3595(for)X -X3712(example\))X -X555 3692(or)N -X656(if)X -X2 f -X739(sdbm)X -X1 f -X942(simply)X -X1193(stops)X -X1391(working)X -X1692(\(fails)X -X1891(after)X -X7 f -X2101(SPLTMAX)X -X1 f -X2471(attempts)X -X2776(to)X -X2872(split\))X -X3070(when)X -X3278(you)X -X3432(feed)X -X3604(your)X -X3784(NEWS)X -X7 f -X555 3788(history)N -X1 f -X912(\256le)X -X1035(to)X -X1118(it,)X -X1203(you)X -X1344(probably)X -X1650(do)X -X1751(not)X -X1874(have)X -X2047(a)X -X2104(good)X -X2285(hashing)X -X2555(function.)X -X2883(If)X -X2958(you)X -X3099(do)X -X3200(better)X -X3404(\(for)X -X3545(different)X -X3842(types)X -X555 3884(of)N -X642(input\),)X -X873(I)X -X920(would)X -X1140(like)X -X1280(to)X -X1362(know)X -X1560(about)X -X1758(the)X -X1876(function)X -X2163(you)X -X2303(use.)X -X755 4008(Block)N -X967(sizes:)X -X1166(It)X -X1236(seems)X -X1453(\(from)X -X1657(various)X -X1914(tests)X -X2077(on)X -X2178(a)X -X2235(few)X -X2377(machines\))X -X2727(that)X -X2867(a)X -X2923(page)X -X3095(\256le)X -X3217(block)X -X3415(size)X -X7 f -X3588(PBLKSIZ)X -X1 f -X3944(of)X -X555 4104(1024)N -X738(is)X -X814(by)X -X917(far)X -X1030(the)X -X1150(best)X -X1301(for)X -X1417(performance,)X -X1866(but)X -X1990(this)X -X2127(also)X -X2278(happens)X -X2563(to)X -X2647(limit)X -X2819(the)X -X2939(size)X -X3086(of)X -X3175(a)X -X3233(key/value)X -X3567(pair.)X -X3734(Depend-)X -X555 4200(ing)N -X681(on)X -X785(your)X -X956(needs,)X -X1183(you)X -X1327(may)X -X1489(wish)X -X1663(to)X -X1748(increase)X -X2035(the)X -X2156(page)X -X2331(size,)X -X2499(and)X -X2638(also)X -X2790(adjust)X -X7 f -X3032(PAIRMAX)X -X1 f -X3391(\(the)X -X3539(maximum)X -X3886(size)X -X555 4296(of)N -X648(a)X -X710(key/value)X -X1048(pair)X -X1199(allowed:)X -X1501(should)X -X1740(always)X -X1989(be)X -X2090(at)X -X2173(least)X -X2345(three)X -X2531(words)X -X2752(smaller)X -X3013(than)X -X7 f -X3204(PBLKSIZ)X -X1 f -X(.\))S -X3612(accordingly.)X -X555 4392(The)N -X706(system-wide)X -X1137(version)X -X1399(of)X -X1492(the)X -X1616(library)X -X1856(should)X -X2095(probably)X -X2406(be)X -X2508(con\256gured)X -X2877(with)X -X3044(1024)X -X3229(\(distribution)X -X3649(default\),)X -X3944(as)X -X555 4488(this)N -X690(appears)X -X956(to)X -X1038(be)X -X1134(suf\256cient)X -X1452(for)X -X1566(most)X -X1741(common)X -X2041(uses)X -X2199(of)X -X2 f -X2286(sdbm)X -X1 f -X2455(.)X -X3 f -X555 4680(Portability)N -X1 f -X755 4804(This)N -X917(package)X -X1201(has)X -X1328(been)X -X1500(tested)X -X1707(in)X -X1789(many)X -X1987(different)X -X2284(UN*Xes)X -X2585(even)X -X2757(including)X -X3079(minix,)X -X3305(and)X -X3441(appears)X -X3707(to)X -X3789(be)X -X3885(rea-)X -X555 4900(sonably)N -X824(portable.)X -X1127(This)X -X1289(does)X -X1456(not)X -X1578(mean)X -X1772(it)X -X1836(will)X -X1980(port)X -X2129(easily)X -X2336(to)X -X2418(non-UN*X)X -X2799(systems.)X -X3 f -X555 5092(Notes)N -X767(and)X -X915(Miscellaneous)X -X1 f -X755 5216(The)N -X2 f -X913(sdbm)X -X1 f -X1115(is)X -X1201(not)X -X1336(a)X -X1405(very)X -X1581(complicated)X -X2006(package,)X -X2323(at)X -X2414(least)X -X2594(not)X -X2729(after)X -X2910(you)X -X3063(familiarize)X -X3444(yourself)X -X3739(with)X -X3913(the)X -X555 5312(literature)N -X879(on)X -X993(external)X -X1286(hashing.)X -X1589(There)X -X1811(are)X -X1944(other)X -X2143(interesting)X -X2514(algorithms)X -X2889(in)X -X2984(existence)X -X3316(that)X -X3469(ensure)X -X3712(\(approxi-)X -X555 5408(mately\))N -X825(single-read)X -X1207(access)X -X1438(to)X -X1525(a)X -X1586(data)X -X1745(value)X -X1944(associated)X -X2299(with)X -X2466(any)X -X2607(key.)X -X2768(These)X -X2984(are)X -X3107(directory-less)X -X3568(schemes)X -X3864(such)X -X555 5504(as)N -X2 f -X644(linear)X -X857(hashing)X -X1 f -X1132([Lit80])X -X1381(\(+)X -X1475(Larson)X -X1720(variations\),)X -X2 f -X2105(spiral)X -X2313(storage)X -X1 f -X2575([Mar79])X -X2865(or)X -X2954(directory)X -X3265(schemes)X -X3558(such)X -X3726(as)X -X2 f -X3814(exten-)X -X555 5600(sible)N -X731(hashing)X -X1 f -X1009([Fag79])X -X1288(by)X -X1393(Fagin)X -X1600(et)X -X1683(al.)X -X1786(I)X -X1838(do)X -X1943(hope)X -X2124(these)X -X2314(sources)X -X2579(provide)X -X2848(a)X -X2908(reasonable)X -X3276(playground)X -X3665(for)X -X3783(experi-)X -X555 5696(mentation)N -X907(with)X -X1081(other)X -X1277(algorithms.)X -X1690(See)X -X1837(the)X -X1966(June)X -X2144(1988)X -X2335(issue)X -X2526(of)X -X2624(ACM)X -X2837(Computing)X -X3227(Surveys)X -X3516([Enb88])X -X3810(for)X -X3935(an)X -X555 5792(excellent)N -X865(overview)X -X1184(of)X -X1271(the)X -X1389(\256eld.)X -X -X4 p -X%%Page: 4 4 -X10 s 0 xH 0 xS 1 f -X2216 384(-)N -X2263(4)X -X2323(-)X -X3 f -X555 672(References)N -X1 f -X555 824([Lar78])N -X875(P.-A.)X -X1064(Larson,)X -X1327(``Dynamic)X -X1695(Hashing'',)X -X2 f -X2056(BIT)X -X1 f -X(,)S -X2216(vol.)X -X2378(18,)X -X2518(pp.)X -X2638(184-201,)X -X2945(1978.)X -X555 948([Tho90])N -X875(Ken)X -X1029(Thompson,)X -X2 f -X1411(private)X -X1658(communication)X -X1 f -X2152(,)X -X2192(Nov.)X -X2370(1990)X -X555 1072([Lit80])N -X875(W.)X -X992(Litwin,)X -X1246(``)X -X1321(Linear)X -X1552(Hashing:)X -X1862(A)X -X1941(new)X -X2096(tool)X -X2261(for)X -X2396(\256le)X -X2539(and)X -X2675(table)X -X2851(addressing'',)X -X2 f -X3288(Proceedings)X -X3709(of)X -X3791(the)X -X3909(6th)X -X875 1168(Conference)N -X1269(on)X -X1373(Very)X -X1548(Large)X -X1782(Dabatases)X -X2163(\(Montreal\))X -X1 f -X2515(,)X -X2558(pp.)X -X2701(212-223,)X -X3031(Very)X -X3215(Large)X -X3426(Database)X -X3744(Founda-)X -X875 1264(tion,)N -X1039(Saratoga,)X -X1360(Calif.,)X -X1580(1980.)X -X555 1388([Fag79])N -X875(R.)X -X969(Fagin,)X -X1192(J.)X -X1284(Nievergelt,)X -X1684(N.)X -X1803(Pippinger,)X -X2175(and)X -X2332(H.)X -X2451(R.)X -X2544(Strong,)X -X2797(``Extendible)X -X3218(Hashing)X -X3505(-)X -X3552(A)X -X3630(Fast)X -X3783(Access)X -X875 1484(Method)N -X1144(for)X -X1258(Dynamic)X -X1572(Files'',)X -X2 f -X1821(ACM)X -X2010(Trans.)X -X2236(Database)X -X2563(Syst.)X -X1 f -X2712(,)X -X2752(vol.)X -X2894(4,)X -X2994(no.3,)X -X3174(pp.)X -X3294(315-344,)X -X3601(Sept.)X -X3783(1979.)X -X555 1608([Wal84])N -X875(Rich)X -X1055(Wales,)X -X1305(``Discussion)X -X1739(of)X -X1835("dbm")X -X2072(data)X -X2235(base)X -X2406(system'',)X -X2 f -X2730(USENET)X -X3051(newsgroup)X -X3430(unix.wizards)X -X1 f -X3836(,)X -X3884(Jan.)X -X875 1704(1984.)N -X555 1828([Tor87])N -X875(Chris)X -X1068(Torek,)X -X1300(``Re:)X -X1505(dbm.a)X -X1743(and)X -X1899(ndbm.a)X -X2177(archives'',)X -X2 f -X2539(USENET)X -X2852(newsgroup)X -X3223(comp.unix)X -X1 f -X3555(,)X -X3595(1987.)X -X555 1952([Mar79])N -X875(G.)X -X974(N.)X -X1073(Martin,)X -X1332(``Spiral)X -X1598(Storage:)X -X1885(Incrementally)X -X2371(Augmentable)X -X2843(Hash)X -X3048(Addressed)X -X3427(Storage'',)X -X2 f -X3766(Techni-)X -X875 2048(cal)N -X993(Report)X -X1231(#27)X -X1 f -X(,)S -X1391(University)X -X1749(of)X -X1836(Varwick,)X -X2153(Coventry,)X -X2491(U.K.,)X -X2687(1979.)X -X555 2172([Enb88])N -X875(R.)X -X977(J.)X -X1057(Enbody)X -X1335(and)X -X1480(H.)X -X1586(C.)X -X1687(Du,)X -X1833(``Dynamic)X -X2209(Hashing)X -X2524(Schemes'',)X -X2 f -X2883(ACM)X -X3080(Computing)X -X3463(Surveys)X -X1 f -X3713(,)X -X3761(vol.)X -X3911(20,)X -X875 2268(no.)N -X995(2,)X -X1075(pp.)X -X1195(85-113,)X -X1462(June)X -X1629(1988.)X -X -X4 p -X%%Trailer -Xxt -X -Xxs -END_OF_FILE -if test 33302 -ne `wc -c <'readme.ps'`; then - echo shar: \"'readme.ps'\" unpacked with wrong size! -fi -# end of 'readme.ps' -fi -if test -f 'sdbm.3' -a "${1}" != "-c" ; then - echo shar: Will not clobber existing file \"'sdbm.3'\" -else -echo shar: Extracting \"'sdbm.3'\" \(8952 characters\) -sed "s/^X//" >'sdbm.3' <<'END_OF_FILE' -X.\" $Id: sdbm.3,v 1.2 90/12/13 13:00:57 oz Exp $ -X.TH SDBM 3 "1 March 1990" -X.SH NAME -Xsdbm, dbm_open, dbm_prep, dbm_close, dbm_fetch, dbm_store, dbm_delete, dbm_firstkey, dbm_nextkey, dbm_hash, dbm_rdonly, dbm_error, dbm_clearerr, dbm_dirfno, dbm_pagfno \- data base subroutines -X.SH SYNOPSIS -X.nf -X.ft B -X#include -X.sp -Xtypedef struct { -X char *dptr; -X int dsize; -X} datum; -X.sp -Xdatum nullitem = { NULL, 0 }; -X.sp -X\s-1DBM\s0 *dbm_open(char *file, int flags, int mode) -X.sp -X\s-1DBM\s0 *dbm_prep(char *dirname, char *pagname, int flags, int mode) -X.sp -Xvoid dbm_close(\s-1DBM\s0 *db) -X.sp -Xdatum dbm_fetch(\s-1DBM\s0 *db, key) -X.sp -Xint dbm_store(\s-1DBM\s0 *db, datum key, datum val, int flags) -X.sp -Xint dbm_delete(\s-1DBM\s0 *db, datum key) -X.sp -Xdatum dbm_firstkey(\s-1DBM\s0 *db) -X.sp -Xdatum dbm_nextkey(\s-1DBM\s0 *db) -X.sp -Xlong dbm_hash(char *string, int len) -X.sp -Xint dbm_rdonly(\s-1DBM\s0 *db) -Xint dbm_error(\s-1DBM\s0 *db) -Xdbm_clearerr(\s-1DBM\s0 *db) -Xint dbm_dirfno(\s-1DBM\s0 *db) -Xint dbm_pagfno(\s-1DBM\s0 *db) -X.ft R -X.fi -X.SH DESCRIPTION -X.IX "database library" sdbm "" "\fLsdbm\fR" -X.IX dbm_open "" "\fLdbm_open\fR \(em open \fLsdbm\fR database" -X.IX dbm_prep "" "\fLdbm_prep\fR \(em prepare \fLsdbm\fR database" -X.IX dbm_close "" "\fLdbm_close\fR \(em close \fLsdbm\fR routine" -X.IX dbm_fetch "" "\fLdbm_fetch\fR \(em fetch \fLsdbm\fR database data" -X.IX dbm_store "" "\fLdbm_store\fR \(em add data to \fLsdbm\fR database" -X.IX dbm_delete "" "\fLdbm_delete\fR \(em remove data from \fLsdbm\fR database" -X.IX dbm_firstkey "" "\fLdbm_firstkey\fR \(em access \fLsdbm\fR database" -X.IX dbm_nextkey "" "\fLdbm_nextkey\fR \(em access \fLsdbm\fR database" -X.IX dbm_hash "" "\fLdbm_hash\fR \(em string hash for \fLsdbm\fR database" -X.IX dbm_rdonly "" "\fLdbm_rdonly\fR \(em return \fLsdbm\fR database read-only mode" -X.IX dbm_error "" "\fLdbm_error\fR \(em return \fLsdbm\fR database error condition" -X.IX dbm_clearerr "" "\fLdbm_clearerr\fR \(em clear \fLsdbm\fR database error condition" -X.IX dbm_dirfno "" "\fLdbm_dirfno\fR \(em return \fLsdbm\fR database bitmap file descriptor" -X.IX dbm_pagfno "" "\fLdbm_pagfno\fR \(em return \fLsdbm\fR database data file descriptor" -X.IX "database functions \(em \fLsdbm\fR" dbm_open "" \fLdbm_open\fP -X.IX "database functions \(em \fLsdbm\fR" dbm_prep "" \fLdbm_prep\fP -X.IX "database functions \(em \fLsdbm\fR" dbm_close "" \fLdbm_close\fP -X.IX "database functions \(em \fLsdbm\fR" dbm_fetch "" \fLdbm_fetch\fP -X.IX "database functions \(em \fLsdbm\fR" dbm_store "" \fLdbm_store\fP -X.IX "database functions \(em \fLsdbm\fR" dbm_delete "" \fLdbm_delete\fP -X.IX "database functions \(em \fLsdbm\fR" dbm_firstkey "" \fLdbm_firstkey\fP -X.IX "database functions \(em \fLsdbm\fR" dbm_nextkey "" \fLdbm_nextkey\fP -X.IX "database functions \(em \fLsdbm\fR" dbm_rdonly "" \fLdbm_rdonly\fP -X.IX "database functions \(em \fLsdbm\fR" dbm_error "" \fLdbm_error\fP -X.IX "database functions \(em \fLsdbm\fR" dbm_clearerr "" \fLdbm_clearerr\fP -X.IX "database functions \(em \fLsdbm\fR" dbm_dirfno "" \fLdbm_dirfno\fP -X.IX "database functions \(em \fLsdbm\fR" dbm_pagfno "" \fLdbm_pagfno\fP -X.LP -XThis package allows an application to maintain a mapping of pairs -Xin disk files. This is not to be considered a real database system, but is -Xstill useful in many simple applications built around fast retrieval of a data -Xvalue from a key. This implementation uses an external hashing scheme, -Xcalled Dynamic Hashing, as described by Per-Aake Larson in BIT 18 (1978) pp. -X184-201. Retrieval of any item usually requires a single disk access. -XThe application interface is compatible with the -X.IR ndbm (3) -Xlibrary. -X.LP -XAn -X.B sdbm -Xdatabase is kept in two files usually given the extensions -X.B \.dir -Xand -X.BR \.pag . -XThe -X.B \.dir -Xfile contains a bitmap representing a forest of binary hash trees, the leaves -Xof which indicate data pages in the -X.B \.pag -Xfile. -X.LP -XThe application interface uses the -X.B datum -Xstructure to describe both -X.I keys -Xand -X.IR value s. -XA -X.B datum -Xspecifies a byte sequence of -X.I dsize -Xsize pointed to by -X.IR dptr . -XIf you use -X.SM ASCII -Xstrings as -X.IR key s -Xor -X.IR value s, -Xthen you must decide whether or not to include the terminating -X.SM NUL -Xbyte which sometimes defines strings. Including it will require larger -Xdatabase files, but it will be possible to get sensible output from a -X.IR strings (1) -Xcommand applied to the data file. -X.LP -XIn order to allow a process using this package to manipulate multiple -Xdatabases, the applications interface always requires a -X.IR handle , -Xa -X.BR "DBM *" , -Xto identify the database to be manipulated. Such a handle can be obtained -Xfrom the only routines that do not require it, namely -X.BR dbm_open (\|) -Xor -X.BR dbm_prep (\|). -XEither of these will open or create the two necessary files. The -Xdifference is that the latter allows explicitly naming the bitmap and data -Xfiles whereas -X.BR dbm_open (\|) -Xwill take a base file name and call -X.BR dbm_prep (\|) -Xwith the default extensions. -XThe -X.I flags -Xand -X.I mode -Xparameters are the same as for -X.BR open (2). -X.LP -XTo free the resources occupied while a database handle is active, call -X.BR dbm_close (\|). -X.LP -XGiven a handle, one can retrieve data associated with a key by using the -X.BR dbm_fetch (\|) -Xroutine, and associate data with a key by using the -X.BR dbm_store (\|) -Xroutine. -X.LP -XThe values of the -X.I flags -Xparameter for -X.BR dbm_store (\|) -Xcan be either -X.BR \s-1DBM_INSERT\s0 , -Xwhich will not change an existing entry with the same key, or -X.BR \s-1DBM_REPLACE\s0 , -Xwhich will replace an existing entry with the same key. -XKeys are unique within the database. -X.LP -XTo delete a key and its associated value use the -X.BR dbm_delete (\|) -Xroutine. -X.LP -XTo retrieve every key in the database, use a loop like: -X.sp -X.nf -X.ft B -Xfor (key = dbm_firstkey(db); key.dptr != NULL; key = dbm_nextkey(db)) -X ; -X.ft R -X.fi -X.LP -XThe order of retrieval is unspecified. -X.LP -XIf you determine that the performance of the database is inadequate or -Xyou notice clustering or other effects that may be due to the hashing -Xalgorithm used by this package, you can override it by supplying your -Xown -X.BR dbm_hash (\|) -Xroutine. Doing so will make the database unintelligable to any other -Xapplications that do not use your specialized hash function. -X.sp -X.LP -XThe following macros are defined in the header file: -X.IP -X.BR dbm_rdonly (\|) -Xreturns true if the database has been opened read\-only. -X.IP -X.BR dbm_error (\|) -Xreturns true if an I/O error has occurred. -X.IP -X.BR dbm_clearerr (\|) -Xallows you to clear the error flag if you think you know what the error -Xwas and insist on ignoring it. -X.IP -X.BR dbm_dirfno (\|) -Xreturns the file descriptor associated with the bitmap file. -X.IP -X.BR dbm_pagfno (\|) -Xreturns the file descriptor associated with the data file. -X.SH SEE ALSO -X.IR open (2). -X.SH DIAGNOSTICS -XFunctions that return a -X.B "DBM *" -Xhandle will use -X.SM NULL -Xto indicate an error. -XFunctions that return an -X.B int -Xwill use \-1 to indicate an error. The normal return value in that case is 0. -XFunctions that return a -X.B datum -Xwill return -X.B nullitem -Xto indicate an error. -X.LP -XAs a special case of -X.BR dbm_store (\|), -Xif it is called with the -X.B \s-1DBM_INSERT\s0 -Xflag and the key already exists in the database, the return value will be 1. -X.LP -XIn general, if a function parameter is invalid, -X.B errno -Xwill be set to -X.BR \s-1EINVAL\s0 . -XIf a write operation is requested on a read-only database, -X.B errno -Xwill be set to -X.BR \s-1ENOPERM\s0 . -XIf a memory allocation (using -X.IR malloc (3)) -Xfailed, -X.B errno -Xwill be set to -X.BR \s-1ENOMEM\s0 . -XFor I/O operation failures -X.B errno -Xwill contain the value set by the relevant failed system call, either -X.IR read (2), -X.IR write (2), -Xor -X.IR lseek (2). -X.SH AUTHOR -X.IP "Ozan S. Yigit" (oz@nexus.yorku.ca) -X.SH BUGS -XThe sum of key and value data sizes must not exceed -X.B \s-1PAIRMAX\s0 -X(1008 bytes). -X.LP -XThe sum of the key and value data sizes where several keys hash to the -Xsame value must fit within one bitmap page. -X.LP -XThe -X.B \.pag -Xfile will contain holes, so its apparent size is larger than its contents. -XWhen copied through the filesystem the holes will be filled. -X.LP -XThe contents of -X.B datum -Xvalues returned are in volatile storage. If you want to retain the values -Xpointed to, you must copy them immediately before another call to this package. -X.LP -XThe only safe way for multiple processes to (read and) update a database at -Xthe same time, is to implement a private locking scheme outside this package -Xand open and close the database between lock acquisitions. It is safe for -Xmultiple processes to concurrently access a database read-only. -X.SH APPLICATIONS PORTABILITY -XFor complete source code compatibility with the Berkeley Unix -X.IR ndbm (3) -Xlibrary, the -X.B sdbm.h -Xheader file should be installed in -X.BR /usr/include/ndbm.h . -X.LP -XThe -X.B nullitem -Xdata item, and the -X.BR dbm_prep (\|), -X.BR dbm_hash (\|), -X.BR dbm_rdonly (\|), -X.BR dbm_dirfno (\|), -Xand -X.BR dbm_pagfno (\|) -Xfunctions are unique to this package. -END_OF_FILE -if test 8952 -ne `wc -c <'sdbm.3'`; then - echo shar: \"'sdbm.3'\" unpacked with wrong size! -fi -# end of 'sdbm.3' -fi -if test -f 'sdbm.c' -a "${1}" != "-c" ; then - echo shar: Will not clobber existing file \"'sdbm.c'\" -else -echo shar: Extracting \"'sdbm.c'\" \(11029 characters\) -sed "s/^X//" >'sdbm.c' <<'END_OF_FILE' -X/* -X * sdbm - ndbm work-alike hashed database library -X * based on Per-Aake Larson's Dynamic Hashing algorithms. BIT 18 (1978). -X * author: oz@nexus.yorku.ca -X * status: public domain. -X * -X * core routines -X */ -X -X#ifndef lint -Xstatic char rcsid[] = "$Id: sdbm.c,v 1.16 90/12/13 13:01:31 oz Exp $"; -X#endif -X -X#include "sdbm.h" -X#include "tune.h" -X#include "pair.h" -X -X#include -X#include -X#ifdef BSD42 -X#include -X#else -X#include -X#include -X#endif -X#include -X#include -X -X#ifdef __STDC__ -X#include -X#endif -X -X#ifndef NULL -X#define NULL 0 -X#endif -X -X/* -X * externals -X */ -X#ifndef sun -Xextern int errno; -X#endif -X -Xextern char *malloc proto((unsigned int)); -Xextern void free proto((void *)); -Xextern long lseek(); -X -X/* -X * forward -X */ -Xstatic int getdbit proto((DBM *, long)); -Xstatic int setdbit proto((DBM *, long)); -Xstatic int getpage proto((DBM *, long)); -Xstatic datum getnext proto((DBM *)); -Xstatic int makroom proto((DBM *, long, int)); -X -X/* -X * useful macros -X */ -X#define bad(x) ((x).dptr == NULL || (x).dsize <= 0) -X#define exhash(item) dbm_hash((item).dptr, (item).dsize) -X#define ioerr(db) ((db)->flags |= DBM_IOERR) -X -X#define OFF_PAG(off) (long) (off) * PBLKSIZ -X#define OFF_DIR(off) (long) (off) * DBLKSIZ -X -Xstatic long masks[] = { -X 000000000000, 000000000001, 000000000003, 000000000007, -X 000000000017, 000000000037, 000000000077, 000000000177, -X 000000000377, 000000000777, 000000001777, 000000003777, -X 000000007777, 000000017777, 000000037777, 000000077777, -X 000000177777, 000000377777, 000000777777, 000001777777, -X 000003777777, 000007777777, 000017777777, 000037777777, -X 000077777777, 000177777777, 000377777777, 000777777777, -X 001777777777, 003777777777, 007777777777, 017777777777 -X}; -X -Xdatum nullitem = {NULL, 0}; -X -XDBM * -Xdbm_open(file, flags, mode) -Xregister char *file; -Xregister int flags; -Xregister int mode; -X{ -X register DBM *db; -X register char *dirname; -X register char *pagname; -X register int n; -X -X if (file == NULL || !*file) -X return errno = EINVAL, (DBM *) NULL; -X/* -X * need space for two seperate filenames -X */ -X n = strlen(file) * 2 + strlen(DIRFEXT) + strlen(PAGFEXT) + 2; -X -X if ((dirname = malloc((unsigned) n)) == NULL) -X return errno = ENOMEM, (DBM *) NULL; -X/* -X * build the file names -X */ -X dirname = strcat(strcpy(dirname, file), DIRFEXT); -X pagname = strcpy(dirname + strlen(dirname) + 1, file); -X pagname = strcat(pagname, PAGFEXT); -X -X db = dbm_prep(dirname, pagname, flags, mode); -X free((char *) dirname); -X return db; -X} -X -XDBM * -Xdbm_prep(dirname, pagname, flags, mode) -Xchar *dirname; -Xchar *pagname; -Xint flags; -Xint mode; -X{ -X register DBM *db; -X struct stat dstat; -X -X if ((db = (DBM *) malloc(sizeof(DBM))) == NULL) -X return errno = ENOMEM, (DBM *) NULL; -X -X db->flags = 0; -X db->hmask = 0; -X db->blkptr = 0; -X db->keyptr = 0; -X/* -X * adjust user flags so that WRONLY becomes RDWR, -X * as required by this package. Also set our internal -X * flag for RDONLY if needed. -X */ -X if (flags & O_WRONLY) -X flags = (flags & ~O_WRONLY) | O_RDWR; -X -X else if ((flags & 03) == O_RDONLY) -X db->flags = DBM_RDONLY; -X/* -X * open the files in sequence, and stat the dirfile. -X * If we fail anywhere, undo everything, return NULL. -X */ -X if ((db->pagf = open(pagname, flags, mode)) > -1) { -X if ((db->dirf = open(dirname, flags, mode)) > -1) { -X/* -X * need the dirfile size to establish max bit number. -X */ -X if (fstat(db->dirf, &dstat) == 0) { -X/* -X * zero size: either a fresh database, or one with a single, -X * unsplit data page: dirpage is all zeros. -X */ -X db->dirbno = (!dstat.st_size) ? 0 : -1; -X db->pagbno = -1; -X db->maxbno = dstat.st_size * BYTESIZ; -X -X (void) memset(db->pagbuf, 0, PBLKSIZ); -X (void) memset(db->dirbuf, 0, DBLKSIZ); -X /* -X * success -X */ -X return db; -X } -X (void) close(db->dirf); -X } -X (void) close(db->pagf); -X } -X free((char *) db); -X return (DBM *) NULL; -X} -X -Xvoid -Xdbm_close(db) -Xregister DBM *db; -X{ -X if (db == NULL) -X errno = EINVAL; -X else { -X (void) close(db->dirf); -X (void) close(db->pagf); -X free((char *) db); -X } -X} -X -Xdatum -Xdbm_fetch(db, key) -Xregister DBM *db; -Xdatum key; -X{ -X if (db == NULL || bad(key)) -X return errno = EINVAL, nullitem; -X -X if (getpage(db, exhash(key))) -X return getpair(db->pagbuf, key); -X -X return ioerr(db), nullitem; -X} -X -Xint -Xdbm_delete(db, key) -Xregister DBM *db; -Xdatum key; -X{ -X if (db == NULL || bad(key)) -X return errno = EINVAL, -1; -X if (dbm_rdonly(db)) -X return errno = EPERM, -1; -X -X if (getpage(db, exhash(key))) { -X if (!delpair(db->pagbuf, key)) -X return -1; -X/* -X * update the page file -X */ -X if (lseek(db->pagf, OFF_PAG(db->pagbno), SEEK_SET) < 0 -X || write(db->pagf, db->pagbuf, PBLKSIZ) < 0) -X return ioerr(db), -1; -X -X return 0; -X } -X -X return ioerr(db), -1; -X} -X -Xint -Xdbm_store(db, key, val, flags) -Xregister DBM *db; -Xdatum key; -Xdatum val; -Xint flags; -X{ -X int need; -X register long hash; -X -X if (db == NULL || bad(key)) -X return errno = EINVAL, -1; -X if (dbm_rdonly(db)) -X return errno = EPERM, -1; -X -X need = key.dsize + val.dsize; -X/* -X * is the pair too big (or too small) for this database ?? -X */ -X if (need < 0 || need > PAIRMAX) -X return errno = EINVAL, -1; -X -X if (getpage(db, (hash = exhash(key)))) { -X/* -X * if we need to replace, delete the key/data pair -X * first. If it is not there, ignore. -X */ -X if (flags == DBM_REPLACE) -X (void) delpair(db->pagbuf, key); -X#ifdef SEEDUPS -X else if (duppair(db->pagbuf, key)) -X return 1; -X#endif -X/* -X * if we do not have enough room, we have to split. -X */ -X if (!fitpair(db->pagbuf, need)) -X if (!makroom(db, hash, need)) -X return ioerr(db), -1; -X/* -X * we have enough room or split is successful. insert the key, -X * and update the page file. -X */ -X (void) putpair(db->pagbuf, key, val); -X -X if (lseek(db->pagf, OFF_PAG(db->pagbno), SEEK_SET) < 0 -X || write(db->pagf, db->pagbuf, PBLKSIZ) < 0) -X return ioerr(db), -1; -X /* -X * success -X */ -X return 0; -X } -X -X return ioerr(db), -1; -X} -X -X/* -X * makroom - make room by splitting the overfull page -X * this routine will attempt to make room for SPLTMAX times before -X * giving up. -X */ -Xstatic int -Xmakroom(db, hash, need) -Xregister DBM *db; -Xlong hash; -Xint need; -X{ -X long newp; -X char twin[PBLKSIZ]; -X char *pag = db->pagbuf; -X char *new = twin; -X register int smax = SPLTMAX; -X -X do { -X/* -X * split the current page -X */ -X (void) splpage(pag, new, db->hmask + 1); -X/* -X * address of the new page -X */ -X newp = (hash & db->hmask) | (db->hmask + 1); -X -X/* -X * write delay, read avoidence/cache shuffle: -X * select the page for incoming pair: if key is to go to the new page, -X * write out the previous one, and copy the new one over, thus making -X * it the current page. If not, simply write the new page, and we are -X * still looking at the page of interest. current page is not updated -X * here, as dbm_store will do so, after it inserts the incoming pair. -X */ -X if (hash & (db->hmask + 1)) { -X if (lseek(db->pagf, OFF_PAG(db->pagbno), SEEK_SET) < 0 -X || write(db->pagf, db->pagbuf, PBLKSIZ) < 0) -X return 0; -X db->pagbno = newp; -X (void) memcpy(pag, new, PBLKSIZ); -X } -X else if (lseek(db->pagf, OFF_PAG(newp), SEEK_SET) < 0 -X || write(db->pagf, new, PBLKSIZ) < 0) -X return 0; -X -X if (!setdbit(db, db->curbit)) -X return 0; -X/* -X * see if we have enough room now -X */ -X if (fitpair(pag, need)) -X return 1; -X/* -X * try again... update curbit and hmask as getpage would have -X * done. because of our update of the current page, we do not -X * need to read in anything. BUT we have to write the current -X * [deferred] page out, as the window of failure is too great. -X */ -X db->curbit = 2 * db->curbit + -X ((hash & (db->hmask + 1)) ? 2 : 1); -X db->hmask |= db->hmask + 1; -X -X if (lseek(db->pagf, OFF_PAG(db->pagbno), SEEK_SET) < 0 -X || write(db->pagf, db->pagbuf, PBLKSIZ) < 0) -X return 0; -X -X } while (--smax); -X/* -X * if we are here, this is real bad news. After SPLTMAX splits, -X * we still cannot fit the key. say goodnight. -X */ -X#ifdef BADMESS -X (void) write(2, "sdbm: cannot insert after SPLTMAX attempts.\n", 44); -X#endif -X return 0; -X -X} -X -X/* -X * the following two routines will break if -X * deletions aren't taken into account. (ndbm bug) -X */ -Xdatum -Xdbm_firstkey(db) -Xregister DBM *db; -X{ -X if (db == NULL) -X return errno = EINVAL, nullitem; -X/* -X * start at page 0 -X */ -X if (lseek(db->pagf, OFF_PAG(0), SEEK_SET) < 0 -X || read(db->pagf, db->pagbuf, PBLKSIZ) < 0) -X return ioerr(db), nullitem; -X db->pagbno = 0; -X db->blkptr = 0; -X db->keyptr = 0; -X -X return getnext(db); -X} -X -Xdatum -Xdbm_nextkey(db) -Xregister DBM *db; -X{ -X if (db == NULL) -X return errno = EINVAL, nullitem; -X return getnext(db); -X} -X -X/* -X * all important binary trie traversal -X */ -Xstatic int -Xgetpage(db, hash) -Xregister DBM *db; -Xregister long hash; -X{ -X register int hbit; -X register long dbit; -X register long pagb; -X -X dbit = 0; -X hbit = 0; -X while (dbit < db->maxbno && getdbit(db, dbit)) -X dbit = 2 * dbit + ((hash & (1 << hbit++)) ? 2 : 1); -X -X debug(("dbit: %d...", dbit)); -X -X db->curbit = dbit; -X db->hmask = masks[hbit]; -X -X pagb = hash & db->hmask; -X/* -X * see if the block we need is already in memory. -X * note: this lookaside cache has about 10% hit rate. -X */ -X if (pagb != db->pagbno) { -X/* -X * note: here, we assume a "hole" is read as 0s. -X * if not, must zero pagbuf first. -X */ -X if (lseek(db->pagf, OFF_PAG(pagb), SEEK_SET) < 0 -X || read(db->pagf, db->pagbuf, PBLKSIZ) < 0) -X return 0; -X if (!chkpage(db->pagbuf)) -X return 0; -X db->pagbno = pagb; -X -X debug(("pag read: %d\n", pagb)); -X } -X return 1; -X} -X -Xstatic int -Xgetdbit(db, dbit) -Xregister DBM *db; -Xregister long dbit; -X{ -X register long c; -X register long dirb; -X -X c = dbit / BYTESIZ; -X dirb = c / DBLKSIZ; -X -X if (dirb != db->dirbno) { -X if (lseek(db->dirf, OFF_DIR(dirb), SEEK_SET) < 0 -X || read(db->dirf, db->dirbuf, DBLKSIZ) < 0) -X return 0; -X db->dirbno = dirb; -X -X debug(("dir read: %d\n", dirb)); -X } -X -X return db->dirbuf[c % DBLKSIZ] & (1 << dbit % BYTESIZ); -X} -X -Xstatic int -Xsetdbit(db, dbit) -Xregister DBM *db; -Xregister long dbit; -X{ -X register long c; -X register long dirb; -X -X c = dbit / BYTESIZ; -X dirb = c / DBLKSIZ; -X -X if (dirb != db->dirbno) { -X if (lseek(db->dirf, OFF_DIR(dirb), SEEK_SET) < 0 -X || read(db->dirf, db->dirbuf, DBLKSIZ) < 0) -X return 0; -X db->dirbno = dirb; -X -X debug(("dir read: %d\n", dirb)); -X } -X -X db->dirbuf[c % DBLKSIZ] |= (1 << dbit % BYTESIZ); -X -X if (dbit >= db->maxbno) -X db->maxbno += DBLKSIZ * BYTESIZ; -X -X if (lseek(db->dirf, OFF_DIR(dirb), SEEK_SET) < 0 -X || write(db->dirf, db->dirbuf, DBLKSIZ) < 0) -X return 0; -X -X return 1; -X} -X -X/* -X * getnext - get the next key in the page, and if done with -X * the page, try the next page in sequence -X */ -Xstatic datum -Xgetnext(db) -Xregister DBM *db; -X{ -X datum key; -X -X for (;;) { -X db->keyptr++; -X key = getnkey(db->pagbuf, db->keyptr); -X if (key.dptr != NULL) -X return key; -X/* -X * we either run out, or there is nothing on this page.. -X * try the next one... If we lost our position on the -X * file, we will have to seek. -X */ -X db->keyptr = 0; -X if (db->pagbno != db->blkptr++) -X if (lseek(db->pagf, OFF_PAG(db->blkptr), SEEK_SET) < 0) -X break; -X db->pagbno = db->blkptr; -X if (read(db->pagf, db->pagbuf, PBLKSIZ) <= 0) -X break; -X if (!chkpage(db->pagbuf)) -X break; -X } -X -X return ioerr(db), nullitem; -X} -END_OF_FILE -if test 11029 -ne `wc -c <'sdbm.c'`; then - echo shar: \"'sdbm.c'\" unpacked with wrong size! -fi -# end of 'sdbm.c' -fi -if test -f 'sdbm.h' -a "${1}" != "-c" ; then - echo shar: Will not clobber existing file \"'sdbm.h'\" -else -echo shar: Extracting \"'sdbm.h'\" \(2174 characters\) -sed "s/^X//" >'sdbm.h' <<'END_OF_FILE' -X/* -X * sdbm - ndbm work-alike hashed database library -X * based on Per-Ake Larson's Dynamic Hashing algorithms. BIT 18 (1978). -X * author: oz@nexus.yorku.ca -X * status: public domain. -X */ -X#define DBLKSIZ 4096 -X#define PBLKSIZ 1024 -X#define PAIRMAX 1008 /* arbitrary on PBLKSIZ-N */ -X#define SPLTMAX 10 /* maximum allowed splits */ -X /* for a single insertion */ -X#define DIRFEXT ".dir" -X#define PAGFEXT ".pag" -X -Xtypedef struct { -X int dirf; /* directory file descriptor */ -X int pagf; /* page file descriptor */ -X int flags; /* status/error flags, see below */ -X long maxbno; /* size of dirfile in bits */ -X long curbit; /* current bit number */ -X long hmask; /* current hash mask */ -X long blkptr; /* current block for nextkey */ -X int keyptr; /* current key for nextkey */ -X long blkno; /* current page to read/write */ -X long pagbno; /* current page in pagbuf */ -X char pagbuf[PBLKSIZ]; /* page file block buffer */ -X long dirbno; /* current block in dirbuf */ -X char dirbuf[DBLKSIZ]; /* directory file block buffer */ -X} DBM; -X -X#define DBM_RDONLY 0x1 /* data base open read-only */ -X#define DBM_IOERR 0x2 /* data base I/O error */ -X -X/* -X * utility macros -X */ -X#define dbm_rdonly(db) ((db)->flags & DBM_RDONLY) -X#define dbm_error(db) ((db)->flags & DBM_IOERR) -X -X#define dbm_clearerr(db) ((db)->flags &= ~DBM_IOERR) /* ouch */ -X -X#define dbm_dirfno(db) ((db)->dirf) -X#define dbm_pagfno(db) ((db)->pagf) -X -Xtypedef struct { -X char *dptr; -X int dsize; -X} datum; -X -Xextern datum nullitem; -X -X#ifdef __STDC__ -X#define proto(p) p -X#else -X#define proto(p) () -X#endif -X -X/* -X * flags to dbm_store -X */ -X#define DBM_INSERT 0 -X#define DBM_REPLACE 1 -X -X/* -X * ndbm interface -X */ -Xextern DBM *dbm_open proto((char *, int, int)); -Xextern void dbm_close proto((DBM *)); -Xextern datum dbm_fetch proto((DBM *, datum)); -Xextern int dbm_delete proto((DBM *, datum)); -Xextern int dbm_store proto((DBM *, datum, datum, int)); -Xextern datum dbm_firstkey proto((DBM *)); -Xextern datum dbm_nextkey proto((DBM *)); -X -X/* -X * other -X */ -Xextern DBM *dbm_prep proto((char *, char *, int, int)); -Xextern long dbm_hash proto((char *, int)); -END_OF_FILE -if test 2174 -ne `wc -c <'sdbm.h'`; then - echo shar: \"'sdbm.h'\" unpacked with wrong size! -fi -# end of 'sdbm.h' -fi -if test -f 'tune.h' -a "${1}" != "-c" ; then - echo shar: Will not clobber existing file \"'tune.h'\" -else -echo shar: Extracting \"'tune.h'\" \(665 characters\) -sed "s/^X//" >'tune.h' <<'END_OF_FILE' -X/* -X * sdbm - ndbm work-alike hashed database library -X * tuning and portability constructs [not nearly enough] -X * author: oz@nexus.yorku.ca -X */ -X -X#define BYTESIZ 8 -X -X#ifdef SVID -X#include -X#endif -X -X#ifdef BSD42 -X#define SEEK_SET L_SET -X#define memset(s,c,n) bzero(s, n) /* only when c is zero */ -X#define memcpy(s1,s2,n) bcopy(s2, s1, n) -X#define memcmp(s1,s2,n) bcmp(s1,s2,n) -X#endif -X -X/* -X * important tuning parms (hah) -X */ -X -X#define SEEDUPS /* always detect duplicates */ -X#define BADMESS /* generate a message for worst case: -X cannot make room after SPLTMAX splits */ -X/* -X * misc -X */ -X#ifdef DEBUG -X#define debug(x) printf x -X#else -X#define debug(x) -X#endif -END_OF_FILE -if test 665 -ne `wc -c <'tune.h'`; then - echo shar: \"'tune.h'\" unpacked with wrong size! -fi -# end of 'tune.h' -fi -if test -f 'util.c' -a "${1}" != "-c" ; then - echo shar: Will not clobber existing file \"'util.c'\" -else -echo shar: Extracting \"'util.c'\" \(767 characters\) -sed "s/^X//" >'util.c' <<'END_OF_FILE' -X#include -X#ifdef SDBM -X#include "sdbm.h" -X#else -X#include "ndbm.h" -X#endif -X -Xvoid -Xoops(s1, s2) -Xregister char *s1; -Xregister char *s2; -X{ -X extern int errno, sys_nerr; -X extern char *sys_errlist[]; -X extern char *progname; -X -X if (progname) -X fprintf(stderr, "%s: ", progname); -X fprintf(stderr, s1, s2); -X if (errno > 0 && errno < sys_nerr) -X fprintf(stderr, " (%s)", sys_errlist[errno]); -X fprintf(stderr, "\n"); -X exit(1); -X} -X -Xint -Xokpage(pag) -Xchar *pag; -X{ -X register unsigned n; -X register off; -X register short *ino = (short *) pag; -X -X if ((n = ino[0]) > PBLKSIZ / sizeof(short)) -X return 0; -X -X if (!n) -X return 1; -X -X off = PBLKSIZ; -X for (ino++; n; ino += 2) { -X if (ino[0] > off || ino[1] > off || -X ino[1] > ino[0]) -X return 0; -X off = ino[1]; -X n -= 2; -X } -X -X return 1; -X} -END_OF_FILE -if test 767 -ne `wc -c <'util.c'`; then - echo shar: \"'util.c'\" unpacked with wrong size! -fi -# end of 'util.c' -fi -echo shar: End of shell archive. -exit 0 diff --git a/ext/dbm/sdbm/Makefile b/ext/dbm/sdbm/Makefile deleted file mode 100755 index 80b09cd..0000000 --- a/ext/dbm/sdbm/Makefile +++ /dev/null @@ -1,47 +0,0 @@ -# -# This Makefile is for the library part of sdbm. For the -# Full package, see makefile.sdbm. -# -# Makefile for public domain ndbm-clone: sdbm -# DUFF: use duff's device (loop unroll) in parts of the code -# -# -CC = cc -ranlib = /usr/bin/ranlib -TOP = ../../.. -LDFLAGS = -CLDFLAGS = -SMALL = -LARGE = - -# To use an alternate make, set in config.sh. -MAKE = make - -SHELL = /bin/sh -CCCMD = `sh $(shellflags) $(TOP)/cflags $@` - -.c.o: - $(CCCMD) -I$(TOP) -DSDBM -DDUFF $*.c - -LIBOBJS = sdbm.o pair.o hash.o -LIBSRCS = sdbm.c pair.c hash.c -HDRS = tune.h sdbm.h pair.h $(TOP)/config.h - -libsdbm.a: $(LIBOBJS) - ar cr libsdbm.a $(LIBOBJS) - $(ranlib) libsdbm.a - -$(LIBOBJS): $(HDRS) - -lint: - lint -abchx $(LIBSRCS) - -clean: - rm -f *.o *.a mon.out core - -realclean: clean - rm -f dbu libsdbm.a dbd dba dbe x-dbu *.dir *.pag - rm -f makefile Makefile - -purge: realclean - diff --git a/ext/dbm/sdbm/Makefile.SH b/ext/dbm/sdbm/Makefile.SH deleted file mode 100644 index 9a19fa2..0000000 --- a/ext/dbm/sdbm/Makefile.SH +++ /dev/null @@ -1,80 +0,0 @@ -if test -f config.sh; then TOP=.; -elif test -f ../config.sh; then TOP=..; -elif test -f ../../config.sh; then TOP=../..; -elif test -f ../../../config.sh; then TOP=../../..; -elif test -f ../../../../config.sh; then TOP=../../../..; -else - echo "Can't find config.sh."; exit 1 -fi -case $CONFIG in -'') - . $TOP/config.sh - ;; -esac -: This forces SH files to create target in same directory as SH file. -: This is so that make depend always knows where to find SH derivatives. - -case "$0" in -*/*) cd `expr X$0 : 'X\(.*\)/'` ;; -esac - -echo "Extracting ext/dbm/sdbm/Makefile (with variable substitutions)" -: This section of the file will have variable substitutions done on it. -: Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!. -: Protect any dollar signs and backticks that you do not want interpreted -: by putting a backslash in front. You may delete these comments. -$spitshell >Makefile <>Makefile <<'!NO!SUBS!' -SHELL = /bin/sh -CCCMD = `sh $(shellflags) $(TOP)/cflags $@` - -.c.o: - $(CCCMD) -I$(TOP) -DSDBM -DDUFF $*.c - -LIBOBJS = sdbm.o pair.o hash.o -LIBSRCS = sdbm.c pair.c hash.c -HDRS = tune.h sdbm.h pair.h $(TOP)/config.h - -libsdbm.a: $(LIBOBJS) - ar cr libsdbm.a $(LIBOBJS) - $(ranlib) libsdbm.a - -$(LIBOBJS): $(HDRS) - -lint: - lint -abchx $(LIBSRCS) - -clean: - rm -f *.o *.a mon.out core - -realclean: clean - rm -f dbu libsdbm.a dbd dba dbe x-dbu *.dir *.pag - rm -f makefile Makefile - -purge: realclean - -!NO!SUBS! -chmod 755 Makefile -$eunicefix Makefile diff --git a/ext/dbm/sdbm/libsdbm.a b/ext/dbm/sdbm/libsdbm.a deleted file mode 100644 index baf4b73..0000000 Binary files a/ext/dbm/sdbm/libsdbm.a and /dev/null differ diff --git a/ext/dbm/sdbm/libsdbm_pure_q552_110.a b/ext/dbm/sdbm/libsdbm_pure_q552_110.a deleted file mode 100644 index 3b426e8..0000000 Binary files a/ext/dbm/sdbm/libsdbm_pure_q552_110.a and /dev/null differ diff --git a/ext/dbm/sdbm/makefile b/ext/dbm/sdbm/makefile deleted file mode 100644 index c959c1f..0000000 --- a/ext/dbm/sdbm/makefile +++ /dev/null @@ -1,55 +0,0 @@ -# -# makefile for public domain ndbm-clone: sdbm -# DUFF: use duff's device (loop unroll) in parts of the code -# -CFLAGS = -O -DSDBM -DDUFF -DBSD42 -pic -#LDFLAGS = -p - -OBJS = sdbm.o pair.o hash.o -SRCS = sdbm.c pair.c hash.c dbu.c dba.c dbd.c util.c -HDRS = tune.h sdbm.h pair.h -MISC = README CHANGES COMPARE sdbm.3 dbe.c dbe.1 dbm.c dbm.h biblio \ - readme.ms readme.ps - -all: dbu dba dbd dbe - -dbu: dbu.o sdbm util.o - cc $(LDFLAGS) -o dbu dbu.o util.o libsdbm.a - -dba: dba.o util.o - cc $(LDFLAGS) -o dba dba.o util.o -dbd: dbd.o util.o - cc $(LDFLAGS) -o dbd dbd.o util.o -dbe: dbe.o sdbm - cc $(LDFLAGS) -o dbe dbe.o libsdbm.a - -sdbm: $(OBJS) - ar cr libsdbm.a $(OBJS) - ranlib libsdbm.a -### cp libsdbm.a /usr/lib/libsdbm.a - -dba.o: sdbm.h -dbu.o: sdbm.h -util.o:sdbm.h - -$(OBJS): sdbm.h tune.h pair.h - -# -# dbu using berkelezoid ndbm routines [if you have them] for testing -# -#x-dbu: dbu.o util.o -# cc $(CFLAGS) -o x-dbu dbu.o util.o -lint: - lint -abchx $(SRCS) - -clean: - rm -f *.o mon.out core - -purge: clean - rm -f dbu libsdbm.a dbd dba dbe x-dbu *.dir *.pag - -shar: - shar $(MISC) makefile $(SRCS) $(HDRS) >SDBM.SHAR - -readme: - nroff -ms readme.ms | col -b >README diff --git a/ext/dbm/sdbm/pair.c b/ext/dbm/sdbm/pair.c deleted file mode 100644 index 575b34c..0000000 --- a/ext/dbm/sdbm/pair.c +++ /dev/null @@ -1,305 +0,0 @@ -/* - * sdbm - ndbm work-alike hashed database library - * based on Per-Aake Larson's Dynamic Hashing algorithms. BIT 18 (1978). - * author: oz@nexus.yorku.ca - * status: public domain. - * - * page-level routines - */ - -#ifndef lint -static char rcsid[] = "$Id: pair.c,v 1.10 90/12/13 13:00:35 oz Exp $"; -#endif - -#include "config.h" -#include "sdbm.h" -#include "tune.h" -#include "pair.h" - -#define exhash(item) sdbm_hash((item).dptr, (item).dsize) - -/* - * forward - */ -static int seepair proto((char *, int, char *, int)); - -/* - * page format: - * +------------------------------+ - * ino | n | keyoff | datoff | keyoff | - * +------------+--------+--------+ - * | datoff | - - - ----> | - * +--------+---------------------+ - * | F R E E A R E A | - * +--------------+---------------+ - * | <---- - - - | data | - * +--------+-----+----+----------+ - * | key | data | key | - * +--------+----------+----------+ - * - * calculating the offsets for free area: if the number - * of entries (ino[0]) is zero, the offset to the END of - * the free area is the block size. Otherwise, it is the - * nth (ino[ino[0]]) entry's offset. - */ - -int -fitpair(pag, need) -char *pag; -int need; -{ - register int n; - register int off; - register int free; - register short *ino = (short *) pag; - - off = ((n = ino[0]) > 0) ? ino[n] : PBLKSIZ; - free = off - (n + 1) * sizeof(short); - need += 2 * sizeof(short); - - debug(("free %d need %d\n", free, need)); - - return need <= free; -} - -void -putpair(pag, key, val) -char *pag; -datum key; -datum val; -{ - register int n; - register int off; - register short *ino = (short *) pag; - - off = ((n = ino[0]) > 0) ? ino[n] : PBLKSIZ; -/* - * enter the key first - */ - off -= key.dsize; - (void) memcpy(pag + off, key.dptr, key.dsize); - ino[n + 1] = off; -/* - * now the data - */ - off -= val.dsize; - (void) memcpy(pag + off, val.dptr, val.dsize); - ino[n + 2] = off; -/* - * adjust item count - */ - ino[0] += 2; -} - -datum -getpair(pag, key) -char *pag; -datum key; -{ - register int i; - register int n; - datum val; - register short *ino = (short *) pag; - - if ((n = ino[0]) == 0) - return nullitem; - - if ((i = seepair(pag, n, key.dptr, key.dsize)) == 0) - return nullitem; - - val.dptr = pag + ino[i + 1]; - val.dsize = ino[i] - ino[i + 1]; - return val; -} - -#ifdef SEEDUPS -int -duppair(pag, key) -char *pag; -datum key; -{ - register short *ino = (short *) pag; - return ino[0] > 0 && seepair(pag, ino[0], key.dptr, key.dsize) > 0; -} -#endif - -datum -getnkey(pag, num) -char *pag; -int num; -{ - datum key; - register int off; - register short *ino = (short *) pag; - - num = num * 2 - 1; - if (ino[0] == 0 || num > ino[0]) - return nullitem; - - off = (num > 1) ? ino[num - 1] : PBLKSIZ; - - key.dptr = pag + ino[num]; - key.dsize = off - ino[num]; - - return key; -} - -int -delpair(pag, key) -char *pag; -datum key; -{ - register int n; - register int i; - register short *ino = (short *) pag; - - if ((n = ino[0]) == 0) - return 0; - - if ((i = seepair(pag, n, key.dptr, key.dsize)) == 0) - return 0; -/* - * found the key. if it is the last entry - * [i.e. i == n - 1] we just adjust the entry count. - * hard case: move all data down onto the deleted pair, - * shift offsets onto deleted offsets, and adjust them. - * [note: 0 < i < n] - */ - if (i < n - 1) { - register int m; - register char *dst = pag + (i == 1 ? PBLKSIZ : ino[i - 1]); - register char *src = pag + ino[i + 1]; - register int zoo = dst - src; - - debug(("free-up %d ", zoo)); -/* - * shift data/keys down - */ - m = ino[i + 1] - ino[n]; -#ifdef DUFF -#define MOVB *--dst = *--src - - if (m > 0) { - register int loop = (m + 8 - 1) >> 3; - - switch (m & (8 - 1)) { - case 0: do { - MOVB; case 7: MOVB; - case 6: MOVB; case 5: MOVB; - case 4: MOVB; case 3: MOVB; - case 2: MOVB; case 1: MOVB; - } while (--loop); - } - } -#else -#ifdef HAS_MEMMOVE - memmove(dst, src, m); -#else - while (m--) - *--dst = *--src; -#endif -#endif -/* - * adjust offset index up - */ - while (i < n - 1) { - ino[i] = ino[i + 2] + zoo; - i++; - } - } - ino[0] -= 2; - return 1; -} - -/* - * search for the key in the page. - * return offset index in the range 0 < i < n. - * return 0 if not found. - */ -static int -seepair(pag, n, key, siz) -char *pag; -register int n; -register char *key; -register int siz; -{ - register int i; - register int off = PBLKSIZ; - register short *ino = (short *) pag; - - for (i = 1; i < n; i += 2) { - if (siz == off - ino[i] && - memcmp(key, pag + ino[i], siz) == 0) - return i; - off = ino[i + 1]; - } - return 0; -} - -void -splpage(pag, new, sbit) -char *pag; -char *new; -long sbit; -{ - datum key; - datum val; - - register int n; - register int off = PBLKSIZ; - char cur[PBLKSIZ]; - register short *ino = (short *) cur; - - (void) memcpy(cur, pag, PBLKSIZ); - (void) memset(pag, 0, PBLKSIZ); - (void) memset(new, 0, PBLKSIZ); - - n = ino[0]; - for (ino++; n > 0; ino += 2) { - key.dptr = cur + ino[0]; - key.dsize = off - ino[0]; - val.dptr = cur + ino[1]; - val.dsize = ino[0] - ino[1]; -/* - * select the page pointer (by looking at sbit) and insert - */ - (void) putpair((exhash(key) & sbit) ? new : pag, key, val); - - off = ino[1]; - n -= 2; - } - - debug(("%d split %d/%d\n", ((short *) cur)[0] / 2, - ((short *) new)[0] / 2, - ((short *) pag)[0] / 2)); -} - -/* - * check page sanity: - * number of entries should be something - * reasonable, and all offsets in the index should be in order. - * this could be made more rigorous. - */ -int -chkpage(pag) -char *pag; -{ - register int n; - register int off; - register short *ino = (short *) pag; - - if ((n = ino[0]) < 0 || n > PBLKSIZ / sizeof(short)) - return 0; - - if (n > 0) { - off = PBLKSIZ; - for (ino++; n > 0; ino += 2) { - if (ino[0] > off || ino[1] > off || - ino[1] > ino[0]) - return 0; - off = ino[1]; - n -= 2; - } - } - return 1; -} diff --git a/ext/dbm/sdbm/sdbm.h b/ext/dbm/sdbm/sdbm.h deleted file mode 100644 index f94b054..0000000 --- a/ext/dbm/sdbm/sdbm.h +++ /dev/null @@ -1,241 +0,0 @@ -/* - * sdbm - ndbm work-alike hashed database library - * based on Per-Ake Larson's Dynamic Hashing algorithms. BIT 18 (1978). - * author: oz@nexus.yorku.ca - * status: public domain. - */ -#define DBLKSIZ 4096 -#define PBLKSIZ 1024 -#define PAIRMAX 1008 /* arbitrary on PBLKSIZ-N */ -#define SPLTMAX 10 /* maximum allowed splits */ - /* for a single insertion */ -#define DIRFEXT ".dir" -#define PAGFEXT ".pag" - -typedef struct { - int dirf; /* directory file descriptor */ - int pagf; /* page file descriptor */ - int flags; /* status/error flags, see below */ - long maxbno; /* size of dirfile in bits */ - long curbit; /* current bit number */ - long hmask; /* current hash mask */ - long blkptr; /* current block for nextkey */ - int keyptr; /* current key for nextkey */ - long blkno; /* current page to read/write */ - long pagbno; /* current page in pagbuf */ - char pagbuf[PBLKSIZ]; /* page file block buffer */ - long dirbno; /* current block in dirbuf */ - char dirbuf[DBLKSIZ]; /* directory file block buffer */ -} DBM; - -#define DBM_RDONLY 0x1 /* data base open read-only */ -#define DBM_IOERR 0x2 /* data base I/O error */ - -/* - * utility macros - */ -#define sdbm_rdonly(db) ((db)->flags & DBM_RDONLY) -#define sdbm_error(db) ((db)->flags & DBM_IOERR) - -#define sdbm_clearerr(db) ((db)->flags &= ~DBM_IOERR) /* ouch */ - -#define sdbm_dirfno(db) ((db)->dirf) -#define sdbm_pagfno(db) ((db)->pagf) - -typedef struct { - char *dptr; - int dsize; -} datum; - -extern datum nullitem; - -#ifdef __STDC__ -#define proto(p) p -#else -#define proto(p) () -#endif - -/* - * flags to sdbm_store - */ -#define DBM_INSERT 0 -#define DBM_REPLACE 1 - -/* - * ndbm interface - */ -extern DBM *sdbm_open proto((char *, int, int)); -extern void sdbm_close proto((DBM *)); -extern datum sdbm_fetch proto((DBM *, datum)); -extern int sdbm_delete proto((DBM *, datum)); -extern int sdbm_store proto((DBM *, datum, datum, int)); -extern datum sdbm_firstkey proto((DBM *)); -extern datum sdbm_nextkey proto((DBM *)); - -/* - * other - */ -extern DBM *sdbm_prep proto((char *, char *, int, int)); -extern long sdbm_hash proto((char *, int)); - -#ifndef SDBM_ONLY -#define dbm_open sdbm_open; -#define dbm_close sdbm_close; -#define dbm_fetch sdbm_fetch; -#define dbm_store sdbm_store; -#define dbm_delete sdbm_delete; -#define dbm_firstkey sdbm_firstkey; -#define dbm_nextkey sdbm_nextkey; -#define dbm_error sdbm_error; -#define dbm_clearerr sdbm_clearerr; -#endif - -/* Most of the following is stolen from perl.h. */ -#ifndef H_PERL /* Include guard */ - -/* - * The following contortions are brought to you on behalf of all the - * standards, semi-standards, de facto standards, not-so-de-facto standards - * of the world, as well as all the other botches anyone ever thought of. - * The basic theory is that if we work hard enough here, the rest of the - * code can be a lot prettier. Well, so much for theory. Sorry, Henry... - */ - -#include -#ifdef HAS_SOCKET -# ifdef I_NET_ERRNO -# include -# endif -#endif - -#ifdef MYMALLOC -# ifdef HIDEMYMALLOC -# define malloc Mymalloc -# define realloc Myremalloc -# define free Myfree -# endif -# define safemalloc malloc -# define saferealloc realloc -# define safefree free -#endif - -#if defined(__STDC__) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus) -# define STANDARD_C 1 -#endif - -#if defined(STANDARD_C) -# define P(args) args -#else -# define P(args) () -#endif - -#include -#include -#include - -#ifdef I_UNISTD -#include -#endif - -#ifndef MSDOS -# ifdef PARAM_NEEDS_TYPES -# include -# endif -# include -#endif - -#ifndef _TYPES_ /* If types.h defines this it's easy. */ -# ifndef major /* Does everyone's types.h define this? */ -# include -# endif -#endif - -#ifdef I_UNISTD -#include -#endif - -#include - -#ifndef SEEK_SET -# ifdef L_SET -# define SEEK_SET L_SET -# else -# define SEEK_SET 0 /* Wild guess. */ -# endif -#endif - -/* Use all the "standard" definitions? */ -#ifdef STANDARD_C -# include -# ifdef I_STRING -# include -# endif -# define MEM_SIZE size_t -#else -# ifdef I_MEMORY -# include -# endif - typedef unsigned int MEM_SIZE; -#endif /* STANDARD_C */ - -#if defined(HAS_MEMCMP) && defined(mips) && defined(ultrix) -# undef HAS_MEMCMP -#endif - -#ifdef HAS_MEMCPY -# if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY) -# ifndef memcpy - extern char * memcpy P((char*, char*, int)); -# endif -# endif -#else -# ifndef memcpy -# ifdef HAS_BCOPY -# define memcpy(d,s,l) bcopy(s,d,l) -# else -# define memcpy(d,s,l) my_bcopy(s,d,l) -# endif -# endif -#endif /* HAS_MEMCPY */ - -#ifdef HAS_MEMSET -# if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY) -# ifndef memset - extern char *memset P((char*, int, int)); -# endif -# endif -# define memzero(d,l) memset(d,0,l) -#else -# ifndef memzero -# ifdef HAS_BZERO -# define memzero(d,l) bzero(d,l) -# else -# define memzero(d,l) my_bzero(d,l) -# endif -# endif -#endif /* HAS_MEMSET */ - -#ifdef HAS_MEMCMP -# if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY) -# ifndef memcmp - extern int memcmp P((char*, char*, int)); -# endif -# endif -#else -# ifndef memcmp -# define memcmp(s1,s2,l) my_memcmp(s1,s2,l) -# endif -#endif /* HAS_MEMCMP */ - -/* we prefer bcmp slightly for comparisons that don't care about ordering */ -#ifndef HAS_BCMP -# ifndef bcmp -# define bcmp(s1,s2,l) memcmp(s1,s2,l) -# endif -#endif /* HAS_BCMP */ - -#ifdef I_NETINET_IN -# include -#endif - -#endif /* Include guard */ diff --git a/ext/dl/dl.c b/ext/dl/dl.c deleted file mode 100644 index d514f81..0000000 --- a/ext/dl/dl.c +++ /dev/null @@ -1,54 +0,0 @@ -#include - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -static int -XS_DynamicLoader_bootstrap(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items < 1 || items > 1) { - croak("Usage: DynamicLoader::bootstrap(package)"); - } - { - char* package = SvPV(ST(1),na); - void* obj = 0; - int (*bootproc)(); - char tmpbuf[1024]; - char tmpbuf2[128]; - AV *av = GvAVn(incgv); - I32 i; - - for (i = 0; i <= AvFILL(av); i++) { - (void)sprintf(tmpbuf, "%s/auto/%s/%s.so", - SvPVx(*av_fetch(av, i, TRUE), na), package, package); - if (obj = dlopen(tmpbuf,1)) - break; - } - if (!obj) - croak("Can't find loadable object for package %s in @INC", package); - - sprintf(tmpbuf2, "boot_%s", package); - bootproc = (int (*)())dlsym(obj, tmpbuf2); - if (!bootproc) - croak("Shared object %s contains no %s function", tmpbuf, tmpbuf2); - bootproc(); - - ST(0) = sv_mortalcopy(&sv_yes); - } - return ax; -} - -int -boot_DynamicLoader(ix,sp,items) -int ix; -int sp; -int items; -{ - char* file = __FILE__; - - newXSUB("DynamicLoader::bootstrap", 0, XS_DynamicLoader_bootstrap, file); -} diff --git a/ext/dl/dl_hpux.c b/ext/dl/dl_hpux.c deleted file mode 100644 index 57adcc6..0000000 --- a/ext/dl/dl_hpux.c +++ /dev/null @@ -1,71 +0,0 @@ -/* -Date: Mon, 25 Apr 94 14:15:30 PDT -From: Jeff Okamoto -To: doughera@lafcol.lafayette.edu -Cc: okamoto@hpcc101.corp.hp.com, Jarkko.Hietaniemi@hut.fi, ram@acri.fr, - john@WPI.EDU, k@franz.ww.TU-Berlin.DE, dmm0t@rincewind.mech.virginia.edu, - lwall@netlabs.com -Subject: dl.c.hpux - -This is what I hacked around and came up with for HP-UX. (Or maybe it should -be called dl_hpux.c). Notice the change in suffix from .so to .sl (the -default suffix for HP-UX shared libraries). - -Jeff -*/ -#include - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -static int -XS_DynamicLoader_bootstrap(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items < 1 || items > 1) { - croak("Usage: DynamicLoader::bootstrap(package)"); - } - { - char* package = SvPV(ST(1),na); - shl_t obj = NULL; - int (*bootproc)(); - char tmpbuf[1024]; - char tmpbuf2[128]; - AV *av = GvAVn(incgv); - I32 i; - - for (i = 0; i <= AvFILL(av); i++) { - (void)sprintf(tmpbuf, "%s/auto/%s/%s.sl", - SvPVx(*av_fetch(av, i, TRUE), na), package, package); - if (obj = shl_load(tmpbuf, - BIND_IMMEDIATE | BIND_NONFATAL | BIND_NOSTART,0L)) - break; - } - if (obj != (shl_t) NULL) - croak("Can't find loadable object for package %s in @INC", package); - - sprintf(tmpbuf2, "boot_%s", package); - i = shl_findsym(&obj, tmpbuf2, TYPE_PROCEDURE, &bootproc); - if (i == -1) - croak("Shared object %s contains no %s function", tmpbuf, tmpbuf2); - bootproc(); - - ST(0) = sv_mortalcopy(&sv_yes); - } - return ax; -} - -int -boot_DynamicLoader(ix,sp,items) -int ix; -int sp; -int items; -{ - char* file = __FILE__; - - newXSUB("DynamicLoader::bootstrap", 0, XS_DynamicLoader_bootstrap, file); -} - diff --git a/ext/dl/dl_next.c b/ext/dl/dl_next.c deleted file mode 100644 index 66e9512..0000000 --- a/ext/dl/dl_next.c +++ /dev/null @@ -1,69 +0,0 @@ -/* dl_next.c - Author: tom@smart.bo.open.de (Thomas Neumann). - Based on dl_sunos.c -*/ -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#include -#include - -static int -XS_DynamicLoader_bootstrap(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items < 1 || items > 1) { - croak("Usage: DynamicLoader::bootstrap(package)"); - } - { - char* package = SvPV(ST(1),na); - int rld_success; - NXStream *nxerr = NXOpenFile(fileno(stderr), NX_READONLY); - int (*bootproc)(); - char tmpbuf[1024]; - char tmpbuf2[128]; - AV *av = GvAVn(incgv); - I32 i; - - for (i = 0; i <= AvFILL(av); i++) { - char *p[2]; - p[0] = tmpbuf; - p[1] = 0; - sprintf(tmpbuf, "%s/auto/%s/%s.so", - SvPVx(*av_fetch(av, i, TRUE), na), package, package); - if (rld_success = rld_load(nxerr, (struct mach_header **)0, p, - (const char *)0)) - { - break; - } - } - if (!rld_success) { - NXClose(nxerr); - croak("Can't find loadable object for package %s in @INC", package); - - } - sprintf(tmpbuf2, "_boot_%s", package); - if (!rld_lookup(nxerr, tmpbuf2, (unsigned long *)&bootproc)) { - NXClose(nxerr); - croak("Shared object %s contains no %s function", tmpbuf, tmpbuf2); - } - NXClose(nxerr); - (*bootproc)(); - ST(0) = sv_mortalcopy(&sv_yes); - } - return ax; -} - -int -boot_DynamicLoader(ix,sp,items) -int ix; -int sp; -int items; -{ - char* file = __FILE__; - - newXSUB("DynamicLoader::bootstrap", 0, XS_DynamicLoader_bootstrap, file); -} diff --git a/ext/dl/dl_sunos.c b/ext/dl/dl_sunos.c deleted file mode 100644 index badd66d..0000000 --- a/ext/dl/dl_sunos.c +++ /dev/null @@ -1,56 +0,0 @@ -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#ifdef I_DLFCN -# include -#endif - -static int -XS_DynamicLoader_bootstrap(ix, ax, items) -register int ix; -register int ax; -register int items; -{ - if (items < 1 || items > 1) { - croak("Usage: DynamicLoader::bootstrap(package)"); - } - { - char* package = SvPV(ST(1),na); - void* obj = 0; - int (*bootproc)(); - char tmpbuf[1024]; - char tmpbuf2[128]; - AV *av = GvAVn(incgv); - I32 i; - - for (i = 0; i <= AvFILL(av); i++) { - (void)sprintf(tmpbuf, "%s/auto/%s/%s.so", - SvPVx(*av_fetch(av, i, TRUE), na), package, package); - if (obj = dlopen(tmpbuf,1)) - break; - } - if (!obj) - croak("Can't find loadable object for package %s in @INC", package); - - sprintf(tmpbuf2, "boot_%s", package); - bootproc = (int (*)())dlsym(obj, tmpbuf2); - if (!bootproc) - croak("Shared object %s contains no %s function", tmpbuf, tmpbuf2); - bootproc(); - - ST(0) = sv_mortalcopy(&sv_yes); - } - return ax; -} - -int -boot_DynamicLoader(ix,sp,items) -int ix; -int sp; -int items; -{ - char* file = __FILE__; - - newXSUB("DynamicLoader::bootstrap", 0, XS_DynamicLoader_bootstrap, file); -} diff --git a/ext/dl/eg/Makefile b/ext/dl/eg/Makefile deleted file mode 100644 index d1ae210..0000000 --- a/ext/dl/eg/Makefile +++ /dev/null @@ -1,20 +0,0 @@ -CC = /vol/apps/lucid-3.1/lcc - -all: main test test1 -main: main.c - $(CC) -g -o main main.c -ldl - -test.o: test.c - $(CC) -g -pic -c test.c - -test: test.o - ld -o test -assert pure-text test.o - -test1.o: test1.c - $(CC) -g -pic -c test1.c - -test1: test1.o - ld -o test1 -assert pure-text test1.o - -clean: - /bin/rm -f *.o test test1 main diff --git a/ext/dl/eg/Makefile.att b/ext/dl/eg/Makefile.att deleted file mode 100644 index 435b916..0000000 --- a/ext/dl/eg/Makefile.att +++ /dev/null @@ -1,18 +0,0 @@ -all: main test test1 -main: main.c - cc -g -o main main.c -ldl - -test.o: test.c - cc -g -pic -c test.c - -test: test.o - cc -o test -G test.o - -test1.o: test1.c - cc -g -pic -c test1.c - -test1: test1.o - cc -o test1 -G test1.o - -clean: - /bin/rm -f *.o test test1 main diff --git a/ext/dl/eg/main.c b/ext/dl/eg/main.c deleted file mode 100644 index ac01554..0000000 --- a/ext/dl/eg/main.c +++ /dev/null @@ -1,28 +0,0 @@ -#include -#include - -main(argc, argv, arge) -int argc; -char **argv; -char **arge; -{ - void *obj; - void (*proc)(); - void *obj1; - void (*proc1)(); - - if (!(obj = dlopen("test", 1))) - fprintf(stderr, "%s\n", dlerror()); - if (!(obj1 = dlopen("test1", 1))) - fprintf(stderr, "%s\n", dlerror()); - proc = (void (*)())dlsym(obj, "test"); - proc1 = (void (*)())dlsym(obj1, "test1"); - proc(); - proc1(); - dlclose(obj); -} - -void print() -{ - printf("got here!\n"); -} diff --git a/ext/dl/eg/test b/ext/dl/eg/test deleted file mode 100755 index 2a8b925..0000000 Binary files a/ext/dl/eg/test and /dev/null differ diff --git a/ext/dl/eg/test.c b/ext/dl/eg/test.c deleted file mode 100644 index a66db19..0000000 --- a/ext/dl/eg/test.c +++ /dev/null @@ -1,4 +0,0 @@ -test() -{ - print(); -} diff --git a/ext/dl/eg/test1 b/ext/dl/eg/test1 deleted file mode 100755 index e9a37e9..0000000 Binary files a/ext/dl/eg/test1 and /dev/null differ diff --git a/ext/dl/eg/test1.c b/ext/dl/eg/test1.c deleted file mode 100644 index fc7b1b2..0000000 --- a/ext/dl/eg/test1.c +++ /dev/null @@ -1,11 +0,0 @@ -#include - -test1() -{ - void *obj; - void (*proc)(); - - obj = dlopen("test", 1); - proc = (void (*)())dlsym(obj, "test"); - proc(); -} diff --git a/ext/man2mus b/ext/man2mus deleted file mode 100644 index a304678..0000000 --- a/ext/man2mus +++ /dev/null @@ -1,66 +0,0 @@ -#!/usr/bin/perl -while (<>) { - if (/^\.SH SYNOPSIS/) { - $spec = ''; - for ($_ = <>; $_ && !/^\.SH/; $_ = <>) { - s/^\.[IRB][IRB]\s*//; - s/^\.[IRB]\s+//; - next if /^\./; - s/\\f\w//g; - s/\\&//g; - s/^\s+//; - next if /^$/; - next if /^#/; - $spec .= $_; - } - $_ = $spec; - 0 while s/\(([^),;]*)\s*,\s*([^);]*)\)/($1|$2)/g; - s/\(\*([^,;]*)\)\(\)/(*)()$1/g; - s/(\w+)\[\]/*$1/g; - - s/\n/ /g; - s/\s+/ /g; - s/(\w+) \(([^*])/$1($2/g; - s/^ //; - s/ ?; ?/\n/g; - s/\) /)\n/g; - s/ \* / \*/g; - s/\* / \*/g; - - $* = 1; - 0 while s/^((struct )?\w+ )([^\n,]*), ?(.*)/$1$3\n$1$4/g; - $* = 0; - s/\|/,/g; - - @cases = (); - for (reverse split(/\n/,$_)) { - if (/\)$/) { - ($type,$name,$args) = split(/(\w+)\(/); - $type =~ s/ $//; - if ($type =~ /^(\w+) =/) { - $type = $type{$1} if $type{$1}; - } - $type = 'int' if $type eq ''; - @args = grep(/./, split(/[,)]/,$args)); - $case = "CASE $type $name\n"; - foreach $arg (@args) { - $type = $type{$arg} || "int"; - $type =~ s/ //g; - $type .= "\t" if length($type) < 8; - if ($type =~ /\*/) { - $case .= "IO $type $arg\n"; - } - else { - $case .= "I $type $arg\n"; - } - } - $case .= "END\n\n"; - unshift(@cases, $case); - } - else { - $type{$name} = $type if ($type,$name) = /(.*\W)(\w+)$/; - } - } - print @cases; - } -} diff --git a/ext/mus b/ext/mus deleted file mode 100644 index b1675fd..0000000 --- a/ext/mus +++ /dev/null @@ -1,135 +0,0 @@ -#!/usr/bin/perl - -while (<>) { - if (s/^CASE\s+//) { - @fields = split; - $funcname = pop(@fields); - $rettype = "@fields"; - @modes = (); - @types = (); - @names = (); - @outies = (); - @callnames = (); - $pre = "\n"; - $post = ''; - - while (<>) { - last unless /^[IO]+\s/; - @fields = split(' '); - push(@modes, shift(@fields)); - push(@names, pop(@fields)); - push(@types, "@fields"); - } - while (s/^<\s//) { - $pre .= "\t $_"; - $_ = <>; - } - while (s/^>\s//) { - $post .= "\t $_"; - $_ = <>; - } - $items = @names; - $namelist = '$' . join(', $', @names); - $namelist = '' if $namelist eq '$'; - print < -#include -#include -#include -#ifdef I_FLOAT -#include -#endif -#include -#include -#include -#include -#ifdef I_PWD -#include -#endif -#include -#include -#ifdef I_STDARG -#include -#endif -#ifdef I_STDDEF -#include -#endif -#include -#include -#include -#include -#include -#include -#include -#include -#if defined(I_TERMIOS) && !defined(CR3) -#include -#endif -#include -#include -#include - -typedef int SysRet; -typedef sigset_t* POSIX__SigSet; -typedef HV* POSIX__SigAction; - -#define HAS_UNAME - -#ifndef HAS_GETPGRP -#define getpgrp() not_here("getpgrp") -#endif -#ifndef HAS_NICE -#define nice(a) not_here("nice") -#endif -#ifndef HAS_READLINK -#define readlink(a,b,c) not_here("readlink") -#endif -#ifndef HAS_SETPGID -#define setpgid(a,b) not_here("setpgid") -#endif -#ifndef HAS_SETSID -#define setsid() not_here("setsid") -#endif -#ifndef HAS_SYMLINK -#define symlink(a,b) not_here("symlink") -#endif -#ifndef HAS_TCGETPGRP -#define tcgetpgrp(a) not_here("tcgetpgrp") -#endif -#ifndef HAS_TCSETPGRP -#define tcsetpgrp(a,b) not_here("tcsetpgrp") -#endif -#ifndef HAS_TIMES -#define times(a) not_here("times") -#endif -#ifndef HAS_UNAME -#define uname(a) not_here("uname") -#endif -#ifndef HAS_WAITPID -#define waitpid(a,b,c) not_here("waitpid") -#endif - -static int -not_here(s) -char *s; -{ - croak("POSIX::%s not implemented on this architecture", s); - return -1; -} - -int constant(name, arg) -char *name; -int arg; -{ - errno = 0; - switch (*name) { - case 'A': - if (strEQ(name, "ARG_MAX")) -#ifdef ARG_MAX - return ARG_MAX; -#else - goto not_there; -#endif - break; - case 'B': - if (strEQ(name, "BUFSIZ")) -#ifdef BUFSIZ - return BUFSIZ; -#else - goto not_there; -#endif - if (strEQ(name, "BRKINT")) -#ifdef BRKINT - return BRKINT; -#else - goto not_there; -#endif - if (strEQ(name, "B9600")) -#ifdef B9600 - return B9600; -#else - goto not_there; -#endif - if (strEQ(name, "B19200")) -#ifdef B19200 - return B19200; -#else - goto not_there; -#endif - if (strEQ(name, "B38400")) -#ifdef B38400 - return B38400; -#else - goto not_there; -#endif - if (strEQ(name, "B0")) -#ifdef B0 - return B0; -#else - goto not_there; -#endif - if (strEQ(name, "B110")) -#ifdef B110 - return B110; -#else - goto not_there; -#endif - if (strEQ(name, "B1200")) -#ifdef B1200 - return B1200; -#else - goto not_there; -#endif - if (strEQ(name, "B134")) -#ifdef B134 - return B134; -#else - goto not_there; -#endif - if (strEQ(name, "B150")) -#ifdef B150 - return B150; -#else - goto not_there; -#endif - if (strEQ(name, "B1800")) -#ifdef B1800 - return B1800; -#else - goto not_there; -#endif - if (strEQ(name, "B200")) -#ifdef B200 - return B200; -#else - goto not_there; -#endif - if (strEQ(name, "B2400")) -#ifdef B2400 - return B2400; -#else - goto not_there; -#endif - if (strEQ(name, "B300")) -#ifdef B300 - return B300; -#else - goto not_there; -#endif - if (strEQ(name, "B4800")) -#ifdef B4800 - return B4800; -#else - goto not_there; -#endif - if (strEQ(name, "B50")) -#ifdef B50 - return B50; -#else - goto not_there; -#endif - if (strEQ(name, "B600")) -#ifdef B600 - return B600; -#else - goto not_there; -#endif - if (strEQ(name, "B75")) -#ifdef B75 - return B75; -#else - goto not_there; -#endif - break; - case 'C': - if (strEQ(name, "CHAR_BIT")) -#ifdef CHAR_BIT - return CHAR_BIT; -#else - goto not_there; -#endif - if (strEQ(name, "CHAR_MAX")) -#ifdef CHAR_MAX - return CHAR_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "CHAR_MIN")) -#ifdef CHAR_MIN - return CHAR_MIN; -#else - goto not_there; -#endif - if (strEQ(name, "CHILD_MAX")) -#ifdef CHILD_MAX - return CHILD_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "CLK_TCK")) -#ifdef CLK_TCK - return CLK_TCK; -#else - goto not_there; -#endif - if (strEQ(name, "CLOCAL")) -#ifdef CLOCAL - return CLOCAL; -#else - goto not_there; -#endif - if (strEQ(name, "CLOCKS_PER_SEC")) -#ifdef CLOCKS_PER_SEC - return CLOCKS_PER_SEC; -#else - goto not_there; -#endif - if (strEQ(name, "CREAD")) -#ifdef CREAD - return CREAD; -#else - goto not_there; -#endif - if (strEQ(name, "CS5")) -#ifdef CS5 - return CS5; -#else - goto not_there; -#endif - if (strEQ(name, "CS6")) -#ifdef CS6 - return CS6; -#else - goto not_there; -#endif - if (strEQ(name, "CS7")) -#ifdef CS7 - return CS7; -#else - goto not_there; -#endif - if (strEQ(name, "CS8")) -#ifdef CS8 - return CS8; -#else - goto not_there; -#endif - if (strEQ(name, "CSIZE")) -#ifdef CSIZE - return CSIZE; -#else - goto not_there; -#endif - if (strEQ(name, "CSTOPB")) -#ifdef CSTOPB - return CSTOPB; -#else - goto not_there; -#endif - break; - case 'D': - if (strEQ(name, "DBL_MAX")) -#ifdef DBL_MAX - return DBL_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "DBL_MIN")) -#ifdef DBL_MIN - return DBL_MIN; -#else - goto not_there; -#endif - if (strEQ(name, "DBL_DIG")) -#ifdef DBL_DIG - return DBL_DIG; -#else - goto not_there; -#endif - if (strEQ(name, "DBL_EPSILON")) -#ifdef DBL_EPSILON - return DBL_EPSILON; -#else - goto not_there; -#endif - if (strEQ(name, "DBL_MANT_DIG")) -#ifdef DBL_MANT_DIG - return DBL_MANT_DIG; -#else - goto not_there; -#endif - if (strEQ(name, "DBL_MAX_10_EXP")) -#ifdef DBL_MAX_10_EXP - return DBL_MAX_10_EXP; -#else - goto not_there; -#endif - if (strEQ(name, "DBL_MAX_EXP")) -#ifdef DBL_MAX_EXP - return DBL_MAX_EXP; -#else - goto not_there; -#endif - if (strEQ(name, "DBL_MIN_10_EXP")) -#ifdef DBL_MIN_10_EXP - return DBL_MIN_10_EXP; -#else - goto not_there; -#endif - if (strEQ(name, "DBL_MIN_EXP")) -#ifdef DBL_MIN_EXP - return DBL_MIN_EXP; -#else - goto not_there; -#endif - break; - case 'E': - switch (name[1]) { - case 'A': - if (strEQ(name, "EACCES")) -#ifdef EACCES - return EACCES; -#else - goto not_there; -#endif - if (strEQ(name, "EAGAIN")) -#ifdef EAGAIN - return EAGAIN; -#else - goto not_there; -#endif - break; - case 'B': - if (strEQ(name, "EBADF")) -#ifdef EBADF - return EBADF; -#else - goto not_there; -#endif - if (strEQ(name, "EBUSY")) -#ifdef EBUSY - return EBUSY; -#else - goto not_there; -#endif - break; - case 'C': - if (strEQ(name, "ECHILD")) -#ifdef ECHILD - return ECHILD; -#else - goto not_there; -#endif - if (strEQ(name, "ECHO")) -#ifdef ECHO - return ECHO; -#else - goto not_there; -#endif - if (strEQ(name, "ECHOE")) -#ifdef ECHOE - return ECHOE; -#else - goto not_there; -#endif - if (strEQ(name, "ECHOK")) -#ifdef ECHOK - return ECHOK; -#else - goto not_there; -#endif - if (strEQ(name, "ECHONL")) -#ifdef ECHONL - return ECHONL; -#else - goto not_there; -#endif - break; - case 'D': - if (strEQ(name, "EDEADLK")) -#ifdef EDEADLK - return EDEADLK; -#else - goto not_there; -#endif - if (strEQ(name, "EDOM")) -#ifdef EDOM - return EDOM; -#else - goto not_there; -#endif - break; - case 'E': - if (strEQ(name, "EEXIST")) -#ifdef EEXIST - return EEXIST; -#else - goto not_there; -#endif - break; - case 'F': - if (strEQ(name, "EFAULT")) -#ifdef EFAULT - return EFAULT; -#else - goto not_there; -#endif - if (strEQ(name, "EFBIG")) -#ifdef EFBIG - return EFBIG; -#else - goto not_there; -#endif - break; - case 'I': - if (strEQ(name, "EINTR")) -#ifdef EINTR - return EINTR; -#else - goto not_there; -#endif - if (strEQ(name, "EINVAL")) -#ifdef EINVAL - return EINVAL; -#else - goto not_there; -#endif - if (strEQ(name, "EIO")) -#ifdef EIO - return EIO; -#else - goto not_there; -#endif - if (strEQ(name, "EISDIR")) -#ifdef EISDIR - return EISDIR; -#else - goto not_there; -#endif - break; - case 'M': - if (strEQ(name, "EMFILE")) -#ifdef EMFILE - return EMFILE; -#else - goto not_there; -#endif - if (strEQ(name, "EMLINK")) -#ifdef EMLINK - return EMLINK; -#else - goto not_there; -#endif - break; - case 'N': - if (strEQ(name, "ENOMEM")) -#ifdef ENOMEM - return ENOMEM; -#else - goto not_there; -#endif - if (strEQ(name, "ENOSPC")) -#ifdef ENOSPC - return ENOSPC; -#else - goto not_there; -#endif - if (strEQ(name, "ENOEXEC")) -#ifdef ENOEXEC - return ENOEXEC; -#else - goto not_there; -#endif - if (strEQ(name, "ENOTTY")) -#ifdef ENOTTY - return ENOTTY; -#else - goto not_there; -#endif - if (strEQ(name, "ENOTDIR")) -#ifdef ENOTDIR - return ENOTDIR; -#else - goto not_there; -#endif - if (strEQ(name, "ENOTEMPTY")) -#ifdef ENOTEMPTY - return ENOTEMPTY; -#else - goto not_there; -#endif - if (strEQ(name, "ENFILE")) -#ifdef ENFILE - return ENFILE; -#else - goto not_there; -#endif - if (strEQ(name, "ENODEV")) -#ifdef ENODEV - return ENODEV; -#else - goto not_there; -#endif - if (strEQ(name, "ENOENT")) -#ifdef ENOENT - return ENOENT; -#else - goto not_there; -#endif - if (strEQ(name, "ENOLCK")) -#ifdef ENOLCK - return ENOLCK; -#else - goto not_there; -#endif - if (strEQ(name, "ENOSYS")) -#ifdef ENOSYS - return ENOSYS; -#else - goto not_there; -#endif - if (strEQ(name, "ENXIO")) -#ifdef ENXIO - return ENXIO; -#else - goto not_there; -#endif - if (strEQ(name, "ENAMETOOLONG")) -#ifdef ENAMETOOLONG - return ENAMETOOLONG; -#else - goto not_there; -#endif - break; - case 'O': - if (strEQ(name, "EOF")) -#ifdef EOF - return EOF; -#else - goto not_there; -#endif - break; - case 'P': - if (strEQ(name, "EPERM")) -#ifdef EPERM - return EPERM; -#else - goto not_there; -#endif - if (strEQ(name, "EPIPE")) -#ifdef EPIPE - return EPIPE; -#else - goto not_there; -#endif - break; - case 'R': - if (strEQ(name, "ERANGE")) -#ifdef ERANGE - return ERANGE; -#else - goto not_there; -#endif - if (strEQ(name, "EROFS")) -#ifdef EROFS - return EROFS; -#else - goto not_there; -#endif - break; - case 'S': - if (strEQ(name, "ESPIPE")) -#ifdef ESPIPE - return ESPIPE; -#else - goto not_there; -#endif - if (strEQ(name, "ESRCH")) -#ifdef ESRCH - return ESRCH; -#else - goto not_there; -#endif - break; - case 'X': - if (strEQ(name, "EXIT_FAILURE")) -#ifdef EXIT_FAILURE - return EXIT_FAILURE; -#else - return 1; -#endif - if (strEQ(name, "EXIT_SUCCESS")) -#ifdef EXIT_SUCCESS - return EXIT_SUCCESS; -#else - return 0; -#endif - if (strEQ(name, "EXDEV")) -#ifdef EXDEV - return EXDEV; -#else - goto not_there; -#endif - break; - } - if (strEQ(name, "E2BIG")) -#ifdef E2BIG - return E2BIG; -#else - goto not_there; -#endif - break; - case 'F': - if (strnEQ(name, "FLT_", 4)) { - if (strEQ(name, "FLT_MAX")) -#ifdef FLT_MAX - return FLT_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "FLT_MIN")) -#ifdef FLT_MIN - return FLT_MIN; -#else - goto not_there; -#endif - if (strEQ(name, "FLT_ROUNDS")) -#ifdef FLT_ROUNDS - return FLT_ROUNDS; -#else - goto not_there; -#endif - if (strEQ(name, "FLT_DIG")) -#ifdef FLT_DIG - return FLT_DIG; -#else - goto not_there; -#endif - if (strEQ(name, "FLT_EPSILON")) -#ifdef FLT_EPSILON - return FLT_EPSILON; -#else - goto not_there; -#endif - if (strEQ(name, "FLT_MANT_DIG")) -#ifdef FLT_MANT_DIG - return FLT_MANT_DIG; -#else - goto not_there; -#endif - if (strEQ(name, "FLT_MAX_10_EXP")) -#ifdef FLT_MAX_10_EXP - return FLT_MAX_10_EXP; -#else - goto not_there; -#endif - if (strEQ(name, "FLT_MAX_EXP")) -#ifdef FLT_MAX_EXP - return FLT_MAX_EXP; -#else - goto not_there; -#endif - if (strEQ(name, "FLT_MIN_10_EXP")) -#ifdef FLT_MIN_10_EXP - return FLT_MIN_10_EXP; -#else - goto not_there; -#endif - if (strEQ(name, "FLT_MIN_EXP")) -#ifdef FLT_MIN_EXP - return FLT_MIN_EXP; -#else - goto not_there; -#endif - if (strEQ(name, "FLT_RADIX")) -#ifdef FLT_RADIX - return FLT_RADIX; -#else - goto not_there; -#endif - break; - } - if (strnEQ(name, "F_", 2)) { - if (strEQ(name, "F_DUPFD")) -#ifdef F_DUPFD - return F_DUPFD; -#else - goto not_there; -#endif - if (strEQ(name, "F_GETFD")) -#ifdef F_GETFD - return F_GETFD; -#else - goto not_there; -#endif - if (strEQ(name, "F_GETFL")) -#ifdef F_GETFL - return F_GETFL; -#else - goto not_there; -#endif - if (strEQ(name, "F_GETLK")) -#ifdef F_GETLK - return F_GETLK; -#else - goto not_there; -#endif - if (strEQ(name, "F_OK")) -#ifdef F_OK - return F_OK; -#else - goto not_there; -#endif - if (strEQ(name, "F_RDLCK")) -#ifdef F_RDLCK - return F_RDLCK; -#else - goto not_there; -#endif - if (strEQ(name, "F_SETFD")) -#ifdef F_SETFD - return F_SETFD; -#else - goto not_there; -#endif - if (strEQ(name, "F_SETFL")) -#ifdef F_SETFL - return F_SETFL; -#else - goto not_there; -#endif - if (strEQ(name, "F_SETLK")) -#ifdef F_SETLK - return F_SETLK; -#else - goto not_there; -#endif - if (strEQ(name, "F_SETLKW")) -#ifdef F_SETLKW - return F_SETLKW; -#else - goto not_there; -#endif - if (strEQ(name, "F_UNLCK")) -#ifdef F_UNLCK - return F_UNLCK; -#else - goto not_there; -#endif - if (strEQ(name, "F_WRLCK")) -#ifdef F_WRLCK - return F_WRLCK; -#else - goto not_there; -#endif - break; - } - if (strEQ(name, "FD_CLOEXEC")) return FD_CLOEXEC; - if (strEQ(name, "FILENAME_MAX")) -#ifdef FILENAME_MAX - return FILENAME_MAX; -#else - goto not_there; -#endif - break; - case 'H': - if (strEQ(name, "HUGE_VAL")) -#ifdef HUGE_VAL - return HUGE_VAL; -#else - goto not_there; -#endif - if (strEQ(name, "HUPCL")) -#ifdef HUPCL - return HUPCL; -#else - goto not_there; -#endif - break; - case 'I': - if (strEQ(name, "INT_MAX")) -#ifdef INT_MAX - return INT_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "INT_MIN")) -#ifdef INT_MIN - return INT_MIN; -#else - goto not_there; -#endif - if (strEQ(name, "ICANON")) -#ifdef ICANON - return ICANON; -#else - goto not_there; -#endif - if (strEQ(name, "ICRNL")) -#ifdef ICRNL - return ICRNL; -#else - goto not_there; -#endif - if (strEQ(name, "IEXTEN")) -#ifdef IEXTEN - return IEXTEN; -#else - goto not_there; -#endif - if (strEQ(name, "IGNBRK")) -#ifdef IGNBRK - return IGNBRK; -#else - goto not_there; -#endif - if (strEQ(name, "IGNCR")) -#ifdef IGNCR - return IGNCR; -#else - goto not_there; -#endif - if (strEQ(name, "IGNPAR")) -#ifdef IGNPAR - return IGNPAR; -#else - goto not_there; -#endif - if (strEQ(name, "INLCR")) -#ifdef INLCR - return INLCR; -#else - goto not_there; -#endif - if (strEQ(name, "INPCK")) -#ifdef INPCK - return INPCK; -#else - goto not_there; -#endif - if (strEQ(name, "ISIG")) -#ifdef ISIG - return ISIG; -#else - goto not_there; -#endif - if (strEQ(name, "ISTRIP")) -#ifdef ISTRIP - return ISTRIP; -#else - goto not_there; -#endif - if (strEQ(name, "IXOFF")) -#ifdef IXOFF - return IXOFF; -#else - goto not_there; -#endif - if (strEQ(name, "IXON")) -#ifdef IXON - return IXON; -#else - goto not_there; -#endif - break; - case 'L': - if (strnEQ(name, "LC_", 3)) { - if (strEQ(name, "LC_ALL")) -#ifdef LC_ALL - return LC_ALL; -#else - goto not_there; -#endif - if (strEQ(name, "LC_COLLATE")) -#ifdef LC_COLLATE - return LC_COLLATE; -#else - goto not_there; -#endif - if (strEQ(name, "LC_CTYPE")) -#ifdef LC_CTYPE - return LC_CTYPE; -#else - goto not_there; -#endif - if (strEQ(name, "LC_MONETARY")) -#ifdef LC_MONETARY - return LC_MONETARY; -#else - goto not_there; -#endif - if (strEQ(name, "LC_NUMERIC")) -#ifdef LC_NUMERIC - return LC_NUMERIC; -#else - goto not_there; -#endif - if (strEQ(name, "LC_TIME")) -#ifdef LC_TIME - return LC_TIME; -#else - goto not_there; -#endif - break; - } - if (strnEQ(name, "LDBL_", 5)) { - if (strEQ(name, "LDBL_MAX")) -#ifdef LDBL_MAX - return LDBL_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "LDBL_MIN")) -#ifdef LDBL_MIN - return LDBL_MIN; -#else - goto not_there; -#endif - if (strEQ(name, "LDBL_DIG")) -#ifdef LDBL_DIG - return LDBL_DIG; -#else - goto not_there; -#endif - if (strEQ(name, "LDBL_EPSILON")) -#ifdef LDBL_EPSILON - return LDBL_EPSILON; -#else - goto not_there; -#endif - if (strEQ(name, "LDBL_MANT_DIG")) -#ifdef LDBL_MANT_DIG - return LDBL_MANT_DIG; -#else - goto not_there; -#endif - if (strEQ(name, "LDBL_MAX_10_EXP")) -#ifdef LDBL_MAX_10_EXP - return LDBL_MAX_10_EXP; -#else - goto not_there; -#endif - if (strEQ(name, "LDBL_MAX_EXP")) -#ifdef LDBL_MAX_EXP - return LDBL_MAX_EXP; -#else - goto not_there; -#endif - if (strEQ(name, "LDBL_MIN_10_EXP")) -#ifdef LDBL_MIN_10_EXP - return LDBL_MIN_10_EXP; -#else - goto not_there; -#endif - if (strEQ(name, "LDBL_MIN_EXP")) -#ifdef LDBL_MIN_EXP - return LDBL_MIN_EXP; -#else - goto not_there; -#endif - break; - } - if (strnEQ(name, "L_", 2)) { - if (strEQ(name, "L_ctermid")) -#ifdef L_ctermid - return L_ctermid; -#else - goto not_there; -#endif - if (strEQ(name, "L_cuserid")) -#ifdef L_cuserid - return L_cuserid; -#else - goto not_there; -#endif - if (strEQ(name, "L_tmpname")) -#ifdef L_tmpname - return L_tmpname; -#else - goto not_there; -#endif - break; - } - if (strEQ(name, "LONG_MAX")) -#ifdef LONG_MAX - return LONG_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "LONG_MIN")) -#ifdef LONG_MIN - return LONG_MIN; -#else - goto not_there; -#endif - if (strEQ(name, "LINK_MAX")) -#ifdef LINK_MAX - return LINK_MAX; -#else - goto not_there; -#endif - break; - case 'M': - if (strEQ(name, "MAX_CANON")) -#ifdef MAX_CANON - return MAX_CANON; -#else - goto not_there; -#endif - if (strEQ(name, "MAX_INPUT")) -#ifdef MAX_INPUT - return MAX_INPUT; -#else - goto not_there; -#endif - if (strEQ(name, "MB_CUR_MAX")) -#ifdef MB_CUR_MAX - return MB_CUR_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "MB_LEN_MAX")) -#ifdef MB_LEN_MAX - return MB_LEN_MAX; -#else - goto not_there; -#endif - break; - case 'N': - if (strEQ(name, "NULL")) return NULL; - if (strEQ(name, "NAME_MAX")) -#ifdef NAME_MAX - return NAME_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "NCCS")) -#ifdef NCCS - return NCCS; -#else - goto not_there; -#endif - if (strEQ(name, "NGROUPS_MAX")) -#ifdef NGROUPS_MAX - return NGROUPS_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "NOFLSH")) -#ifdef NOFLSH - return NOFLSH; -#else - goto not_there; -#endif - break; - case 'O': - if (strnEQ(name, "O_", 2)) { - if (strEQ(name, "O_APPEND")) -#ifdef O_APPEND - return O_APPEND; -#else - goto not_there; -#endif - if (strEQ(name, "O_CREAT")) -#ifdef O_CREAT - return O_CREAT; -#else - goto not_there; -#endif - if (strEQ(name, "O_TRUNC")) -#ifdef O_TRUNC - return O_TRUNC; -#else - goto not_there; -#endif - if (strEQ(name, "O_RDONLY")) -#ifdef O_RDONLY - return O_RDONLY; -#else - goto not_there; -#endif - if (strEQ(name, "O_RDWR")) -#ifdef O_RDWR - return O_RDWR; -#else - goto not_there; -#endif - if (strEQ(name, "O_WRONLY")) -#ifdef O_WRONLY - return O_WRONLY; -#else - goto not_there; -#endif - if (strEQ(name, "O_EXCL")) -#ifdef O_EXCL - return O_EXCL; -#else - goto not_there; -#endif - if (strEQ(name, "O_NOCTTY")) -#ifdef O_NOCTTY - return O_NOCTTY; -#else - goto not_there; -#endif - if (strEQ(name, "O_NONBLOCK")) -#ifdef O_NONBLOCK - return O_NONBLOCK; -#else - goto not_there; -#endif - if (strEQ(name, "O_ACCMODE")) -#ifdef O_ACCMODE - return O_ACCMODE; -#else - goto not_there; -#endif - break; - } - if (strEQ(name, "OPEN_MAX")) -#ifdef OPEN_MAX - return OPEN_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "OPOST")) -#ifdef OPOST - return OPOST; -#else - goto not_there; -#endif - break; - case 'P': - if (strEQ(name, "PATH_MAX")) -#ifdef PATH_MAX - return PATH_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "PARENB")) -#ifdef PARENB - return PARENB; -#else - goto not_there; -#endif - if (strEQ(name, "PARMRK")) -#ifdef PARMRK - return PARMRK; -#else - goto not_there; -#endif - if (strEQ(name, "PARODD")) -#ifdef PARODD - return PARODD; -#else - goto not_there; -#endif - if (strEQ(name, "PIPE_BUF")) -#ifdef PIPE_BUF - return PIPE_BUF; -#else - goto not_there; -#endif - break; - case 'R': - if (strEQ(name, "RAND_MAX")) -#ifdef RAND_MAX - return RAND_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "R_OK")) -#ifdef R_OK - return R_OK; -#else - goto not_there; -#endif - break; - case 'S': - if (strnEQ(name, "SIG", 3)) { - if (name[3] == '_') { - if (strEQ(name, "SIG_BLOCK")) -#ifdef SIG_BLOCK - return SIG_BLOCK; -#else - goto not_there; -#endif -#ifdef SIG_DFL - if (strEQ(name, "SIG_DFL")) return (int)SIG_DFL; -#endif -#ifdef SIG_ERR - if (strEQ(name, "SIG_ERR")) return (int)SIG_ERR; -#endif -#ifdef SIG_IGN - if (strEQ(name, "SIG_IGN")) return (int)SIG_IGN; -#endif - if (strEQ(name, "SIG_SETMASK")) -#ifdef SIG_SETMASK - return SIG_SETMASK; -#else - goto not_there; -#endif - if (strEQ(name, "SIG_UNBLOCK")) -#ifdef SIG_UNBLOCK - return SIG_UNBLOCK; -#else - goto not_there; -#endif - break; - } - if (strEQ(name, "SIGABRT")) -#ifdef SIGABRT - return SIGABRT; -#else - goto not_there; -#endif - if (strEQ(name, "SIGALRM")) -#ifdef SIGALRM - return SIGALRM; -#else - goto not_there; -#endif - if (strEQ(name, "SIGCHLD")) -#ifdef SIGCHLD - return SIGCHLD; -#else - goto not_there; -#endif - if (strEQ(name, "SIGCONT")) -#ifdef SIGCONT - return SIGCONT; -#else - goto not_there; -#endif - if (strEQ(name, "SIGFPE")) -#ifdef SIGFPE - return SIGFPE; -#else - goto not_there; -#endif - if (strEQ(name, "SIGHUP")) -#ifdef SIGHUP - return SIGHUP; -#else - goto not_there; -#endif - if (strEQ(name, "SIGILL")) -#ifdef SIGILL - return SIGILL; -#else - goto not_there; -#endif - if (strEQ(name, "SIGINT")) -#ifdef SIGINT - return SIGINT; -#else - goto not_there; -#endif - if (strEQ(name, "SIGKILL")) -#ifdef SIGKILL - return SIGKILL; -#else - goto not_there; -#endif - if (strEQ(name, "SIGPIPE")) -#ifdef SIGPIPE - return SIGPIPE; -#else - goto not_there; -#endif - if (strEQ(name, "SIGQUIT")) -#ifdef SIGQUIT - return SIGQUIT; -#else - goto not_there; -#endif - if (strEQ(name, "SIGSEGV")) -#ifdef SIGSEGV - return SIGSEGV; -#else - goto not_there; -#endif - if (strEQ(name, "SIGSTOP")) -#ifdef SIGSTOP - return SIGSTOP; -#else - goto not_there; -#endif - if (strEQ(name, "SIGTERM")) -#ifdef SIGTERM - return SIGTERM; -#else - goto not_there; -#endif - if (strEQ(name, "SIGTSTP")) -#ifdef SIGTSTP - return SIGTSTP; -#else - goto not_there; -#endif - if (strEQ(name, "SIGTTIN")) -#ifdef SIGTTIN - return SIGTTIN; -#else - goto not_there; -#endif - if (strEQ(name, "SIGTTOU")) -#ifdef SIGTTOU - return SIGTTOU; -#else - goto not_there; -#endif - if (strEQ(name, "SIGUSR1")) -#ifdef SIGUSR1 - return SIGUSR1; -#else - goto not_there; -#endif - if (strEQ(name, "SIGUSR2")) -#ifdef SIGUSR2 - return SIGUSR2; -#else - goto not_there; -#endif - break; - } - if (name[1] == '_') { -#ifdef S_ISBLK - if (strEQ(name, "S_ISBLK")) return S_ISBLK(arg); -#endif -#ifdef S_ISCHR - if (strEQ(name, "S_ISCHR")) return S_ISCHR(arg); -#endif -#ifdef S_ISDIR - if (strEQ(name, "S_ISDIR")) return S_ISDIR(arg); -#endif -#ifdef S_ISFIFO - if (strEQ(name, "S_ISFIFO")) return S_ISFIFO(arg); -#endif -#ifdef S_ISREG - if (strEQ(name, "S_ISREG")) return S_ISREG(arg); -#endif - if (strEQ(name, "S_ISGID")) -#ifdef S_ISGID - return S_ISGID; -#else - goto not_there; -#endif - if (strEQ(name, "S_ISUID")) -#ifdef S_ISUID - return S_ISUID; -#else - goto not_there; -#endif - if (strEQ(name, "S_IRGRP")) -#ifdef S_IRGRP - return S_IRGRP; -#else - goto not_there; -#endif - if (strEQ(name, "S_IROTH")) -#ifdef S_IROTH - return S_IROTH; -#else - goto not_there; -#endif - if (strEQ(name, "S_IRUSR")) -#ifdef S_IRUSR - return S_IRUSR; -#else - goto not_there; -#endif - if (strEQ(name, "S_IRWXG")) -#ifdef S_IRWXG - return S_IRWXG; -#else - goto not_there; -#endif - if (strEQ(name, "S_IRWXO")) -#ifdef S_IRWXO - return S_IRWXO; -#else - goto not_there; -#endif - if (strEQ(name, "S_IRWXU")) -#ifdef S_IRWXU - return S_IRWXU; -#else - goto not_there; -#endif - if (strEQ(name, "S_IWGRP")) -#ifdef S_IWGRP - return S_IWGRP; -#else - goto not_there; -#endif - if (strEQ(name, "S_IWOTH")) -#ifdef S_IWOTH - return S_IWOTH; -#else - goto not_there; -#endif - if (strEQ(name, "S_IWUSR")) -#ifdef S_IWUSR - return S_IWUSR; -#else - goto not_there; -#endif - if (strEQ(name, "S_IXGRP")) -#ifdef S_IXGRP - return S_IXGRP; -#else - goto not_there; -#endif - if (strEQ(name, "S_IXOTH")) -#ifdef S_IXOTH - return S_IXOTH; -#else - goto not_there; -#endif - if (strEQ(name, "S_IXUSR")) -#ifdef S_IXUSR - return S_IXUSR; -#else - goto not_there; -#endif - break; - } - if (strEQ(name, "SEEK_CUR")) -#ifdef SEEK_CUR - return SEEK_CUR; -#else - goto not_there; -#endif - if (strEQ(name, "SEEK_END")) -#ifdef SEEK_END - return SEEK_END; -#else - goto not_there; -#endif - if (strEQ(name, "SEEK_SET")) -#ifdef SEEK_SET - return SEEK_SET; -#else - goto not_there; -#endif - if (strEQ(name, "STREAM_MAX")) -#ifdef STREAM_MAX - return STREAM_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "SHRT_MAX")) -#ifdef SHRT_MAX - return SHRT_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "SHRT_MIN")) -#ifdef SHRT_MIN - return SHRT_MIN; -#else - goto not_there; -#endif - if (strEQ(name, "SA_NOCLDSTOP")) -#ifdef SA_NOCLDSTOP - return SA_NOCLDSTOP; -#else - goto not_there; -#endif - if (strEQ(name, "SCHAR_MAX")) -#ifdef SCHAR_MAX - return SCHAR_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "SCHAR_MIN")) -#ifdef SCHAR_MIN - return SCHAR_MIN; -#else - goto not_there; -#endif - if (strEQ(name, "SSIZE_MAX")) -#ifdef SSIZE_MAX - return SSIZE_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "STDIN_FILENO")) -#ifdef STDIN_FILENO - return STDIN_FILENO; -#else - goto not_there; -#endif - if (strEQ(name, "STDOUT_FILENO")) -#ifdef STDOUT_FILENO - return STDOUT_FILENO; -#else - goto not_there; -#endif - if (strEQ(name, "STRERR_FILENO")) -#ifdef STRERR_FILENO - return STRERR_FILENO; -#else - goto not_there; -#endif - break; - case 'T': - if (strEQ(name, "TCIFLUSH")) -#ifdef TCIFLUSH - return TCIFLUSH; -#else - goto not_there; -#endif - if (strEQ(name, "TCIOFF")) -#ifdef TCIOFF - return TCIOFF; -#else - goto not_there; -#endif - if (strEQ(name, "TCIOFLUSH")) -#ifdef TCIOFLUSH - return TCIOFLUSH; -#else - goto not_there; -#endif - if (strEQ(name, "TCION")) -#ifdef TCION - return TCION; -#else - goto not_there; -#endif - if (strEQ(name, "TCOFLUSH")) -#ifdef TCOFLUSH - return TCOFLUSH; -#else - goto not_there; -#endif - if (strEQ(name, "TCOOFF")) -#ifdef TCOOFF - return TCOOFF; -#else - goto not_there; -#endif - if (strEQ(name, "TCOON")) -#ifdef TCOON - return TCOON; -#else - goto not_there; -#endif - if (strEQ(name, "TCSADRAIN")) -#ifdef TCSADRAIN - return TCSADRAIN; -#else - goto not_there; -#endif - if (strEQ(name, "TCSAFLUSH")) -#ifdef TCSAFLUSH - return TCSAFLUSH; -#else - goto not_there; -#endif - if (strEQ(name, "TCSANOW")) -#ifdef TCSANOW - return TCSANOW; -#else - goto not_there; -#endif - if (strEQ(name, "TMP_MAX")) -#ifdef TMP_MAX - return TMP_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "TOSTOP")) -#ifdef TOSTOP - return TOSTOP; -#else - goto not_there; -#endif - if (strEQ(name, "TZNAME_MAX")) -#ifdef TZNAME_MAX - return TZNAME_MAX; -#else - goto not_there; -#endif - break; - case 'U': - if (strEQ(name, "UCHAR_MAX")) -#ifdef UCHAR_MAX - return UCHAR_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "UINT_MAX")) -#ifdef UINT_MAX - return UINT_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "ULONG_MAX")) -#ifdef ULONG_MAX - return ULONG_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "USHRT_MAX")) -#ifdef USHRT_MAX - return USHRT_MAX; -#else - goto not_there; -#endif - break; - case 'V': - if (strEQ(name, "VEOF")) -#ifdef VEOF - return VEOF; -#else - goto not_there; -#endif - if (strEQ(name, "VEOL")) -#ifdef VEOL - return VEOL; -#else - goto not_there; -#endif - if (strEQ(name, "VERASE")) -#ifdef VERASE - return VERASE; -#else - goto not_there; -#endif - if (strEQ(name, "VINTR")) -#ifdef VINTR - return VINTR; -#else - goto not_there; -#endif - if (strEQ(name, "VKILL")) -#ifdef VKILL - return VKILL; -#else - goto not_there; -#endif - if (strEQ(name, "VMIN")) -#ifdef VMIN - return VMIN; -#else - goto not_there; -#endif - if (strEQ(name, "VQUIT")) -#ifdef VQUIT - return VQUIT; -#else - goto not_there; -#endif - if (strEQ(name, "VSTART")) -#ifdef VSTART - return VSTART; -#else - goto not_there; -#endif - if (strEQ(name, "VSTOP")) -#ifdef VSTOP - return VSTOP; -#else - goto not_there; -#endif - if (strEQ(name, "VSUSP")) -#ifdef VSUSP - return VSUSP; -#else - goto not_there; -#endif - if (strEQ(name, "VTIME")) -#ifdef VTIME - return VTIME; -#else - goto not_there; -#endif - break; - case 'W': - if (strEQ(name, "W_OK")) -#ifdef W_OK - return W_OK; -#else - goto not_there; -#endif -#ifdef WEXITSTATUS - if (strEQ(name, "WEXITSTATUS")) return WEXITSTATUS(arg); -#endif -#ifdef WIFEXITED - if (strEQ(name, "WIFEXITED")) return WIFEXITED(arg); -#endif -#ifdef WIFSIGNALED - if (strEQ(name, "WIFSIGNALED")) return WIFSIGNALED(arg); -#endif -#ifdef WIFSTOPPED - if (strEQ(name, "WIFSTOPPED")) return WIFSTOPPED(arg); -#endif - if (strEQ(name, "WNOHANG")) -#ifdef WNOHANG - return WNOHANG; -#else - goto not_there; -#endif -#ifdef WSTOPSIG - if (strEQ(name, "WSTOPSIG")) return WSTOPSIG(arg); -#endif -#ifdef WTERMSIG - if (strEQ(name, "WTERMSIG")) return WTERMSIG(arg); -#endif - if (strEQ(name, "WUNTRACED")) -#ifdef WUNTRACED - return WUNTRACED; -#else - goto not_there; -#endif - break; - case 'X': - if (strEQ(name, "X_OK")) -#ifdef X_OK - return X_OK; -#else - goto not_there; -#endif - break; - case '_': - if (strnEQ(name, "_PC_", 4)) { - if (strEQ(name, "_PC_CHOWN_RESTRICTED")) -#ifdef _PC_CHOWN_RESTRICTED - return _PC_CHOWN_RESTRICTED; -#else - goto not_there; -#endif - if (strEQ(name, "_PC_LINK_MAX")) -#ifdef _PC_LINK_MAX - return _PC_LINK_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "_PC_MAX_CANON")) -#ifdef _PC_MAX_CANON - return _PC_MAX_CANON; -#else - goto not_there; -#endif - if (strEQ(name, "_PC_MAX_INPUT")) -#ifdef _PC_MAX_INPUT - return _PC_MAX_INPUT; -#else - goto not_there; -#endif - if (strEQ(name, "_PC_NAME_MAX")) -#ifdef _PC_NAME_MAX - return _PC_NAME_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "_PC_NO_TRUNC")) -#ifdef _PC_NO_TRUNC - return _PC_NO_TRUNC; -#else - goto not_there; -#endif - if (strEQ(name, "_PC_PATH_MAX")) -#ifdef _PC_PATH_MAX - return _PC_PATH_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "_PC_PIPE_BUF")) -#ifdef _PC_PIPE_BUF - return _PC_PIPE_BUF; -#else - goto not_there; -#endif - if (strEQ(name, "_PC_VDISABLE")) -#ifdef _PC_VDISABLE - return _PC_VDISABLE; -#else - goto not_there; -#endif - break; - } - if (strnEQ(name, "_POSIX_", 7)) { - if (strEQ(name, "_POSIX_ARG_MAX")) -#ifdef _POSIX_ARG_MAX - return _POSIX_ARG_MAX; -#else - return 0; -#endif - if (strEQ(name, "_POSIX_CHILD_MAX")) -#ifdef _POSIX_CHILD_MAX - return _POSIX_CHILD_MAX; -#else - return 0; -#endif - if (strEQ(name, "_POSIX_CHOWN_RESTRICTED")) -#ifdef _POSIX_CHOWN_RESTRICTED - return _POSIX_CHOWN_RESTRICTED; -#else - return 0; -#endif - if (strEQ(name, "_POSIX_JOB_CONTROL")) -#ifdef _POSIX_JOB_CONTROL - return _POSIX_JOB_CONTROL; -#else - return 0; -#endif - if (strEQ(name, "_POSIX_LINK_MAX")) -#ifdef _POSIX_LINK_MAX - return _POSIX_LINK_MAX; -#else - return 0; -#endif - if (strEQ(name, "_POSIX_MAX_CANON")) -#ifdef _POSIX_MAX_CANON - return _POSIX_MAX_CANON; -#else - return 0; -#endif - if (strEQ(name, "_POSIX_MAX_INPUT")) -#ifdef _POSIX_MAX_INPUT - return _POSIX_MAX_INPUT; -#else - return 0; -#endif - if (strEQ(name, "_POSIX_NAME_MAX")) -#ifdef _POSIX_NAME_MAX - return _POSIX_NAME_MAX; -#else - return 0; -#endif - if (strEQ(name, "_POSIX_NGROUPS_MAX")) -#ifdef _POSIX_NGROUPS_MAX - return _POSIX_NGROUPS_MAX; -#else - return 0; -#endif - if (strEQ(name, "_POSIX_NO_TRUNC")) -#ifdef _POSIX_NO_TRUNC - return _POSIX_NO_TRUNC; -#else - return 0; -#endif - if (strEQ(name, "_POSIX_OPEN_MAX")) -#ifdef _POSIX_OPEN_MAX - return _POSIX_OPEN_MAX; -#else - return 0; -#endif - if (strEQ(name, "_POSIX_PATH_MAX")) -#ifdef _POSIX_PATH_MAX - return _POSIX_PATH_MAX; -#else - return 0; -#endif - if (strEQ(name, "_POSIX_PIPE_BUF")) -#ifdef _POSIX_PIPE_BUF - return _POSIX_PIPE_BUF; -#else - return 0; -#endif - if (strEQ(name, "_POSIX_SAVED_IDS")) -#ifdef _POSIX_SAVED_IDS - return _POSIX_SAVED_IDS; -#else - return 0; -#endif - if (strEQ(name, "_POSIX_SSIZE_MAX")) -#ifdef _POSIX_SSIZE_MAX - return _POSIX_SSIZE_MAX; -#else - return 0; -#endif - if (strEQ(name, "_POSIX_STREAM_MAX")) -#ifdef _POSIX_STREAM_MAX - return _POSIX_STREAM_MAX; -#else - return 0; -#endif - if (strEQ(name, "_POSIX_TZNAME_MAX")) -#ifdef _POSIX_TZNAME_MAX - return _POSIX_TZNAME_MAX; -#else - return 0; -#endif - if (strEQ(name, "_POSIX_VDISABLE")) -#ifdef _POSIX_VDISABLE - return _POSIX_VDISABLE; -#else - return 0; -#endif - if (strEQ(name, "_POSIX_VERSION")) -#ifdef _POSIX_VERSION - return _POSIX_VERSION; -#else - return 0; -#endif - break; - } - if (strnEQ(name, "_SC_", 4)) { - if (strEQ(name, "_SC_ARG_MAX")) -#ifdef _SC_ARG_MAX - return _SC_ARG_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "_SC_CHILD_MAX")) -#ifdef _SC_CHILD_MAX - return _SC_CHILD_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "_SC_CLK_TCK")) -#ifdef _SC_CLK_TCK - return _SC_CLK_TCK; -#else - goto not_there; -#endif - if (strEQ(name, "_SC_JOB_CONTROL")) -#ifdef _SC_JOB_CONTROL - return _SC_JOB_CONTROL; -#else - goto not_there; -#endif - if (strEQ(name, "_SC_NGROUPS_MAX")) -#ifdef _SC_NGROUPS_MAX - return _SC_NGROUPS_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "_SC_OPEN_MAX")) -#ifdef _SC_OPEN_MAX - return _SC_OPEN_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "_SC_SAVED_IDS")) -#ifdef _SC_SAVED_IDS - return _SC_SAVED_IDS; -#else - goto not_there; -#endif - if (strEQ(name, "_SC_STREAM_MAX")) -#ifdef _SC_STREAM_MAX - return _SC_STREAM_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "_SC_TZNAME_MAX")) -#ifdef _SC_TZNAME_MAX - return _SC_TZNAME_MAX; -#else - goto not_there; -#endif - if (strEQ(name, "_SC_VERSION")) -#ifdef _SC_VERSION - return _SC_VERSION; -#else - goto not_there; -#endif - break; - } - if (strEQ(name, "_IOFBF")) -#ifdef _IOFBF - return _IOFBF; -#else - goto not_there; -#endif - if (strEQ(name, "_IOLBF")) -#ifdef _IOLBF - return _IOLBF; -#else - goto not_there; -#endif - if (strEQ(name, "_IONBF")) -#ifdef _IONBF - return _IONBF; -#else - goto not_there; -#endif - break; - } - errno = EINVAL; - return 0; - -not_there: - errno = ENOENT; - return 0; -} - -MODULE = SigSet PACKAGE = POSIX::SigSet PREFIX = sig - -POSIX::SigSet -new(packname = "POSIX::SigSet", ...) - char * packname - CODE: - { - int i; - RETVAL = (sigset_t*)safemalloc(sizeof(sigset_t)); - sigemptyset(RETVAL); - for (i = 2; i <= items; i++) - sigaddset(RETVAL, SvIV(ST(i))); - } - OUTPUT: - RETVAL - -void -DESTROY(sigset) - POSIX::SigSet sigset - CODE: - safefree(sigset); - -SysRet -sigaddset(sigset, sig) - POSIX::SigSet sigset - int sig - -SysRet -sigdelset(sigset, sig) - POSIX::SigSet sigset - int sig - -SysRet -sigemptyset(sigset) - POSIX::SigSet sigset - -SysRet -sigfillset(sigset) - POSIX::SigSet sigset - -int -sigismember(sigset, sig) - POSIX::SigSet sigset - int sig - - -MODULE = POSIX PACKAGE = POSIX - -int -constant(name,arg) - char * name - int arg - -int -isalnum(charstring) - char * charstring - CODE: - char *s; - RETVAL = 1; - for (s = charstring; *s && RETVAL; s++) - if (!isalnum(*s)) - RETVAL = 0; - OUTPUT: - RETVAL - -int -isalpha(charstring) - char * charstring - CODE: - char *s; - RETVAL = 1; - for (s = charstring; *s && RETVAL; s++) - if (!isalpha(*s)) - RETVAL = 0; - OUTPUT: - RETVAL - -int -iscntrl(charstring) - char * charstring - CODE: - char *s; - RETVAL = 1; - for (s = charstring; *s && RETVAL; s++) - if (!iscntrl(*s)) - RETVAL = 0; - OUTPUT: - RETVAL - -int -isdigit(charstring) - char * charstring - CODE: - char *s; - RETVAL = 1; - for (s = charstring; *s && RETVAL; s++) - if (!isdigit(*s)) - RETVAL = 0; - OUTPUT: - RETVAL - -int -isgraph(charstring) - char * charstring - CODE: - char *s; - RETVAL = 1; - for (s = charstring; *s && RETVAL; s++) - if (!isgraph(*s)) - RETVAL = 0; - OUTPUT: - RETVAL - -int -islower(charstring) - char * charstring - CODE: - char *s; - RETVAL = 1; - for (s = charstring; *s && RETVAL; s++) - if (!islower(*s)) - RETVAL = 0; - OUTPUT: - RETVAL - -int -isprint(charstring) - char * charstring - CODE: - char *s; - RETVAL = 1; - for (s = charstring; *s && RETVAL; s++) - if (!isprint(*s)) - RETVAL = 0; - OUTPUT: - RETVAL - -int -ispunct(charstring) - char * charstring - CODE: - char *s; - RETVAL = 1; - for (s = charstring; *s && RETVAL; s++) - if (!ispunct(*s)) - RETVAL = 0; - OUTPUT: - RETVAL - -int -isspace(charstring) - char * charstring - CODE: - char *s; - RETVAL = 1; - for (s = charstring; *s && RETVAL; s++) - if (!isspace(*s)) - RETVAL = 0; - OUTPUT: - RETVAL - -int -isupper(charstring) - char * charstring - CODE: - char *s; - RETVAL = 1; - for (s = charstring; *s && RETVAL; s++) - if (!isupper(*s)) - RETVAL = 0; - OUTPUT: - RETVAL - -int -isxdigit(charstring) - char * charstring - CODE: - char *s; - RETVAL = 1; - for (s = charstring; *s && RETVAL; s++) - if (!isxdigit(*s)) - RETVAL = 0; - OUTPUT: - RETVAL - -SysRet -open(filename, flags = O_RDONLY, mode = 0666) - char * filename - int flags - int mode - -HV * -localeconv() - CODE: - struct lconv *lcbuf; - RETVAL = newHV(); - if (lcbuf = localeconv()) { - /* the strings */ - if (lcbuf->decimal_point && *lcbuf->decimal_point) - hv_store(RETVAL, "decimal_point", 13, - newSVpv(lcbuf->decimal_point, 0), 0); - if (lcbuf->thousands_sep && *lcbuf->thousands_sep) - hv_store(RETVAL, "thousands_sep", 13, - newSVpv(lcbuf->thousands_sep, 0), 0); - if (lcbuf->grouping && *lcbuf->grouping) - hv_store(RETVAL, "grouping", 8, - newSVpv(lcbuf->grouping, 0), 0); - if (lcbuf->int_curr_symbol && *lcbuf->int_curr_symbol) - hv_store(RETVAL, "int_curr_symbol", 15, - newSVpv(lcbuf->int_curr_symbol, 0), 0); - if (lcbuf->currency_symbol && *lcbuf->currency_symbol) - hv_store(RETVAL, "currency_symbol", 15, - newSVpv(lcbuf->currency_symbol, 0), 0); - if (lcbuf->mon_decimal_point && *lcbuf->mon_decimal_point) - hv_store(RETVAL, "mon_decimal_point", 17, - newSVpv(lcbuf->mon_decimal_point, 0), 0); - if (lcbuf->mon_thousands_sep && *lcbuf->mon_thousands_sep) - hv_store(RETVAL, "mon_thousands_sep", 17, - newSVpv(lcbuf->mon_thousands_sep, 0), 0); - if (lcbuf->mon_grouping && *lcbuf->mon_grouping) - hv_store(RETVAL, "mon_grouping", 12, - newSVpv(lcbuf->mon_grouping, 0), 0); - if (lcbuf->positive_sign && *lcbuf->positive_sign) - hv_store(RETVAL, "positive_sign", 13, - newSVpv(lcbuf->positive_sign, 0), 0); - if (lcbuf->negative_sign && *lcbuf->negative_sign) - hv_store(RETVAL, "negative_sign", 13, - newSVpv(lcbuf->negative_sign, 0), 0); - /* the integers */ - if (lcbuf->int_frac_digits != CHAR_MAX) - hv_store(RETVAL, "int_frac_digits", 15, - newSViv(lcbuf->int_frac_digits), 0); - if (lcbuf->frac_digits != CHAR_MAX) - hv_store(RETVAL, "frac_digits", 11, - newSViv(lcbuf->frac_digits), 0); - if (lcbuf->p_cs_precedes != CHAR_MAX) - hv_store(RETVAL, "p_cs_precedes", 13, - newSViv(lcbuf->p_cs_precedes), 0); - if (lcbuf->p_sep_by_space != CHAR_MAX) - hv_store(RETVAL, "p_sep_by_space", 14, - newSViv(lcbuf->p_sep_by_space), 0); - if (lcbuf->n_cs_precedes != CHAR_MAX) - hv_store(RETVAL, "n_cs_precedes", 13, - newSViv(lcbuf->n_cs_precedes), 0); - if (lcbuf->n_sep_by_space != CHAR_MAX) - hv_store(RETVAL, "n_sep_by_space", 14, - newSViv(lcbuf->n_sep_by_space), 0); - if (lcbuf->p_sign_posn != CHAR_MAX) - hv_store(RETVAL, "p_sign_posn", 11, - newSViv(lcbuf->p_sign_posn), 0); - if (lcbuf->n_sign_posn != CHAR_MAX) - hv_store(RETVAL, "n_sign_posn", 11, - newSViv(lcbuf->n_sign_posn), 0); - } - OUTPUT: - RETVAL - -char * -setlocale(category, locale) - int category - char * locale - -double -acos(x) - double x - -double -asin(x) - double x - -double -atan(x) - double x - -double -ceil(x) - double x - -double -cosh(x) - double x - -double -floor(x) - double x - -double -fmod(x,y) - double x - double y - -void -frexp(x) - double x - PPCODE: - int expvar; - sp--; - /* (We already know stack is long enough.) */ - PUSHs(sv_2mortal(newSVnv(frexp(x,&expvar)))); - PUSHs(sv_2mortal(newSViv(expvar))); - -double -ldexp(x,exp) - double x - int exp - -double -log10(x) - double x - -void -modf(x) - double x - PPCODE: - double intvar; - sp--; - /* (We already know stack is long enough.) */ - PUSHs(sv_2mortal(newSVnv(modf(x,&intvar)))); - PUSHs(sv_2mortal(newSVnv(intvar))); - -double -sinh(x) - double x - -double -tanh(x) - double x - -SysRet -sigaction(sig, action, oldaction = 0) - int sig - POSIX::SigAction action - POSIX::SigAction oldaction - CODE: - -# This code is really grody because we're trying to make the signal -# interface look beautiful, which is hard. - - if (!siggv) - gv_fetchpv("SIG", TRUE, SVt_PVHV); - - { - struct sigaction act; - struct sigaction oact; - POSIX__SigSet sigset; - SV** svp; - SV** sigsvp = hv_fetch(GvHVn(siggv), - sig_name[sig], - strlen(sig_name[sig]), - TRUE); - - /* Remember old handler name if desired. */ - if (oldaction) { - char *hand = SvPVx(*sigsvp, na); - svp = hv_fetch(oldaction, "HANDLER", 7, TRUE); - sv_setpv(*svp, *hand ? hand : "DEFAULT"); - } - - if (action) { - /* Vector new handler through %SIG. (We always use sighandler - for the C signal handler, which reads %SIG to dispatch.) */ - svp = hv_fetch(action, "HANDLER", 7, FALSE); - if (!svp) - croak("Can't supply an action without a HANDLER"); - sv_setpv(*sigsvp, SvPV(*svp, na)); - mg_set(*sigsvp); /* handles DEFAULT and IGNORE */ - act.sa_handler = sighandler; - - /* Set up any desired mask. */ - svp = hv_fetch(action, "MASK", 4, FALSE); - if (svp && sv_isa(*svp, "POSIX::SigSet")) { - sigset = (sigset_t*)(unsigned long)SvNV((SV*)SvRV(*svp)); - act.sa_mask = *sigset; - } - else - sigemptyset(& act.sa_mask); - - /* Set up any desired flags. */ - svp = hv_fetch(action, "FLAGS", 5, FALSE); - act.sa_flags = svp ? SvIV(*svp) : 0; - } - - /* Now work around sigaction oddities */ - if (action && oldaction) - RETVAL = sigaction(sig, & act, & oact); - else if (action) - RETVAL = sigaction(sig, & act, (struct sigaction*)0); - else if (oldaction) - RETVAL = sigaction(sig, (struct sigaction*)0, & oact); - - if (oldaction) { - /* Get back the mask. */ - svp = hv_fetch(oldaction, "MASK", 4, TRUE); - if (sv_isa(*svp, "POSIX::SigSet")) - sigset = (sigset_t*)(unsigned long)SvNV((SV*)SvRV(*svp)); - else { - sigset = (sigset_t*)safemalloc(sizeof(sigset_t)); - sv_setptrobj(*svp, sigset, "POSIX::SigSet"); - } - *sigset = oact.sa_mask; - - /* Get back the flags. */ - svp = hv_fetch(oldaction, "FLAGS", 5, TRUE); - sv_setiv(*svp, oact.sa_flags); - } - } - OUTPUT: - RETVAL - -SysRet -sigpending(sigset) - POSIX::SigSet sigset - -SysRet -sigprocmask(how, sigset, oldsigset = 0) - int how - POSIX::SigSet sigset - POSIX::SigSet oldsigset - -SysRet -sigsuspend(signal_mask) - POSIX::SigSet signal_mask - -############ Work in progress - -#FileHandle -#fdopen(fd, type) -# int fd -# char * type - -#int -#ferror(handle) -# FileHandle handle - -#SysRet -#fflush(handle) -# OutputHandle handle - -void -_exit(status) - int status - -SysRet -close(fd) - int fd - -SysRet -dup(fd) - int fd - -SysRet -dup2(fd1, fd2) - int fd1 - int fd2 - -SysRet -lseek() - int fd - Off_t offset - int whence - -SysRet -nice(incr) - int incr - -int -pipe() - PPCODE: - int fds[2]; - sp--; - if (pipe(fds) != -1) { - EXTEND(sp,2); - PUSHs(sv_2mortal(newSViv(fds[0]))); - PUSHs(sv_2mortal(newSViv(fds[1]))); - } - -SysRet -read() - CODE: - int fd; - char * buffer; - size_t nbytes; - - RETVAL = read(fd, buffer, nbytes); - croak("POSIX::read() not implemented yet\n"); - OUTPUT: - RETVAL - -SysRet -setgid(gid) - Gid_t gid - -SysRet -setpgid(pid, pgid) - pid_t pid - pid_t pgid - -pid_t -setsid() - -SysRet -setuid(uid) - Uid_t uid - -pid_t -tcgetpgrp(fd) - int fd - -SysRet -tcsetpgrp(fd, pgrp_id) - int fd - pid_t pgrp_id - -int -uname() - PPCODE: - struct utsname buf; - sp--; - if (uname(&buf) >= 0) { - EXTEND(sp, 5); - PUSHs(sv_2mortal(newSVpv(buf.sysname, 0))); - PUSHs(sv_2mortal(newSVpv(buf.nodename, 0))); - PUSHs(sv_2mortal(newSVpv(buf.release, 0))); - PUSHs(sv_2mortal(newSVpv(buf.version, 0))); - PUSHs(sv_2mortal(newSVpv(buf.machine, 0))); - } - -SysRet -write() - CODE: - int fd; - char * buffer; - size_t nbytes; - - RETVAL = write(fd, buffer, nbytes); - croak("POSIX::write() not implemented yet\n"); - OUTPUT: - RETVAL diff --git a/ext/posix/typemap b/ext/posix/typemap deleted file mode 100644 index e339f10..0000000 --- a/ext/posix/typemap +++ /dev/null @@ -1,11 +0,0 @@ -mode_t T_NV -pid_t T_NV -Uid_t T_NV -Time_t T_NV -Gid_t T_NV -Off_t T_NV -fd T_IV -FILE * T_PTR -FileHandle T_PTROBJ -POSIX::SigSet T_PTROBJ -POSIX::SigAction T_HVOBJ diff --git a/ext/typemap b/ext/typemap index 1d0c9ba..98493e7 100644 --- a/ext/typemap +++ b/ext/typemap @@ -3,24 +3,32 @@ int T_IV unsigned T_IV unsigned int T_IV -long T_NV -unsigned long T_NV +long T_IV +unsigned long T_IV short T_IV unsigned short T_IV char T_CHAR unsigned char T_U_CHAR -char * T_STRING -unsigned char * T_STRING -caddr_t T_STRING +char * T_PV +unsigned char * T_PV +caddr_t T_PV +wchar_t * T_PV +wchar_t T_IV +bool_t T_IV +size_t T_IV +ssize_t T_IV +time_t T_NV unsigned long * T_OPAQUEPTR char ** T_PACKED void * T_PTR +Time_t * T_PV SV * T_SV -SV * T_SVOBJ -AV * T_AVOBJ -HV * T_HVOBJ -CV * T_CVOBJ +SVREF T_SVREF +AV * T_AVREF +HV * T_HVREF +CV * T_CVREF +IV T_IV I32 T_IV I16 T_IV I8 T_IV @@ -28,30 +36,36 @@ U32 T_U_LONG U16 T_U_SHORT U8 T_IV Result T_U_CHAR -Boolean T_U_CHAR +Boolean T_IV double T_DOUBLE SysRet T_SYSRET +SysRetLong T_SYSRET +FILE * T_IN +FileHandle T_PTROBJ +InputStream T_IN +InOutStream T_INOUT +OutputStream T_OUT ############################################################################# INPUT T_SV - $var = $arg; -T_SVOBJ + $var = $arg +T_SVREF if (sv_isa($arg, \"${ntype}\")) - $var = (AV*)SvRV($arg); + $var = (SV*)SvRV($arg); else croak(\"$var is not of type ${ntype}\") -T_AVOBJ +T_AVREF if (sv_isa($arg, \"${ntype}\")) $var = (AV*)SvRV($arg); else croak(\"$var is not of type ${ntype}\") -T_HVOBJ +T_HVREF if (sv_isa($arg, \"${ntype}\")) $var = (HV*)SvRV($arg); else croak(\"$var is not of type ${ntype}\") -T_CVOBJ +T_CVREF if (sv_isa($arg, \"${ntype}\")) $var = (CV*)SvRV($arg); else @@ -84,30 +98,41 @@ T_NV $var = ($type)SvNV($arg) T_DOUBLE $var = (double)SvNV($arg) -T_STRING - $var = SvPV($arg,na) +T_PV + $var = ($type)SvPV($arg,na) T_PTR - $var = ($type)(unsigned long)SvNV($arg) + $var = ($type)SvIV($arg) T_PTRREF if (SvROK($arg)) { - unsigned long tmp; - tmp = (unsigned long)SvNV((SV*)SvRV($arg)); + IV tmp = SvIV((SV*)SvRV($arg)); $var = ($type) tmp; } else croak(\"$var is not a reference\") +T_REF_IV_REF + if (sv_isa($arg, \"${type}\")) { + IV tmp = SvIV((SV*)SvRV($arg)); + $var = *($type *) tmp; + } + else + croak(\"$var is not of type ${ntype}\") +T_REF_IV_PTR + if (sv_isa($arg, \"${type}\")) { + IV tmp = SvIV((SV*)SvRV($arg)); + $var = ($type) tmp; + } + else + croak(\"$var is not of type ${ntype}\") T_PTROBJ if (sv_isa($arg, \"${ntype}\")) { - unsigned long tmp; - tmp = (unsigned long)SvNV((SV*)SvRV($arg)); + IV tmp = SvIV((SV*)SvRV($arg)); $var = ($type) tmp; } else croak(\"$var is not of type ${ntype}\") T_PTRDESC if (sv_isa($arg, \"${ntype}\")) { - unsigned long tmp; - tmp = (unsigned long)SvNV((SV*)SvRV($arg)); + IV tmp = SvIV((SV*)SvRV($arg)); ${type}_desc = (\U${type}_DESC\E*) tmp; $var = ${type}_desc->ptr; } @@ -115,16 +140,14 @@ T_PTRDESC croak(\"$var is not of type ${ntype}\") T_REFREF if (SvROK($arg)) { - unsigned long tmp; - tmp = (unsigned long)SvNV((SV*)SvRV($arg)); + IV tmp = SvIV((SV*)SvRV($arg)); $var = *($type) tmp; } else croak(\"$var is not a reference\") T_REFOBJ if (sv_isa($arg, \"${ntype}\")) { - unsigned long tmp; - tmp = (unsigned long)SvNV((SV*)SvRV($arg)); + IV tmp = SvIV((SV*)SvRV($arg)); $var = *($type) tmp; } else @@ -145,61 +168,71 @@ T_ARRAY while (items--) { DO_ARRAY_ELEM; } +T_IN + $var = IoIFP(sv_2io($arg)) +T_INOUT + $var = IoIFP(sv_2io($arg)) +T_OUT + $var = IoOFP(sv_2io($arg)) ############################################################################# OUTPUT T_SV $arg = $var; -T_SVOBJ +T_SVREF $arg = newRV((SV*)$var); -T_AVOBJ +T_AVREF $arg = newRV((SV*)$var); -T_HVOBJ +T_HVREF $arg = newRV((SV*)$var); -T_CVOBJ +T_CVREF $arg = newRV((SV*)$var); T_IV - sv_setiv($arg, (I32)$var); + sv_setiv($arg, (IV)$var); T_INT - sv_setiv($arg, (I32)$var); + sv_setiv($arg, (IV)$var); T_SYSRET if ($var != -1) { if ($var == 0) sv_setpvn($arg, "0 but true", 10); else - sv_setiv($arg, (I32)$var); + sv_setiv($arg, (IV)$var); } T_ENUM - sv_setiv($arg, (I32)$var); + sv_setiv($arg, (IV)$var); T_U_INT - sv_setiv($arg, (I32)$var); + sv_setiv($arg, (IV)$var); T_SHORT - sv_setiv($arg, (I32)$var); + sv_setiv($arg, (IV)$var); T_U_SHORT - sv_setiv($arg, (I32)$var); + sv_setiv($arg, (IV)$var); T_LONG - sv_setiv($arg, (I32)$var); + sv_setiv($arg, (IV)$var); T_U_LONG - sv_setiv($arg, (I32)$var); + sv_setiv($arg, (IV)$var); T_CHAR sv_setpvn($arg, (char *)&$var, 1); T_U_CHAR - sv_setiv($arg, (I32)$var); + sv_setiv($arg, (IV)$var); T_FLOAT sv_setnv($arg, (double)$var); T_NV sv_setnv($arg, (double)$var); T_DOUBLE sv_setnv($arg, (double)$var); -T_STRING - sv_setpv($arg, $var); +T_PV + sv_setpv((SV*)$arg, $var); T_PTR - sv_setnv($arg, (double)(unsigned long)$var); + sv_setiv($arg, (IV)$var); T_PTRREF - sv_setptrref($arg, $var); + sv_setref_pv($arg, Nullch, (void*)$var); +T_REF_IV_REF + sv_setref_pv($arg, \"${ntype}\", (void*)new $ntype($var)); +T_REF_IV_PTR + sv_setref_pv($arg, \"${ntype}\", (void*)$var); T_PTROBJ - sv_setptrobj($arg, $var, \"${ntype}\"); + sv_setref_pv($arg, \"${ntype}\", (void*)$var); T_PTRDESC - sv_setptrobj($arg, (void*)new\U${type}_DESC\E($var), \"${ntype}\"); + sv_setref_pv($arg, \"${ntype}\", (void*)new\U${type}_DESC\E($var)); T_REFREF sv_setrefref($arg, \"${ntype}\", XS_service_$ntype, ($var ? (void*)new $ntype($var) : 0)); @@ -225,3 +258,27 @@ T_ARRAY DO_ARRAY_ELEM } sp += $var.size - 1; +T_IN + { + GV *gv = newGVgen("$Package"); + if ( do_open(gv, "<&", 2, $var) ) + sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1))); + else + $arg = &sv_undef; + } +T_INOUT + { + GV *gv = newGVgen("$Package"); + if ( do_open(gv, "+<&", 3, $var) ) + sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1))); + else + $arg = &sv_undef; + } +T_OUT + { + GV *gv = newGVgen("$Package"); + if ( do_open(gv, "+>&", 3, $var) ) + sv_setsv($arg, sv_bless(newRV((SV*)gv), gv_stashpv("$Package",1))); + else + $arg = &sv_undef; + } diff --git a/ext/typemap.oi b/ext/typemap.oi deleted file mode 100644 index fc93718..0000000 --- a/ext/typemap.oi +++ /dev/null @@ -1,99 +0,0 @@ -# -#################################### PARCPLACE OI SECTION -# - -# basic OI types -OI_alignment T_ENUM -OI_bevel_style T_ENUM -OI_bool T_ENUM -OI_charset T_ENUM -OI_char_encode_type T_ENUM -OI_configure_mask T_ENUM -OI_drop_type T_ENUM -OI_ef_char_chk_status T_ENUM -OI_ef_entry_chk_status T_ENUM -OI_ef_mode T_ENUM -OI_enhance T_ENUM -OI_gravity T_ENUM -OI_gauge_ends T_ENUM -OI_gauge_ticks T_ENUM -OI_layout T_INT -OI_menu_cell_type T_ENUM -OI_mnemonic_style T_ENUM -OI_model_type T_ENUM -OI_mt_char_chk_status T_ENUM -OI_mt_entry_chk_status T_ENUM -OI_mt_mode T_ENUM -OI_number T_SHORT -OI_number * T_OPAQUEPTR -OI_orient T_ENUM -OI_pic_type T_ENUM -OI_pic_pixel T_ENUM -OI_psn_type T_ENUM -OI_rm_db T_ENUM -OI_sav_rst_typ T_ENUM -OI_scroll_event T_ENUM -OI_size_track T_ENUM -OI_slider_current T_ENUM -OI_slider_ends T_ENUM -OI_slider_ticks T_ENUM -OI_stat T_ENUM -OI_state T_ENUM -OI_wm_state T_ENUM -PIXEL T_LONG - -# OI classes -OI_abbr_menu * T_PTR -OI_animate_item * T_PTR -OI_app_window * T_PTR -OI_base_text * T_PTR -OI_box * T_PTR -OI_button_menu * T_PTR -OI_command_dialog_box * T_PTR -OI_excl_menu * T_PTR -OI_excl_check_menu * T_PTR -OI_excl_rect_menu * T_PTR -OI_basic_menu * T_PTR -OI_class * T_PTR -OI_connection * T_PTR -OI_ctlr_1d * T_PTR -OI_d_tech * T_PTR -OI_d_tech ** T_OPAQUEPTR -OI_dialog_box * T_PTR -OI_display_1d * T_PTR -OI_entry_field * T_PTR -OI_error_dialog_box * T_PTR -OI_excl_menu * T_PTR -OI_file_dialog_box * T_PTR -OI_gauge * T_PTR -OI_glyph * T_PTR -OI_help * T_PTR -OI_info_dialog_box * T_PTR -OI_menu * T_PTR -OI_menu_cell * T_PTR -OI_menu_cell ** T_OPAQUEPTR -OI_menu_spec * T_PACKED -OI_message_dialog_box * T_PTR -OI_ms_dialog_box * T_PTR -OI_multi_text * T_PTR -OI_panner * T_PTR -OI_pic_spec_mask * T_PTR -OI_pic_spec_mask ** T_OPAQUEPTR -OI_poly_menu * T_PTR -OI_poly_check_menu * T_PTR -OI_poly_rect_menu * T_PTR -OI_prompt_dialog_box * T_PTR -OI_question_dialog_box * T_PTR -OI_scroll_bar * T_PTR -OI_scroll_box * T_PTR -OI_scroll_menu * T_PTR -OI_scroll_text * T_PTR -OI_select_dialog_box * T_PTR -OI_separator * T_PTR -OI_seq_entry_field * T_PTR -OI_slider * T_PTR -OI_static_text * T_PTR -OI_translation_table * T_PTR -OI_warn_dialog_box * T_PTR -OI_work_dialog_box * T_PTR - diff --git a/ext/typemap.xlib b/ext/typemap.xlib deleted file mode 100644 index b04d130..0000000 --- a/ext/typemap.xlib +++ /dev/null @@ -1,97 +0,0 @@ -# -#################################### XLIB SECTION -# - -# basic X types -Atom T_U_LONG -Atom * T_OPAQUEPTR -Bool T_INT -KeyCode T_U_LONG -Status T_INT -Time T_U_LONG -VisualID T_U_LONG -XID T_U_LONG -GC T_PTR -Display * T_PTR -Screen * T_PTR -Visual * T_PTR -XImage * T_PTR -Region T_PTR - -# things that are XIDs -Colormap T_U_LONG -Cursor T_U_LONG -Drawable T_U_LONG -Font T_U_LONG -GContext T_U_LONG -KeySym T_U_LONG -KeySym * T_OPAQUEPTR -Pixmap T_U_LONG -Pixmap * T_OPAQUEPTR -Window T_U_LONG -Window * T_OPAQUEPTR - -# X resource manager types -XrmDatabase T_PTR -XrmQuark T_INT -XrmQuarkList T_OPAQUEPTR -XrmName T_INT -XrmNameList T_OPAQUEPTR -XrmClass T_INT -XrmClassList T_OPAQUEPTR -XrmRepresentation T_INT -XrmString T_STRING -XrmBinding T_ENUM -XrmBindingList T_OPAQUEPTR -XrmOptionKind T_ENUM -XrmSearchList T_OPAQUEPTR - -# context manager types -XContext T_INT - -# Xlib data structures -XArc * T_OPAQUEPTR -XCharStruct T_OPAQUE -XCharStruct * T_OPAQUEPTR -XColor T_OPAQUE -XColor * T_OPAQUEPTR -XComposeStatus * T_OPAQUEPTR -XEvent T_OPAQUE -XEvent * T_OPAQUEPTR -XFontStruct T_OPAQUE -XFontStruct * T_PTR -XGCValues * T_OPAQUEPTR -XIconSize * T_OPAQUEPTR -XKeyboardControl * T_OPAQUEPTR -XKeyboardState T_OPAQUE -XModifierKeymap * T_PTR -XPoint T_OPAQUE -XPoint * T_OPAQUEPTR -XRectangle T_OPAQUE -XRectangle * T_OPAQUEPTR -XSegment * T_OPAQUEPTR -XSetWindowAttributes * T_OPAQUEPTR -XSizeHints T_OPAQUE -XSizeHints * T_OPAQUEPTR -XStandardColormap T_OPAQUE -XStandardColormap * T_OPAQUEPTR -XTimeCoord * T_OPAQUEPTR -XVisualInfo T_OPAQUE -XVisualInfo * T_OPAQUEPTR -XWindowAttributes T_OPAQUE -XWindowAttributes * T_OPAQUEPTR -XWindowChanges * T_OPAQUEPTR -XWMHints * T_OPAQUEPTR - -# these data types must be handled specially -#XrmValue T_OPAQUE -#XrmValue * T_OPAQUEPTR -#XrmOptionDescList T_OPAQUEPTR -#XClassHint T_OPAQUE -#XClassHint * T_OPAQUEPTR -#XHostAddress * T_OPAQUEPTR -#XTextItem * T_OPAQUEPTR -#XTextItem16 * T_OPAQUEPTR -#XTextProperty T_OPAQUE -#XTextProperty * T_OPAQUEPTR - diff --git a/ext/typemap.xpm b/ext/typemap.xpm deleted file mode 100644 index d131276..0000000 --- a/ext/typemap.xpm +++ /dev/null @@ -1,7 +0,0 @@ -# -#################################### XPM SECTION -# -XpmAttributes * T_PACKED -XpmColorSymbol * T_PACKED -XpmExtension * T_PACKED - diff --git a/ext/util/extliblist b/ext/util/extliblist new file mode 100755 index 0000000..2b8938f --- /dev/null +++ b/ext/util/extliblist @@ -0,0 +1,151 @@ +case $CONFIG in +'') + if test -f config.sh; then TOP=.; + elif test -f ../config.sh; then TOP=..; + elif test -f ../../config.sh; then TOP=../..; + elif test -f ../../../config.sh; then TOP=../../..; + elif test -f ../../../../config.sh; then TOP=../../../..; + else + echo "Can't find config.sh."; exit 1 + fi + . $TOP/config.sh + ;; +esac +: extliblist +: +: Author: Andy Dougherty doughera@lafcol.lafayette.edu +: +: This utility takes a list of libraries in the form +: -llib1 -llib2 -llib3 +: and prints out lines suitable for inclusion in an extension +: Makefile. +: Extra library paths may be included with the form -L/another/path +: this will affect the searches for all subsequent libraries. +: +: It is intended to be "dotted" from within an extension Makefile.SH. +: see ext/POSIX/Makefile.SH for an example. +: Prior to calling this, the variable potential_libs should be set +: to the potential list of libraries +: +: It sets the following +: extralibs = full list of libraries needed for static linking. +: Only those libraries that actually exist are included. +: dynaloadlibs = full path names of those libraries that are needed +: but can be linked in dynamically on this platform. On +: SunOS, for example, this would be .so* libraries, +: but not archive libraries. +: Eventually, this list can be used to write a bootstrap file. +: statloadlibs = list of those libraries which must be statically +: linked into the shared library. On SunOS 4.1.3, +: for example, I have only an archive version of +: -lm, and it must be linked in statically. +: +: This script uses config.sh variables libs, libpth, and so. It is mostly +: taken from the metaconfig libs.U unit. +extralibs='' +dynaloadlibs='' +statloadlibs='' +Llibpth='' +for thislib in `echo "XXX $potential_libs " | $sed 's/ -l/ /g'` ; do + case "$thislib" in + XXX) + : Handle case where potential_libs is empty. + ;; + -L*) + : Handle possible linker path arguments. + newpath=`echo $thislib | $sed 's/^-L//'` + if $test -d $newpath; then + Llibpth="$Llibpth $newpath" + extralibs="$extralibs $thislib" + statloadlibs="$statloadlibs $thislib" + fi + ;; + *) + : Handle possible library arguments. + for thispth in $Llibpth $libpth; do + : Loop over possible wildcards and take the last one. + for fullname in $thispth/lib$thislib.$so.[0-9]* ; do + : + done + if $test -f $fullname; then + break + elif fullname=$thispth/lib$thislib.$so && $test -f $fullname; then + break + elif fullname=$thispth/lib${thislib}_s.a && $test -f $fullname; then + thislib=${thislib}_s + break + elif fullname=$thispth/lib${thislib}.a && $test -f $fullname; then + break + elif fullname=$thispth/Slib${thislib}.a && $test -f $fullname; then + break + else + fullname='' + fi + done + : Now update library lists + case "$fullname" in + '') + : Skip nonexistent files + ;; + *) + : Do not add it into the extralibs if it is already linked in + : with the main perl executable. + case " $libs " in + *" -l$thislib "*|*" -l${thislib}_s "*) ;; + *) extralibs="$extralibs -l$thislib" ;; + esac + : + : For NeXT and DLD, put files into DYNALOADLIBS to be + : converted into a boostrap file. For other systems, + : we will use ld with what I have misnamed STATLOADLIBS + : to assemble the shared object. + case "$dlsrc" in + dl_dld*|dl_next*) + dynaloadlibs="$dynaloadlibs $fullname" ;; + *) + case "$fullname" in + *.a) + statloadlibs="$statloadlibs -l$thislib" + ;; + *) + : For SunOS4, do not add in this shared library + : if it is already linked in the main + : perl executable + case "$osname" in + sunos) + case " $libs " in + *" -l$thislib "*) ;; + *) statloadlibs="$statloadlibs -l$thislib" ;; + esac + ;; + *) + statloadlibs="$statloadlibs -l$thislib" + ;; + esac + ;; + esac + ;; + esac + ;; + esac + ;; + esac +done + +case "$dlsrc" in +dl_next*) + extralibs=`echo " $extralibs "| $sed -e 's/ -lm / /'` ;; +esac + +set X $extralibs +shift +extralibs="$*" + +set X $dynaloadlibs +shift +dynaloadlibs="$*" + +set X $statloadlibs +shift +statloadlibs="$*" + diff --git a/ext/util/make_ext b/ext/util/make_ext new file mode 100644 index 0000000..fba77c0 --- /dev/null +++ b/ext/util/make_ext @@ -0,0 +1,74 @@ +# This script acts as a simple interface for building extensions. +# It primarily used by the perl Makefile: +# +# d_dummy $(dynamic_ext): miniperl preplibrary FORCE +# ext/util/make_ext dynamic $@ +# +# It may be deleted in a later release of perl so try to +# avoid using it for other purposes. + +linktype=$1 +extspec=$2 + +case $CONFIG in +'') + if test -f config.sh; then TOP=.; + elif test -f ../config.sh; then TOP=..; + elif test -f ../../config.sh; then TOP=../..; + elif test -f ../../../config.sh; then TOP=../../..; + elif test -f ../../../../config.sh; then TOP=../../../..; + else + echo "Can't find config.sh generated by Configure"; exit 1 + fi + . $TOP/config.sh + ;; +esac + +if test "X$extspec" = X; then + echo "make_ext: no extension specified" + exit 1; +fi + +# convert old style Name.a into ext/Name/Name.a format +case "$extspec" in +ext/*) ;; +*) extspec=`echo "$extspec" | sed -e 's:\(.*\)\.\(.*\):ext/\1/\1.\2:'` +esac + +# get extension directory path, module name and depth +pname=`echo "$extspec" | sed -e 's:^ext/::' -e 's:/[^/]*$::'` +mname=`echo "$pname" | sed -e 's!/!::!'` +depth=`echo "$pname" | sed -e 's![^/][^/]*!..!g'` + +if test ! -d "ext/$pname"; then + echo " Skipping $extspec (directory does not exist)" + exit 0 # not an error ? +fi + +# check link type and do any preliminaries +case "$linktype" in +static) makeargs='CCCDLFLAGS=' ;; +dynamic) makeargs='' ;; +*) echo "make_ext: unknown link type '$linktype'"; exit 1;; +'') echo "make_ext: no link type specified (eg static or dynamic)"; exit 1;; +esac + +echo "" +echo " Making $mname ($linktype)" + +cd ext/$pname + +if test ! -f Makefile ; then + test -f Makefile.PL && ../$depth/miniperl -I../$depth/lib Makefile.PL +fi +if test ! -f Makefile ; then + test -f Makefile.SH && sh Makefile.SH +fi + +make=${altmake-make} + +$make config + +$make $linktype $makeargs + +exit $? diff --git a/ext/util/mkbootstrap b/ext/util/mkbootstrap new file mode 100644 index 0000000..6c3a7e1 --- /dev/null +++ b/ext/util/mkbootstrap @@ -0,0 +1,5 @@ +#!../../miniperl -w -I../../lib + +use ExtUtils::MakeMaker; +&mkbootstrap(join(" ",@ARGV)); +exit; diff --git a/ext/xsubpp b/ext/xsubpp index bb69720..1e13118 100755 --- a/ext/xsubpp +++ b/ext/xsubpp @@ -1,11 +1,13 @@ #!./miniperl +'di '; +'ds 00 \"'; +'ig 00 '; # $Header$ -$usage = "Usage: xsubpp [-ansi] [-C++] [-except] [-tm typemap] file.xs\n"; +$usage = "Usage: xsubpp [-C++] [-except] [-typemap typemap] file.xs\n"; SWITCH: while ($ARGV[0] =~ s/^-//) { $flag = shift @ARGV; - $ansiflag = 1, next SWITCH if $flag eq 'ansi'; $spat = shift, next SWITCH if $flag eq 's'; $cplusplus = 1, next SWITCH if $flag eq 'C++'; $except = 1, next SWITCH if $flag eq 'except'; @@ -15,6 +17,7 @@ SWITCH: while ($ARGV[0] =~ s/^-//) { @ARGV == 1 or die $usage; chop($pwd = `pwd`); ($dir, $filename) = @ARGV[0] =~ m#(.*)/(.*)# + or ($dir, $filename) = @ARGV[0] =~ m#(.*[>\]])(.*)# or ($dir, $filename) = ('.', $ARGV[0]); chdir($dir); @@ -43,7 +46,7 @@ foreach $typemap (@tm) { } else { s/\s*$//; -# $input_expr{$_} = ''; + $input_expr{$_} = ''; $current = \$input_expr{$_}; } } @@ -53,7 +56,7 @@ foreach $typemap (@tm) { } else { s/\s*$//; -# $output_expr{$_} = ''; + $output_expr{$_} = ''; $current = \$output_expr{$_}; } } @@ -76,9 +79,9 @@ sub Q { open(F, $filename) || die "cannot open $filename\n"; while () { - last if ($Module, $foo, $Package, $foo1, $Prefix) = - /^MODULE\s*=\s*(\w+)(\s+PACKAGE\s*=\s*([\w:]+))?(\s+PREFIX\s*=\s*(\S+))?$/; - print $_; + last if ($Module, $foo, $Package, $foo1, $Prefix) = + /^MODULE\s*=\s*([\w:]+)(\s+PACKAGE\s*=\s*([\w:]+))?(\s+PREFIX\s*=\s*(\S+))?\s*$/; + print $_; } exit 0 if $_ eq ""; $lastline = $_; @@ -88,17 +91,20 @@ sub fetch_para { @line = (); if ($lastline ne "") { if ($lastline =~ - /^MODULE\s*=\s*(\w+)(\s+PACKAGE\s*=\s*([\w:]+))?(\s+PREFIX\s*=\s*(\S+))?$/) { + /^MODULE\s*=\s*([\w:]+)(\s+PACKAGE\s*=\s*([\w:]+))?(\s+PREFIX\s*=\s*(\S+))?\s*$/) { $Module = $1; $foo = $2; $Package = $3; $foo1 = $4; $Prefix = $5; + ($Module_cname = $Module) =~ s/\W/_/g; ($Packid = $Package) =~ s/:/_/g; $Packprefix = $Package; $Packprefix .= "::" if defined $Packprefix && $Packprefix ne ""; while () { chop; + next if /^#/ && + !/^#[ \t]*(if|ifdef|ifndef|else|elif|endif|define|undef)\b/; last if /^\S/; } push(@line, $_) if $_ ne ""; @@ -108,7 +114,8 @@ sub fetch_para { } $lastline = ""; while () { - next if /^#/ && !/^#(if|ifdef|else|elif|endif|define|undef)\b/; + next if /^#/ && + !/^#[ \t]*(if|ifdef|ifndef|else|elif|endif|define|undef)\b/; chop; if (/^\S/ && @line && $line[-1] eq "") { $lastline = $_; @@ -118,8 +125,9 @@ sub fetch_para { push(@line, $_); } } - pop(@line) while @line && $line[-1] eq ""; + pop(@line) while @line && $line[-1] =~ /^\s*$/; } + $PPCODE = grep(/PPCODE:/, @line); scalar @line; } @@ -135,6 +143,10 @@ while (&fetch_para) { # extract return type, function name and arguments $ret_type = shift(@line); + if ($ret_type =~ /^BOOT:/) { + push (@BootCode, @line, "", "") ; + next ; + } if ($ret_type =~ /^static\s+(.*)$/) { $static = 1; $ret_type = $1; @@ -149,10 +161,17 @@ while (&fetch_para) { push(@Func_name, "${Packid}_$func_name"); push(@Func_pname, $pname); @args = split(/\s*,\s*/, $orig_args); - if (defined($class) && !defined($static)) { + if (defined($class)) { + if (defined($static)) { + unshift(@args, "CLASS"); + $orig_args = "CLASS, $orig_args"; + $orig_args =~ s/^CLASS, $/CLASS/; + } + else { unshift(@args, "THIS"); $orig_args = "THIS, $orig_args"; $orig_args =~ s/^THIS, $/THIS/; + } } $orig_args =~ s/"/\\"/g; $min_args = $num_args = @args; @@ -172,7 +191,7 @@ while (&fetch_para) { $defaults{$args[$i]} =~ s/"/\\"/g; } } - if (defined($class) && !defined($static)) { + if (defined($class)) { $func_args = join(", ", @args[1..$#args]); } else { $func_args = join(", ", @args); @@ -180,23 +199,11 @@ while (&fetch_para) { @args_match{@args} = 1..@args; # print function header - if ($ansiflag) { - print Q<<"EOF"; -#static int -#XS_${Packid}_$func_name(int, int ax, int items) -#[[ -EOF - } - else { - print Q<<"EOF"; -#static int -#XS_${Packid}_$func_name(ix, ax, items) -#register int ix; -#register int ax; -#register int items; + print Q<<"EOF"; +#XS(XS_${Packid}_$func_name) #[[ +# dXSARGS; EOF - } if ($elipsis) { $cond = qq(items < $min_args); } @@ -218,6 +225,10 @@ EOF # } EOF + print Q<<"EOF" if $PPCODE; +# SP -= items; +EOF + # Now do a block of some sort. $condnum = 0; @@ -258,6 +269,9 @@ EOF $_ = shift(@line); last if /^\s*NOT_IMPLEMENTED_YET/; last if /^\s*(PPCODE|CODE|OUTPUT|CLEANUP|CASE)\s*:/; + # Catch common error. Much more error checking required here. + blurt("Error: no tab in $pname argument declaration '$_'\n") + unless (m/\S+\s*\t\s*\S+/); ($var_type, $var_name, $var_init) = /\s*([^\t]+)\s*([^\s=]+)\s*(=.*)?/; if ($var_name =~ /^&/) { @@ -286,10 +300,17 @@ EOF print "\t$var_name;\n"; } } - if (!$thisdone && defined($class) && !defined($static)) { + if (!$thisdone && defined($class)) { + if (defined($static)) { + print "\tchar *"; + $var_types{"CLASS"} = "char *"; + &generate_init("char *", 1, "CLASS"); + } + else { print "\t$class *"; $var_types{"THIS"} = "$class *"; &generate_init("$class *", 1, "THIS"); + } } # do code @@ -303,14 +324,14 @@ EOF $var_types{"RETVAL"} = $ret_type; } if (/^\s*PPCODE:/) { - print "\tdSP;\n"; print $deferred; while (@line) { $_ = shift(@line); - last if /^\s*(OUTPUT|CLEANUP|CASE)\s*:/; + die "PPCODE must be last thing" + if /^\s*(OUTPUT|CLEANUP|CASE)\s*:/; print "$_\n"; } - print "\tax = sp - stack_base;\n"; + print "\tPUTBACK;\n\treturn;\n"; } elsif (/^\s*CODE:/) { print $deferred; while (@line) { @@ -318,6 +339,10 @@ EOF last if /^\s*(OUTPUT|CLEANUP|CASE)\s*:/; print "$_\n"; } + } elsif ($func_name eq "DESTROY") { + print $deferred; + print "\n\t"; + print "delete THIS;\n" } else { print $deferred; print "\n\t"; @@ -325,7 +350,12 @@ EOF print "RETVAL = "; } if (defined($static)) { + if ($func_name =~ /^new/) { + $func_name = "$class"; + } + else { print "$class::"; + } } elsif (defined($class)) { print "THIS->"; } @@ -346,7 +376,7 @@ EOF s/^\s+//; ($outarg, $outcode) = split(/\t+/); if ($outcode) { - print "\t$outcode\n"; + print "\t$outcode\n"; } else { die "$outarg not an argument" unless defined($args_match{$outarg}); @@ -383,12 +413,17 @@ EOF unshift(@line, $_); } } + print Q<= 2 && @ARGV <= 6); - -SWITCH: while ($ARGV[0] =~ /^-/) { - $flag = shift @ARGV; - $aflag = 1, next SWITCH if $flag =~ /^-a$/; - $spat = $1, next SWITCH if $flag =~ /^-s(.*)$/; - $cflag = 1, next SWITCH if $flag =~ /^-c$/; - $eflag = 1, next SWITCH if $flag =~ /^-e$/; - die $usage; -} - -$typemap = shift @ARGV; -open(TYPEMAP, $typemap) || die "cannot open $typemap\n"; -while () { - next if /^\s*$/ || /^#/; - chop; - ($typename, $kind) = split(/\t+/, $_, 2); - $type_kind{$typename} = $kind; -} -close(TYPEMAP); - -%input_expr = (JUNK, split(/\n(T_\w*)\s*\n/, <<'T_END')); - -T_INT - $var = (int)SvIVn($arg) -T_ENUM - $var = ($type)SvIVn($arg) -T_U_INT - $var = (unsigned int)SvIVn($arg) -T_SHORT - $var = (short)SvIVn($arg) -T_U_SHORT - $var = (unsigned short)SvIVn($arg) -T_LONG - $var = (long)SvIVn($arg) -T_U_LONG - $var = (unsigned long)SvIVn($arg) -T_CHAR - $var = (char)*SvPVn($arg,na) -T_U_CHAR - $var = (unsigned char)SvIVn($arg) -T_FLOAT - $var = (float)SvNVn($arg) -T_DOUBLE - $var = SvNVn($arg) -T_STRING - $var = SvPVn($arg,na) -T_PTR - $var = ($type)(unsigned long)SvNVn($arg) -T_PTRREF - if (SvTYPE($arg) == SVt_REF) - $var = ($type)(unsigned long)SvNVn((SV*)SvANY($arg)); - else - croak(\"$var is not a reference\") -T_PTROBJ - if (sv_isa($arg, \"${ntype}\")) - $var = ($type)(unsigned long)SvNVn((SV*)SvANY($arg)); - else - croak(\"$var is not of type ${ntype}\") -T_PTRDESC - if (sv_isa($arg, \"${ntype}\")) { - ${type}_desc = (\U${type}_DESC\E*)(unsigned long)SvNVn((SV*)SvANY($arg)); - $var = ${type}_desc->ptr; - } - else - croak(\"$var is not of type ${ntype}\") -T_REFREF - if (SvTYPE($arg) == SVt_REF) - $var = *($type)(unsigned long)SvNVn((SV*)SvANY($arg)); - else - croak(\"$var is not a reference\") -T_REFOBJ - if (sv_isa($arg, \"${ntype}\")) - $var = *($type)(unsigned long)SvNVn((SV*)SvANY($arg)); - else - croak(\"$var is not of type ${ntype}\") -T_OPAQUE - $var NOT IMPLEMENTED -T_OPAQUEPTR - $var = ($type)SvPVn($arg,na) -T_PACKED - $var = XS_unpack_$ntype($arg) -T_PACKEDARRAY - $var = XS_unpack_$ntype($arg) -T_CALLBACK - $var = make_perl_cb_$type($arg) -T_ARRAY - $var = $ntype(items -= $argoff); - U32 ix_$var = $argoff; - while (items--) { - DO_ARRAY_ELEM; - } -T_DATUM - $var.dptr = SvPVn($arg, $var.dsize); -T_GDATUM - UNIMPLEMENTED -T_PLACEHOLDER -T_END - -$* = 1; %output_expr = (JUNK, split(/^(T_\w*)\s*\n/, <<'T_END')); $* = 0; -T_INT - sv_setiv($arg, (I32)$var); -T_ENUM - sv_setiv($arg, (I32)$var); -T_U_INT - sv_setiv($arg, (I32)$var); -T_SHORT - sv_setiv($arg, (I32)$var); -T_U_SHORT - sv_setiv($arg, (I32)$var); -T_LONG - sv_setiv($arg, (I32)$var); -T_U_LONG - sv_setiv($arg, (I32)$var); -T_CHAR - sv_setpvn($arg, (char *)&$var, 1); -T_U_CHAR - sv_setiv($arg, (I32)$var); -T_FLOAT - sv_setnv($arg, (double)$var); -T_DOUBLE - sv_setnv($arg, $var); -T_STRING - sv_setpv($arg, $var); -T_PTR - sv_setnv($arg, (double)(unsigned long)$var); -T_PTRREF - sv_setptrref($arg, $var); -T_PTROBJ - sv_setptrobj($arg, $var, \"${ntype}\"); -T_PTRDESC - sv_setptrobj($arg, (void*)new\U${type}_DESC\E($var), \"${ntype}\"); -T_REFREF - sv_setrefref($arg, \"${ntype}\", XS_service_$ntype, - ($var ? (void*)new $ntype($var) : 0)); -T_REFOBJ - NOT IMPLEMENTED -T_OPAQUE - sv_setpvn($arg, (char *)&$var, sizeof($var)); -T_OPAQUEPTR - sv_setpvn($arg, (char *)$var, sizeof(*$var)), XFree((char *)$var); -T_PACKED - XS_pack_$ntype($arg, $var); -T_PACKEDARRAY - XS_pack_$ntype($arg, $var, count_$ntype); -T_DATAUNIT - sv_setpvn($arg, $var.chp(), $var.size()); -T_CALLBACK - sv_setpvn($arg, $var.context.value().chp(), - $var.context.value().size()); -T_ARRAY - ST_EXTEND($var.size); - for (U32 ix_$var = 0; ix_$var < $var.size; ix_$var++) { - ST(ix_$var) = sv_mortalcopy(&sv_undef); - DO_ARRAY_ELEM - } - sp += $var.size - 1; -T_DATUM - sv_setpvn($arg, $var.dptr, $var.dsize); -T_GDATUM - sv_usepvn($arg, $var.dptr, $var.dsize); -T_END - -$uvfile = shift @ARGV; -open(F, $uvfile) || die "cannot open $uvfile\n"; - -if ($eflag) { - print qq|#include "cfm/basic.h"\n|; -} - -while () { - last if ($Module, $foo, $Package, $foo1, $Prefix) = - /^MODULE\s*=\s*(\w+)(\s+PACKAGE\s*=\s*(\w+))?(\s+PREFIX\s*=\s*(.+))?$/; - print $_; -} -$Pack = $Package; -$Package .= "::" if defined $Package && $Package ne ""; -$/ = ""; - -while () { - # parse paragraph - chop; - next if /^\s*$/; - next if /^(#.*\n?)+$/; - if (/^MODULE\s*=\s*(\w+)(\s+PACKAGE\s*=\s*(\w+))?(\s+PREFIX\s*=\s*(.+))?$/) { - $Module = $1; - $foo = $2; - $Package = $3; - $Pack = $Package; - $foo1 = $4; - $Prefix = $5; - $Package .= "::" if defined $Package && $Package ne ""; - next; - } - split(/[\t ]*\n/); - - # initialize info arrays - undef(%args_match); - undef(%var_types); - undef(%var_addr); - undef(%defaults); - undef($class); - undef($static); - undef($elipsis); - - # extract return type, function name and arguments - $ret_type = shift(@_); - if ($ret_type =~ /^static\s+(.*)$/) { - $static = 1; - $ret_type = $1; - } - $func_header = shift(@_); - ($func_name, $orig_args) = $func_header =~ /^([\w:]+)\s*\((.*)\)$/; - if ($func_name =~ /(.*)::(.*)/) { - $class = $1; - $func_name = $2; - } - ($pname = $func_name) =~ s/^($Prefix)?/$Package/; - push(@Func_name, "${Pack}_$func_name"); - push(@Func_pname, $pname); - @args = split(/\s*,\s*/, $orig_args); - if (defined($class) && !defined($static)) { - unshift(@args, "THIS"); - $orig_args = "THIS, $orig_args"; - $orig_args =~ s/^THIS, $/THIS/; - } - $orig_args =~ s/"/\\"/g; - $min_args = $num_args = @args; - foreach $i (0..$num_args-1) { - if ($args[$i] =~ s/\.\.\.//) { - $elipsis = 1; - $min_args--; - if ($args[i] eq '' && $i == $num_args - 1) { - pop(@args); - last; - } - } - if ($args[$i] =~ /([^=]*\S)\s*=\s*(.*)/) { - $min_args--; - $args[$i] = $1; - $defaults{$args[$i]} = $2; - $defaults{$args[$i]} =~ s/"/\\"/g; - } - } - if (defined($class) && !defined($static)) { - $func_args = join(", ", @args[1..$#args]); - } else { - $func_args = join(", ", @args); - } - @args_match{@args} = 1..@args; - - # print function header - print <<"EOF" if $aflag; -static int -XS_${Pack}_$func_name(int, int sp, int items) -EOF - print <<"EOF" if !$aflag; -static int -XS_${Pack}_$func_name(ix, sp, items) -register int ix; -register int sp; -register int items; -EOF - print <<"EOF" if $elipsis; -{ - if (items < $min_args) { - croak("Usage: $pname($orig_args)"); - } -EOF - print <<"EOF" if !$elipsis; -{ - if (items < $min_args || items > $num_args) { - croak("Usage: $pname($orig_args)"); - } -EOF - -# Now do a block of some sort. - -$condnum = 0; -if (!@_) { - @_ = "CLEANUP:"; -} -while (@_) { - if ($_[0] =~ s/^\s*CASE\s*:\s*//) { - $cond = shift(@_); - if ($condnum == 0) { - print " if ($cond)\n"; - } - elsif ($cond ne '') { - print " else if ($cond)\n"; - } - else { - print " else\n"; - } - $condnum++; - } - - print <<"EOF" if $eflag; - TRY { -EOF - print <<"EOF" if !$eflag; - { -EOF - - # do initialization of input variables - $thisdone = 0; - $retvaldone = 0; - $deferred = ""; - while ($_ = shift(@_)) { - last if /^\s*NOT_IMPLEMENTED_YET/; - last if /^\s*(CODE|OUTPUT|CLEANUP|CASE)\s*:/; - ($var_type, $var_name, $var_init) = - /\s*([^\t]+)\s*([^\s=]+)\s*(=.*)?/; - if ($var_name =~ /^&/) { - $var_name =~ s/^&//; - $var_addr{$var_name} = 1; - } - $thisdone |= $var_name eq "THIS"; - $retvaldone |= $var_name eq "RETVAL"; - $var_types{$var_name} = $var_type; - print "\t" . &map_type($var_type); - $var_num = $args_match{$var_name}; - if ($var_addr{$var_name}) { - $func_args =~ s/\b($var_name)\b/&\1/; - } - if ($var_init !~ /^=\s*NO_INIT\s*$/) { - if ($var_init !~ /^\s*$/) { - &output_init($var_type, $var_num, - "$var_name $var_init"); - } elsif ($var_num) { - # generate initialization code - &generate_init($var_type, $var_num, $var_name); - } else { - print ";\n"; - } - } else { - print "\t$var_name;\n"; - } - } - if (!$thisdone && defined($class) && !defined($static)) { - print "\t$class *"; - $var_types{"THIS"} = "$class *"; - &generate_init("$class *", 1, "THIS"); - } - - # do code - if (/^\s*NOT_IMPLEMENTED_YET/) { - print "\ncroak(\"$pname: not implemented yet\");\n"; - } else { - if ($ret_type ne "void") { - print "\t" . &map_type($ret_type) . "\tRETVAL;\n" - if !$retvaldone; - $args_match{"RETVAL"} = 0; - $var_types{"RETVAL"} = $ret_type; - } - print $deferred; - if (/^\s*CODE:/) { - while ($_ = shift(@_)) { - last if /^\s*(OUTPUT|CLEANUP|CASE)\s*:/; - print "$_\n"; - } - } else { - print "\n\t"; - if ($ret_type ne "void") { - print "RETVAL = "; - } - if (defined($static)) { - print "$class::"; - } elsif (defined($class)) { - print "THIS->"; - } - if (defined($spat) && $func_name =~ /^($spat)(.*)$/) { - $func_name = $2; - } - print "$func_name($func_args);\n"; - &generate_output($ret_type, 0, "RETVAL") - unless $ret_type eq "void"; - } - } - - # do output variables - if (/^\s*OUTPUT\s*:/) { - while ($_ = shift(@_)) { - last if /^\s*CLEANUP\s*:/; - s/^\s+//; - ($outarg, $outcode) = split(/\t+/); - if ($outcode) { - print "\t$outcode\n"; - } else { - die "$outarg not an argument" - unless defined($args_match{$outarg}); - $var_num = $args_match{$outarg}; - &generate_output($var_types{$outarg}, $var_num, - $outarg); - } - } - } - # do cleanup - if (/^\s*CLEANUP\s*:/) { - while ($_ = shift(@_)) { - last if /^\s*CASE\s*:/; - print "$_\n"; - } - } - # print function trailer - print <= 2 && @ARGV <= 4); - -SWITCH: while ($ARGV[0] =~ /^-/) { - $flag = shift @ARGV; - $aflag = 1, next SWITCH if $flag =~ /^-a$/; - $cflag = 1, next SWITCH if $flag =~ /^-c$/; - die $usage; -} - -$typemap = shift @ARGV; -open(TYPEMAP, $typemap) || die "cannot open $typemap\n"; -while () { - next if /^\s*$/ || /^#/; - chop; - ($typename, $kind) = split(/\t+/); - $type_kind{$typename} = $kind; -} -close(TYPEMAP); - -$uvfile = shift @ARGV; -open(F, $uvfile) || die "cannot open $uvfile\n"; -#($uvoutfile = $uvfile) =~ s|^.*/([^/]*).us$|\1.c| ; -#print "uvoutfile is $uvoutfile\n"; - -#open(FOUT, ">$uvoutfile") || die "cannot open $uvoutfile\n"; -#select(FOUT); - -while () { - last if ($Module, $foo, $Package, $foo1, $Prefix) = - /^MODULE\s*=\s*(\w+)(\s+PACKAGE\s*=\s*(\w+))?(\s+PREFIX\s*=\s*(\w+))?/; - print $_; -} -$Package .= "::" if defined $Package && $Package ne ""; -print <) { - next if /^s*$/ || /^#/; - if (/^MODULE\s*=\s*(\w+)(\s+PACKAGE\s*=\s*(\w+))?(\s+PREFIX\s*=\s*(\w+))?/) { - $Module = $1; - $foo = $2; - $Package = $3; - $foo1 = $4; - $Prefix = $5; - $Package .= "'" if defined $Package && $Package ne ""; - next; - } - chop; - $func = undef; - ($var, $kind, $store, $read) = split(/\t+/); - die "$kind not defined in typemap\n" if !defined($type_kind{$kind}); - $flags = "0"; - if ($store =~ /FUNC=(.*)/) { - $flags .= "|VI_FUNC"; - $func = $1; - } elsif ($store eq "VAR") { - $flags .= "|VI_VARIABLE"; - } elsif ($store ne "VAL") { - die "$var storage class not VAL, VAR or FUNC\n"; - } - if ($read eq "READWRITE") { - $flags .= "|VI_READWRITE"; - } elsif ($read ne "READONLY") { - die "$var access class not READONLY or READWRITE\n"; - } - SIZE: { - $type_kind = $type_kind{$kind}; - $size = 0; - do {$size = "sizeof(int)"; last SIZE; } - if ($type_kind eq "T_INT"); - do {$size = "sizeof($kind)"; last SIZE; } - if ($type_kind eq "T_ENUM"); - do {$size = "sizeof(unsigned int)"; last SIZE; } - if ($type_kind eq "T_U_INT"); - do {$size = "sizeof(short)"; last SIZE; } - if ($type_kind eq "T_SHORT"); - do {$size = "sizeof(unsigned short)"; last SIZE; } - if ($type_kind eq "T_U_SHORT"); - do {$size = "sizeof(long)"; last SIZE; } - if ($type_kind eq "T_LONG"); - do {$size = "sizeof(unsigned long)"; last SIZE; } - if ($type_kind eq "T_U_LONG"); - do {$size = "sizeof(char)"; last SIZE; } - if ($type_kind eq "T_CHAR"); - do {$size = "sizeof(unsigned char)"; last SIZE; } - if ($type_kind eq "T_U_CHAR"); - do {$size = "0"; last SIZE; } - if ($type_kind eq "T_STRING"); - do {$size = "sizeof(char *)"; last SIZE; } - if ($type_kind eq "T_PTR"); - do {$size = "sizeof($kind)"; last SIZE; } - if ($type_kind eq "T_OPAQUE"); - } - ($name = $var) =~ s/^$Prefix//; - print " { \"$Package$name\", $type_kind, $flags, $size, "; - if ($store =~ /FUNC/) { - print "(char *)$func, 0.0 },\n"; - } elsif ($store eq "VAR") { - print "(char *)&$var, 0.0 },\n"; - } elsif ($type_kind eq "T_FLOAT" || $type_kind eq "T_DOUBLE") { - print "0, $var },\n"; - } else { - print "(char *)$var, 0.0 },\n"; - } -} -print < or . -Special thanks to Larry Wall for initially reviewing this list for -accuracy and especially for writing and releasing Perl in the first place. - - -1.1) What is Perl? -1.2) Is Perl hard to learn? -1.3) Should I program everything in Perl? -1.4) Where can I get Perl over the Internet? -1.5) Where can I get Perl via Email? -1.6) How can I get Perl via UUCP? -1.7) Where can I get more information on Perl? -1.8) Can people who aren't on USENET receive comp.lang.perl as a digest? -1.9) Are archives of comp.lang.perl available? -1.10) How do I get Perl to run on machine FOO? -1.11) Where can I get (info|inter|ora|sql|syb)perl? -1.12) There's an a2p and an s2p; why isn't there a p2c (perl-to-C)? -1.13) Where can I get undump for my machine? -1.14) Where can I get a perl-mode for emacs? -1.15) How can I use Perl interactively? -1.16) Is there a Perl shell? -1.17) Is there a Perl profiler? -1.18) Is there a yacc for Perl? -1.19) How can I use curses with perl? -1.20) How can I use X with Perl? -1.21) What is perl4? What is perl5? -1.22) How does Perl compare with languages like REXX or TCL? -1.23) Is it a Perl program or a Perl script? -1.24) What's the difference between "Perl" and "perl"? -1.25) What companies use or ship Perl? -1.26) Is there commercial, 3rd-party support for Perl? -1.27) Where can I get a list of the JAPH signature quotes? -1.28) Where can I get a list of Larry Wall witticisms? - -2.1) What are all these $@*%<> signs and how do I know when to use them? -2.2) Why don't backticks work as they do in shells? -2.3) How come Perl operators have different precedence than C operators? -2.4) How come my converted awk/sed/sh script runs more slowly in Perl? -2.5) How can I call my system's unique C functions from Perl? -2.6) Where do I get the include files to do ioctl() or syscall()? -2.7) Why doesn't "local($foo) = ;" work right? -2.8) How can I detect keyboard input without reading it? -2.9) How can I make an array of arrays or other recursive data types? -2.10) How can I quote a variable to use in a regexp? -2.11) Why do setuid Perl scripts complain about kernel problems? -2.12) How do I open a pipe both to and from a command? -2.13) How can I change the first N letters of a string? -2.14) How can I manipulate fixed-record-length files? -2.15) How can I make a file handle local to a subroutine? -2.16) How can I extract just the unique elements of an array? -2.17) How can I call alarm() or usleep() from Perl? -2.18) How can I test whether an array contains a certain element? -2.19) How can I do an atexit() or setjmp()/longjmp() in Perl? -2.20) Why doesn't Perl interpret my octal data octally? -2.21) How do I sort an associative array by value instead of by key? -2.22) How can I capture STDERR from an external command? -2.23) Why doesn't open return an error when a pipe open fails? -2.24) How can I compare two date strings? -2.25) What's the fastest way to code up a given task in perl? -2.26) How can I know how many entries are in an associative array? -2.27) Why can't my perl program read from STDIN after I gave it ^D (EOF) ? -2.28) Do I always/never have to quote my strings or use semicolons? -2.29) How can I translate tildes in a filename? -2.30) How can I convert my shell script to Perl? -2.31) What is variable suicide and how can I prevent it? -2.32) Can I use Perl regular expressions to match balanced text? -2.33) Can I use Perl to run a telnet or ftp session? -2.34) What does "Malformed command links" mean? - - - -1.1) What is Perl? - - A programming language, by Larry Wall . - - Here's the beginning of the description from the man page: - - Perl is an interpreted language optimized for scanning arbitrary text - files, extracting information from those text files, and printing reports - based on that information. It's also a good language for many system - management tasks. The language is intended to be practical (easy to use, - efficient, complete) rather than beautiful (tiny, elegant, minimal). It - combines (in the author's opinion, anyway) some of the best features of C, - sed, awk, and sh, so people familiar with those languages should have - little difficulty with it. (Language historians will also note some - vestiges of csh, Pascal, and even BASIC-PLUS.) Expression syntax - corresponds quite closely to C expression syntax. Unlike most Unix - utilities, Perl does not arbitrarily limit the size of your data--if - you've got the memory, Perl can slurp in your whole file as a single - string. Recursion is of unlimited depth. And the hash tables used by - associative arrays grow as necessary to prevent degraded performance. - Perl uses sophisticated pattern matching techniques to scan large amounts - of data very quickly. Although optimized for scanning text, Perl can also - deal with binary data, and can make dbm files look like associative arrays - (where dbm is available). Setuid Perl scripts are safer than C programs - through a dataflow tracing mechanism which prevents many stupid security - holes. If you have a problem that would ordinarily use sed or awk or sh, - but it exceeds their capabilities or must run a little faster, and you - don't want to write the silly thing in C, then Perl may be for you. There - are also translators to turn your sed and awk scripts into Perl scripts. - - -1.2) Is Perl hard to learn? - - No, Perl is easy to learn for two reasons. - - The first reason is that most of Perl is derived from existing tools - and languages, ones that many people who turn to Perl already have - some familiarity with. These include the C programming language, the - UNIX C library, the UNIX shell, sed, and awk. If you already know - these somewhat, Perl should be very easy for you. - - The second reason that Perl is easy to learn is that you don't have to - know every thing there is to know about it in order to get good use - out of it. In fact, just a very small subset, mostly borrowed from C, - the shell, and sed, will be enough for most tasks. As you feel the - need or desire to use more sophisticated features (such as C - structures or networking), you can learn these as you go. The - learning curve for Perl is not a steep one, especially if you have - the headstart of having a background in UNIX. Rather, its learning - curve is gentle and gradual, but it *is* admittedly rather long. - - If you don't know C or UNIX at all, it'll be a steeper learning curve, - but what you then learn from Perl will carry over into other areas, - like using the C library, UNIX system call, regular expressions, and - associative arrays, just to name a few. To know Perl is to know - UNIX, and vice versa. - - -1.3) Should I program everything in Perl? - - Of course not. You should choose the appropriate tool for the task at - hand. While it's true that the answer to the question "Can I do (some - arbitrary task) in Perl?" is almost always "yes", that doesn't mean - this is necessarily a good thing to do. For many people, Perl serves - as a great replacement for shell programming. For a few people, it - also serves as a replacement for most of what they'd do in C. But - for some things, Perl just isn't the optimal choice, such as tasks - requiring very complex data structures. - - -1.4) Where can I get Perl over the Internet? - - From any comp.sources.misc archive. Initial sources were posted to - Volume 18, Issues 19-54 at patchlevel 3. The Patches 4-10 were posted - to Volume 20, Issues 56-62. You can use the archie server - (see the alt.sources FAQ in news.answers) for ways to find these. - - These machines, at the very least, definitely have it available for - anonymous FTP: - - ftp.uu.net 137.39.1.2 - archive.cis.ohio-state.edu 128.146.8.52 - jpl-devvax.jpl.nasa.gov 128.149.1.143 - ftp.netlabs.com 192.94.48.152 - prep.ai.mit.edu 18.71.0.38 - archive.cs.ruu.nl 131.211.80.5 (Europe) - - - - -1.5) Where can I get Perl via Email? - - If you are in Europe, you might using the following site. (I'm still - looking for a domestic site.) This information thanks to "Henk P. - Penning" : One automated fashion is as follows: - - Email: Send a message to 'mail-server@cs.ruu.nl' containing: - begin - path your_email_address - send help - send PERL/INDEX - end - The path-line may be omitted if your message contains a normal From:-line. - You will receive a help-file and an index of the directory that contains - the Perl stuff. - - If all else fails, mail to Larry usually suffices. - - -1.6) How can I get Perl via UUCP? - - You can get it from the site osu-cis; here is the appropriate info, - thanks to J Greely or . - - E-mail contact: - osu-cis!uucp - Get these two files first: - osu-cis!~/GNU.how-to-get. - osu-cis!~/ls-lR.Z - Current Perl distribution: - osu-cis!~/perl/4.0/kits@10/perl.kitXX.Z (XX=01-37) - How to reach osu-cis via uucp(L.sys/Systems file lines): - # - # Direct Trailblazer - # - osu-cis Any ACU 19200 1-614-292-5112 in:--in:--in: Uanon - # - # Direct V.32 (MNP 4) - # dead, dead, dead...sigh. - # - #osu-cis Any ACU 9600 1-614-292-1153 in:--in:--in: Uanon - # - # Micom port selector, at 1200, 2400, or 9600 bps. - # Replace ##'s below with 12, 24, or 96 (both speed and phone number). - # - osu-cis Any ACU ##00 1-614-292-31## "" \r\c Name? osu-cis nected \c GO \d\r\d\r\d\r in:--in:--in: - Uanon - - Modify as appropriate for your site, of course, to deal with your - local telephone system. There are no limitations concerning the hours - of the day you may call. - - Another possibility is to use UUNET, although they charge you - for it. You have been duly warned. Here's the advert: - - Anonymous Access to UUNET's Source Archives - - 1-900-GOT-SRCS - - UUNET now provides access to its extensive collection of UNIX - related sources to non- subscribers. By calling 1-900-468-7727 - and using the login "uucp" with no password, anyone may uucp any - of UUNET's on line source collection. Callers will be charged 40 - cents per minute. The charges will appear on their next tele- - phone bill. - - The file uunet!/info/help contains instructions. The file - uunet!/index//ls-lR.Z contains a complete list of the files available - and is updated daily. Files ending in Z need to be uncompressed - before being used. The file uunet!~/compress.tar is a tar - archive containing the C sources for the uncompress program. - - This service provides a cost effective way of obtaining - current releases of sources without having to maintain accounts - with UUNET or some other service. All modems connected to the - 900 number are Telebit T2500 modems. These modems support all - standard modem speeds including PEP, V.32 (9600), V.22bis (2400), - Bell 212a (1200), and Bell 103 (300). Using PEP or V.32, a 1.5 - megabyte file such as the GNU C compiler would cost $10 in con- - nect charges. The entire 55 megabyte X Window system V11 R4 - would cost only $370 in connect time. These costs are less than - the official tape distribution fees and they are available now - via modem. - - UUNET Communications Services - 3110 Fairview Park Drive, Suite 570 - Falls Church, VA 22042 - +1 703 876 5050 (voice) - +1 703 876 5059 (fax) - info@uunet.uu.net - - - -1.7) Where can I get more information on Perl? - - We'll cover five areas here: USENET (where you're probably reading - this), publications, the reference guide, examples on the Internet, - and Perl instructional courses. - - A. USENET - - You should definitely read the USENET comp.lang.perl newsgrouor - mailing list for all sorts of discussions regarding the language, - bugs, features, history, humor, and trivia. In this respect, it - functions both as a comp.lang.* style newsgroup and also as a user - group for the language; in fact, there's a mailing list called - ``perl-users'' that is bidirectionally gatewayed to the newsgroup; see - question #38 for details. Larry Wall is a very frequent poster here, - as well as many (if not most) of the other seasoned Perl programmers. - It's the best place for the very latest information on Perl. - - B. PUBLICATIONS - - If you've been dismayed by the ~80-page troffed Perl man page (or is - that man treatise?) you should look to ``the Camel Book'', written by - Larry and Randal L. Schwartz , published as a Nutshell - Handbook by O'Reilly & Associates and entitled _Programming Perl_. - Besides serving as a reference guide for Perl, it also contains - tutorial material and is a great source of examples and cookbook - procedures, as well as wit and wisdom, tricks and traps, pranks and - pitfalls. The code examples contained therein are available via - anonymous FTP from ftp.uu.net in - /published/oreilly/nutshell/perl/perl.tar.Z for your retrieval. - Corrections and additions to the book can be found in the Perl man - page right before the BUGS section under the heading ERRATA AND - ADDENDA. - - If you can't find the book in your local technical bookstore, the book - may be ordered directly from O'Reilly by calling 1-800-998-9938 if in - North America and 1-707-829-0515. Autographed copies are available - from TECHbooks by calling 1-503-646-8257 or mailing info@techbook.com. - Cost is ~30$US for the regular version, 40$US for the autographed one. - The book's ISBN is 0-937175-64-1. - - Reasonably substantiated rumor has it that there will be another Perl - book out pretty soon, this one aimed more at beginners. Look for it - from ORA towards the beginning of 93. - - Larry Wall has published a 3-part article on perl in Unix World - (August through October of 1991), and Rob Kolstad also had a 3-parter - in Unix Review (May through July of 1990). Tom Christiansen also has - a brief overview article in the trade newsletter Unix Technology - Advisor from November of 1989. You might also investigate "The Wisdom - of Perl" by Gordon Galligher from SunExpert magazine; April 1991 - Volume 2 Number 4. - - The USENIX LISA (Large Installations Systems Adminstration) Conference - have for several years now included many papers of tools written in - Perl. Old proceedings of these conferences are available; look in - your current issue of ";login:" or send mail to office@usenix.org - for futher information. - - C. INTERNET - - For other examples of Perl scripts, look in the Perl source directory in - the eg subdirectory. You can also find a good deal of them on - tut.cis.ohio-state.edu in the pub/perl/scripts/ subdirectory. - - Another source for examples, currently only for anonymous FTP, is on - convex.com [130.168.1.1]. This contains, amongst other things, - a copy of the newsgroup up through Aug 91, a text retrieval database - for the newsgroup, a rather old and short troff version of Tom Christiansen's - perl tutorial (this was the version presented at Washington DC USENIX), - and quite a few of Tom's scripts. You can look at the INDEX file - in /pub/perl/INDEX for a list of what's in that directory. - - The Convex and Ohio State archives are mirrored on uunet - in /languages/perl/scripts-{convex,osu}. - - D. REFERENCE GUIDE - - A nice reference guide by Johan Vromans is also available; - It is distributed in LaTeX (source) and PostScript (ready to - print) forms. Obsolete versions may still be available in TeX and troff - forms, although these don't print as nicely. The official kit - includes both LaTeX and PostScript forms, and can be FTP'd from - archive.cs.ruu.nl [131.211.80.5], file /pub/DOC/perlref-4.035.tar.Z. - The reference guide comes with the O'Reilly book in a nice, glossy - card format. - - E. PERL COURSES - - Various technical conferences, including USENIX, SUG, WCSAS, AUUG, - FedUnix, and Europen have been sponsoring tutorials of varying lengths - on Perl at their system administration and general conferences. You - might consider attending one of these. These classes are typically - taught by Tom Christiansen , although both Rob - Kolstad and Randal Schwartz also - teach Perl on occasion. Special appearances by Tom, Rob, and/or - Randal may also be negotiated. Classes can run from one day up to a - week ranging over a wide range of subject matter (most are two or - three days), and can include lab time if you want; having lab time - with exercises is generally of great benefit. Send us mail if your - organization is interested in having a Perl class taught at your site. - - -1.8) Can people who aren't on USENET receive comp.lang.perl as a digest? - - "Perl-Users" is the mailing list version of the comp.lang.perl - newsgroup. If you're not lucky enough to be on USENET you can post to - comp.lang.perl by sending to one of the following addresses. Which one - will work best for you depends on which nets your site is hooked into. - Ask your local network guru if you're not certain. - - Internet: PERL-USERS@VIRGINIA.EDU - Perl-Users@UVAARPA.VIRGINIA.EDU - - BitNet: Perl@Virginia - - uucp: ...!uunet!virginia!perl-users - - The Perl-Users list is bidirectionally gatewayed with the USENET - newsgroup comp.lang.perl. This means that VIRGINIA functions as a - reflector. All traffic coming in from the non-USENET side is - immediately posted to the newsgroup. Postings from the USENET side are - periodically digested and mailed out to the Perl-Users mailing list. A - digest is created and distributed at least once per day, more often if - traffic warrants. - - All requests to be added to or deleted from this list, problems, - questions, etc., should be sent to: - - Internet: Perl-Users-Request@Virginia.EDU - Perl-Users-Request@uvaarpa.Virginia.EDU - - BitNet: Perl-Req@Virginia - - uucp: ...!uunet!virginia!perl-users-request - - Coordinator: Marc Rouleau - -1.9) Are archives of comp.lang.perl available? - - Yes, although they're poorly organized. You can get them from - the host betwixt.cs.caltech.edu (131.215.128.4) in the directory - /pub/comp.lang.perl. They are also to uunet in - /languages/perl/comp.lang.perl . It contains these things: - - comp.lang.perl.tar.Z -- the 5M tarchive in MH/news format - archives/ -- the unpacked 5M tarchive - unviewed/ -- new comp.lang.perl messages - - These are currently stored in news- or MH-style format; there are - subdirectories named things like "arrays", "programs", "taint", and - "emacs". Unfortunately, only the first ~1600 or so messages have been - so categorized, and we're now up to almost 15000. Furthermore, even - this categorization was haphazardly done and contains errors. - - A more sophisticated query and retrieval mechanism is desirable. - Preferably one that allows you to retrieve article using a fast-access - indices, keyed on at least author, date, subject, thread (as in "trn") - and probably keywords. Right now, the MH pick command works for this, - but it is very slow to select on 15000 articles. - - If you're serious about this, your best bet is probably to retrieve - the compressed tarchive and play with what you get. Any suggestions - how to better sort this all out are extremely welcome. - - Currently the comp.lang.perl archives on convex.com are nearly a year - behind. That's because I no longer have room to store them there. I - do have them all on-line still, but they are not publicly accessible. - If you have a special request for a query on the old newsgroup - postings, and make nice noises in my direction, I can run the query - and send them to you. Algebraic queries are like "find me anything - about this and that and the other thing but not this or whozits". I - hope to put this in the form of a mailserver. Donated software would - be fine. :-) - - The fast text-retrieval query system for this I'm currently using is - Liam Quin's excellent lqtext system, available from ftp.toronto.edu - in /pub/lq-text* . - - Rumor has it that there are WAIS servers out there for comp.lang.perl - these days, but I haven't used them. - - -1.10) How do I get Perl to run on machine FOO? - - Perl comes with an elaborate auto-configuration script that allows Perl - to be painlessly ported to a wide variety of platforms, including many - non-UNIX ones. Amiga and MS-DOS binaries are available on - jpl-devvax.jpl.nasa.gov [128.149.1.143] for anonymous FTP. Try to bring - Perl up on your machine, and if you have problems, examine the README - file carefully, and if all else fails, post to comp.lang.perl; - probably someone out there has run into your problem and will be able - to help you. - - In particular, since they're so often asked about, here's some information - for the MacIntosh from Matthias Ulrich Neeracher : - - A port of Perl to the Apple Macintosh is available by anonymous - ftp to rascal.ics.utexas.edu from the file - ~ftp/mac/programming/Perl_402_MPW_CPT_bin . - - The file is 1.1M and must be transferred in BINARY mode. Please - be considerate of RASCAL's users during CDT working hours. - (And, no, there is no way to get it by email). - - For European users, the file should soon appear on lth.se. - - To make optimal use of all the features of this port, you - should have MPW, ToolServer, and 5M of memory. There is also a - standalone version included, but it's currently of very limited - usefulness. - - This package contains all of the sources for compilation with - MPW C 3.2 - - And here's some VMS information from Rao V. Akella - : (this appears to be an old port) - - You can pick up Perl for VMS (version 3.0.1.1 patchlevel 4) via - anonymous ftp from ftp.pitt.edu [130.49.253.1] in the - software/vms/perl subdirectory (there are two files there: - perl-pl18.bck and perl-pl4.bck). - - There is also a v3.018 on info.rz.uni-ulm.de [134.60.1.125] or - vms.huji.ac.il [128.139.4.3] in /pub/VMS/misc (information courtesy - of Anders Rolff ). - - And here is a recent version for MS-DOS from Budi Rahard - , who says: - - I am collecting MS-DOS Perl(s) in ftp.ee.umanitoba.ca directory - /pub/msdos/perl. Currently I received three versions of Perl v4.019 - and one of 4.010. (Tommy Thorn and Len Reed - ) - - There is now a 4.035 for 386 [DOS], Hitoshi Doi - port, is available ftp.ee.umanitoba.ca as /pub/msdos/perl/perl386.zoo . - - Please contact the porters directly in case of questions about - these ports. - - -1.11) Where can I get (info|inter|ora|sql|syb)perl? - - Numerous database-oriented extensions to Perl have been written. - These amount to using the usub mechanism (see the usub/ subdirectory - in the distribution tree) to link in a database library, allowing - embedded calls to Informix, Interbase, Oracle, Ingres, and Sybase. - There is currently a project underway, organized by Buzz Moschetti - , to create a higher level interface - (DBperl) that will allow you to write your queries in a - database-independent fashion. Meanwhile, here are the authors of the - various extensions: - - What Target DB Who - -------- ----------- ---------------------------------------- - Infoperl Informix Kurt Andersen (kurt@hpsdid.sdd.hp.com) - Interperl Interbase Buzz Moschetti (buzz@fsrg.bear.com) - Oraperl Oracle Kevin Stock (kstock@encore.com) - Sqlperl Ingres Ted Lemon (mellon@ncd.com) - Sybperl Sybase Michael Peppler (mpeppler@itf.ch) - - -1.12) There's an a2p and an s2p; why isn't there a p2c (perl-to-C)? - - Because the Pascal people would be upset that we stole their name. :-) - - The dynamic nature of Perl's do and eval operators (and remember that - constructs like s/$mac_donald/$mac_gregor/eieio count as an eval) would - make this very difficult. To fully support them, you would have to put - the whole Perl interpreter into each compiled version for those scripts - using them. This is what undump does right now, if your machine has it. - If what you're doing will be faster in C than in Perl, maybe it should - have been written in C in the first place. For things that ought to be - written in Perl, the interpreter will be just about as fast, because the - pattern matching routines won't work any faster linked into a C program. - Even in the case of simple Perl programs that don't do any fancy evals, the - major gain would be in compiling the control flow tests, with the rest - still being a maze of twisty, turny subroutine calls. Since these are not - usually the major bottleneck in the program, there's not as much to be - gained via compilation as one might think. - - -1.13) Where can I get undump for my machine? - - The undump program comes from the TeX distribution. If you have TeX, then - you may have a working undump. If you don't, and you can't get one, - *AND* you have a GNU emacs working on your machine that can clone itself, - then you might try taking its unexec() function and compiling Perl with - -DUNEXEC, which will make Perl call unexec() instead of abort(). You'll - have to add unexec.o to the objects line in the Makefile. If you succeed, - post to comp.lang.perl about your experience so others can benefit from it. - - -1.14) Where can I get a perl-mode for emacs? - - In the perl4.0 source directory, you'll find a directory called - "emacs", which contains several files that should help you. - - -1.15) How can I use Perl interactively? - - The easiest way to do this is to run Perl under its debugger. - If you have no program to debug, you can invoke the debugger - on an `empty' program like this: - - perl -de 0 - - (The more positive amongst us prefer "perl -de 1". :-) - - Now you can type in any legal Perl code, and it will be immediately - evaluated. You can also examine the symbol table, get stack - backtraces, check variable Values, and if you want to, set - breakpoints and do the other things you can do in a symbolic debugger. - - -1.16) Is there a Perl shell? - - Not really. Perl is a programming language, not a command - interpreter. There is a very simple one called "perlsh" - included in the Perl source distribution. It just does this: - - $/ = ''; # set paragraph mode - $SHlinesep = "\n"; - while ($SHcmd = <>) { - $/ = $SHlinesep; - eval $SHcmd; print $@ || "\n"; - $SHlinesep = $/; $/ = ''; - } - - Not very interesting, eh? - - Daniel Smith is working on an interactive Perl - shell called SoftList. It's currently at version 3.0beta. SoftList - 3.0 has tcsh-like command line editing, can let you define a file of - aliases so that you can run chunks of perl or UNIX commands, and so - on. You can send mail to him for further information and availability. - - -1.17) Is there a Perl profiler? - - While there isn't one included with the perl source distribution, - various folks have written packages that allow you to do at least some - sort of profiling. The strategy usually includes modifying the perl - debugger to handle profiling. Authors of these packages include - - Wayne Thompson - Ray Lischner - Kresten Krab Thorup - - The original articles by these folks containing their - profilers are available on convex.com in - /pub/perl/information/profiling.shar via anon ftp. - - -1.18) Is there a yacc for Perl? - - Yes!! It's a version of Berkeley yacc that outputs Perl code instead - of C code! You can get this from ftp.sterling.com [192.124.9.1] in - /local/perl-byacc1.8.1.tar.Z, or send the author mail for details. - - -1.19) How can I use curses with perl? - - One way is to build a curseperl binary by linking in your C curses - library as described in the usub subdirectory of the perl sources. - This requires a modicum of work, but it will be reasonably fast - since it's all in C (assuming you consider curses reasonably fast. :-) - Programs written using this method require the modified curseperl, - not vanilla perl, to run. While this is something of a disadvantage, - experience indicates that it's better to use curseperl than to - try to roll your own using termcap directly. - - Another possibility is to use Henk Penning's cterm package, a curses - emulation library written in perl. cterm is actually a separate - program with which you communicate via a pipe. It is available from - archive.cs.ruu.nl [131.211.80.5] via anonymous ftp in the directory - pub/PERL. You may also acquire the package via email in compressed, - uuencoded form by sending a message to mail-server@cs.ruu.nl - containing these lines: - - begin - send PERL/cterm.shar.Z - end - - See the question on retrieving perl via mail for more information on - how to get retrieve other items of interest from the mail server - there. - - -1.20) How can I use X with Perl? - - Right now, you have several choices. You can wait for perl5, use - the WAFE or STDWIN packages, or try to make your own usub bindings. - - Perl5 is anticipated to be released with bindings for X, called - guiperl. An exciting prototype for this, written by Jon Biggar - , Larry's *other* brother-in-law and officemate, - is already up and running inside of Netlabs. This program addresses - the same dynamic gui-building problem space as does tcl/tk. - - If you can't wait or don't think that guiperl will do what you want, - a stab at Motif bindings was begun by Theodore C. Law - area. His article about this is - on convex.com in /pub/perl/info/motif for anon ftp. - - STDWIN is a library written by Guido van Rossum - (author of the Python programming language) that is portable - between Mac, Dos and X11. One could write a Perl agent to - speak to this STDIN server. - - WAFE is a package that implements a symbolic interface to the Athena - widgets (X11R5). A typical Wafe application consists in our framework - of two parts: the front-end (we call it Wafe for Widget[Athena]front - end) and an application program running typically as separate process. - The application program can be implemented in an arbitrary programming - language and talks to the front-end via stdio. Since Wafe (the - front-end) was developed using the extensible TCL shell (cite John - Ousterhout), an application program can dynamically submit requests to - the front-end to build up the graphical user interface; the - application can even down-load application specific procedures into - the front-end. The distribution contains sample application programs - in Perl, GAWK, Prolog, TCL, and C talking to the same Wafe binary. - Many of the demo applications are implemented in Perl. Wafe 0.9 can - be obtained via anonymous ftp from - ftp.wu-wien.ac.at:pub/src/X11/wafe-0.9.tar.Z - (for people without name server: the ip address is 137.208.3.5) - - -1.21) What is perl4? What is perl5? - - The answer to what is perl4 is nearly anything you might otherwise - program in shell or C. The answer to what is perl5 is basically - Perl: the Next Generation. In fact, it's essentially a complete - rewrite of perl from the bottom up, and back again. - - Larry gave a talk on perl5 at a Bay LISA meeting as well as at the - most recent USENIX LISA conference in Long Beach in which he timorously - admitted that perl5 might possibly be beta released in early 1993. - He enumerated some of the following features. Note that not only have - not all these been implemented yet, the ones further down the list - might well not get done at all. - - a faster, tighter, more flexible interpreter - very easy GUI Perl applications using X bindings ("guiperl") - embeddable Perl code in C code: cc prog.c -lperl - multiple coresident perl interpreters: - perhaps threading and/or coroutines - named argument passing: - some_func( OC => $red, TOF => "\f"); - recursive lists: - [a, b, [c, d], e] has 4 elts, the 3rd being itself a list - typed pointers and generalized indirection: - like @{$aptr} or &{$fptr} or &{ $table[$index] . "func" }(). - merging of list operator and function calling syntax: - split /pat/, $string; - subroutines without &'s: myfunc($arg); - generalization of dbm binding for assoc arrays to handle - any generic fetch/store/open/close/flush package. - (thus allowing both dbm and gdbm at once) - object oriented programming: - STDOUT->flush(1); - give dog $bone; - lexical scoping - dynamic loading of C libraries for systems that can - byte-compiled code for speed and maybe security - - It's tempting to want this stuff soon, since the sooner it comes - out the sooner we can all build really cool applications. But the - longer Larry works on it, the more items from this list will actually - get done, and the more robust the release will be. So let's not - ask him about it too often. - - -1.22) How does Perl compare with languages like REXX or TCL? - - REXX is an interpreted programming language first seen on IBM systems, - and TCL is John Ousterhout's embeddable command language. TCL's most - intriguing feature for many people is the tcl/tk toolset that allows - for interpreted X-based tools. - - To avoid any flamage, if you really want to know the answer to this - question, probably the best thing to do is try to write equivalent - code to do a set of tasks. All three have their own newsgroups in - which you can learn about (but hopefully not argue about) these - languages. - - To find out more about these or other languages, you might also check - out David Muir Sharnoff 's posting on "Catalog of - compilers, interpreters, and other language tools" which he posts to - comp.lang.misc, comp.sources.d, comp.archives.admin, and the - news.answers newsgroups. It's a comprehensive treatment of many - different languages. (Caveat lector: he considers Perl's syntax - "unappealing".) This list is archived on convex.com in - /pub/perl/info/lang-survey.shar . - - -1.23) Is it a Perl program or a Perl script? - - Certainly. :-) - - Current UNIX parlance holds that anything interpreted - is a script, and anything compiled into native machine - code is a program. However, others hold that a program - is a program is a program: after all, one seldom discusses - scripts written in BASIC or LISP. Larry considers it - a program if it's set in stone and you can't change it, - whereas if you go in and hack on it, then it's a script. - - But doesn't really matter. The terms are generally - interchangeable today. - - -1.24) What's the difference between "Perl" and "perl"? - - 32 :-) [ ord('p') - ord('P') ] - - Larry now uses "Perl" to signify the language proper and "perl" the - implementation of it, i.e. the current interpreter. Hence my quip - that "Nothing but perl can parse Perl." - - On the other hand, the aesthetic value of casewise parallelism - in "awk", "sed", and "perl" as much require the lower-case - version as "C", "Pascal", and "Perl" require the - upper-case version. It's also easier to type "Perl" in - typeset print than to be constantly switching in Courier. :-) - - In other words, it doesn't matter much, especially if all - you're doing is hearing someone talk about the language; - case is hard to distingish aurally. - - -1.25) What companies use or ship Perl? - - At this time, the known list includes at least the following: Convex, - Netlabs, BSDI, Integraph, Dell, and Kubota Pacific, although the - latter is in /usr/contrib only. Many other companies use Perl - internally for purposes of tools development, systems administration, - installation scripts, and test suites. Rumor has it that the large - workstation vendors (the TLA set) are seriously looking into shipping - Perl with their standard systems "soon". - - People with support contracts with their vendors are actively - encouraged to submit enhancement requests that Perl be shipped - as part of their standard system. It would, at the very least, - reduce the FTP load on the Internet. :-) - -1.26) Is there commercial, 3rd-party support for Perl? - - No. Although perl is included in the GNU distribution, at last check, - Cygnus does not offer support for it. However, it's unclear whether - they've ever been offered sufficient financial incentive to do so. - - On the other hand, you do have comp.lang.perl as a totally gratis - support mechanism. As long as you ask "interesting" questions, - you'll probably get plenty of help. :-) - -1.27) Where can I get a list of the JAPH signature quotes? - - These are the "just another perl hacker" signatures that - some people sign their postings with. About 100 of the - of the earlier ones are on convex.com in /pib/perl/info/japh. - -1.28) Where can I get a list of Larry Wall witticisms? - - Over a hundred quips by Larry, from postings of his or source code, - can be found on convex.com in /pub/perl/info/lwall-quotes. - - - - -2.1) What are all these $@*%<> signs and how do I know when to use them? - - Those are type specifiers: $ for scalar values, @ for indexed arrays, - and % for hashed arrays. The * means all types of that symbol name - and are sometimes used like pointers; the <> are used for inputting - a record from a filehandle. See the question on arrays of arrays - for more about Perl pointers. - - Always make sure to use a $ for single values and @ for multiple ones. - Thus element 2 of the @foo array is accessed as $foo[2], not @foo[2], - which is a list of length one (not a scalar), and is a fairly common - novice mistake. Sometimes you can get by with @foo[2], but it's - not really doing what you think it's doing for the reason you think - it's doing it, which means one of these days, you'll shoot yourself - in the foot; ponder for a moment what these will really do: - @foo[0] = `cmd args`; - @foo[2] = ; - Just always say $foo[2] and you'll be happier. - - This may seem confusing, but try to think of it this way: you use the - character of the type which you *want back*. You could use @foo[1..3] for - a slice of three elements of @foo, or even @foo{A,B,C} for a slice of - of %foo. This is the same as using ($foo[1], $foo[2], $foo[3]) and - ($foo{A}, $foo{B}, $foo{C}) respectively. In fact, you can even use - lists to subscript arrays and pull out more lists, like @foo[@bar] or - @foo{@bar}, where @bar is in both cases presumably a list of subscripts. - - While there are a few places where you don't actually need these type - specifiers, except for files, you should always use them. Note that - is NOT the type specifier for files; it's the equivalent of awk's - getline function, that is, it reads a line from the handle FILE. When - doing open, close, and other operations besides the getline function on - files, do NOT use the brackets. - - Beware of saying: - $foo = BAR; - Which wil be interpreted as - $foo = 'BAR'; - and not as - $foo = ; - If you always quote your strings, you'll avoid this trap. - - Normally, files are manipulated something like this (with appropriate - error checking added if it were production code): - - open (FILE, ">/tmp/foo.$$"); - print FILE "string\n"; - close FILE; - - If instead of a filehandle, you use a normal scalar variable with file - manipulation functions, this is considered an indirect reference to a - filehandle. For example, - - $foo = "TEST01"; - open($foo, "file"); - - After the open, these two while loops are equivalent: - - while (<$foo>) {} - while () {} - - as are these two statements: - - close $foo; - close TEST01; - - but NOT to this: - - while (<$TEST01>) {} # error - ^ - ^ note spurious dollar sign - - This is another common novice mistake; often it's assumed that - - open($foo, "output.$$"); - - will fill in the value of $foo, which was previously undefined. - This just isn't so -- you must set $foo to be the name of a valid - filehandle before you attempt to open it. - - -2.2) Why don't backticks work as they do in shells? - - Several reason. One is because backticks do not interpolate within - double quotes in Perl as they do in shells. - - Let's look at two common mistakes: - - $foo = "$bar is `wc $file`"; # WRONG - - This should have been: - - $foo = "$bar is " . `wc $file`; - - But you'll have an extra newline you might not expect. This - does not work as expected: - - $back = `pwd`; chdir($somewhere); chdir($back); # WRONG - - Because backticks do not automatically eat trailing or embedded - newlines. The chop() function will remove the last character from - a string. This should have been: - - chop($back = `pwd`); chdir($somewhere); chdir($back); - - You should also be aware that while in the shells, embedding - single quotes will protect variables, in Perl, you'll need - to escape the dollar signs. - - Shell: foo=`cmd 'safe $dollar'` - Perl: $foo=`cmd 'safe \$dollar'`; - - -2.3) How come Perl operators have different precedence than C operators? - - Actually, they don't; all C operators have the same precedence in Perl as - they do in C. The problem is with a class of functions called list - operators, e.g. print, chdir, exec, system, and so on. These are somewhat - bizarre in that they have different precedence depending on whether you - look on the left or right of them. Basically, they gobble up all things - on their right. For example, - - unlink $foo, "bar", @names, "others"; - - will unlink all those file names. A common mistake is to write: - - unlink "a_file" || die "snafu"; - - The problem is that this gets interpreted as - - unlink("a_file" || die "snafu"); - - To avoid this problem, you can always make them look like function calls - or use an extra level of parentheses: - - (unlink "a_file") || die "snafu"; - unlink("a_file") || die "snafu"; - - Sometimes you actually do care about the return value: - - unless ($io_ok = print("some", "list")) { } - - Yes, print() return I/O success. That means - - $io_ok = print(2+4) * 5; - - reutrns 5 times whether printing (2+4) succeeded, and - print(2+4) * 5; - returns the same 5*io_success value and tosses it. - - See the Perl man page's section on Precedence for more gory details, - and be sure to use the -w flag to catch things like this. - - -2.4) How come my converted awk/sed/sh script runs more slowly in Perl? - - The natural way to program in those languages may not make for the fastest - Perl code. Notably, the awk-to-perl translator produces sub-optimal code; - see the a2p man page for tweaks you can make. - - Two of Perl's strongest points are its associative arrays and its regular - expressions. They can dramatically speed up your code when applied - properly. Recasting your code to use them can help alot. - - How complex are your regexps? Deeply nested sub-expressions with {n,m} or - * operators can take a very long time to compute. Don't use ()'s unless - you really need them. Anchor your string to the front if you can. - - Something like this: - next unless /^.*%.*$/; - runs more slowly than the equivalent: - next unless /%/; - - Note that this: - next if /Mon/; - next if /Tue/; - next if /Wed/; - next if /Thu/; - next if /Fri/; - runs faster than this: - next if /Mon/ || /Tue/ || /Wed/ || /Thu/ || /Fri/; - which in turn runs faster than this: - next if /Mon|Tue|Wed|Thu|Fri/; - which runs *much* faster than: - next if /(Mon|Tue|Wed|Thu|Fri)/; - - There's no need to use /^.*foo.*$/ when /foo/ will do. - - Remember that a printf costs more than a simple print. - - Don't split() every line if you don't have to. - - Another thing to look at is your loops. Are you iterating through - indexed arrays rather than just putting everything into a hashed - array? For example, - - @list = ('abc', 'def', 'ghi', 'jkl', 'mno', 'pqr', 'stv'); - - for $i ($[ .. $#list) { - if ($pattern eq $list[$i]) { $found++; } - } - - First of all, it would be faster to use Perl's foreach mechanism - instead of using subscripts: - - foreach $elt (@list) { - if ($pattern eq $elt) { $found++; } - } - - Better yet, this could be sped up dramatically by placing the whole - thing in an associative array like this: - - %list = ('abc', 1, 'def', 1, 'ghi', 1, 'jkl', 1, - 'mno', 1, 'pqr', 1, 'stv', 1 ); - $found += $list{$pattern}; - - (but put the %list assignment outside of your input loop.) - - You should also look at variables in regular expressions, which is - expensive. If the variable to be interpolated doesn't change over the - life of the process, use the /o modifier to tell Perl to compile the - regexp only once, like this: - - for $i (1..100) { - if (/$foo/o) { - &some_func($i); - } - } - - Finally, if you have a bunch of patterns in a list that you'd like to - compare against, instead of doing this: - - @pats = ('_get.*', 'bogus', '_read', '.*exit', '_write'); - foreach $pat (@pats) { - if ( $name =~ /^$pat$/ ) { - &some_func(); - last; - } - } - - If you build your code and then eval it, it will be much faster. - For example: - - @pats = ('_get.*', 'bogus', '_read', '.*exit', '_write'); - $code = <;" work right? - - Well, it does. The thing to remember is that local() provides an array - context, an that the syntax in an array context will read all the - lines in a file. To work around this, use: - - local($foo); - $foo = ; - - You can use the scalar() operator to cast the expression into a scalar - context: - - local($foo) = scalar(); - - -2.8) How can I detect keyboard input without reading it? - - You should check out the Frequently Asked Questions list in - comp.unix.* for things like this: the answer is essentially the same. - It's very system dependent. Here's one solution that works on BSD - systems: - - sub key_ready { - local($rin, $nfd); - vec($rin, fileno(STDIN), 1) = 1; - return $nfd = select($rin,undef,undef,0); - } - - A closely related question is how to input a single character from the - keyboard. Again, this is a system dependent operation. The following - code that may or may not help you: - - $BSD = -f '/vmunix'; - if ($BSD) { - system "stty cbreak /dev/tty 2>&1"; - } - else { - system "stty", 'cbreak', - system "stty", 'eol', "\001"; - } - - $key = getc(STDIN); - - if ($BSD) { - system "stty -cbreak /dev/tty 2>&1"; - } - else { - system "stty", 'icanon'; - system "stty", 'eol', '^@'; # ascii null - } - print "\n"; - - You could also handle the stty operations yourself for speed if you're - going to be doing a lot of them. This code works to toggle cbreak - and echo modes on a BSD system: - - sub set_cbreak { # &set_cbreak(1) or &set_cbreak(0) - local($on) = $_[0]; - local($sgttyb,@ary); - require 'sys/ioctl.ph'; - $sgttyb_t = 'C4 S' unless $sgttyb_t; # c2ph: &sgttyb'typedef() - - ioctl(STDIN,&TIOCGETP,$sgttyb) || die "Can't ioctl TIOCGETP: $!"; - - @ary = unpack($sgttyb_t,$sgttyb); - if ($on) { - $ary[4] |= &CBREAK; - $ary[4] &= ~&ECHO; - } else { - $ary[4] &= ~&CBREAK; - $ary[4] |= &ECHO; - } - $sgttyb = pack($sgttyb_t,@ary); - - ioctl(STDIN,&TIOCSETP,$sgttyb) || die "Can't ioctl TIOCSETP: $!"; - } - - Note that this is one of the few times you actually want to use the - getc() function; it's in general way too expensive to call for normal - I/O. Normally, you just use the syntax, or perhaps the read() - or sysread() functions. - - For perspectives on more portable solutions, use anon ftp to retrieve - the file /pub/perl/info/keypress from convex.com. - - -2.9) How can I make an array of arrays or other recursive data types? - - Remember that Perl isn't about nested data structures (actually, - perl0 .. perl4 weren't, but maybe perl5 will be, at least - somewhat). It's about flat ones, so if you're trying to do this, you - may be going about it the wrong way or using the wrong tools. You - might try parallel arrays with common subscripts. - - But if you're bound and determined, you can use the multi-dimensional - array emulation of $a{'x','y','z'}, or you can make an array of names - of arrays and eval it. - - For example, if @name contains a list of names of arrays, you can - get at a the j-th element of the i-th array like so: - - $ary = $name[$i]; - $val = eval "\$$ary[$j]"; - - or in one line - - $val = eval "\$$name[$i][\$j]"; - - You could also use the type-globbing syntax to make an array of *name - values, which will be more efficient than eval. Here @name hold - a list of pointers, which we'll have to dereference through a temporary - variable. - - For example: - - { local(*ary) = $name[$i]; $val = $ary[$j]; } - - In fact, you can use this method to make arbitrarily nested data - structures. You really have to want to do this kind of thing - badly to go this far, however, as it is notationally cumbersome. - - Let's assume you just simply *have* to have an array of arrays of - arrays. What you do is make an array of pointers to arrays of - pointers, where pointers are *name values described above. You - initialize the outermost array normally, and then you build up your - pointers from there. For example: - - @w = ( 'ww' .. 'xx' ); - @x = ( 'xx' .. 'yy' ); - @y = ( 'yy' .. 'zz' ); - @z = ( 'zz' .. 'zzz' ); - - @ww = reverse @w; - @xx = reverse @x; - @yy = reverse @y; - @zz = reverse @z; - - Now make a couple of array of pointers to these: - - @A = ( *w, *x, *y, *z ); - @B = ( *ww, *xx, *yy, *zz ); - - And finally make an array of pointers to these arrays: - - @AAA = ( *A, *B ); - - To access an element, such as AAA[i][j][k], you must do this: - - local(*foo) = $AAA[$i]; - local(*bar) = $foo[$j]; - $answer = $bar[$k]; - - Similar manipulations on associative arrays are also feasible. - - You could take a look at recurse.pl package posted by Felix Lee - , which lets you simulate vectors and tables (lists and - associative arrays) by using type glob references and some pretty serious - wizardry. - - In C, you're used to creating recursive datatypes for operations - like recursive decent parsing or tree traversal. In Perl, these - algorithms are best implemented using associative arrays. Take an - array called %parent, and build up pointers such that $parent{$person} - is the name of that person's parent. Make sure you remember that - $parent{'adam'} is 'adam'. :-) With a little care, this approach can - be used to implement general graph traversal algorithms as well. - - -2.10) How can I quote a variable to use in a regexp? - - From the manual: - - $pattern =~ s/(\W)/\\$1/g; - - Now you can freely use /$pattern/ without fear of any unexpected - meta-characters in it throwing off the search. If you don't know - whether a pattern is valid or not, enclose it in an eval to avoid - a fatal run-time error. - - -2.11) Why do setuid Perl scripts complain about kernel problems? - - This message: - - YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET! - FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP! - - is triggered because setuid scripts are inherently insecure due to a - kernel bug. If your system has fixed this bug, you can compile Perl - so that it knows this. Otherwise, create a setuid C program that just - execs Perl with the full name of the script. - - -2.12) How do I open a pipe both to and from a command? - - In general, this is a dangerous move because you can find yourself in a - deadlock situation. It's better to put one end of the pipe to a file. - For example: - - # first write some_cmd's input into a_file, then - open(CMD, "some_cmd its_args < a_file |"); - while () { - - # or else the other way; run the cmd - open(CMD, "| some_cmd its_args > a_file"); - while ($condition) { - print CMD "some output\n"; - # other code deleted - } - close CMD || warn "cmd exited $?"; - - # now read the file - open(FILE,"a_file"); - while () { - - If you have ptys, you could arrange to run the command on a pty and - avoid the deadlock problem. See the chat2.pl package in the - distributed library for ways to do this. - - At the risk of deadlock, it is theoretically possible to use a - fork, two pipe calls, and an exec to manually set up the two-way - pipe. (BSD system may use socketpair() in place of the two pipes, - but this is not as portable.) The open2 library function distributed - with the current perl release will do this for you. - - It assumes it's going to talk to something like adb, both writing to - it and reading from it. This is presumably safe because you "know" - that commands like adb will read a line at a time and output a line at - a time. Programs like sort that read their entire input stream first, - however, are quite apt to cause deadlock. - - -2.13) How can I change the first N letters of a string? - - Remember that the substr() function produces an lvalue, that is, it may be - assigned to. Therefore, to change the first character to an S, you could - do this: - - substr($var,0,1) = 'S'; - - This assumes that $[ is 0; for a library routine where you can't know $[, - you should use this instead: - - substr($var,$[,1) = 'S'; - - While it would be slower, you could in this case use a substitute: - - $var =~ s/^./S/; - - But this won't work if the string is empty or its first character is a - newline, which "." will never match. So you could use this instead: - - $var =~ s/^[^\0]?/S/; - - To do things like translation of the first part of a string, use substr, - as in: - - substr($var, $[, 10) =~ tr/a-z/A-Z/; - - If you don't know then length of what to translate, something like - this works: - - /^(\S+)/ && substr($_,$[,length($1)) =~ tr/a-z/A-Z/; - - For some things it's convenient to use the /e switch of the - substitute operator: - - s/^(\S+)/($tmp = $1) =~ tr#a-z#A-Z#, $tmp/e - - although in this case, it runs more slowly than does the previous example. - - -2.14) How can I manipulate fixed-record-length files? - - The most efficient way is using pack and unpack. This is faster than - using substr. Here is a sample chunk of code to break up and put back - together again some fixed-format input lines, in this case, from ps. - - # sample input line: - # 15158 p5 T 0:00 perl /mnt/tchrist/scripts/now-what - $ps_t = 'A6 A4 A7 A5 A*'; - open(PS, "ps|"); - $_ = ; print; - while () { - ($pid, $tt, $stat, $time, $command) = unpack($ps_t, $_); - for $var ('pid', 'tt', 'stat', 'time', 'command' ) { - print "$var: <", eval "\$$var", ">\n"; - } - print 'line=', pack($ps_t, $pid, $tt, $stat, $time, $command), "\n"; - } - - -2.15) How can I make a file handle local to a subroutine? - - You must use the type-globbing *VAR notation. Here is some code to - cat an include file, calling itself recursively on nested local - include files (i.e. those with #include "file", not #include ): - - sub cat_include { - local($name) = @_; - local(*FILE); - local($_); - - warn "\n"; - if (!open (FILE, $name)) { - warn "can't open $name: $!\n"; - return; - } - while () { - if (/^#\s*include "([^"]*)"/) { - &cat_include($1); - } else { - print; - } - } - close FILE; - } - - -2.16) How can I extract just the unique elements of an array? - - There are several possible ways, depending on whether the - array is ordered and you wish to preserve the ordering. - - a) If @in is sorted, and you want @out to be sorted: - - $prev = 'nonesuch'; - @out = grep($_ ne $prev && (($prev) = $_), @in); - - This is nice in that it doesn't use much extra memory, - simulating uniq's behavior of removing only adjacent - duplicates. - - b) If you don't know whether @in is sorted: - - undef %saw; - @out = grep(!$saw{$_}++, @in); - - c) Like (b), but @in contains only small integers: - - @out = grep(!$saw[$_]++, @in); - - d) A way to do (b) without any loops or greps: - - undef %saw; - @saw{@in} = (); - @out = sort keys %saw; # remove sort if undesired - - e) Like (d), but @in contains only small positive integers: - - undef @ary; - @ary[@in] = @in; - @out = sort @ary; - - -2.17) How can I call alarm() or usleep() from Perl? - - It's available as a built-in as of version 3.038. If you want finer - granularity than 1 second (as usleep() provides) and have itimers and - syscall() on your system, you can use the following. You could also - use select(). - - It takes a floating-point number representing how long to delay until - you get the SIGALRM, and returns a floating- point number representing - how much time was left in the old timer, if any. Note that the C - function uses integers, but this one doesn't mind fractional numbers. - - # alarm; send me a SIGALRM in this many seconds (fractions ok) - # tom christiansen - sub alarm { - require 'syscall.ph'; - require 'sys/time.ph'; - - local($ticks) = @_; - local($in_timer,$out_timer); - local($isecs, $iusecs, $secs, $usecs); - - local($itimer_t) = 'L4'; # should be &itimer'typedef() - - $secs = int($ticks); - $usecs = ($ticks - $secs) * 1e6; - - $out_timer = pack($itimer_t,0,0,0,0); - $in_timer = pack($itimer_t,0,0,$secs,$usecs); - - syscall(&SYS_setitimer, &ITIMER_REAL, $in_timer, $out_timer) - && die "alarm: setitimer syscall failed: $!"; - - ($isecs, $iusecs, $secs, $usecs) = unpack($itimer_t,$out_timer); - return $secs + ($usecs/1e6); - } - - -2.18) How can I test whether an array contains a certain element? - - There are several ways to approach this. If you are going to make - this query many times and the values are arbitrary strings, the - fastest way is probably to invert the original array and keep an - associative array lying about whose keys are the first array's values. - - @blues = ('turquoise', 'teal', 'lapis lazuli'); - undef %is_blue; - for (@blues) { $is_blue{$_} = 1; } - - Now you can check whether $is_blue{$some_color}. It might have been - a good idea to keep the blues all in an assoc array in the first place. - - If the values are all small integers, you could use a simple - indexed array. This kind of an array will take up less space: - - @primes = (2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31); - undef @is_tiny_prime; - for (@primes) { $is_tiny_prime[$_] = 1; } - - Now you check whether $is_tiny_prime[$some_number]. - - If the values in question are integers, but instead of strings, - you can save quite a lot of space by using bit strings instead: - - @articles = ( 1..10, 150..2000, 2017 ); - undef $read; - grep (vec($read,$_,1) = 1, @articles); - - Now check whether vec($read,$n,1) is true for some $n. - - -2.19) How can I do an atexit() or setjmp()/longjmp() in Perl? - - Perl's exception-handling mechanism is its eval operator. You - can use eval as setjmp and die as longjmp. Here's an example - of Larry's for timed-out input, which in C is often implemented - using setjmp and longjmp: - - $SIG{ALRM} = TIMEOUT; - sub TIMEOUT { die "restart input\n" } - - do { eval { &realcode } } while $@ =~ /^restart input/; - - sub realcode { - alarm 15; - $ans = ; - alarm 0; - } - - Here's an example of Tom's for doing atexit() handling: - - sub atexit { push(@_exit_subs, @_) } - - sub _cleanup { unlink $tmp } - - &atexit('_cleanup'); - - eval <<'End_Of_Eval'; $here = __LINE__; - # as much code here as you want - End_Of_Eval - - $oops = $@; # save error message - - # now call his stuff - for (@_exit_subs) { &$_() } - - $oops && ($oops =~ s/\(eval\) line (\d+)/$0 . - " line " . ($1+$here)/e, die $oops); - - You can register your own routines via the &atexit function now. You - might also want to use the &realcode method of Larry's rather than - embedding all your code in the here-is document. Make sure to leave - via die rather than exit, or write your own &exit routine and call - that instead. In general, it's better for nested routines to exit - via die rather than exit for just this reason. - - Eval is also quite useful for testing for system dependent features, - like symlinks, or using a user-input regexp that might otherwise - blowup on you. - - -2.20) Why doesn't Perl interpret my octal data octally? - - Perl only understands octal and hex numbers as such when they occur - as constants in your program. If they are read in from somewhere - and assigned, then no automatic conversion takes place. You must - explicitly use oct() or hex() if you want this kind of thing to happen. - Actually, oct() knows to interpret both hex and octal numbers, while - hex only converts hexadecimal ones. For example: - - { - print "What mode would you like? "; - $mode = ; - $mode = oct($mode); - unless ($mode) { - print "You can't really want mode 0!\n"; - redo; - } - chmod $mode, $file; - } - - Without the octal conversion, a requested mode of 755 would turn - into 01363, yielding bizarre file permissions of --wxrw--wt. - - If you want something that handles decimal, octal and hex input, - you could follow the suggestion in the man page and use: - - $val = oct($val) if $val =~ /^0/; - -2.21) How do I sort an associative array by value instead of by key? - - You have to declare a sort subroutine to do this. Let's assume - you want an ASCII sort on the values of the associative array %ary. - You could do so this way: - - foreach $key (sort by_value keys %ary) { - print $key, '=', $ary{$key}, "\n"; - } - sub by_value { $ary{$a} cmp $ary{$b}; } - - If you wanted a descending numeric sort, you could do this: - - sub by_value { $ary{$b} <=> $ary{$a}; } - - You can also inline your sort function, like this: - - foreach $key ( sort { $x{$b} <=> $a{$a} } keys %ary ) { - print $key, '=', $ary{$key}, "\n"; - } - - If you wanted a function that didn't have the array name hard-wired - into it, you could so this: - - foreach $key (&sort_by_value(*ary)) { - print $key, '=', $ary{$key}, "\n"; - } - sub sort_by_value { - local(*x) = @_; - sub _by_value { $x{$a} cmp $x{$b}; } - sort _by_value keys %x; - } - - If you want neither an alphabetic nor a numeric sort, then you'll - have to code in your own logic instead of relying on the built-in - signed comparison operators "cmp" and "<=>". - - Note that if you're sorting on just a part of the value, such as a - piece you might extract via split, unpack, pattern-matching, or - substr, then rather than performing that operation inside your sort - routine on each call to it, it is significantly more efficient to - build a parallel array of just those portions you're sorting on, sort - the indices of this parallel array, and then to subscript your original - array using the newly sorted indices. This method works on both - regular and associative arrays, since both @ary[@idx] and @ary{@idx} - make sense. See page 245 in the Camel Book on "Sorting an Array by a - Computable Field" for a simple example of this. - - -2.22) How can I capture STDERR from an external command? - - There are three basic ways of running external commands: - - system $cmd; - $output = `$cmd`; - open (PIPE, "cmd |"); - - In the first case, both STDOUT and STDERR will go the same place as - the script's versions of these, unless redirected. You can always put - them where you want them and then read them back when the system - returns. In the second and third cases, you are reading the STDOUT - *only* of your command. If you would like to have merged STDOUT and - STDERR, you can use shell file-descriptor redirection to dup STDERR to - STDOUT: - - $output = `$cmd 2>&1`; - open (PIPE, "cmd 2>&1 |"); - - Another possibility is to run STDERR into a file and read the file - later, as in - - $output = `$cmd 2>some_file`; - open (PIPE, "cmd 2>some_file |"); - - Here's a way to read from both of them and know which descriptor - you got each line from. The trick is to pipe only STDERR through - sed, which then marks each of its lines, and then sends that - back into a merged STDOUT/STDERR stream, from which your Perl program - then reads a line at a time: - - open (CMD, - "3>&1 (cmd args 2>&1 1>&3 3>&- | sed 's/^/STDERR:/' 3>&-) 3>&- |"); - - while () { - if (s/^STDERR://) { - print "line from stderr: ", $_; - } else { - print "line from stdout: ", $_; - } - } - - Be apprised that you *must* use Bourne shell redirection syntax - here, not csh! In fact, you can't even do these things with csh. - For details on how lucky you are that perl's system() and backtick - and pipe opens all use Bourne shell, fetch the file from convex.com - called /pub/csh.whynot -- and you'll be glad that perl's shell - interface is the Bourne shell. - - -2.23) Why doesn't open return an error when a pipe open fails? - - These statements: - - open(TOPIPE, "|bogus_command") || die ... - open(FROMPIPE, "bogus_command|") || die ... - - will not fail just for lack of the bogus_command. They'll only - fail if the fork to run them fails, which is seldom the problem. - - If you're writing to the TOPIPE, you'll get a SIGPIPE if the child - exits prematurely or doesn't run. If you are reading from the - FROMPIPE, you need to check the close() to see what happened. - - If you want an answer sooner than pipe buffering might otherwise - afford you, you can do something like this: - - $kid = open (PIPE, "bogus_command |"); # XXX: check defined($kid) - (kill 0, $kid) || die "bogus_command failed"; - - This works fine if bogus_command doesn't have shell metas in it, but - if it does, the shell may well not have exited before the kill 0. You - could always introduce a delay: - - $kid = open (PIPE, "bogus_command actually has a getdate.y - for use with the Perl yacc. You can get this from ftp.sterling.com - [192.124.9.1] in /local/perl-byacc1.8.1.tar.Z, or send the author - mail for details. - - -2.25) What's the fastest way to code up a given task in perl? - - Because Perl so lends itself to a variety of different approaches - for any given task, a common question is which is the fastest way - to code a given task. Since some approaches can be dramatically - more efficient that others, it's sometimes worth knowing which is - best. Unfortunately, the implementation that first comes to mind, - perhaps as a direct translation from C or the shell, often yields - suboptimal performance. Not all approaches have the same results - across different hardware and software platforms. Furthermore, - legibility must sometimes be sacrificed for speed. - - While an experienced perl programmer can sometimes eye-ball the code - and make an educated guess regarding which way would be fastest, - surprises can still occur. So, in the spirit of perl programming - being an empirical science, the best way to find out which of several - different methods runs the fastest is simply to code them all up and - time them. For example: - - $COUNT = 10_000; $| = 1; - - print "method 1: "; - - ($u, $s) = times; - for ($i = 0; $i < $COUNT; $i++) { - # code for method 1 - } - ($nu, $ns) = times; - printf "%8.4fu %8.4fs\n", ($nu - $u), ($ns - $s); - - print "method 2: "; - - ($u, $s) = times; - for ($i = 0; $i < $COUNT; $i++) { - # code for method 2 - } - ($nu, $ns) = times; - printf "%8.4fu %8.4fs\n", ($nu - $u), ($ns - $s); - - For more specific tips, see the section on Efficiency in the - ``Other Oddments'' chapter at the end of the Camel Book. - - -2.26) How can I know how many entries are in an associative array? - - While the number of elements in a @foobar array is simply @foobar when - used in a scalar, you can't figure out how many elements are in an - associative array in an analagous fashion. That's because %foobar in - a scalar context returns the ratio (as a string) of number of buckets - filled versus the number allocated. For example, scalar(%ENV) might - return "20/32". While perl could in theory keep a count, this would - break down on associative arrays that have been bound to dbm files. - - However, while you can't get a count this way, one thing you *can* use - it for is to determine whether there are any elements whatsoever in - the array, since "if (%table)" is guaranteed to be false if nothing - has ever been stored in it. - - So you either have to keep your own count around and increments - it every time you store a new key in the array, or else do it - on the fly when you really care, perhaps like this: - - $count++ while each %ENV; - - This preceding method will be faster than extracting the - keys into a temporary array to count them. - - As of a very recent patch, you can say - - $count = keys %ENV; - - - -2.27) Why can't my perl program read from STDIN after I gave it ^D (EOF) ? - - Because some stdio's set error and eof flags that need clearing. - - Try keeping around the seekpointer and go there, like this: - $where = tell(LOG); - seek(LOG, $where, 0); - - If that doesn't work, try seeking to a different part of the file and - then back. If that doesn't work, try seeking to a different part of - the file, reading something, and then seeking back. If that doesn't - work, give up on your stdio package and use sysread. You can't call - stdio's clearerr() from Perl, so if you get EINTR from a signal - handler, you're out of luck. Best to just use sysread() from the - start for the tty. - - -2.28) Do I always/never have to quote my strings or use semicolons? - - You don't have to quote strings that can't mean anything else - in the language, like identifiers with any upper-case letters - in them. Therefore, it's fine to do this: - - $SIG{INT} = Timeout_Routine; - or - - @Days = (Sun, Mon, Tue, Wed, Thu, Fri, Sat, Sun); - - but you can't get away with this: - - $foo{while} = until; - - in place of - - $foo{'while'} = 'until'; - - The requirements on semicolons have been increasingly relaxed. You no - longer need one at the end of a block, but stylistically, you're - better to use them if you don't put the curly brace on the same line: - - for (1..10) { print } - - is ok, as is - - @nlist = sort { $a <=> $b } @olist; - - but you probably shouldn't do this: - - for ($i = 0; $i < @a; $i++) { - print "i is $i\n" # <-- oops! - } - - because you might want to add lines later, and anyway, - it looks funny. :-) - - -2.29) How can I translate tildes in a filename? - - Perl doesn't expand tildes -- the shell (ok, some shells) do. - The classic request is to be able to do something like: - - open(FILE, "~/dir1/file1"); - open(FILE, "~tchrist/dir1/file1"); - - which doesn't work. (And you don't know it, because you - did a system call without an "|| die" clause! :-) - - If you *know* you're on a system with the csh, and you *know* - that Larry hasn't internalized file globbing, then you could - get away with - - $filename = <~tchrist/dir1/file1>; - - but that's pretty iffy. - - A better way is to do the translation yourself, as in: - - $filename =~ s#^~(\w+)(/.*)?$#(getpwnam($1))[7].$2#e; - - More robust and efficient versions that checked for error conditions, - handed simple ~/blah notation, and cached lookups are all reasonable - enhancements. - - -2.30) How can I convert my shell script to Perl? - - Larry's standard answer for this is to send your script to me (Tom - Christiansen) with appropriate supplications and offerings. :-( - That's because there's no automatic machine translator. Even if you - were, you wouldn't gain a lot, as most of the external programs would - still get called. It's the same problem as blind translation into C: - you're still apt to be bogged down by exec()s. You have to analize - the dataflow and algorithm and rethink it for optimal speedup. It's - not uncommon to see one, two, or even three orders of magnitude of - speed difference between the brute-force and the recoded approaches. - - -2.31) What is variable suicide and how can I prevent it? - - Variable suicide is a nasty sideeffect of dynamic scoping and - the way variables are passed by reference. If you say - - $x = 17; - &munge($x); - sub munge { - local($x); - local($myvar) = $_[0]; - ... - } - - Then you have just clubbered $_[0]! Why this is occurring - is pretty heavy wizardry: the reference to $x stored in - $_[0] was temporarily occluded by the previous local($x) - statement (which, you're recall, occurs at run-time, not - compile-time). The work around is simple, however: declare - your formal parameters first: - - sub munge { - local($myvar) = $_[0]; - local($x); - ... - } - - That doesn't help you if you're going to be trying to access - @_ directly after the local()s. In this case, careful use - of the package facility is your only recourse. - - Another manifestation of this problem occurs due to the - magical nature of the index variable in a foreach() loop. - - @num = 0 .. 4; - print "num begin @num\n"; - foreach $m (@num) { &ug } - print "num finish @num\n"; - sub ug { - local($m) = 42; - print "m=$m $num[0],$num[1],$num[2],$num[3]\n"; - } - - Which prints out the mysterious: - - num begin 0 1 2 3 4 - m=42 42,1,2,3 - m=42 0,42,2,3 - m=42 0,1,42,3 - m=42 0,1,2,42 - m=42 0,1,2,3 - num finish 0 1 2 3 4 - - What's happening here is that $m is an alias for each - element of @num. Inside &ug, you temporarily change - $m. Well, that means that you've also temporarily - changed whatever $m is an alias to!! The only workaround - is to be careful with global variables, using packages, - and/or just be aware of this potential in foreach() loops. - - -2.32) Can I use Perl regular expressions to match balanced text? - - No, or at least, not by the themselves. - - Regexps just aren't powerful enough. Although Perl's patterns aren't - strictly regular because they do backtracking (the \1 notation), you - still can't do it. You need to employ auxiliary logic. A simple - approach would involve keeping a bit of state around, something - vaguely like this (although we don't handle patterns on the same line): - - while(<>) { - if (/pat1/) { - if ($inpat++ > 0) { warn "already saw pat1" } - redo; - } - if (/pat2/) { - if (--$inpat < 0) { warn "never saw pat1" } - redo; - } - } - - A rather more elaborate subroutine to pull out balanced and possibly - nested single chars, like ` and ', { and }, or ( and ) can be found - on convex.com in /pub/perl/scripts/pull_quotes. - - -2.33) Can I use Perl to run a telnet or ftp session? - - Sure, you can connect directly to them using sockets, or you can run a - session on a pty. In either case, Randal's chat2 package, which is - distributed with the perl source, will come in handly. It address - much the same problem space as Don Libes's expect package does. Two - examples of using managing an ftp session using chat2 can be found on - convex.com in /pub/perl/scripts/ftp-chat2.shar . - - Caveat lector: chat2 is documented only by example, may not run on - System V systems, and is subtly machine dependent both in its ideas - of networking and in pseudottys. - - -2.34) What does "Malformed command links" mean? - - This is a bug in 4.035. While in general it's merely a cosmetic - problem, it often comanifests with a highly undesirable coredumping - problem. Programs known to be affected by the fatal coredump include - plum and pcops. Since perl5 is prety much a total rewrite, we can - count on it being fixed then, but if anyone tracks down the coredump - problem before then, a signifcant portion of the perl world would - rejoice. [Fixed in 4.036--lwall] diff --git a/fib b/fib deleted file mode 100755 index 022d9d0..0000000 --- a/fib +++ /dev/null @@ -1,20 +0,0 @@ -#!./perl - -sub fib -{ - ($_[0] < 2) ? $_[0] : &fib($_[0]-1) + &fib($_[0]-2); -} - -sub myruntime -{ - local(@t) = times; # in seconds - $t[0] + $t[1]; -} - -$x = (shift || 20); -print "Starting fib($x)\n"; -$before = &myruntime; -$y = &fib($x); -$after = &myruntime; -printf("Done. Result $y in %g cpu seconds.\n", $after-$before); - diff --git a/fib4 b/fib4 deleted file mode 100755 index 71b11f1..0000000 --- a/fib4 +++ /dev/null @@ -1,21 +0,0 @@ -#!/usr/bin/perl - -sub fib -{ - local($a) = $_[0]; - ($a < 2) ? $a : &fib($a-1) + &fib($a-2); -} - -sub myruntime -{ - local(@t) = times; # in seconds - $t[0] + $t[1]; -} - -$x = (shift || 20); -print "Starting fib($x)\n"; -$before = &myruntime; -$y = &fib($x); -$after = &myruntime; -printf("Done. Result $y in %g cpu seconds.\n", $after-$before); - diff --git a/foo b/foo deleted file mode 100755 index fcd3091..0000000 --- a/foo +++ /dev/null @@ -1,5 +0,0 @@ -#!./perl - -require 'dumpvar.pl'; - -&dumpvar("main"); diff --git a/form.h b/form.h index 6d60a43..531cc72 100644 --- a/form.h +++ b/form.h @@ -1,19 +1,10 @@ -/* $RCSfile: form.h,v $$Revision: 4.1 $$Date: 92/08/07 18:20:43 $ +/* form.h * - * Copyright (c) 1991, Larry Wall + * Copyright (c) 1991-1994, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. * - * $Log: form.h,v $ - * Revision 4.1 92/08/07 18:20:43 lwall - * - * Revision 4.0.1.1 91/06/07 11:08:20 lwall - * patch4: new copyright notice - * - * Revision 4.0 91/03/20 01:19:37 lwall - * 4.0 baseline. - * */ #define FF_END 0 diff --git a/gettest b/gettest deleted file mode 100755 index 565ae82..0000000 --- a/gettest +++ /dev/null @@ -1,20 +0,0 @@ -#!./perl - - while (($name,$aliases,$addrtype,$length,@addrs) = gethostent) { - print $name,' ',$aliases, - sprintf(" %d.%d.%d.%d\n",unpack('CCCC',$addrs[0])); - last if $i++ > 50; - } - ; - while (($name,$aliases,$addrtype,$net) = getnetent) { - print "$name $aliases $addrtype ",sprintf("%08lx",$net),"\n"; - } - ; - while (($name,$aliases,$proto) = getprotoent) { - print "$name $aliases $proto\n"; - } - ; - while (($name,$aliases,$port,$proto) = getservent) { - print "$name $aliases $port $proto\n"; - } - diff --git a/global.sym b/global.sym index d496c90..54b78c2 100644 --- a/global.sym +++ b/global.sym @@ -2,58 +2,115 @@ # Variables +AMG_names No Sv Xpv Yes +abs_amg +add_amg +add_ass_amg additem +amagic_generation an +atan2_amg +autoboot_preamble +band_amg +bool__amg +bor_amg buf bufend bufptr +bxor_amg check coeff compiling +compl_amg comppad comppad_name comppad_name_fill +concat_amg +concat_ass_amg cop_seqmax +cos_amg cryptseen +cryptswitch_add cshlen cshname +curcop curinterp curpad dc +dec_amg di +div_amg +div_ass_amg ds egid +envgv +eq_amg error_count euid evalseq -evstr +exp_amg expect expectterm +fallback_amg fold freq +ge_amg gid +gt_amg hexdigit hints in_my +inc_amg know_next last_lop last_lop_op last_uni +le_amg +lex_state +lex_defer +lex_expect +lex_brackets +lex_formbrack +lex_fakebrack +lex_casemods +lex_dojoin +lex_starts +lex_stuff +lex_repl +lex_op +lex_inpat +lex_inwhat +lex_brackstack +lex_casestack linestr +log_amg +lshift_amg +lshift_ass_amg +lt_amg markstack markstack_max markstack_ptr max_intro_pending min_intro_pending +mod_amg +mod_ass_amg +mult_amg +mult_ass_amg multi_close multi_end multi_open multi_start na +ncmp_amg +nextval +nexttype +nexttoke +ne_amg +neg_amg nexttype nextval no_aelem @@ -68,6 +125,9 @@ no_usym nointrp nomem nomemok +nomethod_amg +not_amg +numer_amg oldbufptr oldoldbufptr op @@ -78,7 +138,11 @@ origalen origenviron padix patleave +pow_amg +pow_ass_amg ppaddr +profiledata +qrt_amg rcsid reall_srchlen regarglen @@ -94,46 +158,67 @@ regmyendp regmyp_size regmystartp regnarrate +regnaughty regnpar regparse regprecomp regprev regsawback -regsawbracket regsize regstartp regtill regxend +repeat_amg +repeat_ass_amg retstack retstack_ix retstack_max rsfp +rshift_amg +rshift_ass_amg savestack savestack_ix savestack_max saw_return +scmp_amg scopestack scopestack_ix scopestack_max scrgv +seq_amg +sge_amg +sgt_amg sig_name +siggv +sighandler simple +sin_amg +sle_amg +slt_amg +sne_amg +stack stack_base stack_max stack_sp statbuf +string_amg sub_generation subline subname +subtr_amg +subtr_ass_amg sv_no sv_undef sv_yes +tainting thisexpr timesbuf tokenbuf uid varies vert +vtbl_amagic +vtbl_amagicelem vtbl_arylen vtbl_bm vtbl_dbline @@ -145,6 +230,7 @@ vtbl_isaelem vtbl_mglob vtbl_pack vtbl_packelem +vtbl_pos vtbl_sig vtbl_sigelem vtbl_substr @@ -187,20 +273,19 @@ av_fill av_len av_make av_pop -av_popnulls av_push av_shift av_store av_undef av_unshift bind_match -block_head +block_end +block_start calllist cando check_uni checkcomma ck_aelem -ck_chop ck_concat ck_eof ck_eval @@ -223,11 +308,11 @@ ck_rvconst ck_select ck_shift ck_sort +ck_spair ck_split ck_subr ck_trunc convert -cpy7bit cpytill croak cv_undef @@ -237,12 +322,12 @@ deb_growlevel debop debstack debstackptrs +deprecate die die_where do_aexec do_chop do_close -do_ctl do_eof do_exec do_execfree @@ -256,6 +341,7 @@ do_open do_pipe do_print do_readline +do_chomp do_seek do_semop do_shmio @@ -278,14 +364,12 @@ fbm_compile fbm_instr fetch_gv fetch_io -fetch_stash fold_constants force_ident force_next force_word free_tmps gen_constant_list -getgimme gp_free gp_ref gv_AVadd @@ -298,13 +382,16 @@ gv_fetchmethod gv_fetchpv gv_fullname gv_init +gv_stashpv +gv_stashsv he_delayfree he_free -hint hoistmust hv_clear hv_delete +hv_exists hv_fetch +hv_stashpv hv_iterinit hv_iterkey hv_iternext @@ -332,11 +419,13 @@ magic_get magic_getarylen magic_getglob magic_getpack +magic_getpos magic_gettaint magic_getuvar magic_len magic_nextpack magic_set +magic_setamagic magic_setarylen magic_setbm magic_setdbline @@ -345,12 +434,15 @@ magic_setglob magic_setisa magic_setmglob magic_setpack +magic_setpos magic_setsig magic_setsubstr magic_settaint magic_setuvar magic_setvec +magic_wipepack magicname +markstack_grow mess mg_clear mg_copy @@ -395,9 +487,11 @@ newLOOPOP newMETHOD newNULLLIST newOP +newPROG newPMOP newPVOP newRANGE +newRV newSLICEOP newSTATEOP newSUB @@ -411,11 +505,11 @@ newSVsv newUNOP newWHILEOP newXSUB +newXS nextargv ninstr no_fh_allowed no_op -nsavestr oopsAV oopsCV oopsHV @@ -478,7 +572,6 @@ pp_delete pp_die pp_divide pp_dofile -pp_done pp_dump pp_each pp_egrent @@ -488,6 +581,7 @@ pp_enter pp_entereval pp_enteriter pp_enterloop +pp_entersub pp_entersubr pp_entertry pp_enterwrite @@ -498,6 +592,7 @@ pp_eq pp_eservent pp_evalonce pp_exec +pp_exists pp_exit pp_exp pp_fcntl @@ -588,7 +683,7 @@ pp_le pp_leave pp_leaveeval pp_leaveloop -pp_leavesubr +pp_leavesub pp_leavetry pp_leavewrite pp_left_shift @@ -602,6 +697,7 @@ pp_log pp_lslice pp_lstat pp_lt +pp_map pp_match pp_method pp_mkdir @@ -631,6 +727,7 @@ pp_padhv pp_padsv pp_pipe_op pp_pop +pp_pos pp_postdec pp_postinc pp_pow @@ -669,6 +766,7 @@ pp_rv2cv pp_rv2gv pp_rv2hv pp_rv2sv +pp_chomp pp_sassign pp_scalar pp_schop @@ -710,6 +808,8 @@ pp_sprotoent pp_spwent pp_sqrt pp_srand +pp_srefgen +pp_schomp pp_sselect pp_sservent pp_ssockopt @@ -765,6 +865,8 @@ regprop repeatcpy rninstr run +savepv +savepvn save_I32 save_aptr save_ary @@ -783,7 +885,6 @@ save_scalar save_sptr save_svref savestack_grow -savestr sawparens scalar scalarkids @@ -807,23 +908,25 @@ scope screaminstr setenv_getix skipspace +stack_grow start_subparse sublex_done sublex_start sv_2bool sv_2cv +sv_2io sv_2iv sv_2mortal sv_2nv sv_2pv sv_backoff +sv_bless sv_catpv sv_catpvn sv_catsv sv_chop sv_clean_all -sv_clean_magic -sv_clean_refs +sv_clean_objs sv_clear sv_cmp sv_dec @@ -849,6 +952,8 @@ sv_setnv sv_setptrobj sv_setpv sv_setpvn +sv_setref_iv +sv_setref_pv sv_setsv sv_unmagic sv_upgrade @@ -862,6 +967,7 @@ wait4pid warn watch whichsig +xiv_arenaroot xiv_root xnv_root xpv_root diff --git a/gv.c b/gv.c index 790e0be..3a9b825 100644 --- a/gv.c +++ b/gv.c @@ -1,43 +1,19 @@ -/* $RCSfile: gv.c,v $$Revision: 4.1 $$Date: 92/08/07 18:26:39 $ +/* gv.c * - * Copyright (c) 1991, Larry Wall + * Copyright (c) 1991-1994, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. * - * $Log: gv.c,v $ - * Revision 4.1 92/08/07 18:26:39 lwall - * - * Revision 4.0.1.4 92/06/08 15:32:19 lwall - * patch20: fixed confusion between a *var's real name and its effective name - * patch20: the debugger now warns you on lines that can't set a breakpoint - * patch20: the debugger made perl forget the last pattern used by // - * patch20: paragraph mode now skips extra newlines automatically - * patch20: ($<,$>) = ... didn't work on some architectures - * - * Revision 4.0.1.3 91/11/05 18:35:33 lwall - * patch11: length($x) was sometimes wrong for numeric $x - * patch11: perl now issues warning if $SIG{'ALARM'} is referenced - * patch11: *foo = undef coredumped - * patch11: solitary subroutine references no longer trigger typo warnings - * patch11: local(*FILEHANDLE) had a memory leak - * - * Revision 4.0.1.2 91/06/07 11:55:53 lwall - * patch4: new copyright notice - * patch4: added $^P variable to control calling of perldb routines - * patch4: added $^F variable to specify maximum system fd, default 2 - * patch4: $` was busted inside s/// - * patch4: default top-of-form run_format is now FILEHANDLE_TOP - * patch4: length($`), length($&), length($') now optimized to avoid string copy - * patch4: $^D |= 1024 now does syntax tree dump at run-time - * - * Revision 4.0.1.1 91/04/12 09:10:24 lwall - * patch1: Configure now differentiates getgroups() type from getgid() type - * patch1: you may now use "die" and "caller" in a signal handler - * - * Revision 4.0 91/03/20 01:39:41 lwall - * 4.0 baseline. - * + */ + +/* + * 'Mercy!' cried Gandalf. 'If the giving of information is to be the cure + * of your inquisitiveness, I shall spend all the rest of my days answering + * you. What more do you want to know?' + * 'The names of all the stars, and of all living things, and the whole + * history of Middle-earth and Over-heaven and of the Sundering Seas,' + * laughed Pippin. */ #include "EXTERN.h" @@ -49,6 +25,8 @@ GV * gv_AVadd(gv) register GV *gv; { + if (!gv || SvTYPE((SV*)gv) != SVt_PVGV) + croak("Bad symbol for array"); if (!GvAV(gv)) GvAV(gv) = newAV(); return gv; @@ -58,12 +36,25 @@ GV * gv_HVadd(gv) register GV *gv; { + if (!gv || SvTYPE((SV*)gv) != SVt_PVGV) + croak("Bad symbol for hash"); if (!GvHV(gv)) GvHV(gv) = newHV(); return gv; } GV * +gv_IOadd(gv) +register GV *gv; +{ + if (!gv || SvTYPE((SV*)gv) != SVt_PVGV) + croak("Bad symbol for filehandle"); + if (!GvIOp(gv)) + GvIOp(gv) = newIO(); + return gv; +} + +GV * gv_fetchfile(name) char *name; { @@ -73,7 +64,7 @@ char *name; sprintf(tmpbuf,"::_<%s", name); gv = gv_fetchpv(tmpbuf, TRUE, SVt_PVGV); sv_setpv(GvSV(gv), name); - if (*name == '/') + if (*name == '/' && (instr(name,"/lib/") || instr(name,".pm"))) SvMULTI_on(gv); if (perldb) hv_magic(GvHVn(gv_AVadd(gv)), gv, 'L'); @@ -102,22 +93,47 @@ int multi; GvEGV(gv) = gv; sv_magic((SV*)gv, (SV*)gv, '*', name, len); GvSTASH(gv) = stash; - GvNAME(gv) = nsavestr(name, len); + GvNAME(gv) = savepvn(name, len); GvNAMELEN(gv) = len; if (multi) SvMULTI_on(gv); } +static void +gv_init_sv(gv, sv_type) +GV* gv; +I32 sv_type; +{ + switch (sv_type) { + case SVt_PVIO: + (void)GvIOn(gv); + break; + case SVt_PVAV: + (void)GvAVn(gv); + break; + case SVt_PVHV: + (void)GvHVn(gv); + break; + } +} + GV * -gv_fetchmeth(stash, name, len) +gv_fetchmeth(stash, name, len, level) HV* stash; char* name; STRLEN len; +I32 level; { AV* av; GV* topgv; GV* gv; GV** gvp; + HV* lastchance; + + if (!stash) + return 0; + if (level > 100) + croak("Recursive inheritance detected"); gvp = (GV**)hv_fetch(stash, name, len, TRUE); @@ -137,14 +153,14 @@ STRLEN len; I32 items = AvFILL(av) + 1; while (items--) { SV* sv = *svp++; - HV* basestash = fetch_stash(sv, FALSE); + HV* basestash = gv_stashsv(sv, FALSE); if (!basestash) { if (dowarn) - warn("Can't locate package %s for @%s'ISA", + warn("Can't locate package %s for @%s::ISA", SvPVX(sv), HvNAME(stash)); continue; } - gv = gv_fetchmeth(basestash, name, len); + gv = gv_fetchmeth(basestash, name, len, level + 1); if (gv) { GvCV(topgv) = GvCV(gv); /* cache the CV */ GvCVGEN(topgv) = sub_generation; /* valid for now */ @@ -152,6 +168,17 @@ STRLEN len; } } } + + if (!level) { + if (lastchance = gv_stashpv("UNIVERSAL", FALSE)) { + if (gv = gv_fetchmeth(lastchance, name, len, level + 1)) { + GvCV(topgv) = GvCV(gv); /* cache the CV */ + GvCVGEN(topgv) = sub_generation; /* valid for now */ + return gv; + } + } + } + return 0; } @@ -161,20 +188,78 @@ HV* stash; char* name; { register char *nend; + char *nsplit = 0; + GV* gv; for (nend = name; *nend; nend++) { - if (*nend == ':' || *nend == '\'') { - return gv_fetchpv(name, FALSE, SVt_PVCV); + if (*nend == ':' || *nend == '\'') + nsplit = nend; + } + if (nsplit) { + char ch; + char *origname = name; + name = nsplit + 1; + ch = *nsplit; + if (*nsplit == ':') + --nsplit; + *nsplit = '\0'; + stash = gv_stashpv(origname,TRUE); + *nsplit = ch; + } + gv = gv_fetchmeth(stash, name, nend - name, 0); + if (!gv) { + CV* cv; + + if (strEQ(name,"import") || strEQ(name,"unimport")) + gv = &sv_yes; + else if (strNE(name, "AUTOLOAD")) { + gv = gv_fetchmeth(stash, "AUTOLOAD", 8, 0); + if (gv && (cv = GvCV(gv))) { /* One more chance... */ + SV *tmpstr = sv_newmortal(); + sv_catpv(tmpstr,HvNAME(stash)); + sv_catpvn(tmpstr,"::", 2); + sv_catpvn(tmpstr, name, nend - name); + sv_setsv(GvSV(CvGV(cv)), tmpstr); + } } } - return gv_fetchmeth(stash, name, nend - name); + return gv; +} + +HV* +gv_stashpv(name,create) +char *name; +I32 create; +{ + char tmpbuf[1234]; + HV *stash; + GV *tmpgv; + sprintf(tmpbuf,"%.*s::",1200,name); + tmpgv = gv_fetchpv(tmpbuf,create, SVt_PVHV); + if (!tmpgv) + return 0; + if (!GvHV(tmpgv)) + GvHV(tmpgv) = newHV(); + stash = GvHV(tmpgv); + if (!HvNAME(stash)) + HvNAME(stash) = savepv(name); + return stash; } +HV* +gv_stashsv(sv,create) +SV *sv; +I32 create; +{ + return gv_stashpv(SvPV(sv,na), create); +} + + GV * -gv_fetchpv(nambeg,add,svtype) +gv_fetchpv(nambeg,add,sv_type) char *nambeg; I32 add; -I32 svtype; +I32 sv_type; { register char *name = nambeg; register GV *gv = 0; @@ -191,13 +276,16 @@ I32 svtype; { if (!stash) stash = defstash; + if (!SvREFCNT(stash)) /* symbol table under destruction */ + return Nullgv; len = namend - name; if (len > 0) { - New(601, tmpbuf, len+2, char); - *tmpbuf = '_'; - Copy(name, tmpbuf+1, len, char); - tmpbuf[++len] = '\0'; + New(601, tmpbuf, len+3, char); + Copy(name, tmpbuf, len, char); + tmpbuf[len++] = ':'; + tmpbuf[len++] = ':'; + tmpbuf[len] = '\0'; gvp = (GV**)hv_fetch(stash,tmpbuf,len,add); Safefree(tmpbuf); if (!gvp || *gvp == (GV*)&sv_undef) @@ -206,6 +294,8 @@ I32 svtype; if (SvTYPE(gv) == SVt_PVGV) SvMULTI_on(gv); + else if (!add) + return Nullgv; else gv_init(gv, stash, nambeg, namend - nambeg, (add & 2)); @@ -213,7 +303,7 @@ I32 svtype; stash = GvHV(gv) = newHV(); if (!HvNAME(stash)) - HvNAME(stash) = nsavestr(nambeg, namend - nambeg); + HvNAME(stash) = savepvn(nambeg, namend - nambeg); } if (*namend == ':') @@ -221,9 +311,12 @@ I32 svtype; namend++; name = namend; if (!*name) - return gv ? gv : defgv; + return gv ? gv : *hv_fetch(defstash, "main::", 6, TRUE); } } + len = namend - name; + if (!len) + len = 1; /* No stash in name, so see how we can default */ @@ -256,8 +349,11 @@ I32 svtype; if (global) stash = defstash; else if ((COP*)curcop == &compiling) { - if (!(hints & HINT_STRICT_VARS) || svtype == SVt_PVCV) - stash = curstash; + stash = curstash; + if (add && (hints & HINT_STRICT_VARS) && sv_type != SVt_PVCV) { + if (stash && !hv_fetch(stash,name,len,0)) + stash = 0; + } } else stash = curcop->cop_stash; @@ -268,46 +364,85 @@ I32 svtype; /* By this point we should have a stash and a name */ - if (!stash) - croak("Global symbol \"%s\" requires explicit package name", name); - len = namend - name; - if (!len) - len = 1; + if (!stash) { + if (add) { + warn("Global symbol \"%s\" requires explicit package name", name); + ++error_count; + stash = curstash ? curstash : defstash; /* avoid core dumps */ + } + else + return Nullgv; + } + + if (!SvREFCNT(stash)) /* symbol table under destruction */ + return Nullgv; + gvp = (GV**)hv_fetch(stash,name,len,add); if (!gvp || *gvp == (GV*)&sv_undef) return Nullgv; gv = *gvp; if (SvTYPE(gv) == SVt_PVGV) { - SvMULTI_on(gv); + if (add) { + SvMULTI_on(gv); + gv_init_sv(gv, sv_type); + } return gv; } /* Adding a new symbol */ + if (add & 4) + warn("Had to create %s unexpectedly", nambeg); gv_init(gv, stash, name, len, add & 2); + gv_init_sv(gv, sv_type); /* set up magic where warranted */ switch (*name) { + case 'A': + if (strEQ(name, "ARGV")) { + IoFLAGS(GvIOn(gv)) |= IOf_ARGV|IOf_START; + } + break; + case 'a': case 'b': if (len == 1) SvMULTI_on(gv); break; + case 'E': + if (strnEQ(name, "EXPORT", 6)) + SvMULTI_on(gv); + break; case 'I': if (strEQ(name, "ISA")) { AV* av = GvAVn(gv); SvMULTI_on(gv); - sv_magic((SV*)av, (SV*)gv, 'I', 0, 0); - if (add & 2 && strEQ(nambeg,"Any_DBM_File::ISA") && AvFILL(av) == -1) + sv_magic((SV*)av, (SV*)gv, 'I', Nullch, 0); + if (add & 2 && strEQ(nambeg,"AnyDBM_File::ISA") && AvFILL(av) == -1) { - av_push(av, newSVpv("NDBM_File",0)); - av_push(av, newSVpv("DB_File",0)); - av_push(av, newSVpv("GDBM_File",0)); - av_push(av, newSVpv("SDBM_File",0)); - av_push(av, newSVpv("ODBM_File",0)); + char *pname; + av_push(av, newSVpv(pname = "NDBM_File",0)); + gv_stashpv(pname, TRUE); + av_push(av, newSVpv(pname = "DB_File",0)); + gv_stashpv(pname, TRUE); + av_push(av, newSVpv(pname = "GDBM_File",0)); + gv_stashpv(pname, TRUE); + av_push(av, newSVpv(pname = "SDBM_File",0)); + gv_stashpv(pname, TRUE); + av_push(av, newSVpv(pname = "ODBM_File",0)); + gv_stashpv(pname, TRUE); } } break; +#ifdef OVERLOAD + case 'O': + if (strEQ(name, "OVERLOAD")) { + HV* hv = GvHVn(gv); + SvMULTI_on(gv); + sv_magic((SV*)hv, (SV*)gv, 'A', 0, 0); + } + break; +#endif /* OVERLOAD */ case 'S': if (strEQ(name, "SIG")) { HV *hv; @@ -318,9 +453,9 @@ I32 svtype; /* initialize signal stack */ signalstack = newAV(); - av_store(signalstack, 32, Nullsv); - av_clear(signalstack); AvREAL_off(signalstack); + av_extend(signalstack, 30); + av_fill(signalstack, 0); } break; @@ -329,21 +464,21 @@ I32 svtype; break; ampergv = gv; sawampersand = TRUE; - goto magicalize; + goto ro_magicalize; case '`': if (len > 1) break; leftgv = gv; sawampersand = TRUE; - goto magicalize; + goto ro_magicalize; case '\'': if (len > 1) break; rightgv = gv; sawampersand = TRUE; - goto magicalize; + goto ro_magicalize; case ':': if (len > 1) @@ -351,8 +486,13 @@ I32 svtype; sv_setpv(GvSV(gv),chopset); goto magicalize; - case '!': case '#': + case '*': + if (dowarn && len == 1 && sv_type == SVt_PV) + warn("Use of $%s is deprecated", name); + /* FALL THROUGH */ + case '[': + case '!': case '?': case '^': case '~': @@ -360,8 +500,6 @@ I32 svtype; case '-': case '%': case '.': - case '+': - case '*': case '(': case ')': case '<': @@ -369,9 +507,9 @@ I32 svtype; case ',': case '\\': case '/': - case '[': case '|': case '\004': + case '\010': case '\t': case '\020': case '\024': @@ -381,6 +519,7 @@ I32 svtype; break; goto magicalize; + case '+': case '1': case '2': case '3': @@ -390,6 +529,8 @@ I32 svtype; case '7': case '8': case '9': + ro_magicalize: + SvREADONLY_on(GvSV(gv)); magicalize: sv_magic(GvSV(gv), (SV*)gv, 0, name, len); break; @@ -410,9 +551,7 @@ I32 svtype; SV *sv; sv = GvSV(gv); sv_upgrade(sv, SVt_PVNV); - sv_setpv(sv,rcsid); - SvNVX(sv) = atof(patchlevel); - SvNOK_on(sv); + sv_setpv(sv, patchlevel); } break; } @@ -457,7 +596,7 @@ newIO() GV *iogv; io = (IO*)NEWSV(0,0); - sv_upgrade(io,SVt_PVIO); + sv_upgrade((SV *)io,SVt_PVIO); SvREFCNT(io) = 1; SvOBJECT_on(io); iogv = gv_fetchpv("FileHandle::", TRUE, SVt_PVIO); @@ -473,34 +612,39 @@ HV* stash; register I32 i; register GV *gv; HV *hv; + GV *filegv; if (!HvARRAY(stash)) return; - for (i = 0; i <= HvMAX(stash); i++) { + for (i = 0; i <= (I32) HvMAX(stash); i++) { for (entry = HvARRAY(stash)[i]; entry; entry = entry->hent_next) { - if (isALPHA(*entry->hent_key)) { + if (entry->hent_key[entry->hent_klen-1] == ':' && + (gv = (GV*)entry->hent_val) && (hv = GvHV(gv)) && HvNAME(hv)) + { + if (hv != defstash) + gv_check(hv); /* nested package */ + } + else if (isALPHA(*entry->hent_key)) { gv = (GV*)entry->hent_val; if (SvMULTI(gv)) continue; curcop->cop_line = GvLINE(gv); - curcop->cop_filegv = GvFILEGV(gv); - if (SvMULTI(GvFILEGV(gv))) /* Filename began with slash */ + filegv = GvFILEGV(gv); + curcop->cop_filegv = filegv; + if (filegv && SvMULTI(filegv)) /* Filename began with slash */ continue; - warn("Identifier \"%s::%s\" used only once: possible typo", HvNAME(stash), GvNAME(gv)); + warn("Identifier \"%s::%s\" used only once: possible typo", + HvNAME(stash), GvNAME(gv)); } - else if (*entry->hent_key == '_' && - (gv = (GV*)entry->hent_val) && - (hv = GvHV(gv)) && HvNAME(hv) && hv != defstash) - gv_check(hv); /* nested package */ - } } } GV * -newGVgen() +newGVgen(pack) +char *pack; { - (void)sprintf(tokenbuf,"_GEN_%d",gensym++); + (void)sprintf(tokenbuf,"%s::_GEN_%ld",pack,(long)gensym++); return gv_fetchpv(tokenbuf,TRUE, SVt_PVGV); } @@ -568,3 +712,344 @@ register GV *gv; return GvGP(gv_HVadd(gv))->gp_hv; } #endif /* Microport 2.4 hack */ + +#ifdef OVERLOAD +/* Updates and caches the CV's */ + +bool +Gv_AMupdate(stash) +HV* stash; +{ + GV** gvp; + HV* hv; + GV* gv; + CV* cv; + MAGIC* mg=mg_find((SV*)stash,'c'); + AMT *amtp; + + if (mg && (amtp=((AMT*)(mg->mg_ptr)))->was_ok_am == amagic_generation && + amtp->was_ok_sub == sub_generation) + return HV_AMAGIC(stash)? TRUE: FALSE; + gvp=(GV**)hv_fetch(stash,"OVERLOAD",8,FALSE); + sv_unmagic((SV*)stash, 'c'); + + DEBUG_o( deb("Recalcing overload magic in package %s\n",HvNAME(stash)) ); + + if (gvp && ((gv = *gvp) != (GV*)&sv_undef && (hv = GvHV(gv)))) { + int filled=0; + int i; + char *cp; + AMT amt; + SV* sv; + SV** svp; + +/* if (*(svp)==(SV*)amagic_generation && *(svp+1)==(SV*)sub_generation) { + DEBUG_o( deb("Overload magic in package %s up-to-date\n",HvNAME(stash)) +); + return HV_AMAGIC(stash)? TRUE: FALSE; + }*/ + + amt.was_ok_am=amagic_generation; + amt.was_ok_sub=sub_generation; + amt.fallback=AMGfallNO; + + /* Work with "fallback" key, which we assume to be first in AMG_names */ + + if ((cp=((char**)(*AMG_names))[0]) && + (svp=(SV**)hv_fetch(hv,cp,strlen(cp),FALSE)) && (sv = *svp)) { + if (SvTRUE(sv)) amt.fallback=AMGfallYES; + else if (SvOK(sv)) amt.fallback=AMGfallNEVER; + } + + for (i=1;icop_stash, SvPV(sv, na)); + if (gv) cv = GvCV(gv); + break; + } + cv = (CV*)SvRV(sv); + if (SvTYPE(cv) == SVt_PVCV) + break; + /* FALL THROUGH */ + case SVt_PVHV: + case SVt_PVAV: + die("Not a subroutine reference in %%OVERLOAD"); + return FALSE; + case SVt_PVCV: + cv = (CV*)sv; + break; + case SVt_PVGV: + if (!(cv = GvCV((GV*)sv))) + cv = sv_2cv(sv, &stash, &gv, TRUE); + break; + } + if (cv) filled=1; + else { + die("Method for operation %s not found in package %s during blessing\n", + cp,HvNAME(stash)); + return FALSE; + } + } + } + amt.table[i]=cv; + } + sv_magic((SV*)stash, 0, 'c', (char*)&amt, sizeof(amt)); + if (filled) { +/* HV_badAMAGIC_off(stash);*/ + HV_AMAGIC_on(stash); + return TRUE; + } + } +/*HV_badAMAGIC_off(stash);*/ + HV_AMAGIC_off(stash); + return FALSE; +} + +/* During call to this subroutine stack can be reallocated. It is + * advised to call SPAGAIN macro in your code after call */ + +SV* +amagic_call(left,right,method,flags) +SV* left; +SV* right; +int method; +int flags; +{ + MAGIC *mg; + CV *cv; + CV **cvp=NULL, **ocvp=NULL; + AMT *amtp, *oamtp; + int fl=0, off, off1, lr=0, assign=AMGf_assign & flags, notfound=0; + int postpr=0; + HV* stash; + if (!(AMGf_noleft & flags) && SvAMAGIC(left) + && (mg = mg_find((SV*)(stash=SvSTASH(SvRV(left))),'c')) + && (ocvp = cvp = ((oamtp=amtp=(AMT*)mg->mg_ptr)->table)) + && (assign ? + ((cv = cvp[off=method+1]) + || ( amtp->fallback > AMGfallNEVER && /* fallback to + * usual method */ + (fl = 1, cv = cvp[off=method]))): + (1 && (cv = cvp[off=method])) )) { + lr = -1; /* Call method for left argument */ + } else { + if (cvp && amtp->fallback > AMGfallNEVER && flags & AMGf_unary) { + int logic; + + /* look for substituted methods */ + switch (method) { + case inc_amg: + if ((cv = cvp[off=add_ass_amg]) + || ((cv = cvp[off=add_amg]) && (postpr=1))) { + right = &sv_yes; lr = -1; assign = 1; + } + break; + case dec_amg: + if ((cv = cvp[off=subtr_ass_amg]) + || ((cv = cvp[off=subtr_amg]) && (postpr=1))) { + right = &sv_yes; lr = -1; assign = 1; + } + break; + case bool__amg: + (void)((cv = cvp[off=numer_amg]) || (cv = cvp[off=string_amg])); + break; + case numer_amg: + (void)((cv = cvp[off=string_amg]) || (cv = cvp[off=bool__amg])); + break; + case string_amg: + (void)((cv = cvp[off=numer_amg]) || (cv = cvp[off=bool__amg])); + break; + case abs_amg: + if ((cvp[off1=lt_amg] || cvp[off1=lt_amg]) + && ((cv = cvp[off=neg_amg]) || (cv = cvp[off=subtr_amg]))) { + if (off1==lt_amg) { + SV* lessp = amagic_call(left, + sv_2mortal(newSViv(0)), + lt_amg,AMGf_noright); + logic = SvTRUE(lessp); + } else { + SV* lessp = amagic_call(left, + sv_2mortal(newSViv(0)), + ncmp_amg,AMGf_noright); + logic = (SvNV(lessp) < 0); + } + if (logic) { + if (off==subtr_amg) { + right = left; + left = sv_2mortal(newSViv(0)); + lr = 1; + } + } else { + return left; + } + } + break; + case neg_amg: + if (cv = cvp[off=subtr_amg]) { + right = left; + left = sv_2mortal(newSViv(0)); + lr = 1; + } + break; + default: + goto not_found; + } + if (!cv) goto not_found; + } else if (!(AMGf_noright & flags) && SvAMAGIC(right) + && (mg = mg_find((SV*)(stash=SvSTASH(SvRV(right))),'c')) + && (cvp = ((amtp=(AMT*)mg->mg_ptr)->table)) + && (cv = cvp[off=method])) { /* Method for right + * argument found */ + lr=1; + } else if (((ocvp && oamtp->fallback > AMGfallNEVER && (cvp=ocvp)) + || (cvp && amtp->fallback > AMGfallNEVER && (lr=1))) + && !(flags & AMGf_unary)) { + /* We look for substitution for + * comparison operations and + * concatendation */ + if (method==concat_amg || method==concat_ass_amg + || method==repeat_amg || method==repeat_ass_amg) { + return NULL; /* Delegate operation to string conversion */ + } + off = -1; + switch (method) { + case lt_amg: + case le_amg: + case gt_amg: + case ge_amg: + case eq_amg: + case ne_amg: + postpr = 1; off=ncmp_amg; break; + case slt_amg: + case sle_amg: + case sgt_amg: + case sge_amg: + case seq_amg: + case sne_amg: + postpr = 1; off=scmp_amg; break; + } + if (off != -1) cv = cvp[off]; + if (!cv) { + goto not_found; + } + } else { + not_found: /* No method found, either report or die */ + if (ocvp && (cv=ocvp[nomethod_amg])) { /* Call report method */ + notfound = 1; lr = -1; + } else if (cvp && (cv=cvp[nomethod_amg])) { + notfound = 1; lr = 1; + } else { + char tmpstr[512]; + sprintf(tmpstr,"Operation `%s': no method found,\n\tleft argument %s%200s,\n\tright argument %s%200s", + ((char**)AMG_names)[off], + SvAMAGIC(left)? + "in overloaded package ": + "has no overloaded magic", + SvAMAGIC(left)? + HvNAME(SvSTASH(SvRV(left))): + "", + SvAMAGIC(right)? + "in overloaded package ": + "has no overloaded magic", + SvAMAGIC(right)? + HvNAME(SvSTASH(SvRV(right))): + ""); + if (amtp && amtp->fallback >= AMGfallYES) { + DEBUG_o( deb(tmpstr) ); + } else { + die(tmpstr); + } + return NULL; + } + } + } + if (!notfound) { + DEBUG_o( deb("Operation `%s': method for %s argument found in package %s%s\n", + ((char**)AMG_names)[off], + (lr? "right": "left"), + HvNAME(stash), + fl? ",\n\tassignment variant used": "") ); + /* Since we use shallow copy, we need to dublicate the contents, + probably we need also to use user-supplied version of coping? + */ + if (assign || method==inc_amg || method==dec_amg) RvDEEPCP(left); + } + { + dSP; + BINOP myop; + SV* res; + + Zero(&myop, 1, BINOP); + myop.op_last = (OP *) &myop; + myop.op_next = Nullop; + myop.op_flags = OPf_KNOW|OPf_STACKED; + + ENTER; + SAVESPTR(op); + op = (OP *) &myop; + PUTBACK; + pp_pushmark(); + + EXTEND(sp, notfound + 5); + PUSHs(lr>0? right: left); + PUSHs(lr>0? left: right); + PUSHs( assign ? &sv_undef : (lr>0? &sv_yes: &sv_no)); + if (notfound) { + PUSHs( sv_2mortal(newSVpv(((char**)AMG_names)[off],0)) ); + } + PUSHs((SV*)cv); + PUTBACK; + + if (op = pp_entersub()) + run(); + LEAVE; + SPAGAIN; + + res=POPs; + PUTBACK; + + if (notfound) { + /* sv_2mortal(res); */ + return NULL; + } + + if (postpr) { + int ans; + switch (method) { + case le_amg: + case sle_amg: + ans=SvIV(res)<=0; break; + case lt_amg: + case slt_amg: + ans=SvIV(res)<0; break; + case ge_amg: + case sge_amg: + ans=SvIV(res)>=0; break; + case gt_amg: + case sgt_amg: + ans=SvIV(res)>0; break; + case eq_amg: + case seq_amg: + ans=SvIV(res)==0; break; + case ne_amg: + case sne_amg: + ans=SvIV(res)!=0; break; + case inc_amg: + case dec_amg: + SvSetSV(left,res); return res; break; + } + return ans? &sv_yes: &sv_no; + } else { + return res; + } + } +} +#endif /* OVERLOAD */ diff --git a/gv.h b/gv.h index a0da45e..3e5ef98 100644 --- a/gv.h +++ b/gv.h @@ -1,27 +1,10 @@ -/* $RCSfile: gv.h,v $$Revision: 4.1 $$Date: 92/08/07 18:26:42 $ +/* gv.h * - * Copyright (c) 1991, Larry Wall + * Copyright (c) 1991-1994, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. * - * $Log: gv.h,v $ - * Revision 4.1 92/08/07 18:26:42 lwall - * - * Revision 4.0.1.3 92/06/08 15:33:44 lwall - * patch20: fixed confusion between a *var's real name and its effective name - * patch20: ($<,$>) = ... didn't work on some architectures - * - * Revision 4.0.1.2 91/11/05 18:36:15 lwall - * patch11: length($x) was sometimes wrong for numeric $x - * - * Revision 4.0.1.1 91/06/07 11:56:35 lwall - * patch4: new copyright notice - * patch4: length($`), length($&), length($') now optimized to avoid string copy - * - * Revision 4.0 91/03/20 01:39:49 lwall - * 4.0 baseline. - * */ struct gp { @@ -46,13 +29,11 @@ struct gp { #define GvXPVGV(gv) ((XPVGV*)SvANY(gv)) -#define GvMAGIC(gv) (GvGP(gv)->gp_magic) #define GvSV(gv) (GvGP(gv)->gp_sv) #define GvREFCNT(gv) (GvGP(gv)->gp_refcnt) -#define GvIO(gv) (GvGP(gv)->gp_io) -#define GvIOn(gv) (GvIO(gv) ? \ - GvIO(gv) : \ - (GvIO(gv) = newIO())) +#define GvIO(gv) ((gv) && SvTYPE((SV*)gv) == SVt_PVGV ? GvIOp(gv) : 0) +#define GvIOp(gv) (GvGP(gv)->gp_io) +#define GvIOn(gv) (GvIO(gv) ? GvIOp(gv) : GvIOp(gv_IOadd(gv))) #define GvFORM(gv) (GvGP(gv)->gp_form) #define GvAV(gv) (GvGP(gv)->gp_av) @@ -104,3 +85,9 @@ HV *GvHVn(); #define DM_EGID 0x020 #define DM_DELAY 0x100 +#define GVf_INTRO 0x01 +#define GVf_IMPORTED 0x02 + +#define GV_ADD 0x01 +#define GV_ADDMULTI 0x02 +#define GV_ADDWARN 0x04 diff --git a/h2ph b/h2ph deleted file mode 100755 index 59caa58..0000000 --- a/h2ph +++ /dev/null @@ -1,253 +0,0 @@ -#!/usr/local/bin/perl -'di'; -'ig00'; - -$perlincl = '/usr/local/lib/perl'; - -chdir '/usr/include' || die "Can't cd /usr/include"; - -@isatype = split(' ',<-"); - } - else { - ($outfile = $file) =~ s/\.h$/.ph/ || next; - print "$file -> $outfile\n"; - if ($file =~ m|^(.*)/|) { - $dir = $1; - if (!-d "$perlincl/$dir") { - mkdir("$perlincl/$dir",0777); - } - } - open(IN,"$file") || ((warn "Can't open $file: $!\n"),next); - open(OUT,">$perlincl/$outfile") || die "Can't create $outfile: $!\n"; - } - while () { - chop; - while (/\\$/) { - chop; - $_ .= ; - chop; - } - if (s:/\*:\200:g) { - s:\*/:\201:g; - s/\200[^\201]*\201//g; # delete single line comments - if (s/\200.*//) { # begin multi-line comment? - $_ .= '/*'; - $_ .= ; - redo; - } - } - if (s/^#\s*//) { - if (s/^define\s+(\w+)//) { - $name = $1; - $new = ''; - s/\s+$//; - if (s/^\(([\w,\s]*)\)//) { - $args = $1; - if ($args ne '') { - foreach $arg (split(/,\s*/,$args)) { - $arg =~ s/^\s*([^\s].*[^\s])\s*$/$1/; - $curargs{$arg} = 1; - } - $args =~ s/\b(\w)/\$$1/g; - $args = "local($args) = \@_;\n$t "; - } - s/^\s+//; - do expr(); - $new =~ s/(["\\])/\\$1/g; - if ($t ne '') { - $new =~ s/(['\\])/\\$1/g; - print OUT $t, - "eval 'sub $name {\n$t ${args}eval \"$new\";\n$t}';\n"; - } - else { - print OUT "sub $name {\n ${args}eval \"$new\";\n}\n"; - } - %curargs = (); - } - else { - s/^\s+//; - do expr(); - $new = 1 if $new eq ''; - if ($t ne '') { - $new =~ s/(['\\])/\\$1/g; - print OUT $t,"eval 'sub $name {",$new,";}';\n"; - } - else { - print OUT $t,"sub $name {",$new,";}\n"; - } - } - } - elsif (/^include\s+<(.*)>/) { - ($incl = $1) =~ s/\.h$/.ph/; - print OUT $t,"require '$incl';\n"; - } - elsif (/^ifdef\s+(\w+)/) { - print OUT $t,"if (defined &$1) {\n"; - $tab += 4; - $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); - } - elsif (/^ifndef\s+(\w+)/) { - print OUT $t,"if (!defined &$1) {\n"; - $tab += 4; - $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); - } - elsif (s/^if\s+//) { - $new = ''; - do expr(); - print OUT $t,"if ($new) {\n"; - $tab += 4; - $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); - } - elsif (s/^elif\s+//) { - $new = ''; - do expr(); - $tab -= 4; - $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); - print OUT $t,"}\n${t}elsif ($new) {\n"; - $tab += 4; - $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); - } - elsif (/^else/) { - $tab -= 4; - $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); - print OUT $t,"}\n${t}else {\n"; - $tab += 4; - $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); - } - elsif (/^endif/) { - $tab -= 4; - $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); - print OUT $t,"}\n"; - } - } - } - print OUT "1;\n"; -} - -sub expr { - while ($_ ne '') { - s/^(\s+)// && do {$new .= ' '; next;}; - s/^(0x[0-9a-fA-F]+)// && do {$new .= $1; next;}; - s/^(\d+)// && do {$new .= $1; next;}; - s/^("(\\"|[^"])*")// && do {$new .= $1; next;}; - s/^'((\\"|[^"])*)'// && do { - if ($curargs{$1}) { - $new .= "ord('\$$1')"; - } - else { - $new .= "ord('$1')"; - } - next; - }; - s/^sizeof\s*\(([^)]+)\)/{$1}/ && do { - $new .= '$sizeof'; - next; - }; - s/^([_a-zA-Z]\w*)// && do { - $id = $1; - if ($id eq 'struct') { - s/^\s+(\w+)//; - $id .= ' ' . $1; - $isatype{$id} = 1; - } - elsif ($id eq 'unsigned') { - s/^\s+(\w+)//; - $id .= ' ' . $1; - $isatype{$id} = 1; - } - if ($curargs{$id}) { - $new .= '$' . $id; - } - elsif ($id eq 'defined') { - $new .= 'defined'; - } - elsif (/^\(/) { - s/^\((\w),/("$1",/ if $id =~ /^_IO[WR]*$/i; # cheat - $new .= " &$id"; - } - elsif ($isatype{$id}) { - if ($new =~ /{\s*$/) { - $new .= "'$id'"; - } - elsif ($new =~ /\(\s*$/ && /^[\s*]*\)/) { - $new =~ s/\(\s*$//; - s/^[\s*]*\)//; - } - else { - $new .= $id; - } - } - else { - $new .= ' &' . $id; - } - next; - }; - s/^(.)// && do {$new .= $1; next;}; - } -} -############################################################################## - - # These next few lines are legal in both Perl and nroff. - -.00; # finish .ig - -'di \" finish diversion--previous line must be blank -.nr nl 0-1 \" fake up transition to first page again -.nr % 0 \" start at page 1 -'; __END__ ############# From here on it's a standard manual page ############ -.TH H2PH 1 "August 8, 1990" -.AT 3 -.SH NAME -h2ph \- convert .h C header files to .ph Perl header files -.SH SYNOPSIS -.B h2ph [headerfiles] -.SH DESCRIPTION -.I h2ph -converts any C header files specified to the corresponding Perl header file -format. -It is most easily run while in /usr/include: -.nf - - cd /usr/include; h2ph * sys/* - -.fi -If run with no arguments, filters standard input to standard output. -.SH ENVIRONMENT -No environment variables are used. -.SH FILES -/usr/include/*.h -.br -/usr/include/sys/*.h -.br -etc. -.SH AUTHOR -Larry Wall -.SH "SEE ALSO" -perl(1) -.SH DIAGNOSTICS -The usual warnings if it can't read or write the files involved. -.SH BUGS -Doesn't construct the %sizeof array for you. -.PP -It doesn't handle all C constructs, but it does attempt to isolate -definitions inside evals so that you can get at the definitions -that it can translate. -.PP -It's only intended as a rough tool. -You may need to dicker with the files produced. -.ex diff --git a/h2ph.SH b/h2ph.SH index f6925db..d6a4b76 100755 --- a/h2ph.SH +++ b/h2ph.SH @@ -22,10 +22,11 @@ echo "Extracting h2ph (with variable substitutions)" rm -f h2ph $spitshell >h2ph <-"); - } - else { - ($outfile = $file) =~ s/\.h$/.ph/ || next; - print "$file -> $outfile\n"; - if ($file =~ m|^(.*)/|) { - $dir = $1; - if (!-d "$perlincl/$dir") { - mkdir("$perlincl/$dir",0777); - } - } - open(IN,"$file") || ((warn "Can't open $file: $!\n"),next); - open(OUT,">$perlincl/$outfile") || die "Can't create $outfile: $!\n"; - } - while () { - chop; - while (/\\$/) { - chop; - $_ .= ; - chop; - } - if (s:/\*:\200:g) { - s:\*/:\201:g; - s/\200[^\201]*\201//g; # delete single line comments - if (s/\200.*//) { # begin multi-line comment? - $_ .= '/*'; - $_ .= ; - redo; - } - } - if (s/^#\s*//) { - if (s/^define\s+(\w+)//) { - $name = $1; - $new = ''; - s/\s+$//; - if (s/^\(([\w,\s]*)\)//) { - $args = $1; - if ($args ne '') { - foreach $arg (split(/,\s*/,$args)) { - $arg =~ s/^\s*([^\s].*[^\s])\s*$/$1/; - $curargs{$arg} = 1; - } - $args =~ s/\b(\w)/\$$1/g; - $args = "local($args) = \@_;\n$t "; - } - s/^\s+//; - do expr(); - $new =~ s/(["\\])/\\$1/g; - if ($t ne '') { - $new =~ s/(['\\])/\\$1/g; - print OUT $t, - "eval 'sub $name {\n$t ${args}eval \"$new\";\n$t}';\n"; - } - else { - print OUT "sub $name {\n ${args}eval \"$new\";\n}\n"; - } - %curargs = (); - } - else { - s/^\s+//; - do expr(); - $new = 1 if $new eq ''; - if ($t ne '') { - $new =~ s/(['\\])/\\$1/g; - print OUT $t,"eval 'sub $name {",$new,";}';\n"; - } - else { - print OUT $t,"sub $name {",$new,";}\n"; - } - } - } - elsif (/^include\s+<(.*)>/) { - ($incl = $1) =~ s/\.h$/.ph/; - print OUT $t,"require '$incl';\n"; - } - elsif (/^ifdef\s+(\w+)/) { - print OUT $t,"if (defined &$1) {\n"; - $tab += 4; - $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); - } - elsif (/^ifndef\s+(\w+)/) { - print OUT $t,"if (!defined &$1) {\n"; - $tab += 4; - $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); - } - elsif (s/^if\s+//) { - $new = ''; - do expr(); - print OUT $t,"if ($new) {\n"; - $tab += 4; - $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); - } - elsif (s/^elif\s+//) { - $new = ''; - do expr(); - $tab -= 4; - $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); - print OUT $t,"}\n${t}elsif ($new) {\n"; - $tab += 4; - $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); - } - elsif (/^else/) { - $tab -= 4; - $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); - print OUT $t,"}\n${t}else {\n"; - $tab += 4; - $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); - } - elsif (/^endif/) { - $tab -= 4; - $t = "\t" x ($tab / 8) . ' ' x ($tab % 8); - print OUT $t,"}\n"; - } - } - } - print OUT "1;\n"; -} - -sub expr { - while ($_ ne '') { - s/^(\s+)// && do {$new .= ' '; next;}; - s/^(0x[0-9a-fA-F]+)// && do {$new .= $1; next;}; - s/^(\d+)// && do {$new .= $1; next;}; - s/^("(\\"|[^"])*")// && do {$new .= $1; next;}; - s/^'((\\"|[^"])*)'// && do { - if ($curargs{$1}) { - $new .= "ord('\$$1')"; - } - else { - $new .= "ord('$1')"; - } - next; - }; - s/^sizeof\s*\(([^)]+)\)/{$1}/ && do { - $new .= '$sizeof'; - next; - }; - s/^([_a-zA-Z]\w*)// && do { - $id = $1; - if ($id eq 'struct') { - s/^\s+(\w+)//; - $id .= ' ' . $1; - $isatype{$id} = 1; - } - elsif ($id eq 'unsigned') { - s/^\s+(\w+)//; - $id .= ' ' . $1; - $isatype{$id} = 1; - } - if ($curargs{$id}) { - $new .= '$' . $id; - } - elsif ($id eq 'defined') { - $new .= 'defined'; - } - elsif (/^\(/) { - s/^\((\w),/("$1",/ if $id =~ /^_IO[WR]*$/i; # cheat - $new .= " &$id"; - } - elsif ($isatype{$id}) { - if ($new =~ /{\s*$/) { - $new .= "'$id'"; - } - elsif ($new =~ /\(\s*$/ && /^[\s*]*\)/) { - $new =~ s/\(\s*$//; - s/^[\s*]*\)//; - } - else { - $new .= $id; - } - } - else { - $new .= ' &' . $id; - } - next; - }; - s/^(.)// && do {$new .= $1; next;}; - } -} -############################################################################## - - # These next few lines are legal in both Perl and nroff. - -.00; # finish .ig - -'di \" finish diversion--previous line must be blank -.nr nl 0-1 \" fake up transition to first page again -.nr % 0 \" start at page 1 -'; __END__ ############# From here on it's a standard manual page ############ -.TH H2PH 1 "August 8, 1990" -.AT 3 -.SH NAME -h2ph \- convert .h C header files to .ph Perl header files -.SH SYNOPSIS -.B h2ph [headerfiles] -.SH DESCRIPTION -.I h2ph -converts any C header files specified to the corresponding Perl header file -format. -It is most easily run while in /usr/include: -.nf - - cd /usr/include; h2ph * sys/* - -.fi -If run with no arguments, filters standard input to standard output. -.SH ENVIRONMENT -No environment variables are used. -.SH FILES -/usr/include/*.h -.br -/usr/include/sys/*.h -.br -etc. -.SH AUTHOR -Larry Wall -.SH "SEE ALSO" -perl(1) -.SH DIAGNOSTICS -The usual warnings if it can't read or write the files involved. -.SH BUGS -Doesn't construct the %sizeof array for you. -.PP -It doesn't handle all C constructs, but it does attempt to isolate -definitions inside evals so that you can get at the definitions -that it can translate. -.PP -It's only intended as a rough tool. -You may need to dicker with the files produced. -.ex diff --git a/h2xs b/h2xs new file mode 100755 index 0000000..5baf61d --- /dev/null +++ b/h2xs @@ -0,0 +1,601 @@ +#!/usr/bin/perl +'di '; +'ds 00 \"'; +'ig 00 '; + +use Getopt::Std; + +$usage='h2xs [-Aachfm] [-n module_name] [headerfile [extra_libraries]] + -a Omit AutoLoad facilities from .pm file. + -c Omit the constant() function from the XS file. + -A Equivalent to -a -c + -f Force creation of the extension even if the C header does not exist. + -m Also create an old-style Makefile.SH + -h help + -n Specify a name to use for the extension. +extra_libraries are any libraries that might be needed for loading + the extension, e.g. -lm would try to link in the math library. +'; + +sub usage{ die "Usage: $usage\n" } + +getopts("fhcaAmn:") || &usage; + +&usage if $opt_h; + +if( @ARGV ){ + $path_h = shift; +} +elsif( ! @ARGV && ! $opt_n ){ + die "Must supply header file or module name\n"; +} + +$extralibs = "@ARGV"; +if( $opt_A ){ + $opt_a = $opt_c = 1; +} +$write_makefile_sh = ($opt_m) ? 1 : 0; + +if( $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$/; + $path_h = "/usr/include/$path_h" unless $path_h =~ m#^[./]#; + die "Can't find $path_h\n" if( ! $opt_f && ! -f $path_h ); +} + +$module = $opt_n || do { + $name =~ s/\.h$//; + if( $name !~ /::/ ){ + $name =~ s#^.*/##; + $name = "\u$name"; + } + $name; +}; + +chdir 'ext' if -d 'ext'; + +if( $module =~ /::/ ){ + $nested = 1; + @modparts = split(/::/,$module); + $modfname = $modparts[-1]; + $modpname = join('/',@modparts); +} +else { + $nested = 0; + @modparts = (); + $modfname = $modpname = $module; +} + + +die "Won't overwrite existing ext/$modpname\n" if -e $modpname; +# quick hack, should really loop over @modparts +mkdir($modparts[0], 0777) if $nested; +mkdir($modpname, 0777); +chdir($modpname) || die "Can't chdir ext/$modpname: $!\n"; + +open(XS, ">$modfname.xs") || die "Can't create ext/$modpname/$modfname.xs: $!\n"; +open(PM, ">$modfname.pm") || die "Can't create ext/$modpname/$modfname.pm: $!\n"; + + +if( -r $path_h ){ + open(CH, "<$path_h") || die "Can't open $path_h: $!\n"; + while () { + if (/^#[ \t]*define\s+(\w+)\b\s*[^("]/) { + $_ = $1; + next if /^_.*_h_*$/i; + $names{$_}++; + @AZ = 'A' .. 'Z' if !@AZ && /^[A-Z]/; + @az = 'a' .. 'z' if !@az && /^[a-z]/; + @under = '_' if !@under && /^_/; + } + } + close(CH); + @names = sort keys %names; +} + +$" = "\n\t"; +warn "Writing ext/$modpname/$modfname.pm\n"; + +if( ! $opt_a ){ +print PM <<"END"; +package $module; + +require Exporter; +require AutoLoader; +require DynaLoader; +\@ISA = qw(Exporter AutoLoader DynaLoader); +# Items to export into callers namespace by default +# (move infrequently used names to \@EXPORT_OK below) +\@EXPORT = qw( + @names +); +# Other items we are prepared to export if requested +\@EXPORT_OK = qw( +); + +sub AUTOLOAD { + if (\@_ > 1) { + \$AutoLoader::AUTOLOAD = \$AUTOLOAD; + goto &AutoLoader::AUTOLOAD; + } + local(\$constname); + (\$constname = \$AUTOLOAD) =~ s/.*:://; + \$val = constant(\$constname, \@_ ? \$_[0] : 0); + if (\$! != 0) { + if (\$! =~ /Invalid/) { + \$AutoLoader::AUTOLOAD = \$AUTOLOAD; + goto &AutoLoader::AUTOLOAD; + } + else { + (\$pack,\$file,\$line) = caller; + die "Your vendor has not defined $module macro \$constname, used at \$file line \$line.\n"; + } + } + eval "sub \$AUTOLOAD { \$val }"; + goto &\$AUTOLOAD; +} + +bootstrap $module; + +# Preloaded methods go here. Autoload methods go after __END__, and are +# processed by the autosplit program. + +1; +__END__ +END +} +else{ +print PM <<"END"; +package $module; + +require Exporter; +require DynaLoader; +\@ISA = qw(Exporter DynaLoader); +# Items to export into callers namespace by default +\@EXPORT = qw(); +# Other items we are prepared to export if requested +\@EXPORT_OK = qw(); + + +bootstrap $module; + +1; +END +} + +close PM; + +warn "Writing ext/$modpname/$modfname.xs\n"; +print XS <<"END"; +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +END +if( $path_h ){ + my($h) = $path_h; + $h =~ s#^/usr/include/##; +print XS <<"END"; +#include <$h> + +END +} + +if( ! $opt_c ){ +print XS <<"END"; +static int +not_here(s) +char *s; +{ + croak("$module::%s not implemented on this architecture", s); + return -1; +} + +static double +constant(name, arg) +char *name; +int arg; +{ + errno = 0; + switch (*name) { +END + +foreach $letter (@AZ, @az, @under) { + + last if $letter eq 'a' && !@names; + + print XS " case '$letter':\n"; + my($name); + while (substr($names[0],0,1) eq $letter) { + $name = shift(@names); + print XS <<"END"; + if (strEQ(name, "$name")) +#ifdef $name + return $name; +#else + goto not_there; +#endif +END + } + print XS <<"END"; + break; +END +} +print XS <<"END"; + } + errno = EINVAL; + return 0; + +not_there: + errno = ENOENT; + return 0; +} + + +MODULE = $module PACKAGE = $module + +double +constant(name,arg) + char * name + int arg + +END +} +else{ +print XS <<"END"; + +MODULE = $module PACKAGE = $module + +END +} + +close XS; + +{ +warn "Writing ext/$modpname/Makefile.PL\n"; +open(PL, ">Makefile.PL") || die "Can't create ext/$modpname/Makefile.PL: $!\n"; + +# Ideally this should have a #!../.. ... miniperl etc header +print PL <<'END'; +use ExtUtils::MakeMaker; +# See lib/ExtUtils/MakeMaker.pm for details of how to influence +# the contents of the Makefile being created. +END +print PL "&writeMakefile(\n"; +print PL " 'potential_libs' => '$extralibs', # e.g., '-lm' \n"; +print PL " 'INC' => '', # e.g., '-I/usr/include/other' \n"; +print PL " 'DISTNAME' => 'myname',\n"; +print PL " 'VERSION' => '0.1',\n"; +print PL ");\n"; +} + +if ($write_makefile_sh){ +warn "Writing ext/$modpname/Makefile.SH\n"; +open(MF, ">Makefile.SH") || die "Can't create ext/$modpname/Makefile.SH: $!\n"; +print MF <<'END'; +: This forces SH files to create target in same directory as SH file. +: This is so that make depend always knows where to find SH derivatives. + +case "$0" in +*/*) cd `expr X$0 : 'X\(.*\)/'` ;; +esac + +if test -f config.sh; then TOP=.; +elif test -f ../config.sh; then TOP=..; +elif test -f ../../config.sh; then TOP=../..; +elif test -f ../../../config.sh; then TOP=../../..; +elif test -f ../../../../config.sh; then TOP=../../../..; +else + echo "Can't find config.sh."; exit 1 +fi + +: Find absolute path name for TOP. This is needed when we cd to TOP +: to run perl on autosplit. +oldpwd=`pwd`; cd $TOP; ABSTOP=`pwd`; cd $oldpwd + +case $CONFIG in +'') + . $TOP/config.sh + ;; +esac + +: Find out directory name. This is also the extension name. +ext=`pwd | $sed -e 's@.*/@@'` + +: This extension might have its own typemap +if test -f typemap; then + exttypemap='typemap' +else + exttypemap='' +fi + +: This extension might need additional libraries. +END +print MF "potential_libs=\"$extralibs\"\n"; +print MF <<'END'; +. $TOP/ext/util/extliblist + +: This extension might need bootstrap support +if test -f ${ext}_BS; then + bootdep=${ext}_BS +else + bootdep='' +fi + +case "$dlsrc" in +dl_aix*) + echo "#!" > $ext.exp + echo "boot_$ext" >> $ext.exp + ;; +esac + +echo "Extracting ext/$ext/Makefile (with variable substitutions)" +: This section of the file will have variable substitutions done on it. +: Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!. +: Protect any dollar signs and backticks that you do not want interpreted +: by putting a backslash in front. You may delete these comments. +$spitshell >Makefile << !GROK!THIS! +# +# This Makefile is for the $ext extension to perl. +# +CC = $cc +RANLIB = $ranlib +TOP = $TOP +ABSTOP = $ABSTOP +LDFLAGS = $ldflags +CLDFLAGS = $ldflags +SMALL = $small +LARGE = $large $split + +# To use an alternate make, set \\$altmake in config.sh. +MAKE = ${altmake-make} + +EXT = $ext + +# $ext might have its own typemap +EXTTYPEMAP = $exttypemap + +# $ext might have its own bootstrap support +BOOTDEP = $bootdep +BOOTSTRAP = $ext.bs + +# The following are used to build and install shared libraries for +# dynamic loading. +LDDLFLAGS = $lddlflags +CCDLFLAGS = $ccdlflags +CCCDLFLAGS = $cccdlflags +SO = $so + +# $ext might need to be linked with some extra libraries. +# EXTRALIBS = full list of libraries needed for static linking. +# Only those libraries that actually exist are included. +# DYNLOADLIBS = list of those libraries that are needed but can be +# linked in dynamically on this platform. On SunOS, for +# example, this would be .so* libraries, but not archive +# libraries. The bootstrap file is installed only if +# this list is not empty. +# STATLOADLIBS = list of those libraries which must be statically +# linked into the shared library. On SunOS 4.1.3, +# for example, I have only an archive version of +# -lm, and it must be linked in statically. +EXTRALIBS = $extralibs +DYNALOADLIBS = $dynaloadlibs +STATLOADLIBS = $statloadlibs + +!GROK!THIS! + +$spitshell >>Makefile <<'!NO!SUBS!' + +# Where to put things: +AUTO = $(TOP)/lib/auto +INSTALLBOOT = $(AUTO)/$(EXT)/$(EXT).bs +INSTALLDYNAMIC = $(AUTO)/$(EXT)/$(EXT).$(SO) +INSTALLSTATIC = $(EXT).a +INSTALLPM = $(TOP)/lib/$(EXT).pm + +PERL = $(ABSTOP)/miniperl +XSUBPP = $(TOP)/ext/xsubpp +SHELL = /bin/sh +CCCMD = `sh $(shellflags) $(TOP)/cflags $@` + +.c.o: + $(CCCMD) $(CCCDLFLAGS) -I$(TOP) $*.c + +all: dynamic +# Phony target to force checking subdirectories. +FORCE: + +# Target for Dynamic Loading: +dynamic: $(INSTALLDYNAMIC) $(INSTALLPM) $(INSTALLBOOT) + +$(INSTALLDYNAMIC): $(EXT).o + @test -d $(AUTO) || mkdir $(AUTO) + @test -d $(AUTO)/$(EXT) || mkdir $(AUTO)/$(EXT) + ld $(LDDLFLAGS) -o $@ $(EXT).o $(STATLOADLIBS) + +$(BOOTSTRAP): Makefile $(BOOTDEP) + $(PERL) -I$(TOP)/lib $(TOP)/ext/util/mkbootstrap $(DYNALOADLIBS) + touch $(BOOTSTRAP) + +$(INSTALLBOOT): $(BOOTSTRAP) + @test ! -s $(BOOTSTRAP) || cp $(BOOTSTRAP) $@ + +# Target for Static Loading: +static: $(INSTALLSTATIC) $(INSTALLPM) + +$(INSTALLSTATIC): $(EXT).o + ar cr $@ $(EXT).o + $(RANLIB) $@ + echo $(EXTRALIBS) >> $(TOP)/ext.libs + +$(EXT).c: $(EXT).xs $(XSUBPP) $(TOP)/ext/typemap $(EXTTYPEMAP) $(TOP)/cflags Makefile + $(PERL) $(XSUBPP) $(EXT).xs >tmp + mv tmp $@ + +END +if( ! $opt_a ){ +print MF <<'END'; +$(INSTALLPM): $(EXT).pm + rm -f $@ + cp $(EXT).pm $@ + cd $(TOP); $(PERL) autosplit $(EXT) +END +} +else { +print MF <<'END'; +$(INSTALLPM): $(EXT).pm + cp $(EXT).pm $@ +END +} +print MF <<'END'; + +clean: + rm -f *.o *.a mon.out core $(EXT).c so_locations $(BOOTSTRAP) $(EXT).exp + +realclean: clean + rm -f makefile Makefile + rm -f $(INSTALLPM) $(INSTALLDYNAMIC) $(INSTALLSTATIC) $(INSTALLBOOT) + rm -rf $(AUTO)/$(EXT) + +purge: realclean + +$(EXT).o : $(TOP)/EXTERN.h +$(EXT).o : $(TOP)/perl.h +$(EXT).o : $(TOP)/embed.h +$(EXT).o : $(TOP)/config.h +$(EXT).o : $(TOP)/unixish.h +$(EXT).o : $(TOP)/handy.h +$(EXT).o : $(TOP)/regexp.h +$(EXT).o : $(TOP)/sv.h +$(EXT).o : $(TOP)/util.h +$(EXT).o : $(TOP)/form.h +$(EXT).o : $(TOP)/gv.h +$(EXT).o : $(TOP)/cv.h +$(EXT).o : $(TOP)/opcode.h +$(EXT).o : $(TOP)/op.h +$(EXT).o : $(TOP)/cop.h +$(EXT).o : $(TOP)/av.h +$(EXT).o : $(TOP)/hv.h +$(EXT).o : $(TOP)/mg.h +$(EXT).o : $(TOP)/scope.h +$(EXT).o : $(TOP)/pp.h +$(EXT).o : $(TOP)/proto.h +$(EXT).o : $(TOP)/XSUB.h + +Makefile: Makefile.SH $(TOP)/config.sh ; /bin/sh Makefile.SH +$(TOP)/config.h: $(TOP)/config.sh; cd $(TOP); /bin/sh config_h.SH +$(TOP)/embed.h: $(TOP)/config.sh; cd $(TOP); /bin/sh embed_h.SH +$(TOP)/cflags: $(TOP)/config.sh; cd $(TOP); /bin/sh cflags.SH + +!NO!SUBS! +chmod 755 Makefile +$eunicefix Makefile + +END +close MF; +} + +system '/bin/ls > MANIFEST'; + +# this needs fixing +# system '[ -f Makefile.SH ] && sh Makefile.SH'; +# system '[ -f Makefile.PL ] && perl Makefile.PL'; + + +############################################################################## + + # These next few lines are legal in both Perl and nroff. + +.00 ; # finish .ig + +'di \" finish diversion--previous line must be blank +.nr nl 0-1 \" fake up transition to first page again +.nr % 0 \" start at page 1 +'; __END__ ############# From here on it's a standard manual page ############ +.TH H2XS 1 "August 9, 1994" +.AT 3 +.SH NAME +h2xs \- convert .h C header files to Perl extensions +.SH SYNOPSIS +.B h2xs [-Aachfm] [-n module_name] [headerfile [extra_libraries]] +.SH DESCRIPTION +.I h2xs +builds a Perl extension from any C header file. The extension will include +functions which can be used to retrieve the value of any #define statement +which was in the C header. +.PP +The +.I module_name +will be used for the name of the extension. If module_name is not supplied +then the name of the header file will be used, with the first character +capitalized. +.PP +If the extension might need extra libraries, they should be included +here. The extension Makefile.SH will take care of checking whether +the libraries actually exist and how they should be loaded. +The extra libraries should be specified in the form -lm -lposix, etc, +just as on the cc command line. By default, the Makefile.SH will +search through the library path determined by Configure. That path +can be augmented by including arguments of the form -L/another/library/path +in the extra-libraries argument. +.SH OPTIONS +.TP +.B \-f +Allows an extension to be created for a header even if that +header is not found in /usr/include. +.TP +.B \-a +Omit AutoLoad(), AUTOLOAD, and autosplit from the .pm and Makefile files. +.TP +.B \-c +Omit constant() from the .xs file. +.TP +.B \-n module_name +Specifies a name to be used for the extension. +.TP +.B \-A +Turns on both -a and -c. +.TP +.B \-m +Causes an old-style Makefile.SH to be created. +.SH EXAMPLES +.nf + + # Default behavior, extension is Rusers + h2xs rpcsvc/rusers + + # Same, but extension is RUSERS + h2xs -n RUSERS rpcsvc/rusers + + # Extension is rpcsvc::rusers. Still finds + h2xs rpcsvc::rusers + + # Extension is ONC::RPC. Still finds + h2xs -n ONC::RPC rpcsvc/rusers + + # Without AUTOLOAD, AutoLoad, autosplit + h2xs -a rpcsvc/rusers + + # Creates templates for an extension named RPC + h2xs -Afn RPC + + # Extension is ONC::RPC. + h2xs -An ONC::RPC + + # Makefile.SH will look for library -lrpc in + # additional directory /opt/net/lib + h2xs rpcsvc/rusers -L/opt/net/lib -lrpc + +.fi +.SH ENVIRONMENT +No environment variables are used. +.SH AUTHOR +Larry Wall +.SH "SEE ALSO" +perl(1) +.SH DIAGNOSTICS +The usual warnings if it can't read or write the files involved. +.ex diff --git a/handy.h b/handy.h index a450b4c..160d839 100644 --- a/handy.h +++ b/handy.h @@ -1,29 +1,10 @@ -/* $RCSfile: handy.h,v $$Revision: 4.1 $$Date: 92/08/07 18:21:46 $ +/* handy.h * - * Copyright (c) 1991, Larry Wall + * Copyright (c) 1991-1994, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. * - * $Log: handy.h,v $ - * Revision 4.1 92/08/07 18:21:46 lwall - * - * Revision 4.0.1.4 92/06/08 13:23:17 lwall - * patch20: isascii() may now be supplied by a library routine - * patch20: Perl now distinguishes overlapped copies from non-overlapped - * - * Revision 4.0.1.3 91/11/05 22:54:26 lwall - * patch11: erratum - * - * Revision 4.0.1.2 91/11/05 17:23:38 lwall - * patch11: prepared for ctype implementations that don't define isascii() - * - * Revision 4.0.1.1 91/06/07 11:09:56 lwall - * patch4: new copyright notice - * - * Revision 4.0 91/03/20 01:22:15 lwall - * 4.0 baseline. - * */ #if !defined(__STDC__) @@ -57,23 +38,13 @@ #define TRUE (1) #define FALSE (0) -#ifdef UNICOS -#define I8 char -#define U8 unsigned char -#define I16 short -#define U16 unsigned short -#define I32 int -#define U32 unsigned int - -#else - typedef char I8; typedef unsigned char U8; typedef short I16; typedef unsigned short U16; -#if INTSIZE == 4 +#if BYTEORDER > 0x4321 typedef int I32; typedef unsigned int U32; #else @@ -81,8 +52,6 @@ typedef unsigned short U16; typedef unsigned long U32; #endif -#endif /* UNICOS */ - #define Ctl(ch) (ch & 037) #define strNE(s1,s2) (strcmp(s1,s2)) @@ -100,6 +69,17 @@ typedef unsigned short U16; # endif #endif +#ifdef USE_NEXT_CTYPE +#define isALNUM(c) (NXIsAlpha((unsigned int)c) || NXIsDigit((unsigned int)c) || c == '_') +#define isIDFIRST(c) (NXIsAlpha((unsigned int)c) || c == '_') +#define isALPHA(c) NXIsAlpha((unsigned int)c) +#define isSPACE(c) NXIsSpace((unsigned int)c) +#define isDIGIT(c) NXIsDigit((unsigned int)c) +#define isUPPER(c) NXIsUpper((unsigned int)c) +#define isLOWER(c) NXIsLower((unsigned int)c) +#define toUPPER(c) NXToUpper((unsigned int)c) +#define toLOWER(c) NXToLower((unsigned int)c) +#else /* USE_NEXT_CTYPE */ #if defined(CTYPE256) || (!defined(isascii) && !defined(HAS_ISASCII)) #define isALNUM(c) (isalpha((unsigned char)(c)) || isdigit((unsigned char)(c)) || c == '_') #define isIDFIRST(c) (isalpha((unsigned char)(c)) || (c) == '_') @@ -108,6 +88,8 @@ typedef unsigned short U16; #define isDIGIT(c) isdigit((unsigned char)(c)) #define isUPPER(c) isupper((unsigned char)(c)) #define isLOWER(c) islower((unsigned char)(c)) +#define toUPPER(c) toupper((unsigned char)(c)) +#define toLOWER(c) tolower((unsigned char)(c)) #else #define isALNUM(c) (isascii(c) && (isalpha(c) || isdigit(c) || c == '_')) #define isIDFIRST(c) (isascii(c) && (isalpha(c) || (c) == '_')) @@ -116,7 +98,10 @@ typedef unsigned short U16; #define isDIGIT(c) (isascii(c) && isdigit(c)) #define isUPPER(c) (isascii(c) && isupper(c)) #define isLOWER(c) (isascii(c) && islower(c)) +#define toUPPER(c) toupper(c) +#define toLOWER(c) tolower(c) #endif +#endif /* USE_NEXT_CTYPE */ /* Line numbers are unsigned, 16 bits. */ typedef U16 line_t; @@ -129,9 +114,9 @@ typedef U16 line_t; #ifndef lint #ifndef LEAKTEST #ifndef safemalloc -char *safemalloc(); -char *saferealloc(); -void safefree(); +char *safemalloc _((MEM_SIZE)); +char *saferealloc _((char *, MEM_SIZE)); +void safefree _((char *)); #endif #ifndef MSDOS #define New(x,v,n,t) (v = (t*)safemalloc((MEM_SIZE)((n) * sizeof(t)))) diff --git a/hints/3b2.sh b/hints/3b2.sh deleted file mode 100644 index 5b67dab..0000000 --- a/hints/3b2.sh +++ /dev/null @@ -1 +0,0 @@ -optimize='-g' diff --git a/hints/README.hints b/hints/README.hints new file mode 100644 index 0000000..84503ce --- /dev/null +++ b/hints/README.hints @@ -0,0 +1,57 @@ +These files are used by Configure to set things which Configure either +can't or doesn't guess properly. Most of these hints files are from +perl4. They may or may not work with perl5, but they are probably a +good starting point. + +The following hints files have been tested with at least some version +of perl5 and are probably reasonably close to being correct: + +aix.sh +bsd386.sh +dec_osf.sh +dgux.sh +esix4.sh +freebsd.sh +hpux_9.sh +irix_4.sh +irix_5.sh +isc.sh +linux.sh +netbsd.sh +next_3_2.sh +sco_3.sh +solaris_2.sh +sunos_4_1.sh +svr4.sh +titanos.sh +ultrix_4.sh +unicos.sh +utekv.sh + +The following hints files have not been tested with perl5: + +3b1.sh +altos486.sh +apollo.sh +aux.sh +dnix.sh +dynix.sh +fps.sh +genix.sh +greenhills.sh +i386.sh +isc_2.sh +mips.sh +mpc.sh +ncr_tower.sh +opus.sh +sco_2_3_0.sh +sco_2_3_1.sh +sco_2_3_2.sh +sco_2_3_3.sh +sco_2_3_4.sh +stellar.sh +sunos_4_0.sh +ti1500.sh +unisysdynix.sh +uts.sh diff --git a/hints/aix.sh b/hints/aix.sh new file mode 100644 index 0000000..81d2a0c --- /dev/null +++ b/hints/aix.sh @@ -0,0 +1,20 @@ +d_fchmod=undef +d_setrgid='undef' +d_setruid='undef' +alignbytes=8 + +# Changes for dynamic linking by Wayne Scott (wscott@ichips.intel.com) +# +# Tell perl which symbols to export for dynamic linking. +ccdlflags='-bE:perl.exp' + +# The first 3 options would not be needed if dynamic libs. could be linked +# with the compiler instead of ld. +# -bI:$(TOP)/perl.exp Read the exported symbols from the perl binary +# -bE:$(EXT).exp Export these symbols. This file contains only one +# symbol: boot_$(EXP) can it be auto-generated? +lddlflags='-H512 -T512 -bhalt:4 -bM:SRE -bI:$(TOP)/perl.exp -bE:$(EXT).exp -e _nostart -lc' + +ccflags='-D_ALL_SOURCE' +# Make setsockopt work correctly. See man page. +# ccflags='-D_BSD=44' diff --git a/hints/aix_rs.sh b/hints/aix_rs.sh deleted file mode 100644 index b2bbb9b..0000000 --- a/hints/aix_rs.sh +++ /dev/null @@ -1,10 +0,0 @@ -d_setregid='undef' -d_setreuid='undef' -d_setrgid='undef' -d_setruid='undef' -d_setegid='undef' -d_seteuid='undef' -memalignbytes=8 -ccflags="$ccflags -D_NO_PROTO" -cppstdin='/lib/cpp -D_AIX -D_IBMR2 -U__STR__' -cppminus='' diff --git a/hints/aix_rt.sh b/hints/aix_rt.sh deleted file mode 100644 index 83bb7a1..0000000 --- a/hints/aix_rt.sh +++ /dev/null @@ -1 +0,0 @@ -ccflags="$ccflags -a -DCRIPPLED_CC" diff --git a/hints/apollo.sh b/hints/apollo.sh new file mode 100644 index 0000000..dd06084 --- /dev/null +++ b/hints/apollo.sh @@ -0,0 +1,20 @@ +optimize='' +ccflags='-A cpu,mathchip -W0,-opt,2' + +cat <<'EOF' +Some tests may fail unless you use 'chacl -B'. Also, op/stat +test 2 may fail occasionally because Apollo doesn't guarantee +that mtime will be equal to ctime on a newly created unmodified +file. Finally, the sleep test will sometimes fail. See the +sleep(3) man page to learn why. + +And a note on ccflags: + + Lastly, while -A cpu,mathchip generates optimal code for your DN3500 + running sr10.3, be aware that you should be using -A cpu,mathlib_sr10 + if your perl must also run on any machines running sr10.0, sr10.1, or + sr10.2. The -A cpu,mathchip option generates code that doesn't work on + pre-sr10.3 nodes. See the cc(1) man page for more details. + -- Steve Vinoski + +EOF diff --git a/hints/apollo_C6_7.sh b/hints/apollo_C6_7.sh deleted file mode 100644 index fd9f44e..0000000 --- a/hints/apollo_C6_7.sh +++ /dev/null @@ -1,4 +0,0 @@ -optimize='-opt 2' -cflags='-A nansi cpu,mathchip -O -U__STDC__' -echo "Some tests may fail unless you use 'chacl -B'. Also, op/stat" -echo "test 2 may fail because Apollo doesn't support mtime or ctime." diff --git a/hints/apollo_C6_8.sh b/hints/apollo_C6_8.sh deleted file mode 100644 index 06fe7d7..0000000 --- a/hints/apollo_C6_8.sh +++ /dev/null @@ -1,20 +0,0 @@ -optimize='' -ccflags='-DDEBUGGING -A cpu,mathchip -W0,-opt,2' - -cat <<'EOF' -Some tests may fail unless you use 'chacl -B'. Also, op/stat -test 2 may fail occasionally because Apollo doesn't guarantee -that mtime will be equal to ctime on a newly created unmodified -file. Finally, the sleep test will sometimes fail. See the -sleep(3) man page to learn why. - -And a note on ccflags: - - Lastly, while -A cpu,mathchip generates optimal code for your DN3500 - running sr10.3, be aware that you should be using -A cpu,mathlib_sr10 - if your perl must also run on any machines running sr10.0, sr10.1, or - sr10.2. The -A cpu,mathchip option generates code that doesn't work on - pre-sr10.3 nodes. See the cc(1) man page for more details. - -- Steve Vinoski - -EOF diff --git a/hints/aux.sh b/hints/aux.sh index 0f46f3e..b64f3fd 100644 --- a/hints/aux.sh +++ b/hints/aux.sh @@ -1,2 +1,3 @@ optimize='-O' ccflags="$ccflags -B/usr/lib/big/ -DPARAM_NEEDS_TYPES" +POSIX_cflags='ccflags="$ccflags -ZP -Du_long=U32"' diff --git a/hints/bsd386.sh b/hints/bsd386.sh new file mode 100644 index 0000000..8303a18 --- /dev/null +++ b/hints/bsd386.sh @@ -0,0 +1,34 @@ +# hints file for BSD/386 1.x +# Original by Neil Bowers +# Tue Oct 4 12:01:34 EDT 1994 +# +# filename extension for shared libraries +so='o' + +d_voidsig='define' +sig_name='ZERO HUP INT QUIT ILL TRAP IOT EMT FPE KILL BUS SEGV SYS PIPE ALRM TERM URG STOP TSTP CONT CHLD TTIN TTOU IO XCPU XFSZ VTALRM PROF WINCH INFO USR1 USR2 ' +signal_t='void' + +# we don't want to use -lnm, since exp() is busted in there (in 1.1 anyway) +set `echo X "$libswanted "| sed -e 's/ nm / /'` +shift +libswanted="$*" + +# Avoid telldir prototype conflict in pp_sys.c (BSD/386 uses const DIR *) +pp_sys_cflags='ccflags="$ccflags -DHAS_TELLDIR_PROTOTYPE"' + +# Avoid problems with HUGE_VAL in POSIX in 1.0's cc. +# Use gcc2 (2.5.8) if available in 1.1. +case "$osvers" in +1.0*) + POSIX_cflags='ccflags="$ccflags -UHUGE_VAL"' + ;; +1.1*) + case "$cc" in + '') cc=gcc2 ;; + esac + ;; +esac + +# BSD/386 has an older header file. +DB_File_cflags='ccflags="$ccflags -DDBXS_HASH_TYPE=int -DDBXS_PREFIX_TYPE=int"' diff --git a/hints/cray.sh b/hints/cray.sh deleted file mode 100644 index 2ce9566..0000000 --- a/hints/cray.sh +++ /dev/null @@ -1,8 +0,0 @@ -case `uname -r` in -6.1*) shellflags="-m+65536" ;; -esac -ccflags="$ccflags -DUNICOS -h nomessage=118:151:172" -usemymalloc='n' -libswanted='malloc m' -d_setregid='undef' -d_setreuid='undef' diff --git a/hints/dec_osf.sh b/hints/dec_osf.sh new file mode 100644 index 0000000..1f9d71f --- /dev/null +++ b/hints/dec_osf.sh @@ -0,0 +1,9 @@ +# hints/dec_osf.sh +optimize="-g" +ccflags="$ccflags -DSTANDARD_C -DDEBUGGING" +# Version 1 has problems with -no_archive if only an archive +# lib is available. +case "$osvers" in +1*) lddlflags='-shared -expect_unresolved "*" -s' ;; +*) lddlflags='-shared -no_archive -expect_unresolved "*" -s' ;; +esac diff --git a/hints/dec_osf1.sh b/hints/dec_osf1.sh deleted file mode 100644 index 07f594e..0000000 --- a/hints/dec_osf1.sh +++ /dev/null @@ -1,11 +0,0 @@ -d_crypt='undef' # The function is there, but it is empty -d_odbm='undef' # We don't need both odbm and ndbm -gidtype='gid_t' -groupstype='int' -libpth="$libpth /usr/shlib" # Use the shared libraries if possible -libc='/usr/shlib/libc.so' # The archive version is /lib/libc.a -case `uname -m` in - mips|alpha) optimize="$optimize -O2 -Olimit 2900" - ccflags="$ccflags -std1 -D_BSD" ;; - *) ccflags="$ccflags -D_BSD" ;; -esac diff --git a/hints/dec_osf_2_0.sh b/hints/dec_osf_2_0.sh deleted file mode 100644 index 207e565..0000000 --- a/hints/dec_osf_2_0.sh +++ /dev/null @@ -1,13 +0,0 @@ -# hints/dec_osf_2_0.sh -d_odbm='undef' # We don't need both odbm and ndbm -gidtype='gid_t' -groupstype='gid_t' -d_voidshmat='define' -clocktype='time_t' -libpth="$libpth /usr/shlib" # Use the shared libraries if possible -libc='/usr/shlib/libc.so' # The archive version is /lib/libc.a -case `uname -m` in - mips|alpha) optimize="$optimize -g" - ccflags="$ccflags -D_BSD -DSTANDARD_C -DDEBUGGING" ;; - *) ccflags="$ccflags -D_BSD -DSTANDARD_C -DDEBUGGING" ;; -esac diff --git a/hints/dgux.sh b/hints/dgux.sh index d0d1154..733570b 100644 --- a/hints/dgux.sh +++ b/hints/dgux.sh @@ -1,7 +1,26 @@ -cppstdin='/lib/cpp' +# +# hints file for Data General DG/UX +# these hints tweaked for perl5 on an AViiON mc88100, running DG/UX 5.4R2.01 +# + gidtype='gid_t' groupstype='gid_t' -libs='-ldgc' +libswanted="dgc $libswanted" uidtype='uid_t' d_index='define' +ccflags='-D_POSIX_SOURCE -D_DGUX_SOURCE' + +# this hasn't been tried with dynamic loading at all +usedl='false' + +# +# an ugly hack, since the Configure test for "gcc -P -" hangs. +# can't just use 'cppstdin', since our DG has a broken cppstdin :-( +# +cppstdin=`cd ..; pwd`/cppstdin +cpprun=`cd ..; pwd`/cppstdin + +# +# you don't want to use /usr/ucb/cc +# cc='gcc' diff --git a/hints/dynix.sh b/hints/dynix.sh index dca74b4..51eae90 100644 --- a/hints/dynix.sh +++ b/hints/dynix.sh @@ -1,2 +1,2 @@ d_castneg=undef -libswanted=`echo $libswanted | sed -e 's/socket /socket seq inet /'` +libswanted=`echo $libswanted | sed -e 's/socket /socket seq /'` diff --git a/hints/esix4.sh b/hints/esix4.sh new file mode 100644 index 0000000..6d8f266 --- /dev/null +++ b/hints/esix4.sh @@ -0,0 +1,39 @@ +# hints/esix4.sh +# Original esix4 hint file courtesy of +# Kevin O'Gorman ( kevin@kosman.UUCP, kevin%kosman.uucp@nrc.com ) +# +# Use Configure -Dcc=gcc to use gcc. +case "$cc" in +'') cc='/bin/cc' + test -f $cc || cc='/usr/ccs/bin/cc' + cccdlflags='-Kpic' + ;; +esac +ldflags='-L/usr/ccs/lib -L/usr/ucblib' +test -d /usr/local/man || mansrc='none' +ccflags='-I/usr/include -I/usr/ucbinclude' +libswanted=`echo " $libswanted " | sed -e 's/ malloc / /' ` +d_index='undef' +d_suidsafe=define +lddlflags="-G $ldflags" +usevfork='false' +if test "$osvers" = "3.0"; then + d_gconvert='undef' + grep 'define[ ]*AF_OSI[ ]' /usr/include/sys/socket.h | grep '/\*[^*]*$' >/tmp/esix$$ + if test -s /tmp/esix$$; then + cat < +# Date: Thu, 28 Jul 1994 19:17:05 -0500 (CDT) +# +# Additional 1.1.5 defines from +# Ollivier Robert +# Date: Wed, 28 Sep 1994 00:37:46 +0100 (MET) +# +case "$osvers" in +0.*|1.0*) + usedl="$undef" + ;; +*) d_dlopen="$define" + cccdlflags='-DPIC -fpic' + lddlflags='-Bshareable' + malloctype='void *' + groupstype='int' + d_setregid='undef' + d_setreuid='undef' + d_setrgid='undef' + d_setruid='undef' + i_unistd='undef' + ;; +esac +# Avoid telldir prototype conflict in pp_sys.c (FreeBSD uses const DIR *) +pp_sys_cflags='ccflags="$ccflags -DHAS_TELLDIR_PROTOTYPE"' +# FreeBSD has an older header file. +DB_File_cflags='ccflags="$ccflags -DDBXS_HASH_TYPE=int -DDBXS_PREFIX_TYPE=int"' diff --git a/hints/hp9000_300.sh b/hints/hp9000_300.sh deleted file mode 100644 index 956bf08..0000000 --- a/hints/hp9000_300.sh +++ /dev/null @@ -1,2 +0,0 @@ -optimize='+O1' -ccflags="$ccflags -Wc,-Nw500" diff --git a/hints/hp9000_400.sh b/hints/hp9000_400.sh deleted file mode 100644 index 956bf08..0000000 --- a/hints/hp9000_400.sh +++ /dev/null @@ -1,2 +0,0 @@ -optimize='+O1' -ccflags="$ccflags -Wc,-Nw500" diff --git a/hints/hp9000_700.sh b/hints/hp9000_700.sh deleted file mode 100644 index eee8a4e..0000000 --- a/hints/hp9000_700.sh +++ /dev/null @@ -1,5 +0,0 @@ -libswanted='ndbm m' -ccflags="$ccflags -Aa -D_POSIX_SOURCE -D_HPUX_SOURCE -DJMPCLOBBER" -optimize='+O1' -d_mymalloc=define -memalignbytes=8 diff --git a/hints/hp9000_800.sh b/hints/hp9000_800.sh deleted file mode 100644 index e1ab9d7..0000000 --- a/hints/hp9000_800.sh +++ /dev/null @@ -1,3 +0,0 @@ -libswanted=`echo $libswanted | sed -e 's/malloc //' -e 's/BSD //` -eval_cflags='optimize=+O1' -teval_cflags=$eval_cflags diff --git a/hints/hpux.sh b/hints/hpux.sh deleted file mode 100644 index 904f9de..0000000 --- a/hints/hpux.sh +++ /dev/null @@ -1,8 +0,0 @@ -echo " " -echo "NOTE: regression test op.read may fail due to an NFS bug in HP/UX." -echo "If so, don't worry about it." -case `(uname -r) 2>/dev/null` in -*3.1*) d_syscall=$undef ;; -*2.1*) libswanted=`echo $libswanted | sed 's/ malloc / /'` ;; -esac -d_index=define diff --git a/hints/hpux_9.sh b/hints/hpux_9.sh new file mode 100644 index 0000000..8d2556a --- /dev/null +++ b/hints/hpux_9.sh @@ -0,0 +1,9 @@ +libswanted='ndbm m dld' +ccflags="$ccflags -Aa -D_POSIX_SOURCE -D_HPUX_SOURCE" +# ldflags="-Wl,-E -Wl,-a,shared" # Force all shared? +ldflags="-Wl,-E" +optimize='+O1' +usemymalloc='y' +alignbytes=8 +selecttype='int *' +POSIX_cflags='ccflags="$ccflags -DFLT_MIN=1.17549435E-38"' diff --git a/hints/irix_4.sh b/hints/irix_4.sh new file mode 100644 index 0000000..57a9031 --- /dev/null +++ b/hints/irix_4.sh @@ -0,0 +1,6 @@ +optimize='-O1' +usemymalloc='y' +d_voidsig=define +usevfork=false +d_charsprf=undef +ccflags="-ansiposix -signed" diff --git a/hints/irix_5.sh b/hints/irix_5.sh new file mode 100644 index 0000000..dcbcfba --- /dev/null +++ b/hints/irix_5.sh @@ -0,0 +1,10 @@ +# irix_5.sh +i_time='define' +ccflags="$ccflags -D_POSIX_SOURCE -ansiposix -D_BSD_TYPES -Olimit 3000" +lddlflags="-shared" +case "$usedl" in +'') usedl='y' ;; +esac +set `echo X "$libswanted "|sed -e 's/ socket / /' -e 's/ nsl / /' -e 's/ dl / /'` +shift +libswanted="$*" diff --git a/hints/isc.sh b/hints/isc.sh new file mode 100644 index 0000000..7c18380 --- /dev/null +++ b/hints/isc.sh @@ -0,0 +1,21 @@ +# isc.sh +# Interactive Unix Versions 3 and 4. +# Compile perl entirely in posix mode. +# Andy Dougherty doughera@lafcol.lafayette.edu +# Wed Oct 5 15:57:37 EDT 1994 +# +# Use Configure -Dcc=gcc to use gcc +# +set `echo X "$libswanted "| sed -e 's/ c / /'` +shift +libswanted="$*" +case "$cc" in +*gcc*) ccflags="$ccflags -posix" + ldflags="$ldflags -posix" + ;; +*) ccflags="$ccflags -Xp -D_POSIX_SOURCE" + ldflags="$ldflags -Xp" + ;; +esac +# Pick up dbm.h in +ccflags="$ccflags -I/usr/include/rpcsvc" diff --git a/hints/isc_2.sh b/hints/isc_2.sh new file mode 100644 index 0000000..95b61ba --- /dev/null +++ b/hints/isc_2.sh @@ -0,0 +1,24 @@ +# isc_2.sh +# Interactive Unix Version 2.2 +# Compile perl entirely in posix mode. +# Andy Dougherty doughera@lafcol.lafayette.edu +# Wed Oct 5 15:57:37 EDT 1994 +# +# Use Configure -Dcc=gcc to use gcc +# +set `echo X "$libswanted "| sed -e 's/ c / /'` +shift +libswanted="$*" +case "$cc" in +*gcc*) ccflags="$ccflags -posix" + ldflags="$ldflags -posix" + ;; +*) ccflags="$ccflags -Xp -D_POSIX_SOURCE" + ldflags="$ldflags -Xp" + ;; +esac +# Pick up dbm.h in +ccflags="$ccflags -I/usr/include/rpcsvc" +# Compensate for conflicts in +doio_cflags='ccflags="$ccflags -DENOTSOCK=103"' +pp_sys_cflags='ccflags="$ccflags -DENOTSOCK=103"' diff --git a/hints/isc_3_2_2.sh b/hints/isc_3_2_2.sh deleted file mode 100644 index 0736d3d..0000000 --- a/hints/isc_3_2_2.sh +++ /dev/null @@ -1,7 +0,0 @@ -set `echo $libswanted | sed -e 's/ x / /' -e 's/ PW / /'` -libswanted="$*" -doio_cflags='ccflags="$ccflags -DENOTSOCK=103"' -tdoio_cflags='ccflags="$ccflags -DENOTSOCK=103"' -echo " defines error numbers for network calls, but" -echo "the definitions for ENAMETOOLONG and ENOTEMPTY conflict with" -echo "those in . Instead just define ENOTSOCK here." diff --git a/hints/isc_3_2_3.sh b/hints/isc_3_2_3.sh deleted file mode 100644 index 5b99353..0000000 --- a/hints/isc_3_2_3.sh +++ /dev/null @@ -1,3 +0,0 @@ -set `echo "$libswanted" | sed -e 's/ PW / /' -e 's/ x / /'` -libswanted="$*" -ccflags="$ccflags -DCRIPPLED_CC -DDEBUGGING" diff --git a/hints/linux.sh b/hints/linux.sh new file mode 100644 index 0000000..7617a88 --- /dev/null +++ b/hints/linux.sh @@ -0,0 +1,32 @@ +# Configuration time: Mon May 16 03:41:24 EDT 1994 +# Original version by rsanders +# Additional dlext support by Kenneth Albanowski +# Target system: linux hrothgar 1.1.12 #9 sat may 14 02:03:23 edt 1994 i486 +bin='/usr/bin' +ccflags='-I/usr/include/bsd' +cppflags=' -I/usr/include/bsd' +d_dosuid='define' +d_voidsig='define' +gidtype='gid_t' +groupstype='gid_t' +malloctype='void *' +nm_opt='' +optimize='-O2' +sig_name='ZERO HUP INT QUIT ILL TRAP IOT UNUSED FPE KILL USR1 SEGV USR2 PIPE ALRM TERM STKFLT CHLD CONT STOP TSTP TTIN TTOU IO XCPU XFSZ VTALRM PROF WINCH' +signal_t='void' +uidtype='uid_t' +usemymalloc='n' +yacc='bison -y' +lddlflags='-r' +so='sa' +dlext='o' +## If you are using DLD 3.2.4 which does not support shared libs, +## uncomment the next two lines: +#ldflags="-static" +#so='none' + +cat </dev/null` -case "$tmp" in -OSF1*) - case "$tmp" in - *mips) - d_volatile=define - ;; - *) - cat < +# To use gcc, do Configure -Dcc=gcc +# +# Try to use libintl.a since it has strcoll and strxfrm +libswanted="intl $libswanted" +# Try to use libdbm.nfs.a since it has dbmclose. +# +if test -f /usr/lib/libdbm.nfs.a ; then + libswanted=`echo "dbm.nfs $libswanted " | sed -e 's/ dbm / /'` +fi +set X $libswanted +shift +libswanted="$*" +# +# We don't want Xenix cross-development libraries +glibpth=`echo $glibpth | sed -e 's! /usr/lib/386 ! !' -e 's! /lib/386 ! !'` +xlibpth='' +# +case "$cc" in +gcc) + ccflags="$ccflags -U M_XENIX" + optimize="$optimize -O2" + ;; +*) + ccflags="$ccflags -W0 -U M_XENIX" + ;; +esac i_varargs=undef -d_rename='undef' +nm_opt='-p' diff --git a/hints/sgi.sh b/hints/sgi.sh deleted file mode 100644 index 4252aaf..0000000 --- a/hints/sgi.sh +++ /dev/null @@ -1,12 +0,0 @@ -optimize='-O1' -d_mymalloc=define -mallocsrc='malloc.c' -mallocobj='malloc.o' -d_voidsig=define -d_vfork=undef -d_charsprf=undef -case `(uname -r) 2>/dev/null` in -4*)libswanted=`echo $libswanted | sed 's/c_s \(.*\)/\1 c_s/'` - ccflags="$ccflags -DLANGUAGE_C -DBSD_SIGNALS -cckr -signed" - ;; -esac diff --git a/hints/solaris_2.sh b/hints/solaris_2.sh new file mode 100644 index 0000000..081213a --- /dev/null +++ b/hints/solaris_2.sh @@ -0,0 +1,33 @@ +usevfork=false +d_suidsafe=define +ccflags="$ccflags" +set `echo $glibpth | sed -e 's@/usr/ucblib@@'` +glibpth="$*" +set `echo " $libswanted " | sed -e 's@ ld @ @' -e 's@ ucb @ @'` +libswanted="$*" + +# Look for architecture name. We want to suggest a useful default +# for archlib and also warn about possible -x486 flags needed. +case "$archname" in +'') + if test -f /usr/bin/arch; then + archname=`/usr/bin/arch` + archname="${archname}-${osname}" + elif test -f /usr/ucb/arch; then + archname=`/usr/ucb/arch` + archname="${archname}-${osname}" + fi + ;; +esac +case "$archname" in +*86*) echo "For an Intel platform you might need to add -x486 to ccflags" >&4;; +*) ;; +esac + +case $PATH in +*/usr/ucb*:/usr/bin:*) cat </dev/null +then # bsd + groupstype='int' +else # sys5 + groupstype='gid_t' +fi +# we don't set gidtype because unistd.h says gid_t getgid() but man +# page says int getgid() for bsd. utils.c includes unistd.h :-( + diff --git a/hints/sunos_4_1_2.sh b/hints/sunos_4_1_2.sh deleted file mode 100644 index 9439388..0000000 --- a/hints/sunos_4_1_2.sh +++ /dev/null @@ -1 +0,0 @@ -groupstype='int' diff --git a/hints/sunos_4_1_3.sh b/hints/sunos_4_1_3.sh deleted file mode 100644 index 9439388..0000000 --- a/hints/sunos_4_1_3.sh +++ /dev/null @@ -1 +0,0 @@ -groupstype='int' diff --git a/hints/svr4.sh b/hints/svr4.sh index eae477e..c707eb8 100644 --- a/hints/svr4.sh +++ b/hints/svr4.sh @@ -1,6 +1,33 @@ -cc='/bin/cc' -test -f $cc || cc='/usr/ccs/bin/cc' -ldflags='-L/usr/ucblib' -mansrc='/usr/share/man/man1' +# svr4 hints, System V Release 4.x +# Use Configure -Dcc=gcc to use gcc. +case "$cc" in +'') cc='/bin/cc' + test -f $cc || cc='/usr/ccs/bin/cc' + cccdlflags='-Kpic' # Probably needed for dynamic loading + ;; +esac +test -d /usr/local/man || mansrc='none' +# We include support for using libraries in /usr/ucblib, but the setting +# 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='-L/usr/ccs/lib -L/usr/ucblib' ccflags='-I/usr/include -I/usr/ucbinclude' -libswanted=`echo $libswanted | sed 's/ ucb/ c ucb/'` +libswanted=`echo $libswanted | tr ' ' '\012' | egrep -v '^(malloc|ucb)$'` +# -lucb: Defines setreuid() and other routines Perl wants but they don't +# add any/much functionality and often won't ld properly. +# -lmalloc: Anyone know what problems this caused? +if [ "" = "$i_ndbm" -a ! -f /usr/ucblib/libndbm.a ]; then +# UnixWare 1.1 may install /usr/ucbinclude/ndbm.h w/o /usr/ucblib/libndbm.a + i_ndbm="$undef" # so Configure tries to build ext/NDBM_File and ld +fi # can't find dbm_open()! "./Configure -D i_ndbm=define" overrides. +d_index='undef' +d_suidsafe=define # "./Configure -d" can't figure this out +lddlflags="-G $ldflags" # Probably needed for dynamic loading +usevfork='false' +# dlopen routines exist but they don't work with perl. +# The case statement allows experimenters to override hint with +# Configure -D usedl +case "$usedl" in +'') usedl="$undef" ;; +esac diff --git a/hints/ti1500.sh b/hints/ti1500.sh index 3d89250..69482d8 100644 --- a/hints/ti1500.sh +++ b/hints/ti1500.sh @@ -1 +1 @@ -d_mymalloc='undef' +usemymalloc='n' diff --git a/hints/titan.sh b/hints/titan.sh deleted file mode 100644 index 1801e82..0000000 --- a/hints/titan.sh +++ /dev/null @@ -1,40 +0,0 @@ -# Hints file (perl 4.019) for Kubota Pacific's Titan 3000 Series Machines. -# Created by: JT McDuffie (jt@kpc.com) 26 DEC 1991 -bin='/usr/local/bin' -installbin='/usr/local/bin' -memalignbytes="8" -byteorder="4321" -cppstdin='/lib/cpp' -cppminus='' -castflags='0' -gid_type='ushort' -groupstype='unsigned short' -intsize='4' -libc='/lib/libc.a' -nm_opts='-eh' -mallocptrtype='void' -mansrc='/usr/man/man1' -installmansrc='/usr/man/man1' -manext='1' -models='none' -optimize='-O' -ccflags="$ccflags -I/usr/include/net -DDEBUGGING" -cppflags="$cppflags -I/usr/include/net -DDEBUGGING" -cc='cc' -libs='-lnsl -ldbm -lPW -lmalloc -lm' -libswanted='net socket nsl nm ndir ndbm dbm PW malloc m x posix ' -scriptdir='/usr/local/bin' -installscr='/usr/local/bin' -stdchar='unsigned char' -uidtype='ushort' -usrinclude='/usr/include' -voidhave='7' -w_localtim='1' -w_s_timevl='1' -w_s_tm='1' -privlib='/usr/local/lib/perl' -installprivlib='/usr/local/lib/perl' -inclwanted='/usr/include /usr/include/net ' -libpth=' /usr/lib /usr/local/lib /lib' -eoPATH='/bin /usr/bin /usr/ucb /usr/local /usr/local/bin /usr/lbin /etc /usr/lib /lib /usr/local/lib ' -pth=' . /bin /usr/bin /usr/ucb /usr/local/bin /usr/X11/bin /usr/lbin /etc /usr/lib /lib /usr/local/lib ' diff --git a/hints/titanos.sh b/hints/titanos.sh new file mode 100644 index 0000000..b327037 --- /dev/null +++ b/hints/titanos.sh @@ -0,0 +1,24 @@ +# Hints file (perl 4.019) for Kubota Pacific's Titan 3000 Series Machines. +# Created by: JT McDuffie (jt@kpc.com) 26 DEC 1991 +# p5ed by: Jarkko Hietaniemi Aug 27 1994 +# NOTE: You should run Configure with tcsh (yes, tcsh). +alignbytes="8" +byteorder="4321" +castflags='0' +gidtype='ushort' +groupstype='unsigned short' +intsize='4' +usenm='true' +nm_opt='-eh' +malloctype='void *' +models='none' +ccflags="$ccflags -I/usr/include/net -DDEBUGGING -DSTANDARD_C" +cppflags="$cppflags -I/usr/include/net -DDEBUGGING -DSTANDARD_C" +libs='-lnsl -ldbm -lPW -lmalloc -lm' +stdchar='unsigned char' +static_ext='DynaLoader NDBM_File Socket' +uidtype='ushort' +voidflags='7' +inclwanted='/usr/include /usr/include/net' +libpth='/usr/lib /usr/local/lib /lib' +pth='. /bin /usr/bin /usr/ucb /usr/local/bin /usr/X11/bin /usr/lbin /etc /usr/lib' diff --git a/hints/ultrix_1.sh b/hints/ultrix_1.sh deleted file mode 100644 index 7569e48..0000000 --- a/hints/ultrix_1.sh +++ /dev/null @@ -1 +0,0 @@ -ccflags="$ccflags -DULTRIX_STDIO_BOTCH" diff --git a/hints/ultrix_3.sh b/hints/ultrix_3.sh deleted file mode 100644 index 0df4723..0000000 --- a/hints/ultrix_3.sh +++ /dev/null @@ -1,14 +0,0 @@ -ccflags="$ccflags -DLANGUAGE_C" -tmp="`(uname -a) 2>/dev/null`" -case "$tmp" in -*3.[01]*RISC) d_waitpid=$undef;; -'') d_waitpid=$undef;; -esac -case "$tmp" in -*RISC) - cmd_cflags='optimize="-g"' - perl_cflags='optimize="-g"' - tcmd_cflags='optimize="-g"' - tperl_cflags='optimize="-g"' - ;; -esac diff --git a/hints/ultrix_4.sh b/hints/ultrix_4.sh index 633e904..c7a8c2c 100644 --- a/hints/ultrix_4.sh +++ b/hints/ultrix_4.sh @@ -1,4 +1,4 @@ -ccflags="$ccflags -DLANGUAGE_C -Olimit 2900" +optimize=-g tmp=`(uname -a) 2>/dev/null` case "$tmp" in *RISC*) cat < 4 Oct. 1994 -# The -DUTekV is needed because the greenhills compiler does not have any -# UTekV specific definitions and we need one in perl.h -ccflags="$ccflags -X18 -DJMPCLOBBER -DUTekV" +# The -X18 is only if you are using the Greenhills compiler. +ccflags="$ccflags -X18" usemymalloc='y' # /usr/include/rpcsvc is for finding dbm.h inclwanted="$inclwanted /usr/include/rpcsvc" -# dont use the wrapper, use the real thing. -cppstdin=/lib/cpp - echo " " echo "NOTE: You may have to take out makefile dependencies on the files in" echo "/usr/include (i.e. /usr/include/ctype.h) or the make will fail. A" diff --git a/hints/vax.sh b/hints/vax.sh deleted file mode 100644 index ea8f224..0000000 --- a/hints/vax.sh +++ /dev/null @@ -1 +0,0 @@ -teval_cflags='case $cc in *gcc);; *) optimize="-O";; esac' diff --git a/hv.c b/hv.c index 3e0bed2..7ae2340 100644 --- a/hv.c +++ b/hv.c @@ -1,35 +1,21 @@ -/* $RCSfile: hash.c,v $$Revision: 4.1 $$Date: 92/08/07 18:21:48 $ +/* hv.c * - * Copyright (c) 1991, Larry Wall + * Copyright (c) 1991-1994, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. * - * $Log: hash.c,v $ - * Revision 4.1 92/08/07 18:21:48 lwall - * - * Revision 4.0.1.3 92/06/08 13:26:29 lwall - * patch20: removed implicit int declarations on functions - * patch20: delete could cause %array to give too low a count of buckets filled - * patch20: hash tables now split only if the memory is available to do so - * - * Revision 4.0.1.2 91/11/05 17:24:13 lwall - * patch11: saberized perl - * - * Revision 4.0.1.1 91/06/07 11:10:11 lwall - * patch4: new copyright notice - * - * Revision 4.0 91/03/20 01:22:26 lwall - * 4.0 baseline. - * + */ + +/* + * "I sit beside the fire and think of all that I have seen." --Bilbo */ #include "EXTERN.h" #include "perl.h" -static void hsplit(); - -static void hfreeentries(); +static void hsplit _((HV *hv)); +static void hfreeentries _((HV *hv)); SV** hv_fetch(hv,key,klen,lval) @@ -52,10 +38,6 @@ I32 lval; if (mg_find((SV*)hv,'P')) { sv = sv_newmortal(); mg_copy((SV*)hv, sv, key, klen); - if (!lval) { - mg_get(sv); - sv_unmagic(sv,'p'); - } Sv = sv; return &Sv; } @@ -63,7 +45,11 @@ I32 lval; xhv = (XPVHV*)SvANY(hv); if (!xhv->xhv_array) { - if (lval) + if (lval +#ifdef DYNAMIC_ENV_FETCH /* if it's an %ENV lookup, we may get it on the fly */ + || (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) +#endif + ) Newz(503,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char); else return 0; @@ -75,7 +61,7 @@ I32 lval; while (i--) hash = hash * 33 + *s++; - entry = ((HE**)xhv->xhv_array)[hash & xhv->xhv_max]; + entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; for (; entry; entry = entry->hent_next) { if (entry->hent_hash != hash) /* strings can't be equal */ continue; @@ -85,6 +71,17 @@ I32 lval; continue; return &entry->hent_val; } +#ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */ + if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) { + char *gotenv; + + gotenv = my_getenv(key); + if (gotenv != NULL) { + sv = newSVpv(gotenv,strlen(gotenv)); + return hv_store(hv,key,klen,sv,hash); + } + } +#endif if (lval) { /* gonna assign to this, so it better be there */ sv = NEWSV(61,0); return hv_store(hv,key,klen,sv,hash); @@ -112,8 +109,14 @@ register U32 hash; xhv = (XPVHV*)SvANY(hv); if (SvMAGICAL(hv)) { mg_copy((SV*)hv, val, key, klen); +#ifndef OVERLOAD if (!xhv->xhv_array) return 0; +#else + if (!xhv->xhv_array && (SvMAGIC(hv)->mg_type != 'A' + || SvMAGIC(hv)->mg_moremagic)) + return 0; +#endif /* OVERLOAD */ } if (!hash) { i = klen; @@ -125,7 +128,7 @@ register U32 hash; if (!xhv->xhv_array) Newz(505, xhv->xhv_array, sizeof(HE**) * (xhv->xhv_max + 1), char); - oentry = &((HE**)xhv->xhv_array)[hash & xhv->xhv_max]; + oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; i = 1; for (entry = *oentry; entry; i=0, entry = entry->hent_next) { @@ -142,7 +145,7 @@ register U32 hash; New(501,entry, 1, HE); entry->hent_klen = klen; - entry->hent_key = nsavestr(key,klen); + entry->hent_key = savepvn(key,klen); entry->hent_val = val; entry->hent_hash = hash; entry->hent_next = *oentry; @@ -177,6 +180,10 @@ U32 klen; if (SvRMAGICAL(hv)) { sv = *hv_fetch(hv, key, klen, TRUE); mg_clear(sv); + if (mg_find(sv, 'p')) { + sv_unmagic(sv, 'p'); /* No longer an element */ + return sv; + } } xhv = (XPVHV*)SvANY(hv); if (!xhv->xhv_array) @@ -187,7 +194,7 @@ U32 klen; while (i--) hash = hash * 33 + *s++; - oentry = &((HE**)xhv->xhv_array)[hash & xhv->xhv_max]; + oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; entry = *oentry; i = 1; for (; entry; i=0, oentry = &entry->hent_next, entry = *oentry) { @@ -201,19 +208,70 @@ U32 klen; if (i && !*oentry) xhv->xhv_fill--; sv = sv_mortalcopy(entry->hent_val); - he_free(entry); + if (entry == xhv->xhv_eiter) + entry->hent_klen = -1; + else + he_free(entry); --xhv->xhv_keys; return sv; } return Nullsv; } +bool +hv_exists(hv,key,klen) +HV *hv; +char *key; +U32 klen; +{ + register XPVHV* xhv; + register char *s; + register I32 i; + register I32 hash; + register HE *entry; + SV *sv; + + if (!hv) + return 0; + + if (SvRMAGICAL(hv)) { + if (mg_find((SV*)hv,'P')) { + sv = sv_newmortal(); + mg_copy((SV*)hv, sv, key, klen); + magic_existspack(sv, mg_find(sv, 'p')); + return SvTRUE(sv); + } + } + + xhv = (XPVHV*)SvANY(hv); + if (!xhv->xhv_array) + return 0; + + i = klen; + hash = 0; + s = key; + while (i--) + hash = hash * 33 + *s++; + + entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; + for (; entry; entry = entry->hent_next) { + if (entry->hent_hash != hash) /* strings can't be equal */ + continue; + if (entry->hent_klen != klen) + continue; + if (bcmp(entry->hent_key,key,klen)) /* is this it? */ + continue; + return TRUE; + } + return FALSE; +} + static void hsplit(hv) HV *hv; { register XPVHV* xhv = (XPVHV*)SvANY(hv); - I32 oldsize = xhv->xhv_max + 1; + I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */ register I32 newsize = oldsize * 2; register I32 i; register HE **a; @@ -256,9 +314,8 @@ newHV() register HV *hv; register XPVHV* xhv; - Newz(502,hv, 1, HV); - SvREFCNT(hv) = 1; - sv_upgrade(hv, SVt_PVHV); + hv = (HV*)NEWSV(502,0); + sv_upgrade((SV *)hv, SVt_PVHV); xhv = (XPVHV*)SvANY(hv); SvPOK_off(hv); SvNOK_off(hv); @@ -301,32 +358,46 @@ HV *hv; xhv = (XPVHV*)SvANY(hv); hfreeentries(hv); xhv->xhv_fill = 0; + xhv->xhv_keys = 0; if (xhv->xhv_array) (void)memzero(xhv->xhv_array, (xhv->xhv_max + 1) * sizeof(HE*)); + + if (SvRMAGICAL(hv)) + mg_clear((SV*)hv); } static void hfreeentries(hv) HV *hv; { - register XPVHV* xhv; + register HE **array; register HE *hent; register HE *ohent = Null(HE*); + I32 riter; + I32 max; if (!hv) return; - xhv = (XPVHV*)SvANY(hv); - if (!xhv->xhv_array) + if (!HvARRAY(hv)) return; - (void)hv_iterinit(hv); - /*SUPPRESS 560*/ - while (hent = hv_iternext(hv)) { /* concise but not very efficient */ - he_free(ohent); - ohent = hent; + + riter = 0; + max = HvMAX(hv); + array = HvARRAY(hv); + hent = array[0]; + for (;;) { + if (hent) { + ohent = hent; + hent = hent->hent_next; + he_free(ohent); + } + if (!hent) { + if (++riter > max) + break; + hent = array[riter]; + } } - he_free(ohent); - if (SvMAGIC(hv)) - mg_clear((SV*)hv); + (void)hv_iterinit(hv); } void @@ -346,7 +417,10 @@ HV *hv; xhv->xhv_array = 0; xhv->xhv_max = 7; /* it's a normal associative array */ xhv->xhv_fill = 0; - (void)hv_iterinit(hv); /* so each() will start off right */ + xhv->xhv_keys = 0; + + if (SvRMAGICAL(hv)) + mg_clear((SV*)hv); } I32 @@ -354,6 +428,9 @@ hv_iterinit(hv) HV *hv; { register XPVHV* xhv = (XPVHV*)SvANY(hv); + HE *entry = xhv->xhv_eiter; + if (entry && entry->hent_klen < 0) /* was deleted earlier? */ + he_free(entry); xhv->xhv_riter = -1; xhv->xhv_eiter = Null(HE*); return xhv->xhv_fill; @@ -365,25 +442,28 @@ HV *hv; { register XPVHV* xhv; register HE *entry; + HE *oldentry; MAGIC* mg; if (!hv) croak("Bad associative array"); xhv = (XPVHV*)SvANY(hv); - entry = xhv->xhv_eiter; + oldentry = entry = xhv->xhv_eiter; if (SvRMAGICAL(hv) && (mg = mg_find((SV*)hv,'P'))) { SV *key = sv_newmortal(); - if (entry) - sv_setpvn(key, entry->hent_key, entry->hent_klen); - else { - Newz(504,entry, 1, HE); - xhv->xhv_eiter = entry; - } - magic_nextpack(hv,mg,key); + if (entry) { + sv_usepvn(key, entry->hent_key, entry->hent_klen); + entry->hent_key = 0; + } + else { + Newz(504,entry, 1, HE); + xhv->xhv_eiter = entry; + } + magic_nextpack((SV*) hv,mg,key); if (SvOK(key)) { STRLEN len; - entry->hent_key = SvPV(key, len); + entry->hent_key = SvPV_force(key, len); entry->hent_klen = len; SvPOK_off(key); SvPVX(key) = 0; @@ -402,7 +482,7 @@ HV *hv; if (entry) entry = entry->hent_next; if (!entry) { - xhv->xhv_riter++; + ++xhv->xhv_riter; if (xhv->xhv_riter > xhv->xhv_max) { xhv->xhv_riter = -1; break; @@ -411,6 +491,9 @@ HV *hv; } } while (!entry); + if (oldentry && oldentry->hent_klen < 0) /* was deleted earlier? */ + he_free(oldentry); + xhv->xhv_eiter = entry; return entry; } @@ -433,19 +516,30 @@ register HE *entry; if (mg_find((SV*)hv,'P')) { SV* sv = sv_newmortal(); mg_copy((SV*)hv, sv, entry->hent_key, entry->hent_klen); - mg_get(sv); - sv_unmagic(sv,'p'); return sv; } } return entry->hent_val; } +SV * +hv_iternextsv(hv, key, retlen) + HV *hv; + char **key; + I32 *retlen; +{ + HE *he; + if ( (he = hv_iternext(hv)) == NULL) + return NULL; + *key = hv_iterkey(he, retlen); + return hv_iterval(hv, he); +} + void hv_magic(hv, gv, how) HV* hv; GV* gv; -I32 how; +int how; { - sv_magic((SV*)hv, (SV*)gv, how, 0, 0); + sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0); } diff --git a/hv.h b/hv.h index adb00c1..4970363 100644 --- a/hv.h +++ b/hv.h @@ -1,22 +1,10 @@ -/* $RCSfile: hash.h,v $$Revision: 4.1 $$Date: 92/08/07 18:21:52 $ +/* hv.h * - * Copyright (c) 1991, Larry Wall + * Copyright (c) 1991-1994, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. * - * $Log: hash.h,v $ - * Revision 4.1 92/08/07 18:21:52 lwall - * - * Revision 4.0.1.2 91/11/05 17:24:31 lwall - * patch11: random cleanup - * - * Revision 4.0.1.1 91/06/07 11:10:33 lwall - * patch4: new copyright notice - * - * Revision 4.0 91/03/20 01:22:38 lwall - * 4.0 baseline. - * */ typedef struct he HE; @@ -33,7 +21,7 @@ struct xpvhv { char * xhv_array; /* pointer to malloced string */ STRLEN xhv_fill; /* how full xhv_array currently is */ STRLEN xhv_max; /* subscript of last element of xhv_array */ - STRLEN xhv_keys; /* how many elements in the array */ + I32 xhv_keys; /* how many elements in the array */ double xnv_nv; /* numeric value, if any */ MAGIC* xmg_magic; /* magic for scalar array */ HV* xmg_stash; /* class package */ @@ -53,3 +41,20 @@ struct xpvhv { #define HvEITER(hv) ((XPVHV*) SvANY(hv))->xhv_eiter #define HvPMROOT(hv) ((XPVHV*) SvANY(hv))->xhv_pmroot #define HvNAME(hv) ((XPVHV*) SvANY(hv))->xhv_name + +#ifdef OVERLOAD + +/* Maybe amagical: */ +/* #define HV_AMAGICmb(hv) (SvFLAGS(hv) & (SVpgv_badAM | SVpgv_AM)) */ + +#define HV_AMAGIC(hv) (SvFLAGS(hv) & SVpgv_AM) +#define HV_AMAGIC_on(hv) (SvFLAGS(hv) |= SVpgv_AM) +#define HV_AMAGIC_off(hv) (SvFLAGS(hv) &= ~SVpgv_AM) + +/* +#define HV_AMAGICbad(hv) (SvFLAGS(hv) & SVpgv_badAM) +#define HV_badAMAGIC_on(hv) (SvFLAGS(hv) |= SVpgv_badAM) +#define HV_badAMAGIC_off(hv) (SvFLAGS(hv) &= ~SVpgv_badAM) +*/ + +#endif /* OVERLOAD */ diff --git a/hvdbm.h b/hvdbm.h deleted file mode 100644 index f81492b..0000000 --- a/hvdbm.h +++ /dev/null @@ -1,58 +0,0 @@ -#define DBM_CACHE_MAX 63 /* cache 64 entries for dbm file */ - /* (resident array acts as a write-thru cache)*/ -#ifdef WANT_DBZ -# include -# define SOME_DBM -# define dbm_fetch(db,dkey) fetch(dkey) -# define dbm_delete(db,dkey) croak("dbz doesn't implement delete") -# define dbm_store(db,dkey,dcontent,flags) store(dkey,dcontent) -# define dbm_close(db) dbmclose() -# define dbm_firstkey(db) (croak("dbz doesn't implement traversal"),fetch()) -# define nextkey() (croak("dbz doesn't implement traversal"),fetch()) -# define dbm_nextkey(db) (croak("dbz doesn't implement traversal"),fetch()) -# ifdef I_NDBM -# undef I_NDBM -# endif -# ifndef I_DBM -# define I_DBM -# endif -#else -# ifdef HAS_GDBM -# ifdef I_GDBM -# include -# endif -# define SOME_DBM -# ifdef I_NDBM -# undef I_NDBM -# endif -# ifdef I_DBM -# undef I_DBM -# endif -# else -# ifdef I_NDBM -# include -# define SOME_DBM -# ifdef I_DBM -# undef I_DBM -# endif -# else -# ifdef I_DBM -# ifdef NULL -# undef NULL /* suppress redefinition message */ -# endif -# include -# ifdef NULL -# undef NULL -# endif -# define NULL 0 /* silly thing is, we don't even use this... */ -# define SOME_DBM -# define dbm_fetch(db,dkey) fetch(dkey) -# define dbm_delete(db,dkey) delete(dkey) -# define dbm_store(db,dkey,dcontent,flags) store(dkey,dcontent) -# define dbm_close(db) dbmclose() -# define dbm_firstkey(db) firstkey() -# endif /* I_DBM */ -# endif /* I_NDBM */ -# endif /* HAS_GDBM */ -#endif /* WANT_DBZ */ - diff --git a/installperl b/installperl index e4e0e44..4fc1452 100755 --- a/installperl +++ b/installperl @@ -1,4 +1,7 @@ #!./perl +BEGIN { @INC=('./lib', '../lib') } + +use File::Find; $mainperldir = "/usr/bin"; @@ -10,8 +13,8 @@ while (@ARGV) { umask 022; -@scripts = ('cppstdin', 'h2ph', 'c2ph', 'pstruct', 'x2p/s2p', 'x2p/find2perl'); -@manpages = ('perl.man', 'h2ph.man', 'x2p/a2p.man', 'x2p/s2p.man'); +@scripts = ('cppstdin', 'c2ph', 'pstruct', 'x2p/s2p', 'x2p/find2perl'); +@manpages = (, 'x2p/a2p.man', 'x2p/s2p.man'); # Read in the config file. @@ -86,40 +89,31 @@ if ($bdev != $ddev || $bino != $dino) { &chmod(0755, "$installbin/a2p"); } -# Make some enemies in the name of standardization. :-) - -($udev,$uino) = stat($mainperldir); - -if (-w _ && ($udev != $bdev || $uino != $bino) && !$nonono) { - &unlink("$mainperldir/perl"); - eval 'link("$installbin/perl", "$mainperldir/perl")' || - eval 'symlink("$installbin/perl", "$mainperldir/perl")' || - &cmd("cp $installbin/perl $mainperldir"); -} - # Install scripts. -&makedir($installscr); +&makedir($installscript); for (@scripts) { - &cmd("cp $_ $installscr"); - s#.*/##; &chmod(0755, "$installscr/$_"); + if (-f $_) { # cppstdin might not exist on this system. + &cmd("cp $_ $installscript"); + s#.*/##; &chmod(0755, "$installscript/$_"); + } } # Install man pages. -if ($mansrc ne '') { - &makedir($mansrc); +if ($installmansrc ne '') { + &makedir($installmansrc); - ($mdev,$mino) = stat($mansrc); + ($mdev,$mino) = stat($installmansrc); if ($mdev != $ddev || $mino != $dino) { for (@manpages) { ($new = $_) =~ s/man$/$manext/; $new =~ s#.*/##; - print STDERR " Installing $mansrc/$new\n"; + print STDERR " Installing $installmansrc/$new\n"; next if $nonono; open(MI,$_) || warn "Can't open $_: $!\n"; - open(MO,">$mansrc/$new") || warn "Can't install $mansrc/$new: $!\n"; + open(MO,">$installmansrc/$new") || warn "Can't install $installmansrc/$new: $!\n"; print MO ".ds RP Release $release Patchlevel $patchlevel\n"; while () { print MO; @@ -132,33 +126,21 @@ if ($mansrc ne '') { # Install library files. +$do_installarchlib = $do_installprivlib = 0; + &makedir($installprivlib); +&makedir($installarchlib); if (chdir "lib") { + ($pdev,$pino) = stat($installarchlib); + ($ldev,$lino) = stat('.'); + $do_installarchlib = ($pdev != $ldev || $pino != $lino); ($pdev,$pino) = stat($installprivlib); ($ldev,$lino) = stat('.'); + $do_installprivlib = ($pdev != $ldev || $pino != $lino); - if ($pdev != $ldev || $pino != $lino) { - # Optimize for quick access. First the auto directory. - system "tar cf - auto | (cd $installprivlib; tar xvf -)"; - # Next the Perl modules. - foreach $file (<*.pm>) { - system "cmp", "-s", $file, "$privlib/$file"; - if ($?) { - &unlink("$installprivlib/$file"); - &cmd("cp $file $installprivlib"); - &chmod(0644, "$installprivlib/$file"); - } - } - # Finally the old library files. - foreach $file (<*.pl>) { - system "cmp", "-s", $file, "$privlib/$file"; - if ($?) { - &unlink("$installprivlib/$file"); - &cmd("cp $file $installprivlib"); - &chmod(0644, "$installprivlib/$file"); - } - } + if ($do_installarchlib || $do_installprivlib) { + find(\&installlib, '.'); } chdir ".." || die "Can't cd back to source directory: $!\n"; } @@ -166,12 +148,82 @@ else { warn "Can't cd to lib to install lib files: $!\n"; } +# Offer to install perl in a "standard" location + +($udev,$uino) = stat($mainperldir); + +$mainperl_is_instperl = 0; + +if (-w _ && ($udev != $bdev || $uino != $bino) && !$nonono) { + # First make sure $mainperldir/perl is not already the same as + # the perl we just installed + if (-x "$mainperldir/perl") { + # Use stat so we detect symbolic links transparently + ($mpdev, $mpino) = stat("$mainperldir/perl"); + ($ipdev, $ipino) = stat("$installbin/perl"); + # Try to be clever about mainperl being a symbolic link + # to binexp/perl if binexp and installbin are different. + $mainperl_is_instperl = + (($mpdev == $ipdev && $mpino == $ipino) || + (($binexp ne $installbin) && + (-l "$mainperldir/perl") && + ((readlink "$mainperldir/perl") eq "$binexp/perl"))); + } + if ((! $mainperl_is_instperl) && + (&yn("Many scripts expect perl to be installed as " . + "$mainperldir/perl.\n" . + "Do you wish to have $mainperldir/perl be the same as\n" . + "$binexp/perl? [y] "))) + { + unlink("$mainperldir/perl"); + eval 'link("$installbin/perl", "$mainperldir/perl")' || + eval 'symlink("$binexp/perl", "$mainperldir/perl")' || + &cmd("cp $installbin/perl $mainperldir"); + $mainperl_is_instperl = 1; + } +} + +# Check to make sure there aren't other perls around in installer's +# path. This is probably UNIX-specific. Check all absolute directories +# in the path except for where public executables are supposed to live. +# Also skip $mainperl if the user opted to have it be a link to the +# installed perl. + +@path = split(/:/, $ENV{"PATH"}); +@otherperls = (); +for (@path) { + next unless m,^/,; + next if ($_ eq $binexp); + # Use &samepath here because some systems have other dirs linked + # to $mainperldir (like SunOS) + next if ($mainperl_is_instperl && &samepath($_, $mainperldir)); + push(@otherperls, "$_/perl") if (-x "$_/perl" && ! -d "$_/perl"); +} +if (@otherperls) { + print STDERR "\nWarning: perl appears in your path in the following " . + "locations beyond where\nwe just installed it:\n"; + for (@otherperls) { + print STDERR " ", $_, "\n"; + } + print STDERR "\n"; +} + print STDERR " Installation complete\n"; exit 0; ############################################################################### +sub yn { + local($prompt) = @_; + local($answer); + local($default) = $prompt =~ m/\[([yn])\]\s*$/i; + print STDERR $prompt; + chop($answer = ); + $answer = $default if $answer =~ m/^\s*$/; + ($answer =~ m/^[yY]/); +} + sub unlink { local(@names) = @_; @@ -218,3 +270,46 @@ sub makedir { mkdir($dir, 0777) || warn "Couldn't create $dir: $!\n" unless $nonono; } } + +sub samepath { + local($p1, $p2) = @_; + local($dev1, $ino1, $dev2, $ino2); + + if ($p1 ne p2) { + ($dev1, $ino1) = stat($p1); + ($dev2, $ino2) = stat($p2); + ($dev1 == $dev2 && $ino1 == $ino2); + } + else { + 1; + } +} + +sub installlib { + my $dir = $File::Find::dir; + $dir =~ s#^\.(?![^/])/?##; + + my $name = $_; + $name = "$dir/$name" if $dir ne ''; + + my $installlib = $installprivlib; + if ((substr($dir, 0, 4) eq 'auto') || ($name eq 'Config.pm')) { + $installlib = $installarchlib; + return unless $do_installarchlib; + } else { + return unless $do_installprivlib; + } + + &makedir("$installlib/$dir"); + + if (-f $_) { + system "cmp", "-s", $_, "$installlib/$name"; + if ($?) { + &unlink("$installlib/$name"); + &cmd("cp $_ $installlib/$dir"); + &chmod(0644, "$installlib/$name"); + } + } elsif (-d $_) { + &makedir("$installlib/$name"); + } +} diff --git a/internals b/internals deleted file mode 100644 index fbf686e..0000000 --- a/internals +++ /dev/null @@ -1,321 +0,0 @@ -Newsgroups: comp.lang.perl -Subject: Re: perl5a4: tie ref restriction? -Summary: -Expires: -References: <2h7b64$aai@jethro.Corp.Sun.COM> -Sender: -Followup-To: -Distribution: world -Organization: NetLabs, Inc. -Keywords: - -In article <2h7b64$aai@jethro.Corp.Sun.COM> Eric.Arnold@Sun.COM writes: -: Darn: -: tie ( @a, TST_tie, "arg1", "arg2" ); -: $a[2]=[1]; -: -: produces: -: -: Can't assign a reference to a magical variable at ./tsttie line 12. -: -: I'm all agog about the "tie" function, but ... if this restriction -: wasn't there, I think I would be able to tie a top level -: reference/variable to my own package, and then automatically tie in all -: subsequently linked vars/references so that I could "tie" any arbitrary thing -: like: -: $r->{key}[el]{key} -: -: to a DBM or other type storage area. -: -: Is the restriction necessary? - -In the current storage scheme, yes, but as I mentioned in the other -article, I can and probably should relax that. That code is some of -the oldest Perl 5 code, and I didn't see some things then that I do -now. - -[I did relax that.] - -Ok, let me explain some things about how values are stored. Consider -this a little design document. - -Internally everything is unified to look like a scalar, regardless of -its type. There's a type-invariant part of every value, and a -type-variant part. When we modify the type of a value, we can do it in -place because all references point to the invariant part. All we do is -swap the variant part for a different part and change that ANY pointer -in the invariant part to point to the new variant. - -The invariant part looks like this: - -struct sv { - void* sv_any; /* pointer to something */ - U32 sv_refcnt; /* how many references to us */ - SVTYPE sv_type; /* what sort of thing pointer points to */ - U8 sv_flags; /* extra flags, some depending on type */ - U8 sv_storage; /* storage class */ - U8 sv_private; /* extra value, depending on type */ -}; - -[The last 4 bytes have been combined into a single U32.] - -This is typedefed to SV. There are other structurally equivalent -types, AV, HV and CV, that are there merely to help gdb know what kind -of pointer sv_any is, and provide a little bit of C type-checking. -Here's a key to Perl naming: - - SV scalar value - AV array value - HV hash value - CV code value - -Additionally I often use names containing - - IV integer value - NV numeric value (double) - PV pointer value - RV reference value - LV lvalue, such as a substr() or vec() being assigned to - BM a string containing a Boyer-Moore compiled pattern - FM a format line program - -You'll notice that in SV there's an sv_type field. This contains one -of the following values, which gives the interpretation of sv_any. - -typedef enum { - SVt_NULL, - SVt_REF, - SVt_IV, - SVt_NV, - SVt_PV, - SVt_PVIV, - SVt_PVNV, - SVt_PVMG, - SVt_PVLV, - SVt_PVAV, - SVt_PVHV, - SVt_PVCV, - SVt_PVGV, - SVt_PVBM, - SVt_PVFM, -} svtype; - -[There is no longer a REF type. There's an RV type that holds a minimal ref -value but other types can also hold an RV. This was to allow magical refs.] - -These are arranged ROUGHLY in order of increasing complexity, though -there are some discontinuities. Many of them indicate that sv_any -points to a struct of a similar name with an X on the front. They can -be classified like this: - - SVt_NULL - The sv_any doesn't point to anything meaningful. - - SVt_REF - The sv_any points to another SV. (This is what we're talking - about changing to work more like IV and NV below.) [And that's what - I did.] - - SVt_IV - SVt_NV - These are a little tricky in order to be efficient in both - memory and time. The sv_any pointer indicates the location of - a solitary integer(double), but not directly. The pointer is - really a pointer to an XPVIV(XPVNV), so that if there's a valid - integer(double) the same code works regardless of the type of - the SV. They have special allocators that guarantee that, even - though sv_any is pointing to a location several words earlier - than the integer(double), it never points to unallocated - memory. This does waste a few allocated integers(doubles) at - the beginning, but it's probably an overall win. - - [SVt_RV probably belongs here.] - SVt_PV - SVt_PVIV - SVt_PVNV - SVt_PVMG - These are pretty ordinary, and each is "derived" from the - previous in the sense that it just adds more data to the - previous structure. -[ Need to add this: - struct xrv { - SV * xrv_rv; /* pointer to another SV */ - }; - - A reference value. In the following structs its space is reserved - as a char* xpv_pv, but if SvROK() is true, xpv_pv is pointing to - another SV, not a string. -] - - struct xpv { - char * xpv_pv; /* pointer to malloced string */ - STRLEN xpv_cur; /* length of xpv_pv as a C string */ - STRLEN xpv_len; /* allocated size */ - }; - - This is your basic string scalar that is never used numerically - or magically. - - struct xpviv { - char * xpv_pv; /* pointer to malloced string */ - STRLEN xpv_cur; /* length of xpv_pv as a C string */ - STRLEN xpv_len; /* allocated size */ - I32 xiv_iv; /* integer value or pv offset */ - }; - - This is a string scalar that has either been used as an - integer, or an integer that has been used in a string - context, or has had the front trimmed off of it, in which - case xiv_iv contains how far xpv_pv has been incremented - from the original allocated value. - - struct xpvnv { - char * xpv_pv; /* pointer to malloced string */ - STRLEN xpv_cur; /* length of xpv_pv as a C string */ - STRLEN xpv_len; /* allocated size */ - I32 xiv_iv; /* integer value or pv offset */ - double xnv_nv; /* numeric value, if any */ - }; - - This is a string or integer scalar that has been used in a - numeric context, or a number that has been used in a string - or integer context. - - struct xpvmg { - char * xpv_pv; /* pointer to malloced string */ - STRLEN xpv_cur; /* length of xpv_pv as a C string */ - STRLEN xpv_len; /* allocated size */ - I32 xiv_iv; /* integer value or pv offset */ - double xnv_nv; /* numeric value, if any */ - MAGIC* xmg_magic; /* linked list of magicalness */ - HV* xmg_stash; /* class package */ - }; - - This is the top of the line for ordinary scalars. This scalar - has been charmed with one or more kinds of magical or object - behavior. In addition it can contain any or all of integer, - double or string. - - SVt_PVLV - SVt_PVAV - SVt_PVHV - SVt_PVCV - SVt_PVGV - SVt_PVBM - SVt_PVFM - These are specialized forms that are never directly visible to - the Perl script. They are independent of each other, and may - not be promoted to any other type. - [Actually, PVBM doesn't belong here, but in the previous section. - saying index($foo,$bar) will in fact turn $bar into a PVBM so that - it can do Boyer-Moore searching.] - -There are several additional data values in the SV structure. The sv_refcnt -gives the number of references to this SV. Some of these references may be -actual Perl language references, but many other are just internal pointers, -from a symbol table, or from the syntax tree, for example. When sv_refcnt -goes to zero, the value can be safely deallocated. Must be, in fact. - -The sv_storage byte is not very well thought out, but tends to indicate -something about where the scalar lives. It's used in allocating -lexical storage, and at runtime contains an 'O' if the value has been -blessed as an object. There may be some conflicts lurking in here, and -I may eventually claim some of the bits for other purposes. [I did, -with a vengeance.] - -The sv_flags are currently as follows. Most of these are set and cleared -by macros to guarantee their consistency, and you should always use the -proper macro rather than accessing them directly. - -[Most of these numbers have changed, and there are some new flags. -And they're all stuffed into a single U32.] - -#define SVf_IOK 1 /* has valid integer value */ -#define SVf_NOK 2 /* has valid numeric value */ -#define SVf_POK 4 /* has valid pointer value */ - These tell whether an integer, double or string value is - immediately available without further consideration. All tainting - and magic (but not objecthood) works by turning off these bits and - forcing a routine to be executed to discover the real value. The - SvIV(), SvNV() and SvPV() macros that fetch values are smart about - all this, and should always be used if possible. Most of the stuff - mentioned below you really don't have to deal with directly. (Values - aren't stored using macros, but using functions sv_setiv(), sv_setnv() - and sv_setpv(), plus variants. You should never have to explicitly - follow the sv_any pointer to any X structure in your code.) - -#define SVf_OOK 8 /* has valid offset value */ - This is only on when SVf_IOK is off, and indicates that the unused - integer storage is holding an offset for the string pointer value - because you've done something like s/^prefix//. - -#define SVf_MAGICAL 16 /* has special methods */ - This indicates not only that sv_type is at least SVt_PVMG, but - also that the linked list of magical behaviors is not empty. - -#define SVf_OK 32 /* has defined value */ - This indicates that the value is defined. Currently it means either - that the type if SVt_REF or that one of SVf_IOK, SVf_NOK, or SVf_POK - is set. - -#define SVf_TEMP 64 /* eventually in sv_private? */ - This indicates that the string is a temporary allocated by one of - the sv_mortal functions, and that any string value may be stolen - from it without copying. (It's important not to steal the value if - the temporary will continue to require the value, however.) - -#define SVf_READONLY 128 /* may not be modified */ - This scalar value may not be modified. Any function that might modify - a scalar should check for this first, and reject the operation when - inappropriate. Currently only the builtin values for sv_undef, sv_yes - and sv_no are marked readonly, but eventually we may provide a language - to set this bit. - -The sv_private byte contains some additional bits that apply across the -board. Really private bits (that depend on the type) are allocated from -128 down. - -#define SVp_IOK 1 /* has valid non-public integer value */ -#define SVp_NOK 2 /* has valid non-public numeric value */ -#define SVp_POK 4 /* has valid non-public pointer value */ - These shadow the bits in sv_flags for tainted variables, indicated that - there really is a valid value available, but you have to set the global - tainted flag if you acces them. - -#define SVp_SCREAM 8 /* has been studied? */ - Indicates that a study was done on this string. A studied string is - magical and automatically unstudies itself when modified. - -#define SVp_TAINTEDDIR 16 /* PATH component is a security risk */ - A special flag for $ENV{PATH} that indicates that, while the value - as a whole may be untainted, some path component names an insecure - directory. - -#define SVpfm_COMPILED 128 - For a format, whether its picture has been "compiled" yet. This - cannot be done until runtime because the user has access to the - internal formline function, and may supply a variable as the - picture. - -#define SVpbm_VALID 128 -#define SVpbm_CASEFOLD 64 -#define SVpbm_TAIL 32 - For a Boyer-Moore pattern, whether the search string has been invalidated - by modification (can happen to $pat between calls to index($string,$pat)), - whether case folding is in force for regexp matching, and whether we're - trying to match something like /foo$/. - -#define SVpgv_MULTI 128 - For a symbol table entry, set when we've decided that this symbol is - probably not a typo. Suspected typos can be reported by -w. - - -Well, that's probably enough for now. As you can see, we could turn -references into something more like an integer or a pointer value. In -fact, I suspect the right thing to do is say that a reference is just -a funny type of string pointer that isn't allocated the same way. -This would let us not only have references to scalars, but might provide -a way to have scalars that point to non-malloced memory. Hmm. I'll -have to think about that s'more. You can think about it too. - -Larry diff --git a/interp.sym b/interp.sym index 6628a3c..ef88090 100644 --- a/interp.sym +++ b/interp.sym @@ -10,7 +10,6 @@ allgvs ampergv argvgv argvoutgv -arybase basetime beginav bodytarget @@ -20,7 +19,6 @@ copline curblock curcop curcsv -curoutgv curpm curstash curstname @@ -114,6 +112,7 @@ rs rschar rslen rspara +runlevel sawampersand sawi sawstudy @@ -135,7 +134,7 @@ statusvalue stdingv strchop sv_count -sv_rvcount +sv_objcount sv_root sv_arenaroot tainted diff --git a/keywords.h b/keywords.h index 14aa732..49f4d20 100644 --- a/keywords.h +++ b/keywords.h @@ -4,42 +4,42 @@ #define KEY___END__ 3 #define KEY_AUTOLOAD 4 #define KEY_BEGIN 5 -#define KEY_DESTROY 6 -#define KEY_END 7 -#define KEY_EQ 8 -#define KEY_GE 9 -#define KEY_GT 10 -#define KEY_LE 11 -#define KEY_LT 12 -#define KEY_NE 13 -#define KEY_abs 14 -#define KEY_accept 15 -#define KEY_alarm 16 -#define KEY_and 17 -#define KEY_atan2 18 -#define KEY_aver 19 +#define KEY_CORE 6 +#define KEY_DESTROY 7 +#define KEY_END 8 +#define KEY_EQ 9 +#define KEY_GE 10 +#define KEY_GT 11 +#define KEY_LE 12 +#define KEY_LT 13 +#define KEY_NE 14 +#define KEY_abs 15 +#define KEY_accept 16 +#define KEY_alarm 17 +#define KEY_and 18 +#define KEY_atan2 19 #define KEY_bind 20 #define KEY_binmode 21 #define KEY_bless 22 #define KEY_caller 23 #define KEY_chdir 24 #define KEY_chmod 25 -#define KEY_chop 26 -#define KEY_chown 27 -#define KEY_chr 28 -#define KEY_chroot 29 -#define KEY_close 30 -#define KEY_closedir 31 -#define KEY_cmp 32 -#define KEY_connect 33 -#define KEY_continue 34 -#define KEY_cos 35 -#define KEY_crypt 36 -#define KEY_dbmclose 37 -#define KEY_dbmopen 38 -#define KEY_defined 39 -#define KEY_delete 40 -#define KEY_deny 41 +#define KEY_chomp 26 +#define KEY_chop 27 +#define KEY_chown 28 +#define KEY_chr 29 +#define KEY_chroot 30 +#define KEY_close 31 +#define KEY_closedir 32 +#define KEY_cmp 33 +#define KEY_connect 34 +#define KEY_continue 35 +#define KEY_cos 36 +#define KEY_crypt 37 +#define KEY_dbmclose 38 +#define KEY_dbmopen 39 +#define KEY_defined 40 +#define KEY_delete 41 #define KEY_die 42 #define KEY_do 43 #define KEY_dump 44 @@ -56,178 +56,186 @@ #define KEY_eq 55 #define KEY_eval 56 #define KEY_exec 57 -#define KEY_exit 58 -#define KEY_exp 59 -#define KEY_fcntl 60 -#define KEY_fileno 61 -#define KEY_flock 62 -#define KEY_for 63 -#define KEY_foreach 64 -#define KEY_fork 65 -#define KEY_format 66 -#define KEY_formline 67 -#define KEY_ge 68 -#define KEY_getc 69 -#define KEY_getgrent 70 -#define KEY_getgrgid 71 -#define KEY_getgrnam 72 -#define KEY_gethostbyaddr 73 -#define KEY_gethostbyname 74 -#define KEY_gethostent 75 -#define KEY_getlogin 76 -#define KEY_getnetbyaddr 77 -#define KEY_getnetbyname 78 -#define KEY_getnetent 79 -#define KEY_getpeername 80 -#define KEY_getpgrp 81 -#define KEY_getppid 82 -#define KEY_getpriority 83 -#define KEY_getprotobyname 84 -#define KEY_getprotobynumber 85 -#define KEY_getprotoent 86 -#define KEY_getpwent 87 -#define KEY_getpwnam 88 -#define KEY_getpwuid 89 -#define KEY_getservbyname 90 -#define KEY_getservbyport 91 -#define KEY_getservent 92 -#define KEY_getsockname 93 -#define KEY_getsockopt 94 -#define KEY_glob 95 -#define KEY_gmtime 96 -#define KEY_goto 97 -#define KEY_grep 98 -#define KEY_gt 99 -#define KEY_hex 100 -#define KEY_if 101 -#define KEY_index 102 -#define KEY_int 103 -#define KEY_ioctl 104 -#define KEY_join 105 -#define KEY_keys 106 -#define KEY_kill 107 -#define KEY_last 108 -#define KEY_lc 109 -#define KEY_lcfirst 110 -#define KEY_le 111 -#define KEY_length 112 -#define KEY_link 113 -#define KEY_listen 114 -#define KEY_local 115 -#define KEY_localtime 116 -#define KEY_log 117 -#define KEY_lstat 118 -#define KEY_lt 119 -#define KEY_m 120 -#define KEY_mkdir 121 -#define KEY_msgctl 122 -#define KEY_msgget 123 -#define KEY_msgrcv 124 -#define KEY_msgsnd 125 -#define KEY_my 126 -#define KEY_ne 127 -#define KEY_next 128 -#define KEY_oct 129 -#define KEY_open 130 -#define KEY_opendir 131 -#define KEY_or 132 -#define KEY_ord 133 -#define KEY_pack 134 -#define KEY_package 135 -#define KEY_pipe 136 -#define KEY_pop 137 -#define KEY_print 138 -#define KEY_printf 139 -#define KEY_push 140 -#define KEY_q 141 -#define KEY_qq 142 -#define KEY_qw 143 -#define KEY_qx 144 -#define KEY_rand 145 -#define KEY_read 146 -#define KEY_readdir 147 -#define KEY_readline 148 -#define KEY_readlink 149 -#define KEY_readpipe 150 -#define KEY_recv 151 -#define KEY_redo 152 -#define KEY_ref 153 -#define KEY_rename 154 -#define KEY_require 155 -#define KEY_reset 156 -#define KEY_return 157 -#define KEY_reverse 158 -#define KEY_rewinddir 159 -#define KEY_rindex 160 -#define KEY_rmdir 161 -#define KEY_s 162 -#define KEY_scalar 163 -#define KEY_seek 164 -#define KEY_seekdir 165 -#define KEY_select 166 -#define KEY_semctl 167 -#define KEY_semget 168 -#define KEY_semop 169 -#define KEY_send 170 -#define KEY_setgrent 171 -#define KEY_sethostent 172 -#define KEY_setnetent 173 -#define KEY_setpgrp 174 -#define KEY_setpriority 175 -#define KEY_setprotoent 176 -#define KEY_setpwent 177 -#define KEY_setservent 178 -#define KEY_setsockopt 179 -#define KEY_shift 180 -#define KEY_shmctl 181 -#define KEY_shmget 182 -#define KEY_shmread 183 -#define KEY_shmwrite 184 -#define KEY_shutdown 185 -#define KEY_sin 186 -#define KEY_sleep 187 -#define KEY_socket 188 -#define KEY_socketpair 189 -#define KEY_sort 190 -#define KEY_splice 191 -#define KEY_split 192 -#define KEY_sprintf 193 -#define KEY_sqrt 194 -#define KEY_srand 195 -#define KEY_stat 196 -#define KEY_study 197 -#define KEY_sub 198 -#define KEY_substr 199 -#define KEY_symlink 200 -#define KEY_syscall 201 -#define KEY_sysread 202 -#define KEY_system 203 -#define KEY_syswrite 204 -#define KEY_tell 205 -#define KEY_telldir 206 -#define KEY_tie 207 -#define KEY_time 208 -#define KEY_times 209 -#define KEY_tr 210 -#define KEY_truncate 211 -#define KEY_uc 212 -#define KEY_ucfirst 213 -#define KEY_umask 214 -#define KEY_undef 215 -#define KEY_unless 216 -#define KEY_unlink 217 -#define KEY_unpack 218 -#define KEY_unshift 219 -#define KEY_untie 220 -#define KEY_until 221 -#define KEY_utime 222 -#define KEY_values 223 -#define KEY_vec 224 -#define KEY_wait 225 -#define KEY_waitpid 226 -#define KEY_wantarray 227 -#define KEY_warn 228 -#define KEY_while 229 -#define KEY_write 230 -#define KEY_x 231 -#define KEY_y 232 +#define KEY_exists 58 +#define KEY_exit 59 +#define KEY_exp 60 +#define KEY_fcntl 61 +#define KEY_fileno 62 +#define KEY_flock 63 +#define KEY_for 64 +#define KEY_foreach 65 +#define KEY_fork 66 +#define KEY_format 67 +#define KEY_formline 68 +#define KEY_ge 69 +#define KEY_getc 70 +#define KEY_getgrent 71 +#define KEY_getgrgid 72 +#define KEY_getgrnam 73 +#define KEY_gethostbyaddr 74 +#define KEY_gethostbyname 75 +#define KEY_gethostent 76 +#define KEY_getlogin 77 +#define KEY_getnetbyaddr 78 +#define KEY_getnetbyname 79 +#define KEY_getnetent 80 +#define KEY_getpeername 81 +#define KEY_getpgrp 82 +#define KEY_getppid 83 +#define KEY_getpriority 84 +#define KEY_getprotobyname 85 +#define KEY_getprotobynumber 86 +#define KEY_getprotoent 87 +#define KEY_getpwent 88 +#define KEY_getpwnam 89 +#define KEY_getpwuid 90 +#define KEY_getservbyname 91 +#define KEY_getservbyport 92 +#define KEY_getservent 93 +#define KEY_getsockname 94 +#define KEY_getsockopt 95 +#define KEY_glob 96 +#define KEY_gmtime 97 +#define KEY_goto 98 +#define KEY_grep 99 +#define KEY_gt 100 +#define KEY_hex 101 +#define KEY_if 102 +#define KEY_index 103 +#define KEY_int 104 +#define KEY_ioctl 105 +#define KEY_join 106 +#define KEY_keys 107 +#define KEY_kill 108 +#define KEY_last 109 +#define KEY_lc 110 +#define KEY_lcfirst 111 +#define KEY_le 112 +#define KEY_length 113 +#define KEY_link 114 +#define KEY_listen 115 +#define KEY_local 116 +#define KEY_localtime 117 +#define KEY_log 118 +#define KEY_lstat 119 +#define KEY_lt 120 +#define KEY_m 121 +#define KEY_map 122 +#define KEY_mkdir 123 +#define KEY_msgctl 124 +#define KEY_msgget 125 +#define KEY_msgrcv 126 +#define KEY_msgsnd 127 +#define KEY_my 128 +#define KEY_ne 129 +#define KEY_next 130 +#define KEY_no 131 +#define KEY_not 132 +#define KEY_oct 133 +#define KEY_open 134 +#define KEY_opendir 135 +#define KEY_or 136 +#define KEY_ord 137 +#define KEY_pack 138 +#define KEY_package 139 +#define KEY_pipe 140 +#define KEY_pop 141 +#define KEY_pos 142 +#define KEY_print 143 +#define KEY_printf 144 +#define KEY_push 145 +#define KEY_q 146 +#define KEY_qq 147 +#define KEY_quotemeta 148 +#define KEY_qw 149 +#define KEY_qx 150 +#define KEY_rand 151 +#define KEY_read 152 +#define KEY_readdir 153 +#define KEY_readline 154 +#define KEY_readlink 155 +#define KEY_readpipe 156 +#define KEY_recv 157 +#define KEY_redo 158 +#define KEY_ref 159 +#define KEY_rename 160 +#define KEY_require 161 +#define KEY_reset 162 +#define KEY_return 163 +#define KEY_reverse 164 +#define KEY_rewinddir 165 +#define KEY_rindex 166 +#define KEY_rmdir 167 +#define KEY_s 168 +#define KEY_scalar 169 +#define KEY_seek 170 +#define KEY_seekdir 171 +#define KEY_select 172 +#define KEY_semctl 173 +#define KEY_semget 174 +#define KEY_semop 175 +#define KEY_send 176 +#define KEY_setgrent 177 +#define KEY_sethostent 178 +#define KEY_setnetent 179 +#define KEY_setpgrp 180 +#define KEY_setpriority 181 +#define KEY_setprotoent 182 +#define KEY_setpwent 183 +#define KEY_setservent 184 +#define KEY_setsockopt 185 +#define KEY_shift 186 +#define KEY_shmctl 187 +#define KEY_shmget 188 +#define KEY_shmread 189 +#define KEY_shmwrite 190 +#define KEY_shutdown 191 +#define KEY_sin 192 +#define KEY_sleep 193 +#define KEY_socket 194 +#define KEY_socketpair 195 +#define KEY_sort 196 +#define KEY_splice 197 +#define KEY_split 198 +#define KEY_sprintf 199 +#define KEY_sqrt 200 +#define KEY_srand 201 +#define KEY_stat 202 +#define KEY_study 203 +#define KEY_sub 204 +#define KEY_substr 205 +#define KEY_symlink 206 +#define KEY_syscall 207 +#define KEY_sysread 208 +#define KEY_system 209 +#define KEY_syswrite 210 +#define KEY_tell 211 +#define KEY_telldir 212 +#define KEY_tie 213 +#define KEY_time 214 +#define KEY_times 215 +#define KEY_tr 216 +#define KEY_truncate 217 +#define KEY_uc 218 +#define KEY_ucfirst 219 +#define KEY_umask 220 +#define KEY_undef 221 +#define KEY_unless 222 +#define KEY_unlink 223 +#define KEY_unpack 224 +#define KEY_unshift 225 +#define KEY_untie 226 +#define KEY_until 227 +#define KEY_use 228 +#define KEY_utime 229 +#define KEY_values 230 +#define KEY_vec 231 +#define KEY_wait 232 +#define KEY_waitpid 233 +#define KEY_wantarray 234 +#define KEY_warn 235 +#define KEY_while 236 +#define KEY_write 237 +#define KEY_x 238 +#define KEY_xor 239 +#define KEY_y 240 diff --git a/keywords.pl b/keywords.pl new file mode 100755 index 0000000..d3426be --- /dev/null +++ b/keywords.pl @@ -0,0 +1,266 @@ +#!/usr/bin/perl + +open(KW, ">keywords.h") || die "Can't create keywords.h: $!\n"; +select KW; + +# Read & print data. + +$keynum = 0; +while () { + chop; + next unless $_; + next if /^#/; + ($keyword) = split; + print &tab(5, "#define KEY_$keyword"), $keynum++, "\n"; +} + +########################################################################### +sub tab { + local($l, $t) = @_; + $t .= "\t" x ($l - (length($t) + 1) / 8); + $t; +} +########################################################################### +__END__ + +NULL +__LINE__ +__FILE__ +__END__ +AUTOLOAD +BEGIN +CORE +DESTROY +END +EQ +GE +GT +LE +LT +NE +abs +accept +alarm +and +atan2 +bind +binmode +bless +caller +chdir +chmod +chomp +chop +chown +chr +chroot +close +closedir +cmp +connect +continue +cos +crypt +dbmclose +dbmopen +defined +delete +die +do +dump +each +else +elsif +endgrent +endhostent +endnetent +endprotoent +endpwent +endservent +eof +eq +eval +exec +exists +exit +exp +fcntl +fileno +flock +for +foreach +fork +format +formline +ge +getc +getgrent +getgrgid +getgrnam +gethostbyaddr +gethostbyname +gethostent +getlogin +getnetbyaddr +getnetbyname +getnetent +getpeername +getpgrp +getppid +getpriority +getprotobyname +getprotobynumber +getprotoent +getpwent +getpwnam +getpwuid +getservbyname +getservbyport +getservent +getsockname +getsockopt +glob +gmtime +goto +grep +gt +hex +if +index +int +ioctl +join +keys +kill +last +lc +lcfirst +le +length +link +listen +local +localtime +log +lstat +lt +m +map +mkdir +msgctl +msgget +msgrcv +msgsnd +my +ne +next +no +not +oct +open +opendir +or +ord +pack +package +pipe +pop +pos +print +printf +push +q +qq +quotemeta +qw +qx +rand +read +readdir +readline +readlink +readpipe +recv +redo +ref +rename +require +reset +return +reverse +rewinddir +rindex +rmdir +s +scalar +seek +seekdir +select +semctl +semget +semop +send +setgrent +sethostent +setnetent +setpgrp +setpriority +setprotoent +setpwent +setservent +setsockopt +shift +shmctl +shmget +shmread +shmwrite +shutdown +sin +sleep +socket +socketpair +sort +splice +split +sprintf +sqrt +srand +stat +study +sub +substr +symlink +syscall +sysread +system +syswrite +tell +telldir +tie +time +times +tr +truncate +uc +ucfirst +umask +undef +unless +unlink +unpack +unshift +untie +until +use +utime +values +vec +wait +waitpid +wantarray +warn +while +write +x +xor +y diff --git a/lib/AnyDBM_File.pm b/lib/AnyDBM_File.pm new file mode 100644 index 0000000..ff90786 --- /dev/null +++ b/lib/AnyDBM_File.pm @@ -0,0 +1,9 @@ +package AnyDBM_File; + +@ISA = qw(NDBM_File DB_File GDBM_File SDBM_File ODBM_File) unless @ISA; + +eval { require NDBM_File } || +eval { require DB_File } || +eval { require GDBM_File } || +eval { require SDBM_File } || +eval { require ODBM_File }; diff --git a/lib/AutoLoader.pm b/lib/AutoLoader.pm index dba8ca2..3f5eef2 100644 --- a/lib/AutoLoader.pm +++ b/lib/AutoLoader.pm @@ -1,13 +1,23 @@ package AutoLoader; +use Carp; AUTOLOAD { my $name = "auto/$AUTOLOAD.al"; $name =~ s#::#/#g; eval {require $name}; if ($@) { - ($p,$f,$l) = caller($AutoLevel); - $@ =~ s/ at .*\n//; - die "$@ at $f line $l\n"; + # The load might just have failed because the filename was too + # long for some old SVR3 systems which treat long names as errors. + # If we can succesfully truncate a long name then it's worth a go. + # There is a slight risk that we could pick up the wrong file here + # but autosplit should have warned about that when splitting. + if ($name =~ s/(\w{12,})\.al$/substr($1,0,11).".al"/e){ + eval {require $name}; + } + if ($@){ + $@ =~ s/ at .*\n//; + croak $@; + } } goto &$AUTOLOAD; } diff --git a/lib/AutoSplit.pm b/lib/AutoSplit.pm new file mode 100644 index 0000000..dabf43c --- /dev/null +++ b/lib/AutoSplit.pm @@ -0,0 +1,225 @@ +package AutoSplit; + +require 5.000; +require Exporter; + +use Config; +use Carp; + +@ISA = qw(Exporter); +@EXPORT = qw(&autosplit &autosplit_lib_modules); +@EXPORT_OK = qw($Verbose $Keep); + +# for portability warn about names longer than $maxlen +$Maxlen = 8; # 8 for dos, 11 (14-".al") for SYSVR3 +$Verbose = 1; # 0=none, 1=minimal, 2=list .al files +$Keep = 0; +$IndexFile = "autosplit.ix"; # file also serves as timestamp + +$maxflen = 255; +$maxflen = 14 if $Config{'d_flexfnam'} ne 'define'; +$vms = ($Config{'osname'} eq 'VMS'); + +sub autosplit{ + my($file, $autodir) = @_; + autosplit_file($file, $autodir, $Keep, 1, 0); +} + + + +# This function is used during perl building/installation +# ./miniperl -e 'use AutoSplit; autosplit_modules(@ARGV)' ... + +sub autosplit_lib_modules{ + my(@modules) = @_; # list of Module names + + foreach(@modules){ + s#::#/#g; # incase specified as ABC::XYZ + s#^lib/##; # incase specified as lib/*.pm + if ($vms && /[:>\]]/) { # may need to convert VMS-style filespecs + my ($dir,$name) = (/(.*])(.*)/); + $dir =~ s/.*lib[\.\]]//; + $dir =~ s#[\.\]]#/#g; + $_ = $dir . $name; + } + autosplit_file("lib/$_", "lib/auto", $Keep, 1, 1); + } + 0; +} + + +# private functions + +sub autosplit_file{ + my($filename, $autodir, $keep, $check_for_autoloader, $check_mod_time) = @_; + my(@names); + + # where to write output files + $autodir = "lib/auto" unless $autodir; + die "autosplit directory $autodir does not exist" unless -d $autodir; + + # allow just a package name to be used + $filename .= ".pm" unless ($filename =~ m/\.pm$/); + + open(IN, "<$filename") || die "AutoSplit: Can't open $filename: $!\n"; + my($pm_mod_time) = (stat($filename))[9]; + my($autoloader_seen) = 0; + while () { + # record last package name seen + $package = $1 if (m/^\s*package\s+([\w:]+)\s*;/); + ++$autoloader_seen if m/^\s*use\s+AutoLoader\b/; + ++$autoloader_seen if m/\bISA\s*=.*\bAutoLoader\b/; + last if /^__END__/; + } + return 0 if ($check_for_autoloader && !$autoloader_seen); + $_ or die "Can't find __END__ in $filename\n"; + + $package or die "Can't find 'package Name;' in $filename\n"; + + my($modpname) = $package; $modpname =~ s#::#/#g; + my($al_idx_file) = "$autodir/$modpname/$IndexFile"; + + die "Package $package does not match filename $filename" + unless ($filename =~ m/$modpname.pm$/ or + $vms && $filename =~ m/$modpname.pm/i); + + if ($check_mod_time){ + my($al_ts_time) = (stat("$al_idx_file"))[9] || 1; + if ($al_ts_time >= $pm_mod_time){ + print "AutoSplit skipped ($al_idx_file newer that $filename)\n" + if ($Verbose >= 2); + return undef; # one undef, not a list + } + } + + my($from) = ($Verbose>=2) ? "$filename => " : ""; + print "AutoSplitting $package ($from$autodir/$modpname)\n" + if $Verbose; + + unless (-d "$autodir/$modpname"){ + local($", @p)="/"; + foreach(split(/\//,"$autodir/$modpname")){ + push(@p, $_); + next if -d "@p"; + mkdir("@p",0777) or die "AutoSplit unable to mkdir @p: $!"; + } + } + + # We must try to deal with some SVR3 systems with a limit of 14 + # characters for file names. Sadly we *cannot* simply truncate all + # file names to 14 characters on these systems because we *must* + # create filenames which exactly match the names used by AutoLoader.pm. + # This is a problem because some systems silently truncate the file + # names while others treat long file names as an error. + + # We do not yet deal with multiple packages within one file. + # Ideally both of these styles should work. + # + # package NAME; + # __END__ + # sub AAA { ... } + # package NAME::option1; + # sub BBB { ... } + # package NAME::option2; + # sub BBB { ... } + # + # package NAME; + # __END__ + # sub AAA { ... } + # sub NAME::option1::BBB { ... } + # sub NAME::option2::BBB { ... } + # + # For now both of these produce warnings. + + open(OUT,">/dev/null") || open(OUT,">nla0:"); # avoid 'not opened' warning + my(@subnames); + while () { + if (/^package ([\w:]+)\s*;/) { + warn "package $1; in AutoSplit section ignored. Not currently supported."; + } + if (/^sub ([\w:]+)/) { + print OUT "1;\n"; + my($subname) = $1; + if ($subname =~ m/::/){ + warn "subs with package names not currently supported in AutoSplit section"; + } + push(@subnames, $subname); + my($lname, $sname) = ($subname, substr($subname,0,$maxflen-3)); + my($lpath) = "$autodir/$modpname/$lname.al"; + my($spath) = "$autodir/$modpname/$sname.al"; + unless(open(OUT, ">$lpath")){ + open(OUT, ">$spath") or die "Can't create $spath: $!\n"; + push(@names, $sname); + print " writing $spath (with truncated name)\n" + if ($Verbose>=1); + }else{ + push(@names, $lname); + print " writing $lpath\n" if ($Verbose>=2); + } + print OUT "# NOTE: Derived from $filename. ", + "Changes made here will be lost.\n"; + print OUT "package $package;\n\n"; + } + print OUT $_; + } + print OUT "1;\n"; + close(OUT); + close(IN); + + if (!$keep){ # don't keep any obsolete *.al files in the directory + my(%names); + @names{@names} = @names; + opendir(OUTDIR,"$autodir/$modpname"); + foreach(sort readdir(OUTDIR)){ + next unless /\.al$/; + my($subname) = m/(.*)\.al$/; + next if $names{substr($subname,0,$maxflen-3)}; + my($file) = "$autodir/$modpname/$_"; + print " deleting $file\n" if ($Verbose>=2); + unlink $file or carp "Unable to delete $file: $!"; + } + closedir(OUTDIR); + } + + open(TS,">$al_idx_file") or + carp "AutoSplit: unable to create timestamp file ($al_idx_file): $!"; + print TS "# Index created by AutoSplit for $filename (file acts as timestamp)\n"; + print TS map("sub $_ ;\n", @subnames); + close(TS); + + check_unique($package, $Maxlen, 1, @names); + + @names; +} + + +sub check_unique{ + my($module, $maxlen, $warn, @names) = @_; + my(%notuniq) = (); + my(%shorts) = (); + my(@toolong) = grep(length > $maxlen, @names); + + foreach(@toolong){ + my($trunc) = substr($_,0,$maxlen); + $notuniq{$trunc}=1 if $shorts{$trunc}; + $shorts{$trunc} = ($shorts{$trunc}) ? "$shorts{$trunc}, $_" : $_; + } + if (%notuniq && $warn){ + print "$module: some names are not unique when truncated to $maxlen characters:\n"; + foreach(keys %notuniq){ + print " $shorts{$_} truncate to $_\n"; + } + } + %notuniq; +} + +1; +__END__ + +# test functions so AutoSplit.pm can be applied to itself: +sub test1{ "test 1\n"; } +sub test2{ "test 2\n"; } +sub test3{ "test 3\n"; } +sub test4{ "test 4\n"; } + + diff --git a/lib/Benchmark.pm b/lib/Benchmark.pm new file mode 100644 index 0000000..a19caff --- /dev/null +++ b/lib/Benchmark.pm @@ -0,0 +1,245 @@ +package Benchmark; + +# Purpose: benchmark running times of code. +# +# +# Usage - to time code snippets and print results: +# +# timethis($count, '...code...'); +# +# prints: +# timethis 100: 2 secs ( 0.23 usr 0.10 sys = 0.33 cpu) +# +# +# timethese($count, { +# Name1 => '...code1...', +# Name2 => '...code2...', +# ... }); +# prints: +# Benchmark: timing 100 iterations of Name1, Name2... +# Name1: 2 secs ( 0.50 usr 0.00 sys = 0.50 cpu) +# Name2: 1 secs ( 0.48 usr 0.00 sys = 0.48 cpu) +# +# The default display style will automatically add child process +# values if non-zero. +# +# +# Usage - to time sections of your own code: +# +# use Benchmark; +# $t0 = new Benchmark; +# ... your code here ... +# $t1 = new Benchmark; +# $td = &timediff($t1, $t0); +# print "the code took:",timestr($td),"\n"; +# +# $t = &timeit($count, '...other code...') +# print "$count loops of other code took:",timestr($t),"\n"; +# +# +# Data format: +# The data is stored as a list of values from the time and times +# functions: ($real, $user, $system, $children_user, $children_system) +# in seconds for the whole loop (not divided by the number of rounds). +# +# Internals: +# The timing is done using time(3) and times(3). +# +# Code is executed in the callers package +# +# Enable debugging by: $Benchmark::debug = 1; +# +# The time of the null loop (a loop with the same +# number of rounds but empty loop body) is substracted +# from the time of the real loop. +# +# The null loop times are cached, the key being the +# number of rounds. The caching can be controlled using +# &clearcache($key); &clearallcache; +# &disablecache; &enablecache; +# +# Caveats: +# +# The real time timing is done using time(2) and +# the granularity is therefore only one second. +# +# Short tests may produce negative figures because perl +# can appear to take longer to execute the empty loop +# than a short test: try timethis(100,'1'); +# +# 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 < 0 +# +# More documentation is needed :-( +# Especially for styles and formats. +# +# Authors: Jarkko Hietaniemi +# Tim Bunce +# +# +# Last updated: Sept 8th 94 by Tim Bunce +# + +use Exporter; +@ISA=(Exporter); +@EXPORT=qw(timeit timethis timethese timediff timestr); +@EXPORT_OK=qw(clearcache clearallcache disablecache enablecache); + +&init; + +sub init { + $debug = 0; + $min_count = 4; + $min_cpu = 0.4; + $defaultfmt = '5.2f'; + $defaultstyle = 'auto'; + # The cache can cause a slight loss of sys time accuracy. If a + # user does many tests (>10) with *very* large counts (>10000) + # or works on a very slow machine the cache may be useful. + &disablecache; + &clearallcache; +} + +sub clearcache { delete $cache{$_[0]}; } +sub clearallcache { %cache = (); } +sub enablecache { $cache = 1; } +sub disablecache { $cache = 0; } + + +# --- Functions to process the 'time' data type + +sub new { my(@t)=(time, times); print "new=@t\n" if $debug; bless \@t; } + +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 timediff{ + my($a, $b) = @_; + my(@r); + for($i=0; $i < @$a; ++$i){ + push(@r, $a->[$i] - $b->[$i]); + } + bless \@r; +} + +sub timestr{ + my($tr, $style, $f) = @_; + my(@t) = @$tr; + warn "bad time value" unless @t==5; + my($r, $pu, $ps, $cu, $cs) = @t; + my($pt, $ct, $t) = ($tr->cpu_p, $tr->cpu_c, $tr->cpu_a); + $f = $defaultfmt unless $f; + # format a time in the required style, other formats may be added here + $style = $defaultstyle unless $style; + $style = ($ct>0) ? 'all' : 'noc' if $style=~/^auto$/; + my($s) = "@t $style"; # default for unknown style + $s=sprintf("%2d secs (%$f usr %$f sys + %$f cusr %$f csys = %$f cpu)", + @t,$t) if $style =~ /^all$/; + $s=sprintf("%2d secs (%$f usr %$f sys = %$f cpu)", + $r,$pu,$ps,$pt) if $style =~ /^noc$/; + $s=sprintf("%2d secs (%$f cusr %$f csys = %$f cpu)", + $r,$cu,$cs,$ct) if $style =~ /^nop$/; + $s; +} +sub timedebug{ + my($msg, $t) = @_; + print STDERR "$msg",timestr($t),"\n" if ($debug); +} + + +# --- Functions implementing low-level support for timing loops + +sub runloop { + my($n, $c) = @_; + my($t0, $t1, $td); # before, after, difference + + # find package of caller so we can execute code there + my ($curpack) = caller(0); + my ($i, $pack)= 0; + while (($pack) = caller(++$i)) { + last if $pack ne $curpack; + } + + my $subcode = "sub { package $pack; my(\$_i)=$n; while (\$_i--){$c;} }"; + my $subref = eval $subcode; + die "runloop unable to compile '$c': $@\ncode: $subcode\n" if $@; + print STDERR "runloop $n '$subcode'\n" if ($debug); + + $t0 = &new; + &$subref; + $t1 = &new; + $td = &timediff($t1, $t0); + + timedebug("runloop:",$td); + $td; +} + + +sub timeit { + my($n, $code) = @_; + my($wn, $wc, $wd); + + printf STDERR "timeit $n $code\n" if $debug; + + if ($cache && exists $cache{$n}){ + $wn = $cache{$n}; + }else{ + $wn = &runloop($n, ''); + $cache{$n} = $wn; + } + + $wc = &runloop($n, $code); + + $wd = timediff($wc, $wn); + + timedebug("timeit: ",$wc); + timedebug(" - ",$wn); + timedebug(" = ",$wd); + + $wd; +} + + +# --- Functions implementing high-level time-then-print utilities + +sub timethis{ + my($n, $code, $title, $style) = @_; + my($t) = timeit($n, $code); + local($|) = 1; + $title = "timethis $n" unless $title; + $style = "" unless $style; + printf("%10s: ", $title); + print timestr($t, $style),"\n"; + # A conservative warning to spot very silly tests. + # Don't assume that your benchmark is ok simply because + # you don't get this warning! + print " (warning: too few iterations for a reliable count)\n" + if ( $n < $min_count + || ($t->real < 1 && $n < 1000) + || $t->cpu_a < $min_cpu); + $t; +} + + +sub timethese{ + my($n, $alt, $style) = @_; + die "usage: timethese(count, { 'Name1'=>'code1', ... }\n" + unless ref $alt eq HASH; + my(@all); + my(@names) = sort keys %$alt; + $style = "" unless $style; + print "Benchmark: timing $n iterations of ",join(', ',@names),"...\n"; + foreach(@names){ + $t = timethis($n, $alt->{$_}, $_, $style); + push(@all, $t); + } + # we could produce a summary from @all here + # sum, min, max, avg etc etc + @all; +} + + +1; diff --git a/lib/Carp.pm b/lib/Carp.pm new file mode 100644 index 0000000..5daba5c --- /dev/null +++ b/lib/Carp.pm @@ -0,0 +1,37 @@ +package Carp; + +# This package implements handy routines for modules that wish to throw +# exceptions outside of the current package. + +require Exporter; +@ISA = Exporter; +@EXPORT = qw(confess croak carp); + +sub longmess { + my $error = shift; + my $mess = ""; + my $i = 2; + my ($pack,$file,$line,$sub); + while (($pack,$file,$line,$sub) = caller($i++)) { + $mess .= "\t$sub " if $error eq "called"; + $mess .= "$error at $file line $line\n"; + $error = "called"; + } + $mess || $error; +} + +sub shortmess { + my $error = shift; + my ($curpack) = caller(1); + my $i = 2; + my ($pack,$file,$line,$sub); + while (($pack,$file,$line,$sub) = caller($i++)) { + return "$error at $file line $line\n" if $pack ne $curpack; + } + longmess $error; +} + +sub confess { die longmess @_; } +sub croak { die shortmess @_; } +sub carp { warn shortmess @_; } + diff --git a/lib/Config.pm b/lib/Config.pm deleted file mode 100644 index 20df7e0..0000000 --- a/lib/Config.pm +++ /dev/null @@ -1,362 +0,0 @@ -package Config; -require Exporter; -@ISA = (Exporter); -@EXPORT = qw(%Config); - -$] == 5.000 or die sprintf - "Perl lib version (5.000) doesn't match executable version (%.3f)\n", $]; - - -# -# 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". -# - -# Configuration time: Wed May 4 15:10:39 PDT 1994 -# Configured by: lwall -# Target system: sunos scalpel 4.1.3 3 sun4c - -$Config{'extensions'} = ' ext/dbm/NDBM_File.xs ext/dbm/ODBM_File.xs ext/dbm/SDBM_File.xs ext/posix/POSIX.xs'; -$Config{'d_eunice'} = undef; -$Config{'d_xenix'} = undef; -$Config{'eunicefix'} = ':'; -$Config{'Mcc'} = 'Mcc'; -$Config{'awk'} = '/bin/awk'; -$Config{'bash'} = ''; -$Config{'bison'} = '/usr/local/bin/bison'; -$Config{'byacc'} = 'byacc'; -$Config{'cat'} = '/bin/cat'; -$Config{'chgrp'} = ''; -$Config{'chmod'} = ''; -$Config{'chown'} = ''; -$Config{'compress'} = ''; -$Config{'cp'} = '/bin/cp'; -$Config{'cpio'} = ''; -$Config{'cpp'} = '/usr/lib/cpp'; -$Config{'csh'} = '/bin/csh'; -$Config{'date'} = '/bin/date'; -$Config{'echo'} = '/bin/echo'; -$Config{'egrep'} = '/bin/egrep'; -$Config{'emacs'} = ''; -$Config{'expr'} = '/bin/expr'; -$Config{'find'} = '/bin/find'; -$Config{'flex'} = ''; -$Config{'gcc'} = ''; -$Config{'grep'} = '/bin/grep'; -$Config{'inews'} = ''; -$Config{'ksh'} = ''; -$Config{'less'} = ''; -$Config{'line'} = '/bin/line'; -$Config{'lint'} = ''; -$Config{'ln'} = '/bin/ln'; -$Config{'lp'} = ''; -$Config{'lpr'} = ''; -$Config{'ls'} = ''; -$Config{'mail'} = ''; -$Config{'mailx'} = ''; -$Config{'make'} = ''; -$Config{'mkdir'} = '/bin/mkdir'; -$Config{'more'} = ''; -$Config{'mv'} = '/bin/mv'; -$Config{'nroff'} = '/bin/nroff'; -$Config{'perl'} = '/home/netlabs1/lwall/pl/perl'; -$Config{'pg'} = ''; -$Config{'pmake'} = ''; -$Config{'pr'} = ''; -$Config{'rm'} = '/bin/rm'; -$Config{'rmail'} = ''; -$Config{'sed'} = '/bin/sed'; -$Config{'sendmail'} = ''; -$Config{'sh'} = ''; -$Config{'shar'} = ''; -$Config{'sleep'} = ''; -$Config{'smail'} = ''; -$Config{'sort'} = '/bin/sort'; -$Config{'submit'} = ''; -$Config{'tail'} = ''; -$Config{'tar'} = ''; -$Config{'tbl'} = ''; -$Config{'test'} = 'test'; -$Config{'touch'} = '/bin/touch'; -$Config{'tr'} = '/bin/tr'; -$Config{'troff'} = ''; -$Config{'uname'} = '/bin/uname'; -$Config{'uniq'} = '/bin/uniq'; -$Config{'uuname'} = ''; -$Config{'vi'} = ''; -$Config{'zcat'} = ''; -$Config{'hint'} = 'recommended'; -$Config{'myuname'} = 'sunos scalpel 4.1.3 3 sun4c '; -$Config{'osname'} = 'sunos'; -$Config{'osvers'} = '4.1.3'; -$Config{'Author'} = ''; -$Config{'Date'} = '$Date'; -$Config{'Header'} = ''; -$Config{'Id'} = '$Id'; -$Config{'Locker'} = ''; -$Config{'Log'} = '$Log'; -$Config{'RCSfile'} = '$RCSfile'; -$Config{'Revision'} = '$Revision'; -$Config{'Source'} = ''; -$Config{'State'} = ''; -$Config{'afs'} = 'false'; -$Config{'memalignbytes'} = '8'; -$Config{'bin'} = '/usr/local/bin'; -$Config{'binexp'} = '/usr/local/bin'; -$Config{'installbin'} = '/usr/local/bin'; -$Config{'byteorder'} = '4321'; -$Config{'cc'} = 'cc'; -$Config{'gccversion'} = ''; -$Config{'ccflags'} = '-DDEBUGGING'; -$Config{'cppflags'} = ' -DDEBUGGING'; -$Config{'ldflags'} = ''; -$Config{'lkflags'} = ''; -$Config{'optimize'} = '-g'; -$Config{'cf_by'} = 'lwall'; -$Config{'cf_time'} = 'Wed May 4 15:10:39 PDT 1994'; -$Config{'contains'} = 'grep'; -$Config{'cpplast'} = ''; -$Config{'cppminus'} = ''; -$Config{'cpprun'} = '/usr/lib/cpp'; -$Config{'cppstdin'} = '/tmp_mnt/net/vaccine/export/src/local/lwall/perl5/cppstdin'; -$Config{'d_access'} = 'define'; -$Config{'d_bcmp'} = 'define'; -$Config{'d_bcopy'} = 'define'; -$Config{'d_bzero'} = 'define'; -$Config{'d_casti32'} = 'define'; -$Config{'castflags'} = '0'; -$Config{'d_castneg'} = 'define'; -$Config{'d_charsprf'} = 'define'; -$Config{'d_chsize'} = undef; -$Config{'d_const'} = undef; -$Config{'cryptlib'} = ''; -$Config{'d_crypt'} = 'define'; -$Config{'d_csh'} = 'define'; -$Config{'d_dosuid'} = undef; -$Config{'d_dup2'} = 'define'; -$Config{'d_fchmod'} = 'define'; -$Config{'d_fchown'} = 'define'; -$Config{'d_fcntl'} = 'define'; -$Config{'d_flexfnam'} = 'define'; -$Config{'d_flock'} = 'define'; -$Config{'d_getgrps'} = 'define'; -$Config{'d_gethent'} = undef; -$Config{'aphostname'} = ''; -$Config{'d_gethname'} = undef; -$Config{'d_phostname'} = undef; -$Config{'d_uname'} = 'define'; -$Config{'d_getpgrp2'} = undef; -$Config{'d_getpgrp'} = 'define'; -$Config{'d_getprior'} = 'define'; -$Config{'d_htonl'} = 'define'; -$Config{'d_isascii'} = 'define'; -$Config{'d_killpg'} = 'define'; -$Config{'d_link'} = 'define'; -$Config{'d_lstat'} = 'define'; -$Config{'d_memcmp'} = 'define'; -$Config{'d_memcpy'} = 'define'; -$Config{'d_memmove'} = undef; -$Config{'d_memset'} = 'define'; -$Config{'d_mkdir'} = 'define'; -$Config{'d_msg'} = 'define'; -$Config{'d_msgctl'} = 'define'; -$Config{'d_msgget'} = 'define'; -$Config{'d_msgrcv'} = 'define'; -$Config{'d_msgsnd'} = 'define'; -$Config{'d_open3'} = 'define'; -$Config{'d_portable'} = undef; -$Config{'d_readdir'} = 'define'; -$Config{'d_rewinddir'} = 'define'; -$Config{'d_seekdir'} = 'define'; -$Config{'d_telldir'} = 'define'; -$Config{'d_rename'} = 'define'; -$Config{'d_rmdir'} = 'define'; -$Config{'d_safebcpy'} = 'define'; -$Config{'d_safemcpy'} = undef; -$Config{'d_select'} = 'define'; -$Config{'d_sem'} = 'define'; -$Config{'d_semctl'} = 'define'; -$Config{'d_semget'} = 'define'; -$Config{'d_semop'} = 'define'; -$Config{'d_setegid'} = 'define'; -$Config{'d_seteuid'} = 'define'; -$Config{'d_setlocale'} = 'define'; -$Config{'d_setpgid'} = 'define'; -$Config{'d_setpgrp2'} = undef; -$Config{'d_bsdpgrp'} = ''; -$Config{'d_setpgrp'} = 'define'; -$Config{'d_setprior'} = 'define'; -$Config{'d_setregid'} = 'define'; -$Config{'d_setresgid'} = undef; -$Config{'d_setresuid'} = undef; -$Config{'d_setreuid'} = 'define'; -$Config{'d_setrgid'} = 'define'; -$Config{'d_setruid'} = 'define'; -$Config{'d_setsid'} = 'define'; -$Config{'d_shm'} = 'define'; -$Config{'d_shmat'} = 'define'; -$Config{'d_voidshmat'} = undef; -$Config{'d_shmctl'} = 'define'; -$Config{'d_shmdt'} = 'define'; -$Config{'d_shmget'} = 'define'; -$Config{'d_oldsock'} = undef; -$Config{'d_socket'} = 'define'; -$Config{'d_sockpair'} = 'define'; -$Config{'sockethdr'} = ''; -$Config{'socketlib'} = ''; -$Config{'d_statblks'} = 'define'; -$Config{'d_stdstdio'} = 'define'; -$Config{'d_index'} = undef; -$Config{'d_strchr'} = 'define'; -$Config{'d_strctcpy'} = 'define'; -$Config{'d_strerrm'} = 'define'; -$Config{'d_strerror'} = undef; -$Config{'d_sysernlst'} = ''; -$Config{'d_syserrlst'} = 'define'; -$Config{'d_symlink'} = 'define'; -$Config{'d_syscall'} = 'define'; -$Config{'d_system'} = 'define'; -$Config{'d_time'} = 'define'; -$Config{'timetype'} = 'long'; -$Config{'clocktype'} = 'long'; -$Config{'d_times'} = 'define'; -$Config{'d_truncate'} = 'define'; -$Config{'d_usendir'} = undef; -$Config{'i_ndir'} = undef; -$Config{'ndirc'} = ''; -$Config{'ndirlib'} = ''; -$Config{'ndiro'} = ''; -$Config{'d_vfork'} = undef; -$Config{'d_voidsig'} = 'define'; -$Config{'signal_t'} = 'void'; -$Config{'d_volatile'} = undef; -$Config{'d_charvspr'} = 'define'; -$Config{'d_vprintf'} = 'define'; -$Config{'d_wait4'} = 'define'; -$Config{'d_waitpid'} = 'define'; -$Config{'cccdlflags'} = ''; -$Config{'ccdlflags'} = ''; -$Config{'dldir'} = 'ext/dl'; -$Config{'dlobj'} = 'dl_sunos.o'; -$Config{'dlsrc'} = 'dl_sunos.c'; -$Config{'lddlflags'} = ''; -$Config{'shlibsuffix'} = '.so'; -$Config{'usedl'} = 'define'; -$Config{'gidtype'} = 'gid_t'; -$Config{'groupstype'} = 'int'; -$Config{'h_fcntl'} = 'false'; -$Config{'h_sysfile'} = 'true'; -$Config{'i_dbm'} = 'define'; -$Config{'d_dirnamlen'} = undef; -$Config{'i_dirent'} = 'define'; -$Config{'i_dlfcn'} = 'define'; -$Config{'i_fcntl'} = undef; -$Config{'i_gdbm'} = undef; -$Config{'i_grp'} = 'define'; -$Config{'i_memory'} = 'define'; -$Config{'i_ndbm'} = 'define'; -$Config{'i_neterrno'} = undef; -$Config{'i_niin'} = 'define'; -$Config{'i_sysin'} = undef; -$Config{'d_pwage'} = 'define'; -$Config{'d_pwchange'} = undef; -$Config{'d_pwclass'} = undef; -$Config{'d_pwcomment'} = 'define'; -$Config{'d_pwexpire'} = undef; -$Config{'d_pwquota'} = undef; -$Config{'i_pwd'} = 'define'; -$Config{'i_sdbm'} = 'define'; -$Config{'i_stdarg'} = undef; -$Config{'i_stddef'} = 'define'; -$Config{'i_string'} = 'define'; -$Config{'strings'} = '/usr/include/string.h'; -$Config{'i_sysdir'} = 'define'; -$Config{'i_sysfile'} = 'define'; -$Config{'d_voidtty'} = ''; -$Config{'i_bsdioctl'} = ''; -$Config{'i_sysioctl'} = 'define'; -$Config{'i_syssockio'} = ''; -$Config{'i_sysndir'} = undef; -$Config{'i_sysselct'} = undef; -$Config{'i_sgtty'} = undef; -$Config{'i_termio'} = undef; -$Config{'i_termios'} = 'define'; -$Config{'i_systime'} = 'define'; -$Config{'i_systimek'} = undef; -$Config{'i_time'} = undef; -$Config{'timeincl'} = '/usr/include/sys/time.h '; -$Config{'i_unistd'} = 'define'; -$Config{'i_utime'} = 'define'; -$Config{'i_varargs'} = 'define'; -$Config{'i_varhdr'} = 'varargs.h'; -$Config{'i_vfork'} = undef; -$Config{'intsize'} = '4'; -$Config{'lib'} = '/usr/local/lib'; -$Config{'libexp'} = '/usr/local/lib'; -$Config{'libc'} = '/usr/lib/libc.so.1.8.1'; -$Config{'libpth'} = ' /lib /usr/lib /usr/ucblib /usr/local/lib'; -$Config{'plibpth'} = ''; -$Config{'xlibpth'} = '/usr/lib/386 /lib/386'; -$Config{'libs'} = '-ldbm -ldl -lm -lposix'; -$Config{'lns'} = '/bin/ln -s'; -$Config{'lseektype'} = 'off_t'; -$Config{'d_mymalloc'} = 'define'; -$Config{'mallocobj'} = 'malloc.o'; -$Config{'mallocsrc'} = 'malloc.c'; -$Config{'malloctype'} = 'char *'; -$Config{'usemymalloc'} = 'y'; -$Config{'installmansrc'} = '/usr/local/man/man1'; -$Config{'manext'} = '1'; -$Config{'mansrc'} = '/usr/local/man/man1'; -$Config{'mansrcexp'} = '/usr/local/man/man1'; -$Config{'huge'} = ''; -$Config{'large'} = ''; -$Config{'medium'} = ''; -$Config{'models'} = 'none'; -$Config{'small'} = ''; -$Config{'split'} = ''; -$Config{'mydomain'} = ''; -$Config{'myhostname'} = 'scalpel'; -$Config{'phostname'} = 'hostname'; -$Config{'c'} = ''; -$Config{'n'} = '-n'; -$Config{'groupcat'} = ''; -$Config{'hostcat'} = 'ypcat hosts'; -$Config{'passcat'} = ''; -$Config{'orderlib'} = 'false'; -$Config{'ranlib'} = '/usr/bin/ranlib'; -$Config{'package'} = 'perl'; -$Config{'spackage'} = ''; -$Config{'installprivlib'} = '/usr/local/lib/perl'; -$Config{'privlib'} = '/usr/local/lib/perl'; -$Config{'privlibexp'} = '/usr/local/lib/perl'; -$Config{'prototype'} = undef; -$Config{'ptrsize'} = '4'; -$Config{'randbits'} = '31'; -$Config{'installscript'} = '/usr/local/bin'; -$Config{'scriptdir'} = '/usr/local/bin'; -$Config{'scriptdirexp'} = '/usr/local/bin'; -$Config{'sig_name'} = 'ZERO HUP INT QUIT ILL TRAP ABRT EMT FPE KILL BUS SEGV SYS PIPE ALRM TERM URG STOP TSTP CONT CLD TTIN TTOU IO XCPU XFSZ VTALRM PROF WINCH LOST USR1 USR2'; -$Config{'sharpbang'} = '#!'; -$Config{'shsharp'} = 'true'; -$Config{'spitshell'} = 'cat'; -$Config{'startsh'} = '#!/bin/sh'; -$Config{'stdchar'} = 'unsigned char'; -$Config{'sysman'} = '/usr/man/man1'; -$Config{'uidtype'} = 'uid_t'; -$Config{'nm_opt'} = ''; -$Config{'runnm'} = 'true'; -$Config{'usenm'} = 'true'; -$Config{'incpath'} = ''; -$Config{'mips'} = ''; -$Config{'mips_type'} = ''; -$Config{'usrinc'} = '/usr/include'; -$Config{'defvoidused'} = '15'; -$Config{'voidflags'} = '15'; -$Config{'yacc'} = 'yacc'; -$Config{'yaccflags'} = ''; -$Config{'PATCHLEVEL'} = 0; -$Config{'CONFIG'} = 'true'; -1; diff --git a/lib/Cwd.pm b/lib/Cwd.pm new file mode 100644 index 0000000..719d1d2 --- /dev/null +++ b/lib/Cwd.pm @@ -0,0 +1,161 @@ +package Cwd; +require 5.000; +require Exporter; + +@ISA = qw(Exporter); +@EXPORT = qw(getcwd fastcwd); +@EXPORT_OK = qw(chdir); + + +# By Brandon S. Allbery +# +# Usage: $cwd = getcwd(); + +sub getcwd +{ + my($dotdots, $cwd, @pst, @cst, $dir, @tst); + + unless (@cst = stat('.')) + { + warn "stat(.): $!"; + return ''; + } + $cwd = ''; + do + { + $dotdots .= '/' if $dotdots; + $dotdots .= '..'; + @pst = @cst; + unless (opendir(PARENT, $dotdots)) + { + warn "opendir($dotdots): $!"; + return ''; + } + unless (@cst = stat($dotdots)) + { + warn "stat($dotdots): $!"; + closedir(PARENT); + return ''; + } + if ($pst[0] == $cst[0] && $pst[1] == $cst[1]) + { + $dir = ''; + } + else + { + do + { + unless ($dir = readdir(PARENT)) + { + warn "readdir($dotdots): $!"; + closedir(PARENT); + return ''; + } + unless (@tst = lstat("$dotdots/$dir")) + { + warn "lstat($dotdots/$dir): $!"; + closedir(PARENT); + return ''; + } + } + while ($dir eq '.' || $dir eq '..' || $tst[0] != $pst[0] || + $tst[1] != $pst[1]); + } + $cwd = "$dir/$cwd"; + closedir(PARENT); + } while ($dir); + chop($cwd); + $cwd; +} + + + +# By John Bazik +# +# Usage: $cwd = &fastcwd; +# +# This is a faster version of getcwd. It's also more dangerous because +# you might chdir out of a directory that you can't chdir back into. + +sub fastcwd { + my($odev, $oino, $cdev, $cino, $tdev, $tino); + my(@path, $path); + local(*DIR); + + ($cdev, $cino) = stat('.'); + for (;;) { + ($odev, $oino) = ($cdev, $cino); + chdir('..'); + ($cdev, $cino) = stat('.'); + last if $odev == $cdev && $oino == $cino; + opendir(DIR, '.'); + for (;;) { + $_ = readdir(DIR); + next if $_ eq '.'; + next if $_ eq '..'; + + last unless $_; + ($tdev, $tino) = lstat($_); + last unless $tdev != $odev || $tino != $oino; + } + closedir(DIR); + unshift(@path, $_); + } + chdir($path = '/' . join('/', @path)); + $path; +} + + +# keeps track of current working directory in PWD environment var +# +# $RCSfile: pwd.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:11 $ +# +# $Log: pwd.pl,v $ +# +# Usage: +# use Cwd 'chdir'; +# chdir $newdir; + +$chdir_init = 0; + +sub chdir_init{ + if ($ENV{'PWD'}) { + my($dd,$di) = stat('.'); + my($pd,$pi) = stat($ENV{'PWD'}); + if (!defined $dd or !defined $pd or $di != $pi or $dd != $pd) { + chop($ENV{'PWD'} = `pwd`); + } + } + else { + chop($ENV{'PWD'} = `pwd`); + } + if ($ENV{'PWD'} =~ m|(/[^/]+(/[^/]+/[^/]+))(.*)|) { + my($pd,$pi) = stat($2); + my($dd,$di) = stat($1); + if (defined $pd and defined $dd and $di == $pi and $dd == $pd) { + $ENV{'PWD'}="$2$3"; + } + } + $chdir_init = 1; +} + +sub chdir { + my($newdir) = shift; + chdir_init() unless $chdir_init; + return 0 unless (CORE::chdir $newdir); + if ($newdir =~ m#^/#) { + $ENV{'PWD'} = $newdir; + }else{ + my(@curdir) = split(m#/#,$ENV{'PWD'}); + @curdir = '' unless @curdir; + foreach $component (split(m#/#, $newdir)) { + next if $component eq '.'; + pop(@curdir),next if $component eq '..'; + push(@curdir,$component); + } + $ENV{'PWD'} = join('/',@curdir) || '/'; + } +} + +1; + diff --git a/lib/English.pm b/lib/English.pm index 79cceee..b203721 100644 --- a/lib/English.pm +++ b/lib/English.pm @@ -3,6 +3,8 @@ package English; require Exporter; @ISA = (Exporter); +local($^W) = 0; + @EXPORT = qw( *ARG $MATCH @@ -30,6 +32,7 @@ require Exporter; $FORMAT_FORMFEED $CHILD_ERROR $OS_ERROR + $ERRNO $EVAL_ERROR $PROCESS_ID $PID @@ -101,6 +104,7 @@ require Exporter; *CHILD_ERROR = \$? ; *OS_ERROR = \$! ; + *ERRNO = \$! ; *EVAL_ERROR = \$@ ; # Process info. @@ -131,8 +135,8 @@ require Exporter; # Deprecated. - *ARRAY_BASE = \$[ ; - *OFMT = \$# ; - *MULTILINE_MATCHING = \$* ; +# *ARRAY_BASE = \$[ ; +# *OFMT = \$# ; +# *MULTILINE_MATCHING = \$* ; 1; diff --git a/lib/Env.pm b/lib/Env.pm new file mode 100644 index 0000000..2187090 --- /dev/null +++ b/lib/Env.pm @@ -0,0 +1,69 @@ +package Env; + +=head1 NAME + +Env - Perl module that imports environment variables + +=head1 DESCRIPTION + +Perl maintains environment variables in a pseudo-associative-array +named %ENV. For when this access method is inconvenient, the Perl +module C allows environment variables to be treated as simple +variables. + +The Env::import() function ties environment variables with suitable +names to global Perl variables with the same names. By default it +does so with all existing environment variables (C). If +the import function receives arguments, it takes them to be a list of +environment variables to tie; it's okay if they don't yet exist. + +After an environment variable is tied, merely use it like a normal variable. +You may access its value + + @path = split(/:/, $PATH); + +or modify it + + $PATH .= ":."; + +however you'd like. +To remove a tied environment variable from +the environment, assign it the undefined value + + undef $PATH; + +=head1 AUTHOR + +Chip Salzenberg + +=cut + +sub import { + my ($callpack) = caller(0); + my $pack = shift; + my @vars = @_ ? @_ : keys(%ENV); + + foreach (@vars) { + tie ${"${callpack}::$_"}, Env, $_ if /^[A-Za-z_]\w*$/; + } +} + +sub TIESCALAR { + bless \($_[1]); +} + +sub FETCH { + my ($self) = @_; + $ENV{$$self}; +} + +sub STORE { + my ($self, $value) = @_; + if (defined($value)) { + $ENV{$$self} = $value; + } else { + delete $ENV{$$self}; + } +} + +1; diff --git a/lib/Exporter.pm b/lib/Exporter.pm index 0b021b3..dce6909 100644 --- a/lib/Exporter.pm +++ b/lib/Exporter.pm @@ -2,9 +2,11 @@ package Exporter; require 5.000; -sub import { - my ($callpack, $callfile, $callline) = caller($ExportLevel); +$ExportLevel = 0; + +sub export { my $pack = shift; + my $callpack = shift; my @imports = @_; *exports = \@{"${pack}::EXPORT"}; if (@imports) { @@ -14,11 +16,14 @@ sub import { if (!%exports) { grep(s/^&//, @exports); @exports{@exports} = (1) x @exports; + foreach $extra (@{"${pack}::EXPORT_OK"}) { + $exports{$extra} = 1; + } } foreach $sym (@imports) { if (!$exports{$sym}) { if ($sym !~ s/^&// || !$exports{$sym}) { - warn "$sym is not exported by the $pack module ", + warn qq["$sym" is not exported by the $pack module ], "at $callfile line $callline\n"; $oops++; next; @@ -43,4 +48,10 @@ sub import { } }; +sub import { + local ($callpack, $callfile, $callline) = caller($ExportLevel); + my $pack = shift; + export $pack, $callpack, @_; +} + 1; diff --git a/lib/ExtUtils/MakeMaker.pm b/lib/ExtUtils/MakeMaker.pm new file mode 100644 index 0000000..563241f --- /dev/null +++ b/lib/ExtUtils/MakeMaker.pm @@ -0,0 +1,694 @@ +package ExtUtils::MakeMaker; + +# Authors: Andy Dougherty +# Andreas Koenig +# Tim Bunce + +# Last Revision: 12 Oct 1994 + +# This utility is designed to write a Makefile for an extension +# module from a Makefile.PL. It is based on the excellent Makefile.SH +# model provided by Andy Dougherty and the perl5-porters. + +# It splits the task of generating the Makefile into several +# subroutines that can be individually overridden. +# Each subroutine returns the text it wishes to have written to +# the Makefile. + +use Config; +require Exporter; +@ISA = qw(Exporter); +@EXPORT = qw(writeMakefile mkbootstrap $Verbose); +@EXPORT_OK = qw(%att @recognized_att_keys); + +use strict qw(refs); + +# Setup dummy package: +# MY exists for overriding methods to be defined within +unshift(@MY::ISA, qw(MM)); + +$Verbose = 0; +$Subdirs = 0; # set to 1 to have this .PL run all below +$^W=1; + + +# For most extensions it will do to call +# +# use ExtUtils::MakeMaker +# &writeMakefile("potential_libs" => "-L/usr/alpha -lfoo -lbar"); +# +# from Makefile.PL in the extension directory +# It is also handy to include some of the following attributes: +# +@recognized_att_keys=qw( + TOP INC DISTNAME VERSION DEFINE OBJECT LDTARGET ARMAYBE + BACKUP_LIBS AUTOSPLITMAXLEN LINKTYPE + potential_libs otherldflags perl fullperl + distclean_tarflags + clean_files realclean_files +); + +# +# TOP is the directory above lib/ and ext/ (normally ../..) +# (MakeMaker will normally work this out for itself) +# INC is something like "-I/usr/local/Minerva/include" +# DISTNAME is a name of your choice for distributing the package +# VERSION is your version number +# DEFINE is something like "-DHAVE_UNISTD_H" +# OBJECT defaults to '$(BASEEXT).o', but can be a long string containing +# all object files, e.g. "tkpBind.o tkpButton.o tkpCanvas.o" +# LDTARGET defaults to $(OBJECT) and is used in the ld command +# (some machines need additional switches for bigger projects) +# ARMAYBE defaults to ":", but can be used to run ar before ld +# BACKUP_LIBS is an anonymous array of libraries to be searched for +# until we get at least some output from ext/util/extliblist +# 'potential_libs' => "-lgdbm", +# 'BACKUP_LIBS' => [ "-ldbm -lfoo", "-ldbm.nfs" ] +# AUTOSPLITMAXLEN defaults to 8 and is used when autosplit is done +# (can be set higher on a case-by-case basis) +# defaults to `dynamic', can be set to `static' + +# +# `make distclean' builds $(DISTNAME)-$(VERSION).tar.Z after a clean + +# Be aware, that you can also pass attributes into the %att hash table +# by calling Makefile.PL with an argument of the form TOP=/some/where. + +# If the Makefile generated by default does not fit your purpose, +# you may specify private subroutines in the Makefile.PL as there are: +# +# MY->initialize => sub MY::initialize{ ... } +# MY->post_initialize => sub MY::post_initialize{ ... } +# MY->constants => etc +# MY->dynamic +# etc. (see function writeMakefile, for the current breakpoints) +# +# Each subroutines returns the text it wishes to have written to +# the Makefile. To override a section of the Makefile you can +# either say: sub MY::co { "new literal text" } +# or you can edit the default by saying something like: +# sub MY::co { $_=MM->co; s/old text/new text/; $_ } +# +# If you still need a different solution, try to develop another +# subroutine, that fits your needs and submit the diffs to +# perl5-porters or comp.lang.perl as appropriate. + +sub writeMakefile { + %att = @_; + local($\)="\n"; + + foreach (@ARGV){ + $att{$1}=$2 if m/(.*)=(.*)/; + } + print STDOUT "MakeMaker" if $Verbose; + print STDOUT map(" $_ = '$att{$_}'\n", sort keys %att) if ($Verbose && %att); + + MY->initialize(); + + print STDOUT "Writing ext/$att{FULLEXT}/Makefile (with variable substitutions)"; + + open MAKE, ">Makefile" or die "Unable to open Makefile: $!"; + + MY->mkbootstrap(split(" ", $att{'dynaloadlibs'})); + print MAKE MY->post_initialize; + + print MAKE MY->constants; + print MAKE MY->post_constants; + + print MAKE MY->subdir if $Subdirs; + print MAKE MY->dynamic; + print MAKE MY->force; + print MAKE MY->static; + print MAKE MY->co; + print MAKE MY->c; + print MAKE MY->installpm; + print MAKE MY->clean; + print MAKE MY->realclean; + print MAKE MY->test; + print MAKE MY->install; + print MAKE MY->perldepend; + print MAKE MY->distclean; + print MAKE MY->postamble; + + MY->finish; + + close MAKE; + + 1; +} + + +sub mkbootstrap{ + MY->mkbootstrap(@_) +} + + +sub avoid_typo_warnings{ + local($t) = "$t + $main::writeMakefile + $main::mkbootstrap + $main::Verbose + $DynaLoader::dl_resolve_using + $ExtUtils::MakeMaker::Config + $DynaLoader::Config + "; +} + + +# --- Supply the MakeMaker default methods --- + +package MM; + +use Config; +require Exporter; + +Exporter::import('ExtUtils::MakeMaker', qw(%att @recognized_att_keys)); + +# These attributes cannot be overridden +@other_att_keys=qw(extralibs dynaloadlibs statloadlibs bootdep); + + +sub find_perl{ + my($self, $ver, $names, $dirs, $trace) = @_; + my($name, $dir); + print "Looking for perl $ver by these names: @$names, in these dirs: @$dirs\n" + if ($trace); + foreach $dir (@$dirs){ + foreach $name (@$names){ + print "checking $dir/$name\n" if ($trace >= 2); + next unless -x "$dir/$name"; + print "executing $dir/$name\n" if ($trace); + my($out) = `$dir/$name -e 'require $ver; print "5OK\n" ' 2>&1`; + return "$dir/$name" if $out =~ /5OK/; + } + } + warn "Unable to find a perl $ver (by these names: @$names, in these dirs: @$dirs)\n"; + 0; # false and not empty +} + + +sub initialize { + # Find out directory name. This is also the extension name. + chop($pwd=`pwd`); + + unless ( $top = $att{TOP} ){ + foreach(qw(../.. ../../.. ../../../..)){ + ($top=$_, last) if -f "$_/config.sh"; + } + die "Can't find config.sh" unless -f "$top/config.sh"; + } + chdir $top or die "Couldn't chdir $top: $!"; + chop($abstop=`pwd`); + chdir $pwd; + + # EXTMODNAME = The perl module name for this extension. + # FULLEXT = Full pathname to extension directory. + # BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. + # ROOTEXT = Directory part of FULLEXT. May be empty. + my($p) = $pwd; $p =~ s:^\Q$abstop/ext/\E::; + ($att{EXTMODNAME}=$p) =~ s#/#::#g ; #eg. BSD::Foo::Socket + ($att{FULLEXT} =$p); #eg. BSD/Foo/Socket + ($att{BASEEXT} =$p) =~ s:.*/:: ; #eg. Socket + ($att{ROOTEXT} =$p) =~ s:/?\Q$att{BASEEXT}\E$:: ; #eg. BSD/Foo + + # Find Perl 5. The only contract here is that both 'perl' and 'fullperl' + # will be working versions of perl 5. + $att{'perl'} = MY->find_perl(5.0, [ qw(perl5 perl miniperl) ], + [ $abstop, split(":", $ENV{PATH}) ], 0 ) + unless ($att{'perl'} && -x $att{'perl'}); + + # Define 'fullperl' to be a non-miniperl (used in test: target) + ($att{'fullperl'} = $att{'perl'}) =~ s/miniperl$/perl/ + unless ($att{'fullperl'} && -x $att{'fullperl'}); + + for $key (@recognized_att_keys, @other_att_keys){ + # avoid warnings for uninitialized vars + $att{$key} = "" unless defined $att{$key}; + } + + # compute extralibs, dynaloadlibs and statloadlibs from + # $att{'potential_libs'} + + unless ( &run_extliblist($att{'potential_libs'}) ){ + foreach ( @{$att{'BACKUP_LIBS'} || []} ){ + # Try again. Maybe they have specified some other libraries + last if &run_extliblist($_); + } + } +} + + +sub run_extliblist { + my($potential_libs)=@_; + # Now run ext/util/extliblist to discover what *libs definitions + # are required for the needs of $potential_libs + $ENV{'potential_libs'} = $potential_libs; + $_=`. $abstop/ext/util/extliblist; + echo extralibs=\$extralibs + echo dynaloadlibs=\$dynaloadlibs + echo statloadlibs=\$statloadlibs + echo bootdep=\$bootdep + `; + my(@w); + foreach $line (split "\n", $_){ + chomp $line; + if ($line =~ /(.*)\s*=\s*(.*)$/){ + $att{$1} = $2; + print STDERR " $1 = $2" if $Verbose; + }else{ + push(@w, $line); + } + } + print STDERR "Messages from extliblist:\n", join("\n",@w,'') + if @w ; + join '', @att{qw(extralibs dynaloadlibs statloadlibs)}; +} + + +sub post_initialize{ + ""; +} + + +sub constants { + my(@m); + + $att{BOOTDEP} = (-f "$att{BASEEXT}_BS") ? "$att{BASEEXT}_BS" : ""; + $att{OBJECT} = '$(BASEEXT).o' unless $att{OBJECT}; + $att{LDTARGET} = '$(OBJECT)' unless $att{LDTARGET}; + $att{ARMAYBE} = ":" unless $att{ARMAYBE}; + $att{AUTOSPLITMAXLEN} = 8 unless $att{AUTOSPLITMAXLEN}; + $att{LINKTYPE} = ($Config{'usedl'}) ? 'dynamic' : 'static' + unless $att{LINKTYPE}; + + + push @m, " +# +# This Makefile is for the $att{FULLEXT} extension to perl. +# It was written by Makefile.PL, so don't edit it, edit +# Makefile.PL instead. ANY CHANGES MADE HERE WILL BE LOST! +# + +DISTNAME = $att{DISTNAME} +VERSION = $att{VERSION} + +TOP = $top +ABSTOP = $abstop +PERL = $att{'perl'} +FULLPERL = $att{'fullperl'} +INC = $att{INC} +DEFINE = $att{DEFINE} +OBJECT = $att{OBJECT} +LDTARGET = $att{LDTARGET} +"; + + push @m, " +CC = $Config{'cc'} +LIBC = $Config{'libc'} +LDFLAGS = $Config{'ldflags'} +CLDFLAGS = $Config{'ldflags'} +LINKTYPE = $att{LINKTYPE} +ARMAYBE = $att{ARMAYBE} +RANLIB = $Config{'ranlib'} + +SMALL = $Config{'small'} +LARGE = $Config{'large'} $Config{'split'} +# The following are used to build and install shared libraries for +# dynamic loading. +LDDLFLAGS = $Config{'lddlflags'} +CCDLFLAGS = $Config{'ccdlflags'} +CCCDLFLAGS = $Config{'cccdlflags'} +SO = $Config{'so'} +DLEXT = $Config{'dlext'} +DLSRC = $Config{'dlsrc'} +"; + + push @m, " +# $att{FULLEXT} might need to be linked with some extra libraries. +# EXTRALIBS = full list of libraries needed for static linking. +# Only those libraries that actually exist are included. +# DYNALOADLIBS = list of those libraries that are needed but can be +# linked in dynamically on this platform. On SunOS, for +# example, this would be .so* libraries, but not archive +# libraries. The bootstrap file is installed only if +# this list is not empty. +# STATLOADLIBS = list of those libraries which must be statically +# linked into the shared library. On SunOS 4.1.3, +# for example, I have only an archive version of +# -lm, and it must be linked in statically. +EXTRALIBS = $att{'extralibs'} +DYNALOADLIBS = $att{'dynaloadlibs'} +STATLOADLIBS = $att{'statloadlibs'} + +"; + + push @m, " +# EXTMODNAME = The perl module name for this extension. +# FULLEXT = Full pathname to extension directory. +# BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. +# ROOTEXT = Directory part of FULLEXT. May be empty. +EXTMODNAME = $att{EXTMODNAME} +FULLEXT = $att{FULLEXT} +BASEEXT = $att{BASEEXT} +ROOTEXT = $att{ROOTEXT} +# and for backward compatibility and for AIX support (due to change!) +EXT = $att{BASEEXT} + +# $att{FULLEXT} might have its own typemap +EXTTYPEMAP = ".(-f "typemap" ? "typemap" : "")." +# $att{FULLEXT} might have its own bootstrap support +BOOTSTRAP = $att{BASEEXT}.bs +BOOTDEP = $att{BOOTDEP} +"; + + push @m, ' +# Where to put things: +AUTO = $(TOP)/lib/auto +AUTOEXT = $(TOP)/lib/auto/$(FULLEXT) +INST_BOOT = $(AUTOEXT)/$(BASEEXT).bs +INST_DYNAMIC = $(AUTOEXT)/$(BASEEXT).$(DLEXT) +INST_STATIC = $(BASEEXT).a +INST_PM = $(TOP)/lib/$(FULLEXT).pm +'." +# These two are only used by install: targets +INSTALLPRIVLIB = $Config{'installprivlib'} +INSTALLARCHLIB = $Config{'installarchlib'} +"; + + push @m, "\nshellflags = $Config{'shellflags'}" if $Config{'shellflags'}; + + push @m, q{ +# Tools +SHELL = /bin/sh +CCCMD = `sh $(shellflags) $(ABSTOP)/cflags $@` +XSUBPP = $(TOP)/ext/xsubpp +# the following is a portable way to say mkdir -p +MKPATH = $(PERL) -we '$$"="/"; foreach(split(/\//,$$ARGV[0])){ push(@p, $$_); next if -d "@p"; print "mkdir @p\n"; mkdir("@p",0777)||die "mkdir @p: $$!" } exit 0;' +AUTOSPLITLIB = cd $(TOP); \ + $(PERL) -Ilib -e 'use AutoSplit; $$AutoSplit::Maxlen=}.$att{AUTOSPLITMAXLEN}.q{; autosplit_lib_modules(@ARGV) ;' +}; + + push @m, ' + +all :: + +config :: Makefile + @$(MKPATH) $(AUTOEXT) + +install :: + +'; + + join('',@m); +} + + +sub post_constants{ + ""; +} + + +sub subdir { + my(@m); + foreach $MakefilePL (<*/Makefile.PL>){ + ($subdir=$MakefilePL) =~ s:/Makefile\.PL$:: ; + push @m, " +config :: + \@cd $subdir ; \\ + if test ! -f Makefile; then \\ + test -f Makefile.PL && \$(PERL) -I\$(ABSTOP)/lib Makefile.PL TOP=\$(ABSTOP) ; \\ + fi + +all :: + cd $subdir ; \$(MAKE) config + cd $subdir ; \$(MAKE) all +"; + + } + join('',@m); +} + + +sub co { + ' +.c.o: + $(CCCMD) $(CCCDLFLAGS) $(DEFINE) -I$(TOP) $(INC) $*.c +'; +} + + +sub force { + ' +# Phony target to force checking subdirectories. +FORCE: +'; +} + + +sub dynamic { + ' +all:: $(LINKTYPE) + +# Target for Dynamic Loading: +dynamic:: $(INST_DYNAMIC) $(INST_PM) $(INST_BOOT) + +$(INST_DYNAMIC): $(OBJECT) + @$(MKPATH) $(AUTOEXT) + $(ARMAYBE) cr $(EXTMODNAME).a $(OBJECT) + ld $(LDDLFLAGS) -o $@ $(LDTARGET) '.$att{'otherldflags'}.' $(STATLOADLIBS) + +$(BOOTSTRAP): $(BOOTDEP) + $(PERL) -I$(TOP)/lib -e \'use ExtUtils::MakeMaker; &mkbootstrap("$(DYNALOADLIBS)");\' + touch $(BOOTSTRAP) + +$(INST_BOOT): $(BOOTSTRAP) + @test ! -s $(BOOTSTRAP) || cp $(BOOTSTRAP) $@ +'; +} + + +sub static { + ' +# Target for Static Loading: +static:: $(INST_STATIC) $(INST_PM) + +$(INST_STATIC): $(OBJECT) + ar cr $@ $(OBJECT) + $(RANLIB) $@ + echo $(EXTRALIBS) >> $(TOP)/ext.libs +'; +} + + +sub c { + ' +$(BASEEXT).c: $(BASEEXT).xs $(XSUBPP) $(TOP)/ext/typemap $(EXTTYPEMAP) $(TOP)/cflags + $(PERL) $(XSUBPP) $(BASEEXT).xs >tmp + mv tmp $@ +'; +} + + +sub installpm { + ' +$(INST_PM): $(BASEEXT).pm + @$(MKPATH) $(TOP)/lib/$(ROOTEXT) + rm -f $@ + cp $(BASEEXT).pm $@ + @$(AUTOSPLITLIB) $(EXTMODNAME) +'; +} + + +sub clean { + ' +clean:: + rm -f *.o *.a mon.out core $(BASEEXT).c so_locations + rm -f makefile Makefile $(BOOTSTRAP) $(BASEEXT).bso '.$att{'clean_files'}.' +'; +} + + +sub realclean { + ' +realclean:: clean + rm -f $(INST_DYNAMIC) $(INST_STATIC) $(INST_BOOT) + rm -rf $(INST_PM) $(AUTOEXT) '.$att{'realclean_files'}.' + +purge: realclean +'; +} + + +sub test { + ' +test: all + $(FULLPERL) -I$(TOP)/lib -e \'use Test::Harness; runtests @ARGV;\' t/*.t +'; +} + + +sub install { + ' +# used if installperl will not be installing it for you +install:: all + # not yet defined +'; +} + + +sub distclean { + my($tarflags) = $att{'distclean_tarflags'} || 'cvf'; + ' +distclean: clean + rm -f Makefile *~ t/*~ + cd ..; tar '.$tarflags.' "$(DISTNAME)-$(VERSION).tar" $(BASEEXT) + cd ..; compress "$(DISTNAME)-$(VERSION).tar" +'; +} + + +sub perldepend { + ' +$(OBJECT) : Makefile +$(OBJECT) : $(TOP)/EXTERN.h +$(OBJECT) : $(TOP)/INTERN.h +$(OBJECT) : $(TOP)/XSUB.h +$(OBJECT) : $(TOP)/av.h +$(OBJECT) : $(TOP)/cop.h +$(OBJECT) : $(TOP)/cv.h +$(OBJECT) : $(TOP)/dosish.h +$(OBJECT) : $(TOP)/embed.h +$(OBJECT) : $(TOP)/form.h +$(OBJECT) : $(TOP)/gv.h +$(OBJECT) : $(TOP)/handy.h +$(OBJECT) : $(TOP)/hv.h +$(OBJECT) : $(TOP)/keywords.h +$(OBJECT) : $(TOP)/mg.h +$(OBJECT) : $(TOP)/op.h +$(OBJECT) : $(TOP)/opcode.h +$(OBJECT) : $(TOP)/patchlevel.h +$(OBJECT) : $(TOP)/perl.h +$(OBJECT) : $(TOP)/perly.h +$(OBJECT) : $(TOP)/pp.h +$(OBJECT) : $(TOP)/proto.h +$(OBJECT) : $(TOP)/regcomp.h +$(OBJECT) : $(TOP)/regexp.h +$(OBJECT) : $(TOP)/scope.h +$(OBJECT) : $(TOP)/sv.h +$(OBJECT) : $(TOP)/unixish.h +$(OBJECT) : $(TOP)/util.h +$(TOP)/config.h: $(TOP)/config.sh; cd $(TOP); /bin/sh config_h.SH +$(TOP)/embed.h: $(TOP)/config.sh; cd $(TOP); /bin/sh embed_h.SH +$(TOP)/cflags: $(TOP)/config.sh; cd $(TOP); /bin/sh cflags.SH + +Makefile: Makefile.PL + $(PERL) -I$(TOP)/lib Makefile.PL +'; +} + + +sub postamble{ + ""; +} + + +sub finish { + chmod 0644, "Makefile"; + system("$Config{'eunicefix'} Makefile") unless $Config{'eunicefix'} eq ":"; +} + + + +sub mkbootstrap { +# +# mkbootstrap, by: +# +# Andreas Koenig +# Tim Bunce +# Andy Dougherty +# +# This perl script attempts to make a bootstrap file for use by this +# system's DynaLoader. It typically gets called from an extension +# Makefile. +# +# There is no .bs file supplied with the extension. Instead a _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 +# @DynaLoader::dl_resolve_using array for the current architecture. +# That will be extended by $dynaloadlibs, which was computed by Andy's +# extliblist script. If this array still is empty, we do nothing, else +# we write a .bs file with an @DynaLoader::dl_resolve_using array, but +# without any `if's, because there is no longer a need to deal with +# special cases. +# +# The _BS file can put some code into the generated .bs file by placing +# it in $bscode. This is a handy 'escape' mechanism that may prove +# useful in complex situations. +# +# If @DynaLoader::dl_resolve_using contains -L* or -l* entries then +# mkbootstrap will automatically add a dl_findfile() call to the +# generated .bs file. +# + my($self, @dynaloadlibs)=@_; + print STDERR " dynaloadlibs=@dynaloadlibs" if $Verbose; + require DynaLoader; # we need DynaLoader, if the *_BS gets interpreted + import DynaLoader; # we don't say `use', so if DynaLoader is not + # yet built MakeMaker works nonetheless except here + + &initialize unless defined $att{'perl'}; + + rename "$att{BASEEXT}.bs", "$att{BASEEXT}.bso"; + + if (-f "$att{BASEEXT}_BS"){ + $_ = "$att{BASEEXT}_BS"; + package DynaLoader; # execute code as if in DynaLoader + local($osname, $dlsrc) = (); # avoid warnings + ($osname, $dlsrc) = @Config{qw(osname dlsrc)}; + $bscode = ""; + unshift @INC, "."; + require $_; + } + + if ($Config{'dlsrc'} =~ /^dl_dld/){ + package DynaLoader; + push(@dl_resolve_using, dl_findfile('-lc')); + } + + my(@all) = (@dynaloadlibs, @DynaLoader::dl_resolve_using); + my($method) = ''; + if (@all){ + open BS, ">$att{BASEEXT}.bs" + or die "Unable to open $att{BASEEXT}.bs: $!"; + print STDOUT "Writing $att{BASEEXT}.bs\n"; + print STDOUT " containing: @all" if $Verbose; + print BS "# $att{BASEEXT} DynaLoader bootstrap file for $Config{'osname'} architecture.\n"; + print BS "# Do not edit this file, changes will be lost.\n"; + print BS "# This file was automatically generated by the\n"; + print BS "# mkbootstrap routine in ExtUtils/MakeMaker.pm.\n"; + print BS "\@DynaLoader::dl_resolve_using = "; + if (" @all" =~ m/ -[lL]/){ + print BS " dl_findfile(qw(\n @all\n ));\n"; + }else{ + print BS " qw(@all);\n"; + } + # write extra code if *_BS says so + print BS $DynaLoader::bscode if $DynaLoader::bscode; + print BS "1;\n"; + close BS; + } + + if ($Config{'dlsrc'} =~ /^dl_aix/){ + open AIX, ">$att{BASEEXT}.exp"; + print AIX "#!\nboot_$att{BASEEXT}\n"; + close AIX; + } +} + +# the following makes AutoSplit happy (bug in perl5b3e) +package ExtUtils::MakeMaker; +1; + +__END__ diff --git a/lib/FOOBAR.pm b/lib/FOOBAR.pm deleted file mode 100644 index 9013b4e..0000000 --- a/lib/FOOBAR.pm +++ /dev/null @@ -1,10 +0,0 @@ -package FOOBAR; - -require Exporter; -@ISA = (Exporter); -@EXPORT = (foo, bar); - -sub foo { print "FOO\n" }; -sub bar { print "BAR\n" }; - -1; diff --git a/lib/File/Basename.pm b/lib/File/Basename.pm new file mode 100644 index 0000000..9e2e25e --- /dev/null +++ b/lib/File/Basename.pm @@ -0,0 +1,138 @@ +package File::Basename; + +require 5.000; +use Config; +require Exporter; +@ISA = qw(Exporter); +@EXPORT = qw(fileparse set_fileparse_fstype basename dirname); + +# fileparse_set_fstype() - specify OS-based rules used in future +# calls to routines in this package +# +# Currently recognized values: VMS, MSDOS, MacOS +# Any other name uses Unix-style rules + +sub fileparse_set_fstype { + $Fileparse_fstype = $_[0]; +} + +# fileparse() - parse file specification +# +# calling sequence: +# ($filename,$prefix,$tail) = &basename_pat($filespec,@excludelist); +# where $filespec is the file specification to be parsed, and +# @excludelist is a list of patterns which should be removed +# from the end of $filename. +# $filename is the part of $filespec after $prefix (i.e. the +# name of the file). The elements of @excludelist +# are compared to $filename, and if an +# $prefix is the path portion $filespec, up to and including +# the end of the last directory name +# $tail any characters removed from $filename because they +# matched an element of @excludelist. +# +# fileparse() first removes the directory specification from $filespec, +# according to the syntax of the OS (code is provided below to handle +# VMS, Unix, MSDOS and MacOS; you can pick the one you want using +# fileparse_set_fstype(), or you can accept the default, which is +# based on the information in the %Config array). It then compares +# each element of @excludelist to $filename, and if that element is a +# suffix of $filename, it is removed from $filename and prepended to +# $tail. By specifying the elements of @excludelist in the right order, +# you can 'nibble back' $filename to extract the portion of interest +# to you. +# +# For example, on a system running Unix, +# ($base,$path,$type) = fileparse('/virgil/aeneid/draft.book7', +# '\.book\d+'); +# would yield $base == 'draft', +# $path == '/virgil/aeneid', and +# $tail == '.book7'. +# Similarly, on a system running VMS, +# ($name,$dir,$type) = fileparse('Doc_Root:[Help]Rhetoric.Rnh','\..*'); +# would yield $name == 'Rhetoric'; +# $dir == 'Doc_Root:[Help]', and +# $type == '.Rnh'. +# +# Version 2.2 13-Oct-1994 Charles Bailey bailey@genetics.upenn.edu + + +sub fileparse { + my($fullname,@suffices) = @_; + my($fstype) = $Fileparse_fstype; + my($dirpath,$tail,$suffix,$idx); + + if ($fstype =~ /^VMS/i) { + if ($fullname =~ m#/#) { $fstype = '' } # We're doing Unix emulation + else { + ($dirpath,$basename) = ($fullname =~ /(.*[:>\]])?(.*)/); + $dirpath = $ENV{'PATH'} unless $dirpath; + } + } + if ($fstype =~ /^MSDOS/i) { + ($dirpath,$basename) = ($fullname =~ /(.*\\)?(.*)/); + $dirpath = '.' unless $dirpath; + } + elsif ($fstype =~ /^MAC/i) { + ($dirpath,$basename) = ($fullname =~ /(.*:)?(.*)/); + } + else { # default to Unix + ($dirpath,$basename) = ($fullname =~ m#(.*/)?(.*)#); + $dirpath = '.' unless $dirpath; + } + + if (@suffices) { + foreach $suffix (@suffices) { + if ($basename =~ /($suffix)$/) { + $tail = $1 . $tail; + $basename = $`; + } + } + } + + ($basename,$dirpath,$tail); + +} + + +# basename() - returns first element of list returned by fileparse() + +sub basename { + (fileparse(@_))[0]; +} + + +# dirname() - returns device and directory portion of file specification +# Behavior matches that of Unix dirname(1) exactly for Unix and MSDOS +# filespecs. This differs from the second element of the list returned +# by fileparse() in that the trailing '/' (Unix) or '\' (MSDOS) (and +# the last directory name if the filespec ends in a '/' or '\'), is lost. + +sub dirname { + my($basename,$dirname) = fileparse($_[0]); + my($fstype) = $Fileparse_fstype; + + if ($fstype =~ /VMS/i) { + if (m#/#) { $fstype = '' } + else { return $dirname } + } + if ($fstype =~ /MacOS/i) { return $dirname } + elsif ($fstype =~ /MSDOS/i) { + if ( $dirname =~ /:\\$/) { return $dirname } + chop $dirname; + $dirname =~ s:[^/]+$:: unless $basename; + $dirname = '.' unless $dirname; + } + else { + if ( $dirname eq '/') { return $dirname } + chop $dirname; + $dirname =~ s:[^/]+$:: unless $basename; + $dirname = '.' unless $dirname; + } + + $dirname; +} + +$Fileparse_fstype = $Config{'osname'}; + +1; diff --git a/lib/File/CheckTree.pm b/lib/File/CheckTree.pm new file mode 100644 index 0000000..d3dfa70 --- /dev/null +++ b/lib/File/CheckTree.pm @@ -0,0 +1,112 @@ +package File::CheckTree; +require 5.000; +require Exporter; + +@ISA = qw(Exporter); +@EXPORT = qw(validate); + +# $RCSfile: validate.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:19 $ + +# The validate routine takes a single multiline string consisting of +# lines containing a filename plus a file test to try on it. (The +# file test may also be a 'cd', causing subsequent relative filenames +# to be interpreted relative to that directory.) After the file test +# you may put '|| die' to make it a fatal error if the file test fails. +# The default is '|| warn'. The file test may optionally have a ! prepended +# to test for the opposite condition. If you do a cd and then list some +# relative filenames, you may want to indent them slightly for readability. +# If you supply your own "die" or "warn" message, you can use $file to +# interpolate the filename. + +# Filetests may be bunched: -rwx tests for all of -r, -w and -x. +# Only the first failed test of the bunch will produce a warning. + +# The routine returns the number of warnings issued. + +# Usage: +# use File::CheckTree; +# $warnings += validate(' +# /vmunix -e || die +# /boot -e || die +# /bin cd +# csh -ex +# csh !-ug +# sh -ex +# sh !-ug +# /usr -d || warn "What happened to $file?\n" +# '); + +sub validate { + local($file,$test,$warnings,$oldwarnings); + foreach $check (split(/\n/,$_[0])) { + next if $check =~ /^#/; + next if $check =~ /^$/; + ($file,$test) = split(' ',$check,2); + if ($test =~ s/^(!?-)(\w{2,}\b)/$1Z/) { + $testlist = $2; + @testlist = split(//,$testlist); + } + else { + @testlist = ('Z'); + } + $oldwarnings = $warnings; + foreach $one (@testlist) { + $this = $test; + $this =~ s/(-\w\b)/$1 \$file/g; + $this =~ s/-Z/-$one/; + $this .= ' || warn' unless $this =~ /\|\|/; + $this =~ s/^(.*\S)\s*\|\|\s*(die|warn)$/$1 || valmess('$2','$1')/; + $this =~ s/\bcd\b/chdir (\$cwd = \$file)/g; + eval $this; + last if $warnings > $oldwarnings; + } + } + $warnings; +} + +sub valmess { + local($disposition,$this) = @_; + $file = $cwd . '/' . $file unless $file =~ m|^/|; + if ($this =~ /^(!?)-(\w)\s+\$file\s*$/) { + $neg = $1; + $tmp = $2; + $tmp eq 'r' && ($mess = "$file is not readable by uid $>."); + $tmp eq 'w' && ($mess = "$file is not writable by uid $>."); + $tmp eq 'x' && ($mess = "$file is not executable by uid $>."); + $tmp eq 'o' && ($mess = "$file is not owned by uid $>."); + $tmp eq 'R' && ($mess = "$file is not readable by you."); + $tmp eq 'W' && ($mess = "$file is not writable by you."); + $tmp eq 'X' && ($mess = "$file is not executable by you."); + $tmp eq 'O' && ($mess = "$file is not owned by you."); + $tmp eq 'e' && ($mess = "$file does not exist."); + $tmp eq 'z' && ($mess = "$file does not have zero size."); + $tmp eq 's' && ($mess = "$file does not have non-zero size."); + $tmp eq 'f' && ($mess = "$file is not a plain file."); + $tmp eq 'd' && ($mess = "$file is not a directory."); + $tmp eq 'l' && ($mess = "$file is not a symbolic link."); + $tmp eq 'p' && ($mess = "$file is not a named pipe (FIFO)."); + $tmp eq 'S' && ($mess = "$file is not a socket."); + $tmp eq 'b' && ($mess = "$file is not a block special file."); + $tmp eq 'c' && ($mess = "$file is not a character special file."); + $tmp eq 'u' && ($mess = "$file does not have the setuid bit set."); + $tmp eq 'g' && ($mess = "$file does not have the setgid bit set."); + $tmp eq 'k' && ($mess = "$file does not have the sticky bit set."); + $tmp eq 'T' && ($mess = "$file is not a text file."); + $tmp eq 'B' && ($mess = "$file is not a binary file."); + if ($neg eq '!') { + $mess =~ s/ is not / should not be / || + $mess =~ s/ does not / should not / || + $mess =~ s/ not / /; + } + print stderr $mess,"\n"; + } + else { + $this =~ s/\$file/'$file'/g; + print stderr "Can't do $this.\n"; + } + if ($disposition eq 'die') { exit 1; } + ++$warnings; +} + +1; + diff --git a/lib/File/Find.pm b/lib/File/Find.pm new file mode 100644 index 0000000..612f145 --- /dev/null +++ b/lib/File/Find.pm @@ -0,0 +1,224 @@ +package File::Find; +require 5.000; +require Exporter; + +@ISA = qw(Exporter); +@EXPORT = qw(find finddepth); + +# Usage: +# use File::Find; +# +# find(\&wanted, '/foo','/bar'); +# +# sub wanted { ... } +# where wanted does whatever you want. $dir contains the +# current directory name, and $_ the current filename within +# that directory. $name contains "$dir/$_". You are cd'ed +# to $dir when the function is called. The function may +# set $prune to prune the tree. +# +# This library is primarily for find2perl, which, when fed +# +# find2perl / -name .nfs\* -mtime +7 -exec rm -f {} \; -o -fstype nfs -prune +# +# spits out something like this +# +# sub wanted { +# /^\.nfs.*$/ && +# (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) && +# int(-M _) > 7 && +# unlink($_) +# || +# ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) && +# $dev < 0 && +# ($prune = 1); +# } +# +# Set the variable $dont_use_nlink if you're using AFS, since AFS cheats. + +sub find { + my $wanted = shift; + chop($cwd = `pwd`); + foreach $topdir (@_) { + (($topdev,$topino,$topmode,$topnlink) = stat($topdir)) + || (warn("Can't stat $topdir: $!\n"), next); + if (-d _) { + if (chdir($topdir)) { + ($dir,$_) = ($topdir,'.'); + $name = $topdir; + &$wanted; + ($fixtopdir = $topdir) =~ s,/$,, ; + &finddir($wanted,$fixtopdir,$topnlink); + } + else { + warn "Can't cd to $topdir: $!\n"; + } + } + else { + unless (($dir,$_) = $topdir =~ m#^(.*/)(.*)$#) { + ($dir,$_) = ('.', $topdir); + } + $name = $topdir; + chdir $dir && &$wanted; + } + chdir $cwd; + } +} + +sub finddir { + local($wanted,$dir,$nlink) = @_; + local($dev,$ino,$mode,$subcount); + local($name); + + # Get the list of files in the current directory. + + opendir(DIR,'.') || (warn "Can't open $dir: $!\n", return); + local(@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; + } + } + else { # This dir has subdirectories. + $subcount = $nlink - 2; + for (@filenames) { + next if $_ eq '.'; + next if $_ eq '..'; + $nlink = $prune = 0; + $name = "$dir/$_"; + &$wanted; + if ($subcount > 0 || $dont_use_nlink) { # Seen all the subdirs? + + # Get link count and check for directoriness. + + ($dev,$ino,$mode,$nlink) = lstat($_) unless $nlink; + + if (-d _) { + + # It really is a directory, so do it recursively. + + if (!$prune && chdir $_) { + &finddir($wanted,$name,$nlink); + chdir '..'; + } + --$subcount; + } + } + } + } +} + +# Usage: +# use File::Find; +# +# finddepth(\&wanted, '/foo','/bar'); +# +# sub wanted { ... } +# where wanted does whatever you want. $dir contains the +# current directory name, and $_ the current filename within +# that directory. $name contains "$dir/$_". You are cd'ed +# to $dir when the function is called. The function may +# set $prune to prune the tree. +# +# This library is primarily for find2perl, which, when fed +# +# find2perl / -name .nfs\* -mtime +7 -exec rm -f {} \; -o -fstype nfs -prune +# +# spits out something like this +# +# sub wanted { +# /^\.nfs.*$/ && +# (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_)) && +# int(-M _) > 7 && +# unlink($_) +# || +# ($nlink || (($dev,$ino,$mode,$nlink,$uid,$gid) = lstat($_))) && +# $dev < 0 && +# ($prune = 1); +# } + +sub finddepth { + my $wanted = shift; + chop($cwd = `pwd`); + foreach $topdir (@_) { + (($topdev,$topino,$topmode,$topnlink) = stat($topdir)) + || (warn("Can't stat $topdir: $!\n"), next); + if (-d _) { + if (chdir($topdir)) { + ($fixtopdir = $topdir) =~ s,/$,, ; + &finddepthdir($wanted,$fixtopdir,$topnlink); + ($dir,$_) = ($fixtopdir,'.'); + $name = $fixtopdir; + &$wanted; + } + else { + warn "Can't cd to $topdir: $!\n"; + } + } + else { + unless (($dir,$_) = $topdir =~ m#^(.*/)(.*)$#) { + ($dir,$_) = ('.', $topdir); + } + chdir $dir && &$wanted; + } + chdir $cwd; + } +} + +sub finddepthdir { + my($wanted,$dir,$nlink) = @_; + my($dev,$ino,$mode,$subcount); + my($name); + + # Get the list of files in the current directory. + + opendir(DIR,'.') || warn "Can't open $dir: $!\n"; + my(@filenames) = readdir(DIR); + closedir(DIR); + + if ($nlink == 2) { # This dir has no subdirectories. + for (@filenames) { + next if $_ eq '.'; + next if $_ eq '..'; + $name = "$dir/$_"; + $nlink = 0; + &$wanted; + } + } + else { # This dir has subdirectories. + $subcount = $nlink - 2; + for (@filenames) { + next if $_ eq '.'; + next if $_ eq '..'; + $nlink = $prune = 0; + $name = "$dir/$_"; + if ($subcount > 0) { # Seen all the subdirs? + + # Get link count and check for directoriness. + + ($dev,$ino,$mode,$nlink) = lstat($_) unless $nlink; + + if (-d _) { + + # It really is a directory, so do it recursively. + + if (!$prune && chdir $_) { + &finddepthdir($wanted,$name,$nlink); + chdir '..'; + } + --$subcount; + } + } + &$wanted; + } + } +} + +1; + diff --git a/lib/FileHandle.pm b/lib/FileHandle.pm index 2452a15..c45f446 100644 --- a/lib/FileHandle.pm +++ b/lib/FileHandle.pm @@ -1,12 +1,12 @@ package FileHandle; -BEGIN { - require 5.000; - require English; import English; - require Exporter; -} +# Note that some additional FileHandle methods are defined in POSIX.pm. + +require 5.000; +use English; +use Exporter; -@ISA = (Exporter); +@ISA = qw(Exporter); @EXPORT = qw( print autoflush @@ -21,6 +21,7 @@ BEGIN { format_top_name format_line_break_characters format_formfeed + cacheout ); sub print { @@ -124,4 +125,50 @@ sub format_formfeed { $prev; } + +# --- cacheout functions --- + +# Open in their package. + +sub cacheout_open { + my $pack = caller(1); + open(*{$pack . '::' . $_[0]}, $_[1]); +} + +sub cacheout_close { + my $pack = caller(1); + close(*{$pack . '::' . $_[0]}); +} + +# But only this sub name is visible to them. + +sub cacheout { + ($file) = @_; + if (!$cacheout_maxopen){ + if (open(PARAM,'/usr/include/sys/param.h')) { + local($.); + while () { + $cacheout_maxopen = $1 - 4 + if /^\s*#\s*define\s+NOFILE\s+(\d+)/; + } + close PARAM; + } + $cacheout_maxopen = 16 unless $cacheout_maxopen; + } + if (!$isopen{$file}) { + if (++$cacheout_numopen > $cacheout_maxopen) { + local(@lru) = sort {$isopen{$a} <=> $isopen{$b};} keys(%isopen); + splice(@lru, $cacheout_maxopen / 3); + $cacheout_numopen -= @lru; + for (@lru) { &cacheout_close($_); delete $isopen{$_}; } + } + &cacheout_open($file, ($saw{$file}++ ? '>>' : '>') . $file) + || croak("Can't create $file: $!"); + } + $isopen{$file} = ++$cacheout_seq; +} + +$cacheout_seq = 0; +$cacheout_numopen = 0; + 1; diff --git a/lib/Getopt/Long.pm b/lib/Getopt/Long.pm new file mode 100644 index 0000000..9c66264 --- /dev/null +++ b/lib/Getopt/Long.pm @@ -0,0 +1,513 @@ +package Getopt::Long; +require 5.000; +require Exporter; + +@ISA = qw(Exporter); +@EXPORT = qw(GetOptions); + + +# newgetopt.pl -- new options parsing + +# SCCS Status : @(#)@ newgetopt.pl 1.14 +# Author : Johan Vromans +# Created On : Tue Sep 11 15:00:12 1990 +# Last Modified By: Johan Vromans +# Last Modified On: Sat Feb 12 18:24:02 1994 +# Update Count : 138 +# Status : Okay + +################ Introduction ################ +# +# This package implements an extended getopt function. This function adheres +# to the new syntax (long option names, no bundling). +# It tries to implement the better functionality of traditional, GNU and +# POSIX getopt functions. +# +# This program is Copyright 1990,1994 by Johan Vromans. +# This program is free software; you can redistribute it and/or +# modify it under the terms of the GNU General Public License +# as published by the Free Software Foundation; either version 2 +# of the License, or (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# If you do not have a copy of the GNU General Public License write to +# the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, +# MA 02139, USA. + +################ Description ################ +# +# Usage: +# +# require "newgetopt.pl"; +# ...change configuration values, if needed... +# $result = &NGetOpt (...option-descriptions...); +# +# Each description should designate a valid perl identifier, optionally +# followed by an argument specifier. +# +# Values for argument specifiers are: +# +# option does not take an argument +# ! option does not take an argument and may be negated +# =s :s option takes a mandatory (=) or optional (:) string argument +# =i :i option takes a mandatory (=) or optional (:) integer argument +# =f :f option takes a mandatory (=) or optional (:) real number argument +# +# If option "name" is set, it will cause the perl variable $opt_name to +# be set to the specified value. The calling program can use this +# variable to detect whether the option has been set. Options that do +# not take an argument will be set to 1 (one). +# +# Options that take an optional argument will be defined, but set to '' +# if no actual argument has been supplied. +# +# If an "@" sign is appended to the argument specifier, the option is +# treated as an array. Value(s) are not set, but pushed into array +# @opt_name. +# +# Options that do not take a value may have an "!" argument spacifier to +# indicate that they may be negated. E.g. "foo!" will allow -foo (which +# sets $opt_foo to 1) and -nofoo (which will set $opt_foo to 0). +# +# The option name may actually be a list of option names, separated by +# '|'s, e.g. "foo|bar|blech=s". In this example, options 'bar' and +# 'blech' will set $opt_foo instead. +# +# Option names may be abbreviated to uniqueness, depending on +# configuration variable $autoabbrev. +# +# Dashes in option names are allowed (e.g. pcc-struct-return) and will +# be translated to underscores in the corresponding perl variable (e.g. +# $opt_pcc_struct_return). Note that a lone dash "-" is considered an +# option, corresponding perl identifier is $opt_ . +# +# A double dash "--" signals end of the options list. +# +# If the first option of the list consists of non-alphanumeric +# characters only, it is interpreted as a generic option starter. +# Everything starting with one of the characters from the starter will +# be considered an option. +# +# The default values for the option starters are "-" (traditional), "--" +# (POSIX) and "+" (GNU, being phased out). +# +# Options that start with "--" may have an argument appended, separated +# with an "=", e.g. "--foo=bar". +# +# If configuration varaible $getopt_compat is set to a non-zero value, +# options that start with "+" may also include their arguments, +# e.g. "+foo=bar". +# +# A return status of 0 (false) indicates that the function detected +# one or more errors. +# +################ Some examples ################ +# +# If option "one:i" (i.e. takes an optional integer argument), then +# the following situations are handled: +# +# -one -two -> $opt_one = '', -two is next option +# -one -2 -> $opt_one = -2 +# +# Also, assume "foo=s" and "bar:s" : +# +# -bar -xxx -> $opt_bar = '', '-xxx' is next option +# -foo -bar -> $opt_foo = '-bar' +# -foo -- -> $opt_foo = '--' +# +# In GNU or POSIX format, option names and values can be combined: +# +# +foo=blech -> $opt_foo = 'blech' +# --bar= -> $opt_bar = '' +# --bar=-- -> $opt_bar = '--' +# +################ Configuration values ################ +# +# $autoabbrev Allow option names to be abbreviated to uniqueness. +# Default is 1 unless environment variable +# POSIXLY_CORRECT has been set. +# +# $getopt_compat Allow '+' to start options. +# Default is 1 unless environment variable +# POSIXLY_CORRECT has been set. +# +# $option_start Regexp with option starters. +# Default is (--|-) if environment variable +# POSIXLY_CORRECT has been set, (--|-|\+) otherwise. +# +# $order Whether non-options are allowed to be mixed with +# options. +# Default is $REQUIRE_ORDER if environment variable +# POSIXLY_CORRECT has been set, $PERMUTE otherwise. +# +# $ignorecase Ignore case when matching options. Default is 1. +# +# $debug Enable debugging output. Default is 0. + +################ History ################ +# +# 12-Feb-1994 Johan Vromans +# Added "!" for negation. +# Released to the net. +# +# 26-Aug-1992 Johan Vromans +# More POSIX/GNU compliance. +# Lone dash and double-dash are now independent of the option prefix +# that is used. +# Make errors in NGetOpt parameters fatal. +# Allow options to be mixed with arguments. +# Check $ENV{"POSIXLY_CORRECT"} to suppress this. +# Allow --foo=bar and +foo=bar (but not -foo=bar). +# Allow options to be abbreviated to minimum needed for uniqueness. +# (Controlled by configuration variable $autoabbrev.) +# Allow alias names for options (e.g. "foo|bar=s"). +# Allow "-" in option names (e.g. --pcc-struct-return). Dashes are +# translated to "_" to form valid perl identifiers +# (e.g. $opt_pcc_struct_return). +# +# 2-Jun-1992 Johan Vromans +# Do not use //o to allow multiple NGetOpt calls with different delimeters. +# Prevent typeless option from using previous $array state. +# Prevent empty option from being eaten as a (negative) number. +# +# 25-May-1992 Johan Vromans +# Add array options. "foo=s@" will return an array @opt_foo that +# contains all values that were supplied. E.g. "-foo one -foo -two" will +# return @opt_foo = ("one", "-two"); +# Correct bug in handling options that allow for a argument when followed +# by another option. +# +# 4-May-1992 Johan Vromans +# Add $ignorecase to match options in either case. +# Allow '' option. +# +# 19-Mar-1992 Johan Vromans +# Allow require from packages. +# NGetOpt is now defined in the package that requires it. +# @ARGV and $opt_... are taken from the package that calls it. +# Use standard (?) option prefixes: -, -- and +. +# +# 20-Sep-1990 Johan Vromans +# Set options w/o argument to 1. +# Correct the dreadful semicolon/require bug. + +################ Configuration Section ################ + +{ + + # Values for $order. See GNU getopt.c for details. + $REQUIRE_ORDER = 0; + $PERMUTE = 1; + $RETURN_IN_ORDER = 2; + + # Handle POSIX compliancy. + if ( defined $ENV{"POSIXLY_CORRECT"} ) { + $autoabbrev = 0; # no automatic abbrev of options (???) + $getopt_compat = 0; # disallow '+' to start options + $option_start = "(--|-)"; + $order = $REQUIRE_ORDER; + } + else { + $autoabbrev = 1; # automatic abbrev of options + $getopt_compat = 1; # allow '+' to start options + $option_start = "(--|-|\\+)"; + $order = $PERMUTE; + } + + # Other configurable settings. + $debug = 0; # for debugging + $ignorecase = 1; # ignore case when matching options + $argv_end = "--"; # don't change this! +} + +################ Subroutines ################ + +sub GetOptions { + + @optionlist = @_; #'; + + local ($[) = 0; + local ($genprefix) = $option_start; + local ($argend) = $argv_end; + local ($error) = 0; + local ($opt, $optx, $arg, $type, $mand, %opctl); + local ($pkg) = (caller)[0]; + local ($optarg); + local (%aliases); + local (@ret) = (); + + print STDERR "NGetOpt 1.14 -- called from $pkg\n" if $debug; + + # See if the first element of the optionlist contains option + # starter characters. + if ( $optionlist[0] =~ /^\W+$/ ) { + $genprefix = shift (@optionlist); + # Turn into regexp. + $genprefix =~ s/(\W)/\\$1/g; + $genprefix = "[" . $genprefix . "]"; + } + + # Verify correctness of optionlist. + %opctl = (); + foreach $opt ( @optionlist ) { + $opt =~ tr/A-Z/a-z/ if $ignorecase; + if ( $opt !~ /^(\w+[-\w|]*)?(!|[=:][infse]@?)?$/ ) { + die ("Error in option spec: \"", $opt, "\"\n"); + $error++; + next; + } + local ($o, $c, $a) = ($1, $2); + + if ( ! defined $o ) { + $opctl{''} = defined $c ? $c : ''; + } + else { + # Handle alias names + foreach ( split (/\|/, $o)) { + if ( defined $c && $c eq '!' ) { + $opctl{"no$_"} = $c; + $c = ''; + } + $opctl{$_} = defined $c ? $c : ''; + if ( defined $a ) { + # Note alias. + $aliases{$_} = $a; + } + else { + # Set primary name. + $a = $_; + } + } + } + } + @opctl = sort(keys (%opctl)) if $autoabbrev; + + return 0 if $error; + + if ( $debug ) { + local ($arrow, $k, $v); + $arrow = "=> "; + while ( ($k,$v) = each(%opctl) ) { + print STDERR ($arrow, "\$opctl{\"$k\"} = \"$v\"\n"); + $arrow = " "; + } + } + + # Process argument list + + while ( $#ARGV >= 0 ) { + + # >>> See also the continue block <<< + + #### Get next argument #### + + $opt = shift (@ARGV); + print STDERR ("=> option \"", $opt, "\"\n") if $debug; + $arg = undef; + $optarg = undef; + $array = 0; + + #### Determine what we have #### + + # Double dash is option list terminator. + if ( $opt eq $argend ) { + unshift (@ret, @ARGV) if $order == $PERMUTE; + return ($error == 0); + } + elsif ( $opt =~ /^$genprefix/ ) { + # Looks like an option. + $opt = $'; # option name (w/o prefix) + # If it is a long opt, it may include the value. + if (($+ eq "--" || ($getopt_compat && $+ eq "+")) && + $opt =~ /^([^=]+)=/ ) { + $opt = $1; + $optarg = $'; + print STDERR ("=> option \"", $opt, + "\", optarg = \"$optarg\"\n") + if $debug; + } + + } + # Not an option. Save it if we may permute... + elsif ( $order == $PERMUTE ) { + push (@ret, $opt); + next; + } + # ...otherwise, terminate. + else { + # Push back and exit. + unshift (@ARGV, $opt); + return ($error == 0); + } + + #### Look it up ### + + $opt =~ tr/A-Z/a-z/ if $ignorecase; + + local ($tryopt) = $opt; + if ( $autoabbrev ) { + local ($pat, @hits); + + # Turn option name into pattern. + ($pat = $opt) =~ s/(\W)/\\$1/g; + # Look up in option names. + @hits = grep (/^$pat/, @opctl); + print STDERR ("=> ", 0+@hits, " hits (@hits) with \"$pat\" ", + "out of ", 0+@opctl, "\n") + if $debug; + + # Check for ambiguous results. + unless ( (@hits <= 1) || (grep ($_ eq $opt, @hits) == 1) ) { + print STDERR ("Option ", $opt, " is ambiguous (", + join(", ", @hits), ")\n"); + $error++; + next; + } + + # Complete the option name, if appropriate. + if ( @hits == 1 && $hits[0] ne $opt ) { + $tryopt = $hits[0]; + print STDERR ("=> option \"$opt\" -> \"$tryopt\"\n") + if $debug; + } + } + + unless ( defined ( $type = $opctl{$tryopt} ) ) { + print STDERR ("Unknown option: ", $opt, "\n"); + $error++; + next; + } + $opt = $tryopt; + print STDERR ("=> found \"$type\" for ", $opt, "\n") if $debug; + + #### Determine argument status #### + + # If it is an option w/o argument, we're almost finished with it. + if ( $type eq '' || $type eq '!' ) { + if ( defined $optarg ) { + print STDERR ("Option ", $opt, " does not take an argument\n"); + $error++; + } + elsif ( $type eq '' ) { + $arg = 1; # supply explicit value + } + else { + substr ($opt, 0, 2) = ''; # strip NO prefix + $arg = 0; # supply explicit value + } + next; + } + + # Get mandatory status and type info. + ($mand, $type, $array) = $type =~ /^(.)(.)(@?)$/; + + # Check if there is an option argument available. + if ( defined $optarg ? ($optarg eq '') : ($#ARGV < 0) ) { + + # Complain if this option needs an argument. + if ( $mand eq "=" ) { + print STDERR ("Option ", $opt, " requires an argument\n"); + $error++; + } + if ( $mand eq ":" ) { + $arg = $type eq "s" ? '' : 0; + } + next; + } + + # Get (possibly optional) argument. + $arg = defined $optarg ? $optarg : shift (@ARGV); + + #### Check if the argument is valid for this option #### + + if ( $type eq "s" ) { # string + # A mandatory string takes anything. + next if $mand eq "="; + + # An optional string takes almost anything. + next if defined $optarg; + next if $arg eq "-"; + + # Check for option or option list terminator. + if ($arg eq $argend || + $arg =~ /^$genprefix.+/) { + # Push back. + unshift (@ARGV, $arg); + # Supply empty value. + $arg = ''; + } + next; + } + + if ( $type eq "n" || $type eq "i" ) { # numeric/integer + if ( $arg !~ /^-?[0-9]+$/ ) { + if ( defined $optarg || $mand eq "=" ) { + print STDERR ("Value \"", $arg, "\" invalid for option ", + $opt, " (number expected)\n"); + $error++; + undef $arg; # don't assign it + } + else { + # Push back. + unshift (@ARGV, $arg); + # Supply default value. + $arg = 0; + } + } + next; + } + + if ( $type eq "f" ) { # fixed real number, int is also ok + if ( $arg !~ /^-?[0-9.]+$/ ) { + if ( defined $optarg || $mand eq "=" ) { + print STDERR ("Value \"", $arg, "\" invalid for option ", + $opt, " (real number expected)\n"); + $error++; + undef $arg; # don't assign it + } + else { + # Push back. + unshift (@ARGV, $arg); + # Supply default value. + $arg = 0.0; + } + } + next; + } + + die ("NGetOpt internal error (Can't happen)\n"); + } + + continue { + if ( defined $arg ) { + $opt = $aliases{$opt} if defined $aliases{$opt}; + # Make sure a valid perl identifier results. + $opt =~ s/\W/_/g; + if ( $array ) { + print STDERR ('=> push (@', $pkg, '\'opt_', $opt, ", \"$arg\")\n") + if $debug; + eval ('push(@' . $pkg . '\'opt_' . $opt . ", \$arg);"); + } + else { + print STDERR ('=> $', $pkg, '\'opt_', $opt, " = \"$arg\"\n") + if $debug; + eval ('$' . $pkg . '\'opt_' . $opt . " = \$arg;"); + } + } + } + + if ( $order == $PERMUTE && @ret > 0 ) { + unshift (@ARGV, @ret); + } + return ($error == 0); +} + +################ Package return ################ + +1; + + diff --git a/lib/Getopt/Std.pm b/lib/Getopt/Std.pm new file mode 100644 index 0000000..e1de3b5 --- /dev/null +++ b/lib/Getopt/Std.pm @@ -0,0 +1,104 @@ +package Getopt::Std; +require 5.000; +require Exporter; + +@ISA = qw(Exporter); +@EXPORT = qw(getopt getopts); + +# $RCSfile: getopt.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:23:58 $ + +# Process single-character switches with switch clustering. Pass one argument +# which is a string containing all switches that take an argument. For each +# switch found, sets $opt_x (where x is the switch name) to the value of the +# argument, or 1 if no argument. Switches which take an argument don't care +# whether there is a space between the switch and the argument. + +# Usage: +# getopt('oDI'); # -o, -D & -I take arg. Sets opt_* as a side effect. + +sub getopt { + local($argumentative) = @_; + local($_,$first,$rest); + local $Exporter::ExportLevel; + + while (@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) { + ($first,$rest) = ($1,$2); + if (index($argumentative,$first) >= 0) { + if ($rest ne '') { + shift(@ARGV); + } + else { + shift(@ARGV); + $rest = shift(@ARGV); + } + eval "\$opt_$first = \$rest;"; + push( @EXPORT, "\$opt_$first" ); + } + else { + eval "\$opt_$first = 1;"; + push( @EXPORT, "\$opt_$first" ); + if ($rest ne '') { + $ARGV[0] = "-$rest"; + } + else { + shift(@ARGV); + } + } + } + $Exporter::ExportLevel++; + import Getopt::Std; +} + +# Usage: +# getopts('a:bc'); # -a takes arg. -b & -c not. Sets opt_* as a +# # side effect. + +sub getopts { + local($argumentative) = @_; + local(@args,$_,$first,$rest); + local($errs) = 0; + local $Exporter::ExportLevel; + + @args = split( / */, $argumentative ); + while(@ARGV && ($_ = $ARGV[0]) =~ /^-(.)(.*)/) { + ($first,$rest) = ($1,$2); + $pos = index($argumentative,$first); + if($pos >= 0) { + if($args[$pos+1] eq ':') { + shift(@ARGV); + if($rest eq '') { + ++$errs unless @ARGV; + $rest = shift(@ARGV); + } + eval "\$opt_$first = \$rest;"; + push( @EXPORT, "\$opt_$first" ); + } + else { + eval "\$opt_$first = 1"; + push( @EXPORT, "\$opt_$first" ); + if($rest eq '') { + shift(@ARGV); + } + else { + $ARGV[0] = "-$rest"; + } + } + } + else { + print STDERR "Unknown option: $first\n"; + ++$errs; + if($rest ne '') { + $ARGV[0] = "-$rest"; + } + else { + shift(@ARGV); + } + } + } + $Exporter::ExportLevel++; + import Getopt::Std; + $errs == 0; +} + +1; + diff --git a/lib/Hostname.pm b/lib/Hostname.pm deleted file mode 100644 index f61592e..0000000 --- a/lib/Hostname.pm +++ /dev/null @@ -1,48 +0,0 @@ -# by David Sundstrom sunds@asictest.sc.ti.com -# Texas Instruments - -package Hostname; - -require Exporter; -@ISA = (Exporter); -@EXPORT = (hostname); - -# -# Try every conceivable way to get hostname. -# - -sub hostname { - # method 1 - we already know it - return $host if defined $host; - - # method 2 - syscall is preferred since it avoids tainting problems - eval { - require "syscall.ph"; - $host = "\0" x 65; ## preload scalar - syscall(&SYS_gethostname, $host, 65) == 0; - } - - # method 3 - trusty old hostname command - || eval { - $host = `hostname 2>/dev/null`; # bsdish - } - - # method 4 - sysV uname command (may truncate) - || eval { - $host = `uname -n 2>/dev/null`; ## sysVish - } - - # method 5 - Apollo pre-SR10 - || eval { - ($host,$a,$b,$c,$d)=split(/[:\. ]/,`/com/host`,6); - } - - # bummer - || die "Cannot get host name of local machine\n"; - - # remove garbage - $host =~ tr/\0\r\n//d; - $host; -} - -1; diff --git a/lib/I18N/Collate.pm b/lib/I18N/Collate.pm new file mode 100644 index 0000000..52c78ab --- /dev/null +++ b/lib/I18N/Collate.pm @@ -0,0 +1,97 @@ +package I18N::Collate; + +# Collate.pm +# +# Author: Jarkko Hietaniemi +# Helsinki University of Technology, Finland +# +# Acks: Guy Decoux understood +# overloading magic much deeper than I and told +# how to cut the size of this code by more than half. +# (my first version did overload all of lt gt eq le ge cmp) +# +# Purpose: compare 8-bit scalar data according to the current locale +# +# Requirements: Perl5 POSIX::setlocale() and POSIX::strxfrm() +# +# Exports: setlocale 1) +# collate_xfrm 2) +# +# Overloads: cmp # 3) +# +# Usage: use Collate; +# setlocale(&LC_COLLATE, 'locale-of-your-choice'); # 4) +# $s1 = new Collate "scalar_data_1"; +# $s2 = new Collate "scalar_data_2"; +# +# now you can compare $s1 and $s2: $s1 le $s2 +# to extract the data itself, you need to deref: $$s1 +# +# Notes: +# 1) this uses POSIX::setlocale +# 2) the basic collation conversion is done by strxfrm() which +# terminates at NUL characters being a decent C routine. +# collate_xfrm handles embedded NUL characters gracefully. +# 3) due to cmp and overload magic, lt le eq ge gt work also +# 4) the available locales depend on your operating system; +# try whether "locale -a" shows them or the more direct +# approach "ls /usr/lib/nls/loc" or "ls /usr/lib/nls". +# The locale names are probably something like +# 'xx_XX.(ISO)?8859-N'. +# +# Updated: 19940913 1341 GMT +# +# --- + +use POSIX qw(strxfrm LC_COLLATE); + +require Exporter; + +@ISA = qw(Exporter); +@EXPORT = qw(collate_xfrm setlocale LC_COLLATE); +@EXPORT_OK = qw(); + +%OVERLOAD = qw( +fallback 1 +cmp collate_cmp +); + +sub new { my $new = $_[1]; bless \$new } + +sub setlocale { + my ($category, $locale) = @_[0,1]; + + POSIX::setlocale($category, $locale) if (defined $category); + # the current $LOCALE + $LOCALE = $locale || $ENV{'LC_COLLATE'} || $ENV{'LC_ALL'} || ''; +} + +sub C { + my $s = ${$_[0]}; + + $C->{$LOCALE}->{$s} = collate_xfrm($s) + unless (defined $C->{$LOCALE}->{$s}); # cache when met + + $C->{$LOCALE}->{$s}; +} + +sub collate_xfrm { + my $s = $_[0]; + my $x = ''; + + for (split(/(\000+)/, $s)) { + $x .= (/^\000/) ? $_ : strxfrm("$_\000"); + } + + $x; +} + +sub collate_cmp { + &C($_[0]) cmp &C($_[1]); +} + +# init $LOCALE + +&I18N::Collate::setlocale(); + +1; # keep require happy diff --git a/lib/IPC/Open2.pm b/lib/IPC/Open2.pm new file mode 100644 index 0000000..c59c7d6 --- /dev/null +++ b/lib/IPC/Open2.pm @@ -0,0 +1,62 @@ +package IPC::Open2; +require 5.000; +require Exporter; +use Carp; + +@ISA = qw(Exporter); +@EXPORT = qw(open2); + +# &open2: tom christiansen, +# +# usage: $pid = open2('rdr', 'wtr', 'some cmd and args'); +# or $pid = open2('rdr', 'wtr', 'some', 'cmd', 'and', 'args'); +# +# spawn the given $cmd and connect $rdr for +# reading and $wtr for writing. return pid +# of child, or 0 on failure. +# +# WARNING: this is dangerous, as you may block forever +# unless you are very careful. +# +# $wtr is left unbuffered. +# +# abort program if +# rdr or wtr are null +# pipe or fork or exec fails + +$fh = 'FHOPEN000'; # package static in case called more than once + +sub open2 { + local($kidpid); + local($dad_rdr, $dad_wtr, @cmd) = @_; + + $dad_rdr ne '' || croak "open2: rdr should not be null"; + $dad_wtr ne '' || croak "open2: wtr should not be null"; + + # force unqualified filehandles into callers' package + local($package) = caller; + $dad_rdr =~ s/^[^']+$/$package'$&/; + $dad_wtr =~ s/^[^']+$/$package'$&/; + + local($kid_rdr) = ++$fh; + local($kid_wtr) = ++$fh; + + pipe($dad_rdr, $kid_wtr) || croak "open2: pipe 1 failed: $!"; + pipe($kid_rdr, $dad_wtr) || croak "open2: pipe 2 failed: $!"; + + if (($kidpid = fork) < 0) { + croak "open2: fork failed: $!"; + } elsif ($kidpid == 0) { + close $dad_rdr; close $dad_wtr; + open(STDIN, "<&$kid_rdr"); + open(STDOUT, ">&$kid_wtr"); + warn "execing @cmd\n" if $debug; + exec @cmd; + croak "open2: exec of @cmd failed"; + } + close $kid_rdr; close $kid_wtr; + select((select($dad_wtr), $| = 1)[0]); # unbuffer pipe + $kidpid; +} +1; # so require is happy + diff --git a/lib/IPC/Open3.pm b/lib/IPC/Open3.pm new file mode 100644 index 0000000..3426f19 --- /dev/null +++ b/lib/IPC/Open3.pm @@ -0,0 +1,113 @@ +package IPC::Open3; +require 5.000; +require Exporter; +use Carp; + +@ISA = qw(Exporter); +@EXPORT = qw(open3); + +# &open3: Marc Horowitz +# derived mostly from &open2 by tom christiansen, +# +# $Id: open3.pl,v 1.1 1993/11/23 06:26:15 marc Exp $ +# +# usage: $pid = open3('wtr', 'rdr', 'err' 'some cmd and args', 'optarg', ...); +# +# spawn the given $cmd and connect rdr for +# reading, wtr for writing, and err for errors. +# if err is '', or the same as rdr, then stdout and +# stderr of the child are on the same fh. returns pid +# of child, or 0 on failure. + + +# if wtr begins with '>&', then wtr will be closed in the parent, and +# the child will read from it directly. if rdr or err begins with +# '>&', then the child will send output directly to that fd. In both +# cases, there will be a dup() instead of a pipe() made. + + +# WARNING: this is dangerous, as you may block forever +# unless you are very careful. +# +# $wtr is left unbuffered. +# +# abort program if +# rdr or wtr are null +# pipe or fork or exec fails + +$fh = 'FHOPEN000'; # package static in case called more than once + +sub open3 { + local($kidpid); + local($dad_wtr, $dad_rdr, $dad_err, @cmd) = @_; + local($dup_wtr, $dup_rdr, $dup_err); + + $dad_wtr || croak "open3: wtr should not be null"; + $dad_rdr || croak "open3: rdr should not be null"; + $dad_err = $dad_rdr if ($dad_err eq ''); + + $dup_wtr = ($dad_wtr =~ s/^\>\&//); + $dup_rdr = ($dad_rdr =~ s/^\>\&//); + $dup_err = ($dad_err =~ s/^\>\&//); + + # force unqualified filehandles into callers' package + local($package) = caller; + $dad_wtr =~ s/^[^']+$/$package'$&/; + $dad_rdr =~ s/^[^']+$/$package'$&/; + $dad_err =~ s/^[^']+$/$package'$&/; + + local($kid_rdr) = ++$fh; + local($kid_wtr) = ++$fh; + local($kid_err) = ++$fh; + + if (!$dup_wtr) { + pipe($kid_rdr, $dad_wtr) || croak "open3: pipe 1 (stdin) failed: $!"; + } + if (!$dup_rdr) { + pipe($dad_rdr, $kid_wtr) || croak "open3: pipe 2 (stdout) failed: $!"; + } + if ($dad_err ne $dad_rdr && !$dup_err) { + pipe($dad_err, $kid_err) || croak "open3: pipe 3 (stderr) failed: $!"; + } + + if (($kidpid = fork) < 0) { + croak "open2: fork failed: $!"; + } elsif ($kidpid == 0) { + if ($dup_wtr) { + open(STDIN, ">&$dad_wtr") if (fileno(STDIN) != fileno($dad_wtr)); + } else { + close($dad_wtr); + open(STDIN, ">&$kid_rdr"); + } + if ($dup_rdr) { + open(STDOUT, ">&$dad_rdr") if (fileno(STDOUT) != fileno($dad_rdr)); + } else { + close($dad_rdr); + open(STDOUT, ">&$kid_wtr"); + } + if ($dad_rdr ne $dad_err) { + if ($dup_err) { + open(STDERR, ">&$dad_err") + if (fileno(STDERR) != fileno($dad_err)); + } else { + close($dad_err); + open(STDERR, ">&$kid_err"); + } + } else { + open(STDERR, ">&STDOUT") if (fileno(STDERR) != fileno(STDOUT)); + } + local($")=(" "); + exec @cmd; + croak "open2: exec of @cmd failed"; + } + + close $kid_rdr; close $kid_wtr; close $kid_err; + if ($dup_wtr) { + close($dad_wtr); + } + + select((select($dad_wtr), $| = 1)[0]); # unbuffer pipe + $kidpid; +} +1; # so require is happy + diff --git a/lib/Math/BigFloat.pm b/lib/Math/BigFloat.pm new file mode 100644 index 0000000..92e7016 --- /dev/null +++ b/lib/Math/BigFloat.pm @@ -0,0 +1,297 @@ +package Math::BigFloat; + +use Math::BigInt; + +use Exporter; # just for use to be happy +@ISA = (Exporter); + +%OVERLOAD = ( + # Anonymous subroutines: +'+' => sub {new BigFloat &fadd}, +'-' => sub {new BigFloat + $_[2]? fsub($_[1],${$_[0]}) : fsub(${$_[0]},$_[1])}, +'<=>' => sub {new BigFloat + $_[2]? fcmp($_[1],${$_[0]}) : fcmp(${$_[0]},$_[1])}, +'cmp' => sub {new BigFloat + $_[2]? ($_[1] cmp ${$_[0]}) : (${$_[0]} cmp $_[1])}, +'*' => sub {new BigFloat &fmul}, +'/' => sub {new BigFloat + $_[2]? scalar fdiv($_[1],${$_[0]}) : + scalar fdiv(${$_[0]},$_[1])}, +'neg' => sub {new BigFloat &fneg}, +'abs' => sub {new BigFloat &fabs}, + +qw( +"" stringify +0+ numify) # Order of arguments unsignificant +); + +sub new { + my $foo = fnorm($_[1]); + panic("Not a number initialized to BigFloat") if $foo eq "NaN"; + bless \$foo; +} +sub numify { 0 + "${$_[0]}" } # Not needed, additional overhead + # comparing to direct compilation based on + # stringify +sub stringify { + my $n = ${$_[0]}; + + $n =~ s/^\+//; + $n =~ s/E//; + + $n =~ s/([-+]\d+)$//; + + my $e = $1; + my $ln = length($n); + + if ($e > 0) { + $n .= "0" x $e . '.'; + } elsif (abs($e) < $ln) { + substr($n, $ln + $e, 0) = '.'; + } else { + $n = '.' . ("0" x (abs($e) - $ln)) . $n; + } + + # 1 while $n =~ s/(.*\d)(\d\d\d)/$1,$2/; + + return $n; +} + +# Arbitrary length float math package +# +# by Mark Biggar +# +# number format +# canonical strings have the form /[+-]\d+E[+-]\d+/ +# Input values can have inbedded whitespace +# Error returns +# 'NaN' An input parameter was "Not a Number" or +# divide by zero or sqrt of negative number +# Division is computed to +# max($div_scale,length(dividend)+length(divisor)) +# digits by default. +# Also used for default sqrt scale + +$div_scale = 40; + +# Rounding modes one of 'even', 'odd', '+inf', '-inf', 'zero' or 'trunc'. + +$rnd_mode = 'even'; + +sub fadd; sub fsub; sub fmul; sub fdiv; +sub fneg; sub fabs; sub fcmp; +sub fround; sub ffround; +sub fnorm; sub fsqrt; + +# bigfloat routines +# +# fadd(NSTR, NSTR) return NSTR addition +# fsub(NSTR, NSTR) return NSTR subtraction +# fmul(NSTR, NSTR) return NSTR multiplication +# fdiv(NSTR, NSTR[,SCALE]) returns NSTR division to SCALE places +# fneg(NSTR) return NSTR negation +# fabs(NSTR) return NSTR absolute value +# fcmp(NSTR,NSTR) return CODE compare undef,<0,=0,>0 +# fround(NSTR, SCALE) return NSTR round to SCALE digits +# ffround(NSTR, SCALE) return NSTR round at SCALEth place +# fnorm(NSTR) return (NSTR) normalize +# fsqrt(NSTR[, SCALE]) return NSTR sqrt to SCALE places + + +# Convert a number to canonical string form. +# Takes something that looks like a number and converts it to +# the form /^[+-]\d+E[+-]\d+$/. +sub fnorm { #(string) return fnum_str + local($_) = @_; + s/\s+//g; # strip white space + if (/^([+-]?)(\d*)(\.(\d*))?([Ee]([+-]?\d+))?$/ && "$2$4" ne '') { + &norm(($1 ? "$1$2$4" : "+$2$4"),(($4 ne '') ? $6-length($4) : $6)); + } else { + 'NaN'; + } +} + +# normalize number -- for internal use +sub norm { #(mantissa, exponent) return fnum_str + local($_, $exp) = @_; + if ($_ eq 'NaN') { + 'NaN'; + } else { + s/^([+-])0+/$1/; # strip leading zeros + if (length($_) == 1) { + '+0E+0'; + } else { + $exp += length($1) if (s/(0+)$//); # strip trailing zeros + sprintf("%sE%+ld", $_, $exp); + } + } +} + +# negation +sub fneg { #(fnum_str) return fnum_str + local($_) = fnorm($_[$[]); + vec($_,0,8) ^= ord('+') ^ ord('-') unless $_ eq '+0E+0'; # flip sign + s/^H/N/; + $_; +} + +# absolute value +sub fabs { #(fnum_str) return fnum_str + local($_) = fnorm($_[$[]); + s/^-/+/; # mash sign + $_; +} + +# multiplication +sub fmul { #(fnum_str, fnum_str) return fnum_str + local($x,$y) = (fnorm($_[$[]),fnorm($_[$[+1])); + if ($x eq 'NaN' || $y eq 'NaN') { + 'NaN'; + } else { + local($xm,$xe) = split('E',$x); + local($ym,$ye) = split('E',$y); + &norm(Math::BigInt::bmul($xm,$ym),$xe+$ye); + } +} + +# addition +sub fadd { #(fnum_str, fnum_str) return fnum_str + local($x,$y) = (fnorm($_[$[]),fnorm($_[$[+1])); + if ($x eq 'NaN' || $y eq 'NaN') { + 'NaN'; + } else { + local($xm,$xe) = split('E',$x); + local($ym,$ye) = split('E',$y); + ($xm,$xe,$ym,$ye) = ($ym,$ye,$xm,$xe) if ($xe < $ye); + &norm(Math::BigInt::badd($ym,$xm.('0' x ($xe-$ye))),$ye); + } +} + +# subtraction +sub fsub { #(fnum_str, fnum_str) return fnum_str + fadd($_[$[],fneg($_[$[+1])); +} + +# division +# args are dividend, divisor, scale (optional) +# result has at most max(scale, length(dividend), length(divisor)) digits +sub fdiv #(fnum_str, fnum_str[,scale]) return fnum_str +{ + local($x,$y,$scale) = (fnorm($_[$[]),fnorm($_[$[+1]),$_[$[+2]); + if ($x eq 'NaN' || $y eq 'NaN' || $y eq '+0E+0') { + 'NaN'; + } else { + local($xm,$xe) = split('E',$x); + local($ym,$ye) = split('E',$y); + $scale = $div_scale if (!$scale); + $scale = length($xm)-1 if (length($xm)-1 > $scale); + $scale = length($ym)-1 if (length($ym)-1 > $scale); + $scale = $scale + length($ym) - length($xm); + &norm(&round(Math::BigInt::bdiv($xm.('0' x $scale),$ym),$ym), + $xe-$ye-$scale); + } +} + +# round int $q based on fraction $r/$base using $rnd_mode +sub round { #(int_str, int_str, int_str) return int_str + local($q,$r,$base) = @_; + if ($q eq 'NaN' || $r eq 'NaN') { + 'NaN'; + } elsif ($rnd_mode eq 'trunc') { + $q; # just truncate + } else { + local($cmp) = Math::BigInt::bcmp(Math::BigInt::bmul($r,'+2'),$base); + if ( $cmp < 0 || + ($cmp == 0 && + ( $rnd_mode eq 'zero' || + ($rnd_mode eq '-inf' && (substr($q,$[,1) eq '+')) || + ($rnd_mode eq '+inf' && (substr($q,$[,1) eq '-')) || + ($rnd_mode eq 'even' && $q =~ /[24680]$/) || + ($rnd_mode eq 'odd' && $q =~ /[13579]$/) )) ) { + $q; # round down + } else { + Math::BigInt::badd($q, ((substr($q,$[,1) eq '-') ? '-1' : '+1')); + # round up + } + } +} + +# round the mantissa of $x to $scale digits +sub fround { #(fnum_str, scale) return fnum_str + local($x,$scale) = (fnorm($_[$[]),$_[$[+1]); + if ($x eq 'NaN' || $scale <= 0) { + $x; + } else { + local($xm,$xe) = split('E',$x); + if (length($xm)-1 <= $scale) { + $x; + } else { + &norm(&round(substr($xm,$[,$scale+1), + "+0".substr($xm,$[+$scale+1,1),"+10"), + $xe+length($xm)-$scale-1); + } + } +} + +# round $x at the 10 to the $scale digit place +sub ffround { #(fnum_str, scale) return fnum_str + local($x,$scale) = (fnorm($_[$[]),$_[$[+1]); + if ($x eq 'NaN') { + 'NaN'; + } else { + local($xm,$xe) = split('E',$x); + if ($xe >= $scale) { + $x; + } else { + $xe = length($xm)+$xe-$scale; + if ($xe < 1) { + '+0E+0'; + } elsif ($xe == 1) { + &norm(&round('+0',"+0".substr($xm,$[+1,1),"+10"), $scale); + } else { + &norm(&round(substr($xm,$[,$xe), + "+0".substr($xm,$[+$xe,1),"+10"), $scale); + } + } + } +} + +# compare 2 values returns one of undef, <0, =0, >0 +# returns undef if either or both input value are not numbers +sub fcmp #(fnum_str, fnum_str) return cond_code +{ + local($x, $y) = (fnorm($_[$[]),fnorm($_[$[+1])); + if ($x eq "NaN" || $y eq "NaN") { + undef; + } else { + 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)) + ); + } +} + +# square root by Newtons method. +sub fsqrt { #(fnum_str[, scale]) return fnum_str + local($x, $scale) = (fnorm($_[$[]), $_[$[+1]); + if ($x eq 'NaN' || $x =~ /^-/) { + 'NaN'; + } elsif ($x eq '+0E+0') { + '+0E+0'; + } else { + local($xm, $xe) = split('E',$x); + $scale = $div_scale if (!$scale); + $scale = length($xm)-1 if ($scale < length($xm)-1); + local($gs, $guess) = (1, sprintf("1E%+d", (length($xm)+$xe-1)/2)); + while ($gs < 2*$scale) { + $guess = fmul(fadd($guess,fdiv($x,$guess,$gs*2)),".5"); + $gs *= 2; + } + new BigFloat &fround($guess, $scale); + } +} + +1; diff --git a/lib/Math/BigInt.pm b/lib/Math/BigInt.pm new file mode 100644 index 0000000..3e0fc17 --- /dev/null +++ b/lib/Math/BigInt.pm @@ -0,0 +1,347 @@ +package Math::BigInt; + +%OVERLOAD = ( + # Anonymous subroutines: +'+' => sub {new BigInt &badd}, +'-' => sub {new BigInt + $_[2]? bsub($_[1],${$_[0]}) : bsub(${$_[0]},$_[1])}, +'<=>' => sub {new BigInt + $_[2]? bcmp($_[1],${$_[0]}) : bcmp(${$_[0]},$_[1])}, +'cmp' => sub {new BigInt + $_[2]? ($_[1] cmp ${$_[0]}) : (${$_[0]} cmp $_[1])}, +'*' => sub {new BigInt &bmul}, +'/' => sub {new BigInt + $_[2]? scalar bdiv($_[1],${$_[0]}) : + scalar bdiv(${$_[0]},$_[1])}, +'%' => sub {new BigInt + $_[2]? bmod($_[1],${$_[0]}) : bmod(${$_[0]},$_[1])}, +'**' => sub {new BigInt + $_[2]? bpow($_[1],${$_[0]}) : bpow(${$_[0]},$_[1])}, +'neg' => sub {new BigInt &bneg}, +'abs' => sub {new BigInt &babs}, + +qw( +"" stringify +0+ numify) # Order of arguments unsignificant +); + +sub new { + my $foo = bnorm($_[1]); + die "Not a number initialized to BigInt" if $foo eq "NaN"; + bless \$foo; +} +sub stringify { "${$_[0]}" } +sub numify { 0 + "${$_[0]}" } # Not needed, additional overhead + # comparing to direct compilation based on + # stringify + +# arbitrary size integer math package +# +# by Mark Biggar +# +# Canonical Big integer value are strings of the form +# /^[+-]\d+$/ with leading zeros suppressed +# Input values to these routines may be strings of the form +# /^\s*[+-]?[\d\s]+$/. +# Examples: +# '+0' canonical zero value +# ' -123 123 123' canonical value '-123123123' +# '1 23 456 7890' canonical value '+1234567890' +# Output values always always in canonical form +# +# Actual math is done in an internal format consisting of an array +# whose first element is the sign (/^[+-]$/) and whose remaining +# elements are base 100000 digits with the least significant digit first. +# The string 'NaN' is used to represent the result when input arguments +# are not numbers, as well as the result of dividing by zero +# +# routines provided are: +# +# bneg(BINT) return BINT negation +# babs(BINT) return BINT absolute value +# bcmp(BINT,BINT) return CODE compare numbers (undef,<0,=0,>0) +# badd(BINT,BINT) return BINT addition +# bsub(BINT,BINT) return BINT subtraction +# bmul(BINT,BINT) return BINT multiplication +# bdiv(BINT,BINT) return (BINT,BINT) division (quo,rem) just quo if scalar +# bmod(BINT,BINT) return BINT modulus +# bgcd(BINT,BINT) return BINT greatest common divisor +# bnorm(BINT) return BINT normalization +# + +$zero = 0; + + +# normalize string form of number. Strip leading zeros. Strip any +# white space and add a sign, if missing. +# Strings that are not numbers result the value 'NaN'. + +sub bnorm { #(num_str) return num_str + local($_) = @_; + s/\s+//g; # strip white space + if (s/^([+-]?)0*(\d+)$/$1$2/) { # test if number + substr($_,$[,0) = '+' unless $1; # Add missing sign + s/^-0/+0/; + $_; + } else { + 'NaN'; + } +} + +# Convert a number from string format to internal base 100000 format. +# Assumes normalized value as input. +sub internal { #(num_str) return int_num_array + local($d) = @_; + ($is,$il) = (substr($d,$[,1),length($d)-2); + substr($d,$[,1) = ''; + ($is, reverse(unpack("a" . ($il%5+1) . ("a5" x ($il/5)), $d))); +} + +# Convert a number from internal base 100000 format to string format. +# This routine scribbles all over input array. +sub external { #(int_num_array) return num_str + $es = shift; + grep($_ > 9999 || ($_ = substr('0000'.$_,-5)), @_); # zero pad + &bnorm(join('', $es, reverse(@_))); # reverse concat and normalize +} + +# Negate input value. +sub bneg { #(num_str) return num_str + local($_) = &bnorm(@_); + vec($_,0,8) ^= ord('+') ^ ord('-') unless $_ eq '+0'; + s/^H/N/; + $_; +} + +# Returns the absolute value of the input. +sub babs { #(num_str) return num_str + &abs(&bnorm(@_)); +} + +sub abs { # post-normalized abs for internal use + local($_) = @_; + s/^-/+/; + $_; +} + +# Compares 2 values. Returns one of undef, <0, =0, >0. (suitable for sort) +sub bcmp { #(num_str, num_str) return cond_code + local($x,$y) = (&bnorm($_[$[]),&bnorm($_[$[+1])); + if ($x eq 'NaN') { + undef; + } elsif ($y eq 'NaN') { + undef; + } else { + &cmp($x,$y); + } +} + +sub cmp { # post-normalized compare for internal use + local($cx, $cy) = @_; + $cx cmp $cy + && + ( + ord($cy) <=> ord($cx) + || + ($cx cmp ',') * (length($cy) <=> length($cx) || $cy cmp $cx) + ); +} + +sub badd { #(num_str, num_str) return num_str + local(*x, *y); ($x, $y) = (&bnorm($_[$[]),&bnorm($_[$[+1])); + if ($x eq 'NaN') { + 'NaN'; + } elsif ($y eq 'NaN') { + 'NaN'; + } else { + @x = &internal($x); # convert to internal form + @y = &internal($y); + local($sx, $sy) = (shift @x, shift @y); # get signs + if ($sx eq $sy) { + &external($sx, &add(*x, *y)); # if same sign add + } else { + ($x, $y) = (&abs($x),&abs($y)); # make abs + if (&cmp($y,$x) > 0) { + &external($sy, &sub(*y, *x)); + } else { + &external($sx, &sub(*x, *y)); + } + } + } +} + +sub bsub { #(num_str, num_str) return num_str + &badd($_[$[],&bneg($_[$[+1])); +} + +# GCD -- Euclids algorithm Knuth Vol 2 pg 296 +sub bgcd { #(num_str, num_str) return num_str + local($x,$y) = (&bnorm($_[$[]),&bnorm($_[$[+1])); + if ($x eq 'NaN' || $y eq 'NaN') { + 'NaN'; + } else { + ($x, $y) = ($y,&bmod($x,$y)) while $y ne '+0'; + $x; + } +} + +# routine to add two base 1e5 numbers +# stolen from Knuth Vol 2 Algorithm A pg 231 +# there are separate routines to add and sub as per Kunth pg 233 +sub add { #(int_num_array, int_num_array) return int_num_array + local(*x, *y) = @_; + $car = 0; + for $x (@x) { + last unless @y || $car; + $x -= 1e5 if $car = (($x += shift(@y) + $car) >= 1e5); + } + for $y (@y) { + last unless $car; + $y -= 1e5 if $car = (($y += $car) >= 1e5); + } + (@x, @y, $car); +} + +# subtract base 1e5 numbers -- stolen from Knuth Vol 2 pg 232, $x > $y +sub sub { #(int_num_array, int_num_array) return int_num_array + local(*sx, *sy) = @_; + $bar = 0; + for $sx (@sx) { + last unless @y || $bar; + $sx += 1e5 if $bar = (($sx -= shift(@sy) + $bar) < 0); + } + @sx; +} + +# multiply two numbers -- stolen from Knuth Vol 2 pg 233 +sub bmul { #(num_str, num_str) return num_str + local(*x, *y); ($x, $y) = (&bnorm($_[$[]), &bnorm($_[$[+1])); + if ($x eq 'NaN') { + 'NaN'; + } elsif ($y eq 'NaN') { + 'NaN'; + } else { + @x = &internal($x); + @y = &internal($y); + &external(&mul(*x,*y)); + } +} + +# multiply two numbers in internal representation +# destroys the arguments, supposes that two arguments are different +sub mul { #(*int_num_array, *int_num_array) return int_num_array + local(*x, *y) = (shift, shift); + local($signr) = (shift @x ne shift @y) ? '-' : '+'; + @prod = (); + for $x (@x) { + ($car, $cty) = (0, $[); + for $y (@y) { + $prod = $x * $y + $prod[$cty] + $car; + $prod[$cty++] = + $prod - ($car = int($prod * 1e-5)) * 1e5; + } + $prod[$cty] += $car if $car; + $x = shift @prod; + } + ($signr, @x, @prod); +} + +# modulus +sub bmod { #(num_str, num_str) return num_str + (&bdiv(@_))[$[+1]; +} + +sub bdiv { #(dividend: num_str, divisor: num_str) return num_str + local (*x, *y); ($x, $y) = (&bnorm($_[$[]), &bnorm($_[$[+1])); + return wantarray ? ('NaN','NaN') : 'NaN' + if ($x eq 'NaN' || $y eq 'NaN' || $y eq '+0'); + return wantarray ? ('+0',$x) : '+0' if (&cmp(&abs($x),&abs($y)) < 0); + @x = &internal($x); @y = &internal($y); + $srem = $y[$[]; + $sr = (shift @x ne shift @y) ? '-' : '+'; + $car = $bar = $prd = 0; + if (($dd = int(1e5/($y[$#y]+1))) != 1) { + for $x (@x) { + $x = $x * $dd + $car; + $x -= ($car = int($x * 1e-5)) * 1e5; + } + push(@x, $car); $car = 0; + for $y (@y) { + $y = $y * $dd + $car; + $y -= ($car = int($y * 1e-5)) * 1e5; + } + } + else { + push(@x, 0); + } + @q = (); ($v2,$v1) = @y[-2,-1]; + while ($#x > $#y) { + ($u2,$u1,$u0) = @x[-3..-1]; + $q = (($u0 == $v1) ? 99999 : int(($u0*1e5+$u1)/$v1)); + --$q while ($v2*$q > ($u0*1e5+$u1-$q*$v1)*1e5+$u2); + if ($q) { + ($car, $bar) = (0,0); + for ($y = $[, $x = $#x-$#y+$[-1; $y <= $#y; ++$y,++$x) { + $prd = $q * $y[$y] + $car; + $prd -= ($car = int($prd * 1e-5)) * 1e5; + $x[$x] += 1e5 if ($bar = (($x[$x] -= $prd + $bar) < 0)); + } + if ($x[$#x] < $car + $bar) { + $car = 0; --$q; + for ($y = $[, $x = $#x-$#y+$[-1; $y <= $#y; ++$y,++$x) { + $x[$x] -= 1e5 + if ($car = (($x[$x] += $y[$y] + $car) > 1e5)); + } + } + } + pop(@x); unshift(@q, $q); + } + if (wantarray) { + @d = (); + if ($dd != 1) { + $car = 0; + for $x (reverse @x) { + $prd = $car * 1e5 + $x; + $car = $prd - ($tmp = int($prd / $dd)) * $dd; + unshift(@d, $tmp); + } + } + else { + @d = @x; + } + (&external($sr, @q), &external($srem, @d, $zero)); + } else { + &external($sr, @q); + } +} + +# compute power of two numbers -- stolen from Knuth Vol 2 pg 233 +sub bpow { #(num_str, num_str) return num_str + local(*x, *y); ($x, $y) = (&bnorm($_[$[]), &bnorm($_[$[+1])); + if ($x eq 'NaN') { + 'NaN'; + } elsif ($y eq 'NaN') { + 'NaN'; + } elsif ($x eq '+1') { + '+1'; + } elsif ($x eq '-1') { + &bmod($x,2) ? '-1': '+1'; + } elsif ($y =~ /^-/) { + 'NaN'; + } elsif ($x eq '+0' && $y eq '+0') { + 'NaN'; + } else { + @x = &internal($x); + local(@pow2)=@x; + local(@pow)=&internal("+1"); + local($y1,$res,@tmp1,@tmp2)=(1); # need tmp to send to mul + while ($y ne '+0') { + ($y,$res)=&bdiv($y,2); + if ($res ne '+0') {@tmp=@pow2; @pow=&mul(*pow,*tmp);} + if ($y ne '+0') {@tmp=@pow2;@pow2=&mul(*pow2,*tmp);} + } + &external(@pow); + } +} + +1; diff --git a/lib/Math/Complex.pm b/lib/Math/Complex.pm new file mode 100644 index 0000000..a5a40b2 --- /dev/null +++ b/lib/Math/Complex.pm @@ -0,0 +1,136 @@ +# +# Perl5 Package for complex numbers +# +# 1994 by David Nadler +# Coding know-how provided by Tom Christiansen, Tim Bunce, and Larry Wall +# sqrt() added by Tom Christiansen; beware should have two roots, +# but only returns one. (use wantarray?) +# +# +# The functions "Re", "Im", and "arg" are provided. +# "~" is used as the conjugation operator and "abs" is overloaded. +# +# Transcendental functions overloaded: so far only sin, cos, and exp. +# + +package Math::Complex; + +require Exporter; + +@ISA = ('Exporter'); + +# just to make use happy + +%OVERLOAD= ( + '+' => sub { my($x1,$y1,$x2,$y2) = (@{$_[0]},@{$_[1]}); + bless [ $x1+$x2, $y1+$y2]; + }, + + '-' => sub { my($x1,$y1,$x2,$y2) = (@{$_[0]},@{$_[1]}); + bless [ $x1-$x2, $y1-$y2]; + }, + + '*' => sub { my($x1,$y1,$x2,$y2) = (@{$_[0]},@{$_[1]}); + bless [ $x1*$x2-$y1*$y2,$x1*$y2+$x2*$y1]; + }, + + '/' => sub { my($x1,$y1,$x2,$y2) = (@{$_[0]},@{$_[1]}); + my $q = $x2*$x2+$y2*$y2; + bless [($x1*$x2+$y1*$y2)/$q, ($y1*$x2-$y2*$x1)/$q]; + }, + + 'neg' => sub { my($x,$y) = @{$_[0]}; bless [ -$x, -$y]; + }, + + '~' => sub { my($x,$y) = @{$_[0]}; bless [ $x, -$y]; + }, + + 'abs' => sub { my($x,$y) = @{$_[0]}; sqrt $x*$x+$y*$y; + }, + + 'cos' => sub { my($x,$y) = @{$_[0]}; + my ($ab,$c,$s) = (exp $y, cos $x, sin $x); + my $abr = 1/(2*$ab); $ab /= 2; + bless [ ($abr+$ab)*$c, ($abr-$ab)*$s]; + }, + + 'sin' => sub { my($x,$y) = @{$_[0]}; + my ($ab,$c,$s) = (exp $y, cos $x, sin $x); + my $abr = 1/(2*$ab); $ab /= 2; + bless [ (-$abr-$ab)*$s, ($abr-$ab)*$c]; + }, + + 'exp' => sub { my($x,$y) = @{$_[0]}; + my ($ab,$c,$s) = (exp $x, cos $y, sin $y); + bless [ $ab*$c, $ab*$s ]; + }, + + 'sqrt' => sub { + my($zr,$zi) = @{$_[0]}; + my ($x, $y, $r, $w); + my $c = new Math::Complex (0,0); + if (($zr == 0) && ($zi == 0)) { + # nothing, $c already set + } + else { + $x = abs($zr); + $y = abs($zi); + if ($x >= $y) { + $r = $y/$x; + $w = sqrt($x) * sqrt(0.5*(1.0+sqrt(1.0+$r*$r))); + } + else { + $r = $x/$y; + $w = sqrt($y) * sqrt($y) * sqrt(0.5*($r+sqrt(1.0+$r*$r))); + } + if ( $zr >= 0) { + @$c = ($w, $zi/(2 * $w) ); + } + else { + $c->[1] = ($zi >= 0) ? $w : -$w; + $c->[0] = $zi/(2.0* $c->[1]); + } + } + return $c; + }, + + qw("" stringify) +); + +sub new { + shift; + my @C = @_; + bless \@C; +} + +sub Re { + my($x,$y) = @{$_[0]}; + $x; +} + +sub Im { + my($x,$y) = @{$_[0]}; + $y; +} + +sub arg { + my($x,$y) = @{$_[0]}; + atan2($y,$x); +} + +sub stringify { + my($x,$y) = @{$_[0]}; + my($re,$im); + + $re = $x if ($x); + if ($y == 1) {$im = 'i';} + elsif ($y == -1){$im = '-i';} + elsif ($y) {$im = "${y}i"; } + + local $_ = $re.'+'.$im; + s/\+-/-/; + s/^\+//; + s/[\+-]$//; + $_ = 0 if ($_ eq ''); + return $_; +} diff --git a/lib/NDBM_File.pm b/lib/NDBM_File.pm deleted file mode 100644 index 637001f..0000000 --- a/lib/NDBM_File.pm +++ /dev/null @@ -1,9 +0,0 @@ -package NDBM_File; - -require Exporter; -@ISA = (Exporter, DynamicLoader); -@EXPORT = split(' ', 'new fetch store delete firstkey nextkey error clearerr'); - -bootstrap NDBM_File; - -1; diff --git a/lib/Net/Ping.pm b/lib/Net/Ping.pm new file mode 100644 index 0000000..2528f55 --- /dev/null +++ b/lib/Net/Ping.pm @@ -0,0 +1,64 @@ +package Net::Ping; + +# Authors: karrer@bernina.ethz.ch (Andreas Karrer) +# pmarquess@bfsec.bt.co.uk (Paul Marquess) + +require Exporter; + +@ISA = qw(Exporter); +@EXPORT = qw(ping pingecho); + +use Socket; +use Carp ; + +$tcp_proto = (getprotobyname('tcp'))[2]; +$echo_port = (getservbyname('echo', 'tcp'))[2]; + +sub ping { + croak "ping not implemented yet. Use pingecho()"; +} + + +sub pingecho { + + croak "usage: pingecho host [timeout]" + unless @_ == 1 || @_ == 2 ; + + local ($host, $timeout) = @_; + local (*PINGSOCK); + local ($saddr, $ip); + local ($ret) ; + + # check if $host is alive by connecting to its echo port, within $timeout + # (default 5) seconds. returns 1 if OK, 0 if no answer, 0 if host not found + + $timeout = 5 unless $timeout; + + if ($host =~ /^\s*((\d+\.){3}\d+)\s*$/) + { $ip = pack ('C4', split (/\./, $1)) } + else + { $ip = (gethostbyname($host))[4] } + + return 0 unless $ip; # "no such host" + + $saddr = pack('S n a4 x8', AF_INET, $echo_port, $ip); + $SIG{'ALRM'} = sub { die } ; + alarm($timeout); + + $ret = eval <<'EOM' ; + + return 0 + unless socket(PINGSOCK, PF_INET, SOCK_STREAM, $tcp_proto) ; + + return 0 + unless connect(PINGSOCK, $saddr) ; + + return 1 ; +EOM + + alarm(0); + close(PINGSOCK); + $ret == 1 ? 1 : 0 ; +} + +1; diff --git a/lib/POSIX.pm b/lib/POSIX.pm deleted file mode 100644 index e2ccbcc..0000000 --- a/lib/POSIX.pm +++ /dev/null @@ -1,1232 +0,0 @@ -package POSIX; - -require Exporter; -require AutoLoader; -@ISA = (Exporter, AutoLoader, DynamicLoader); - -$H{assert_h} = [qw(assert NDEBUG)]; - -$H{ctype_h} = [qw(isalnum isalpha iscntrl isdigit isgraph islower - isprint ispunct isspace isupper isxdigit tolower toupper)]; - -$H{dirent_h} = [qw(closedir opendir readdir rewinddir)]; - -$H{errno_h} = [qw(E2BIG EACCES EAGAIN EBADF EBUSY ECHILD EDEADLK EDOM - EEXIST EFAULT EFBIG EINTR EINVAL EIO EISDIR EMFILE - EMLINK ENAMETOOLONG ENFILE ENODEV ENOENT ENOEXEC ENOLCK - ENOMEM ENOSPC ENOSYS ENOTDIR ENOTEMPTY ENOTTY ENXIO - EPERM EPIPE ERANGE EROFS ESPIPE ESRCH EXDEV errno)]; - -$H{fcntl_h} = [qw(FD_CLOEXEC F_DUPFD F_GETFD F_GETFL F_GETLK F_RDLCK - F_SETFD F_SETFL F_SETLK F_SETLKW F_UNLCK F_WRLCK - O_ACCMODE O_APPEND O_CREAT O_EXCL O_NOCTTY O_NONBLOCK - O_RDONLY O_RDWR O_TRUNC O_WRONLY - creat fcntl open - SEEK_CUR SEEK_END SEEK_SET - S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU - S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISGID S_ISREG S_ISUID - S_IWGRP S_IWOTH S_IWUSR)]; - -$H{float_h} = [qw(DBL_DIG DBL_EPSILON DBL_MANT_DIG - DBL_MAX DBL_MAX_10_EXP DBL_MAX_EXP - DBL_MIN DBL_MIN_10_EXP DBL_MIN_EXP - FLT_DIG FLT_EPSILON FLT_MANT_DIG - FLT_MAX FLT_MAX_10_EXP FLT_MAX_EXP - FLT_MIN FLT_MIN_10_EXP FLT_MIN_EXP - FLT_RADIX FLT_ROUNDS - LDBL_DIG LDBL_EPSILON LDBL_MANT_DIG - LDBL_MAX LDBL_MAX_10_EXP LDBL_MAX_EXP - LDBL_MIN LDBL_MIN_10_EXP LDBL_MIN_EXP)]; - -$H{grp_h} = [qw(getgrgid getgrnam)]; - -$H{limits_h} = [qw( ARG_MAX CHAR_BIT CHAR_MAX CHAR_MIN CHILD_MAX - INT_MAX INT_MIN LINK_MAX LONG_MAX LONG_MIN MAX_CANON - MAX_INPUT MB_LEN_MAX NAME_MAX NGROUPS_MAX OPEN_MAX - PATH_MAX PIPE_BUF SCHAR_MAX SCHAR_MIN SHRT_MAX SHRT_MIN - SSIZE_MAX STREAM_MAX TZNAME_MAX UCHAR_MAX UINT_MAX - ULONG_MAX USHRT_MAX _POSIX_ARG_MAX _POSIX_CHILD_MAX - _POSIX_LINK_MAX _POSIX_MAX_CANON _POSIX_MAX_INPUT - _POSIX_NAME_MAX _POSIX_NGROUPS_MAX _POSIX_OPEN_MAX - _POSIX_PATH_MAX _POSIX_PIPE_BUF _POSIX_SSIZE_MAX - _POSIX_STREADM_MAX _POSIX_TZNAME_MAX)]; - -$H{locale_h} = [qw(LC_ALL LC_COLLATE LC_CTYPE LC_MONETARY LC_NUMERIC - LC_TIME NULL localeconv setlocale)]; - -$H{math_h} = [qw(HUGE_VAL acos asin atan2 atan ceil cos cosh exp - fabs floor fmod frexp ldexp log10 log modf pow sin sinh - sqrt tan tanh)]; - -$H{pwd_h} = [qw(getpwnam getpwuid)]; - -$H{setjmp_h} = [qw(longjmp setjmp siglongjmp sigsetjmp)]; - -$H{signal_h} = [qw(SA_NOCLDSTOP SIGABRT SIGALRM SIGCHLD SIGCONT SIGFPE - SIGHUP SIGILL SIGINT SIGKILL SIGPIPE SIGQUIT SIGSEGV - SIGSTOP SIGTERM SIGTSTP SIGTTIN SIGTTOU SIGUSR1 SIGUSR2 - SIG_BLOCK SIG_DFL SIG_ERR SIG_IGN SIG_SETMASK SIG_UNBLOCK - kill raise sigaction signal sigpending sigprocmask - sigsuspend)]; - -$H{stdarg_h} = [qw()]; - -$H{stddef_h} = [qw(NULL offsetof)]; - -$H{stdio_h} = [qw(BUFSIZ EOF FILENAME_MAX L_ctermid L_cuserid - L_tmpname NULL SEEK_CUR SEEK_END SEEK_SET STREAM_MAX - TMP_MAX stderr stdin stdout _IOFBF _IOLBF _IONBF - clearerr fclose fdopen feof ferror fflush fgetc fgetpos - fgets fileno fopen fprintf fputc fputs fread freopen - fscanf fseek fsetpos ftell fwrite getc getchar gets - perror printf putc putchar puts remove rename rewind - scanf setbuf setvbuf sprintf sscanf tmpfile tmpnam - ungetc vfprintf vprintf vsprintf)]; - -$H{stdlib_h} = [qw(EXIT_FAILURE EXIT_SUCCESS MB_CUR_MAX NULL RAND_MAX - abort abs atexit atof atoi atol bsearch calloc div exit - free getenv labs ldiv malloc mblen mbstowcs mbtowc - qsort rand realloc srand strtod strtol stroul system - wcstombs wctomb)]; - -$H{string_h} = [qw(NULL memchr memcmp memcpy memmove memset strcat - strchr strcmp strcoll strcpy strcspn strerror strlen - strncat strncmp strncpy strpbrk strrchr strspn strstr - strtok strxfrm)]; - -$H{sys_stat_h} = [qw(S_IRGRP S_IROTH S_IRUSR S_IRWXG S_IRWXO S_IRWXU - S_ISBLK S_ISCHR S_ISDIR S_ISFIFO S_ISGID S_ISREG - S_ISUID S_IWGRP S_IWOTH S_IWUSR S_IXGRP S_IXOTH S_IXUSR - chmod fstat mkdir mkfifo stat umask)]; - -$H{sys_times_h} = [qw(times)]; - -$H{sys_types_h} = [qw()]; - -$H{sys_utsname_h} = [qw(uname)]; - -$H{sys_wait_h} = [qw(WEXITSTATUS WIFEXITED WIFSIGNALED WIFSTOPPED - WNOHANG WSTOPSIG WTERMSIG WUNTRACED wait waitpid)]; - -$H{termios_h} = [qw( B0 B110 B1200 B134 B150 B1800 B19200 B200 B2400 - B300 B38400 B4800 B50 B600 B75 B9600 BRKINT CLOCAL - CREAD CS5 CS6 CS7 CS8 CSIZE CSTOPB ECHO ECHOE ECHOK - ECHONL HUPCL ICANON ICRNL IEXTEN IGNBRK IGNCR IGNPAR - INLCR INPCK ISIG ISTRIP IXOFF IXON NCCS NOFLSH OPOST - PARENB PARMRK PARODD TCIFLUSH TCIOFF TCIOFLUSH TCION - TCOFLUSH TCOOFF TCOON TCSADRAIN TCSAFLUSH TCSANOW - TOSTOP VEOF VEOL VERASE VINTR VKILL VMIN VQUIT VSTART - VSTOP VSUSP VTIME - cfgetispeed cfgetospeed cfsetispeed cfsetospeed tcdrain - tcflow tcflush tcgetattr tcsendbreak tcsetattr )]; - -$H{time_h} = [qw(CLK_TCK CLOCKS_PER_SEC NULL asctime clock ctime - difftime gmtime localtime mktime strftime time tzset tzname)]; - -$H{unistd_h} = [qw(F_OK NULL R_OK SEEK_CUR SEEK_END SEEK_SET - STRERR_FILENO STDIN_FILENO STDOUT_FILENO W_OK X_OK - _PC_CHOWN_RESTRICTED _PC_LINK_MAX _PC_MAX_CANON - _PC_MAX_INPUT _PC_NAME_MAX _PC_NO_TRUNC _PC_PATH_MAX - _PC_PIPE_BUF _PC_VDISABLE _POSIX_CHOWN_RESTRICTED - _POSIX_JOB_CONTROL _POSIX_NO_TRUNC _POSIX_SAVED_IDS - _POSIX_VDISABLE _POSIX_VERSION _SC_ARG_MAX - _SC_CHILD_MAX _SC_CLK_TCK _SC_JOB_CONTROL - _SC_NGROUPS_MAX _SC_OPEN_MAX _SC_SAVED_IDS - _SC_STREAM_MAX _SC_TZNAME_MAX _SC_VERSION - _exit access alarm chdir chown close ctermid cuserid - dup2 dup execl execle execlp execv execve execvp fork - fpathconf getcwd getegid geteuid getgid getgroups - getlogin getpgrp getpid getppid getuid isatty link - lseek pathconf pause pipe read rmdir setgid setpgid - setsid setuid sleep sysconf tcgetpgrp tcsetpgrp ttyname - unlink write)]; - -$H{utime_h} = [qw(utime)]; - -sub expand { - local (@mylist); - foreach $entry (@_) { - if ($H{$entry}) { - push(@mylist, @{$H{$entry}}); - } - else { - push(@mylist, $entry); - } - } - @mylist; -} - -@EXPORT = expand qw(assert_h ctype_h dirent_h errno_h fcntl_h float_h - grp_h limits_h locale_h math_h pwd_h setjmp_h signal_h - stdarg_h stddef_h stdio_h stdlib_h string_h sys_stat_h - sys_times_h sys_types_h sys_utsname_h sys_wait_h - termios_h time_h unistd_h utime_h); - -sub import { - my $this = shift; - my @list = expand @_; - local $Exporter::ExportLevel = 1; - Exporter::import($this,@list); -} - -sub AUTOLOAD { - if ($AUTOLOAD =~ /::(_?[a-z])/) { - $AutoLoader::AUTOLOAD = $AUTOLOAD; - goto &AutoLoader::AUTOLOAD - } - local $constname = $AUTOLOAD; - $constname =~ s/.*:://; - $val = constant($constname, $_[0]); - if ($! != 0) { - ($pack,$file,$line) = caller; - if ($! =~ /Invalid/) { - die "$constname is not a valid POSIX macro at $file line $line.\n"; - } - else { - die "Your vendor has not defined POSIX macro $constname, used at $file line $line.\n"; - } - } - eval "sub $AUTOLOAD { $val }"; - goto &$AUTOLOAD; -} - -bootstrap POSIX; - -sub usage { - local ($mess, $pack, $file, $line) = @_; - die "Usage: POSIX::$mess at $file line $line\n"; -} - -sub unimpl { - local ($mess, $pack, $file, $line) = @_; - $mess =~ s/xxx//; - die "Unimplemented: POSIX::$mess at $file line $line\n"; -} - -$gensym = "SYM000"; - -sub gensym { - $gensym++; -} - -sub ungensym { - delete $_POSIX{$_[0]}; -} - -1; - -package POSIX::SigAction; - -sub new { - bless {HANDLER => $_[1], MASK => $_[2], FLAGS => $_[3]}; -} -__END__ - -sub assert { - usage "assert(expr)", caller if @_ != 1; - if (!$_[0]) { - local ($pack,$file,$line) = caller; - die "Assertion failed at $file line $line\n"; - } -} - -sub tolower { - usage "tolower(string)", caller if @_ != 1; - lc($_[0]); -} - -sub toupper { - usage "toupper(string)", caller if @_ != 1; - uc($_[0]); -} - -sub closedir { - usage "closedir(dirhandle)", caller if @_ != 1; - closedir($_[0]); - ungensym($_[0]); -} - -sub opendir { - usage "opendir(directory)", caller if @_ != 1; - local($dirhandle) = &gensym; - opendir($dirhandle, $_[0]) - ? $dirhandle - : (ungensym($dirhandle), undef); -} - -sub readdir { - usage "readdir(dirhandle)", caller if @_ != 1; - readdir($_[0]); -} - -sub rewinddir { - usage "rewinddir(dirhandle)", caller if @_ != 1; - rewinddir($_[0]); -} - -sub errno { - usage "errno()", caller if @_ != 0; - $! + 0; -} - -sub creat { - usage "creat(filename, mode)", caller if @_ != 2; - &open($_[0], &O_WRONLY | &O_CREAT | &O_TRUNC, $_[2]); -} - -sub fcntl { - usage "fcntl(filehandle, cmd, arg)", caller if @_ != 3; - fcntl($_[0], $_[1], $_[2]); -} - -sub getgrgid { - usage "getgrgid(gid)", caller if @_ != 1; - getgrgid($_[0]); -} - -sub getgrnam { - usage "getgrnam(name)", caller if @_ != 1; - getgrnam($_[0]); -} - -sub atan2 { - usage "atan2(x,y)", caller if @_ != 2; - atan2($_[0], $_[1]); -} - -sub cos { - usage "cos(x)", caller if @_ != 1; - cos($_[0]); -} - -sub exp { - usage "exp(x)", caller if @_ != 1; - exp($_[0]); -} - -sub fabs { - usage "fabs(x)", caller if @_ != 1; - abs($_[0]); -} - -sub log { - usage "log(x)", caller if @_ != 1; - log($_[0]); -} - -sub pow { - usage "pow(x,exponent)", caller if @_ != 2; - $_[0] ** $_[1]; -} - -sub sin { - usage "sin(x)", caller if @_ != 1; - sin($_[0]); -} - -sub sqrt { - usage "sqrt(x)", caller if @_ != 1; - sqrt($_[0]); -} - -sub tan { - usage "tan(x)", caller if @_ != 1; - tan($_[0]); -} - -sub getpwnam { - usage "getpwnam(name)", caller if @_ != 1; - getpwnam($_[0]); -} - -sub getpwuid { - usage "getpwuid(uid)", caller if @_ != 1; - getpwuid($_[0]); -} - -sub longjmp { - unimpl "longjmp() is C-specific: use die instead", caller; -} - -sub setjmp { - unimpl "setjmp() is C-specific: use eval {} instead", caller; -} - -sub siglongjmp { - unimpl "siglongjmp() is C-specific: use die instead", caller; -} - -sub sigsetjmp { - unimpl "sigsetjmp() is C-specific: use eval {} instead", caller; -} - -sub kill { - usage "kill(pid, sig)", caller if @_ != 2; - kill $_[1], $_[0]; -} - -sub raise { - usage "raise(sig)", caller if @_ != 1; - kill $$, $_[0]; # Is this good enough? -} - -sub offsetof { - unimpl "offsetof() is C-specific, stopped", caller; -} - -sub clearerr { - usage "clearerr(filehandle)", caller if @_ != 1; - seek($_[0], 0, 1); -} - -sub fclose { - unimpl "fclose() is C-specific--use close instead", caller; -} - -sub feof { - usage "feof(filehandle)", caller if @_ != 1; - eof($_[0]); -} - -sub fgetc { - usage "fgetc(filehandle)", caller if @_ != 1; - getc($_[0]); -} - -sub fgetpos { - unimpl "fgetpos(xxx)", caller if @_ != 123; - fgetpos($_[0]); -} - -sub fgets { - usage "fgets(filehandle)", caller if @_ != 1; - local($handle) = @_; - scalar <$handle>; -} - -sub fileno { - usage "fileno(filehandle)", caller if @_ != 1; - fileno($_[0]); -} - -sub fopen { - unimpl "fopen() is C-specific--use open instead", caller; -} - -sub fprintf { - unimpl "fprintf() is C-specific--use printf instead", caller; -} - -sub fputc { - unimpl "fputc() is C-specific--use print instead", caller; -} - -sub fputs { - unimpl "fputs() is C-specific--use print instead", caller; - usage "fputs(string, handle)", caller if @_ != 2; - local($handle) = pop; - print $handle @_; -} - -sub fread { - unimpl "fread() is C-specific--use read instead", caller; - unimpl "fread(xxx)", caller if @_ != 123; - fread($_[0]); -} - -sub freopen { - unimpl "freopen() is C-specific--use open instead", caller; - unimpl "freopen(xxx)", caller if @_ != 123; - freopen($_[0]); -} - -sub fscanf { - unimpl "fscanf() is C-specific--use <> and regular expressions instead", caller; - unimpl "fscanf(xxx)", caller if @_ != 123; - fscanf($_[0]); -} - -sub fseek { - unimpl "fseek() is C-specific--use seek instead", caller; - unimpl "fseek(xxx)", caller if @_ != 123; - fseek($_[0]); -} - -sub fsetpos { - unimpl "fsetpos() is C-specific--use seek instead", caller; - unimpl "fsetpos(xxx)", caller if @_ != 123; - fsetpos($_[0]); -} - -sub ftell { - unimpl "ftell() is C-specific--use tell instead", caller; - unimpl "ftell(xxx)", caller if @_ != 123; - ftell($_[0]); -} - -sub fwrite { - unimpl "fwrite() is C-specific--use print instead", caller; - unimpl "fwrite(xxx)", caller if @_ != 123; - fwrite($_[0]); -} - -sub getc { - usage "getc(handle)", caller if @_ != 1; - getc($_[0]); -} - -sub getchar { - usage "getchar()", caller if @_ != 0; - getc(STDIN); -} - -sub gets { - usage "gets(handle)", caller if @_ != 1; - local($handle) = shift; - scalar <$handle>; -} - -sub perror { - unimpl "perror() is C-specific--print $! instead", caller; - unimpl "perror(xxx)", caller if @_ != 123; - perror($_[0]); -} - -sub printf { - usage "printf(pattern, args...)", caller if @_ < 1; - printf STDOUT @_; -} - -sub putc { - unimpl "putc() is C-specific--use print instead", caller; - unimpl "putc(xxx)", caller if @_ != 123; - putc($_[0]); -} - -sub putchar { - unimpl "putchar() is C-specific--use print instead", caller; - unimpl "putchar(xxx)", caller if @_ != 123; - putchar($_[0]); -} - -sub puts { - unimpl "puts() is C-specific--use print instead", caller; - unimpl "puts(xxx)", caller if @_ != 123; - puts($_[0]); -} - -sub remove { - unimpl "remove(xxx)", caller if @_ != 123; - remove($_[0]); -} - -sub rename { - usage "rename(oldfilename, newfilename)", caller if @_ != 2; - rename($_[0], $_[1]); -} - -sub rewind { - unimpl "rewind(xxx)", caller if @_ != 123; - rewind($_[0]); -} - -sub scanf { - unimpl "scanf(xxx)", caller if @_ != 123; - scanf($_[0]); -} - -sub setbuf { - unimpl "setbuf(xxx)", caller if @_ != 123; - setbuf($_[0]); -} - -sub setvbuf { - unimpl "setvbuf(xxx)", caller if @_ != 123; - setvbuf($_[0]); -} - -sub sprintf { - unimpl "sprintf(xxx)", caller if @_ != 123; - sprintf($_[0]); -} - -sub sscanf { - unimpl "sscanf(xxx)", caller if @_ != 123; - sscanf($_[0]); -} - -sub tmpfile { - unimpl "tmpfile(xxx)", caller if @_ != 123; - tmpfile($_[0]); -} - -sub tmpnam { - unimpl "tmpnam(xxx)", caller if @_ != 123; - tmpnam($_[0]); -} - -sub ungetc { - unimpl "ungetc(xxx)", caller if @_ != 123; - ungetc($_[0]); -} - -sub vfprintf { - unimpl "vfprintf(xxx)", caller if @_ != 123; - vfprintf($_[0]); -} - -sub vprintf { - unimpl "vprintf(xxx)", caller if @_ != 123; - vprintf($_[0]); -} - -sub vsprintf { - unimpl "vsprintf(xxx)", caller if @_ != 123; - vsprintf($_[0]); -} - -sub abort { - unimpl "abort(xxx)", caller if @_ != 123; - abort($_[0]); -} - -sub abs { - usage "abs(x)", caller if @_ != 1; - abs($_[0]); -} - -sub atexit { - unimpl "atexit() is C-specific: use END {} instead", caller; -} - -sub atof { - unimpl "atof() is C-specific, stopped", caller; -} - -sub atoi { - unimpl "atoi() is C-specific, stopped", caller; -} - -sub atol { - unimpl "atol() is C-specific, stopped", caller; -} - -sub bsearch { - unimpl "bsearch(xxx)", caller if @_ != 123; - bsearch($_[0]); -} - -sub calloc { - unimpl "calloc(xxx)", caller if @_ != 123; - calloc($_[0]); -} - -sub div { - unimpl "div(xxx)", caller if @_ != 123; - div($_[0]); -} - -sub exit { - unimpl "exit(xxx)", caller if @_ != 123; - exit($_[0]); -} - -sub free { - unimpl "free(xxx)", caller if @_ != 123; - free($_[0]); -} - -sub getenv { - unimpl "getenv(xxx)", caller if @_ != 123; - getenv($_[0]); -} - -sub labs { - unimpl "labs(xxx)", caller if @_ != 123; - labs($_[0]); -} - -sub ldiv { - unimpl "ldiv(xxx)", caller if @_ != 123; - ldiv($_[0]); -} - -sub malloc { - unimpl "malloc(xxx)", caller if @_ != 123; - malloc($_[0]); -} - -sub mblen { - unimpl "mblen(xxx)", caller if @_ != 123; - mblen($_[0]); -} - -sub mbstowcs { - unimpl "mbstowcs(xxx)", caller if @_ != 123; - mbstowcs($_[0]); -} - -sub mbtowc { - unimpl "mbtowc(xxx)", caller if @_ != 123; - mbtowc($_[0]); -} - -sub qsort { - unimpl "qsort(xxx)", caller if @_ != 123; - qsort($_[0]); -} - -sub rand { - unimpl "rand(xxx)", caller if @_ != 123; - rand($_[0]); -} - -sub realloc { - unimpl "realloc(xxx)", caller if @_ != 123; - realloc($_[0]); -} - -sub srand { - unimpl "srand(xxx)", caller if @_ != 123; - srand($_[0]); -} - -sub strtod { - unimpl "strtod(xxx)", caller if @_ != 123; - strtod($_[0]); -} - -sub strtol { - unimpl "strtol(xxx)", caller if @_ != 123; - strtol($_[0]); -} - -sub stroul { - unimpl "stroul(xxx)", caller if @_ != 123; - stroul($_[0]); -} - -sub system { - usage "system(command)", caller if @_ != 1; - system($_[0]); -} - -sub wcstombs { - unimpl "wcstombs(xxx)", caller if @_ != 123; - wcstombs($_[0]); -} - -sub wctomb { - unimpl "wctomb(xxx)", caller if @_ != 123; - wctomb($_[0]); -} - -sub memchr { - unimpl "memchr(xxx)", caller if @_ != 123; - memchr($_[0]); -} - -sub memcmp { - unimpl "memcmp(xxx)", caller if @_ != 123; - memcmp($_[0]); -} - -sub memcpy { - unimpl "memcpy(xxx)", caller if @_ != 123; - memcpy($_[0]); -} - -sub memmove { - unimpl "memmove(xxx)", caller if @_ != 123; - memmove($_[0]); -} - -sub memset { - unimpl "memset(xxx)", caller if @_ != 123; - memset($_[0]); -} - -sub strcat { - unimpl "strcat(xxx)", caller if @_ != 123; - strcat($_[0]); -} - -sub strchr { - unimpl "strchr(xxx)", caller if @_ != 123; - strchr($_[0]); -} - -sub strcmp { - unimpl "strcmp(xxx)", caller if @_ != 123; - strcmp($_[0]); -} - -sub strcoll { - unimpl "strcoll(xxx)", caller if @_ != 123; - strcoll($_[0]); -} - -sub strcpy { - unimpl "strcpy(xxx)", caller if @_ != 123; - strcpy($_[0]); -} - -sub strcspn { - unimpl "strcspn(xxx)", caller if @_ != 123; - strcspn($_[0]); -} - -sub strerror { - unimpl "strerror(xxx)", caller if @_ != 123; - strerror($_[0]); -} - -sub strlen { - unimpl "strlen(xxx)", caller if @_ != 123; - strlen($_[0]); -} - -sub strncat { - unimpl "strncat(xxx)", caller if @_ != 123; - strncat($_[0]); -} - -sub strncmp { - unimpl "strncmp(xxx)", caller if @_ != 123; - strncmp($_[0]); -} - -sub strncpy { - unimpl "strncpy(xxx)", caller if @_ != 123; - strncpy($_[0]); -} - -sub strpbrk { - unimpl "strpbrk(xxx)", caller if @_ != 123; - strpbrk($_[0]); -} - -sub strrchr { - unimpl "strrchr(xxx)", caller if @_ != 123; - strrchr($_[0]); -} - -sub strspn { - unimpl "strspn(xxx)", caller if @_ != 123; - strspn($_[0]); -} - -sub strstr { - unimpl "strstr(xxx)", caller if @_ != 123; - strstr($_[0]); -} - -sub strtok { - unimpl "strtok(xxx)", caller if @_ != 123; - strtok($_[0]); -} - -sub strxfrm { - unimpl "strxfrm(xxx)", caller if @_ != 123; - strxfrm($_[0]); -} - -sub chmod { - usage "chmod(filename, mode)", caller if @_ != 2; - chmod($_[0], $_[1]); -} - -sub fstat { - usage "fstat(fd)", caller if @_ != 1; - local(*TMP); - open(TMP, "<&$_[0]"); # Gross. - local(@l) = stat(TMP); - close(TMP); - @l; -} - -sub mkdir { - usage "mkdir(directoryname, mode)", caller if @_ != 2; - mkdir($_[0], $_[1]); -} - -sub mkfifo { - unimpl "mkfifo(xxx)", caller if @_ != 123; - mkfifo($_[0]); -} - -sub stat { - usage "stat(filename)", caller if @_ != 1; - stat($_[0]); -} - -sub umask { - usage "umask(mask)", caller if @_ != 1; - umask($_[0]); -} - -sub times { - usage "times()", caller if @_ != 0; - times(); -} - -sub wait { - usage "wait(statusvariable)", caller if @_ != 1; - local $result = wait(); - $_[0] = $?; - $result; -} - -sub waitpid { - usage "waitpid(pid, statusvariable, options)", caller if @_ != 3; - local $result = waitpid($_[0], $_[2]); - $_[1] = $?; - $result; -} - -sub cfgetispeed { - unimpl "cfgetispeed(xxx)", caller if @_ != 123; - cfgetispeed($_[0]); -} - -sub cfgetospeed { - unimpl "cfgetospeed(xxx)", caller if @_ != 123; - cfgetospeed($_[0]); -} - -sub cfsetispeed { - unimpl "cfsetispeed(xxx)", caller if @_ != 123; - cfsetispeed($_[0]); -} - -sub cfsetospeed { - unimpl "cfsetospeed(xxx)", caller if @_ != 123; - cfsetospeed($_[0]); -} - -sub tcdrain { - unimpl "tcdrain(xxx)", caller if @_ != 123; - tcdrain($_[0]); -} - -sub tcflow { - unimpl "tcflow(xxx)", caller if @_ != 123; - tcflow($_[0]); -} - -sub tcflush { - unimpl "tcflush(xxx)", caller if @_ != 123; - tcflush($_[0]); -} - -sub tcgetattr { - unimpl "tcgetattr(xxx)", caller if @_ != 123; - tcgetattr($_[0]); -} - -sub tcsendbreak { - unimpl "tcsendbreak(xxx)", caller if @_ != 123; - tcsendbreak($_[0]); -} - -sub tcsetattr { - unimpl "tcsetattr(xxx)", caller if @_ != 123; - tcsetattr($_[0]); -} - -sub asctime { - unimpl "asctime(xxx)", caller if @_ != 123; - asctime($_[0]); -} - -sub clock { - unimpl "clock(xxx)", caller if @_ != 123; - clock($_[0]); -} - -sub ctime { - unimpl "ctime(xxx)", caller if @_ != 123; - ctime($_[0]); -} - -sub difftime { - unimpl "difftime(xxx)", caller if @_ != 123; - difftime($_[0]); -} - -sub gmtime { - unimpl "gmtime(xxx)", caller if @_ != 123; - gmtime($_[0]); -} - -sub localtime { - unimpl "localtime(xxx)", caller if @_ != 123; - localtime($_[0]); -} - -sub mktime { - unimpl "mktime(xxx)", caller if @_ != 123; - mktime($_[0]); -} - -sub strftime { - unimpl "strftime(xxx)", caller if @_ != 123; - strftime($_[0]); -} - -sub time { - unimpl "time(xxx)", caller if @_ != 123; - time($_[0]); -} - -sub tzset { - unimpl "tzset(xxx)", caller if @_ != 123; - tzset($_[0]); -} - -sub tzname { - unimpl "tzname(xxx)", caller if @_ != 123; - tzname($_[0]); -} - -sub _exit { - unimpl "_exit(xxx)", caller if @_ != 123; - _exit($_[0]); -} - -sub access { - unimpl "access(xxx)", caller if @_ != 123; - access($_[0]); -} - -sub alarm { - unimpl "alarm(xxx)", caller if @_ != 123; - alarm($_[0]); -} - -sub chdir { - unimpl "chdir(xxx)", caller if @_ != 123; - chdir($_[0]); -} - -sub chown { - usage "chown(filename, uid, gid)", caller if @_ != 3; - chown($_[0], $_[1], $_[2]); -} - -sub close { - unimpl "close(xxx)", caller if @_ != 123; - close($_[0]); -} - -sub ctermid { - unimpl "ctermid(xxx)", caller if @_ != 123; - ctermid($_[0]); -} - -sub cuserid { - unimpl "cuserid(xxx)", caller if @_ != 123; - cuserid($_[0]); -} - -sub dup2 { - unimpl "dup2(xxx)", caller if @_ != 123; - dup2($_[0]); -} - -sub dup { - unimpl "dup(xxx)", caller if @_ != 123; - dup($_[0]); -} - -sub execl { - unimpl "execl(xxx)", caller if @_ != 123; - execl($_[0]); -} - -sub execle { - unimpl "execle(xxx)", caller if @_ != 123; - execle($_[0]); -} - -sub execlp { - unimpl "execlp(xxx)", caller if @_ != 123; - execlp($_[0]); -} - -sub execv { - unimpl "execv(xxx)", caller if @_ != 123; - execv($_[0]); -} - -sub execve { - unimpl "execve(xxx)", caller if @_ != 123; - execve($_[0]); -} - -sub execvp { - unimpl "execvp(xxx)", caller if @_ != 123; - execvp($_[0]); -} - -sub fork { - usage "fork()", caller if @_ != 0; - fork; -} - -sub fpathconf { - unimpl "fpathconf(xxx)", caller if @_ != 123; - fpathconf($_[0]); -} - -sub getcwd { - unimpl "getcwd(xxx)", caller if @_ != 123; - getcwd($_[0]); -} - -sub getegid { - usage "getegid()", caller if @_ != 0; - $) + 0; -} - -sub geteuid { - usage "geteuid()", caller if @_ != 0; - $> + 0; -} - -sub getgid { - usage "getgid()", caller if @_ != 0; - $( + 0; -} - -sub getgroups { - usage "getgroups()", caller if @_ != 0; - local(%seen) = (); - grep(!%seen{$_}++, split(' ', $) )); -} - -sub getlogin { - usage "getlogin(xxx)", caller if @_ != 0; - getlogin(); -} - -sub getpgrp { - usage "getpgrp()", caller if @_ != 0; - getpgrp($_[0]); -} - -sub getpid { - usage "getpid()", caller if @_ != 0; - $$; -} - -sub getppid { - usage "getppid()", caller if @_ != 0; - getppid; -} - -sub getuid { - usage "getuid()", caller if @_ != 0; - $<; -} - -sub isatty { - unimpl "isatty(xxx)", caller if @_ != 123; - isatty($_[0]); -} - -sub link { - usage "link(oldfilename, newfilename)", caller if @_ != 2; - link($_[0], $_[1]); -} - -sub lseek { - unimpl "lseek(xxx)", caller if @_ != 123; - lseek($_[0]); -} - -sub pathconf { - unimpl "pathconf(xxx)", caller if @_ != 123; - pathconf($_[0]); -} - -sub pause { - unimpl "pause(xxx)", caller if @_ != 123; - pause($_[0]); -} - -sub pipe { - unimpl "pipe(xxx)", caller if @_ != 123; - pipe($_[0]); -} - -sub read { - unimpl "read(xxx)", caller if @_ != 123; - read($_[0]); -} - -sub rmdir { - usage "rmdir(directoryname)", caller if @_ != 1; - rmdir($_[0]); -} - -sub setgid { - unimpl "setgid(xxx)", caller if @_ != 123; - setgid($_[0]); -} - -sub setpgid { - unimpl "setpgid(xxx)", caller if @_ != 123; - setpgid($_[0]); -} - -sub setsid { - unimpl "setsid(xxx)", caller if @_ != 123; - setsid($_[0]); -} - -sub setuid { - unimpl "setuid(xxx)", caller if @_ != 123; - setuid($_[0]); -} - -sub sleep { - unimpl "sleep(xxx)", caller if @_ != 123; - sleep($_[0]); -} - -sub sysconf { - unimpl "sysconf(xxx)", caller if @_ != 123; - sysconf($_[0]); -} - -sub tcgetpgrp { - unimpl "tcgetpgrp(xxx)", caller if @_ != 123; - tcgetpgrp($_[0]); -} - -sub tcsetpgrp { - unimpl "tcsetpgrp(xxx)", caller if @_ != 123; - tcsetpgrp($_[0]); -} - -sub ttyname { - unimpl "ttyname(xxx)", caller if @_ != 123; - ttyname($_[0]); -} - -sub unlink { - usage "unlink(filename)", caller if @_ != 1; - unlink($_[0]); -} - -sub write { - unimpl "write(xxx)", caller if @_ != 123; - write($_[0]); -} - -sub utime { - usage "utime(filename, atime, mtime)", caller if @_ != 3; - utime($_[1], $_[2], $_[0]); -} - diff --git a/lib/SDBM_File.pm b/lib/SDBM_File.pm deleted file mode 100644 index 544f66f..0000000 --- a/lib/SDBM_File.pm +++ /dev/null @@ -1,9 +0,0 @@ -package SDBM_File; - -require Exporter; -@ISA = (Exporter, DynamicLoader); -@EXPORT = qw(new fetch store delete firstkey nextkey error clearerr); - -bootstrap SDBM_File; - -1; diff --git a/lib/Search/Dict.pm b/lib/Search/Dict.pm new file mode 100644 index 0000000..10aa4ff --- /dev/null +++ b/lib/Search/Dict.pm @@ -0,0 +1,52 @@ +package Search::Dict; +require 5.000; +require Exporter; + +@ISA = qw(Exporter); +@EXPORT = qw(look); + +# Usage: look(*FILEHANDLE,$key,$dict,$fold) + +# Sets file position in FILEHANDLE to be first line greater than or equal +# (stringwise) to $key. Pass flags for dictionary order and case folding. + +sub look { + local(*FH,$key,$dict,$fold) = @_; + local($max,$min,$mid,$_); + local($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, + $blksize,$blocks) = stat(FH); + $blksize = 8192 unless $blksize; + $key =~ s/[^\w\s]//g if $dict; + $key =~ tr/A-Z/a-z/ if $fold; + $max = int($size / $blksize); + while ($max - $min > 1) { + $mid = int(($max + $min) / 2); + seek(FH,$mid * $blksize,0); + $_ = if $mid; # probably a partial line + $_ = ; + chop; + s/[^\w\s]//g if $dict; + tr/A-Z/a-z/ if $fold; + if ($_ lt $key) { + $min = $mid; + } + else { + $max = $mid; + } + } + $min *= $blksize; + seek(FH,$min,0); + if $min; + while () { + chop; + s/[^\w\s]//g if $dict; + y/A-Z/a-z/ if $fold; + last if $_ ge $key; + $min = tell(FH); + } + seek(FH,$min,0); + $min; +} + +1; + diff --git a/lib/Shell.pm b/lib/Shell.pm new file mode 100644 index 0000000..8098bf2 --- /dev/null +++ b/lib/Shell.pm @@ -0,0 +1,47 @@ +package Shell; + +sub import { + my $self = shift; + my ($callpack, $callfile, $callline) = caller; + my @EXPORT; + if (@_) { + @EXPORT = @_; + } + else { + @EXPORT = 'AUTOLOAD'; + } + foreach $sym (@EXPORT) { + *{"${callpack}::$sym"} = \&{"Shell::$sym"}; + } +}; + +AUTOLOAD { + my $cmd = $AUTOLOAD; + $cmd =~ s/^.*:://; + eval qq { + sub $AUTOLOAD { + if (\@_ < 2) { + `$cmd \@_`; + } + else { + open(SUBPROC, "-|") + or exec '$cmd', \@_ + or die "Can't exec $cmd: \$!\n"; + if (wantarray) { + my \@ret = ; + close SUBPROC; # XXX Oughta use a destructor. + \@ret; + } + else { + local(\$/) = undef; + my \$ret = ; + close SUBPROC; + \$ret; + } + } + } + }; + goto &$AUTOLOAD; +} + +1; diff --git a/lib/Sys/Hostname.pm b/lib/Sys/Hostname.pm new file mode 100644 index 0000000..4dd4fe2 --- /dev/null +++ b/lib/Sys/Hostname.pm @@ -0,0 +1,53 @@ +# by David Sundstrom sunds@asictest.sc.ti.com +# Texas Instruments + +package Sys::Hostname; + +use Carp; +require Exporter; +@ISA = qw(Exporter); +@EXPORT = qw(hostname); + +# +# Try every conceivable way to get hostname. +# + +sub hostname { + + # method 1 - we already know it + return $host if defined $host; + + # method 2 - syscall is preferred since it avoids tainting problems + eval { + { + package main; + require "syscall.ph"; + } + $host = "\0" x 65; ## preload scalar + syscall(&main::SYS_gethostname, $host, 65) == 0; + } + + # method 3 - trusty old hostname command + || eval { + $host = `(hostname) 2>/dev/null`; # bsdish + } + + # method 4 - sysV uname command (may truncate) + || eval { + $host = `uname -n 2>/dev/null`; ## sysVish + } + + # method 5 - Apollo pre-SR10 + || eval { + ($host,$a,$b,$c,$d)=split(/[:\. ]/,`/com/host`,6); + } + + # bummer + || Carp::croak "Cannot get host name of local machine"; + + # remove garbage + $host =~ tr/\0\r\n//d; + $host; +} + +1; diff --git a/lib/Sys/Syslog.pm b/lib/Sys/Syslog.pm new file mode 100644 index 0000000..0f7859e --- /dev/null +++ b/lib/Sys/Syslog.pm @@ -0,0 +1,195 @@ +package Sys::Syslog; +require 5.000; +require Exporter; +use Carp; + +@ISA = qw(Exporter); +@EXPORT = qw(openlog closelog setlogmask syslog); + +# +# syslog.pl +# +# $Log: syslog.pl,v $ +# +# tom christiansen +# modified to use sockets by Larry Wall +# NOTE: openlog now takes three arguments, just like openlog(3) +# +# call syslog() with a string priority and a list of printf() args +# like syslog(3) +# +# usage: use Syslog; +# +# then (put these all in a script to test function) +# +# openlog($program,'cons,pid','user'); +# syslog('info','this is another test'); +# syslog('mail|warning','this is a better test: %d', time); +# closelog(); +# +# syslog('debug','this is the last test'); +# openlog("$program $$",'ndelay','user'); +# syslog('notice','fooprogram: this is really done'); +# +# $! = 55; +# syslog('info','problem was %m'); # %m == $! in syslog(3) + +$host = 'localhost' unless $host; # set $Syslog::host to change + +require 'syslog.ph'; + +$maskpri = &LOG_UPTO(&LOG_DEBUG); + +sub openlog { + ($ident, $logopt, $facility) = @_; # package vars + $lo_pid = $logopt =~ /\bpid\b/; + $lo_ndelay = $logopt =~ /\bndelay\b/; + $lo_cons = $logopt =~ /\bcons\b/; + $lo_nowait = $logopt =~ /\bnowait\b/; + &connect if $lo_ndelay; +} + +sub closelog { + $facility = $ident = ''; + &disconnect; +} + +sub setlogmask { + local($oldmask) = $maskpri; + $maskpri = shift; + $oldmask; +} + +sub syslog { + local($priority) = shift; + local($mask) = shift; + local($message, $whoami); + local(@words, $num, $numpri, $numfac, $sum); + local($facility) = $facility; # may need to change temporarily. + + croak "syslog: expected both priority and mask" unless $mask && $priority; + + @words = split(/\W+/, $priority, 2);# Allow "level" or "level|facility". + undef $numpri; + undef $numfac; + foreach (@words) { + $num = &xlate($_); # Translate word to number. + if (/^kern$/ || $num < 0) { + croak "syslog: invalid level/facility: $_"; + } + elsif ($num <= &LOG_PRIMASK) { + croak "syslog: too many levels given: $_" if defined($numpri); + $numpri = $num; + return 0 unless &LOG_MASK($numpri) & $maskpri; + } + else { + croak "syslog: too many facilities given: $_" if defined($numfac); + $facility = $_; + $numfac = $num; + } + } + + croak "syslog: level must be given" unless defined($numpri); + + if (!defined($numfac)) { # Facility not specified in this call. + $facility = 'user' unless $facility; + $numfac = &xlate($facility); + } + + &connect unless $connected; + + $whoami = $ident; + + if (!$ident && $mask =~ /^(\S.*):\s?(.*)/) { + $whoami = $1; + $mask = $2; + } + + unless ($whoami) { + ($whoami = getlogin) || + ($whoami = getpwuid($<)) || + ($whoami = 'syslog'); + } + + $whoami .= "[$$]" if $lo_pid; + + $mask =~ s/%m/$!/g; + $mask .= "\n" unless $mask =~ /\n$/; + $message = sprintf ($mask, @_); + + $sum = $numpri + $numfac; + unless (send(SYSLOG,"<$sum>$whoami: $message",0)) { + if ($lo_cons) { + if ($pid = fork) { + unless ($lo_nowait) { + do {$died = wait;} until $died == $pid || $died < 0; + } + } + else { + open(CONS,">/dev/console"); + print CONS "<$facility.$priority>$whoami: $message\r"; + exit if defined $pid; # if fork failed, we're parent + close CONS; + } + } + } +} + +sub xlate { + local($name) = @_; + $name =~ y/a-z/A-Z/; + $name = "LOG_$name" unless $name =~ /^LOG_/; + $name = "syslog'$name"; + eval(&$name) || -1; +} + +sub connect { + $pat = 'S n C4 x8'; + + $af_unix = 1; + $af_inet = 2; + + $stream = 1; + $datagram = 2; + + ($name,$aliases,$proto) = getprotobyname('udp'); + $udp = $proto; + + ($name,$aliase,$port,$proto) = getservbyname('syslog','udp'); + $syslog = $port; + + if (chop($myname = `hostname`)) { + ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($myname); + croak "Can't lookup $myname" unless $name; + @bytes = unpack("C4",$addrs[0]); + } + else { + @bytes = (0,0,0,0); + } + $this = pack($pat, $af_inet, 0, @bytes); + + if ($host =~ /^\d+\./) { + @bytes = split(/\./,$host); + } + else { + ($name,$aliases,$addrtype,$length,@addrs) = gethostbyname($host); + croak "Can't lookup $host" unless $name; + @bytes = unpack("C4",$addrs[0]); + } + $that = pack($pat,$af_inet,$syslog,@bytes); + + socket(SYSLOG,$af_inet,$datagram,$udp) || croak "socket: $!"; + bind(SYSLOG,$this) || croak "bind: $!"; + connect(SYSLOG,$that) || croak "connect: $!"; + + local($old) = select(SYSLOG); $| = 1; select($old); + $connected = 1; +} + +sub disconnect { + close SYSLOG; + $connected = 0; +} + +1; + diff --git a/lib/Term/Cap.pm b/lib/Term/Cap.pm new file mode 100644 index 0000000..30389bb --- /dev/null +++ b/lib/Term/Cap.pm @@ -0,0 +1,174 @@ +package Term::Cap; +require 5.000; +require Exporter; +use Carp; + +@ISA = qw(Exporter); +@EXPORT = qw(&Tgetent &Tputs &Tgoto $ispeed $ospeed %TC); + +# $RCSfile: termcap.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:16 $ +# +# Usage: +# require 'ioctl.pl'; +# ioctl(TTY,$TIOCGETP,$foo); +# ($ispeed,$ospeed) = unpack('cc',$foo); +# use Termcap; +# &Tgetent('vt100'); # sets $TC{'cm'}, etc. +# &Tputs(&Tgoto($TC{'cm'},$col,$row), 0, 'FILEHANDLE'); +# &Tputs($TC{'dl'},$affcnt,'FILEHANDLE'); +# +sub Tgetent { + local($TERM) = @_; + local($TERMCAP,$_,$entry,$loop,$field); + + warn "Tgetent: no ospeed set" unless $ospeed; + foreach $key (keys(%TC)) { + delete $TC{$key}; + } + $TERM = $ENV{'TERM'} unless $TERM; + $TERM =~ s/(\W)/\\$1/g; + $TERMCAP = $ENV{'TERMCAP'}; + $TERMCAP = '/etc/termcap' unless $TERMCAP; + if ($TERMCAP !~ m:^/:) { + if ($TERMCAP !~ /(^|\|)$TERM[:\|]/) { + $TERMCAP = '/etc/termcap'; + } + } + if ($TERMCAP =~ m:^/:) { + $entry = ''; + do { + $loop = " + open(TERMCAP,'<$TERMCAP') || croak \"Can't open $TERMCAP\"; + while () { + next if /^#/; + next if /^\t/; + if (/(^|\\|)${TERM}[:\\|]/) { + chop; + while (chop eq '\\\\') { + \$_ .= ; + chop; + } + \$_ .= ':'; + last; + } + } + close TERMCAP; + \$entry .= \$_; + "; + eval $loop; + } while s/:tc=([^:]+):/:/ && ($TERM = $1); + $TERMCAP = $entry; + } + + foreach $field (split(/:[\s:\\]*/,$TERMCAP)) { + if ($field =~ /^\w\w$/) { + $TC{$field} = 1; + } + elsif ($field =~ /^(\w\w)#(.*)/) { + $TC{$1} = $2 unless defined $TC{$1}; + } + elsif ($field =~ /^(\w\w)=(.*)/) { + $entry = $1; + $_ = $2; + s/\\E/\033/g; + s/\\(\d\d\d)/pack('c',$1 & 0177)/eg; + s/\\n/\n/g; + s/\\r/\r/g; + s/\\t/\t/g; + s/\\b/\b/g; + s/\\f/\f/g; + s/\\\^/\377/g; + s/\^\?/\177/g; + s/\^(.)/pack('c',ord($1) & 31)/eg; + s/\\(.)/$1/g; + s/\377/^/g; + $TC{$entry} = $_ unless defined $TC{$entry}; + } + } + $TC{'pc'} = "\0" unless defined $TC{'pc'}; + $TC{'bc'} = "\b" unless defined $TC{'bc'}; +} + +@Tputs = (0,200,133.3,90.9,74.3,66.7,50,33.3,16.7,8.3,5.5,4.1,2,1,.5,.2); + +sub Tputs { + local($string,$affcnt,$FH) = @_; + local($ms); + if ($string =~ /(^[\d.]+)(\*?)(.*)$/) { + $ms = $1; + $ms *= $affcnt if $2; + $string = $3; + $decr = $Tputs[$ospeed]; + if ($decr > .1) { + $ms += $decr / 2; + $string .= $TC{'pc'} x ($ms / $decr); + } + } + print $FH $string if $FH; + $string; +} + +sub Tgoto { + local($string) = shift(@_); + local($result) = ''; + local($after) = ''; + local($code,$tmp) = @_; + local(@tmp); + @tmp = ($tmp,$code); + local($online) = 0; + while ($string =~ /^([^%]*)%(.)(.*)/) { + $result .= $1; + $code = $2; + $string = $3; + if ($code eq 'd') { + $result .= sprintf("%d",shift(@tmp)); + } + elsif ($code eq '.') { + $tmp = shift(@tmp); + if ($tmp == 0 || $tmp == 4 || $tmp == 10) { + if ($online) { + ++$tmp, $after .= $TC{'up'} if $TC{'up'}; + } + else { + ++$tmp, $after .= $TC{'bc'}; + } + } + $result .= sprintf("%c",$tmp); + $online = !$online; + } + elsif ($code eq '+') { + $result .= sprintf("%c",shift(@tmp)+ord($string)); + $string = substr($string,1,99); + $online = !$online; + } + elsif ($code eq 'r') { + ($code,$tmp) = @tmp; + @tmp = ($tmp,$code); + $online = !$online; + } + elsif ($code eq '>') { + ($code,$tmp,$string) = unpack("CCa99",$string); + if ($tmp[$[] > $code) { + $tmp[$[] += $tmp; + } + } + elsif ($code eq '2') { + $result .= sprintf("%02d",shift(@tmp)); + $online = !$online; + } + elsif ($code eq '3') { + $result .= sprintf("%03d",shift(@tmp)); + $online = !$online; + } + elsif ($code eq 'i') { + ($code,$tmp) = @tmp; + @tmp = ($code+1,$tmp+1); + } + else { + return "OOPS"; + } + } + $result . $string . $after; +} + +1; diff --git a/lib/Term/Complete.pm b/lib/Term/Complete.pm new file mode 100644 index 0000000..10b12a2 --- /dev/null +++ b/lib/Term/Complete.pm @@ -0,0 +1,113 @@ +package Term::Complete; +require 5.000; +require Exporter; + +@ISA = qw(Exporter); +@EXPORT = qw(Complete); + +# +# @(#)complete.pl,v1.1 (me@anywhere.EBay.Sun.COM) 09/23/91 +# +# Author: Wayne Thompson +# +# Description: +# This routine provides word completion. +# (TAB) attempts word completion. +# (^D) prints completion list. +# (These may be changed by setting $Complete::complete, etc.) +# +# Diagnostics: +# Bell when word completion fails. +# +# Dependencies: +# The tty driver is put into raw mode. +# +# Bugs: +# +# Usage: +# $input = complete('prompt_string', \@completion_list); +# or +# $input = complete('prompt_string', @completion_list); +# + +CONFIG: { + $complete = "\004"; + $kill = "\025"; + $erase1 = "\177"; + $erase2 = "\010"; +} + +sub complete { + $prompt = shift; + if (ref $_[0] || $_[0] =~ /^\*/) { + @cmp_lst = sort @{$_[0]}; + } + else { + @cmp_lst = sort(@_); + } + + system('stty raw -echo'); + LOOP: { + print($prompt, $return); + while (($_ = getc(STDIN)) ne "\r") { + CASE: { + # (TAB) attempt completion + $_ eq "\t" && do { + @match = grep(/^$return/, @cmp_lst); + $l = length($test = shift(@match)); + unless ($#match < 0) { + foreach $cmp (@match) { + until (substr($cmp, 0, $l) eq substr($test, 0, $l)) { + $l--; + } + } + print("\a"); + } + print($test = substr($test, $r, $l - $r)); + $r = length($return .= $test); + last CASE; + }; + + # (^D) completion list + $_ eq $complete && do { + print(join("\r\n", '', grep(/^$return/, @cmp_lst)), "\r\n"); + redo LOOP; + }; + + # (^U) kill + $_ eq $kill && do { + if ($r) { + undef($r, $return); + print("\r\n"); + redo LOOP; + } + last CASE; + }; + + # (DEL) || (BS) erase + ($_ eq $erase1 || $_ eq $erase2) && do { + if($r) { + print("\b \b"); + chop($return); + $r--; + } + last CASE; + }; + + # printable char + ord >= 32 && do { + $return .= $_; + $r++; + print; + last CASE; + }; + } + } + } + system('stty -raw echo'); + print("\n"); + $return; +} + +1; + diff --git a/lib/Termcap.pm b/lib/Termcap.pm deleted file mode 100644 index da4c7ce..0000000 --- a/lib/Termcap.pm +++ /dev/null @@ -1,174 +0,0 @@ -package Termcap; - -require 5.000; -require Exporter; -@ISA = (Exporter); -@EXPORT = qw(&Tgetent $ispeed $ospeed &Tputs %TC &Tgoto); - - -;# Termcap.pm -;# -;# Usage: -;# require 'ioctl.pl'; -;# require Termcap; -;# import Termcap; -;# ioctl(TTY,$TIOCGETP,$foo); -;# ($ispeed,$ospeed) = unpack('cc',$foo); -;# &Tgetent('vt100'); # sets $TC{'cm'}, etc. -;# &Tputs(&Tgoto($TC{'cm'},$col,$row), 0, 'FILEHANDLE'); -;# &Tputs($TC{'dl'},$affcnt,'FILEHANDLE'); -;# -sub Tgetent { - local($TERM) = @_; - local($TERMCAP,$_,$entry,$loop,$field); - - warn "Tgetent: no ospeed set" unless $ospeed; - foreach $key (keys(%TC)) { - delete $TC{$key}; - } - $TERM = $ENV{'TERM'} unless $TERM; - $TERMCAP = $ENV{'TERMCAP'}; - $TERMCAP = '/etc/termcap' unless $TERMCAP; - if ($TERMCAP !~ m:^/:) { - if ($TERMCAP !~ /(^|\|)$TERM[:\|]/) { - $TERMCAP = '/etc/termcap'; - } - } - if ($TERMCAP =~ m:^/:) { - $entry = ''; - do { - $loop = " - open(TERMCAP,'<$TERMCAP') || die \"Can't open $TERMCAP\"; - while () { - next if /^#/; - next if /^\t/; - if (/(^|\\|)$TERM\[:\\|]/) { - chop; - while (chop eq '\\\\') { - \$_ .= ; - chop; - } - \$_ .= ':'; - last; - } - } - close TERMCAP; - \$entry .= \$_; - "; - eval $loop; - } while s/:tc=([^:]+):/:/ && ($TERM = $1); - $TERMCAP = $entry; - } - - foreach $field (split(/:[\s:\\]*/,$TERMCAP)) { - if ($field =~ /^\w\w$/) { - $TC{$field} = 1; - } - elsif ($field =~ /^(\w\w)#(.*)/) { - $TC{$1} = $2 unless defined $TC{$1}; - } - elsif ($field =~ /^(\w\w)=(.*)/) { - $entry = $1; - $_ = $2; - s/\\E/\033/g; - s/\\(\d\d\d)/pack('c',$1 & 0177)/eg; - s/\\n/\n/g; - s/\\r/\r/g; - s/\\t/\t/g; - s/\\b/\b/g; - s/\\f/\f/g; - s/\\\^/\377/g; - s/\^\?/\177/g; - s/\^(.)/pack('c',ord($1) & 31)/eg; - s/\\(.)/$1/g; - s/\377/^/g; - $TC{$entry} = $_ unless defined $TC{$entry}; - } - } - $TC{'pc'} = "\0" unless defined $TC{'pc'}; - $TC{'bc'} = "\b" unless defined $TC{'bc'}; -} - -@Tputs = (0,200,133.3,90.9,74.3,66.7,50,33.3,16.7,8.3,5.5,4.1,2,1,.5,.2); - -sub Tputs { - local($string,$affcnt,$FH) = @_; - local($ms); - if ($string =~ /(^[\d.]+)(\*?)(.*)$/) { - $ms = $1; - $ms *= $affcnt if $2; - $string = $3; - $decr = $Tputs[$ospeed]; - if ($decr > .1) { - $ms += $decr / 2; - $string .= $TC{'pc'} x ($ms / $decr); - } - } - print $FH $string if $FH; - $string; -} - -sub Tgoto { - local($string) = shift(@_); - local($result) = ''; - local($after) = ''; - local($code,$tmp) = @_; - local(@tmp); - @tmp = ($tmp,$code); - local($online) = 0; - while ($string =~ /^([^%]*)%(.)(.*)/) { - $result .= $1; - $code = $2; - $string = $3; - if ($code eq 'd') { - $result .= sprintf("%d",shift(@tmp)); - } - elsif ($code eq '.') { - $tmp = shift(@tmp); - if ($tmp == 0 || $tmp == 4 || $tmp == 10) { - if ($online) { - ++$tmp, $after .= $TC{'up'} if $TC{'up'}; - } - else { - ++$tmp, $after .= $TC{'bc'}; - } - } - $result .= sprintf("%c",$tmp); - $online = !$online; - } - elsif ($code eq '+') { - $result .= sprintf("%c",shift(@tmp)+ord($string)); - $string = substr($string,1,99); - $online = !$online; - } - elsif ($code eq 'r') { - ($code,$tmp) = @tmp; - @tmp = ($tmp,$code); - $online = !$online; - } - elsif ($code eq '>') { - ($code,$tmp,$string) = unpack("CCa99",$string); - if ($tmp[$[] > $code) { - $tmp[$[] += $tmp; - } - } - elsif ($code eq '2') { - $result .= sprintf("%02d",shift(@tmp)); - $online = !$online; - } - elsif ($code eq '3') { - $result .= sprintf("%03d",shift(@tmp)); - $online = !$online; - } - elsif ($code eq 'i') { - ($code,$tmp) = @tmp; - @tmp = ($code+1,$tmp+1); - } - else { - return "OOPS"; - } - } - $result . $string . $after; -} - -1; diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm new file mode 100644 index 0000000..8422f8e --- /dev/null +++ b/lib/Test/Harness.pm @@ -0,0 +1,80 @@ +package Test::Harness; + +use Exporter; +use Benchmark; +@ISA=(Exporter); +@EXPORT= qw(&runtests &test_lib); +@EXPORT_OK= qw($verbose $switches); + +$verbose = 0; +$switches = "-w"; + +sub runtests { + my(@tests) = @_; + local($|) = 1; + my($test,$te,$ok,$next,$max,$totmax, $files,$pct); + my $bad = 0; + my $good = 0; + my $total = @tests; + local($ENV{'PERL5LIB'}) = join(':', @INC); # pass -I flags to children + + my $t_start = new Benchmark; + while ($test = shift(@tests)) { + $te = $test; + chop($te); + print "$te" . '.' x (20 - length($te)); + my $fh = "RESULTS"; + open($fh,"$^X $switches $test|") || (print "can't run. $!\n"); + $ok = 0; + $next = 0; + while (<$fh>) { + if( $verbose ){ + print $_; + } + unless (/^#/) { + if (/^1\.\.([0-9]+)/) { + $max = $1; + $totmax += $max; + $files += 1; + $next = 1; + $ok = 1; + } else { + $next = $1, $ok = 0, last if /^not ok ([0-9]*)/; + if (/^ok (.*)/ && $1 == $next) { + $next = $next + 1; + } + } + } + } + close($fh); # must close to reap child resource values + $next -= 1; + if ($ok && $next == $max) { + print "ok\n"; + $good += 1; + } else { + $next += 1; + print "FAILED on test $next\n"; + $bad += 1; + $_ = $test; + } + } + my $t_total = timediff(new Benchmark, $t_start); + + if ($bad == 0) { + if ($ok) { + print "All tests successful.\n"; + } else { + die "FAILED--no tests were run for some reason.\n"; + } + } else { + $pct = sprintf("%.2f", $good / $total * 100); + if ($bad == 1) { + warn "Failed 1 test, $pct% okay.\n"; + } else { + die "Failed $bad/$total tests, $pct% okay.\n"; + } + } + printf("Files=%d, Tests=%d, %s\n", $files,$totmax, timestr($t_total, 'nop')); +} + +1; diff --git a/lib/Text/Abbrev.pm b/lib/Text/Abbrev.pm new file mode 100644 index 0000000..77370d3 --- /dev/null +++ b/lib/Text/Abbrev.pm @@ -0,0 +1,37 @@ +package Text::Abbrev; +require 5.000; +require Exporter; + +@ISA = qw(Exporter); +@EXPORT = qw(abbrev); + +# Usage: +# &abbrev(*foo,LIST); +# ... +# $long = $foo{$short}; + +sub abbrev { + local(*domain) = shift; + @cmp = @_; + %domain = (); + foreach $name (@_) { + @extra = split(//,$name); + $abbrev = shift(@extra); + $len = 1; + foreach $cmp (@cmp) { + next if $cmp eq $name; + while (substr($cmp,0,$len) eq $abbrev) { + $abbrev .= shift(@extra); + ++$len; + } + } + $domain{$abbrev} = $name; + while (@extra) { + $abbrev .= shift(@extra); + $domain{$abbrev} = $name; + } + } +} + +1; + diff --git a/lib/Text/ParseWords.pm b/lib/Text/ParseWords.pm new file mode 100644 index 0000000..8927850 --- /dev/null +++ b/lib/Text/ParseWords.pm @@ -0,0 +1,170 @@ +package Text::ParseWords; + +require 5.000; +require Exporter; +require AutoLoader; +use Carp; + +@ISA = qw(Exporter AutoLoader); +@EXPORT = qw(shellwords quotewords); +@EXPORT_OK = qw(old_shellwords); + +# This code needs updating to use new Perl 5 features (regexp etc). + +# ParseWords.pm +# +# Usage: +# use ParseWords; +# @words = "ewords($delim, $keep, @lines); +# @words = &shellwords(@lines); +# @words = &old_shellwords(@lines); + +# Hal Pomeranz (pomeranz@netcom.com), 23 March 1994 +# Permission to use and distribute under the same terms as Perl. +# No warranty expressed or implied. + +# Basically an update and generalization of the old shellwords.pl. +# Much code shamelessly stolen from the old version (author unknown). +# +# "ewords() accepts a delimiter (which can be a regular expression) +# and a list of lines and then breaks those lines up into a list of +# words ignoring delimiters that appear inside quotes. +# +# The $keep argument is a boolean flag. If true, the quotes are kept +# with each word, otherwise quotes are stripped in the splitting process. +# $keep also defines whether unprotected backslashes are retained. +# + +1; +__END__ + + +sub shellwords { + + # A &shellwords() replacement is included to demonstrate the new package. + # This version differs from the original in that it will _NOT_ default + # to using $_ if no arguments are given. I personally find the old behavior + # to be a mis-feature. + + local(@lines) = @_; + $lines[$#lines] =~ s/\s+$//; + "ewords('\s+', 0, @lines); +} + + + +sub quotewords { + +# "ewords() works by simply jamming all of @lines into a single +# string in $_ and then pulling off words a bit at a time until $_ +# is exhausted. +# +# The inner "for" loop builds up each word (or $field) one $snippet +# at a time. A $snippet is a quoted string, a backslashed character, +# or an unquoted string. We fall out of the "for" loop when we reach +# the end of $_ or when we hit a delimiter. Falling out of the "for" +# loop, we push the $field we've been building up onto the list of +# @words we'll be returning, and then loop back and pull another word +# off of $_. +# +# The first two cases inside the "for" loop deal with quoted strings. +# The first case matches a double quoted string, removes it from $_, +# and assigns the double quoted string to $snippet in the body of the +# conditional. The second case handles single quoted strings. In +# the third case we've found a quote at the current beginning of $_, +# but it didn't match the quoted string regexps in the first two cases, +# so it must be an unbalanced quote and we croak with an error (which can +# be caught by eval()). +# +# The next case handles backslashed characters, and the next case is the +# exit case on reaching the end of the string or finding a delimiter. +# +# Otherwise, we've found an unquoted thing and we pull of characters one +# at a time until we reach something that could start another $snippet-- +# a quote of some sort, a backslash, or the delimiter. This one character +# at a time behavior was necessary if the delimiter was going to be a +# regexp (love to hear it if you can figure out a better way). + + local($delim, $keep, @lines) = @_; + local(@words,$snippet,$field,$_); + + $_ = join('', @lines); + while ($_) { + $field = ''; + for (;;) { + $snippet = ''; + if (s/^"(([^"\\]|\\[\\"])*)"//) { + $snippet = $1; + $snippet = "\"$snippet\"" if ($keep); + } + elsif (s/^'(([^'\\]|\\[\\'])*)'//) { + $snippet = $1; + $snippet = "'$snippet'" if ($keep); + } + elsif (/^["']/) { + croak "Unmatched quote"; + } + elsif (s/^\\(.)//) { + $snippet = $1; + $snippet = "\\$snippet" if ($keep); + } + elsif (!$_ || s/^$delim//) { + last; + } + else { + while ($_ && !(/^$delim/ || /^['"\\]/)) { + $snippet .= substr($_, 0, 1); + substr($_, 0, 1) = ''; + } + } + $field .= $snippet; + } + push(@words, $field); + } + @words; +} + + +sub old_shellwords { + + # Usage: + # use ParseWords; + # @words = old_shellwords($line); + # or + # @words = old_shellwords(@lines); + + local($_) = join('', @_); + my(@words,$snippet,$field); + + s/^\s+//; + while ($_ ne '') { + $field = ''; + for (;;) { + if (s/^"(([^"\\]|\\.)*)"//) { + ($snippet = $1) =~ s#\\(.)#$1#g; + } + elsif (/^"/) { + croak "Unmatched double quote: $_"; + } + elsif (s/^'(([^'\\]|\\.)*)'//) { + ($snippet = $1) =~ s#\\(.)#$1#g; + } + elsif (/^'/) { + croak "Unmatched single quote: $_"; + } + elsif (s/^\\(.)//) { + $snippet = $1; + } + elsif (s/^([^\s\\'"]+)//) { + $snippet = $1; + } + else { + s/^\s+//; + last; + } + $field .= $snippet; + } + push(@words, $field); + } + @words; +} diff --git a/lib/Text/Soundex.pm b/lib/Text/Soundex.pm new file mode 100644 index 0000000..6551523 --- /dev/null +++ b/lib/Text/Soundex.pm @@ -0,0 +1,82 @@ +package Text::Soundex; +require 5.000; +require Exporter; + +@ISA = qw(Exporter); +@EXPORT = qw(&soundex $soundex_nocode); + +# $Id: soundex.pl,v 1.2 1994/03/24 00:30:27 mike Exp $ +# +# Implementation of soundex algorithm as described by Knuth in volume +# 3 of The Art of Computer Programming, with ideas stolen from Ian +# Phillips . +# +# Mike Stok , 2 March 1994. +# +# Knuth's test cases are: +# +# Euler, Ellery -> E460 +# Gauss, Ghosh -> G200 +# Hilbert, Heilbronn -> H416 +# Knuth, Kant -> K530 +# Lloyd, Ladd -> L300 +# Lukasiewicz, Lissajous -> L222 +# +# $Log: soundex.pl,v $ +# Revision 1.2 1994/03/24 00:30:27 mike +# Subtle bug (any excuse :-) spotted by Rich Pinder +# in the way I handles leasing characters which were different but had +# the same soundex code. This showed up comparing it with Oracle's +# soundex output. +# +# Revision 1.1 1994/03/02 13:01:30 mike +# Initial revision +# +# +############################################################################## + +# $soundex_nocode is used to indicate a string doesn't have a soundex +# code, I like undef other people may want to set it to 'Z000'. + +$soundex_nocode = undef; + +# soundex +# +# usage: +# +# @codes = &soundex (@wordList); +# $code = &soundex ($word); +# +# This strenuously avoids 0 + +sub soundex +{ + local (@s, $f, $fc, $_) = @_; + + foreach (@s) + { + tr/a-z/A-Z/; + tr/A-Z//cd; + + if ($_ eq '') + { + $_ = $soundex_nocode; + } + else + { + ($f) = /^(.)/; + tr/AEHIOUWYBFPVCGJKQSXZDTLMNR/00000000111122222222334556/; + ($fc) = /^(.)/; + s/^$fc+//; + tr///cs; + tr/0//d; + $_ = $f . $_ . '000'; + s/^(.{4}).*/$1/; + } + } + + wantarray ? @s : shift @s; +} + +1; + diff --git a/lib/Text/Tabs.pm b/lib/Text/Tabs.pm new file mode 100644 index 0000000..8ca833f --- /dev/null +++ b/lib/Text/Tabs.pm @@ -0,0 +1,47 @@ +# +# expand and unexpand tabs as per the unix expand and +# unexpand programs. +# +# expand and unexpand operate on arrays of lines. Do not +# feed strings that contain newlines to them. +# +# David Muir Sharnoff +# + +package Tabs; + +require Exporter; + +@ISA = (Exporter); +@EXPORT = qw(expand unexpand $tabstop); + +$tabstop = 8; + +sub expand +{ + my @l = @_; + for $_ (@l) { + 1 while s/^([^\t]*)(\t+)/ + $1 . (" " x + ($tabstop * length($2) + - (length($1) % $tabstop))) + /e; + } + return @l; +} + +sub unexpand +{ + my @l = &expand(@_); + my @e; + for $x (@l) { + @e = split(/(.{$tabstop})/,$x); + for $_ (@e) { + s/ +$/\t/; + } + $x = join('',@e); + } + return @l; +} + +1; diff --git a/lib/TieHash.pm b/lib/TieHash.pm new file mode 100644 index 0000000..0cb4afa --- /dev/null +++ b/lib/TieHash.pm @@ -0,0 +1,42 @@ +package TieHash; +use Carp; + +sub new { + my $pack = shift; + $pack->TIEHASH(@_); +} + +# Grandfather "new" + +sub TIEHASH { + my $pack = shift; + if (defined &{"{$pack}::new"}) { + carp "WARNING: calling ${pack}->new since ${pack}->TIEHASH is missing" + if $^W; + $pack->new(@_); + } + else { + croak "$pack doesn't define a TIEHASH method"; + } +} + +sub EXISTS { + my $pack = ref $_[0]; + croak "$pack doesn't define an EXISTS method"; +} + +sub CLEAR { + my $self = shift; + my $key = $self->FIRSTKEY(@_); + my @keys; + + while (defined $key) { + push @keys, $key; + $key = $self->NEXTKEY(@_, $key); + } + foreach $key (@keys) { + $self->DELETE(@_, $key); + } +} + +1; diff --git a/lib/Time/Local.pm b/lib/Time/Local.pm new file mode 100644 index 0000000..64e6240 --- /dev/null +++ b/lib/Time/Local.pm @@ -0,0 +1,105 @@ +package Time::Local; +require 5.000; +require Exporter; +use Carp; + +@ISA = qw(Exporter); +@EXPORT = qw(timegm timelocal); + +# timelocal.pl +# +# Usage: +# $time = timelocal($sec,$min,$hours,$mday,$mon,$year); +# $time = timegm($sec,$min,$hours,$mday,$mon,$year); + +# These routines are quite efficient and yet are always guaranteed to agree +# with localtime() and gmtime(). We manage this by caching the start times +# of any months we've seen before. If we know the start time of the month, +# we can always calculate any time within the month. The start times +# themselves are guessed by successive approximation starting at the +# current time, since most dates seen in practice are close to the +# current date. Unlike algorithms that do a binary search (calling gmtime +# once for each bit of the time value, resulting in 32 calls), this algorithm +# calls it at most 6 times, and usually only once or twice. If you hit +# the month cache, of course, it doesn't call it at all. + +# timelocal is implemented using the same cache. We just assume that we're +# translating a GMT time, and then fudge it when we're done for the timezone +# and daylight savings arguments. The timezone is determined by examining +# the result of localtime(0) when the package is initialized. The daylight +# savings offset is currently assumed to be one hour. + +# Both routines return -1 if the integer limit is hit. I.e. for dates +# after the 1st of January, 2038 on most machines. + +@epoch = localtime(0); +$tzmin = $epoch[2] * 60 + $epoch[1]; # minutes east of GMT +if ($tzmin > 0) { + $tzmin = 24 * 60 - $tzmin; # minutes west of GMT + $tzmin -= 24 * 60 if $epoch[5] == 70; # account for the date line +} + +$SEC = 1; +$MIN = 60 * $SEC; +$HR = 60 * $MIN; +$DAYS = 24 * $HR; +$YearFix = ((gmtime(946684800))[5] == 100) ? 100 : 0; + +sub timegm { + $ym = pack(C2, @_[5,4]); + $cheat = $cheat{$ym} || &cheat; + return -1 if $cheat<0; + $cheat + $_[0] * $SEC + $_[1] * $MIN + $_[2] * $HR + ($_[3]-1) * $DAYS; +} + +sub timelocal { + $time = &timegm + $tzmin*$MIN; + return -1 if $cheat<0; + @test = localtime($time); + $time -= $HR if $test[2] != $_[2]; + $time; +} + +sub cheat { + $year = $_[5]; + $month = $_[4]; + croak "Month out of range 0..11 in timelocal.pl" + if $month > 11 || $month < 0; + croak "Day out of range 1..31 in timelocal.pl" + if $_[3] > 31 || $_[3] < 1; + croak "Hour out of range 0..23 in timelocal.pl" + if $_[2] > 23 || $_[2] < 0; + croak "Minute out of range 0..59 in timelocal.pl" + if $_[1] > 59 || $_[1] < 0; + croak "Second out of range 0..59 in timelocal.pl" + if $_[0] > 59 || $_[0] < 0; + $guess = $^T; + @g = gmtime($guess); + $year += $YearFix if $year < $epoch[5]; + $lastguess = ""; + while ($diff = $year - $g[5]) { + $guess += $diff * (363 * $DAYS); + @g = gmtime($guess); + if (($thisguess = "@g") eq $lastguess){ + return -1; #date beyond this machine's integer limit + } + $lastguess = $thisguess; + } + while ($diff = $month - $g[4]) { + $guess += $diff * (27 * $DAYS); + @g = gmtime($guess); + if (($thisguess = "@g") eq $lastguess){ + return -1; #date beyond this machine's integer limit + } + $lastguess = $thisguess; + } + @gfake = gmtime($guess-1); #still being sceptic + if ("@gfake" eq $lastguess){ + return -1; #date beyond this machine's integer limit + } + $g[3]--; + $guess -= $g[0] * $SEC + $g[1] * $MIN + $g[2] * $HR + $g[3] * $DAYS; + $cheat{$ym} = $guess; +} + +1; diff --git a/lib/auto/NDBM_File.so b/lib/auto/NDBM_File.so deleted file mode 100755 index af2b0d3..0000000 Binary files a/lib/auto/NDBM_File.so and /dev/null differ diff --git a/lib/auto/NDBM_File/NDBM_File.so b/lib/auto/NDBM_File/NDBM_File.so deleted file mode 100755 index 49c04e6..0000000 Binary files a/lib/auto/NDBM_File/NDBM_File.so and /dev/null differ diff --git a/lib/auto/ODBM_File.so b/lib/auto/ODBM_File.so deleted file mode 100755 index 5044c8a..0000000 Binary files a/lib/auto/ODBM_File.so and /dev/null differ diff --git a/lib/auto/ODBM_File/ODBM_File.so b/lib/auto/ODBM_File/ODBM_File.so deleted file mode 100755 index f61231f..0000000 Binary files a/lib/auto/ODBM_File/ODBM_File.so and /dev/null differ diff --git a/lib/auto/POSIX.so b/lib/auto/POSIX.so deleted file mode 100755 index 7065a09..0000000 Binary files a/lib/auto/POSIX.so and /dev/null differ diff --git a/lib/auto/POSIX/POSIX.so b/lib/auto/POSIX/POSIX.so deleted file mode 100755 index 17560bd..0000000 Binary files a/lib/auto/POSIX/POSIX.so and /dev/null differ diff --git a/lib/auto/POSIX/_exit b/lib/auto/POSIX/_exit deleted file mode 100644 index a860527..0000000 --- a/lib/auto/POSIX/_exit +++ /dev/null @@ -1,9 +0,0 @@ -package POSIX; - -sub _exit { - unimpl "_exit(xxx)", caller if @_ != 123; - _exit($_[0]); -} - - -1; diff --git a/lib/auto/POSIX/_exit.al b/lib/auto/POSIX/_exit.al deleted file mode 100644 index 7666ceb..0000000 --- a/lib/auto/POSIX/_exit.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub _exit { - unimpl "_exit(xxx)", caller if @_ != 123; - _exit($_[0]); -} - -1; diff --git a/lib/auto/POSIX/abort.al b/lib/auto/POSIX/abort.al deleted file mode 100644 index 58e7ce9..0000000 --- a/lib/auto/POSIX/abort.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub abort { - unimpl "abort(xxx)", caller if @_ != 123; - abort($_[0]); -} - -1; diff --git a/lib/auto/POSIX/abs.al b/lib/auto/POSIX/abs.al deleted file mode 100644 index 4a832b4..0000000 --- a/lib/auto/POSIX/abs.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub abs { - usage "abs(x)", caller if @_ != 1; - abs($_[0]); -} - -1; diff --git a/lib/auto/POSIX/access.al b/lib/auto/POSIX/access.al deleted file mode 100644 index 89bbfb0..0000000 --- a/lib/auto/POSIX/access.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub access { - unimpl "access(xxx)", caller if @_ != 123; - access($_[0]); -} - -1; diff --git a/lib/auto/POSIX/alarm.al b/lib/auto/POSIX/alarm.al deleted file mode 100644 index 183b6d9..0000000 --- a/lib/auto/POSIX/alarm.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub alarm { - unimpl "alarm(xxx)", caller if @_ != 123; - alarm($_[0]); -} - -1; diff --git a/lib/auto/POSIX/asctime.al b/lib/auto/POSIX/asctime.al deleted file mode 100644 index 067e0f4..0000000 --- a/lib/auto/POSIX/asctime.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub asctime { - unimpl "asctime(xxx)", caller if @_ != 123; - asctime($_[0]); -} - -1; diff --git a/lib/auto/POSIX/assert.al b/lib/auto/POSIX/assert.al deleted file mode 100644 index f32a853..0000000 --- a/lib/auto/POSIX/assert.al +++ /dev/null @@ -1,12 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub assert { - usage "assert(expr)", caller if @_ != 1; - if (!$_[0]) { - local ($pack,$file,$line) = caller; - die "Assertion failed at $file line $line\n"; - } -} - -1; diff --git a/lib/auto/POSIX/atan2.al b/lib/auto/POSIX/atan2.al deleted file mode 100644 index 1b2e23a..0000000 --- a/lib/auto/POSIX/atan2.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub atan2 { - usage "atan2(x,y)", caller if @_ != 2; - atan2($_[0], $_[1]); -} - -1; diff --git a/lib/auto/POSIX/atexit.al b/lib/auto/POSIX/atexit.al deleted file mode 100644 index 054d8da..0000000 --- a/lib/auto/POSIX/atexit.al +++ /dev/null @@ -1,8 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub atexit { - unimpl "atexit() is C-specific: use END {} instead", caller; -} - -1; diff --git a/lib/auto/POSIX/atof.al b/lib/auto/POSIX/atof.al deleted file mode 100644 index 0875991..0000000 --- a/lib/auto/POSIX/atof.al +++ /dev/null @@ -1,8 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub atof { - unimpl "atof() is C-specific, stopped", caller; -} - -1; diff --git a/lib/auto/POSIX/atoi.al b/lib/auto/POSIX/atoi.al deleted file mode 100644 index 6f18387..0000000 --- a/lib/auto/POSIX/atoi.al +++ /dev/null @@ -1,8 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub atoi { - unimpl "atoi() is C-specific, stopped", caller; -} - -1; diff --git a/lib/auto/POSIX/atol.al b/lib/auto/POSIX/atol.al deleted file mode 100644 index 9393d21..0000000 --- a/lib/auto/POSIX/atol.al +++ /dev/null @@ -1,8 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub atol { - unimpl "atol() is C-specific, stopped", caller; -} - -1; diff --git a/lib/auto/POSIX/bsearch.al b/lib/auto/POSIX/bsearch.al deleted file mode 100644 index ed104ad..0000000 --- a/lib/auto/POSIX/bsearch.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub bsearch { - unimpl "bsearch(xxx)", caller if @_ != 123; - bsearch($_[0]); -} - -1; diff --git a/lib/auto/POSIX/calloc.al b/lib/auto/POSIX/calloc.al deleted file mode 100644 index d533523..0000000 --- a/lib/auto/POSIX/calloc.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub calloc { - unimpl "calloc(xxx)", caller if @_ != 123; - calloc($_[0]); -} - -1; diff --git a/lib/auto/POSIX/cfgetispeed.al b/lib/auto/POSIX/cfgetispeed.al deleted file mode 100644 index a95efd6..0000000 --- a/lib/auto/POSIX/cfgetispeed.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub cfgetispeed { - unimpl "cfgetispeed(xxx)", caller if @_ != 123; - cfgetispeed($_[0]); -} - -1; diff --git a/lib/auto/POSIX/cfgetospeed.al b/lib/auto/POSIX/cfgetospeed.al deleted file mode 100644 index 69e66ad..0000000 --- a/lib/auto/POSIX/cfgetospeed.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub cfgetospeed { - unimpl "cfgetospeed(xxx)", caller if @_ != 123; - cfgetospeed($_[0]); -} - -1; diff --git a/lib/auto/POSIX/cfsetispeed.al b/lib/auto/POSIX/cfsetispeed.al deleted file mode 100644 index cbcc646..0000000 --- a/lib/auto/POSIX/cfsetispeed.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub cfsetispeed { - unimpl "cfsetispeed(xxx)", caller if @_ != 123; - cfsetispeed($_[0]); -} - -1; diff --git a/lib/auto/POSIX/cfsetospeed.al b/lib/auto/POSIX/cfsetospeed.al deleted file mode 100644 index 7dae85c..0000000 --- a/lib/auto/POSIX/cfsetospeed.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub cfsetospeed { - unimpl "cfsetospeed(xxx)", caller if @_ != 123; - cfsetospeed($_[0]); -} - -1; diff --git a/lib/auto/POSIX/chdir.al b/lib/auto/POSIX/chdir.al deleted file mode 100644 index 9e1f685..0000000 --- a/lib/auto/POSIX/chdir.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub chdir { - unimpl "chdir(xxx)", caller if @_ != 123; - chdir($_[0]); -} - -1; diff --git a/lib/auto/POSIX/chmod.al b/lib/auto/POSIX/chmod.al deleted file mode 100644 index 24fe4c5..0000000 --- a/lib/auto/POSIX/chmod.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub chmod { - usage "chmod(filename, mode)", caller if @_ != 2; - chmod($_[0], $_[1]); -} - -1; diff --git a/lib/auto/POSIX/chown.al b/lib/auto/POSIX/chown.al deleted file mode 100644 index 127d898..0000000 --- a/lib/auto/POSIX/chown.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub chown { - usage "chown(filename, uid, gid)", caller if @_ != 3; - chown($_[0], $_[1], $_[2]); -} - -1; diff --git a/lib/auto/POSIX/clearerr.al b/lib/auto/POSIX/clearerr.al deleted file mode 100644 index 412f521..0000000 --- a/lib/auto/POSIX/clearerr.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub clearerr { - usage "clearerr(filehandle)", caller if @_ != 1; - seek($_[0], 0, 1); -} - -1; diff --git a/lib/auto/POSIX/clock.al b/lib/auto/POSIX/clock.al deleted file mode 100644 index 7fae255..0000000 --- a/lib/auto/POSIX/clock.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub clock { - unimpl "clock(xxx)", caller if @_ != 123; - clock($_[0]); -} - -1; diff --git a/lib/auto/POSIX/close.al b/lib/auto/POSIX/close.al deleted file mode 100644 index ce47188..0000000 --- a/lib/auto/POSIX/close.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub close { - unimpl "close(xxx)", caller if @_ != 123; - close($_[0]); -} - -1; diff --git a/lib/auto/POSIX/closedir.al b/lib/auto/POSIX/closedir.al deleted file mode 100644 index bb12a26..0000000 --- a/lib/auto/POSIX/closedir.al +++ /dev/null @@ -1,10 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub closedir { - usage "closedir(dirhandle)", caller if @_ != 1; - closedir($_[0]); - ungensym($_[0]); -} - -1; diff --git a/lib/auto/POSIX/cos.al b/lib/auto/POSIX/cos.al deleted file mode 100644 index 4ea59df..0000000 --- a/lib/auto/POSIX/cos.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub cos { - usage "cos(x)", caller if @_ != 1; - cos($_[0]); -} - -1; diff --git a/lib/auto/POSIX/creat.al b/lib/auto/POSIX/creat.al deleted file mode 100644 index 74656e7..0000000 --- a/lib/auto/POSIX/creat.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub creat { - usage "creat(filename, mode)", caller if @_ != 2; - &open($_[0], &O_WRONLY | &O_CREAT | &O_TRUNC, $_[2]); -} - -1; diff --git a/lib/auto/POSIX/ctermid.al b/lib/auto/POSIX/ctermid.al deleted file mode 100644 index 37a8f71..0000000 --- a/lib/auto/POSIX/ctermid.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub ctermid { - unimpl "ctermid(xxx)", caller if @_ != 123; - ctermid($_[0]); -} - -1; diff --git a/lib/auto/POSIX/ctime.al b/lib/auto/POSIX/ctime.al deleted file mode 100644 index d12aa4e..0000000 --- a/lib/auto/POSIX/ctime.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub ctime { - unimpl "ctime(xxx)", caller if @_ != 123; - ctime($_[0]); -} - -1; diff --git a/lib/auto/POSIX/cuserid.al b/lib/auto/POSIX/cuserid.al deleted file mode 100644 index 546c309..0000000 --- a/lib/auto/POSIX/cuserid.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub cuserid { - unimpl "cuserid(xxx)", caller if @_ != 123; - cuserid($_[0]); -} - -1; diff --git a/lib/auto/POSIX/difftime.al b/lib/auto/POSIX/difftime.al deleted file mode 100644 index dd4b3db..0000000 --- a/lib/auto/POSIX/difftime.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub difftime { - unimpl "difftime(xxx)", caller if @_ != 123; - difftime($_[0]); -} - -1; diff --git a/lib/auto/POSIX/div.al b/lib/auto/POSIX/div.al deleted file mode 100644 index 0102b32..0000000 --- a/lib/auto/POSIX/div.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub div { - unimpl "div(xxx)", caller if @_ != 123; - div($_[0]); -} - -1; diff --git a/lib/auto/POSIX/dup.al b/lib/auto/POSIX/dup.al deleted file mode 100644 index 393119e..0000000 --- a/lib/auto/POSIX/dup.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub dup { - unimpl "dup(xxx)", caller if @_ != 123; - dup($_[0]); -} - -1; diff --git a/lib/auto/POSIX/dup2.al b/lib/auto/POSIX/dup2.al deleted file mode 100644 index c85f16e..0000000 --- a/lib/auto/POSIX/dup2.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub dup2 { - unimpl "dup2(xxx)", caller if @_ != 123; - dup2($_[0]); -} - -1; diff --git a/lib/auto/POSIX/errno.al b/lib/auto/POSIX/errno.al deleted file mode 100644 index 971b7e8..0000000 --- a/lib/auto/POSIX/errno.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub errno { - usage "errno()", caller if @_ != 0; - $! + 0; -} - -1; diff --git a/lib/auto/POSIX/execl.al b/lib/auto/POSIX/execl.al deleted file mode 100644 index c89c6fd..0000000 --- a/lib/auto/POSIX/execl.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub execl { - unimpl "execl(xxx)", caller if @_ != 123; - execl($_[0]); -} - -1; diff --git a/lib/auto/POSIX/execle.al b/lib/auto/POSIX/execle.al deleted file mode 100644 index 530ac76..0000000 --- a/lib/auto/POSIX/execle.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub execle { - unimpl "execle(xxx)", caller if @_ != 123; - execle($_[0]); -} - -1; diff --git a/lib/auto/POSIX/execlp.al b/lib/auto/POSIX/execlp.al deleted file mode 100644 index ea78975..0000000 --- a/lib/auto/POSIX/execlp.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub execlp { - unimpl "execlp(xxx)", caller if @_ != 123; - execlp($_[0]); -} - -1; diff --git a/lib/auto/POSIX/execv.al b/lib/auto/POSIX/execv.al deleted file mode 100644 index 382ec7d..0000000 --- a/lib/auto/POSIX/execv.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub execv { - unimpl "execv(xxx)", caller if @_ != 123; - execv($_[0]); -} - -1; diff --git a/lib/auto/POSIX/execve.al b/lib/auto/POSIX/execve.al deleted file mode 100644 index 9f5790a..0000000 --- a/lib/auto/POSIX/execve.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub execve { - unimpl "execve(xxx)", caller if @_ != 123; - execve($_[0]); -} - -1; diff --git a/lib/auto/POSIX/execvp.al b/lib/auto/POSIX/execvp.al deleted file mode 100644 index 38677d8..0000000 --- a/lib/auto/POSIX/execvp.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub execvp { - unimpl "execvp(xxx)", caller if @_ != 123; - execvp($_[0]); -} - -1; diff --git a/lib/auto/POSIX/exit.al b/lib/auto/POSIX/exit.al deleted file mode 100644 index fc46de2..0000000 --- a/lib/auto/POSIX/exit.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub exit { - unimpl "exit(xxx)", caller if @_ != 123; - exit($_[0]); -} - -1; diff --git a/lib/auto/POSIX/exp.al b/lib/auto/POSIX/exp.al deleted file mode 100644 index 70683e0..0000000 --- a/lib/auto/POSIX/exp.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub exp { - usage "exp(x)", caller if @_ != 1; - exp($_[0]); -} - -1; diff --git a/lib/auto/POSIX/fabs.al b/lib/auto/POSIX/fabs.al deleted file mode 100644 index 5683d66..0000000 --- a/lib/auto/POSIX/fabs.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub fabs { - usage "fabs(x)", caller if @_ != 1; - abs($_[0]); -} - -1; diff --git a/lib/auto/POSIX/fclose.al b/lib/auto/POSIX/fclose.al deleted file mode 100644 index 493b964..0000000 --- a/lib/auto/POSIX/fclose.al +++ /dev/null @@ -1,8 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub fclose { - unimpl "fclose() is C-specific--use close instead", caller; -} - -1; diff --git a/lib/auto/POSIX/fcntl.al b/lib/auto/POSIX/fcntl.al deleted file mode 100644 index 8108a00..0000000 --- a/lib/auto/POSIX/fcntl.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub fcntl { - usage "fcntl(filehandle, cmd, arg)", caller if @_ != 3; - fcntl($_[0], $_[1], $_[2]); -} - -1; diff --git a/lib/auto/POSIX/fdopen.al b/lib/auto/POSIX/fdopen.al deleted file mode 100644 index 23487ca..0000000 --- a/lib/auto/POSIX/fdopen.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub fdopen { - unimpl "fdopen(xxx)", caller if @_ != 123; - fdopen($_[0]); -} - -1; diff --git a/lib/auto/POSIX/feof.al b/lib/auto/POSIX/feof.al deleted file mode 100644 index 895d58b..0000000 --- a/lib/auto/POSIX/feof.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub feof { - usage "feof(filehandle)", caller if @_ != 1; - eof($_[0]); -} - -1; diff --git a/lib/auto/POSIX/ferror.al b/lib/auto/POSIX/ferror.al deleted file mode 100644 index 0588424..0000000 --- a/lib/auto/POSIX/ferror.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub ferror { - unimpl "ferror(xxx)", caller if @_ != 123; - ferror($_[0]); -} - -1; diff --git a/lib/auto/POSIX/fflush.al b/lib/auto/POSIX/fflush.al deleted file mode 100644 index b7b7676..0000000 --- a/lib/auto/POSIX/fflush.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub fflush { - unimpl "fflush(xxx)", caller if @_ != 123; - fflush($_[0]); -} - -1; diff --git a/lib/auto/POSIX/fgetc.al b/lib/auto/POSIX/fgetc.al deleted file mode 100644 index 41cd70f..0000000 --- a/lib/auto/POSIX/fgetc.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub fgetc { - usage "fgetc(filehandle)", caller if @_ != 1; - getc($_[0]); -} - -1; diff --git a/lib/auto/POSIX/fgetpos.al b/lib/auto/POSIX/fgetpos.al deleted file mode 100644 index 679fcd5..0000000 --- a/lib/auto/POSIX/fgetpos.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub fgetpos { - unimpl "fgetpos(xxx)", caller if @_ != 123; - fgetpos($_[0]); -} - -1; diff --git a/lib/auto/POSIX/fgets.al b/lib/auto/POSIX/fgets.al deleted file mode 100644 index 7a475b3..0000000 --- a/lib/auto/POSIX/fgets.al +++ /dev/null @@ -1,10 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub fgets { - usage "fgets(filehandle)", caller if @_ != 1; - local($handle) = @_; - scalar <$handle>; -} - -1; diff --git a/lib/auto/POSIX/fileno.al b/lib/auto/POSIX/fileno.al deleted file mode 100644 index 62c7c0a..0000000 --- a/lib/auto/POSIX/fileno.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub fileno { - usage "fileno(filehandle)", caller if @_ != 1; - fileno($_[0]); -} - -1; diff --git a/lib/auto/POSIX/fopen.al b/lib/auto/POSIX/fopen.al deleted file mode 100644 index f4394ad..0000000 --- a/lib/auto/POSIX/fopen.al +++ /dev/null @@ -1,8 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub fopen { - unimpl "fopen() is C-specific--use open instead", caller; -} - -1; diff --git a/lib/auto/POSIX/fork.al b/lib/auto/POSIX/fork.al deleted file mode 100644 index 0646615..0000000 --- a/lib/auto/POSIX/fork.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub fork { - usage "fork()", caller if @_ != 0; - fork; -} - -1; diff --git a/lib/auto/POSIX/fpathconf.al b/lib/auto/POSIX/fpathconf.al deleted file mode 100644 index 533f906..0000000 --- a/lib/auto/POSIX/fpathconf.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub fpathconf { - unimpl "fpathconf(xxx)", caller if @_ != 123; - fpathconf($_[0]); -} - -1; diff --git a/lib/auto/POSIX/fprintf.al b/lib/auto/POSIX/fprintf.al deleted file mode 100644 index b577f9a..0000000 --- a/lib/auto/POSIX/fprintf.al +++ /dev/null @@ -1,8 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub fprintf { - unimpl "fprintf() is C-specific--use printf instead", caller; -} - -1; diff --git a/lib/auto/POSIX/fputc.al b/lib/auto/POSIX/fputc.al deleted file mode 100644 index 0cdf82c..0000000 --- a/lib/auto/POSIX/fputc.al +++ /dev/null @@ -1,8 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub fputc { - unimpl "fputc() is C-specific--use print instead", caller; -} - -1; diff --git a/lib/auto/POSIX/fputs.al b/lib/auto/POSIX/fputs.al deleted file mode 100644 index 208eea6..0000000 --- a/lib/auto/POSIX/fputs.al +++ /dev/null @@ -1,11 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub fputs { - unimpl "fputs() is C-specific--use print instead", caller; - usage "fputs(string, handle)", caller if @_ != 2; - local($handle) = pop; - print $handle @_; -} - -1; diff --git a/lib/auto/POSIX/fread.al b/lib/auto/POSIX/fread.al deleted file mode 100644 index 5b5c0c5..0000000 --- a/lib/auto/POSIX/fread.al +++ /dev/null @@ -1,10 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub fread { - unimpl "fread() is C-specific--use read instead", caller; - unimpl "fread(xxx)", caller if @_ != 123; - fread($_[0]); -} - -1; diff --git a/lib/auto/POSIX/free.al b/lib/auto/POSIX/free.al deleted file mode 100644 index 319a76d..0000000 --- a/lib/auto/POSIX/free.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub free { - unimpl "free(xxx)", caller if @_ != 123; - free($_[0]); -} - -1; diff --git a/lib/auto/POSIX/freopen.al b/lib/auto/POSIX/freopen.al deleted file mode 100644 index ed4eca6..0000000 --- a/lib/auto/POSIX/freopen.al +++ /dev/null @@ -1,10 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub freopen { - unimpl "freopen() is C-specific--use open instead", caller; - unimpl "freopen(xxx)", caller if @_ != 123; - freopen($_[0]); -} - -1; diff --git a/lib/auto/POSIX/fscanf.al b/lib/auto/POSIX/fscanf.al deleted file mode 100644 index 80a8e61..0000000 --- a/lib/auto/POSIX/fscanf.al +++ /dev/null @@ -1,10 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub fscanf { - unimpl "fscanf() is C-specific--use <> and regular expressions instead", caller; - unimpl "fscanf(xxx)", caller if @_ != 123; - fscanf($_[0]); -} - -1; diff --git a/lib/auto/POSIX/fseek.al b/lib/auto/POSIX/fseek.al deleted file mode 100644 index 55da72a..0000000 --- a/lib/auto/POSIX/fseek.al +++ /dev/null @@ -1,10 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub fseek { - unimpl "fseek() is C-specific--use seek instead", caller; - unimpl "fseek(xxx)", caller if @_ != 123; - fseek($_[0]); -} - -1; diff --git a/lib/auto/POSIX/fsetpos.al b/lib/auto/POSIX/fsetpos.al deleted file mode 100644 index 9b59546..0000000 --- a/lib/auto/POSIX/fsetpos.al +++ /dev/null @@ -1,10 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub fsetpos { - unimpl "fsetpos() is C-specific--use seek instead", caller; - unimpl "fsetpos(xxx)", caller if @_ != 123; - fsetpos($_[0]); -} - -1; diff --git a/lib/auto/POSIX/fstat.al b/lib/auto/POSIX/fstat.al deleted file mode 100644 index 64ac1b6..0000000 --- a/lib/auto/POSIX/fstat.al +++ /dev/null @@ -1,13 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub fstat { - usage "fstat(fd)", caller if @_ != 1; - local(*TMP); - open(TMP, "<&$_[0]"); # Gross. - local(@l) = stat(TMP); - close(TMP); - @l; -} - -1; diff --git a/lib/auto/POSIX/ftell.al b/lib/auto/POSIX/ftell.al deleted file mode 100644 index aa922c6..0000000 --- a/lib/auto/POSIX/ftell.al +++ /dev/null @@ -1,10 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub ftell { - unimpl "ftell() is C-specific--use tell instead", caller; - unimpl "ftell(xxx)", caller if @_ != 123; - ftell($_[0]); -} - -1; diff --git a/lib/auto/POSIX/fwrite.al b/lib/auto/POSIX/fwrite.al deleted file mode 100644 index 09d8e7d..0000000 --- a/lib/auto/POSIX/fwrite.al +++ /dev/null @@ -1,10 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub fwrite { - unimpl "fwrite() is C-specific--use print instead", caller; - unimpl "fwrite(xxx)", caller if @_ != 123; - fwrite($_[0]); -} - -1; diff --git a/lib/auto/POSIX/getc.al b/lib/auto/POSIX/getc.al deleted file mode 100644 index 5919395..0000000 --- a/lib/auto/POSIX/getc.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub getc { - usage "getc(handle)", caller if @_ != 1; - getc($_[0]); -} - -1; diff --git a/lib/auto/POSIX/getchar.al b/lib/auto/POSIX/getchar.al deleted file mode 100644 index 08e5111..0000000 --- a/lib/auto/POSIX/getchar.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub getchar { - usage "getchar()", caller if @_ != 0; - getc(STDIN); -} - -1; diff --git a/lib/auto/POSIX/getcwd.al b/lib/auto/POSIX/getcwd.al deleted file mode 100644 index 1e1ec7c..0000000 --- a/lib/auto/POSIX/getcwd.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub getcwd { - unimpl "getcwd(xxx)", caller if @_ != 123; - getcwd($_[0]); -} - -1; diff --git a/lib/auto/POSIX/getegid.al b/lib/auto/POSIX/getegid.al deleted file mode 100644 index 6f3719c..0000000 --- a/lib/auto/POSIX/getegid.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub getegid { - usage "getegid()", caller if @_ != 0; - $) + 0; -} - -1; diff --git a/lib/auto/POSIX/getenv.al b/lib/auto/POSIX/getenv.al deleted file mode 100644 index 04fc148..0000000 --- a/lib/auto/POSIX/getenv.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub getenv { - unimpl "getenv(xxx)", caller if @_ != 123; - getenv($_[0]); -} - -1; diff --git a/lib/auto/POSIX/geteuid.al b/lib/auto/POSIX/geteuid.al deleted file mode 100644 index 74b10ff..0000000 --- a/lib/auto/POSIX/geteuid.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub geteuid { - usage "geteuid()", caller if @_ != 0; - $> + 0; -} - -1; diff --git a/lib/auto/POSIX/getgid.al b/lib/auto/POSIX/getgid.al deleted file mode 100644 index a106618..0000000 --- a/lib/auto/POSIX/getgid.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub getgid { - usage "getgid()", caller if @_ != 0; - $( + 0; -} - -1; diff --git a/lib/auto/POSIX/getgrgid.al b/lib/auto/POSIX/getgrgid.al deleted file mode 100644 index 485ed2b..0000000 --- a/lib/auto/POSIX/getgrgid.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub getgrgid { - usage "getgrgid(gid)", caller if @_ != 1; - getgrgid($_[0]); -} - -1; diff --git a/lib/auto/POSIX/getgrnam.al b/lib/auto/POSIX/getgrnam.al deleted file mode 100644 index 1dcbc69..0000000 --- a/lib/auto/POSIX/getgrnam.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub getgrnam { - usage "getgrnam(name)", caller if @_ != 1; - getgrnam($_[0]); -} - -1; diff --git a/lib/auto/POSIX/getgroups.al b/lib/auto/POSIX/getgroups.al deleted file mode 100644 index 34ae5e8..0000000 --- a/lib/auto/POSIX/getgroups.al +++ /dev/null @@ -1,10 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub getgroups { - usage "getgroups()", caller if @_ != 0; - local(%seen) = (); - grep(!%seen{$_}++, split(' ', $) )); -} - -1; diff --git a/lib/auto/POSIX/getlogin.al b/lib/auto/POSIX/getlogin.al deleted file mode 100644 index 8f61cb2..0000000 --- a/lib/auto/POSIX/getlogin.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub getlogin { - usage "getlogin(xxx)", caller if @_ != 0; - getlogin(); -} - -1; diff --git a/lib/auto/POSIX/getpgrp.al b/lib/auto/POSIX/getpgrp.al deleted file mode 100644 index 0364706..0000000 --- a/lib/auto/POSIX/getpgrp.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub getpgrp { - usage "getpgrp()", caller if @_ != 0; - getpgrp($_[0]); -} - -1; diff --git a/lib/auto/POSIX/getpid.al b/lib/auto/POSIX/getpid.al deleted file mode 100644 index 51deea4..0000000 --- a/lib/auto/POSIX/getpid.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub getpid { - usage "getpid()", caller if @_ != 0; - $$; -} - -1; diff --git a/lib/auto/POSIX/getppid.al b/lib/auto/POSIX/getppid.al deleted file mode 100644 index 95450e9..0000000 --- a/lib/auto/POSIX/getppid.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub getppid { - usage "getppid()", caller if @_ != 0; - getppid; -} - -1; diff --git a/lib/auto/POSIX/getpwnam.al b/lib/auto/POSIX/getpwnam.al deleted file mode 100644 index d4cbc8d..0000000 --- a/lib/auto/POSIX/getpwnam.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub getpwnam { - usage "getpwnam(name)", caller if @_ != 1; - getpwnam($_[0]); -} - -1; diff --git a/lib/auto/POSIX/getpwuid.al b/lib/auto/POSIX/getpwuid.al deleted file mode 100644 index cfb1265..0000000 --- a/lib/auto/POSIX/getpwuid.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub getpwuid { - usage "getpwuid(uid)", caller if @_ != 1; - getpwuid($_[0]); -} - -1; diff --git a/lib/auto/POSIX/gets.al b/lib/auto/POSIX/gets.al deleted file mode 100644 index d989692..0000000 --- a/lib/auto/POSIX/gets.al +++ /dev/null @@ -1,10 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub gets { - usage "gets(handle)", caller if @_ != 1; - local($handle) = shift; - scalar <$handle>; -} - -1; diff --git a/lib/auto/POSIX/getuid.al b/lib/auto/POSIX/getuid.al deleted file mode 100644 index 6b97d48..0000000 --- a/lib/auto/POSIX/getuid.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub getuid { - usage "getuid()", caller if @_ != 0; - $<; -} - -1; diff --git a/lib/auto/POSIX/gmtime.al b/lib/auto/POSIX/gmtime.al deleted file mode 100644 index 520d2da..0000000 --- a/lib/auto/POSIX/gmtime.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub gmtime { - unimpl "gmtime(xxx)", caller if @_ != 123; - gmtime($_[0]); -} - -1; diff --git a/lib/auto/POSIX/isatty.al b/lib/auto/POSIX/isatty.al deleted file mode 100644 index dfc50f4..0000000 --- a/lib/auto/POSIX/isatty.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub isatty { - unimpl "isatty(xxx)", caller if @_ != 123; - isatty($_[0]); -} - -1; diff --git a/lib/auto/POSIX/kill.al b/lib/auto/POSIX/kill.al deleted file mode 100644 index 138a6d7..0000000 --- a/lib/auto/POSIX/kill.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub kill { - usage "kill(pid, sig)", caller if @_ != 2; - kill $_[1], $_[0]; -} - -1; diff --git a/lib/auto/POSIX/labs.al b/lib/auto/POSIX/labs.al deleted file mode 100644 index 90426e8..0000000 --- a/lib/auto/POSIX/labs.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub labs { - unimpl "labs(xxx)", caller if @_ != 123; - labs($_[0]); -} - -1; diff --git a/lib/auto/POSIX/ldiv.al b/lib/auto/POSIX/ldiv.al deleted file mode 100644 index 788fb32..0000000 --- a/lib/auto/POSIX/ldiv.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub ldiv { - unimpl "ldiv(xxx)", caller if @_ != 123; - ldiv($_[0]); -} - -1; diff --git a/lib/auto/POSIX/link.al b/lib/auto/POSIX/link.al deleted file mode 100644 index 662ad9d..0000000 --- a/lib/auto/POSIX/link.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub link { - usage "link(oldfilename, newfilename)", caller if @_ != 2; - link($_[0], $_[1]); -} - -1; diff --git a/lib/auto/POSIX/localtime.al b/lib/auto/POSIX/localtime.al deleted file mode 100644 index 5e4d61a..0000000 --- a/lib/auto/POSIX/localtime.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub localtime { - unimpl "localtime(xxx)", caller if @_ != 123; - localtime($_[0]); -} - -1; diff --git a/lib/auto/POSIX/log.al b/lib/auto/POSIX/log.al deleted file mode 100644 index 2ba36f2..0000000 --- a/lib/auto/POSIX/log.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub log { - usage "log(x)", caller if @_ != 1; - log($_[0]); -} - -1; diff --git a/lib/auto/POSIX/longjmp.al b/lib/auto/POSIX/longjmp.al deleted file mode 100644 index d403d46..0000000 --- a/lib/auto/POSIX/longjmp.al +++ /dev/null @@ -1,8 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub longjmp { - unimpl "longjmp() is C-specific: use die instead", caller; -} - -1; diff --git a/lib/auto/POSIX/lseek.al b/lib/auto/POSIX/lseek.al deleted file mode 100644 index ded754a..0000000 --- a/lib/auto/POSIX/lseek.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub lseek { - unimpl "lseek(xxx)", caller if @_ != 123; - lseek($_[0]); -} - -1; diff --git a/lib/auto/POSIX/malloc.al b/lib/auto/POSIX/malloc.al deleted file mode 100644 index e860639..0000000 --- a/lib/auto/POSIX/malloc.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub malloc { - unimpl "malloc(xxx)", caller if @_ != 123; - malloc($_[0]); -} - -1; diff --git a/lib/auto/POSIX/mblen.al b/lib/auto/POSIX/mblen.al deleted file mode 100644 index 1a7b7f3..0000000 --- a/lib/auto/POSIX/mblen.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub mblen { - unimpl "mblen(xxx)", caller if @_ != 123; - mblen($_[0]); -} - -1; diff --git a/lib/auto/POSIX/mbstowcs.al b/lib/auto/POSIX/mbstowcs.al deleted file mode 100644 index 8f15fe3..0000000 --- a/lib/auto/POSIX/mbstowcs.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub mbstowcs { - unimpl "mbstowcs(xxx)", caller if @_ != 123; - mbstowcs($_[0]); -} - -1; diff --git a/lib/auto/POSIX/mbtowc.al b/lib/auto/POSIX/mbtowc.al deleted file mode 100644 index 695dcb9..0000000 --- a/lib/auto/POSIX/mbtowc.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub mbtowc { - unimpl "mbtowc(xxx)", caller if @_ != 123; - mbtowc($_[0]); -} - -1; diff --git a/lib/auto/POSIX/memchr.al b/lib/auto/POSIX/memchr.al deleted file mode 100644 index 28b0c12..0000000 --- a/lib/auto/POSIX/memchr.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub memchr { - unimpl "memchr(xxx)", caller if @_ != 123; - memchr($_[0]); -} - -1; diff --git a/lib/auto/POSIX/memcmp.al b/lib/auto/POSIX/memcmp.al deleted file mode 100644 index 8406f28..0000000 --- a/lib/auto/POSIX/memcmp.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub memcmp { - unimpl "memcmp(xxx)", caller if @_ != 123; - memcmp($_[0]); -} - -1; diff --git a/lib/auto/POSIX/memcpy.al b/lib/auto/POSIX/memcpy.al deleted file mode 100644 index eee2dd6..0000000 --- a/lib/auto/POSIX/memcpy.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub memcpy { - unimpl "memcpy(xxx)", caller if @_ != 123; - memcpy($_[0]); -} - -1; diff --git a/lib/auto/POSIX/memmove.al b/lib/auto/POSIX/memmove.al deleted file mode 100644 index c926d78..0000000 --- a/lib/auto/POSIX/memmove.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub memmove { - unimpl "memmove(xxx)", caller if @_ != 123; - memmove($_[0]); -} - -1; diff --git a/lib/auto/POSIX/memset.al b/lib/auto/POSIX/memset.al deleted file mode 100644 index 369930e..0000000 --- a/lib/auto/POSIX/memset.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub memset { - unimpl "memset(xxx)", caller if @_ != 123; - memset($_[0]); -} - -1; diff --git a/lib/auto/POSIX/mkdir.al b/lib/auto/POSIX/mkdir.al deleted file mode 100644 index 0b10882..0000000 --- a/lib/auto/POSIX/mkdir.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub mkdir { - usage "mkdir(directoryname, mode)", caller if @_ != 2; - mkdir($_[0], $_[1]); -} - -1; diff --git a/lib/auto/POSIX/mkfifo.al b/lib/auto/POSIX/mkfifo.al deleted file mode 100644 index 8b6ad72..0000000 --- a/lib/auto/POSIX/mkfifo.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub mkfifo { - unimpl "mkfifo(xxx)", caller if @_ != 123; - mkfifo($_[0]); -} - -1; diff --git a/lib/auto/POSIX/mktime.al b/lib/auto/POSIX/mktime.al deleted file mode 100644 index df7e355..0000000 --- a/lib/auto/POSIX/mktime.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub mktime { - unimpl "mktime(xxx)", caller if @_ != 123; - mktime($_[0]); -} - -1; diff --git a/lib/auto/POSIX/offsetof.al b/lib/auto/POSIX/offsetof.al deleted file mode 100644 index fb5ecfb..0000000 --- a/lib/auto/POSIX/offsetof.al +++ /dev/null @@ -1,8 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub offsetof { - unimpl "offsetof() is C-specific, stopped", caller; -} - -1; diff --git a/lib/auto/POSIX/opendir.al b/lib/auto/POSIX/opendir.al deleted file mode 100644 index 7c264d4..0000000 --- a/lib/auto/POSIX/opendir.al +++ /dev/null @@ -1,12 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub opendir { - usage "opendir(directory)", caller if @_ != 1; - local($dirhandle) = &gensym; - opendir($dirhandle, $_[0]) - ? $dirhandle - : (ungensym($dirhandle), undef); -} - -1; diff --git a/lib/auto/POSIX/pathconf.al b/lib/auto/POSIX/pathconf.al deleted file mode 100644 index 4a66189..0000000 --- a/lib/auto/POSIX/pathconf.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub pathconf { - unimpl "pathconf(xxx)", caller if @_ != 123; - pathconf($_[0]); -} - -1; diff --git a/lib/auto/POSIX/pause.al b/lib/auto/POSIX/pause.al deleted file mode 100644 index 41fcea6..0000000 --- a/lib/auto/POSIX/pause.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub pause { - unimpl "pause(xxx)", caller if @_ != 123; - pause($_[0]); -} - -1; diff --git a/lib/auto/POSIX/perror.al b/lib/auto/POSIX/perror.al deleted file mode 100644 index 36ae11e..0000000 --- a/lib/auto/POSIX/perror.al +++ /dev/null @@ -1,10 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub perror { - unimpl "perror() is C-specific--print $! instead", caller; - unimpl "perror(xxx)", caller if @_ != 123; - perror($_[0]); -} - -1; diff --git a/lib/auto/POSIX/pipe.al b/lib/auto/POSIX/pipe.al deleted file mode 100644 index d65b5ec..0000000 --- a/lib/auto/POSIX/pipe.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub pipe { - unimpl "pipe(xxx)", caller if @_ != 123; - pipe($_[0]); -} - -1; diff --git a/lib/auto/POSIX/pow.al b/lib/auto/POSIX/pow.al deleted file mode 100644 index 0893b22..0000000 --- a/lib/auto/POSIX/pow.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub pow { - usage "pow(x,exponent)", caller if @_ != 2; - $_[0] ** $_[1]; -} - -1; diff --git a/lib/auto/POSIX/printf.al b/lib/auto/POSIX/printf.al deleted file mode 100644 index f911780..0000000 --- a/lib/auto/POSIX/printf.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub printf { - usage "printf(pattern, args...)", caller if @_ < 1; - printf STDOUT @_; -} - -1; diff --git a/lib/auto/POSIX/putc.al b/lib/auto/POSIX/putc.al deleted file mode 100644 index 59eaca8..0000000 --- a/lib/auto/POSIX/putc.al +++ /dev/null @@ -1,10 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub putc { - unimpl "putc() is C-specific--use print instead", caller; - unimpl "putc(xxx)", caller if @_ != 123; - putc($_[0]); -} - -1; diff --git a/lib/auto/POSIX/putchar.al b/lib/auto/POSIX/putchar.al deleted file mode 100644 index 1d6016c..0000000 --- a/lib/auto/POSIX/putchar.al +++ /dev/null @@ -1,10 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub putchar { - unimpl "putchar() is C-specific--use print instead", caller; - unimpl "putchar(xxx)", caller if @_ != 123; - putchar($_[0]); -} - -1; diff --git a/lib/auto/POSIX/puts.al b/lib/auto/POSIX/puts.al deleted file mode 100644 index 84d3d80..0000000 --- a/lib/auto/POSIX/puts.al +++ /dev/null @@ -1,10 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub puts { - unimpl "puts() is C-specific--use print instead", caller; - unimpl "puts(xxx)", caller if @_ != 123; - puts($_[0]); -} - -1; diff --git a/lib/auto/POSIX/qsort.al b/lib/auto/POSIX/qsort.al deleted file mode 100644 index 93eb124..0000000 --- a/lib/auto/POSIX/qsort.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub qsort { - unimpl "qsort(xxx)", caller if @_ != 123; - qsort($_[0]); -} - -1; diff --git a/lib/auto/POSIX/raise.al b/lib/auto/POSIX/raise.al deleted file mode 100644 index de43d2a..0000000 --- a/lib/auto/POSIX/raise.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub raise { - usage "raise(sig)", caller if @_ != 1; - kill $$, $_[0]; # Is this good enough? -} - -1; diff --git a/lib/auto/POSIX/rand.al b/lib/auto/POSIX/rand.al deleted file mode 100644 index 08c3a1b..0000000 --- a/lib/auto/POSIX/rand.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub rand { - unimpl "rand(xxx)", caller if @_ != 123; - rand($_[0]); -} - -1; diff --git a/lib/auto/POSIX/read.al b/lib/auto/POSIX/read.al deleted file mode 100644 index 50363af..0000000 --- a/lib/auto/POSIX/read.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub read { - unimpl "read(xxx)", caller if @_ != 123; - read($_[0]); -} - -1; diff --git a/lib/auto/POSIX/readdir.al b/lib/auto/POSIX/readdir.al deleted file mode 100644 index 84792b0..0000000 --- a/lib/auto/POSIX/readdir.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub readdir { - usage "readdir(dirhandle)", caller if @_ != 1; - readdir($_[0]); -} - -1; diff --git a/lib/auto/POSIX/realloc.al b/lib/auto/POSIX/realloc.al deleted file mode 100644 index 4899b05..0000000 --- a/lib/auto/POSIX/realloc.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub realloc { - unimpl "realloc(xxx)", caller if @_ != 123; - realloc($_[0]); -} - -1; diff --git a/lib/auto/POSIX/remove.al b/lib/auto/POSIX/remove.al deleted file mode 100644 index 83d2b8a..0000000 --- a/lib/auto/POSIX/remove.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub remove { - unimpl "remove(xxx)", caller if @_ != 123; - remove($_[0]); -} - -1; diff --git a/lib/auto/POSIX/rename.al b/lib/auto/POSIX/rename.al deleted file mode 100644 index b657c5a..0000000 --- a/lib/auto/POSIX/rename.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub rename { - usage "rename(oldfilename, newfilename)", caller if @_ != 2; - rename($_[0], $_[1]); -} - -1; diff --git a/lib/auto/POSIX/rewind.al b/lib/auto/POSIX/rewind.al deleted file mode 100644 index 0bbcc84..0000000 --- a/lib/auto/POSIX/rewind.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub rewind { - unimpl "rewind(xxx)", caller if @_ != 123; - rewind($_[0]); -} - -1; diff --git a/lib/auto/POSIX/rewinddir.al b/lib/auto/POSIX/rewinddir.al deleted file mode 100644 index 610f458..0000000 --- a/lib/auto/POSIX/rewinddir.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub rewinddir { - usage "rewinddir(dirhandle)", caller if @_ != 1; - rewinddir($_[0]); -} - -1; diff --git a/lib/auto/POSIX/rmdir.al b/lib/auto/POSIX/rmdir.al deleted file mode 100644 index a439aa6..0000000 --- a/lib/auto/POSIX/rmdir.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub rmdir { - usage "rmdir(directoryname)", caller if @_ != 1; - rmdir($_[0]); -} - -1; diff --git a/lib/auto/POSIX/scanf.al b/lib/auto/POSIX/scanf.al deleted file mode 100644 index f154409..0000000 --- a/lib/auto/POSIX/scanf.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub scanf { - unimpl "scanf(xxx)", caller if @_ != 123; - scanf($_[0]); -} - -1; diff --git a/lib/auto/POSIX/setbuf.al b/lib/auto/POSIX/setbuf.al deleted file mode 100644 index 96f2e97..0000000 --- a/lib/auto/POSIX/setbuf.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub setbuf { - unimpl "setbuf(xxx)", caller if @_ != 123; - setbuf($_[0]); -} - -1; diff --git a/lib/auto/POSIX/setgid.al b/lib/auto/POSIX/setgid.al deleted file mode 100644 index fcbb8b6..0000000 --- a/lib/auto/POSIX/setgid.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub setgid { - unimpl "setgid(xxx)", caller if @_ != 123; - setgid($_[0]); -} - -1; diff --git a/lib/auto/POSIX/setjmp.al b/lib/auto/POSIX/setjmp.al deleted file mode 100644 index 93e614a..0000000 --- a/lib/auto/POSIX/setjmp.al +++ /dev/null @@ -1,8 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub setjmp { - unimpl "setjmp() is C-specific: use eval {} instead", caller; -} - -1; diff --git a/lib/auto/POSIX/setpgid.al b/lib/auto/POSIX/setpgid.al deleted file mode 100644 index 948e79a..0000000 --- a/lib/auto/POSIX/setpgid.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub setpgid { - unimpl "setpgid(xxx)", caller if @_ != 123; - setpgid($_[0]); -} - -1; diff --git a/lib/auto/POSIX/setsid.al b/lib/auto/POSIX/setsid.al deleted file mode 100644 index 7edc965..0000000 --- a/lib/auto/POSIX/setsid.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub setsid { - unimpl "setsid(xxx)", caller if @_ != 123; - setsid($_[0]); -} - -1; diff --git a/lib/auto/POSIX/setuid.al b/lib/auto/POSIX/setuid.al deleted file mode 100644 index 02da7d3..0000000 --- a/lib/auto/POSIX/setuid.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub setuid { - unimpl "setuid(xxx)", caller if @_ != 123; - setuid($_[0]); -} - -1; diff --git a/lib/auto/POSIX/setvbuf.al b/lib/auto/POSIX/setvbuf.al deleted file mode 100644 index 5303581..0000000 --- a/lib/auto/POSIX/setvbuf.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub setvbuf { - unimpl "setvbuf(xxx)", caller if @_ != 123; - setvbuf($_[0]); -} - -1; diff --git a/lib/auto/POSIX/sigaction.al b/lib/auto/POSIX/sigaction.al deleted file mode 100644 index c2b8300..0000000 --- a/lib/auto/POSIX/sigaction.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub sigaction { - unimpl "sigaction(xxx)", caller if @_ != 123; - sigaction($_[0]); -} - -1; diff --git a/lib/auto/POSIX/sigaddset.al b/lib/auto/POSIX/sigaddset.al deleted file mode 100644 index 9a0ea67..0000000 --- a/lib/auto/POSIX/sigaddset.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub sigaddset { - unimpl "sigaddset(xxx)", caller if @_ != 123; - sigaddset($_[0]); -} - -1; diff --git a/lib/auto/POSIX/sigdelset.al b/lib/auto/POSIX/sigdelset.al deleted file mode 100644 index c252f9f..0000000 --- a/lib/auto/POSIX/sigdelset.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub sigdelset { - unimpl "sigdelset(xxx)", caller if @_ != 123; - sigdelset($_[0]); -} - -1; diff --git a/lib/auto/POSIX/sigemptyset.al b/lib/auto/POSIX/sigemptyset.al deleted file mode 100644 index f665f62..0000000 --- a/lib/auto/POSIX/sigemptyset.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub sigemptyset { - unimpl "sigemptyset(xxx)", caller if @_ != 123; - sigemptyset($_[0]); -} - -1; diff --git a/lib/auto/POSIX/sigfillset.al b/lib/auto/POSIX/sigfillset.al deleted file mode 100644 index b685797..0000000 --- a/lib/auto/POSIX/sigfillset.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub sigfillset { - unimpl "sigfillset(xxx)", caller if @_ != 123; - sigfillset($_[0]); -} - -1; diff --git a/lib/auto/POSIX/sigismember.al b/lib/auto/POSIX/sigismember.al deleted file mode 100644 index 67c9d98..0000000 --- a/lib/auto/POSIX/sigismember.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub sigismember { - unimpl "sigismember(xxx)", caller if @_ != 123; - sigismember($_[0]); -} - -1; diff --git a/lib/auto/POSIX/siglongjmp.al b/lib/auto/POSIX/siglongjmp.al deleted file mode 100644 index 48ab95e..0000000 --- a/lib/auto/POSIX/siglongjmp.al +++ /dev/null @@ -1,8 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub siglongjmp { - unimpl "siglongjmp() is C-specific: use die instead", caller; -} - -1; diff --git a/lib/auto/POSIX/signal.al b/lib/auto/POSIX/signal.al deleted file mode 100644 index 2471bd3..0000000 --- a/lib/auto/POSIX/signal.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub signal { - unimpl "signal(xxx)", caller if @_ != 123; - signal($_[0]); -} - -1; diff --git a/lib/auto/POSIX/sigpending.al b/lib/auto/POSIX/sigpending.al deleted file mode 100644 index bb2c76d..0000000 --- a/lib/auto/POSIX/sigpending.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub sigpending { - unimpl "sigpending(xxx)", caller if @_ != 123; - sigpending($_[0]); -} - -1; diff --git a/lib/auto/POSIX/sigprocmask.al b/lib/auto/POSIX/sigprocmask.al deleted file mode 100644 index a6d42a2..0000000 --- a/lib/auto/POSIX/sigprocmask.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub sigprocmask { - unimpl "sigprocmask(xxx)", caller if @_ != 123; - sigprocmask($_[0]); -} - -1; diff --git a/lib/auto/POSIX/sigsetjmp.al b/lib/auto/POSIX/sigsetjmp.al deleted file mode 100644 index b737259..0000000 --- a/lib/auto/POSIX/sigsetjmp.al +++ /dev/null @@ -1,8 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub sigsetjmp { - unimpl "sigsetjmp() is C-specific: use eval {} instead", caller; -} - -1; diff --git a/lib/auto/POSIX/sigsuspend.al b/lib/auto/POSIX/sigsuspend.al deleted file mode 100644 index 159f1d5..0000000 --- a/lib/auto/POSIX/sigsuspend.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub sigsuspend { - unimpl "sigsuspend(xxx)", caller if @_ != 123; - sigsuspend($_[0]); -} - -1; diff --git a/lib/auto/POSIX/sin.al b/lib/auto/POSIX/sin.al deleted file mode 100644 index 90681ff..0000000 --- a/lib/auto/POSIX/sin.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub sin { - usage "sin(x)", caller if @_ != 1; - sin($_[0]); -} - -1; diff --git a/lib/auto/POSIX/sleep.al b/lib/auto/POSIX/sleep.al deleted file mode 100644 index ac326e8..0000000 --- a/lib/auto/POSIX/sleep.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub sleep { - unimpl "sleep(xxx)", caller if @_ != 123; - sleep($_[0]); -} - -1; diff --git a/lib/auto/POSIX/sprintf.al b/lib/auto/POSIX/sprintf.al deleted file mode 100644 index 5a61a83..0000000 --- a/lib/auto/POSIX/sprintf.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub sprintf { - unimpl "sprintf(xxx)", caller if @_ != 123; - sprintf($_[0]); -} - -1; diff --git a/lib/auto/POSIX/sqrt.al b/lib/auto/POSIX/sqrt.al deleted file mode 100644 index f2efe5d..0000000 --- a/lib/auto/POSIX/sqrt.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub sqrt { - usage "sqrt(x)", caller if @_ != 1; - sqrt($_[0]); -} - -1; diff --git a/lib/auto/POSIX/srand.al b/lib/auto/POSIX/srand.al deleted file mode 100644 index 563757d..0000000 --- a/lib/auto/POSIX/srand.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub srand { - unimpl "srand(xxx)", caller if @_ != 123; - srand($_[0]); -} - -1; diff --git a/lib/auto/POSIX/sscanf.al b/lib/auto/POSIX/sscanf.al deleted file mode 100644 index 0570141..0000000 --- a/lib/auto/POSIX/sscanf.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub sscanf { - unimpl "sscanf(xxx)", caller if @_ != 123; - sscanf($_[0]); -} - -1; diff --git a/lib/auto/POSIX/stat.al b/lib/auto/POSIX/stat.al deleted file mode 100644 index 636607e..0000000 --- a/lib/auto/POSIX/stat.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub stat { - usage "stat(filename)", caller if @_ != 1; - stat($_[0]); -} - -1; diff --git a/lib/auto/POSIX/strcat.al b/lib/auto/POSIX/strcat.al deleted file mode 100644 index b80dd70..0000000 --- a/lib/auto/POSIX/strcat.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub strcat { - unimpl "strcat(xxx)", caller if @_ != 123; - strcat($_[0]); -} - -1; diff --git a/lib/auto/POSIX/strchr.al b/lib/auto/POSIX/strchr.al deleted file mode 100644 index 9dbea2e..0000000 --- a/lib/auto/POSIX/strchr.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub strchr { - unimpl "strchr(xxx)", caller if @_ != 123; - strchr($_[0]); -} - -1; diff --git a/lib/auto/POSIX/strcmp.al b/lib/auto/POSIX/strcmp.al deleted file mode 100644 index 72f5304..0000000 --- a/lib/auto/POSIX/strcmp.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub strcmp { - unimpl "strcmp(xxx)", caller if @_ != 123; - strcmp($_[0]); -} - -1; diff --git a/lib/auto/POSIX/strcoll.al b/lib/auto/POSIX/strcoll.al deleted file mode 100644 index a904097..0000000 --- a/lib/auto/POSIX/strcoll.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub strcoll { - unimpl "strcoll(xxx)", caller if @_ != 123; - strcoll($_[0]); -} - -1; diff --git a/lib/auto/POSIX/strcpy.al b/lib/auto/POSIX/strcpy.al deleted file mode 100644 index aa3e05d..0000000 --- a/lib/auto/POSIX/strcpy.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub strcpy { - unimpl "strcpy(xxx)", caller if @_ != 123; - strcpy($_[0]); -} - -1; diff --git a/lib/auto/POSIX/strcspn.al b/lib/auto/POSIX/strcspn.al deleted file mode 100644 index 00a5c1a..0000000 --- a/lib/auto/POSIX/strcspn.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub strcspn { - unimpl "strcspn(xxx)", caller if @_ != 123; - strcspn($_[0]); -} - -1; diff --git a/lib/auto/POSIX/strerror.al b/lib/auto/POSIX/strerror.al deleted file mode 100644 index d4dbd7e..0000000 --- a/lib/auto/POSIX/strerror.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub strerror { - unimpl "strerror(xxx)", caller if @_ != 123; - strerror($_[0]); -} - -1; diff --git a/lib/auto/POSIX/strftime.al b/lib/auto/POSIX/strftime.al deleted file mode 100644 index 578b324..0000000 --- a/lib/auto/POSIX/strftime.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub strftime { - unimpl "strftime(xxx)", caller if @_ != 123; - strftime($_[0]); -} - -1; diff --git a/lib/auto/POSIX/strlen.al b/lib/auto/POSIX/strlen.al deleted file mode 100644 index afb3a7e..0000000 --- a/lib/auto/POSIX/strlen.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub strlen { - unimpl "strlen(xxx)", caller if @_ != 123; - strlen($_[0]); -} - -1; diff --git a/lib/auto/POSIX/strncat.al b/lib/auto/POSIX/strncat.al deleted file mode 100644 index d5694bd..0000000 --- a/lib/auto/POSIX/strncat.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub strncat { - unimpl "strncat(xxx)", caller if @_ != 123; - strncat($_[0]); -} - -1; diff --git a/lib/auto/POSIX/strncmp.al b/lib/auto/POSIX/strncmp.al deleted file mode 100644 index d85972c..0000000 --- a/lib/auto/POSIX/strncmp.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub strncmp { - unimpl "strncmp(xxx)", caller if @_ != 123; - strncmp($_[0]); -} - -1; diff --git a/lib/auto/POSIX/strncpy.al b/lib/auto/POSIX/strncpy.al deleted file mode 100644 index 1ebe12d..0000000 --- a/lib/auto/POSIX/strncpy.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub strncpy { - unimpl "strncpy(xxx)", caller if @_ != 123; - strncpy($_[0]); -} - -1; diff --git a/lib/auto/POSIX/stroul.al b/lib/auto/POSIX/stroul.al deleted file mode 100644 index bbdb71e..0000000 --- a/lib/auto/POSIX/stroul.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub stroul { - unimpl "stroul(xxx)", caller if @_ != 123; - stroul($_[0]); -} - -1; diff --git a/lib/auto/POSIX/strpbrk.al b/lib/auto/POSIX/strpbrk.al deleted file mode 100644 index ee8bef9..0000000 --- a/lib/auto/POSIX/strpbrk.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub strpbrk { - unimpl "strpbrk(xxx)", caller if @_ != 123; - strpbrk($_[0]); -} - -1; diff --git a/lib/auto/POSIX/strrchr.al b/lib/auto/POSIX/strrchr.al deleted file mode 100644 index 175f326..0000000 --- a/lib/auto/POSIX/strrchr.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub strrchr { - unimpl "strrchr(xxx)", caller if @_ != 123; - strrchr($_[0]); -} - -1; diff --git a/lib/auto/POSIX/strspn.al b/lib/auto/POSIX/strspn.al deleted file mode 100644 index 1856cae..0000000 --- a/lib/auto/POSIX/strspn.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub strspn { - unimpl "strspn(xxx)", caller if @_ != 123; - strspn($_[0]); -} - -1; diff --git a/lib/auto/POSIX/strstr.al b/lib/auto/POSIX/strstr.al deleted file mode 100644 index c9ef04a..0000000 --- a/lib/auto/POSIX/strstr.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub strstr { - unimpl "strstr(xxx)", caller if @_ != 123; - strstr($_[0]); -} - -1; diff --git a/lib/auto/POSIX/strtod.al b/lib/auto/POSIX/strtod.al deleted file mode 100644 index 44ada12..0000000 --- a/lib/auto/POSIX/strtod.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub strtod { - unimpl "strtod(xxx)", caller if @_ != 123; - strtod($_[0]); -} - -1; diff --git a/lib/auto/POSIX/strtok.al b/lib/auto/POSIX/strtok.al deleted file mode 100644 index 4782514..0000000 --- a/lib/auto/POSIX/strtok.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub strtok { - unimpl "strtok(xxx)", caller if @_ != 123; - strtok($_[0]); -} - -1; diff --git a/lib/auto/POSIX/strtol.al b/lib/auto/POSIX/strtol.al deleted file mode 100644 index 4a40dff..0000000 --- a/lib/auto/POSIX/strtol.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub strtol { - unimpl "strtol(xxx)", caller if @_ != 123; - strtol($_[0]); -} - -1; diff --git a/lib/auto/POSIX/strxfrm.al b/lib/auto/POSIX/strxfrm.al deleted file mode 100644 index 9ad22f1..0000000 --- a/lib/auto/POSIX/strxfrm.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub strxfrm { - unimpl "strxfrm(xxx)", caller if @_ != 123; - strxfrm($_[0]); -} - -1; diff --git a/lib/auto/POSIX/sysconf.al b/lib/auto/POSIX/sysconf.al deleted file mode 100644 index 5dfeab8..0000000 --- a/lib/auto/POSIX/sysconf.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub sysconf { - unimpl "sysconf(xxx)", caller if @_ != 123; - sysconf($_[0]); -} - -1; diff --git a/lib/auto/POSIX/system.al b/lib/auto/POSIX/system.al deleted file mode 100644 index c143ca1..0000000 --- a/lib/auto/POSIX/system.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub system { - usage "system(command)", caller if @_ != 1; - system($_[0]); -} - -1; diff --git a/lib/auto/POSIX/tan.al b/lib/auto/POSIX/tan.al deleted file mode 100644 index a86b877..0000000 --- a/lib/auto/POSIX/tan.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub tan { - usage "tan(x)", caller if @_ != 1; - tan($_[0]); -} - -1; diff --git a/lib/auto/POSIX/tcdrain.al b/lib/auto/POSIX/tcdrain.al deleted file mode 100644 index 97ea14f..0000000 --- a/lib/auto/POSIX/tcdrain.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub tcdrain { - unimpl "tcdrain(xxx)", caller if @_ != 123; - tcdrain($_[0]); -} - -1; diff --git a/lib/auto/POSIX/tcflow.al b/lib/auto/POSIX/tcflow.al deleted file mode 100644 index 690587a..0000000 --- a/lib/auto/POSIX/tcflow.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub tcflow { - unimpl "tcflow(xxx)", caller if @_ != 123; - tcflow($_[0]); -} - -1; diff --git a/lib/auto/POSIX/tcflush.al b/lib/auto/POSIX/tcflush.al deleted file mode 100644 index 733ab16..0000000 --- a/lib/auto/POSIX/tcflush.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub tcflush { - unimpl "tcflush(xxx)", caller if @_ != 123; - tcflush($_[0]); -} - -1; diff --git a/lib/auto/POSIX/tcgetattr.al b/lib/auto/POSIX/tcgetattr.al deleted file mode 100644 index c8a5e09..0000000 --- a/lib/auto/POSIX/tcgetattr.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub tcgetattr { - unimpl "tcgetattr(xxx)", caller if @_ != 123; - tcgetattr($_[0]); -} - -1; diff --git a/lib/auto/POSIX/tcgetpgrp.al b/lib/auto/POSIX/tcgetpgrp.al deleted file mode 100644 index 8b6f884..0000000 --- a/lib/auto/POSIX/tcgetpgrp.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub tcgetpgrp { - unimpl "tcgetpgrp(xxx)", caller if @_ != 123; - tcgetpgrp($_[0]); -} - -1; diff --git a/lib/auto/POSIX/tcsendbreak.al b/lib/auto/POSIX/tcsendbreak.al deleted file mode 100644 index e90b7fa..0000000 --- a/lib/auto/POSIX/tcsendbreak.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub tcsendbreak { - unimpl "tcsendbreak(xxx)", caller if @_ != 123; - tcsendbreak($_[0]); -} - -1; diff --git a/lib/auto/POSIX/tcsetattr.al b/lib/auto/POSIX/tcsetattr.al deleted file mode 100644 index 1735cf6..0000000 --- a/lib/auto/POSIX/tcsetattr.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub tcsetattr { - unimpl "tcsetattr(xxx)", caller if @_ != 123; - tcsetattr($_[0]); -} - -1; diff --git a/lib/auto/POSIX/tcsetpgrp.al b/lib/auto/POSIX/tcsetpgrp.al deleted file mode 100644 index 9dcff24..0000000 --- a/lib/auto/POSIX/tcsetpgrp.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub tcsetpgrp { - unimpl "tcsetpgrp(xxx)", caller if @_ != 123; - tcsetpgrp($_[0]); -} - -1; diff --git a/lib/auto/POSIX/time.al b/lib/auto/POSIX/time.al deleted file mode 100644 index d750d24..0000000 --- a/lib/auto/POSIX/time.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub time { - unimpl "time(xxx)", caller if @_ != 123; - time($_[0]); -} - -1; diff --git a/lib/auto/POSIX/times.al b/lib/auto/POSIX/times.al deleted file mode 100644 index d8f588a..0000000 --- a/lib/auto/POSIX/times.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub times { - usage "times()", caller if @_ != 0; - times(); -} - -1; diff --git a/lib/auto/POSIX/tmpfile.al b/lib/auto/POSIX/tmpfile.al deleted file mode 100644 index 7adb01f..0000000 --- a/lib/auto/POSIX/tmpfile.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub tmpfile { - unimpl "tmpfile(xxx)", caller if @_ != 123; - tmpfile($_[0]); -} - -1; diff --git a/lib/auto/POSIX/tmpnam.al b/lib/auto/POSIX/tmpnam.al deleted file mode 100644 index 23e7dfb..0000000 --- a/lib/auto/POSIX/tmpnam.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub tmpnam { - unimpl "tmpnam(xxx)", caller if @_ != 123; - tmpnam($_[0]); -} - -1; diff --git a/lib/auto/POSIX/tolower.al b/lib/auto/POSIX/tolower.al deleted file mode 100644 index 8bcbb84..0000000 --- a/lib/auto/POSIX/tolower.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub tolower { - usage "tolower(string)", caller if @_ != 1; - lc($_[0]); -} - -1; diff --git a/lib/auto/POSIX/toupper.al b/lib/auto/POSIX/toupper.al deleted file mode 100644 index e8b4c0b..0000000 --- a/lib/auto/POSIX/toupper.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub toupper { - usage "toupper(string)", caller if @_ != 1; - uc($_[0]); -} - -1; diff --git a/lib/auto/POSIX/ttyname.al b/lib/auto/POSIX/ttyname.al deleted file mode 100644 index 60f39dc..0000000 --- a/lib/auto/POSIX/ttyname.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub ttyname { - unimpl "ttyname(xxx)", caller if @_ != 123; - ttyname($_[0]); -} - -1; diff --git a/lib/auto/POSIX/tzname.al b/lib/auto/POSIX/tzname.al deleted file mode 100644 index 86e7019..0000000 --- a/lib/auto/POSIX/tzname.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub tzname { - unimpl "tzname(xxx)", caller if @_ != 123; - tzname($_[0]); -} - -1; diff --git a/lib/auto/POSIX/tzset.al b/lib/auto/POSIX/tzset.al deleted file mode 100644 index 44b5b0a..0000000 --- a/lib/auto/POSIX/tzset.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub tzset { - unimpl "tzset(xxx)", caller if @_ != 123; - tzset($_[0]); -} - -1; diff --git a/lib/auto/POSIX/umask.al b/lib/auto/POSIX/umask.al deleted file mode 100644 index e7c7fc7..0000000 --- a/lib/auto/POSIX/umask.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub umask { - usage "umask(mask)", caller if @_ != 1; - umask($_[0]); -} - -1; diff --git a/lib/auto/POSIX/ungetc.al b/lib/auto/POSIX/ungetc.al deleted file mode 100644 index 76c426e..0000000 --- a/lib/auto/POSIX/ungetc.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub ungetc { - unimpl "ungetc(xxx)", caller if @_ != 123; - ungetc($_[0]); -} - -1; diff --git a/lib/auto/POSIX/unlink.al b/lib/auto/POSIX/unlink.al deleted file mode 100644 index 798ce43..0000000 --- a/lib/auto/POSIX/unlink.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub unlink { - usage "unlink(filename)", caller if @_ != 1; - unlink($_[0]); -} - -1; diff --git a/lib/auto/POSIX/utime.al b/lib/auto/POSIX/utime.al deleted file mode 100644 index fff416d..0000000 --- a/lib/auto/POSIX/utime.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub utime { - usage "utime(filename, atime, mtime)", caller if @_ != 3; - utime($_[1], $_[2], $_[0]); -} - -1; diff --git a/lib/auto/POSIX/vfprintf.al b/lib/auto/POSIX/vfprintf.al deleted file mode 100644 index b18f42f..0000000 --- a/lib/auto/POSIX/vfprintf.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub vfprintf { - unimpl "vfprintf(xxx)", caller if @_ != 123; - vfprintf($_[0]); -} - -1; diff --git a/lib/auto/POSIX/vprintf.al b/lib/auto/POSIX/vprintf.al deleted file mode 100644 index f295a99..0000000 --- a/lib/auto/POSIX/vprintf.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub vprintf { - unimpl "vprintf(xxx)", caller if @_ != 123; - vprintf($_[0]); -} - -1; diff --git a/lib/auto/POSIX/vsprintf.al b/lib/auto/POSIX/vsprintf.al deleted file mode 100644 index c8e00c7..0000000 --- a/lib/auto/POSIX/vsprintf.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub vsprintf { - unimpl "vsprintf(xxx)", caller if @_ != 123; - vsprintf($_[0]); -} - -1; diff --git a/lib/auto/POSIX/wait.al b/lib/auto/POSIX/wait.al deleted file mode 100644 index 489b1e3..0000000 --- a/lib/auto/POSIX/wait.al +++ /dev/null @@ -1,11 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub wait { - usage "wait(statusvariable)", caller if @_ != 1; - local $result = wait(); - $_[0] = $?; - $result; -} - -1; diff --git a/lib/auto/POSIX/waitpid.al b/lib/auto/POSIX/waitpid.al deleted file mode 100644 index a7706a7..0000000 --- a/lib/auto/POSIX/waitpid.al +++ /dev/null @@ -1,11 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub waitpid { - usage "waitpid(pid, statusvariable, options)", caller if @_ != 3; - local $result = waitpid($_[0], $_[2]); - $_[1] = $?; - $result; -} - -1; diff --git a/lib/auto/POSIX/wcstombs.al b/lib/auto/POSIX/wcstombs.al deleted file mode 100644 index 1f8782b..0000000 --- a/lib/auto/POSIX/wcstombs.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub wcstombs { - unimpl "wcstombs(xxx)", caller if @_ != 123; - wcstombs($_[0]); -} - -1; diff --git a/lib/auto/POSIX/wctomb.al b/lib/auto/POSIX/wctomb.al deleted file mode 100644 index e4ccf87..0000000 --- a/lib/auto/POSIX/wctomb.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub wctomb { - unimpl "wctomb(xxx)", caller if @_ != 123; - wctomb($_[0]); -} - -1; diff --git a/lib/auto/POSIX/write.al b/lib/auto/POSIX/write.al deleted file mode 100644 index 2306b69..0000000 --- a/lib/auto/POSIX/write.al +++ /dev/null @@ -1,9 +0,0 @@ -# NOTE: Derived from POSIX.pm. Changes made here will be lost. -package POSIX; - -sub write { - unimpl "write(xxx)", caller if @_ != 123; - write($_[0]); -} - -1; diff --git a/lib/auto/README b/lib/auto/README deleted file mode 100644 index b217acc..0000000 --- a/lib/auto/README +++ /dev/null @@ -1,2 +0,0 @@ -Everything down here is derived from elsewhere. If you modify anything -down here it will someday be overwritten. diff --git a/lib/auto/SDBM_File.so b/lib/auto/SDBM_File.so deleted file mode 100755 index 8414d44..0000000 Binary files a/lib/auto/SDBM_File.so and /dev/null differ diff --git a/lib/auto/SDBM_File/SDBM_File.so b/lib/auto/SDBM_File/SDBM_File.so deleted file mode 100755 index 362042c..0000000 Binary files a/lib/auto/SDBM_File/SDBM_File.so and /dev/null differ diff --git a/lib/auto/SDBM_File/foo b/lib/auto/SDBM_File/foo deleted file mode 100755 index 193c50c..0000000 Binary files a/lib/auto/SDBM_File/foo and /dev/null differ diff --git a/lib/cacheout.pl b/lib/cacheout.pl index 513c25b..48d594b 100644 --- a/lib/cacheout.pl +++ b/lib/cacheout.pl @@ -4,6 +4,12 @@ sub cacheout'open { open($_[0], $_[1]); } +# Close as well + +sub cacheout'close { + close($_[0]); +} + # But only this sub name is visible to them. sub cacheout { @@ -15,7 +21,7 @@ sub cacheout { local(@lru) = sort {$isopen{$a} <=> $isopen{$b};} keys(%isopen); splice(@lru, $maxopen / 3); $numopen -= @lru; - for (@lru) { close $_; delete $isopen{$_}; } + for (@lru) { &close($_); delete $isopen{$_}; } } &open($file, ($saw{$file}++ ? '>>' : '>') . $file) || die "Can't create $file: $!\n"; diff --git a/lib/chat2.pl b/lib/chat2.pl index 67d0c84..58674e5 100644 --- a/lib/chat2.pl +++ b/lib/chat2.pl @@ -1,6 +1,6 @@ # chat.pl: chat with a server # Based on: V2.01.alpha.7 91/06/16 -# Randal L. Schwartz (was ) +# Randal L. Schwartz (was ) # multihome additions by A.Macpherson@bnr.co.uk # allow for /dev/pts based systems by Joe Doupnik diff --git a/lib/dotsh.pl b/lib/dotsh.pl new file mode 100644 index 0000000..4db85e7 --- /dev/null +++ b/lib/dotsh.pl @@ -0,0 +1,67 @@ +# +# @(#)dotsh.pl 03/19/94 +# +# Author: Charles Collins +# +# Description: +# This routine takes a shell script and 'dots' it into the current perl +# environment. This makes it possible to use existing system scripts +# to alter environment variables on the fly. +# +# Usage: +# &dotsh ('ShellScript', 'DependentVariable(s)'); +# +# where +# +# 'ShellScript' is the full name of the shell script to be dotted +# +# 'DependentVariable(s)' is an optional list of shell variables in the +# form VARIABLE=VALUE,VARIABLE=VALUE,... that 'ShellScript' is +# dependent upon. These variables MUST be defined using shell syntax. +# +# Example: +# &dotsh ('/tmp/foo', 'arg1'); +# &dotsh ('/tmp/foo'); +# &dotsh ('/tmp/foo arg1 ... argN'); +# +sub dotsh { + local(@sh) = @_; + local($tmp,$key,$shell,*dotsh,$command,$args,$vars) = ''; + $dotsh = shift(@sh); + @dotsh = split (/\s/, $dotsh); + $command = shift (@dotsh); + $args = join (" ", @dotsh); + $vars = join ("\n", @sh); + open (_SH_ENV, "$command") || die "Could not open $dotsh!\n"; + chop($_ = <_SH_ENV>); + $shell = "$1 -c" if ($_ =~ /^\#\!\s*(\S+(\/sh|\/ksh|\/zsh|\/csh))\s*$/); + close (_SH_ENV); + if (!$shell) { + if ($ENV{'SHELL'} =~ /\/sh$|\/ksh$|\/zsh$|\/csh$/) { + $shell = "$ENV{'SHELL'} -c"; + } else { + print "SHELL not recognized!\nUsing /bin/sh...\n"; + $shell = "/bin/sh -c"; + } + } + if (length($vars) > 0) { + system "$shell \"$vars;. $command $args; set > /tmp/_sh_env$$\""; + } else { + system "$shell \". $command $args; set > /tmp/_sh_env$$\""; + } + + open (_SH_ENV, "/tmp/_sh_env$$") || die "Could not open /tmp/_sh_env$$!\n"; + while (<_SH_ENV>) { + chop; + /=/; + $ENV{$`} = $'; + } + close (_SH_ENV); + system "rm -f /tmp/_sh_env$$"; + + foreach $key (keys(ENV)) { + $tmp .= "\$$key = \$ENV{'$key'};" if $key =~ /^[A-Za-z]\w*$/; + } + eval $tmp; +} +1; diff --git a/lib/dotsh.pl.art b/lib/dotsh.pl.art deleted file mode 100644 index 4f0f188..0000000 --- a/lib/dotsh.pl.art +++ /dev/null @@ -1,154 +0,0 @@ -Article 19995 of comp.lang.perl: -Newsgroups: comp.lang.perl -Path: netlabs!news.cerf.net!mvb.saic.com!MathWorks.Com!europa.eng.gtefsd.com!howland.reston.ans.net!news.ans.net!malgudi.oar.net!chemabs!skf26 -From: skf26@cas.org (Scott Frost) -Subject: HOW TO source shell scripts into Perl -Message-ID: <1994Mar21.191518.11636@chemabs.uucp> -Followup-To: scott.frost@cas.org -Keywords: Shell, Source, Dot -Sender: usenet@chemabs.uucp -Organization: Chemical Abstracts Service -Date: Mon, 21 Mar 1994 19:15:18 GMT -Lines: 139 - -A few days ago I posted a request for information on how to source -a shell script into a perl script. In general, the responses indicated that -it could not be done (although one came pretty close to the actual solution). - -A fellow staff member (who I was posting the request for) wasn't satisfied with -the response and came up with a way. - -Before I indicate how he solved the problem, let me suggest some alternative -methods of resolving this issue, - - 1. Hard code the environment variables directly in your PERL script. This - is easy but unreliable. System administrators could change the - production shell script environment variables and your PERL script would - be hosed. - - 2. Create a shell wrapper that dots the shell script into your current - environment and then invoke your perl script. This approach is easy - to do, fairly full proof, but an affront to serious PERL programmers - who believe PERL is God's gift to man (or at least Larry's :-) ). - -Chuck's solution involves running the script in the appropriate shell -environment, dumping the shell's environment variables to a file, and then -reading the environment variables into PERL's environment. - -It supports ksh, sh, csh, and zsh shells. It'll look at the first line of -the file to be executed to determine the shell to run it under, if not found, -it'll look at the SHELL environment variable. If the shell is not one of the -four listed, it'll warn you and attempt to run the shell script under /bin/sh. - - A typical usage might look like this, - #!/usr/bin/perl - - # Make sure dotsh.pl is placed in your /usr/perl/lib - require "dotsh.pl"; - - print "SHELL_ENV_VAR = $SHELL_ENV_VAR\n" ; - &dotsh('/tmp/foo') ; # script to run - print "SHELL_ENV_VAR = $SHELL_ENV_VAR\n" ; - - /tmp/foo looks like this: - #!/bin/ksh - export SHELL_ENV_VAR="hi mom" - -The actual dotsh.pl script follows (BTW, this is now public domain): -# -# @(#)dotsh.pl 03/19/94 -# -# Author: Charles Collins -# -# Description: -# This routine takes a shell script and 'dots' it into the current perl -# environment. This makes it possible to use existing system scripts -# to alter environment variables on the fly. -# -# Usage: -# &dotsh ('ShellScript', 'DependentVariable(s)'); -# -# where -# -# 'ShellScript' is the full name of the shell script to be dotted -# -# 'DependentVariable(s)' is an optional list of shell variables in the -# form VARIABLE=VALUE,VARIABLE=VALUE,... that 'ShellScript' is -# dependent upon. These variables MUST be defined using shell syntax. -# -# Example: -# &dotsh ('/tmp/foo', 'arg1'); -# &dotsh ('/tmp/foo'); -# &dotsh ('/tmp/foo arg1 ... argN'); -# -sub dotsh { - local(@sh) = @_; - local($tmp,$key,$shell,*dotsh,$command,$args,$vars) = ''; - $dotsh = shift(@sh); - @dotsh = split (/\s/, $dotsh); - $command = shift (@dotsh); - $args = join (" ", @dotsh); - $vars = join ("\n", @sh); - open (_SH_ENV, "$command") || die "Could not open $dotsh!\n"; - chop($_ = <_SH_ENV>); - $shell = "$1 -c" if ($_ =~ /^\#\!\s*(\S+(\/sh|\/ksh|\/zsh|\/csh))\s*$/); - close (_SH_ENV); - if (!$shell) { - if ($ENV{'SHELL'} =~ /\/sh$|\/ksh$|\/zsh$|\/csh$/) { - $shell = "$ENV{'SHELL'} -c"; - } else { - print "SHELL not recognized!\nUsing /bin/sh...\n"; - $shell = "/bin/sh -c"; - } - } - if (length($vars) > 0) { - system "$shell \"$vars;. $command $args; set > /tmp/_sh_env$$\""; - } else { - system "$shell \". $command $args; set > /tmp/_sh_env$$\""; - } - - open (_SH_ENV, "/tmp/_sh_env$$") || die "Could not open /tmp/_sh_env$$!\n"; - while (<_SH_ENV>) { - chop; - /=/; - $ENV{$`} = $'; - } - close (_SH_ENV); - system "rm -f /tmp/_sh_env$$"; - - foreach $key (keys(ENV)) { - $tmp .= "\$$key = \$ENV{'$key'};" if $key =~ /^[A-Za-z]\w*$/; - } - eval $tmp; -} -1; - - - - - - - - - - - - - - - - - - - - - - - - - - --- -Scott K. Frost INET: scott.frost@cas.org - - diff --git a/lib/dumpvar.pl b/lib/dumpvar.pl index 03dbbcd..4ebcb52 100644 --- a/lib/dumpvar.pl +++ b/lib/dumpvar.pl @@ -3,18 +3,23 @@ package dumpvar; # translate control chars to ^X - Randal Schwartz sub unctrl { local($_) = @_; + return \$_ if ref \$_ eq "GLOB"; s/([\001-\037\177])/'^'.pack('c',ord($1)^64)/eg; $_; } sub main'dumpvar { ($package,@vars) = @_; - local(*stab) = *{"::_$package"}; + $package .= "::" unless $package =~ /::$/; + *stab = *{"main::"}; + while ($package =~ /(\w+?::)/g){ + *stab = ${stab}{$1}; + } while (($key,$val) = each(%stab)) { { next if @vars && !grep($key eq $_,@vars); local(*entry) = $val; if (defined $entry) { - print "\$$key = '",&unctrl($entry),"'\n"; + print "\$",&unctrl($key)," = '",&unctrl($entry),"'\n"; } if (defined @entry) { print "\@$key = (\n"; @@ -23,7 +28,8 @@ sub main'dumpvar { } print ")\n"; } - if ($key ne "_$package" && $key ne "_DB" && defined %entry) { + if ($key ne "main::" && $key ne "DB::" && defined %entry + && !($package eq "dumpvar" and $key eq "stab")) { print "\%$key = (\n"; foreach $key (sort keys(%entry)) { print " $key\t'",&unctrl($entry{$key}),"'\n"; diff --git a/lib/find.pl b/lib/find.pl index d55cd33..40e613e 100644 --- a/lib/find.pl +++ b/lib/find.pl @@ -39,8 +39,8 @@ sub find { ($dir,$_) = ($topdir,'.'); $name = $topdir; &wanted; - $topdir =~ s,/$,, ; - &finddir($topdir,$topnlink); + ($fixtopdir = $topdir) =~ s,/$,, ; + &finddir($fixtopdir,$topnlink); } else { warn "Can't cd to $topdir: $!\n"; diff --git a/lib/finddepth.pl b/lib/finddepth.pl index 15e4daf..1fe6a37 100644 --- a/lib/finddepth.pl +++ b/lib/finddepth.pl @@ -34,10 +34,10 @@ sub finddepth { || (warn("Can't stat $topdir: $!\n"), next); if (-d _) { if (chdir($topdir)) { - $topdir =~ s,/$,, ; - &finddepthdir($topdir,$topnlink); - ($dir,$_) = ($topdir,'.'); - $name = $topdir; + ($fixtopdir = $topdir) =~ s,/$,, ; + &finddepthdir($fixtopdir,$topnlink); + ($dir,$_) = ($fixtopdir,'.'); + $name = $fixtopdir; &wanted; } else { diff --git a/lib/integer.pm b/lib/integer.pm new file mode 100644 index 0000000..74039bb --- /dev/null +++ b/lib/integer.pm @@ -0,0 +1,11 @@ +package integer; + +sub import { + $^H |= 1; +} + +sub unimport { + $^H &= ~1; +} + +1; diff --git a/lib/less.pm b/lib/less.pm new file mode 100644 index 0000000..a95484f --- /dev/null +++ b/lib/less.pm @@ -0,0 +1,2 @@ +package less; +1; diff --git a/lib/open3.pl b/lib/open3.pl index 1dbe525..7c8b6ae 100644 --- a/lib/open3.pl +++ b/lib/open3.pl @@ -90,9 +90,8 @@ sub main'open3 { } else { open(STDERR, ">&STDOUT") if (fileno(STDERR) != fileno(STDOUT)); } - exec @cmd; - local($")=(" "); + exec @cmd; die "open2: exec of @cmd failed"; } diff --git a/lib/perl5db.pl b/lib/perl5db.pl new file mode 100644 index 0000000..ac03c09 --- /dev/null +++ b/lib/perl5db.pl @@ -0,0 +1,569 @@ +package DB; + +# modified Perl debugger, to be run from Emacs in perldb-mode +# Ray Lischner (uunet!mntgfx!lisch) as of 5 Nov 1990 +# Johan Vromans -- upgrade to 4.0 pl 10 + +$header = '$RCSfile: perl5db.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:07 $'; +# +# This file is automatically included if you do perl -d. +# It's probably not useful to include this yourself. +# +# Perl supplies the values for @line and %sub. It effectively inserts +# a &DB'DB(); in front of every place that can +# have a breakpoint. It also inserts a do 'perldb.pl' before the first line. +# +# $Log: perldb.pl,v $ + +local($^W) = 0; + +if (-e "/dev/tty") { + $console = "/dev/tty"; + $rcfile=".perldb"; +} +elsif (-e "con") { + $console = "con"; + $rcfile="perldb.ini"; +} +else { + $console = "sys\$command"; + $rcfile="perldb.ini"; +} + +open(IN, "<$console") || open(IN, "<&STDIN"); # so we don't dingle stdin +open(OUT,">$console") || open(OUT, ">&STDERR") + || open(OUT, ">&STDOUT"); # so we don't dongle stdout +select(OUT); +$| = 1; # for DB::OUT +select(STDOUT); +$| = 1; # for real STDOUT +$sub = ''; + +# Is Perl being run from Emacs? +$emacs = $main::ARGV[0] eq '-emacs'; +shift(@main::ARGV) if $emacs; + +$header =~ s/.Header: ([^,]+),v(\s+\S+\s+\S+).*$/$1$2/; +print OUT "\nLoading DB routines from $header\n"; +print OUT ("Emacs support ", + $emacs ? "enabled" : "available", + ".\n"); +print OUT "\nEnter h for help.\n\n"; + +sub DB { + &save; + ($package, $filename, $line) = caller; + $usercontext = '($@, $!, $,, $/, $\, $^W) = @saved;' . + "package $package;"; # this won't let them modify, alas + local(*dbline) = "::_<$filename"; + $max = $#dbline; + if (($stop,$action) = split(/\0/,$dbline{$line})) { + if ($stop eq '1') { + $signal |= 1; + } + else { + $evalarg = "\$DB::signal |= do {$stop;}"; &eval; + $dbline{$line} =~ s/;9($|\0)/$1/; + } + } + if ($single || $trace || $signal) { + if ($emacs) { + print OUT "\032\032$filename:$line:0\n"; + } else { + $prefix = $sub =~ /'|::/ ? "" : "${package}::"; + $prefix .= "$sub($filename:"; + if (length($prefix) > 30) { + print OUT "$prefix$line):\n$line:\t",$dbline[$line]; + $prefix = ""; + $infix = ":\t"; + } + else { + $infix = "):\t"; + print OUT "$prefix$line$infix",$dbline[$line]; + } + for ($i = $line + 1; $i <= $max && $dbline[$i] == 0; ++$i) { + last if $dbline[$i] =~ /^\s*(}|#|\n)/; + print OUT "$prefix$i$infix",$dbline[$i]; + } + } + } + $evalarg = $action, &eval if $action; + if ($single || $signal) { + $evalarg = $pre, &eval if $pre; + print OUT $#stack . " levels deep in subroutine calls!\n" + if $single & 4; + $start = $line; + CMD: + while ((print OUT " DB<", $#hist+1, "> "), $cmd=&gets) { + { + $single = 0; + $signal = 0; + $cmd eq '' && exit 0; + chop($cmd); + $cmd =~ s/\\$// && do { + print OUT " cont: "; + $cmd .= &gets; + redo CMD; + }; + $cmd =~ /^q$/ && exit 0; + $cmd =~ /^$/ && ($cmd = $laststep); + push(@hist,$cmd) if length($cmd) > 1; + ($i) = split(/\s+/,$cmd); + eval "\$cmd =~ $alias{$i}", print OUT $@ if $alias{$i}; + $cmd =~ /^h$/ && do { + print OUT " +T Stack trace. +s Single step. +n Next, steps over subroutine calls. +r Return from current subroutine. +c [line] Continue; optionally inserts a one-time-only breakpoint + at the specified line. + Repeat last n or s. +l min+incr List incr+1 lines starting at min. +l min-max List lines. +l line List line; +l List next window. +- List previous window. +w line List window around line. +l subname List subroutine. +f filename Switch to filename. +/pattern/ Search forwards for pattern; final / is optional. +?pattern? Search backwards for pattern. +L List breakpoints and actions. +S List subroutine names. +t Toggle trace mode. +b [line] [condition] + Set breakpoint; line defaults to the current execution line; + condition breaks if it evaluates to true, defaults to \'1\'. +b subname [condition] + Set breakpoint at first line of subroutine. +d [line] Delete breakpoint. +D Delete all breakpoints. +a [line] command + Set an action to be done before the line is executed. + Sequence is: check for breakpoint, print line if necessary, + do action, prompt user if breakpoint or step, evaluate line. +A Delete all actions. +V [pkg [vars]] List some (default all) variables in package (default current). +X [vars] Same as \"V currentpackage [vars]\". +< command Define command before prompt. +> command Define command after prompt. +! number Redo command (default previous command). +! -number Redo number\'th to last command. +H -number Display last number commands (default all). +q or ^D Quit. +p expr Same as \"print DB::OUT expr\" in current package. += [alias value] Define a command alias, or list current aliases. +command Execute as a perl statement in current package. + +"; + next CMD; }; + $cmd =~ /^t$/ && do { + $trace = !$trace; + print OUT "Trace = ".($trace?"on":"off")."\n"; + next CMD; }; + $cmd =~ /^S$/ && do { + foreach $subname (sort(keys %sub)) { + print OUT $subname,"\n"; + } + next CMD; }; + $cmd =~ s/^X\b/V $package/; + $cmd =~ /^V$/ && do { + $cmd = "V $package"; }; + $cmd =~ /^V\b\s*(\S+)\s*(.*)/ && do { + local ($savout) = select(OUT); + $packname = $1; + @vars = split(' ',$2); + do 'dumpvar.pl' unless defined &main::dumpvar; + if (defined &main::dumpvar) { + &main::dumpvar($packname,@vars); + } + else { + print DB::OUT "dumpvar.pl not available.\n"; + } + select ($savout); + next CMD; }; + $cmd =~ /^f\b\s*(.*)/ && do { + $file = $1; + if (!$file) { + print OUT "The old f command is now the r command.\n"; + print OUT "The new f command switches filenames.\n"; + next CMD; + } + if (!defined $main::{'_<' . $file}) { + if (($try) = grep(m#^_<.*$file#, keys %main::)) { + $file = substr($try,2); + print "\n$file:\n"; + } + } + if (!defined $main::{'_<' . $file}) { + print OUT "There's no code here anything matching $file.\n"; + next CMD; + } + elsif ($file ne $filename) { + *dbline = "::_<$file"; + $max = $#dbline; + $filename = $file; + $start = 1; + $cmd = "l"; + } }; + $cmd =~ /^l\b\s*([':A-Za-z_][':\w]*)/ && do { + $subname = $1; + $subname = "main::" . $subname unless $subname =~ /'|::/; + $subname = "main" . $subname if substr($subname,0,1)eq "'"; + $subname = "main" . $subname if substr($subname,0,2)eq "::"; + ($file,$subrange) = split(/:/,$sub{$subname}); + if ($file ne $filename) { + *dbline = "::_<$file"; + $max = $#dbline; + $filename = $file; + } + if ($subrange) { + if (eval($subrange) < -$window) { + $subrange =~ s/-.*/+/; + } + $cmd = "l $subrange"; + } else { + print OUT "Subroutine $1 not found.\n"; + next CMD; + } }; + $cmd =~ /^w\b\s*(\d*)$/ && do { + $incr = $window - 1; + $start = $1 if $1; + $start -= $preview; + $cmd = 'l ' . $start . '-' . ($start + $incr); }; + $cmd =~ /^-$/ && do { + $incr = $window - 1; + $cmd = 'l ' . ($start-$window*2) . '+'; }; + $cmd =~ /^l$/ && do { + $incr = $window - 1; + $cmd = 'l ' . $start . '-' . ($start + $incr); }; + $cmd =~ /^l\b\s*(\d*)\+(\d*)$/ && do { + $start = $1 if $1; + $incr = $2; + $incr = $window - 1 unless $incr; + $cmd = 'l ' . $start . '-' . ($start + $incr); }; + $cmd =~ /^l\b\s*(([\d\$\.]+)([-,]([\d\$\.]+))?)?/ && do { + $end = (!$2) ? $max : ($4 ? $4 : $2); + $end = $max if $end > $max; + $i = $2; + $i = $line if $i eq '.'; + $i = 1 if $i < 1; + if ($emacs) { + print OUT "\032\032$filename:$i:0\n"; + $i = $end; + } else { + for (; $i <= $end; $i++) { + print OUT "$i:\t", $dbline[$i]; + last if $signal; + } + } + $start = $i; # remember in case they want more + $start = $max if $start > $max; + next CMD; }; + $cmd =~ /^D$/ && do { + print OUT "Deleting all breakpoints...\n"; + for ($i = 1; $i <= $max ; $i++) { + if (defined $dbline{$i}) { + $dbline{$i} =~ s/^[^\0]+//; + if ($dbline{$i} =~ s/^\0?$//) { + delete $dbline{$i}; + } + } + } + next CMD; }; + $cmd =~ /^L$/ && do { + for ($i = 1; $i <= $max; $i++) { + if (defined $dbline{$i}) { + print OUT "$i:\t", $dbline[$i]; + ($stop,$action) = split(/\0/, $dbline{$i}); + print OUT " break if (", $stop, ")\n" + if $stop; + print OUT " action: ", $action, "\n" + if $action; + last if $signal; + } + } + next CMD; }; + $cmd =~ /^b\b\s*([':A-Za-z_][':\w]*)\s*(.*)/ && do { + $subname = $1; + $cond = $2 || '1'; + $subname = "${package}::" . $subname + unless $subname =~ /'|::/; + $subname = "main" . $subname if substr($subname,0,1) eq "'"; + $subname = "main" . $subname if substr($subname,0,2) eq "::"; + ($filename,$i) = split(/:/, $sub{$subname}); + $i += 0; + if ($i) { + *dbline = "::_<$filename"; + ++$i while $dbline[$i] == 0 && $i < $#dbline; + $dbline{$i} =~ s/^[^\0]*/$cond/; + } else { + print OUT "Subroutine $subname not found.\n"; + } + next CMD; }; + $cmd =~ /^b\b\s*(\d*)\s*(.*)/ && do { + $i = ($1?$1:$line); + $cond = $2 || '1'; + if ($dbline[$i] == 0) { + print OUT "Line $i not breakable.\n"; + } else { + $dbline{$i} =~ s/^[^\0]*/$cond/; + } + next CMD; }; + $cmd =~ /^d\b\s*(\d+)?/ && do { + $i = ($1?$1:$line); + $dbline{$i} =~ s/^[^\0]*//; + delete $dbline{$i} if $dbline{$i} eq ''; + next CMD; }; + $cmd =~ /^A$/ && do { + for ($i = 1; $i <= $max ; $i++) { + if (defined $dbline{$i}) { + $dbline{$i} =~ s/\0[^\0]*//; + delete $dbline{$i} if $dbline{$i} eq ''; + } + } + next CMD; }; + $cmd =~ /^<\s*(.*)/ && do { + $pre = action($1); + next CMD; }; + $cmd =~ /^>\s*(.*)/ && do { + $post = action($1); + next CMD; }; + $cmd =~ /^a\b\s*(\d+)(\s+(.*))?/ && do { + $i = $1; + if ($dbline[$i] == 0) { + print OUT "Line $i may not have an action.\n"; + } else { + $dbline{$i} =~ s/\0[^\0]*//; + $dbline{$i} .= "\0" . action($3); + } + next CMD; }; + $cmd =~ /^n$/ && do { + $single = 2; + $laststep = $cmd; + last CMD; }; + $cmd =~ /^s$/ && do { + $single = 1; + $laststep = $cmd; + last CMD; }; + $cmd =~ /^c\b\s*(\d*)\s*$/ && do { + $i = $1; + if ($i) { + if ($dbline[$i] == 0) { + print OUT "Line $i not breakable.\n"; + next CMD; + } + $dbline{$i} =~ s/(\0|$)/;9$1/; # add one-time-only b.p. + } + for ($i=0; $i <= $#stack; ) { + $stack[$i++] &= ~1; + } + last CMD; }; + $cmd =~ /^r$/ && do { + $stack[$#stack] |= 2; + last CMD; }; + $cmd =~ /^T$/ && do { + local($p,$f,$l,$s,$h,$a,@a,@sub); + for ($i = 1; ($p,$f,$l,$s,$h,$w) = caller($i); $i++) { + @a = (); + for $arg (@args) { + $_ = "$arg"; + s/'/\\'/g; + s/([^\0]*)/'$1'/ + unless /^(?: -?[\d.]+ | \*[\w:]* )$/x; + s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg; + s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg; + push(@a, $_); + } + $w = $w ? '@ = ' : '$ = '; + $a = $h ? '(' . join(', ', @a) . ')' : ''; + push(@sub, "$w$s$a from file $f line $l\n"); + last if $signal; + } + for ($i=0; $i <= $#sub; $i++) { + last if $signal; + print OUT $sub[$i]; + } + next CMD; }; + $cmd =~ /^\/(.*)$/ && do { + $inpat = $1; + $inpat =~ s:([^\\])/$:$1:; + if ($inpat ne "") { + eval '$inpat =~ m'."\a$inpat\a"; + if ($@ ne "") { + print OUT "$@"; + next CMD; + } + $pat = $inpat; + } + $end = $start; + eval ' + for (;;) { + ++$start; + $start = 1 if ($start > $max); + last if ($start == $end); + if ($dbline[$start] =~ m'."\a$pat\a".'i) { + if ($emacs) { + print OUT "\032\032$filename:$start:0\n"; + } else { + print OUT "$start:\t", $dbline[$start], "\n"; + } + last; + } + } '; + print OUT "/$pat/: not found\n" if ($start == $end); + next CMD; }; + $cmd =~ /^\?(.*)$/ && do { + $inpat = $1; + $inpat =~ s:([^\\])\?$:$1:; + if ($inpat ne "") { + eval '$inpat =~ m'."\a$inpat\a"; + if ($@ ne "") { + print OUT "$@"; + next CMD; + } + $pat = $inpat; + } + $end = $start; + eval ' + for (;;) { + --$start; + $start = $max if ($start <= 0); + last if ($start == $end); + if ($dbline[$start] =~ m'."\a$pat\a".'i) { + if ($emacs) { + print OUT "\032\032$filename:$start:0\n"; + } else { + print OUT "$start:\t", $dbline[$start], "\n"; + } + last; + } + } '; + print OUT "?$pat?: not found\n" if ($start == $end); + next CMD; }; + $cmd =~ /^!+\s*(-)?(\d+)?$/ && do { + pop(@hist) if length($cmd) > 1; + $i = ($1?($#hist-($2?$2:1)):($2?$2:$#hist)); + $cmd = $hist[$i] . "\n"; + print OUT $cmd; + redo CMD; }; + $cmd =~ /^!(.+)$/ && do { + $pat = "^$1"; + pop(@hist) if length($cmd) > 1; + for ($i = $#hist; $i; --$i) { + last if $hist[$i] =~ $pat; + } + if (!$i) { + print OUT "No such command!\n\n"; + next CMD; + } + $cmd = $hist[$i] . "\n"; + print OUT $cmd; + redo CMD; }; + $cmd =~ /^H\b\s*(-(\d+))?/ && do { + $end = $2?($#hist-$2):0; + $hist = 0 if $hist < 0; + for ($i=$#hist; $i>$end; $i--) { + print OUT "$i: ",$hist[$i],"\n" + unless $hist[$i] =~ /^.?$/; + }; + next CMD; }; + $cmd =~ s/^p( .*)?$/print DB::OUT$1/; + $cmd =~ /^=/ && do { + if (local($k,$v) = ($cmd =~ /^=\s*(\S+)\s+(.*)/)) { + $alias{$k}="s~$k~$v~"; + print OUT "$k = $v\n"; + } elsif ($cmd =~ /^=\s*$/) { + foreach $k (sort keys(%alias)) { + if (($v = $alias{$k}) =~ s~^s\~$k\~(.*)\~$~$1~) { + print OUT "$k = $v\n"; + } else { + print OUT "$k\t$alias{$k}\n"; + }; + }; + }; + next CMD; }; + } + $evalarg = $cmd; &eval; + print OUT "\n"; + } + if ($post) { + $evalarg = $post; &eval; + } + } + ($@, $!, $,, $/, $\) = @saved; +} + +sub save { + @saved = ($@, $!, $,, $/, $\, $^W); + $, = ""; $/ = "\n"; $\ = ""; $^W = 0; +} + +# The following takes its argument via $evalarg to preserve current @_ + +sub eval { + eval "$usercontext $evalarg; &DB::save"; + print OUT $@; +} + +sub action { + local($action) = @_; + while ($action =~ s/\\$//) { + print OUT "+ "; + $action .= &gets; + } + $action; +} + +sub gets { + local($.); + ; +} + +sub catch { + $signal = 1; +} + +sub sub { + push(@stack, $single); + $single &= 1; + $single |= 4 if $#stack == $deep; + if (wantarray) { + @i = &$sub; + $single |= pop(@stack); + @i; + } + else { + $i = &$sub; + $single |= pop(@stack); + $i; + } +} + +$trace = $signal = $single = 0; # uninitialized warning suppression + +@hist = ('?'); +$SIG{'INT'} = "DB::catch"; +$deep = 100; # warning if stack gets this deep +$window = 10; +$preview = 3; + +@stack = (0); +@ARGS = @ARGV; +for (@args) { + s/'/\\'/g; + s/(.*)/'$1'/ unless /^-?[\d.]+$/; +} + +if (-f $rcfile) { + do "./$rcfile"; +} +elsif (-f "$ENV{'LOGDIR'}/$rcfile") { + do "$ENV{'LOGDIR'}/$rcfile"; +} +elsif (-f "$ENV{'HOME'}/$rcfile") { + do "$ENV{'HOME'}/$rcfile"; +} + +1; diff --git a/lib/perldb.pl b/lib/perldb.pl deleted file mode 100644 index 0b50555..0000000 --- a/lib/perldb.pl +++ /dev/null @@ -1,596 +0,0 @@ -package DB; - -# modified Perl debugger, to be run from Emacs in perldb-mode -# Ray Lischner (uunet!mntgfx!lisch) as of 5 Nov 1990 -# Johan Vromans -- upgrade to 4.0 pl 10 - -$header = '$RCSfile: perldb.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:07 $'; -# -# This file is automatically included if you do perl -d. -# It's probably not useful to include this yourself. -# -# Perl supplies the values for @line and %sub. It effectively inserts -# a do DB'DB(); in front of every place that can -# have a breakpoint. It also inserts a do 'perldb.pl' before the first line. -# -# $Log: perldb.pl,v $ -# Revision 4.1 92/08/07 18:24:07 lwall -# -# Revision 4.0.1.3 92/06/08 13:43:57 lwall -# patch20: support for MSDOS folded into perldb.pl -# patch20: perldb couldn't debug file containing '-', such as STDIN designator -# -# Revision 4.0.1.2 91/11/05 17:55:58 lwall -# patch11: perldb.pl modified to run within emacs in perldb-mode -# -# Revision 4.0.1.1 91/06/07 11:17:44 lwall -# patch4: added $^P variable to control calling of perldb routines -# patch4: debugger sometimes listed wrong number of lines for a statement -# -# Revision 4.0 91/03/20 01:25:50 lwall -# 4.0 baseline. -# -# Revision 3.0.1.6 91/01/11 18:08:58 lwall -# patch42: @_ couldn't be accessed from debugger -# -# Revision 3.0.1.5 90/11/10 01:40:26 lwall -# patch38: the debugger wouldn't stop correctly or do action routines -# -# Revision 3.0.1.4 90/10/15 17:40:38 lwall -# patch29: added caller -# patch29: the debugger now understands packages and evals -# patch29: scripts now run at almost full speed under the debugger -# patch29: more variables are settable from debugger -# -# Revision 3.0.1.3 90/08/09 04:00:58 lwall -# patch19: debugger now allows continuation lines -# patch19: debugger can now dump lists of variables -# patch19: debugger can now add aliases easily from prompt -# -# Revision 3.0.1.2 90/03/12 16:39:39 lwall -# patch13: perl -d didn't format stack traces of *foo right -# patch13: perl -d wiped out scalar return values of subroutines -# -# Revision 3.0.1.1 89/10/26 23:14:02 lwall -# patch1: RCS expanded an unintended $Header in lib/perldb.pl -# -# Revision 3.0 89/10/18 15:19:46 lwall -# 3.0 baseline -# -# Revision 2.0 88/06/05 00:09:45 root -# Baseline version 2.0. -# -# - -if (-e "/dev/tty") { - $console = "/dev/tty"; - $rcfile=".perldb"; -} -else { - $console = "con"; - $rcfile="perldb.ini"; -} - -open(IN, "<$console") || open(IN, "<&STDIN"); # so we don't dingle stdin -open(OUT,">$console") || open(OUT, "<&STDERR") - || open(OUT, ">&STDOUT"); # so we don't dongle stdout -select(OUT); -$| = 1; # for DB::OUT -select(STDOUT); -$| = 1; # for real STDOUT -$sub = ''; - -# Is Perl being run from Emacs? -$emacs = $main::ARGV[$[] eq '-emacs'; -shift(@main::ARGV) if $emacs; - -$header =~ s/.Header: ([^,]+),v(\s+\S+\s+\S+).*$/$1$2/; -print OUT "\nLoading DB routines from $header\n"; -print OUT ("Emacs support ", - $emacs ? "enabled" : "available", - ".\n"); -print OUT "\nEnter h for help.\n\n"; - -sub DB { - &save; - ($package, $filename, $line) = caller; - $usercontext = '($@, $!, $[, $,, $/, $\) = @saved;' . - "package $package;"; # this won't let them modify, alas - local(*dbline) = "::_<$filename"; - $max = $#dbline; - if (($stop,$action) = split(/\0/,$dbline{$line})) { - if ($stop eq '1') { - $signal |= 1; - } - else { - $evalarg = "\$DB::signal |= do {$stop;}"; &eval; - $dbline{$line} =~ s/;9($|\0)/$1/; - } - } - if ($single || $trace || $signal) { - if ($emacs) { - print OUT "\032\032$filename:$line:0\n"; - } else { - print OUT "$package::" unless $sub =~ /'|::/; - print OUT "$sub($filename:$line):\t",$dbline[$line]; - for ($i = $line + 1; $i <= $max && $dbline[$i] == 0; ++$i) { - last if $dbline[$i] =~ /^\s*(}|#|\n)/; - print OUT "$sub($filename:$i):\t",$dbline[$i]; - } - } - } - $evalarg = $action, &eval if $action; - if ($single || $signal) { - $evalarg = $pre, &eval if $pre; - print OUT $#stack . " levels deep in subroutine calls!\n" - if $single & 4; - $start = $line; - CMD: - while ((print OUT " DB<", $#hist+1, "> "), $cmd=&gets) { - { - $single = 0; - $signal = 0; - $cmd eq '' && exit 0; - chop($cmd); - $cmd =~ s/\\$// && do { - print OUT " cont: "; - $cmd .= &gets; - redo CMD; - }; - $cmd =~ /^q$/ && exit 0; - $cmd =~ /^$/ && ($cmd = $laststep); - push(@hist,$cmd) if length($cmd) > 1; - ($i) = split(/\s+/,$cmd); - eval "\$cmd =~ $alias{$i}", print OUT $@ if $alias{$i}; - $cmd =~ /^h$/ && do { - print OUT " -T Stack trace. -s Single step. -n Next, steps over subroutine calls. -r Return from current subroutine. -c [line] Continue; optionally inserts a one-time-only breakpoint - at the specified line. - Repeat last n or s. -l min+incr List incr+1 lines starting at min. -l min-max List lines. -l line List line; -l List next window. -- List previous window. -w line List window around line. -l subname List subroutine. -f filename Switch to filename. -/pattern/ Search forwards for pattern; final / is optional. -?pattern? Search backwards for pattern. -L List breakpoints and actions. -S List subroutine names. -t Toggle trace mode. -b [line] [condition] - Set breakpoint; line defaults to the current execution line; - condition breaks if it evaluates to true, defaults to \'1\'. -b subname [condition] - Set breakpoint at first line of subroutine. -d [line] Delete breakpoint. -D Delete all breakpoints. -a [line] command - Set an action to be done before the line is executed. - Sequence is: check for breakpoint, print line if necessary, - do action, prompt user if breakpoint or step, evaluate line. -A Delete all actions. -V [pkg [vars]] List some (default all) variables in package (default current). -X [vars] Same as \"V currentpackage [vars]\". -< command Define command before prompt. -> command Define command after prompt. -! number Redo command (default previous command). -! -number Redo number\'th to last command. -H -number Display last number commands (default all). -q or ^D Quit. -p expr Same as \"print DB::OUT expr\" in current package. -= [alias value] Define a command alias, or list current aliases. -command Execute as a perl statement in current package. - -"; - next CMD; }; - $cmd =~ /^t$/ && do { - $trace = !$trace; - print OUT "Trace = ".($trace?"on":"off")."\n"; - next CMD; }; - $cmd =~ /^S$/ && do { - foreach $subname (sort(keys %sub)) { - print OUT $subname,"\n"; - } - next CMD; }; - $cmd =~ s/^X\b/V $package/; - $cmd =~ /^V$/ && do { - $cmd = "V $package"; }; - $cmd =~ /^V\b\s*(\S+)\s*(.*)/ && do { - local ($savout) = select(OUT); - $packname = $1; - @vars = split(' ',$2); - do 'dumpvar.pl' unless defined &main::dumpvar; - if (defined &main::dumpvar) { - &main::dumpvar($packname,@vars); - } - else { - print DB::OUT "dumpvar.pl not available.\n"; - } - select ($savout); - next CMD; }; - $cmd =~ /^f\b\s*(.*)/ && do { - $file = $1; - if (!$file) { - print OUT "The old f command is now the r command.\n"; - print OUT "The new f command switches filenames.\n"; - next CMD; - } - if (!defined $::_main{'_<' . $file}) { - if (($try) = grep(m#^_<.*$file#, keys %::_main)) { - $file = substr($try,2); - print "\n$file:\n"; - } - } - if (!defined $::_main{'_<' . $file}) { - print OUT "There's no code here anything matching $file.\n"; - next CMD; - } - elsif ($file ne $filename) { - *dbline = "::_<$file"; - $max = $#dbline; - $filename = $file; - $start = 1; - $cmd = "l"; - } }; - $cmd =~ /^l\b\s*([':A-Za-z_][':\w]*)/ && do { - $subname = $1; - $subname = "main::" . $subname unless $subname =~ /'|::/; - $subname = "main" . $subname if substr($subname,0,1)eq "'"; - $subname = "main" . $subname if substr($subname,0,2)eq "::"; - ($file,$subrange) = split(/:/,$sub{$subname}); - if ($file ne $filename) { - *dbline = "::_<$file"; - $max = $#dbline; - $filename = $file; - } - if ($subrange) { - if (eval($subrange) < -$window) { - $subrange =~ s/-.*/+/; - } - $cmd = "l $subrange"; - } else { - print OUT "Subroutine $1 not found.\n"; - next CMD; - } }; - $cmd =~ /^w\b\s*(\d*)$/ && do { - $incr = $window - 1; - $start = $1 if $1; - $start -= $preview; - $cmd = 'l ' . $start . '-' . ($start + $incr); }; - $cmd =~ /^-$/ && do { - $incr = $window - 1; - $cmd = 'l ' . ($start-$window*2) . '+'; }; - $cmd =~ /^l$/ && do { - $incr = $window - 1; - $cmd = 'l ' . $start . '-' . ($start + $incr); }; - $cmd =~ /^l\b\s*(\d*)\+(\d*)$/ && do { - $start = $1 if $1; - $incr = $2; - $incr = $window - 1 unless $incr; - $cmd = 'l ' . $start . '-' . ($start + $incr); }; - $cmd =~ /^l\b\s*(([\d\$\.]+)([-,]([\d\$\.]+))?)?/ && do { - $end = (!$2) ? $max : ($4 ? $4 : $2); - $end = $max if $end > $max; - $i = $2; - $i = $line if $i eq '.'; - $i = 1 if $i < 1; - if ($emacs) { - print OUT "\032\032$filename:$i:0\n"; - $i = $end; - } else { - for (; $i <= $end; $i++) { - print OUT "$i:\t", $dbline[$i]; - last if $signal; - } - } - $start = $i; # remember in case they want more - $start = $max if $start > $max; - next CMD; }; - $cmd =~ /^D$/ && do { - print OUT "Deleting all breakpoints...\n"; - for ($i = 1; $i <= $max ; $i++) { - if (defined $dbline{$i}) { - $dbline{$i} =~ s/^[^\0]+//; - if ($dbline{$i} =~ s/^\0?$//) { - delete $dbline{$i}; - } - } - } - next CMD; }; - $cmd =~ /^L$/ && do { - for ($i = 1; $i <= $max; $i++) { - if (defined $dbline{$i}) { - print OUT "$i:\t", $dbline[$i]; - ($stop,$action) = split(/\0/, $dbline{$i}); - print OUT " break if (", $stop, ")\n" - if $stop; - print OUT " action: ", $action, "\n" - if $action; - last if $signal; - } - } - next CMD; }; - $cmd =~ /^b\b\s*([':A-Za-z_][':\w]*)\s*(.*)/ && do { - $subname = $1; - $cond = $2 || '1'; - $subname = "$package::" . $subname unless $subname =~ /'|::/; - $subname = "main" . $subname if substr($subname,0,1) eq "'"; - $subname = "main" . $subname if substr($subname,0,2) eq "::"; - ($filename,$i) = split(/:/, $sub{$subname}); - $i += 0; - if ($i) { - *dbline = "::_<$filename"; - ++$i while $dbline[$i] == 0 && $i < $#dbline; - $dbline{$i} =~ s/^[^\0]*/$cond/; - } else { - print OUT "Subroutine $subname not found.\n"; - } - next CMD; }; - $cmd =~ /^b\b\s*(\d*)\s*(.*)/ && do { - $i = ($1?$1:$line); - $cond = $2 || '1'; - if ($dbline[$i] == 0) { - print OUT "Line $i not breakable.\n"; - } else { - $dbline{$i} =~ s/^[^\0]*/$cond/; - } - next CMD; }; - $cmd =~ /^d\b\s*(\d+)?/ && do { - $i = ($1?$1:$line); - $dbline{$i} =~ s/^[^\0]*//; - delete $dbline{$i} if $dbline{$i} eq ''; - next CMD; }; - $cmd =~ /^A$/ && do { - for ($i = 1; $i <= $max ; $i++) { - if (defined $dbline{$i}) { - $dbline{$i} =~ s/\0[^\0]*//; - delete $dbline{$i} if $dbline{$i} eq ''; - } - } - next CMD; }; - $cmd =~ /^<\s*(.*)/ && do { - $pre = do action($1); - next CMD; }; - $cmd =~ /^>\s*(.*)/ && do { - $post = do action($1); - next CMD; }; - $cmd =~ /^a\b\s*(\d+)(\s+(.*))?/ && do { - $i = $1; - if ($dbline[$i] == 0) { - print OUT "Line $i may not have an action.\n"; - } else { - $dbline{$i} =~ s/\0[^\0]*//; - $dbline{$i} .= "\0" . do action($3); - } - next CMD; }; - $cmd =~ /^n$/ && do { - $single = 2; - $laststep = $cmd; - last CMD; }; - $cmd =~ /^s$/ && do { - $single = 1; - $laststep = $cmd; - last CMD; }; - $cmd =~ /^c\b\s*(\d*)\s*$/ && do { - $i = $1; - if ($i) { - if ($dbline[$i] == 0) { - print OUT "Line $i not breakable.\n"; - next CMD; - } - $dbline{$i} =~ s/(\0|$)/;9$1/; # add one-time-only b.p. - } - for ($i=0; $i <= $#stack; ) { - $stack[$i++] &= ~1; - } - last CMD; }; - $cmd =~ /^r$/ && do { - $stack[$#stack] |= 2; - last CMD; }; - $cmd =~ /^T$/ && do { - local($p,$f,$l,$s,$h,$a,@a,@sub); - for ($i = 1; ($p,$f,$l,$s,$h,$w) = caller($i); $i++) { - @a = @args; - for (@a) { - s/'/\\'/g; - s/([^\0]*)/'$1'/ unless /^-?[\d.]+$/; - s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg; - s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg; - } - $w = $w ? '@ = ' : '$ = '; - $a = $h ? '(' . join(', ', @a) . ')' : ''; - push(@sub, "$w&$s$a from file $f line $l\n"); - last if $signal; - } - for ($i=0; $i <= $#sub; $i++) { - last if $signal; - print OUT $sub[$i]; - } - next CMD; }; - $cmd =~ /^\/(.*)$/ && do { - $inpat = $1; - $inpat =~ s:([^\\])/$:$1:; - if ($inpat ne "") { - eval '$inpat =~ m'."\n$inpat\n"; - if ($@ ne "") { - print OUT "$@"; - next CMD; - } - $pat = $inpat; - } - $end = $start; - eval ' - for (;;) { - ++$start; - $start = 1 if ($start > $max); - last if ($start == $end); - if ($dbline[$start] =~ m'."\n$pat\n".'i) { - if ($emacs) { - print OUT "\032\032$filename:$start:0\n"; - } else { - print OUT "$start:\t", $dbline[$start], "\n"; - } - last; - } - } '; - print OUT "/$pat/: not found\n" if ($start == $end); - next CMD; }; - $cmd =~ /^\?(.*)$/ && do { - $inpat = $1; - $inpat =~ s:([^\\])\?$:$1:; - if ($inpat ne "") { - eval '$inpat =~ m'."\n$inpat\n"; - if ($@ ne "") { - print OUT "$@"; - next CMD; - } - $pat = $inpat; - } - $end = $start; - eval ' - for (;;) { - --$start; - $start = $max if ($start <= 0); - last if ($start == $end); - if ($dbline[$start] =~ m'."\n$pat\n".'i) { - if ($emacs) { - print OUT "\032\032$filename:$start:0\n"; - } else { - print OUT "$start:\t", $dbline[$start], "\n"; - } - last; - } - } '; - print OUT "?$pat?: not found\n" if ($start == $end); - next CMD; }; - $cmd =~ /^!+\s*(-)?(\d+)?$/ && do { - pop(@hist) if length($cmd) > 1; - $i = ($1?($#hist-($2?$2:1)):($2?$2:$#hist)); - $cmd = $hist[$i] . "\n"; - print OUT $cmd; - redo CMD; }; - $cmd =~ /^!(.+)$/ && do { - $pat = "^$1"; - pop(@hist) if length($cmd) > 1; - for ($i = $#hist; $i; --$i) { - last if $hist[$i] =~ $pat; - } - if (!$i) { - print OUT "No such command!\n\n"; - next CMD; - } - $cmd = $hist[$i] . "\n"; - print OUT $cmd; - redo CMD; }; - $cmd =~ /^H\b\s*(-(\d+))?/ && do { - $end = $2?($#hist-$2):0; - $hist = 0 if $hist < 0; - for ($i=$#hist; $i>$end; $i--) { - print OUT "$i: ",$hist[$i],"\n" - unless $hist[$i] =~ /^.?$/; - }; - next CMD; }; - $cmd =~ s/^p( .*)?$/print DB::OUT$1/; - $cmd =~ /^=/ && do { - if (local($k,$v) = ($cmd =~ /^=\s*(\S+)\s+(.*)/)) { - $alias{$k}="s~$k~$v~"; - print OUT "$k = $v\n"; - } elsif ($cmd =~ /^=\s*$/) { - foreach $k (sort keys(%alias)) { - if (($v = $alias{$k}) =~ s~^s\~$k\~(.*)\~$~$1~) { - print OUT "$k = $v\n"; - } else { - print OUT "$k\t$alias{$k}\n"; - }; - }; - }; - next CMD; }; - } - $evalarg = $cmd; &eval; - print OUT "\n"; - } - if ($post) { - $evalarg = $post; &eval; - } - } - ($@, $!, $[, $,, $/, $\) = @saved; -} - -sub save { - @saved = ($@, $!, $[, $,, $/, $\); - $[ = 0; $, = ""; $/ = "\n"; $\ = ""; -} - -# The following takes its argument via $evalarg to preserve current @_ - -sub eval { - eval "$usercontext $evalarg; &DB::save"; - print OUT $@; -} - -sub action { - local($action) = @_; - while ($action =~ s/\\$//) { - print OUT "+ "; - $action .= &gets; - } - $action; -} - -sub gets { - local($.); - ; -} - -sub catch { - $signal = 1; -} - -sub sub { - push(@stack, $single); - $single &= 1; - $single |= 4 if $#stack == $deep; - if (wantarray) { - @i = &$sub; - $single |= pop(@stack); - @i; - } - else { - $i = &$sub; - $single |= pop(@stack); - $i; - } -} - -$single = 1; # so it stops on first executable statement -@hist = ('?'); -$SIG{'INT'} = "DB::catch"; -$deep = 100; # warning if stack gets this deep -$window = 10; -$preview = 3; - -@stack = (0); -@ARGS = @ARGV; -for (@args) { - s/'/\\'/g; - s/(.*)/'$1'/ unless /^-?[\d.]+$/; -} - -if (-f $rcfile) { - do "./$rcfile"; -} -elsif (-f "$ENV{'LOGDIR'}/$rcfile") { - do "$ENV{'LOGDIR'}/$rcfile"; -} -elsif (-f "$ENV{'HOME'}/$rcfile") { - do "$ENV{'HOME'}/$rcfile"; -} - -1; diff --git a/lib/pwd.pl b/lib/pwd.pl index 8e17dd0..0cc3d4e 100644 --- a/lib/pwd.pl +++ b/lib/pwd.pl @@ -3,20 +3,6 @@ ;# $RCSfile: pwd.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:11 $ ;# ;# $Log: pwd.pl,v $ -;# Revision 4.1 92/08/07 18:24:11 lwall -;# -;# Revision 4.0.1.1 92/06/08 13:45:22 lwall -;# patch20: support added to pwd.pl to strip automounter crud -;# -;# Revision 4.0 91/03/20 01:26:03 lwall -;# 4.0 baseline. -;# -;# Revision 3.0.1.2 91/01/11 18:09:24 lwall -;# patch42: some .pl files were missing their trailing 1; -;# -;# Revision 3.0.1.1 90/08/09 04:01:24 lwall -;# patch19: Initial revision -;# ;# ;# Usage: ;# require "pwd.pl"; diff --git a/lib/quotewords.pl.art b/lib/quotewords.pl.art deleted file mode 100644 index 65e9f0a..0000000 --- a/lib/quotewords.pl.art +++ /dev/null @@ -1,146 +0,0 @@ -Article 20075 of comp.lang.perl: -Newsgroups: comp.lang.perl -Path: netlabs!news.cerf.net!ihnp4.ucsd.edu!swrinde!sgiblab!rpal.rockwell.com!imagen!pomeranz -From: pomeranz@imagen.com (Hal Pomeranz) -Subject: quotewords.pl [REVISED] -Message-ID: <1994Mar23.071634.23171@aqm.com> -Sender: usenet@aqm.com -Nntp-Posting-Host: imagen -Organization: QMS Inc., Santa Clara -Date: Wed, 23 Mar 1994 07:16:34 GMT -Lines: 132 - - -ARRGH! The version I posted earlier tonight contained an error, so -I've sent out a cancel to chase it down and kill it. Please use this -version dated "23 March 1994". - -quotewords.pl is a generic replacement for shellwords.pl. -"ewords() allows you to specify a delimiter, which may be a -regular expression, and returns a list of words broken on that -delimiter ignoring any instances of the delimiter which may appear -within a quoted string. There's a boolean flag to tell the function -whether or not you want it to strip quotes and backslashes or retain -them. - -I've also included a revised version of &shellwords() (written in -terms of "ewords() of course) which is 99% the same as the -original version. The only difference is that the new version will -not default to using $_ if no arguments are supplied. - -Share and enjoy... - -============================================================================== - Hal Pomeranz pomeranz@sclara.qms.com pomeranz@cs.swarthmore.edu -System/Network Manager "All I can say is that my life is pretty plain. - QMS Santa Clara I like watchin' the puddles gather rain." Blind Melon -============================================================================== - -# quotewords.pl -# -# Usage: -# require 'quotes.pl'; -# @words = "ewords($delim, $keep, @lines); -# @words = &shellwords(@lines); - -# Hal Pomeranz (pomeranz@netcom.com), 23 March 1994 -# Permission to use and distribute under the same terms as Perl. -# No warranty expressed or implied. - -# Basically an update and generalization of the old shellwords.pl. -# Much code shamelessly stolen from the old version (author unknown). -# -# "ewords() accepts a delimiter (which can be a regular expression) -# and a list of lines and then breaks those lines up into a list of -# words ignoring delimiters that appear inside quotes. -# -# The $keep argument is a boolean flag. If true, the quotes are kept -# with each word, otherwise quotes are stripped in the splitting process. -# $keep also defines whether unprotected backslashes are retained. -# -# A &shellwords() replacement is included to demonstrate the new package. -# This version differs from the original in that it will _NOT_ default -# to using $_ if no arguments are given. I personally find the old behavior -# to be a mis-feature. - -package quotewords; - -sub main'shellwords { - local(@lines) = @_; - $lines[$#lines] =~ s/\s+$//; - &main'quotewords('\s+', 0, @lines); -} - - -# "ewords() works by simply jamming all of @lines into a single -# string in $_ and then pulling off words a bit at a time until $_ -# is exhausted. -# -# The inner "for" loop builds up each word (or $field) one $snippet -# at a time. A $snippet is a quoted string, a backslashed character, -# or an unquoted string. We fall out of the "for" loop when we reach -# the end of $_ or when we hit a delimiter. Falling out of the "for" -# loop, we push the $field we've been building up onto the list of -# @words we'll be returning, and then loop back and pull another word -# off of $_. -# -# The first two cases inside the "for" loop deal with quoted strings. -# The first case matches a double quoted string, removes it from $_, -# and assigns the double quoted string to $snippet in the body of the -# conditional. The second case handles single quoted strings. In -# the third case we've found a quote at the current beginning of $_, -# but it didn't match the quoted string regexps in the first two cases, -# so it must be an unbalanced quote and we die with an error (which can -# be caught by eval()). -# -# The next case handles backslashed characters, and the next case is the -# exit case on reaching the end of the string or finding a delimiter. -# -# Otherwise, we've found an unquoted thing and we pull of characters one -# at a time until we reach something that could start another $snippet-- -# a quote of some sort, a backslash, or the delimiter. This one character -# at a time behavior was necessary if the delimiter was going to be a -# regexp (love to hear it if you can figure out a better way). - -sub main'quotewords { - local($delim, $keep, @lines) = @_; - local(@words,$snippet,$field,$_); - - $_ = join('', @lines); - while ($_) { - $field = ''; - for (;;) { - $snippet = ''; - if (s/^"(([^"\\]|\\[\\"])*)"//) { - $snippet = $1; - $snippet = "\"$snippet\"" if ($keep); - } - elsif (s/^'(([^'\\]|\\[\\'])*)'//) { - $snippet = $1; - $snippet = "'$snippet'" if ($keep); - } - elsif (/^["']/) { - die "Unmatched quote\n"; - } - elsif (s/^\\(.)//) { - $snippet = $1; - $snippet = "\\$snippet" if ($keep); - } - elsif (!$_ || s/^$delim//) { - last; - } - else { - while ($_ && !(/^$delim/ || /^['"\\]/)) { - $snippet .= substr($_, 0, 1); - substr($_, 0, 1) = ''; - } - } - $field .= $snippet; - } - push(@words, $field); - } - @words; -} -1; - - diff --git a/lib/shellwords.pl b/lib/shellwords.pl index 5d593da..1c45a5a 100644 --- a/lib/shellwords.pl +++ b/lib/shellwords.pl @@ -17,13 +17,13 @@ sub shellwords { while ($_ ne '') { $field = ''; for (;;) { - if (s/^"(([^"\\]|\\[\\"])*)"//) { + if (s/^"(([^"\\]|\\.)*)"//) { ($snippet = $1) =~ s#\\(.)#$1#g; } elsif (/^"/) { die "Unmatched double quote: $_\n"; } - elsif (s/^'(([^'\\]|\\[\\'])*)'//) { + elsif (s/^'(([^'\\]|\\.)*)'//) { ($snippet = $1) =~ s#\\(.)#$1#g; } elsif (/^'/) { diff --git a/lib/sigtrap.pm b/lib/sigtrap.pm new file mode 100644 index 0000000..72b9cb6 --- /dev/null +++ b/lib/sigtrap.pm @@ -0,0 +1,47 @@ +package sigtrap; + +require Carp; + +sub import { + my $pack = shift; + my @sigs = @_; + @sigs or @sigs = qw(QUIT ILL TRAP ABRT EMT FPE BUS SEGV SYS PIPE TERM); + foreach $sig (@sigs) { + $SIG{$sig} = 'sigtrap::trap'; + } +} + +sub trap { + package DB; # To get subroutine args. + $SIG{'ABRT'} = DEFAULT; + kill 'ABRT', $$ if $panic++; + syswrite(STDERR, 'Caught a SIG', 12); + syswrite(STDERR, $_[0], length($_[0])); + syswrite(STDERR, ' at ', 4); + ($pack,$file,$line) = caller; + syswrite(STDERR, $file, length($file)); + syswrite(STDERR, ' line ', 6); + syswrite(STDERR, $line, length($line)); + syswrite(STDERR, "\n", 1); + + # Now go for broke. + for ($i = 1; ($p,$f,$l,$s,$h,$w) = caller($i); $i++) { + @a = (); + for $arg (@args) { + $_ = "$arg"; + s/'/\\'/g; + s/([^\0]*)/'$1'/ + unless /^(?: -?[\d.]+ | \*[\w:]* )$/x; + s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg; + s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg; + push(@a, $_); + } + $w = $w ? '@ = ' : '$ = '; + $a = $h ? '(' . join(', ', @a) . ')' : ''; + $mess = "$w$s$a called from $f line $l\n"; + syswrite(STDERR, $mess, length($mess)); + } + kill 'ABRT', $$; +} + +1; diff --git a/lib/soundex.pl.art b/lib/soundex.pl.art deleted file mode 100644 index 1cc0b9e..0000000 --- a/lib/soundex.pl.art +++ /dev/null @@ -1,285 +0,0 @@ -Article 20106 of comp.lang.perl: -Path: netlabs!news.cerf.net!ihnp4.ucsd.edu!mvb.saic.com!MathWorks.Com!noc.near.net!newshost.meiko.com!not-for-mail -From: mike@meiko.com (Mike Stok) -Newsgroups: comp.lang.perl -Subject: Soundex (again :-) -Date: 23 Mar 1994 19:44:35 -0500 -Organization: Meiko Scientific, Inc., MA -Lines: 272 -Message-ID: <2mqnpj$qk4@hibbert.meiko.com> -NNTP-Posting-Host: hibbert.meiko.com - -Thanks to Rich Pinder for finding a little bug in my -soundex code I posted a while back. This showed up when he compared it -with the output from Oracle's soundex function, and were caused by leading -characters which were different but shared the same soundex code. - -Here's a fixed shar file... - -Mike - -#!/bin/sh -# This is a shell archive (produced by shar 3.49) -# To extract the files from this archive, save it to a file, remove -# everything above the "!/bin/sh" line above, and type "sh file_name". -# -# made 03/24/1994 00:35 UTC by Mike.Stok@meiko.concord.ma.us -# Source directory /tmp_mnt/develop/sw/misc/mike/soundex -# -# existing files will NOT be overwritten unless -c is specified -# -# This shar contains: -# length mode name -# ------ ---------- ------------------------------------------ -# 1677 -r--r--r-- soundex.pl -# 2408 -r-xr-xr-x soundex.t -# -# ============= soundex.pl ============== -if test -f 'soundex.pl' -a X"$1" != X"-c"; then - echo 'x - skipping soundex.pl (File already exists)' -else -echo 'x - extracting soundex.pl (Text)' -sed 's/^X//' << 'SHAR_EOF' > 'soundex.pl' && -package soundex; -X -;# $Id: soundex.pl,v 1.2 1994/03/24 00:30:27 mike Exp $ -;# -;# Implementation of soundex algorithm as described by Knuth in volume -;# 3 of The Art of Computer Programming, with ideas stolen from Ian -;# Phillips . -;# -;# Mike Stok , 2 March 1994. -;# -;# Knuth's test cases are: -;# -;# Euler, Ellery -> E460 -;# Gauss, Ghosh -> G200 -;# Hilbert, Heilbronn -> H416 -;# Knuth, Kant -> K530 -;# Lloyd, Ladd -> L300 -;# Lukasiewicz, Lissajous -> L222 -;# -;# $Log: soundex.pl,v $ -;# Revision 1.2 1994/03/24 00:30:27 mike -;# Subtle bug (any excuse :-) spotted by Rich Pinder -;# in the way I handles leasing characters which were different but had -;# the same soundex code. This showed up comparing it with Oracle's -;# soundex output. -;# -;# Revision 1.1 1994/03/02 13:01:30 mike -;# Initial revision -;# -;# -;############################################################################## -X -;# $soundex'noCode is used to indicate a string doesn't have a soundex -;# code, I like undef other people may want to set it to 'Z000'. -X -$noCode = undef; -X -;# main'soundex -;# -;# usage: -;# -;# @codes = &main'soundex (@wordList); -;# $code = &main'soundex ($word); -;# -;# This strenuously avoids $[ -X -sub main'soundex -{ -X local (@s, $f, $fc, $_) = @_; -X -X foreach (@s) -X { -X tr/a-z/A-Z/; -X tr/A-Z//cd; -X -X if ($_ eq '') -X { -X $_ = $noCode; -X } -X else -X { -X ($f) = /^(.)/; -X tr/AEHIOUWYBFPVCGJKQSXZDTLMNR/00000000111122222222334556/; -X ($fc) = /^(.)/; -X s/^$fc+//; -X tr///cs; -X tr/0//d; -X $_ = $f . $_ . '000'; -X s/^(.{4}).*/$1/; -X } -X } -X -X wantarray ? @s : shift @s; -} -X -1; -SHAR_EOF -chmod 0444 soundex.pl || -echo 'restore of soundex.pl failed' -Wc_c="`wc -c < 'soundex.pl'`" -test 1677 -eq "$Wc_c" || - echo 'soundex.pl: original size 1677, current size' "$Wc_c" -fi -# ============= soundex.t ============== -if test -f 'soundex.t' -a X"$1" != X"-c"; then - echo 'x - skipping soundex.t (File already exists)' -else -echo 'x - extracting soundex.t (Text)' -sed 's/^X//' << 'SHAR_EOF' > 'soundex.t' && -#!./perl -;# -;# $Id: soundex.t,v 1.2 1994/03/24 00:30:27 mike Exp $ -;# -;# test module for soundex.pl -;# -;# $Log: soundex.t,v $ -;# Revision 1.2 1994/03/24 00:30:27 mike -;# Subtle bug (any excuse :-) spotted by Rich Pinder -;# in the way I handles leasing characters which were different but had -;# the same soundex code. This showed up comparing it with Oracle's -;# soundex output. -;# -;# Revision 1.1 1994/03/02 13:03:02 mike -;# Initial revision -;# -;# -X -require '../lib/soundex.pl'; -X -$test = 0; -print "1..13\n"; -X -while () -{ -X chop; -X next if /^\s*;?#/; -X next if /^\s*$/; -X -X ++$test; -X $bad = 0; -X -X if (/^eval\s+/) -X { -X ($try = $_) =~ s/^eval\s+//; -X -X eval ($try); -X if ($@) -X { -X $bad++; -X print "not ok $test\n"; -X print "# eval '$try' returned $@"; -X } -X } -X elsif (/^\(/) -X { -X ($in, $out) = split (':'); -X -X $try = "\@expect = $out; \@got = &soundex $in;"; -X eval ($try); -X -X if (@expect != @got) -X { -X $bad++; -X print "not ok $test\n"; -X print "# expected ", scalar @expect, " results, got ", scalar @got, "\n"; -X print "# expected (", join (', ', @expect), -X ") got (", join (', ', @got), ")\n"; -X } -X else -X { -X while (@got) -X { -X $expect = shift @expect; -X $got = shift @got; -X -X if ($expect ne $got) -X { -X $bad++; -X print "not ok $test\n"; -X print "# expected $expect, got $got\n"; -X } -X } -X } -X } -X else -X { -X ($in, $out) = split (':'); -X -X $try = "\$expect = $out; \$got = &soundex ($in);"; -X eval ($try); -X -X if ($expect ne $got) -X { -X $bad++; -X print "not ok $test\n"; -X print "# expected $expect, got $got\n"; -X } -X } -X -X print "ok $test\n" unless $bad; -} -X -__END__ -# -# 1..6 -# -# Knuth's test cases, scalar in, scalar out -# -'Euler':'E460' -'Gauss':'G200' -'Hilbert':'H416' -'Knuth':'K530' -'Lloyd':'L300' -'Lukasiewicz':'L222' -# -# 7..8 -# -# check default bad code -# -'2 + 2 = 4':undef -undef:undef -# -# 9 -# -# check array in, array out -# -('Ellery', 'Ghosh', 'Heilbronn', 'Kant', 'Ladd', 'Lissajous'):('E460', 'G200', 'H416', 'K530', 'L300', 'L222') -# -# 10 -# -# check array with explicit undef -# -('Mike', undef, 'Stok'):('M200', undef, 'S320') -# -# 11..12 -# -# check setting $soundex'noCode -# -eval $soundex'noCode = 'Z000'; -('Mike', undef, 'Stok'):('M200', 'Z000', 'S320') -# -# 13 -# -# a subtle difference between me & oracle, spotted by Rich Pinder -# -# -CZARKOWSKA:C622 -SHAR_EOF -chmod 0555 soundex.t || -echo 'restore of soundex.t failed' -Wc_c="`wc -c < 'soundex.t'`" -test 2408 -eq "$Wc_c" || - echo 'soundex.t: original size 2408, current size' "$Wc_c" -fi -exit 0 - --- -The "usual disclaimers" apply. | Meiko -Mike Stok | 130C Baker Ave. Ext -Mike.Stok@meiko.concord.ma.us | Concord, MA 01742 -Meiko tel: (508) 371 0088 | - - diff --git a/lib/strict.pm b/lib/strict.pm new file mode 100644 index 0000000..adaf47c --- /dev/null +++ b/lib/strict.pm @@ -0,0 +1,23 @@ +package strict; + +sub bits { + my $bits = 0; + foreach $sememe (@_) { + $bits |= 0x00000002 if $sememe eq 'refs'; + $bits |= 0x00000200 if $sememe eq 'subs'; + $bits |= 0x00000400 if $sememe eq 'vars'; + } + $bits; +} + +sub import { + shift; + $^H |= bits(@_ ? @_ : qw(refs subs vars)); +} + +sub unimport { + shift; + $^H &= ~ bits(@_ ? @_ : qw(refs subs vars)); +} + +1; diff --git a/lib/subs.pm b/lib/subs.pm new file mode 100644 index 0000000..8b58357 --- /dev/null +++ b/lib/subs.pm @@ -0,0 +1,16 @@ +package subs; + +require 5.000; + +$ExportLevel = 0; + +sub import { + my $callpack = caller; + my $pack = shift; + my @imports = @_; + foreach $sym (@imports) { + *{"${callpack}::$sym"} = \&{"${callpack}::$sym"}; + } +}; + +1; diff --git a/lib/syslog.pl b/lib/syslog.pl index 8e64a00..a3b9edf 100644 --- a/lib/syslog.pl +++ b/lib/syslog.pl @@ -2,41 +2,7 @@ # syslog.pl # # $Log: syslog.pl,v $ -# Revision 4.1 92/08/07 18:24:15 lwall # -# Revision 4.0.1.1 92/06/08 13:48:05 lwall -# patch20: new warning for ambiguous use of unary operators -# -# Revision 4.0 91/03/20 01:26:24 lwall -# 4.0 baseline. -# -# Revision 3.0.1.4 90/11/10 01:41:11 lwall -# patch38: syslog.pl was referencing an absolute path -# -# Revision 3.0.1.3 90/10/15 17:42:18 lwall -# patch29: various portability fixes -# -# Revision 3.0.1.1 90/08/09 03:57:17 lwall -# patch19: Initial revision -# -# Revision 1.2 90/06/11 18:45:30 18:45:30 root () -# - Changed 'warn' to 'mail|warning' in test call (to give example of -# facility specification, and because 'warn' didn't work on HP-UX). -# - Fixed typo in &openlog ("ncons" should be "cons"). -# - Added (package-global) $maskpri, and &setlogmask. -# - In &syslog: -# - put argument test ahead of &connect (why waste cycles?), -# - allowed facility to be specified in &syslog's first arg (temporarily -# overrides any $facility set in &openlog), just as in syslog(3C), -# - do a return 0 when bit for $numpri not set in log mask (see syslog(3C)), -# - changed $whoami code to use getlogin, getpwuid($<) and 'syslog' -# (in that order) when $ident is null, -# - made PID logging consistent with syslog(3C) and subject to $lo_pid only, -# - fixed typo in "print CONS" statement ($ # modified to use sockets by Larry Wall # NOTE: openlog now takes three arguments, just like openlog(3) diff --git a/lib/termcap.pl b/lib/termcap.pl new file mode 100644 index 0000000..e8f108d --- /dev/null +++ b/lib/termcap.pl @@ -0,0 +1,166 @@ +;# $RCSfile: termcap.pl,v $$Revision: 4.1 $$Date: 92/08/07 18:24:16 $ +;# +;# Usage: +;# require 'ioctl.pl'; +;# ioctl(TTY,$TIOCGETP,$foo); +;# ($ispeed,$ospeed) = unpack('cc',$foo); +;# require 'termcap.pl'; +;# &Tgetent('vt100'); # sets $TC{'cm'}, etc. +;# &Tputs(&Tgoto($TC{'cm'},$col,$row), 0, 'FILEHANDLE'); +;# &Tputs($TC{'dl'},$affcnt,'FILEHANDLE'); +;# +sub Tgetent { + local($TERM) = @_; + local($TERMCAP,$_,$entry,$loop,$field); + + warn "Tgetent: no ospeed set" unless $ospeed; + foreach $key (keys(TC)) { + delete $TC{$key}; + } + $TERM = $ENV{'TERM'} unless $TERM; + $TERM =~ s/(\W)/\\$1/g; + $TERMCAP = $ENV{'TERMCAP'}; + $TERMCAP = '/etc/termcap' unless $TERMCAP; + if ($TERMCAP !~ m:^/:) { + if ($TERMCAP !~ /(^|\|)$TERM[:\|]/) { + $TERMCAP = '/etc/termcap'; + } + } + if ($TERMCAP =~ m:^/:) { + $entry = ''; + do { + $loop = " + open(TERMCAP,'<$TERMCAP') || die \"Can't open $TERMCAP\"; + while () { + next if /^#/; + next if /^\t/; + if (/(^|\\|)${TERM}[:\\|]/) { + chop; + while (chop eq '\\\\') { + \$_ .= ; + chop; + } + \$_ .= ':'; + last; + } + } + close TERMCAP; + \$entry .= \$_; + "; + eval $loop; + } while s/:tc=([^:]+):/:/ && ($TERM = $1); + $TERMCAP = $entry; + } + + foreach $field (split(/:[\s:\\]*/,$TERMCAP)) { + if ($field =~ /^\w\w$/) { + $TC{$field} = 1; + } + elsif ($field =~ /^(\w\w)#(.*)/) { + $TC{$1} = $2 if $TC{$1} eq ''; + } + elsif ($field =~ /^(\w\w)=(.*)/) { + $entry = $1; + $_ = $2; + s/\\E/\033/g; + s/\\(\d\d\d)/pack('c',$1 & 0177)/eg; + s/\\n/\n/g; + s/\\r/\r/g; + s/\\t/\t/g; + s/\\b/\b/g; + s/\\f/\f/g; + s/\\\^/\377/g; + s/\^\?/\177/g; + s/\^(.)/pack('c',ord($1) & 31)/eg; + s/\\(.)/$1/g; + s/\377/^/g; + $TC{$entry} = $_ if $TC{$entry} eq ''; + } + } + $TC{'pc'} = "\0" if $TC{'pc'} eq ''; + $TC{'bc'} = "\b" if $TC{'bc'} eq ''; +} + +@Tputs = (0,200,133.3,90.9,74.3,66.7,50,33.3,16.7,8.3,5.5,4.1,2,1,.5,.2); + +sub Tputs { + local($string,$affcnt,$FH) = @_; + local($ms); + if ($string =~ /(^[\d.]+)(\*?)(.*)$/) { + $ms = $1; + $ms *= $affcnt if $2; + $string = $3; + $decr = $Tputs[$ospeed]; + if ($decr > .1) { + $ms += $decr / 2; + $string .= $TC{'pc'} x ($ms / $decr); + } + } + print $FH $string if $FH; + $string; +} + +sub Tgoto { + local($string) = shift(@_); + local($result) = ''; + local($after) = ''; + local($code,$tmp) = @_; + local(@tmp); + @tmp = ($tmp,$code); + local($online) = 0; + while ($string =~ /^([^%]*)%(.)(.*)/) { + $result .= $1; + $code = $2; + $string = $3; + if ($code eq 'd') { + $result .= sprintf("%d",shift(@tmp)); + } + elsif ($code eq '.') { + $tmp = shift(@tmp); + if ($tmp == 0 || $tmp == 4 || $tmp == 10) { + if ($online) { + ++$tmp, $after .= $TC{'up'} if $TC{'up'}; + } + else { + ++$tmp, $after .= $TC{'bc'}; + } + } + $result .= sprintf("%c",$tmp); + $online = !$online; + } + elsif ($code eq '+') { + $result .= sprintf("%c",shift(@tmp)+ord($string)); + $string = substr($string,1,99); + $online = !$online; + } + elsif ($code eq 'r') { + ($code,$tmp) = @tmp; + @tmp = ($tmp,$code); + $online = !$online; + } + elsif ($code eq '>') { + ($code,$tmp,$string) = unpack("CCa99",$string); + if ($tmp[$[] > $code) { + $tmp[$[] += $tmp; + } + } + elsif ($code eq '2') { + $result .= sprintf("%02d",shift(@tmp)); + $online = !$online; + } + elsif ($code eq '3') { + $result .= sprintf("%03d",shift(@tmp)); + $online = !$online; + } + elsif ($code eq 'i') { + ($code,$tmp) = @tmp; + @tmp = ($code+1,$tmp+1); + } + else { + return "OOPS"; + } + } + $result . $string . $after; +} + +1; diff --git a/lib/timelocal.pl b/lib/timelocal.pl index c5d8a92..75f1ac1 100644 --- a/lib/timelocal.pl +++ b/lib/timelocal.pl @@ -21,6 +21,9 @@ ;# the result of localtime(0) when the package is initialized. The daylight ;# savings offset is currently assumed to be one hour. +;# Both routines return -1 if the integer limit is hit. I.e. for dates +;# after the 1st of January, 2038 on most machines. + CONFIG: { package timelocal; @@ -46,6 +49,7 @@ sub timegm { local($[) = 0; $ym = pack(C2, @_[5,4]); $cheat = $cheat{$ym} || &cheat; + return -1 if $cheat<0; $cheat + $_[0] * $SEC + $_[1] * $MIN + $_[2] * $HR + ($_[3]-1) * $DAYS; } @@ -54,6 +58,7 @@ sub timelocal { local($[) = 0; $time = &main'timegm + $tzmin*$MIN; + return -1 if $cheat<0; @test = localtime($time); $time -= $HR if $test[2] != $_[2]; $time; @@ -64,17 +69,39 @@ package timelocal; sub cheat { $year = $_[5]; $month = $_[4]; - die "Month out of range 0..11 in ctime.pl\n" if $month > 11; + die "Month out of range 0..11 in timelocal.pl\n" + if $month > 11 || $month < 0; + die "Day out of range 1..31 in timelocal.pl\n" + if $_[3] > 31 || $_[3] < 1; + die "Hour out of range 0..23 in timelocal.pl\n" + if $_[2] > 23 || $_[2] < 0; + die "Minute out of range 0..59 in timelocal.pl\n" + if $_[1] > 59 || $_[1] < 0; + die "Second out of range 0..59 in timelocal.pl\n" + if $_[0] > 59 || $_[0] < 0; $guess = $^T; @g = gmtime($guess); $year += $YearFix if $year < $epoch[5]; + $lastguess = ""; while ($diff = $year - $g[5]) { $guess += $diff * (363 * $DAYS); @g = gmtime($guess); + if (($thisguess = "@g") eq $lastguess){ + return -1; #date beyond this machine's integer limit + } + $lastguess = $thisguess; } while ($diff = $month - $g[4]) { $guess += $diff * (27 * $DAYS); @g = gmtime($guess); + if (($thisguess = "@g") eq $lastguess){ + return -1; #date beyond this machine's integer limit + } + $lastguess = $thisguess; + } + @gfake = gmtime($guess-1); #still being sceptic + if ("@gfake" eq $lastguess){ + return -1; #date beyond this machine's integer limit } $g[3]--; $guess -= $g[0] * $SEC + $g[1] * $MIN + $g[2] * $HR + $g[3] * $DAYS; diff --git a/main.c b/main.c deleted file mode 100644 index 8cb0a88..0000000 --- a/main.c +++ /dev/null @@ -1,37 +0,0 @@ -#include "INTERN.h" -#include "perl.h" - -main(argc, argv, env) -int argc; -char **argv; -char **env; -{ - int exitstatus; - PerlInterpreter *my_perl; - - my_perl = perl_alloc(); - if (!my_perl) - exit(1); - perl_construct( my_perl ); - - exitstatus = perl_parse( my_perl, argc, argv, env ); - if (exitstatus) - exit( exitstatus ); - - exitstatus = perl_run( my_perl ); - - perl_destruct( my_perl ); - perl_free( my_perl ); - - exit( exitstatus ); -} - -/* Register any extra external extensions */ - -void -perl_init_ext() -{ - char *file = __FILE__; - - boot_DynamicLoader(); -} diff --git a/make.out b/make.out deleted file mode 100644 index c38dafd..0000000 --- a/make.out +++ /dev/null @@ -1,9 +0,0 @@ -make: Warning: Both `makefile' and `Makefile' exists -test -f miniperl || make miniperl -./miniperl ext/xsubpp ext/posix/POSIX.xs >tmp -mv tmp POSIX.c -`sh cflags POSIX.o` POSIX.c - CCCMD = cc -c -DDEBUGGING -g -test -d lib/auto/POSIX || mkdir lib/auto/POSIX -ld -o lib/auto/POSIX/POSIX.so POSIX.o -lm -cc -o perl perlmain.o perl.o av.o scope.o op.o doop.o doio.o dump.o hv.o malloc.o mg.o perly.o pp.o regcomp.o regexec.o gv.o sv.o taint.o toke.o util.o deb.o run.o dl_sunos.o -ldbm -ldl -lm -lposix diff --git a/makedepend b/makedepend deleted file mode 100755 index 6aec6df..0000000 --- a/makedepend +++ /dev/null @@ -1,155 +0,0 @@ -#!/bin/sh -# $RCSfile: makedepend.SH,v 3314Revision: 4.1 3314Date: 92/08/07 18:24:20 $ -# -# $Log: makedepend.SH,v $ -# Revision 4.1 92/08/07 18:24:20 lwall -# -# Revision 4.0.1.4 92/06/08 13:51:24 lwall -# patch20: various and sundry fixes -# -# Revision 4.0.1.3 91/11/05 17:56:33 lwall -# patch11: various portability fixes -# -# Revision 4.0.1.2 91/06/07 15:40:06 lwall -# patch4: fixed cppstdin to run in the right directory -# -# Revision 4.0.1.1 91/06/07 11:20:06 lwall -# patch4: Makefile is no longer self-modifying code under makedepend -# -# Revision 4.0 91/03/20 01:27:04 lwall -# 4.0 baseline. -# -# - -export PATH || (echo "OOPS, this isn't sh. Desperation time. I will feed myself to sh."; sh $0; kill $$) - -cat='/bin/cat' -cppflags=' -DDEBUGGING' -cp='/bin/cp' -cppstdin='/tmp_mnt/net/vaccine/export/src/local/lwall/perl5/cppstdin' -cppminus='' -echo='/bin/echo' -egrep='/bin/egrep' -expr='/bin/expr' -mv='/bin/mv' -rm='/bin/rm' -sed='/bin/sed' -sort='/bin/sort' -test='test' -tr='/bin/tr' -uniq='/bin/uniq' - -PATH="$PATH:." -export PATH - -$cat /dev/null >.deptmp -$rm -f *.c.c c/*.c.c -if test -f Makefile; then - cp Makefile makefile -fi -mf=makefile -if test -f $mf; then - defrule=`<$mf sed -n \ - -e '/^\.c\.o:.*;/{' \ - -e 's/\$\*\.c//' \ - -e 's/^[^;]*;[ ]*//p' \ - -e q \ - -e '}' \ - -e '/^\.c\.o: *$/{' \ - -e N \ - -e 's/\$\*\.c//' \ - -e 's/^.*\n[ ]*//p' \ - -e q \ - -e '}'` -fi -case "$defrule" in -'') defrule='$(CC) -c $(CFLAGS)' ;; -esac - -: Create files in UU directory to avoid problems with long filenames -: on systems with 14 character filename limits so file.c.c and file.c -: might be identical -$test -d UU || mkdir UU - -make clist || ($echo "Searching for .c files..."; \ - $echo *.c | $tr ' ' '\012' | $egrep -v '\*' >.clist) -for file in `$cat .clist`; do -# for file in `cat /dev/null`; do - case "$file" in - *.c) filebase=`basename $file .c` ;; - *.y) filebase=`basename $file .y` ;; - esac - case "$file" in - */*) finc="-I`echo $file | sed 's#/[^/]*$##`" ;; - *) finc= ;; - esac - $echo "Finding dependencies for $filebase.o." - ( $echo "#line 1 \"$file\""; \ - $sed -n <$file \ - -e "/^${filebase}_init(/q" \ - -e '/^#line/d' \ - -e '/^#/{' \ - -e 's|/\*.*$||' \ - -e 's|\\$||' \ - -e p \ - -e '}' ) >UU/$file.c - $cppstdin $finc -I/usr/local/include -I. $cppflags $cppminus > .deptmp -done - -$sed <$mf >$mf.new -e '1,/^# AUTOMATICALLY/!d' - -make shlist || ($echo "Searching for .SH files..."; \ - $echo *.SH | $tr ' ' '\012' | $egrep -v '\*' >.shlist) -if $test -s .deptmp; then - for file in `cat .shlist`; do - $echo `$expr X$file : 'X\(.*\).SH'`: $file config.sh \; \ - /bin/sh $file >> .deptmp - done - $echo "Updating $mf..." - $echo "# If this runs make out of memory, delete /usr/include lines." \ - >> $mf.new - $sed 's|^\(.*\.o:\) *\(.*/.*\.c\) *$|\1 \2; '"$defrule \2|" .deptmp \ - >>$mf.new -else - make hlist || ($echo "Searching for .h files..."; \ - $echo *.h | $tr ' ' '\012' | $egrep -v '\*' >.hlist) - $echo "You don't seem to have a proper C preprocessor. Using grep instead." - $egrep '^#include ' `cat .clist` `cat .hlist` >.deptmp - $echo "Updating $mf..." - <.clist $sed -n \ - -e '/\//{' \ - -e 's|^\(.*\)/\(.*\)\.c|\2.o: \1/\2.c; '"$defrule \1/\2.c|p" \ - -e d \ - -e '}' \ - -e 's|^\(.*\)\.c|\1.o: \1.c|p' >> $mf.new - <.hlist $sed -n 's|\(.*/\)\(.*\)|s= \2= \1\2=|p' >.hsed - <.deptmp $sed -n 's|c:#include "\(.*\)".*$|o: \1|p' | \ - $sed 's|^[^;]*/||' | \ - $sed -f .hsed >> $mf.new - <.deptmp $sed -n 's|c:#include <\(.*\)>.*$|o: /usr/include/\1|p' \ - >> $mf.new - <.deptmp $sed -n 's|h:#include "\(.*\)".*$|h: \1|p' | \ - $sed -f .hsed >> $mf.new - <.deptmp $sed -n 's|h:#include <\(.*\)>.*$|h: /usr/include/\1|p' \ - >> $mf.new - for file in `$cat .shlist`; do - $echo `$expr X$file : 'X\(.*\).SH'`: $file config.sh \; \ - /bin/sh $file >> $mf.new - done -fi -$rm -f $mf.old -$cp $mf $mf.old -$cp $mf.new $mf -$rm $mf.new -$echo "# WARNING: Put nothing here or make depend will gobble it up!" >> $mf -$rm -rf .deptmp UU .shlist .clist .hlist .hsed - diff --git a/makedepend.SH b/makedepend.SH index 01963f8..296c954 100755 --- a/makedepend.SH +++ b/makedepend.SH @@ -1,63 +1,42 @@ case $CONFIG in '') - if test ! -f config.sh; then - ln ../config.sh . || \ - ln ../../config.sh . || \ - ln ../../../config.sh . || \ - (echo "Can't find config.sh."; exit 1) - fi 2>/dev/null - . ./config.sh - ;; + if test -f config.sh; then TOP=.; + elif test -f ../config.sh; then TOP=..; + elif test -f ../../config.sh; then TOP=../..; + elif test -f ../../../config.sh; then TOP=../../..; + elif test -f ../../../../config.sh; then TOP=../../../..; + else + echo "Can't find config.sh."; exit 1 + fi + . $TOP/config.sh + ;; esac +: This forces SH files to create target in same directory as SH file. +: This is so that make depend always knows where to find SH derivatives. case "$0" in */*) cd `expr X$0 : 'X\(.*\)/'` ;; esac echo "Extracting makedepend (with variable substitutions)" rm -f makedepend -$spitshell >makedepend <makedepend <<'!NO!SUBS!' +# makedepend.SH # -# $Log: makedepend.SH,v $ -# Revision 4.1 92/08/07 18:24:20 lwall -# -# Revision 4.0.1.4 92/06/08 13:51:24 lwall -# patch20: various and sundry fixes -# -# Revision 4.0.1.3 91/11/05 17:56:33 lwall -# patch11: various portability fixes -# -# Revision 4.0.1.2 91/06/07 15:40:06 lwall -# patch4: fixed cppstdin to run in the right directory -# -# Revision 4.0.1.1 91/06/07 11:20:06 lwall -# patch4: Makefile is no longer self-modifying code under makedepend -# -# Revision 4.0 91/03/20 01:27:04 lwall -# 4.0 baseline. -# -# export PATH || (echo "OOPS, this isn't sh. Desperation time. I will feed myself to sh."; sh \$0; kill \$\$) -cat='$cat' -cppflags='$cppflags' -cp='$cp' -cppstdin='$cppstdin' -cppminus='$cppminus' -echo='$echo' -egrep='$egrep' -expr='$expr' -mv='$mv' -rm='$rm' -sed='$sed' -sort='$sort' -test='$test' -tr='$tr' -uniq='$uniq' -!GROK!THIS! - -$spitshell >>makedepend <<'!NO!SUBS!' +case $CONFIG in +'') + if test -f config.sh; then TOP=.; + elif test -f ../config.sh; then TOP=..; + elif test -f ../../config.sh; then TOP=../..; + elif test -f ../../../config.sh; then TOP=../../..; + elif test -f ../../../../config.sh; then TOP=../../../..; + else + echo "Can't find config.sh."; exit 1 + fi + . $TOP/config.sh + ;; +esac PATH="$PATH:." export PATH @@ -131,7 +110,7 @@ make shlist || ($echo "Searching for .SH files..."; \ $echo *.SH | $tr ' ' '\012' | $egrep -v '\*' >.shlist) if $test -s .deptmp; then for file in `cat .shlist`; do - $echo `$expr X$file : 'X\(.*\).SH'`: $file config.sh \; \ + $echo `$expr X$file : 'X\(.*\).SH'`: $file $TOP/config.sh \; \ /bin/sh $file >> .deptmp done $echo "Updating $mf..." @@ -155,14 +134,10 @@ else <.deptmp $sed -n 's|c:#include "\(.*\)".*$|o: \1|p' | \ $sed 's|^[^;]*/||' | \ $sed -f .hsed >> $mf.new - <.deptmp $sed -n 's|c:#include <\(.*\)>.*$|o: /usr/include/\1|p' \ - >> $mf.new <.deptmp $sed -n 's|h:#include "\(.*\)".*$|h: \1|p' | \ $sed -f .hsed >> $mf.new - <.deptmp $sed -n 's|h:#include <\(.*\)>.*$|h: /usr/include/\1|p' \ - >> $mf.new for file in `$cat .shlist`; do - $echo `$expr X$file : 'X\(.*\).SH'`: $file config.sh \; \ + $echo `$expr X$file : 'X\(.*\).SH'`: $file $TOP/config.sh \; \ /bin/sh $file >> $mf.new done fi diff --git a/makedir b/makedir deleted file mode 100755 index 250bdd5..0000000 --- a/makedir +++ /dev/null @@ -1,58 +0,0 @@ -#!/bin/sh -# $RCSfile: makedir.SH,v 3314Revision: 4.1 3314Date: 92/08/07 18:24:23 $ -# -# $Log: makedir.SH,v $ -# Revision 4.1 92/08/07 18:24:23 lwall -# -# Revision 4.0.1.1 92/06/08 14:24:55 lwall -# patch20: SH files didn't work well with symbolic links -# -# Revision 4.0 91/03/20 01:27:13 lwall -# 4.0 baseline. -# -# - -export PATH || (echo "OOPS, this isn't sh. Desperation time. I will feed myself to sh."; sh $0; kill $$) - -case $# in - 0) - /bin/echo "makedir pathname filenameflag" - exit 1 - ;; -esac - -: guarantee one slash before 1st component -case $1 in - /*) ;; - *) set ./$1 $2 ;; -esac - -: strip last component if it is to be a filename -case X$2 in - X1) set `/bin/echo $1 | /bin/sed 's:\(.*\)/[^/]*$:\1:'` ;; - *) set $1 ;; -esac - -: return reasonable status if nothing to be created -if test -d "$1" ; then - exit 0 -fi - -list='' -while true ; do - case $1 in - */*) - list="$1 $list" - set `echo $1 | /bin/sed 's:\(.*\)/:\1 :'` - ;; - *) - break - ;; - esac -done - -set $list - -for dir do - /bin/mkdir $dir >/dev/null 2>&1 -done diff --git a/makedir.SH b/makedir.SH index 4d055cf..09908ed 100755 --- a/makedir.SH +++ b/makedir.SH @@ -16,17 +16,7 @@ echo "Extracting makedir (with variable substitutions)" rm -f makedir $spitshell >makedir <tmp - mv tmp NDBM_File.c - -lib/auto/NDBM_File/NDBM_File$(SHLIBSUFFIX): NDBM_File.o - test -d lib/auto/NDBM_File || mkdir lib/auto/NDBM_File - ld $(LDDLFLAGS) -o $@ NDBM_File.o - -# ODBM_File extension -ODBM_File.o: ODBM_File.c - $(CCCMD) $(CCCDLFLAGS) $*.c - -ODBM_File.c: ext/dbm/ODBM_File.xs ext/xsubpp ext/typemap - test -f miniperl || make miniperl - ./miniperl ext/xsubpp ext/dbm/ODBM_File.xs >tmp - mv tmp ODBM_File.c - -lib/auto/ODBM_File/ODBM_File$(SHLIBSUFFIX): ODBM_File.o - test -d lib/auto/ODBM_File || mkdir lib/auto/ODBM_File - ld $(LDDLFLAGS) -o $@ ODBM_File.o - -# SDBM_File extension -SDBM_File.o: SDBM_File.c - $(CCCMD) $(CCCDLFLAGS) $*.c - -SDBM_File.c: ext/dbm/SDBM_File.xs ext/xsubpp ext/typemap - test -f miniperl || make miniperl - ./miniperl ext/xsubpp ext/dbm/SDBM_File.xs >tmp - mv tmp SDBM_File.c - -lib/auto/SDBM_File/SDBM_File$(SHLIBSUFFIX): SDBM_File.o ext/dbm/sdbm/libsdbm.a - test -d lib/auto/SDBM_File || mkdir lib/auto/SDBM_File - ld $(LDDLFLAGS) -o $@ SDBM_File.o ext/dbm/sdbm/libsdbm.a - -# POSIX extension -POSIX.o: POSIX.c - $(CCCMD) $(CCCDLFLAGS) $*.c - -POSIX.c: ext/posix/POSIX.xs ext/xsubpp ext/typemap - test -f miniperl || make miniperl - ./miniperl ext/xsubpp ext/posix/POSIX.xs >tmp - mv tmp POSIX.c - -lib/auto/POSIX/POSIX$(SHLIBSUFFIX): POSIX.o - test -d lib/auto/POSIX || mkdir lib/auto/POSIX - ld $(LDDLFLAGS) -o $@ POSIX.o -lm - -# List of extensions (used by writemain) to generate perlmain.c -ext= NDBM_File ODBM_File SDBM_File POSIX -extsrc= NDBM_File.c ODBM_File.c SDBM_File.c POSIX.c -# Extension dependencies. -extdep= lib/auto/NDBM_File/NDBM_File$(SHLIBSUFFIX) lib/auto/ODBM_File/ODBM_File$(SHLIBSUFFIX) lib/auto/SDBM_File/SDBM_File$(SHLIBSUFFIX) lib/auto/POSIX/POSIX$(SHLIBSUFFIX) -# How to include extensions in linking command -extobj= - -ext/dbm/sdbm/libsdbm.a: ext/dbm/sdbm/sdbm.h ext/dbm/sdbm/sdbm.c - cd ext/dbm/sdbm; $(MAKE) -f Makefile libsdbm.a - -# The $& notation tells Sequent machines that it can do a parallel make, -# and is harmless otherwise. - -miniperl: $& miniperlmain.o perl.o $(obj) - $(CC) $(LARGE) $(CLDFLAGS) -o miniperl miniperlmain.o perl.o $(obj) $(libs) - -perlmain.c: miniperlmain.c - sh writemain $(ext) > perlmain.c - -perlmain.o: perlmain.c - -perl: $& perlmain.o perl.o $(obj) $(dlobj) $(extdep) - $(CC) $(LARGE) $(CLDFLAGS) $(CCDLFLAGS) -o perl perlmain.o perl.o $(obj) $(dlobj) $(extobj) $(libs) - -libperl.rlb: libperl.a - $(ranlib) libperl.a - touch libperl.rlb - -libperl.a: $& perl.o $(obj) - ar rcuv libperl.a $(obj) - -# This version, if specified in Configure, does ONLY those scripts which need -# set-id emulation. Suidperl must be setuid root. It contains the "taint" -# checks as well as the special code to validate that the script in question -# has been invoked correctly. - -suidperl: $& sperl.o perlmain.o libperl.rlb - $(CC) $(LARGE) $(CLDFLAGS) sperl.o perlmain.o libperl.a $(libs) -o suidperl - -lib/Config.pm: config.sh miniperl - ./miniperl configpm - -saber: $(saber) - # load $(saber) - # load /lib/libm.a - -sperl.o: perl.c perly.h patchlevel.h $(h) - $(RMS) sperl.c - $(LNS) perl.c sperl.c - $(CCCMD) -DIAMSUID sperl.c - $(RMS) sperl.c - -perly.h: perly.c - @ echo Dummy dependency for dumb parallel make - touch perly.h - -opcode.h: opcode.pl - - perl opcode.pl - -embed.h: embed_h.SH global.sym interp.sym - sh embed_h.SH - -perly.c: - @ echo 'Expect' 80 shift/reduce and 62 reduce/reduce conflicts - $(BYACC) -d perly.y - sh $(shellflags) ./perly.fixer y.tab.c perly.c - mv y.tab.h perly.h - echo 'extern YYSTYPE yylval;' >>perly.h - -perly.o: perly.c perly.h $(h) - $(CCCMD) perly.c - -install: all - ./perl installperl - -clean: - rm -f *.o all perl miniperl - rm -f POSIX.c ?DBM_File.c perlmain.c - rm -f ext/dbm/sdbm/libsdbm.a - cd ext/dbm/sdbm; $(MAKE) -f Makefile clean - cd x2p; $(MAKE) clean - -realclean: clean - cd x2p; $(MAKE) realclean - cd ext/dbm/sdbm; $(MAKE) -f Makefile realclean - rm -f *.orig */*.orig *~ */*~ core $(addedbyconf) h2ph h2ph.man - rm -f Makefile cflags embed_h makedepend makedir writemain - rm -f config.h t/perl makefile makefile.old cflags - rm -rf lib/auto/?DBM_File lib/auto/POSIX - rm -f x2p/Makefile x2p/makefile x2p/makefile.old x2p/cflags - rm -f lib/Config.pm - rm -f c2ph pstruct - -# The following lint has practically everything turned on. Unfortunately, -# you have to wade through a lot of mumbo jumbo that can't be suppressed. -# If the source file has a /*NOSTRICT*/ somewhere, ignore the lint message -# for that spot. - -lint: perly.c $(c) - lint $(lintflags) $(defs) perly.c $(c) > perl.fuzz - -depend: makedepend - - test -f perly.h || cp /dev/null perly.h - ./makedepend - - test -s perly.h || /bin/rm -f perly.h - cd x2p; $(MAKE) depend - -test: perl lib/Config.pm - - cd t && chmod +x TEST */*.t - - cd t && (rm -f perl; $(LNS) ../perl perl) && ./perl TEST .clist - -hlist: $(h) - echo $(h) | tr ' ' '\012' >.hlist - -shlist: $(sh) - echo $(sh) | tr ' ' '\012' >.shlist - -# AUTOMATICALLY GENERATED MAKE DEPENDENCIES--PUT NOTHING BELOW THIS LINE -# If this runs make out of memory, delete /usr/include lines. -av.o: /usr/include/ctype.h -av.o: /usr/include/dirent.h -av.o: /usr/include/errno.h -av.o: /usr/include/machine/param.h -av.o: /usr/include/machine/setjmp.h -av.o: /usr/include/netinet/in.h -av.o: /usr/include/setjmp.h -av.o: /usr/include/stdio.h -av.o: /usr/include/sys/dirent.h -av.o: /usr/include/sys/errno.h -av.o: /usr/include/sys/filio.h -av.o: /usr/include/sys/ioccom.h -av.o: /usr/include/sys/ioctl.h -av.o: /usr/include/sys/param.h -av.o: /usr/include/sys/signal.h -av.o: /usr/include/sys/sockio.h -av.o: /usr/include/sys/stat.h -av.o: /usr/include/sys/stdtypes.h -av.o: /usr/include/sys/sysmacros.h -av.o: /usr/include/sys/time.h -av.o: /usr/include/sys/times.h -av.o: /usr/include/sys/ttold.h -av.o: /usr/include/sys/ttychars.h -av.o: /usr/include/sys/ttycom.h -av.o: /usr/include/sys/ttydev.h -av.o: /usr/include/sys/types.h -av.o: /usr/include/time.h -av.o: /usr/include/varargs.h -av.o: /usr/include/vm/faultcode.h -av.o: EXTERN.h -av.o: av.c -av.o: av.h -av.o: config.h -av.o: cop.h -av.o: cv.h -av.o: embed.h -av.o: form.h -av.o: gv.h -av.o: handy.h -av.o: hv.h -av.o: mg.h -av.o: op.h -av.o: opcode.h -av.o: perl.h -av.o: pp.h -av.o: proto.h -av.o: regexp.h -av.o: scope.h -av.o: sv.h -av.o: unixish.h -av.o: util.h -scope.o: /usr/include/ctype.h -scope.o: /usr/include/dirent.h -scope.o: /usr/include/errno.h -scope.o: /usr/include/machine/param.h -scope.o: /usr/include/machine/setjmp.h -scope.o: /usr/include/netinet/in.h -scope.o: /usr/include/setjmp.h -scope.o: /usr/include/stdio.h -scope.o: /usr/include/sys/dirent.h -scope.o: /usr/include/sys/errno.h -scope.o: /usr/include/sys/filio.h -scope.o: /usr/include/sys/ioccom.h -scope.o: /usr/include/sys/ioctl.h -scope.o: /usr/include/sys/param.h -scope.o: /usr/include/sys/signal.h -scope.o: /usr/include/sys/sockio.h -scope.o: /usr/include/sys/stat.h -scope.o: /usr/include/sys/stdtypes.h -scope.o: /usr/include/sys/sysmacros.h -scope.o: /usr/include/sys/time.h -scope.o: /usr/include/sys/times.h -scope.o: /usr/include/sys/ttold.h -scope.o: /usr/include/sys/ttychars.h -scope.o: /usr/include/sys/ttycom.h -scope.o: /usr/include/sys/ttydev.h -scope.o: /usr/include/sys/types.h -scope.o: /usr/include/time.h -scope.o: /usr/include/varargs.h -scope.o: /usr/include/vm/faultcode.h -scope.o: EXTERN.h -scope.o: av.h -scope.o: config.h -scope.o: cop.h -scope.o: cv.h -scope.o: embed.h -scope.o: form.h -scope.o: gv.h -scope.o: handy.h -scope.o: hv.h -scope.o: mg.h -scope.o: op.h -scope.o: opcode.h -scope.o: perl.h -scope.o: pp.h -scope.o: proto.h -scope.o: regexp.h -scope.o: scope.c -scope.o: scope.h -scope.o: sv.h -scope.o: unixish.h -scope.o: util.h -op.o: /usr/include/ctype.h -op.o: /usr/include/dirent.h -op.o: /usr/include/errno.h -op.o: /usr/include/machine/param.h -op.o: /usr/include/machine/setjmp.h -op.o: /usr/include/netinet/in.h -op.o: /usr/include/setjmp.h -op.o: /usr/include/stdio.h -op.o: /usr/include/sys/dirent.h -op.o: /usr/include/sys/errno.h -op.o: /usr/include/sys/filio.h -op.o: /usr/include/sys/ioccom.h -op.o: /usr/include/sys/ioctl.h -op.o: /usr/include/sys/param.h -op.o: /usr/include/sys/signal.h -op.o: /usr/include/sys/sockio.h -op.o: /usr/include/sys/stat.h -op.o: /usr/include/sys/stdtypes.h -op.o: /usr/include/sys/sysmacros.h -op.o: /usr/include/sys/time.h -op.o: /usr/include/sys/times.h -op.o: /usr/include/sys/ttold.h -op.o: /usr/include/sys/ttychars.h -op.o: /usr/include/sys/ttycom.h -op.o: /usr/include/sys/ttydev.h -op.o: /usr/include/sys/types.h -op.o: /usr/include/time.h -op.o: /usr/include/varargs.h -op.o: /usr/include/vm/faultcode.h -op.o: EXTERN.h -op.o: av.h -op.o: config.h -op.o: cop.h -op.o: cv.h -op.o: embed.h -op.o: form.h -op.o: gv.h -op.o: handy.h -op.o: hv.h -op.o: mg.h -op.o: op.c -op.o: op.h -op.o: opcode.h -op.o: perl.h -op.o: pp.h -op.o: proto.h -op.o: regexp.h -op.o: scope.h -op.o: sv.h -op.o: unixish.h -op.o: util.h -doop.o: /usr/include/ctype.h -doop.o: /usr/include/dirent.h -doop.o: /usr/include/errno.h -doop.o: /usr/include/machine/param.h -doop.o: /usr/include/machine/setjmp.h -doop.o: /usr/include/netinet/in.h -doop.o: /usr/include/setjmp.h -doop.o: /usr/include/stdio.h -doop.o: /usr/include/sys/dirent.h -doop.o: /usr/include/sys/errno.h -doop.o: /usr/include/sys/filio.h -doop.o: /usr/include/sys/ioccom.h -doop.o: /usr/include/sys/ioctl.h -doop.o: /usr/include/sys/param.h -doop.o: /usr/include/sys/signal.h -doop.o: /usr/include/sys/sockio.h -doop.o: /usr/include/sys/stat.h -doop.o: /usr/include/sys/stdtypes.h -doop.o: /usr/include/sys/sysmacros.h -doop.o: /usr/include/sys/time.h -doop.o: /usr/include/sys/times.h -doop.o: /usr/include/sys/ttold.h -doop.o: /usr/include/sys/ttychars.h -doop.o: /usr/include/sys/ttycom.h -doop.o: /usr/include/sys/ttydev.h -doop.o: /usr/include/sys/types.h -doop.o: /usr/include/time.h -doop.o: /usr/include/varargs.h -doop.o: /usr/include/vm/faultcode.h -doop.o: EXTERN.h -doop.o: av.h -doop.o: config.h -doop.o: cop.h -doop.o: cv.h -doop.o: doop.c -doop.o: embed.h -doop.o: form.h -doop.o: gv.h -doop.o: handy.h -doop.o: hv.h -doop.o: mg.h -doop.o: op.h -doop.o: opcode.h -doop.o: perl.h -doop.o: pp.h -doop.o: proto.h -doop.o: regexp.h -doop.o: scope.h -doop.o: sv.h -doop.o: unixish.h -doop.o: util.h -doio.o: /usr/include/ctype.h -doio.o: /usr/include/debug/debug.h -doio.o: /usr/include/dirent.h -doio.o: /usr/include/errno.h -doio.o: /usr/include/machine/mmu.h -doio.o: /usr/include/machine/param.h -doio.o: /usr/include/machine/setjmp.h -doio.o: /usr/include/mon/obpdefs.h -doio.o: /usr/include/mon/openprom.h -doio.o: /usr/include/mon/sunromvec.h -doio.o: /usr/include/netinet/in.h -doio.o: /usr/include/setjmp.h -doio.o: /usr/include/stdio.h -doio.o: /usr/include/sys/dirent.h -doio.o: /usr/include/sys/errno.h -doio.o: /usr/include/sys/fcntlcom.h -doio.o: /usr/include/sys/file.h -doio.o: /usr/include/sys/filio.h -doio.o: /usr/include/sys/ioccom.h -doio.o: /usr/include/sys/ioctl.h -doio.o: /usr/include/sys/ipc.h -doio.o: /usr/include/sys/msg.h -doio.o: /usr/include/sys/param.h -doio.o: /usr/include/sys/sem.h -doio.o: /usr/include/sys/shm.h -doio.o: /usr/include/sys/signal.h -doio.o: /usr/include/sys/sockio.h -doio.o: /usr/include/sys/stat.h -doio.o: /usr/include/sys/stdtypes.h -doio.o: /usr/include/sys/sysmacros.h -doio.o: /usr/include/sys/time.h -doio.o: /usr/include/sys/times.h -doio.o: /usr/include/sys/ttold.h -doio.o: /usr/include/sys/ttychars.h -doio.o: /usr/include/sys/ttycom.h -doio.o: /usr/include/sys/ttydev.h -doio.o: /usr/include/sys/types.h -doio.o: /usr/include/time.h -doio.o: /usr/include/utime.h -doio.o: /usr/include/varargs.h -doio.o: /usr/include/vm/faultcode.h -doio.o: EXTERN.h -doio.o: av.h -doio.o: config.h -doio.o: cop.h -doio.o: cv.h -doio.o: doio.c -doio.o: embed.h -doio.o: form.h -doio.o: gv.h -doio.o: handy.h -doio.o: hv.h -doio.o: mg.h -doio.o: op.h -doio.o: opcode.h -doio.o: perl.h -doio.o: pp.h -doio.o: proto.h -doio.o: regexp.h -doio.o: scope.h -doio.o: sv.h -doio.o: unixish.h -doio.o: util.h -dump.o: /usr/include/ctype.h -dump.o: /usr/include/dirent.h -dump.o: /usr/include/errno.h -dump.o: /usr/include/machine/param.h -dump.o: /usr/include/machine/setjmp.h -dump.o: /usr/include/netinet/in.h -dump.o: /usr/include/setjmp.h -dump.o: /usr/include/stdio.h -dump.o: /usr/include/sys/dirent.h -dump.o: /usr/include/sys/errno.h -dump.o: /usr/include/sys/filio.h -dump.o: /usr/include/sys/ioccom.h -dump.o: /usr/include/sys/ioctl.h -dump.o: /usr/include/sys/param.h -dump.o: /usr/include/sys/signal.h -dump.o: /usr/include/sys/sockio.h -dump.o: /usr/include/sys/stat.h -dump.o: /usr/include/sys/stdtypes.h -dump.o: /usr/include/sys/sysmacros.h -dump.o: /usr/include/sys/time.h -dump.o: /usr/include/sys/times.h -dump.o: /usr/include/sys/ttold.h -dump.o: /usr/include/sys/ttychars.h -dump.o: /usr/include/sys/ttycom.h -dump.o: /usr/include/sys/ttydev.h -dump.o: /usr/include/sys/types.h -dump.o: /usr/include/time.h -dump.o: /usr/include/varargs.h -dump.o: /usr/include/vm/faultcode.h -dump.o: EXTERN.h -dump.o: av.h -dump.o: config.h -dump.o: cop.h -dump.o: cv.h -dump.o: dump.c -dump.o: embed.h -dump.o: form.h -dump.o: gv.h -dump.o: handy.h -dump.o: hv.h -dump.o: mg.h -dump.o: op.h -dump.o: opcode.h -dump.o: perl.h -dump.o: pp.h -dump.o: proto.h -dump.o: regexp.h -dump.o: scope.h -dump.o: sv.h -dump.o: unixish.h -dump.o: util.h -hv.o: /usr/include/ctype.h -hv.o: /usr/include/dirent.h -hv.o: /usr/include/errno.h -hv.o: /usr/include/machine/param.h -hv.o: /usr/include/machine/setjmp.h -hv.o: /usr/include/netinet/in.h -hv.o: /usr/include/setjmp.h -hv.o: /usr/include/stdio.h -hv.o: /usr/include/sys/dirent.h -hv.o: /usr/include/sys/errno.h -hv.o: /usr/include/sys/filio.h -hv.o: /usr/include/sys/ioccom.h -hv.o: /usr/include/sys/ioctl.h -hv.o: /usr/include/sys/param.h -hv.o: /usr/include/sys/signal.h -hv.o: /usr/include/sys/sockio.h -hv.o: /usr/include/sys/stat.h -hv.o: /usr/include/sys/stdtypes.h -hv.o: /usr/include/sys/sysmacros.h -hv.o: /usr/include/sys/time.h -hv.o: /usr/include/sys/times.h -hv.o: /usr/include/sys/ttold.h -hv.o: /usr/include/sys/ttychars.h -hv.o: /usr/include/sys/ttycom.h -hv.o: /usr/include/sys/ttydev.h -hv.o: /usr/include/sys/types.h -hv.o: /usr/include/time.h -hv.o: /usr/include/varargs.h -hv.o: /usr/include/vm/faultcode.h -hv.o: EXTERN.h -hv.o: av.h -hv.o: config.h -hv.o: cop.h -hv.o: cv.h -hv.o: embed.h -hv.o: form.h -hv.o: gv.h -hv.o: handy.h -hv.o: hv.c -hv.o: hv.h -hv.o: mg.h -hv.o: op.h -hv.o: opcode.h -hv.o: perl.h -hv.o: pp.h -hv.o: proto.h -hv.o: regexp.h -hv.o: scope.h -hv.o: sv.h -hv.o: unixish.h -hv.o: util.h -malloc.o: /usr/include/ctype.h -malloc.o: /usr/include/dirent.h -malloc.o: /usr/include/errno.h -malloc.o: /usr/include/machine/param.h -malloc.o: /usr/include/machine/setjmp.h -malloc.o: /usr/include/netinet/in.h -malloc.o: /usr/include/setjmp.h -malloc.o: /usr/include/stdio.h -malloc.o: /usr/include/sys/dirent.h -malloc.o: /usr/include/sys/errno.h -malloc.o: /usr/include/sys/filio.h -malloc.o: /usr/include/sys/ioccom.h -malloc.o: /usr/include/sys/ioctl.h -malloc.o: /usr/include/sys/param.h -malloc.o: /usr/include/sys/signal.h -malloc.o: /usr/include/sys/sockio.h -malloc.o: /usr/include/sys/stat.h -malloc.o: /usr/include/sys/stdtypes.h -malloc.o: /usr/include/sys/sysmacros.h -malloc.o: /usr/include/sys/time.h -malloc.o: /usr/include/sys/times.h -malloc.o: /usr/include/sys/ttold.h -malloc.o: /usr/include/sys/ttychars.h -malloc.o: /usr/include/sys/ttycom.h -malloc.o: /usr/include/sys/ttydev.h -malloc.o: /usr/include/sys/types.h -malloc.o: /usr/include/time.h -malloc.o: /usr/include/varargs.h -malloc.o: /usr/include/vm/faultcode.h -malloc.o: EXTERN.h -malloc.o: av.h -malloc.o: config.h -malloc.o: cop.h -malloc.o: cv.h -malloc.o: embed.h -malloc.o: form.h -malloc.o: gv.h -malloc.o: handy.h -malloc.o: hv.h -malloc.o: malloc.c -malloc.o: mg.h -malloc.o: op.h -malloc.o: opcode.h -malloc.o: perl.h -malloc.o: pp.h -malloc.o: proto.h -malloc.o: regexp.h -malloc.o: scope.h -malloc.o: sv.h -malloc.o: unixish.h -malloc.o: util.h -mg.o: /usr/include/ctype.h -mg.o: /usr/include/dirent.h -mg.o: /usr/include/errno.h -mg.o: /usr/include/machine/param.h -mg.o: /usr/include/machine/setjmp.h -mg.o: /usr/include/netinet/in.h -mg.o: /usr/include/setjmp.h -mg.o: /usr/include/stdio.h -mg.o: /usr/include/sys/dirent.h -mg.o: /usr/include/sys/errno.h -mg.o: /usr/include/sys/filio.h -mg.o: /usr/include/sys/ioccom.h -mg.o: /usr/include/sys/ioctl.h -mg.o: /usr/include/sys/param.h -mg.o: /usr/include/sys/signal.h -mg.o: /usr/include/sys/sockio.h -mg.o: /usr/include/sys/stat.h -mg.o: /usr/include/sys/stdtypes.h -mg.o: /usr/include/sys/sysmacros.h -mg.o: /usr/include/sys/time.h -mg.o: /usr/include/sys/times.h -mg.o: /usr/include/sys/ttold.h -mg.o: /usr/include/sys/ttychars.h -mg.o: /usr/include/sys/ttycom.h -mg.o: /usr/include/sys/ttydev.h -mg.o: /usr/include/sys/types.h -mg.o: /usr/include/time.h -mg.o: /usr/include/varargs.h -mg.o: /usr/include/vm/faultcode.h -mg.o: EXTERN.h -mg.o: av.h -mg.o: config.h -mg.o: cop.h -mg.o: cv.h -mg.o: embed.h -mg.o: form.h -mg.o: gv.h -mg.o: handy.h -mg.o: hv.h -mg.o: mg.c -mg.o: mg.h -mg.o: op.h -mg.o: opcode.h -mg.o: perl.h -mg.o: pp.h -mg.o: proto.h -mg.o: regexp.h -mg.o: scope.h -mg.o: sv.h -mg.o: unixish.h -mg.o: util.h -perly.o: /usr/include/ctype.h -perly.o: /usr/include/dirent.h -perly.o: /usr/include/errno.h -perly.o: /usr/include/machine/param.h -perly.o: /usr/include/machine/setjmp.h -perly.o: /usr/include/netinet/in.h -perly.o: /usr/include/setjmp.h -perly.o: /usr/include/stdio.h -perly.o: /usr/include/sys/dirent.h -perly.o: /usr/include/sys/errno.h -perly.o: /usr/include/sys/filio.h -perly.o: /usr/include/sys/ioccom.h -perly.o: /usr/include/sys/ioctl.h -perly.o: /usr/include/sys/param.h -perly.o: /usr/include/sys/signal.h -perly.o: /usr/include/sys/sockio.h -perly.o: /usr/include/sys/stat.h -perly.o: /usr/include/sys/stdtypes.h -perly.o: /usr/include/sys/sysmacros.h -perly.o: /usr/include/sys/time.h -perly.o: /usr/include/sys/times.h -perly.o: /usr/include/sys/ttold.h -perly.o: /usr/include/sys/ttychars.h -perly.o: /usr/include/sys/ttycom.h -perly.o: /usr/include/sys/ttydev.h -perly.o: /usr/include/sys/types.h -perly.o: /usr/include/time.h -perly.o: /usr/include/varargs.h -perly.o: /usr/include/vm/faultcode.h -perly.o: EXTERN.h -perly.o: av.h -perly.o: config.h -perly.o: cop.h -perly.o: cv.h -perly.o: embed.h -perly.o: form.h -perly.o: gv.h -perly.o: handy.h -perly.o: hv.h -perly.o: mg.h -perly.o: op.h -perly.o: opcode.h -perly.o: perl.h -perly.o: perly.c -perly.o: pp.h -perly.o: proto.h -perly.o: regexp.h -perly.o: scope.h -perly.o: sv.h -perly.o: unixish.h -perly.o: util.h -pp.o: /usr/include/ctype.h -pp.o: /usr/include/dirent.h -pp.o: /usr/include/errno.h -pp.o: /usr/include/grp.h -pp.o: /usr/include/machine/param.h -pp.o: /usr/include/machine/setjmp.h -pp.o: /usr/include/netdb.h -pp.o: /usr/include/netinet/in.h -pp.o: /usr/include/pwd.h -pp.o: /usr/include/setjmp.h -pp.o: /usr/include/stdio.h -pp.o: /usr/include/sys/dirent.h -pp.o: /usr/include/sys/errno.h -pp.o: /usr/include/sys/fcntlcom.h -pp.o: /usr/include/sys/file.h -pp.o: /usr/include/sys/filio.h -pp.o: /usr/include/sys/ioccom.h -pp.o: /usr/include/sys/ioctl.h -pp.o: /usr/include/sys/param.h -pp.o: /usr/include/sys/signal.h -pp.o: /usr/include/sys/socket.h -pp.o: /usr/include/sys/sockio.h -pp.o: /usr/include/sys/stat.h -pp.o: /usr/include/sys/stdtypes.h -pp.o: /usr/include/sys/sysmacros.h -pp.o: /usr/include/sys/time.h -pp.o: /usr/include/sys/times.h -pp.o: /usr/include/sys/ttold.h -pp.o: /usr/include/sys/ttychars.h -pp.o: /usr/include/sys/ttycom.h -pp.o: /usr/include/sys/ttydev.h -pp.o: /usr/include/sys/types.h -pp.o: /usr/include/time.h -pp.o: /usr/include/utime.h -pp.o: /usr/include/varargs.h -pp.o: /usr/include/vm/faultcode.h -pp.o: EXTERN.h -pp.o: av.h -pp.o: config.h -pp.o: cop.h -pp.o: cv.h -pp.o: embed.h -pp.o: form.h -pp.o: gv.h -pp.o: handy.h -pp.o: hv.h -pp.o: mg.h -pp.o: op.h -pp.o: opcode.h -pp.o: perl.h -pp.o: pp.c -pp.o: pp.h -pp.o: proto.h -pp.o: regexp.h -pp.o: scope.h -pp.o: sv.h -pp.o: unixish.h -pp.o: util.h -regcomp.o: /usr/include/ctype.h -regcomp.o: /usr/include/dirent.h -regcomp.o: /usr/include/errno.h -regcomp.o: /usr/include/machine/param.h -regcomp.o: /usr/include/machine/setjmp.h -regcomp.o: /usr/include/netinet/in.h -regcomp.o: /usr/include/setjmp.h -regcomp.o: /usr/include/stdio.h -regcomp.o: /usr/include/sys/dirent.h -regcomp.o: /usr/include/sys/errno.h -regcomp.o: /usr/include/sys/filio.h -regcomp.o: /usr/include/sys/ioccom.h -regcomp.o: /usr/include/sys/ioctl.h -regcomp.o: /usr/include/sys/param.h -regcomp.o: /usr/include/sys/signal.h -regcomp.o: /usr/include/sys/sockio.h -regcomp.o: /usr/include/sys/stat.h -regcomp.o: /usr/include/sys/stdtypes.h -regcomp.o: /usr/include/sys/sysmacros.h -regcomp.o: /usr/include/sys/time.h -regcomp.o: /usr/include/sys/times.h -regcomp.o: /usr/include/sys/ttold.h -regcomp.o: /usr/include/sys/ttychars.h -regcomp.o: /usr/include/sys/ttycom.h -regcomp.o: /usr/include/sys/ttydev.h -regcomp.o: /usr/include/sys/types.h -regcomp.o: /usr/include/time.h -regcomp.o: /usr/include/varargs.h -regcomp.o: /usr/include/vm/faultcode.h -regcomp.o: EXTERN.h -regcomp.o: INTERN.h -regcomp.o: av.h -regcomp.o: config.h -regcomp.o: cop.h -regcomp.o: cv.h -regcomp.o: embed.h -regcomp.o: form.h -regcomp.o: gv.h -regcomp.o: handy.h -regcomp.o: hv.h -regcomp.o: mg.h -regcomp.o: op.h -regcomp.o: opcode.h -regcomp.o: perl.h -regcomp.o: pp.h -regcomp.o: proto.h -regcomp.o: regcomp.c -regcomp.o: regcomp.h -regcomp.o: regexp.h -regcomp.o: scope.h -regcomp.o: sv.h -regcomp.o: unixish.h -regcomp.o: util.h -regexec.o: /usr/include/ctype.h -regexec.o: /usr/include/dirent.h -regexec.o: /usr/include/errno.h -regexec.o: /usr/include/machine/param.h -regexec.o: /usr/include/machine/setjmp.h -regexec.o: /usr/include/netinet/in.h -regexec.o: /usr/include/setjmp.h -regexec.o: /usr/include/stdio.h -regexec.o: /usr/include/sys/dirent.h -regexec.o: /usr/include/sys/errno.h -regexec.o: /usr/include/sys/filio.h -regexec.o: /usr/include/sys/ioccom.h -regexec.o: /usr/include/sys/ioctl.h -regexec.o: /usr/include/sys/param.h -regexec.o: /usr/include/sys/signal.h -regexec.o: /usr/include/sys/sockio.h -regexec.o: /usr/include/sys/stat.h -regexec.o: /usr/include/sys/stdtypes.h -regexec.o: /usr/include/sys/sysmacros.h -regexec.o: /usr/include/sys/time.h -regexec.o: /usr/include/sys/times.h -regexec.o: /usr/include/sys/ttold.h -regexec.o: /usr/include/sys/ttychars.h -regexec.o: /usr/include/sys/ttycom.h -regexec.o: /usr/include/sys/ttydev.h -regexec.o: /usr/include/sys/types.h -regexec.o: /usr/include/time.h -regexec.o: /usr/include/varargs.h -regexec.o: /usr/include/vm/faultcode.h -regexec.o: EXTERN.h -regexec.o: av.h -regexec.o: config.h -regexec.o: cop.h -regexec.o: cv.h -regexec.o: embed.h -regexec.o: form.h -regexec.o: gv.h -regexec.o: handy.h -regexec.o: hv.h -regexec.o: mg.h -regexec.o: op.h -regexec.o: opcode.h -regexec.o: perl.h -regexec.o: pp.h -regexec.o: proto.h -regexec.o: regcomp.h -regexec.o: regexec.c -regexec.o: regexp.h -regexec.o: scope.h -regexec.o: sv.h -regexec.o: unixish.h -regexec.o: util.h -gv.o: /usr/include/ctype.h -gv.o: /usr/include/dirent.h -gv.o: /usr/include/errno.h -gv.o: /usr/include/machine/param.h -gv.o: /usr/include/machine/setjmp.h -gv.o: /usr/include/netinet/in.h -gv.o: /usr/include/setjmp.h -gv.o: /usr/include/stdio.h -gv.o: /usr/include/sys/dirent.h -gv.o: /usr/include/sys/errno.h -gv.o: /usr/include/sys/filio.h -gv.o: /usr/include/sys/ioccom.h -gv.o: /usr/include/sys/ioctl.h -gv.o: /usr/include/sys/param.h -gv.o: /usr/include/sys/signal.h -gv.o: /usr/include/sys/sockio.h -gv.o: /usr/include/sys/stat.h -gv.o: /usr/include/sys/stdtypes.h -gv.o: /usr/include/sys/sysmacros.h -gv.o: /usr/include/sys/time.h -gv.o: /usr/include/sys/times.h -gv.o: /usr/include/sys/ttold.h -gv.o: /usr/include/sys/ttychars.h -gv.o: /usr/include/sys/ttycom.h -gv.o: /usr/include/sys/ttydev.h -gv.o: /usr/include/sys/types.h -gv.o: /usr/include/time.h -gv.o: /usr/include/varargs.h -gv.o: /usr/include/vm/faultcode.h -gv.o: EXTERN.h -gv.o: av.h -gv.o: config.h -gv.o: cop.h -gv.o: cv.h -gv.o: embed.h -gv.o: form.h -gv.o: gv.c -gv.o: gv.h -gv.o: handy.h -gv.o: hv.h -gv.o: mg.h -gv.o: op.h -gv.o: opcode.h -gv.o: perl.h -gv.o: pp.h -gv.o: proto.h -gv.o: regexp.h -gv.o: scope.h -gv.o: sv.h -gv.o: unixish.h -gv.o: util.h -sv.o: /usr/include/ctype.h -sv.o: /usr/include/dirent.h -sv.o: /usr/include/errno.h -sv.o: /usr/include/machine/param.h -sv.o: /usr/include/machine/setjmp.h -sv.o: /usr/include/netinet/in.h -sv.o: /usr/include/setjmp.h -sv.o: /usr/include/stdio.h -sv.o: /usr/include/sys/dirent.h -sv.o: /usr/include/sys/errno.h -sv.o: /usr/include/sys/filio.h -sv.o: /usr/include/sys/ioccom.h -sv.o: /usr/include/sys/ioctl.h -sv.o: /usr/include/sys/param.h -sv.o: /usr/include/sys/signal.h -sv.o: /usr/include/sys/sockio.h -sv.o: /usr/include/sys/stat.h -sv.o: /usr/include/sys/stdtypes.h -sv.o: /usr/include/sys/sysmacros.h -sv.o: /usr/include/sys/time.h -sv.o: /usr/include/sys/times.h -sv.o: /usr/include/sys/ttold.h -sv.o: /usr/include/sys/ttychars.h -sv.o: /usr/include/sys/ttycom.h -sv.o: /usr/include/sys/ttydev.h -sv.o: /usr/include/sys/types.h -sv.o: /usr/include/time.h -sv.o: /usr/include/varargs.h -sv.o: /usr/include/vm/faultcode.h -sv.o: EXTERN.h -sv.o: av.h -sv.o: config.h -sv.o: cop.h -sv.o: cv.h -sv.o: embed.h -sv.o: form.h -sv.o: gv.h -sv.o: handy.h -sv.o: hv.h -sv.o: mg.h -sv.o: op.h -sv.o: opcode.h -sv.o: perl.h -sv.o: perly.h -sv.o: pp.h -sv.o: proto.h -sv.o: regexp.h -sv.o: scope.h -sv.o: sv.c -sv.o: sv.h -sv.o: unixish.h -sv.o: util.h -taint.o: /usr/include/ctype.h -taint.o: /usr/include/dirent.h -taint.o: /usr/include/errno.h -taint.o: /usr/include/machine/param.h -taint.o: /usr/include/machine/setjmp.h -taint.o: /usr/include/netinet/in.h -taint.o: /usr/include/setjmp.h -taint.o: /usr/include/stdio.h -taint.o: /usr/include/sys/dirent.h -taint.o: /usr/include/sys/errno.h -taint.o: /usr/include/sys/filio.h -taint.o: /usr/include/sys/ioccom.h -taint.o: /usr/include/sys/ioctl.h -taint.o: /usr/include/sys/param.h -taint.o: /usr/include/sys/signal.h -taint.o: /usr/include/sys/sockio.h -taint.o: /usr/include/sys/stat.h -taint.o: /usr/include/sys/stdtypes.h -taint.o: /usr/include/sys/sysmacros.h -taint.o: /usr/include/sys/time.h -taint.o: /usr/include/sys/times.h -taint.o: /usr/include/sys/ttold.h -taint.o: /usr/include/sys/ttychars.h -taint.o: /usr/include/sys/ttycom.h -taint.o: /usr/include/sys/ttydev.h -taint.o: /usr/include/sys/types.h -taint.o: /usr/include/time.h -taint.o: /usr/include/varargs.h -taint.o: /usr/include/vm/faultcode.h -taint.o: EXTERN.h -taint.o: av.h -taint.o: config.h -taint.o: cop.h -taint.o: cv.h -taint.o: embed.h -taint.o: form.h -taint.o: gv.h -taint.o: handy.h -taint.o: hv.h -taint.o: mg.h -taint.o: op.h -taint.o: opcode.h -taint.o: perl.h -taint.o: pp.h -taint.o: proto.h -taint.o: regexp.h -taint.o: scope.h -taint.o: sv.h -taint.o: taint.c -taint.o: unixish.h -taint.o: util.h -toke.o: /usr/include/ctype.h -toke.o: /usr/include/dirent.h -toke.o: /usr/include/errno.h -toke.o: /usr/include/machine/param.h -toke.o: /usr/include/machine/setjmp.h -toke.o: /usr/include/netinet/in.h -toke.o: /usr/include/setjmp.h -toke.o: /usr/include/stdio.h -toke.o: /usr/include/sys/dirent.h -toke.o: /usr/include/sys/errno.h -toke.o: /usr/include/sys/fcntlcom.h -toke.o: /usr/include/sys/file.h -toke.o: /usr/include/sys/filio.h -toke.o: /usr/include/sys/ioccom.h -toke.o: /usr/include/sys/ioctl.h -toke.o: /usr/include/sys/param.h -toke.o: /usr/include/sys/signal.h -toke.o: /usr/include/sys/sockio.h -toke.o: /usr/include/sys/stat.h -toke.o: /usr/include/sys/stdtypes.h -toke.o: /usr/include/sys/sysmacros.h -toke.o: /usr/include/sys/time.h -toke.o: /usr/include/sys/times.h -toke.o: /usr/include/sys/ttold.h -toke.o: /usr/include/sys/ttychars.h -toke.o: /usr/include/sys/ttycom.h -toke.o: /usr/include/sys/ttydev.h -toke.o: /usr/include/sys/types.h -toke.o: /usr/include/time.h -toke.o: /usr/include/varargs.h -toke.o: /usr/include/vm/faultcode.h -toke.o: EXTERN.h -toke.o: av.h -toke.o: config.h -toke.o: cop.h -toke.o: cv.h -toke.o: embed.h -toke.o: form.h -toke.o: gv.h -toke.o: handy.h -toke.o: hv.h -toke.o: keywords.h -toke.o: mg.h -toke.o: op.h -toke.o: opcode.h -toke.o: perl.h -toke.o: perly.h -toke.o: pp.h -toke.o: proto.h -toke.o: regexp.h -toke.o: scope.h -toke.o: sv.h -toke.o: toke.c -toke.o: unixish.h -toke.o: util.h -util.o: /usr/include/ctype.h -util.o: /usr/include/dirent.h -util.o: /usr/include/errno.h -util.o: /usr/include/machine/param.h -util.o: /usr/include/machine/setjmp.h -util.o: /usr/include/netinet/in.h -util.o: /usr/include/setjmp.h -util.o: /usr/include/stdio.h -util.o: /usr/include/sys/dirent.h -util.o: /usr/include/sys/errno.h -util.o: /usr/include/sys/fcntlcom.h -util.o: /usr/include/sys/file.h -util.o: /usr/include/sys/filio.h -util.o: /usr/include/sys/ioccom.h -util.o: /usr/include/sys/ioctl.h -util.o: /usr/include/sys/param.h -util.o: /usr/include/sys/signal.h -util.o: /usr/include/sys/sockio.h -util.o: /usr/include/sys/stat.h -util.o: /usr/include/sys/stdtypes.h -util.o: /usr/include/sys/sysmacros.h -util.o: /usr/include/sys/time.h -util.o: /usr/include/sys/times.h -util.o: /usr/include/sys/ttold.h -util.o: /usr/include/sys/ttychars.h -util.o: /usr/include/sys/ttycom.h -util.o: /usr/include/sys/ttydev.h -util.o: /usr/include/sys/types.h -util.o: /usr/include/time.h -util.o: /usr/include/unistd.h -util.o: /usr/include/varargs.h -util.o: /usr/include/vm/faultcode.h -util.o: EXTERN.h -util.o: av.h -util.o: config.h -util.o: cop.h -util.o: cv.h -util.o: embed.h -util.o: form.h -util.o: gv.h -util.o: handy.h -util.o: hv.h -util.o: mg.h -util.o: op.h -util.o: opcode.h -util.o: perl.h -util.o: pp.h -util.o: proto.h -util.o: regexp.h -util.o: scope.h -util.o: sv.h -util.o: unixish.h -util.o: util.c -util.o: util.h -deb.o: /usr/include/ctype.h -deb.o: /usr/include/dirent.h -deb.o: /usr/include/errno.h -deb.o: /usr/include/machine/param.h -deb.o: /usr/include/machine/setjmp.h -deb.o: /usr/include/netinet/in.h -deb.o: /usr/include/setjmp.h -deb.o: /usr/include/stdio.h -deb.o: /usr/include/sys/dirent.h -deb.o: /usr/include/sys/errno.h -deb.o: /usr/include/sys/filio.h -deb.o: /usr/include/sys/ioccom.h -deb.o: /usr/include/sys/ioctl.h -deb.o: /usr/include/sys/param.h -deb.o: /usr/include/sys/signal.h -deb.o: /usr/include/sys/sockio.h -deb.o: /usr/include/sys/stat.h -deb.o: /usr/include/sys/stdtypes.h -deb.o: /usr/include/sys/sysmacros.h -deb.o: /usr/include/sys/time.h -deb.o: /usr/include/sys/times.h -deb.o: /usr/include/sys/ttold.h -deb.o: /usr/include/sys/ttychars.h -deb.o: /usr/include/sys/ttycom.h -deb.o: /usr/include/sys/ttydev.h -deb.o: /usr/include/sys/types.h -deb.o: /usr/include/time.h -deb.o: /usr/include/varargs.h -deb.o: /usr/include/vm/faultcode.h -deb.o: EXTERN.h -deb.o: av.h -deb.o: config.h -deb.o: cop.h -deb.o: cv.h -deb.o: deb.c -deb.o: embed.h -deb.o: form.h -deb.o: gv.h -deb.o: handy.h -deb.o: hv.h -deb.o: mg.h -deb.o: op.h -deb.o: opcode.h -deb.o: perl.h -deb.o: pp.h -deb.o: proto.h -deb.o: regexp.h -deb.o: scope.h -deb.o: sv.h -deb.o: unixish.h -deb.o: util.h -run.o: /usr/include/ctype.h -run.o: /usr/include/dirent.h -run.o: /usr/include/errno.h -run.o: /usr/include/machine/param.h -run.o: /usr/include/machine/setjmp.h -run.o: /usr/include/netinet/in.h -run.o: /usr/include/setjmp.h -run.o: /usr/include/stdio.h -run.o: /usr/include/sys/dirent.h -run.o: /usr/include/sys/errno.h -run.o: /usr/include/sys/filio.h -run.o: /usr/include/sys/ioccom.h -run.o: /usr/include/sys/ioctl.h -run.o: /usr/include/sys/param.h -run.o: /usr/include/sys/signal.h -run.o: /usr/include/sys/sockio.h -run.o: /usr/include/sys/stat.h -run.o: /usr/include/sys/stdtypes.h -run.o: /usr/include/sys/sysmacros.h -run.o: /usr/include/sys/time.h -run.o: /usr/include/sys/times.h -run.o: /usr/include/sys/ttold.h -run.o: /usr/include/sys/ttychars.h -run.o: /usr/include/sys/ttycom.h -run.o: /usr/include/sys/ttydev.h -run.o: /usr/include/sys/types.h -run.o: /usr/include/time.h -run.o: /usr/include/varargs.h -run.o: /usr/include/vm/faultcode.h -run.o: EXTERN.h -run.o: av.h -run.o: config.h -run.o: cop.h -run.o: cv.h -run.o: embed.h -run.o: form.h -run.o: gv.h -run.o: handy.h -run.o: hv.h -run.o: mg.h -run.o: op.h -run.o: opcode.h -run.o: perl.h -run.o: pp.h -run.o: proto.h -run.o: regexp.h -run.o: run.c -run.o: scope.h -run.o: sv.h -run.o: unixish.h -run.o: util.h -dl_sunos.o: /usr/include/ctype.h -dl_sunos.o: /usr/include/dirent.h -dl_sunos.o: /usr/include/dlfcn.h -dl_sunos.o: /usr/include/errno.h -dl_sunos.o: /usr/include/machine/param.h -dl_sunos.o: /usr/include/machine/setjmp.h -dl_sunos.o: /usr/include/netinet/in.h -dl_sunos.o: /usr/include/setjmp.h -dl_sunos.o: /usr/include/stdio.h -dl_sunos.o: /usr/include/sys/dirent.h -dl_sunos.o: /usr/include/sys/errno.h -dl_sunos.o: /usr/include/sys/filio.h -dl_sunos.o: /usr/include/sys/ioccom.h -dl_sunos.o: /usr/include/sys/ioctl.h -dl_sunos.o: /usr/include/sys/param.h -dl_sunos.o: /usr/include/sys/signal.h -dl_sunos.o: /usr/include/sys/sockio.h -dl_sunos.o: /usr/include/sys/stat.h -dl_sunos.o: /usr/include/sys/stdtypes.h -dl_sunos.o: /usr/include/sys/sysmacros.h -dl_sunos.o: /usr/include/sys/time.h -dl_sunos.o: /usr/include/sys/times.h -dl_sunos.o: /usr/include/sys/ttold.h -dl_sunos.o: /usr/include/sys/ttychars.h -dl_sunos.o: /usr/include/sys/ttycom.h -dl_sunos.o: /usr/include/sys/ttydev.h -dl_sunos.o: /usr/include/sys/types.h -dl_sunos.o: /usr/include/time.h -dl_sunos.o: /usr/include/varargs.h -dl_sunos.o: /usr/include/vm/faultcode.h -dl_sunos.o: EXTERN.h -dl_sunos.o: XSUB.h -dl_sunos.o: av.h -dl_sunos.o: config.h -dl_sunos.o: cop.h -dl_sunos.o: cv.h -dl_sunos.o: dl_sunos.c -dl_sunos.o: embed.h -dl_sunos.o: form.h -dl_sunos.o: gv.h -dl_sunos.o: handy.h -dl_sunos.o: hv.h -dl_sunos.o: mg.h -dl_sunos.o: op.h -dl_sunos.o: opcode.h -dl_sunos.o: perl.h -dl_sunos.o: pp.h -dl_sunos.o: proto.h -dl_sunos.o: regexp.h -dl_sunos.o: scope.h -dl_sunos.o: sv.h -dl_sunos.o: unixish.h -dl_sunos.o: util.h -miniperlmain.o: /usr/include/ctype.h -miniperlmain.o: /usr/include/dirent.h -miniperlmain.o: /usr/include/errno.h -miniperlmain.o: /usr/include/machine/param.h -miniperlmain.o: /usr/include/machine/setjmp.h -miniperlmain.o: /usr/include/netinet/in.h -miniperlmain.o: /usr/include/setjmp.h -miniperlmain.o: /usr/include/stdio.h -miniperlmain.o: /usr/include/sys/dirent.h -miniperlmain.o: /usr/include/sys/errno.h -miniperlmain.o: /usr/include/sys/filio.h -miniperlmain.o: /usr/include/sys/ioccom.h -miniperlmain.o: /usr/include/sys/ioctl.h -miniperlmain.o: /usr/include/sys/param.h -miniperlmain.o: /usr/include/sys/signal.h -miniperlmain.o: /usr/include/sys/sockio.h -miniperlmain.o: /usr/include/sys/stat.h -miniperlmain.o: /usr/include/sys/stdtypes.h -miniperlmain.o: /usr/include/sys/sysmacros.h -miniperlmain.o: /usr/include/sys/time.h -miniperlmain.o: /usr/include/sys/times.h -miniperlmain.o: /usr/include/sys/ttold.h -miniperlmain.o: /usr/include/sys/ttychars.h -miniperlmain.o: /usr/include/sys/ttycom.h -miniperlmain.o: /usr/include/sys/ttydev.h -miniperlmain.o: /usr/include/sys/types.h -miniperlmain.o: /usr/include/time.h -miniperlmain.o: /usr/include/varargs.h -miniperlmain.o: /usr/include/vm/faultcode.h -miniperlmain.o: INTERN.h -miniperlmain.o: av.h -miniperlmain.o: config.h -miniperlmain.o: cop.h -miniperlmain.o: cv.h -miniperlmain.o: embed.h -miniperlmain.o: form.h -miniperlmain.o: gv.h -miniperlmain.o: handy.h -miniperlmain.o: hv.h -miniperlmain.o: mg.h -miniperlmain.o: miniperlmain.c -miniperlmain.o: op.h -miniperlmain.o: opcode.h -miniperlmain.o: perl.h -miniperlmain.o: pp.h -miniperlmain.o: proto.h -miniperlmain.o: regexp.h -miniperlmain.o: scope.h -miniperlmain.o: sv.h -miniperlmain.o: unixish.h -miniperlmain.o: util.h -perlmain.o: /usr/include/ctype.h -perlmain.o: /usr/include/dirent.h -perlmain.o: /usr/include/errno.h -perlmain.o: /usr/include/machine/param.h -perlmain.o: /usr/include/machine/setjmp.h -perlmain.o: /usr/include/netinet/in.h -perlmain.o: /usr/include/setjmp.h -perlmain.o: /usr/include/stdio.h -perlmain.o: /usr/include/sys/dirent.h -perlmain.o: /usr/include/sys/errno.h -perlmain.o: /usr/include/sys/filio.h -perlmain.o: /usr/include/sys/ioccom.h -perlmain.o: /usr/include/sys/ioctl.h -perlmain.o: /usr/include/sys/param.h -perlmain.o: /usr/include/sys/signal.h -perlmain.o: /usr/include/sys/sockio.h -perlmain.o: /usr/include/sys/stat.h -perlmain.o: /usr/include/sys/stdtypes.h -perlmain.o: /usr/include/sys/sysmacros.h -perlmain.o: /usr/include/sys/time.h -perlmain.o: /usr/include/sys/times.h -perlmain.o: /usr/include/sys/ttold.h -perlmain.o: /usr/include/sys/ttychars.h -perlmain.o: /usr/include/sys/ttycom.h -perlmain.o: /usr/include/sys/ttydev.h -perlmain.o: /usr/include/sys/types.h -perlmain.o: /usr/include/time.h -perlmain.o: /usr/include/varargs.h -perlmain.o: /usr/include/vm/faultcode.h -perlmain.o: INTERN.h -perlmain.o: av.h -perlmain.o: config.h -perlmain.o: cop.h -perlmain.o: cv.h -perlmain.o: embed.h -perlmain.o: form.h -perlmain.o: gv.h -perlmain.o: handy.h -perlmain.o: hv.h -perlmain.o: mg.h -perlmain.o: op.h -perlmain.o: opcode.h -perlmain.o: perl.h -perlmain.o: perlmain.c -perlmain.o: pp.h -perlmain.o: proto.h -perlmain.o: regexp.h -perlmain.o: scope.h -perlmain.o: sv.h -perlmain.o: unixish.h -perlmain.o: util.h -Makefile: Makefile.SH config.sh ; /bin/sh Makefile.SH -cflags: cflags.SH config.sh ; /bin/sh cflags.SH -embed_h: embed_h.SH config.sh ; /bin/sh embed_h.SH -makedepend: makedepend.SH config.sh ; /bin/sh makedepend.SH -makedir: makedir.SH config.sh ; /bin/sh makedir.SH -writemain: writemain.SH config.sh ; /bin/sh writemain.SH -# WARNING: Put nothing here or make depend will gobble it up! diff --git a/malloc.c b/malloc.c index a2631ae..ef095c5 100644 --- a/malloc.c +++ b/malloc.c @@ -1,31 +1,8 @@ -/* $RCSfile: malloc.c,v $$Revision: 4.1 $$Date: 92/08/07 18:24:25 $ +/* malloc.c * - * $Log: malloc.c,v $ - * Revision 4.1 92/08/07 18:24:25 lwall - * - * Revision 4.0.1.4 92/06/08 14:28:38 lwall - * patch20: removed implicit int declarations on functions - * patch20: hash tables now split only if the memory is available to do so - * patch20: realloc(0, size) now does malloc in case library routines call it - * - * Revision 4.0.1.3 91/11/05 17:57:40 lwall - * patch11: safe malloc code now integrated into Perl's malloc when possible - * - * Revision 4.0.1.2 91/06/07 11:20:45 lwall - * patch4: many, many itty-bitty portability fixes - * - * Revision 4.0.1.1 91/04/11 17:48:31 lwall - * patch1: Configure now figures out malloc ptr type - * - * Revision 4.0 91/03/20 01:28:52 lwall - * 4.0 baseline. - * */ #ifndef lint -/*SUPPRESS 592*/ -static char sccsid[] = "@(#)malloc.c 4.3 (Berkeley) 9/16/83"; - #ifdef DEBUGGING #define RCHECK #endif @@ -44,9 +21,6 @@ static char sccsid[] = "@(#)malloc.c 4.3 (Berkeley) 9/16/83"; #include "EXTERN.h" #include "perl.h" -static int findbucket(); -static int morecore(); - /* I don't much care whether these are defined in sys/types.h--LAW */ #define u_char unsigned char @@ -81,6 +55,12 @@ union overhead { #define ov_rmagic ovu.ovu_rmagic }; +#ifdef debug +static void botch _((char *s)); +#endif +static void morecore _((int bucket)); +static int findbucket _((union overhead *freep, int srchlen)); + #define MAGIC 0xff /* magic # on accounting info */ #define RMAGIC 0x55555555 /* magic # on range info */ #ifdef RCHECK @@ -176,21 +156,15 @@ malloc(nbytes) } #ifdef safemalloc -#if !(defined(I286) || defined(atarist)) - DEBUG_m(fprintf(stderr,"0x%x: (%05d) malloc %ld bytes\n",p+1,an++,(long)size)); -#else - DEBUG_m(fprintf(stderr,"0x%lx: (%05d) malloc %ld bytes\n",p+1,an++,(long)size)); -#endif + DEBUG_m(fprintf(stderr,"0x%lx: (%05d) malloc %ld bytes\n", + (unsigned long)(p+1),an++,(long)size)); #endif /* safemalloc */ /* remove from linked list */ #ifdef RCHECK if (*((int*)p) & (sizeof(union overhead) - 1)) -#if !(defined(I286) || defined(atarist)) - fprintf(stderr,"Corrupt malloc ptr 0x%x at 0x%x\n",*((int*)p),p); -#else - fprintf(stderr,"Corrupt malloc ptr 0x%lx at 0x%lx\n",*((int*)p),p); -#endif + fprintf(stderr,"Corrupt malloc ptr 0x%lx at 0x%lx\n", + (unsigned long)*((int*)p),(unsigned long)p); #endif nextf[bucket] = p->ov_next; p->ov_magic = MAGIC; @@ -214,7 +188,7 @@ malloc(nbytes) /* * Allocate more memory to the indicated bucket. */ -static +static void morecore(bucket) register int bucket; { @@ -288,11 +262,7 @@ free(mp) char *cp = (char*)mp; #ifdef safemalloc -#if !(defined(I286) || defined(atarist)) - DEBUG_m(fprintf(stderr,"0x%x: (%05d) free\n",cp,an++)); -#else - DEBUG_m(fprintf(stderr,"0x%lx: (%05d) free\n",cp,an++)); -#endif + DEBUG_m(fprintf(stderr,"0x%lx: (%05d) free\n",(unsigned long)cp,an++)); #endif /* safemalloc */ if (cp == NULL) @@ -425,17 +395,11 @@ realloc(mp, nbytes) #ifdef safemalloc #ifdef DEBUGGING -# if !(defined(I286) || defined(atarist)) - if (debug & 128) { - fprintf(stderr,"0x%x: (%05d) rfree\n",res,an++); - fprintf(stderr,"0x%x: (%05d) realloc %ld bytes\n",res,an++,(long)size); - } -# else - if (debug & 128) { - fprintf(stderr,"0x%lx: (%05d) rfree\n",res,an++); - fprintf(stderr,"0x%lx: (%05d) realloc %ld bytes\n",res,an++,(long)size); - } -# endif + if (debug & 128) { + fprintf(stderr,"0x%lx: (%05d) rfree\n",(unsigned long)res,an++); + fprintf(stderr,"0x%lx: (%05d) realloc %ld bytes\n", + (unsigned long)res,an++,(long)size); + } #endif #endif /* safemalloc */ return ((Malloc_t)res); diff --git a/mg.c b/mg.c index da11119..45016a6 100644 --- a/mg.c +++ b/mg.c @@ -1,16 +1,26 @@ -/* $RCSfile: hash.c,v $$Revision: 4.1 $$Date: 92/08/07 18:21:48 $ +/* mg.c * - * Copyright (c) 1993, Larry Wall + * Copyright (c) 1991-1994, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. * - * $Log: hash.c,v $ + */ + +/* + * "Sam sat on the ground and put his head in his hands. 'I wish I had never + * come here, and I don't want to see no more magic,' he said, and fell silent." */ #include "EXTERN.h" #include "perl.h" +/* Omit -- it causes too much grief on mixed systems. +#ifdef I_UNISTD +# include +#endif +*/ + void mg_magical(sv) SV* sv; @@ -19,7 +29,7 @@ SV* sv; for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { MGVTBL* vtbl = mg->mg_virtual; if (vtbl) { - if (vtbl->svt_get) + if (vtbl->svt_get && !(mg->mg_flags & MGf_GSKIP)) SvGMAGICAL_on(sv); if (vtbl->svt_set) SvSMAGICAL_on(sv); @@ -34,20 +44,28 @@ mg_get(sv) SV* sv; { MAGIC* mg; - U32 savemagic = SvMAGICAL(sv); + U32 savemagic = SvMAGICAL(sv) | SvREADONLY(sv); + assert(SvGMAGICAL(sv)); SvMAGICAL_off(sv); + SvREADONLY_off(sv); SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT; for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { MGVTBL* vtbl = mg->mg_virtual; - if (vtbl && vtbl->svt_get) + if (!(mg->mg_flags & MGf_GSKIP) && vtbl && vtbl->svt_get) { (*vtbl->svt_get)(sv, mg); + if (mg->mg_flags & MGf_GSKIP) + savemagic = 0; + } } - SvFLAGS(sv) |= savemagic; - assert(SvGMAGICAL(sv)); - SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK); + if (savemagic) + SvFLAGS(sv) |= savemagic; + else + mg_magical(sv); + if (SvGMAGICAL(sv)) + SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK); return 0; } @@ -65,12 +83,19 @@ SV* sv; for (mg = SvMAGIC(sv); mg; mg = nextmg) { MGVTBL* vtbl = mg->mg_virtual; nextmg = mg->mg_moremagic; /* it may delete itself */ + if (mg->mg_flags & MGf_GSKIP) { + mg->mg_flags &= ~MGf_GSKIP; /* setting requires another read */ + savemagic = 0; + } if (vtbl && vtbl->svt_set) (*vtbl->svt_set)(sv, mg); } if (SvMAGIC(sv)) { - SvFLAGS(sv) |= savemagic; + if (savemagic) + SvFLAGS(sv) |= savemagic; + else + mg_magical(sv); if (SvGMAGICAL(sv)) SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK); } @@ -94,6 +119,7 @@ SV* sv; SvMAGICAL_off(sv); SvFLAGS(sv) |= (SvFLAGS(sv)&(SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT; + /* omit MGf_GSKIP -- not changed here */ len = (*vtbl->svt_len)(sv, mg); SvFLAGS(sv) |= savemagic; @@ -120,6 +146,8 @@ SV* sv; for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { MGVTBL* vtbl = mg->mg_virtual; + /* omit GSKIP -- never set here */ + if (vtbl && vtbl->svt_clear) (*vtbl->svt_clear)(sv, mg); } @@ -132,13 +160,9 @@ SV* sv; } MAGIC* -#ifndef STANDARD_C mg_find(sv, type) SV* sv; -char type; -#else -mg_find(SV *sv, char type) -#endif /* STANDARD_C */ +int type; { MAGIC* mg; for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { @@ -159,7 +183,7 @@ STRLEN klen; MAGIC* mg; for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { if (isUPPER(mg->mg_type)) { - sv_magic(nsv, mg->mg_obj, tolower(mg->mg_type), key, klen); + sv_magic(nsv, mg->mg_obj, toLOWER(mg->mg_type), key, klen); count++; } } @@ -222,6 +246,8 @@ MAGIC *mg; case '+': if (curpm) { paren = curpm->op_pmregexp->lastparen; + if (!paren) + return 0; goto getparen; } break; @@ -278,6 +304,9 @@ MAGIC *mg; case '\006': /* ^F */ sv_setiv(sv,(I32)maxsysfd); break; + case '\010': /* ^H */ + sv_setiv(sv,(I32)hints); + break; case '\t': /* ^I */ if (inplace) sv_setpv(sv, inplace); @@ -300,7 +329,8 @@ MAGIC *mg; getparen: if (curpm->op_pmregexp && paren <= curpm->op_pmregexp->nparens && - (s = curpm->op_pmregexp->startp[paren]) ) { + (s = curpm->op_pmregexp->startp[paren]) && + curpm->op_pmregexp->endp[paren] ) { i = curpm->op_pmregexp->endp[paren] - s; if (i >= 0) sv_setpvn(sv,s,i); @@ -314,7 +344,10 @@ MAGIC *mg; case '+': if (curpm) { paren = curpm->op_pmregexp->lastparen; - goto getparen; + if (paren) + goto getparen; + else + sv_setsv(sv,&sv_undef); } break; case '`': @@ -343,7 +376,7 @@ MAGIC *mg; break; case '.': #ifndef lint - if (last_in_gv && GvIO(last_in_gv)) { + if (GvIO(last_in_gv)) { sv_setiv(sv,(I32)IoLINES(GvIO(last_in_gv))); } #endif @@ -352,7 +385,7 @@ MAGIC *mg; sv_setiv(sv,(I32)statusvalue); break; case '^': - s = IoTOP_NAME(GvIO(defoutgv)); + s = IoTOP_NAME(GvIOp(defoutgv)); if (s) sv_setpv(sv,s); else { @@ -361,20 +394,20 @@ MAGIC *mg; } break; case '~': - s = IoFMT_NAME(GvIO(defoutgv)); + s = IoFMT_NAME(GvIOp(defoutgv)); if (!s) s = GvENAME(defoutgv); sv_setpv(sv,s); break; #ifndef lint case '=': - sv_setiv(sv,(I32)IoPAGE_LEN(GvIO(defoutgv))); + sv_setiv(sv,(I32)IoPAGE_LEN(GvIOp(defoutgv))); break; case '-': - sv_setiv(sv,(I32)IoLINES_LEFT(GvIO(defoutgv))); + sv_setiv(sv,(I32)IoLINES_LEFT(GvIOp(defoutgv))); break; case '%': - sv_setiv(sv,(I32)IoPAGE(GvIO(defoutgv))); + sv_setiv(sv,(I32)IoPAGE(GvIOp(defoutgv))); break; #endif case ':': @@ -382,12 +415,10 @@ MAGIC *mg; case '/': break; case '[': - sv_setiv(sv,(I32)arybase); + sv_setiv(sv,(I32)curcop->cop_arybase); break; case '|': - if (!GvIO(defoutgv)) - GvIO(defoutgv) = newIO(); - sv_setiv(sv, (IoFLAGS(GvIO(defoutgv)) & IOf_FLUSH) != 0 ); + sv_setiv(sv, (IoFLAGS(GvIOp(defoutgv)) & IOf_FLUSH) != 0 ); break; case ',': sv_setpvn(sv,ofs,ofslen); @@ -423,7 +454,7 @@ MAGIC *mg; #define NGROUPS 32 #endif { - GROUPSTYPE gary[NGROUPS]; + Groups_t gary[NGROUPS]; i = getgroups(NGROUPS,gary); while (--i >= 0) { @@ -439,6 +470,7 @@ MAGIC *mg; case '0': break; } + return 0; } int @@ -459,20 +491,30 @@ SV* sv; MAGIC* mg; { register char *s; - U32 i; - s = SvPV(sv,na); + STRLEN len; + I32 i; + s = SvPV(sv,len); my_setenv(mg->mg_ptr,s); +#ifdef DYNAMIC_ENV_FETCH + /* We just undefd an environment var. Is a replacement */ + /* waiting in the wings? */ + if (!len) { + SV **envsvp; + if (envsvp = hv_fetch(GvHVn(envgv),mg->mg_ptr,mg->mg_len,FALSE)) + s = SvPV(*envsvp,len); + } +#endif /* And you'll never guess what the dog had */ /* in its mouth... */ if (tainting) { if (s && strEQ(mg->mg_ptr,"PATH")) { - char *strend = SvEND(sv); + char *strend = s + len; while (s < strend) { s = cpytill(tokenbuf,s,strend,':',&i); s++; if (*tokenbuf != '/' - || (stat(tokenbuf,&statbuf) && (statbuf.st_mode & 2)) ) + || (Stat(tokenbuf,&statbuf) && (statbuf.st_mode & 2)) ) MgTAINTEDDIR_on(mg); } } @@ -496,10 +538,15 @@ MAGIC* mg; { register char *s; I32 i; - s = SvPV(sv,na); + i = whichsig(mg->mg_ptr); /* ...no, a brick */ if (!i && (dowarn || strEQ(mg->mg_ptr,"ALARM"))) warn("No such signal: SIG%s", mg->mg_ptr); + if (SvTYPE(sv) == SVt_PVGV || SvROK(sv)) { + (void)signal(i,sighandler); + return 0; + } + s = SvPV_force(sv,na); if (strEQ(s,"IGNORE")) #ifndef lint (void)signal(i,SIG_IGN); @@ -527,49 +574,55 @@ MAGIC* mg; return 0; } +#ifdef OVERLOAD + int -magic_getpack(sv,mg) +magic_setamagic(sv,mg) SV* sv; MAGIC* mg; { - SV* rv = mg->mg_obj; - HV* stash = SvSTASH(SvRV(rv)); - GV* gv = gv_fetchmethod(stash, "fetch"); - dSP; - BINOP myop; + /* HV_badAMAGIC_on(Sv_STASH(sv)); */ + amagic_generation++; - if (!gv || !GvCV(gv)) { - croak("No fetch method for magical variable in package \"%s\"", - HvNAME(stash)); - } - Zero(&myop, 1, BINOP); - myop.op_last = (OP *) &myop; - myop.op_next = Nullop; - myop.op_flags = OPf_STACKED; + return 0; +} +#endif /* OVERLOAD */ - ENTER; - SAVESPTR(op); - op = (OP *) &myop; - PUTBACK; - pp_pushmark(); +static int +magic_methpack(sv,mg,meth) +SV* sv; +MAGIC* mg; +char *meth; +{ + dSP; - EXTEND(sp, 4); - PUSHs(gv); - PUSHs(rv); + ENTER; + SAVETMPS; + PUSHMARK(sp); + EXTEND(sp, 2); + PUSHs(mg->mg_obj); if (mg->mg_ptr) - PUSHs(sv_mortalcopy(newSVpv(mg->mg_ptr, mg->mg_len))); - else if (mg->mg_len >= 0) - PUSHs(sv_mortalcopy(newSViv(mg->mg_len))); + PUSHs(sv_2mortal(newSVpv(mg->mg_ptr, mg->mg_len))); + else if (mg->mg_type == 'p') + PUSHs(sv_2mortal(newSViv(mg->mg_len))); PUTBACK; - if (op = pp_entersubr()) - run(); - LEAVE; - SPAGAIN; + if (perl_call_method(meth, G_SCALAR)) + sv_setsv(sv, *stack_sp--); - sv_setsv(sv, POPs); - PUTBACK; + FREETMPS; + LEAVE; + return 0; +} +int +magic_getpack(sv,mg) +SV* sv; +MAGIC* mg; +{ + magic_methpack(sv,mg,"FETCH"); + if (mg->mg_ptr) + mg->mg_flags |= MGf_GSKIP; return 0; } @@ -578,44 +631,19 @@ magic_setpack(sv,mg) SV* sv; MAGIC* mg; { - SV* rv = mg->mg_obj; - HV* stash = SvSTASH(SvRV(rv)); - GV* gv = gv_fetchmethod(stash, "store"); dSP; - BINOP myop; - - if (!gv || !GvCV(gv)) { - croak("No store method for magical variable in package \"%s\"", - HvNAME(stash)); - } - Zero(&myop, 1, BINOP); - myop.op_last = (OP *) &myop; - myop.op_next = Nullop; - myop.op_flags = OPf_STACKED; - - ENTER; - SAVESPTR(op); - op = (OP *) &myop; - PUTBACK; - pp_pushmark(); - EXTEND(sp, 4); - PUSHs(gv); - PUSHs(rv); + PUSHMARK(sp); + EXTEND(sp, 3); + PUSHs(mg->mg_obj); if (mg->mg_ptr) - PUSHs(sv_mortalcopy(newSVpv(mg->mg_ptr, mg->mg_len))); - else if (mg->mg_len >= 0) - PUSHs(sv_mortalcopy(newSViv(mg->mg_len))); + PUSHs(sv_2mortal(newSVpv(mg->mg_ptr, mg->mg_len))); + else if (mg->mg_type == 'p') + PUSHs(sv_2mortal(newSViv(mg->mg_len))); PUSHs(sv); PUTBACK; - if (op = pp_entersubr()) - run(); - LEAVE; - SPAGAIN; - - POPs; - PUTBACK; + perl_call_method("STORE", G_SCALAR|G_DISCARD); return 0; } @@ -625,43 +653,20 @@ magic_clearpack(sv,mg) SV* sv; MAGIC* mg; { - SV* rv = mg->mg_obj; - HV* stash = SvSTASH(SvRV(rv)); - GV* gv = gv_fetchmethod(stash, "delete"); - dSP; - BINOP myop; + return magic_methpack(sv,mg,"DELETE"); +} - if (!gv || !GvCV(gv)) { - croak("No delete method for magical variable in package \"%s\"", - HvNAME(stash)); - } - Zero(&myop, 1, BINOP); - myop.op_last = (OP *) &myop; - myop.op_next = Nullop; - myop.op_flags = OPf_STACKED; +int magic_wipepack(sv,mg) +SV* sv; +MAGIC* mg; +{ + dSP; - ENTER; - SAVESPTR(op); - op = (OP *) &myop; + PUSHMARK(sp); + XPUSHs(mg->mg_obj); PUTBACK; - pp_pushmark(); - EXTEND(sp, 4); - PUSHs(gv); - PUSHs(rv); - if (mg->mg_ptr) - PUSHs(sv_mortalcopy(newSVpv(mg->mg_ptr, mg->mg_len))); - else - PUSHs(sv_mortalcopy(newSViv(mg->mg_len))); - PUTBACK; - - if (op = pp_entersubr()) - run(); - LEAVE; - SPAGAIN; - - sv_setsv(sv, POPs); - PUTBACK; + perl_call_method("CLEAR", G_SCALAR|G_DISCARD); return 0; } @@ -672,46 +677,35 @@ SV* sv; MAGIC* mg; SV* key; { - SV* rv = mg->mg_obj; - HV* stash = SvSTASH(SvRV(rv)); - GV* gv = gv_fetchmethod(stash, SvOK(key) ? "nextkey" : "firstkey"); dSP; - BINOP myop; - - if (!gv || !GvCV(gv)) { - croak("No fetch method for magical variable in package \"%s\"", - HvNAME(stash)); - } - Zero(&myop, 1, BINOP); - myop.op_last = (OP *) &myop; - myop.op_next = Nullop; - myop.op_flags = OPf_STACKED; + char *meth = SvOK(key) ? "NEXTKEY" : "FIRSTKEY"; ENTER; - SAVESPTR(op); - op = (OP *) &myop; - PUTBACK; - pp_pushmark(); - - EXTEND(sp, 4); - PUSHs(gv); - PUSHs(rv); + SAVETMPS; + PUSHMARK(sp); + EXTEND(sp, 2); + PUSHs(mg->mg_obj); if (SvOK(key)) PUSHs(key); PUTBACK; - if (op = pp_entersubr()) - run(); - LEAVE; - SPAGAIN; - - sv_setsv(key, POPs); - PUTBACK; + if (perl_call_method(meth, G_SCALAR)) + sv_setsv(key, *stack_sp--); + FREETMPS; + LEAVE; return 0; } int +magic_existspack(sv,mg) +SV* sv; +MAGIC* mg; +{ + return magic_methpack(sv,mg,"EXISTS"); +} + +int magic_setdbline(sv,mg) SV* sv; MAGIC* mg; @@ -736,7 +730,7 @@ magic_getarylen(sv,mg) SV* sv; MAGIC* mg; { - sv_setiv(sv, AvFILL((AV*)mg->mg_obj) + arybase); + sv_setiv(sv, AvFILL((AV*)mg->mg_obj) + curcop->cop_arybase); return 0; } @@ -745,7 +739,63 @@ magic_setarylen(sv,mg) SV* sv; MAGIC* mg; { - av_fill((AV*)mg->mg_obj, (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) - arybase); + av_fill((AV*)mg->mg_obj, SvIV(sv) - curcop->cop_arybase); + return 0; +} + +int +magic_getpos(sv,mg) +SV* sv; +MAGIC* mg; +{ + SV* lsv = LvTARG(sv); + + if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv)) { + mg = mg_find(lsv, 'g'); + if (mg && mg->mg_len >= 0) { + sv_setiv(sv, mg->mg_len + curcop->cop_arybase); + return 0; + } + } + (void)SvOK_off(sv); + return 0; +} + +int +magic_setpos(sv,mg) +SV* sv; +MAGIC* mg; +{ + SV* lsv = LvTARG(sv); + SSize_t pos; + STRLEN len; + + mg = 0; + + if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv)) + mg = mg_find(lsv, 'g'); + if (!mg) { + if (!SvOK(sv)) + return 0; + sv_magic(lsv, (SV*)0, 'g', Nullch, 0); + mg = mg_find(lsv, 'g'); + } + else if (!SvOK(sv)) { + mg->mg_len = -1; + return 0; + } + len = SvPOK(lsv) ? SvCUR(lsv) : sv_len(lsv); + + pos = SvIV(sv) - curcop->cop_arybase; + if (pos < 0) { + pos += len; + if (pos < 0) + pos = 0; + } + else if (pos > len) + pos = len; + mg->mg_len = pos; + return 0; } @@ -781,8 +831,8 @@ MAGIC* mg; gv_AVadd(gv); if (!GvHV(gv)) gv_HVadd(gv); - if (!GvIO(gv)) - GvIO(gv) = newIO(); + if (!GvIOp(gv)) + GvIOp(gv) = newIO(); return 0; } @@ -811,8 +861,11 @@ magic_settaint(sv,mg) SV* sv; MAGIC* mg; { - if (!tainted) + if (!tainted) { + if (!SvMAGICAL(sv)) + SvMAGICAL_on(sv); sv_unmagic(sv, 't'); + } return 0; } @@ -830,8 +883,7 @@ magic_setmglob(sv,mg) SV* sv; MAGIC* mg; { - mg->mg_ptr = 0; - mg->mg_len = 0; + mg->mg_len = -1; return 0; } @@ -873,11 +925,14 @@ MAGIC* mg; case '\006': /* ^F */ maxsysfd = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); break; + case '\010': /* ^H */ + hints = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); + break; case '\t': /* ^I */ if (inplace) Safefree(inplace); if (SvOK(sv)) - inplace = savestr(SvPV(sv,na)); + inplace = savepv(SvPV(sv,na)); else inplace = Nullch; break; @@ -901,35 +956,33 @@ MAGIC* mg; if (localizing) save_sptr((SV**)&last_in_gv); else if (SvOK(sv)) - IoLINES(GvIO(last_in_gv)) = (long)SvIV(sv); + IoLINES(GvIOp(last_in_gv)) = (long)SvIV(sv); break; case '^': - Safefree(IoTOP_NAME(GvIO(defoutgv))); - IoTOP_NAME(GvIO(defoutgv)) = s = savestr(SvPV(sv,na)); - IoTOP_GV(GvIO(defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO); + Safefree(IoTOP_NAME(GvIOp(defoutgv))); + IoTOP_NAME(GvIOp(defoutgv)) = s = savepv(SvPV(sv,na)); + IoTOP_GV(GvIOp(defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO); break; case '~': - Safefree(IoFMT_NAME(GvIO(defoutgv))); - IoFMT_NAME(GvIO(defoutgv)) = s = savestr(SvPV(sv,na)); - IoFMT_GV(GvIO(defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO); + Safefree(IoFMT_NAME(GvIOp(defoutgv))); + IoFMT_NAME(GvIOp(defoutgv)) = s = savepv(SvPV(sv,na)); + IoFMT_GV(GvIOp(defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO); break; case '=': - IoPAGE_LEN(GvIO(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)); + IoPAGE_LEN(GvIOp(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)); break; case '-': - IoLINES_LEFT(GvIO(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)); - if (IoLINES_LEFT(GvIO(defoutgv)) < 0L) - IoLINES_LEFT(GvIO(defoutgv)) = 0L; + IoLINES_LEFT(GvIOp(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)); + if (IoLINES_LEFT(GvIOp(defoutgv)) < 0L) + IoLINES_LEFT(GvIOp(defoutgv)) = 0L; break; case '%': - IoPAGE(GvIO(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)); + IoPAGE(GvIOp(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)); break; case '|': - if (!GvIO(defoutgv)) - GvIO(defoutgv) = newIO(); - IoFLAGS(GvIO(defoutgv)) &= ~IOf_FLUSH; + IoFLAGS(GvIOp(defoutgv)) &= ~IOf_FLUSH; if ((SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) != 0) { - IoFLAGS(GvIO(defoutgv)) |= IOf_FLUSH; + IoFLAGS(GvIOp(defoutgv)) |= IOf_FLUSH; } break; case '*': @@ -937,8 +990,8 @@ MAGIC* mg; multiline = (i != 0); break; case '/': - if (SvPOK(sv)) { - nrs = rs = SvPV(sv,rslen); + if (SvOK(sv)) { + nrs = rs = SvPV_force(sv,rslen); nrslen = rslen; if (rspara = !rslen) { nrs = rs = "\n\n"; @@ -954,20 +1007,20 @@ MAGIC* mg; case '\\': if (ors) Safefree(ors); - ors = savestr(SvPV(sv,orslen)); + ors = savepv(SvPV(sv,orslen)); break; case ',': if (ofs) Safefree(ofs); - ofs = savestr(SvPV(sv, ofslen)); + ofs = savepv(SvPV(sv, ofslen)); break; case '#': if (ofmt) Safefree(ofmt); - ofmt = savestr(SvPV(sv,na)); + ofmt = savepv(SvPV(sv,na)); break; case '[': - arybase = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); + compiling.cop_arybase = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv); break; case '?': statusvalue = U_S(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)); @@ -991,8 +1044,10 @@ MAGIC* mg; #else if (uid == euid) /* special case $< = $> */ (void)setuid(uid); - else + else { + uid = (I32)getuid(); croak("setruid() not implemented"); + } #endif #endif #endif @@ -1016,8 +1071,10 @@ MAGIC* mg; #else if (euid == uid) /* special case $> = $< */ setuid(euid); - else + else { + euid = (I32)geteuid(); croak("seteuid() not implemented"); + } #endif #endif #endif @@ -1075,7 +1132,7 @@ MAGIC* mg; tainting |= (euid != uid || egid != gid); break; case ':': - chopset = SvPV(sv,na); + chopset = SvPV_force(sv,na); break; case '0': if (!origalen) { @@ -1095,7 +1152,7 @@ MAGIC* mg; } origalen = s - origargv[0]; } - s = SvPV(sv,len); + s = SvPV_force(sv,len); i = len; if (i >= origalen) { i = origalen; @@ -1140,36 +1197,34 @@ char *sig; VOIDRET sighandler(sig) -I32 sig; +int sig; { dSP; GV *gv; + HV *st; SV *sv; CV *cv; - CONTEXT *cx; AV *oldstack; - I32 hasargs = 1; - I32 items = 1; - I32 gimme = G_SCALAR; #ifdef OS2 /* or anybody else who requires SIG_ACK */ signal(sig, SIG_ACK); #endif - gv = gv_fetchpv( - SvPVx(*hv_fetch(GvHVn(siggv),sig_name[sig],strlen(sig_name[sig]), - TRUE), na), TRUE, SVt_PVCV); - cv = GvCV(gv); - if (!cv && *sig_name[sig] == 'C' && instr(sig_name[sig],"LD")) { + cv = sv_2cv(*hv_fetch(GvHVn(siggv),sig_name[sig],strlen(sig_name[sig]), + TRUE), + &st, &gv, TRUE); + if (!cv || !CvROOT(cv) && + *sig_name[sig] == 'C' && instr(sig_name[sig],"LD")) { + if (sig_name[sig][1] == 'H') - gv = gv_fetchpv(SvPVx(*hv_fetch(GvHVn(siggv),"CLD",3,TRUE), na), - TRUE, SVt_PVCV); + cv = sv_2cv(*hv_fetch(GvHVn(siggv),"CLD",3,TRUE), + &st, &gv, TRUE); else - gv = gv_fetchpv(SvPVx(*hv_fetch(GvHVn(siggv),"CHLD",4,TRUE), na), - TRUE, SVt_PVCV); - cv = GvCV(gv); /* gag */ + cv = sv_2cv(*hv_fetch(GvHVn(siggv),"CHLD",4,TRUE), + &st, &gv, TRUE); + /* gag */ } - if (!cv) { + if (!cv || !CvROOT(cv)) { if (dowarn) warn("SIG%s handler \"%s\" not defined.\n", sig_name[sig], GvENAME(gv) ); @@ -1177,34 +1232,19 @@ I32 sig; } oldstack = stack; + if (stack != signalstack) + AvFILL(signalstack) = 0; SWITCHSTACK(stack, signalstack); sv = sv_newmortal(); sv_setpv(sv,sig_name[sig]); + PUSHMARK(sp); PUSHs(sv); - - ENTER; - SAVETMPS; - - push_return(op); - push_return(0); - PUSHBLOCK(cx, CXt_SUB, sp); - PUSHSUB(cx); - cx->blk_sub.savearray = GvAV(defgv); - cx->blk_sub.argarray = av_fake(items, sp); - SAVEFREESV(cx->blk_sub.argarray); - GvAV(defgv) = cx->blk_sub.argarray; - CvDEPTH(cv)++; - if (CvDEPTH(cv) >= 2) { - if (CvDEPTH(cv) == 100 && dowarn) - warn("Deep recursion on subroutine \"%s\"",GvENAME(gv)); - } - op = CvSTART(cv); PUTBACK; - run(); /* Does the LEAVE for us. */ + + perl_call_sv((SV*)cv, G_DISCARD); SWITCHSTACK(signalstack, oldstack); - op = pop_return(); return; } diff --git a/mg.h b/mg.h index b2cd7d6..a7d217c 100644 --- a/mg.h +++ b/mg.h @@ -1,19 +1,18 @@ -/* $RCSfile: arg.h,v $$Revision: 4.1 $$Date: 92/08/07 17:18:16 $ +/* mg.h * - * Copyright (c) 1993, Larry Wall + * Copyright (c) 1991-1994, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. * - * $Log: arg.h,v $ */ struct mgvtbl { - int (*svt_get) P((SV *sv, MAGIC* mg)); - int (*svt_set) P((SV *sv, MAGIC* mg)); - U32 (*svt_len) P((SV *sv, MAGIC* mg)); - int (*svt_clear) P((SV *sv, MAGIC* mg)); - int (*svt_free) P((SV *sv, MAGIC* mg)); + int (*svt_get) _((SV *sv, MAGIC* mg)); + int (*svt_set) _((SV *sv, MAGIC* mg)); + U32 (*svt_len) _((SV *sv, MAGIC* mg)); + int (*svt_clear) _((SV *sv, MAGIC* mg)); + int (*svt_free) _((SV *sv, MAGIC* mg)); }; struct magic { @@ -29,5 +28,6 @@ struct magic { #define MGf_TAINTEDDIR 1 #define MGf_REFCOUNTED 2 +#define MGf_GSKIP 4 #define MgTAINTEDDIR(mg) (mg->mg_flags & MGf_TAINTEDDIR) #define MgTAINTEDDIR_on(mg) (mg->mg_flags |= MGf_TAINTEDDIR) diff --git a/miniperlmain.c b/miniperlmain.c index 0e1b0f9..44c3d71 100644 --- a/miniperlmain.c +++ b/miniperlmain.c @@ -1,26 +1,42 @@ +/* + * "The Road goes ever on and on, down from the door where it began." + */ + #include "INTERN.h" #include "perl.h" +static void xs_init _((void)); +static PerlInterpreter *my_perl; + +/* This value may be raised by extensions for testing purposes */ +int perl_destruct_level = 0; /* 0=none, 1=full, 2=full with checks */ + +int main(argc, argv, env) int argc; char **argv; char **env; { int exitstatus; - PerlInterpreter *my_perl; - my_perl = perl_alloc(); - if (!my_perl) - exit(1); - perl_construct( my_perl ); +#ifdef VMS + getredirection(&argc,&argv); +#endif + + if (!do_undump) { + my_perl = perl_alloc(); + if (!my_perl) + exit(1); + perl_construct( my_perl ); + } - exitstatus = perl_parse( my_perl, argc, argv, env ); + exitstatus = perl_parse( my_perl, xs_init, argc, argv, env ); if (exitstatus) exit( exitstatus ); exitstatus = perl_run( my_perl ); - perl_destruct( my_perl ); + perl_destruct( my_perl, perl_destruct_level ); perl_free( my_perl ); exit( exitstatus ); @@ -28,9 +44,8 @@ char **env; /* Register any extra external extensions */ -void -perl_init_ext() +static void +xs_init() { - char *file = __FILE__; /* Do not delete this line--writemain depends on it */ } diff --git a/miniperlmain.x b/miniperlmain.x deleted file mode 100644 index e69de29..0000000 diff --git a/msdos/Changes.dds b/msdos/Changes.dds deleted file mode 100644 index 1eed759..0000000 --- a/msdos/Changes.dds +++ /dev/null @@ -1,57 +0,0 @@ -These are the changes done by the `patches' file: - -[These patches have been applied, more or less, so I don't supply the -patches file--law] - -Compilation of some portions is done conditional on the definition -of the following symbols: - -BINARY Enables the usage of setmode under MSDOS (added binmode command) -BUGGY_MSC Adds #pragma_function(memset) to avoid internal compiler error -CHOWN Enables chown -CHROOT Enables chroot -FORK Enables fork and changes the compilation of system -GETLOGIN Enables getlogin -GETPPID Enables getppid -GROUP Enables all the group access functions -KILL Enables kill -LINK Enables link -PASSWD Enables all the password access functions -PIPE Enables the pipe function -WAIT Enables the wait function -UMASK Enables the umask function - -S_IFBLK * Enables the block special device check -S_ISGID * Enables the setgid check -S_ISUID * Enables the setuid check -S_ISVTX * Enables the vtx check -unix * Compiles globbing for Unix -MSDOS * Compiles globbing for MS-DOS - Closes stdaux and stdprn on startup - Adds a copyright message for -v - Disables the compilation of my_popen, my_pclose as the - are in a separate file. - -Symbols marked with * are defined in the compilation environment. The -rest should be added to config.h (config.h.SH). All functions when not -supported give a fatal error. - -Added documentation for the binmode function in the manual. - -Fixed the following bugs: - -In eval.c function eval if ioctl or fcntl returned something -other than 0 or -1 the result was a random number as the -double `value' variable wasn't set to `anum'. - -In doio.c function do_exec there were two errors associated with -firing up the shell when the execv fails. First argv was not freed, -secondly an attempt was made to start up the shell with the cmd -string that was now cut to pieces for the execv. Also the maxible -possible length of argv was calculated by (s - cmd). Problem was -that s was not pointing to the end of the string, but to the first -non alpha. - -[These are incorporated in patches 15 and 16--law] - -Diomidis Spinellis, March 1990 diff --git a/msdos/Makefile b/msdos/Makefile deleted file mode 100644 index eeb15e8..0000000 --- a/msdos/Makefile +++ /dev/null @@ -1,101 +0,0 @@ -# -# Makefile for compiling Perl under MS-DOS -# -# Needs a Unix compatible make. -# This makefile works for an initial compilation. It does not -# include all dependencies and thus is unsuitable for serious -# development work. But who would do serious development under -# MS-DOS? -# -# By Diomidis Spinellis, March 1990 -# - -# Source files -SRC = array.c cmd.c cons.c consarg.c doarg.c doio.c dolist.c dump.c \ -eval.c form.c hash.c perl.y perly.c regcomp.c regexec.c \ -stab.c str.c toke.c util.c msdos.c popen.c directory.c - -# Object files -OBJ = perl.obj array.obj cmd.obj cons.obj consarg.obj doarg.obj doio.obj \ -dolist.obj dump.obj eval.obj form.obj hash.obj perly.obj regcomp.obj \ -regexec.obj stab.obj str.obj toke.obj util.obj msdos.obj popen.obj \ -directory.obj - -# Files in the MS-DOS distribution -DOSFILES=config.h dir.h director.c glob.c makefile msdos.c popen.c readme.msd \ -changes.dds wishlist.dds patches manifest - -# Yacc flags -YFLAGS=-d - -# Manual pages -MAN=perlman.1 perlman.2 perlman.3 perlman.4 - -CC=cc -# Cflags for the files that break under the optimiser -CPLAIN=-AL -DCRIPPLED_CC -# Cflags for all the rest -CFLAGS=$(CPLAIN) -Ox -# Destination directory for executables -DESTDIR=\usr\bin - -# Deliverables -all: perl.exe perl.1 glob.exe - -perl.exe: $(OBJ) - echo array+cmd+cons+consarg+doarg+doio+dolist+dump+ >perl.arp - echo eval+form+hash+perl+perly+regcomp+regexec+ >>perl.arp - echo stab+str+toke+util+msdos+popen+directory+\lib\setargv >>perl.arp - echo perl.exe >>perl.arp - echo nul >>perl.arp - echo /stack:32767 /NOE >>perl.arp - link @perl.arp - -glob.exe: glob.c - $(CC) glob.c \lib\setargv.obj -link /NOE - -array.obj: array.c -cmd.obj: cmd.c -cons.obj: cons.c perly.h -consarg.obj: consarg.c - $(CC) $(CPLAIN) -c consarg.c -doarg.obj: doarg.c -doio.obj: doio.c -dolist.obj: dolist.c -dump.obj: dump.c -eval.obj: eval.c evalargs.xc -form.obj: form.c -hash.obj: hash.c -perl.obj: perl.y -perly.obj: perly.c -regcomp.obj: regcomp.c -regexec.obj: regexec.c -stab.obj: stab.c -str.obj: str.c -toke.obj: toke.c -util.obj: util.c - $(CC) $(CPLAIN) -c util.c -perly.h: perl.obj - mv ytab.h perly.h -directory.obj: directory.c -popen.obj: popen.c -msdos.obj: msdos.c - -perl.1: $(MAN) - nroff -man $(MAN) >perl.1 - -install: all - exepack perl.exe $(DESTDIR)\perl.exe - exepack glob.exe $(DESTDIR)\glob.exe - -clean: - rm -f *.obj *.exe perl.1 perly.h perl.arp - -tags: - ctags *.c *.h *.xc - -dosperl: - mv $(DOSFILES) ../perl30.new - -doskit: - mv $(DOSFILES) ../msdos diff --git a/msdos/README.msdos b/msdos/README.msdos deleted file mode 100644 index 3a5c38f..0000000 --- a/msdos/README.msdos +++ /dev/null @@ -1,195 +0,0 @@ - Notes on the MS-DOS Perl port - - Diomidis Spinellis - (dds@cc.ic.ac.uk) - -[0. First copy the files in the msdos directory into the parent -directory--law] - -1. Compiling. - - Perl has been compiled under MS-DOS using the Microsoft -C compiler version 5.1. Before compiling install dir.h as -. You will need a Unix-like make program (e.g. -pdmake) and something like yacc (e.g. bison). You could get -away by running yacc and dry running make on a Unix host, -but I haven't tried it. Compilation takes 12 minutes on a -20MHz 386 machine (together with formating the manual), so -you will probably need something to do in the meantime. The -executable is 272k and the top level directory needs 1M for -sources and about the same ammount for the object code and -the executables. - - The makefile will compile glob for you which you will -need to place somewhere in your path so that perl globbing -will work correctly. I have not tried all the tests or the -examples, nor the awk and sed to Perl translators. You are -on your own with them. In the eg directory I have included -an example program that uses ioctl to display the charac- -teristics of the storage devices of the system. - -2. Using MS-DOS Perl - - The MS-DOS version of perl has most of the functional- -ity of the Unix version. Functions that can not be provided -under MS-DOS like sockets, password and host database -access, fork and wait have been ommited and will terminate -with a fatal error. Care has been taken to implement the -rest. In particular directory access, redirection (includ- -ing pipes, but excluding the pipe function), system, ioctl -and sleep have been provided. - -[Files currently can be edited in-place provided you are cre- -ating a backup. However, if the backup coincidentally has -the same name as the original, or if the resulting backup -filename is invalid, then the file will probably be trashed. -For example, don't do - - perl -i~ script makefile - perl -i.bak script file.dat - -because (1) MS-DOS treats "makefile~" and "makefile" as the -same filename, and (2) "file.dat.bak" is an invalid filename. -The files "makefile" and "file.dat" will probably be lost -forever. Moral of the story: Don't use in-place editing -under MS-DOS. --rjc] - -2.1. Interface to the MS-DOS ioctl system call. - - The function code of the ioctl function (the second -argument) is encoded as follows: - -- The lowest nibble of the function code goes to AL. -- The two middle nibbles go to CL. -- The high nibble goes to CH. - - The return code is -1 in the case of an error and if -successful: - -- for functions AL = 00, 09, 0a the value of the register DX -- for functions AL = 02 - 08, 0e the value of the register AX -- for functions AL = 01, 0b - 0f the number 0. - - See the perl manual for instruction on how to distin- -guish between the return value and the success of ioctl. - - Some ioctl functions need a number as the first argu- -ment. Provided that no other files have been opened the -number can be obtained if ioctl is called with -@fdnum[number] as the first argument after executing the -following code: - - @fdnum = ("STDIN", "STDOUT", "STDERR"); - $maxdrives = 15; - for ($i = 3; $i < $maxdrives; $i++) { - open("FD$i", "nul"); - @fdnum[$i - 1] = "FD$i"; - } - -2.2. Binary file access - - Files are opened in text mode by default. This means -that CR LF pairs are translated to LF. If binary access is -needed the `binary' function should be used. There is -currently no way to reverse the effect of the binary func- -tion. If that is needed close and reopen the file. - -2.3. Interpreter startup. - - The effect of the Unix #!/bin/perl interpreter startup -can be obtained under MS-DOS by giving the script a .bat -extension and using the following lines on its begining: - - @REM=(" - @perl %0.bat %1 %2 %3 %4 %5 %6 %7 %8 %9 - @end ") if 0 ; - -(Note that you will probably want an absolute path name in -front of %0.bat). - - March 1990 - - Diomidis Spinellis - Myrsinis 1 - GR-145 62 Kifissia - Greece - --------------------------------------------------------------------------- - - Revisions to the MS-DOS support in Perl 4.0 - Tom Dinger, 18 March 1991 - -The DOS compatibility added to Perl sometime in release 3.x was not -maintained, and Perl as distributed could not be built without changes. - -Both myself and Len Reed more or less "rediscovered" how to get Perl built -and running reliably for MS-DOS, using the Microsoft C compiler. He and I -have communicated, and will be putting together additional patches for the -DOS version of Perl. - -1. Compiling Perl - - For now, I have not supplied a makefile, as there is no standard for - make utilities under DOS. All the files can be compiled with Microsoft - C 5.1, using the switches "-AL -Ox" for Large memory model, maximum - optimization (this turned out a few code generation bugs in MSC 5.1). - The code will also compile with MSC 6.00A, with the optimization - "-Oacegils /Gs" for all files (regcomp.c has special case code to change - the aliasing optimizations). - - Generally, you follow the instructions given above to compile and build - Perl 4.0 for DOS. I used the output of SunOS yacc run on perly.y, - without modification, but I expect both Bison and Berkeley-YACC will work - also. From inspection of the generated code, however, I believe AT&T - derived YACC produces the smallest tables, i.e. uses the least memory. - This is important for a 300K executable file. - -2. Editing in-place. - - You will need the file suffix.c from the os2 subdirectory -- it will - create a backup file with much less danger for DOS. - -3. A "Smarter" chdir() function. - - I have added to the DOS version of Perl 4.0 a replacement chdir() - function. Unlike the "normal" behavior, it is aware of drive letters - at the start of paths for DOS. So for example: - - perl_chdir( "B:" ) changes to the default directory, on drive B: - perl_chdir( "C:\FOO" ) changes to the specified directory, on drive C: - perl_chdir( "\BAR" ) changes to the specified directory on the - current drive. - -4. *.BAT Scripts as Perl scripts - - The strategy described above for turning a Perl script into a *.BAT - script do not work. I have been using the following lines at the - beginning of a Perl *.BAT script: - - @REM=(qq! - @perl -S %0.bat %1 %2 %3 %4 %5 %6 %7 %8 %9 - @goto end !) if 0 ; - - and the following at the end of the *.BAT script: - - @REM=(qq! - :end !) if 0 ; - - If you like, with the proper editor you can replace the four '!' - characters with some untypeable character, such as Ctrl-A. This will - allow you to pass any characters, including ".." strings as arguments. - -4. Things to Come - - * Better temporary file handling. - * A real Makefile -- Len Reed has one for Dmake 3.6 - * Swapping code -- swaps most of Perl out of memory (to EMS, XMS or - disk) before running a sub-program or pipe. - * MKS command line support, both into Perl, and to other programs - spawned by Perl. - * Smarter pipe functions, not using COMMAND.COM. - - - Tom Dinger - tdinger@East.Sun.COM - Martch 18, 1991 diff --git a/msdos/Wishlist.dds b/msdos/Wishlist.dds deleted file mode 100644 index d06de11..0000000 --- a/msdos/Wishlist.dds +++ /dev/null @@ -1,17 +0,0 @@ -Perl in general: -Add ftw or find? -Add a parsing mechanism (user specifies parse tree, perl parses). -Arbitrary precision arithmetic. -File calculus (e.g. file1 = file2 + file3, file1 =^ s/foo/bar/g etc.) - -MS-DOS version of Perl: -Add interface to treat dBase files as associative arrays. -Add int86x function. -Handle the C preprocessor. -Provide real pipes by switching the processes. (difficult) -Provide a list of ioctl codes. -Check the ioctl errno handling. -I can't find an easy way in Perl to pass a number as the first argument - to ioctl. This is needed for some functions of ioctl. Either hack - ioctl, or change perl to ioctl interface. Another solution would be - a perl pseudo array containing the filehandles indexed by fd. diff --git a/msdos/chdir.c b/msdos/chdir.c deleted file mode 100644 index b650eb0..0000000 --- a/msdos/chdir.c +++ /dev/null @@ -1,96 +0,0 @@ -/* - * (C) Copyright 1990, 1991 Tom Dinger - * - * You may distribute under the terms of either the GNU General Public - * License or the Artistic License, as specified in the README file. - * - */ - -/* - * A "DOS-aware" chdir() function, that will change current drive as well. - * - * chdir( "B:" ) -- changes to the default directory, on drive B: - * chdir( "C:\FOO" ) changes to the specified directory, on drive C: - * chdir( "\BAR" ) changes to the specified directory on the current - * drive. - */ - -#include -#include -#include -#include -#include - -#include "config.h" -#ifdef chdir -#undef chdir -#endif - -/* We should have the line: - * - * #define chdir perl_chdir - * - * in some header for perl (I put it in config.h) so that all - * references to chdir() become references to this function. - */ - -/*------------------------------------------------------------------*/ - -#if defined(BUGGY_MSC5) /* only needed for MSC 5.1 */ - -int _chdrive( int drivenum ) -{ -unsigned int ndrives; -unsigned int tmpdrive; - - -_dos_setdrive( drivenum, &ndrives ); - -/* check for illegal drive letter */ -_dos_getdrive( &tmpdrive ); - -return (tmpdrive != drivenum) ? -1 : 0 ; -} - -#endif - -/*-----------------------------------------------------------------*/ - -int perl_chdir( char * path ) -{ -int drive_letter; -unsigned int drivenum; - - -if ( path && *path && (path[1] == ':') ) - { - /* The path starts with a drive letter */ - /* Change current drive */ - drive_letter = *path; - if ( isalpha(drive_letter) ) - { - /* Drive letter legal */ - if ( islower(drive_letter) ) - drive_letter = toupper(drive_letter); - drivenum = drive_letter - 'A' + 1; - - /* Change drive */ - if ( _chdrive( drivenum ) == -1 ) - { - /* Drive change failed -- must be illegal drive letter */ - errno = ENODEV; - return -1; - } - - /* Now see if that's all we do */ - if ( ! path[2] ) - return 0; /* no path after drive -- all done */ - } - /* else drive letter illegal -- fall into "normal" chdir */ - } - -/* Here with some path as well */ -return chdir( path ); - -/* end perl_chdir() */ -} diff --git a/msdos/config.h b/msdos/config.h deleted file mode 100644 index 7131d63..0000000 --- a/msdos/config.h +++ /dev/null @@ -1,938 +0,0 @@ -#ifndef config_h -#define config_h -/* config.h - * - * This file is hand tailored for MS-DOS and MSC 5.1 and 6.00A. - * Tom Dinger, March 1991. - */ - - -/* - * BUGGY_MSC5: - * This symbol is defined if you are the unfortunate owner of the buggy - * Microsoft C compiler version 5.1. It is used as a conditional to - * guard code sections that are known to break this compiler. - * BUGGY_MSC6: - * This symbol is defined if you are the unfortunate owner of the buggy - * Microsoft C compiler version 6.0A. It is used as a conditional to - * guard code sections that are known to break this compiler. - */ -#define BUGGY_MSC5 /**/ -/*#undef BUGGY_MSC6 /**/ - - -/* EUNICE - * This symbol, if defined, indicates that the program is being compiled - * under the EUNICE package under VMS. The program will need to handle - * things like files that don't go away the first time you unlink them, - * due to version numbering. It will also need to compensate for lack - * of a respectable link() command. - */ -/* VMS - * This symbol, if defined, indicates that the program is running under - * VMS. It is currently only set in conjunction with the EUNICE symbol. - */ -/*#undef EUNICE /**/ -/*#undef VMS /**/ - -/* ALIGNBYTES - * This symbol contains the number of bytes required to align a double. - * Usual values are 2, 4, and 8. - */ -#define ALIGNBYTES 4 /**/ - -/* BIN - * This symbol holds the name of the directory in which the user wants - * to keep publicly executable images for the package in question. It - * is most often a local directory such as /usr/local/bin. - */ -#define BIN "/usr/local/bin" /**/ - -/* BYTEORDER - * This symbol contains an encoding of the order of bytes in a long. - * Usual values (in octal) are 01234, 04321, 02143, 03412... - */ -#define BYTEORDER 0x1234 /**/ - -/* 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". - */ -/* 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 "". - */ -/* TODO: doesn't work for MSC -- it's more complicated than this */ -#define CPPSTDIN "cl " -#define CPPMINUS "" - -/* HAS_BCMP - * This symbol, if defined, indicates that the bcmp routine is available - * to compare blocks of memory. If undefined, use memcmp. If that's - * not available, roll your own. - */ -/*#undef HAS_BCMP /**/ - -/* HAS_BCOPY - * This symbol, if defined, indicates that the bcopy routine is available - * to copy blocks of memory. Otherwise you should probably use memcpy(). - * If neither is defined, roll your own. - */ -/* SAFE_BCOPY - * This symbol, if defined, indicates that the bcopy routine is available - * to copy potentially overlapping copy blocks of bcopy. Otherwise you - * should probably use memmove() or memcpy(). If neither is defined, - * roll your own. - */ -/*#undef HAS_BCOPY /**/ -/*#undef SAFE_BCOPY /**/ - -/* HAS_BZERO - * This symbol, if defined, indicates that the bzero routine is available - * to zero blocks of memory. Otherwise you should probably use memset() - * or roll your own. - */ -/*#undef HAS_BZERO /**/ - -/* CASTNEGFLOAT - * This symbol, if defined, indicates that this C compiler knows how to - * cast negative or large floating point 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: - * 1 = couldn't cast < 0 - * 2 = couldn't cast >= 0x80000000 - */ -#define CASTNEGFLOAT /**/ -#define CASTFLAGS 0 /**/ - -/* CHARSPRINTF - * This symbol is defined if this system declares "char *sprintf()" in - * stdio.h. The trend seems to be to declare it as "int sprintf()". It - * is up to the package author to declare sprintf correctly based on the - * symbol. - */ -/*#undef CHARSPRINTF /**/ - -/* 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 /**/ - -/* HAS_CRYPT - * This symbol, if defined, indicates that the crypt routine is available - * to encrypt passwords and the like. - */ -/*#undef HAS_CRYPT /**/ - -/* CSH - * This symbol, if defined, indicates that the C-shell exists. - * If defined, contains the full pathname of csh. - */ -/*#undef CSH "/usr/bin/csh" /**/ - -/* 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. - */ -/*#undef DOSUID /**/ - -/* HAS_DUP2 - * This symbol, if defined, indicates that the dup2 routine is available - * to dup file descriptors. Otherwise you should use dup(). - */ -#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(). - */ -/*#undef 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(). - */ -/*#undef HAS_FCHOWN /**/ - -/* HAS_FCNTL - * This symbol, if defined, indicates to the C program that - * the fcntl() function exists. - */ -/*#undef HAS_FCNTL /**/ - -/* FLEXFILENAMES - * This symbol, if defined, indicates that the system supports filenames - * longer than 14 characters. - */ -/*#undef FLEXFILENAMES /**/ - -/* HAS_FLOCK - * This symbol, if defined, indicates that the flock() routine is - * available to do file locking. - */ -/*#undef HAS_FLOCK /**/ - -/* 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. - */ -/*#undef HAS_GETGROUPS /**/ - -/* HAS_GETHOSTENT - * This symbol, if defined, indicates that the gethostent() routine is - * available to lookup host names in some data base or other. - */ -/*#undef HAS_GETHOSTENT /**/ - -/* HAS_GETPGRP - * This symbol, if defined, indicates that the getpgrp() routine is - * available to get the current process group. - */ -/*#undef HAS_GETPGRP /**/ - -/* HAS_GETPGRP2 - * This symbol, if defined, indicates that the getpgrp2() (as in DG/UX) - * routine is available to get the current process group. - */ -/*#undef HAS_GETPGRP2 /**/ - -/* HAS_GETPRIORITY - * This symbol, if defined, indicates that the getpriority() routine is - * available to get a process's priority. - */ -/*#undef HAS_GETPRIORITY /**/ - -/* HAS_HTONS - * This symbol, if defined, indicates that the htons routine (and friends) - * are available to do network order byte swapping. - */ -/* HAS_HTONL - * This symbol, if defined, indicates that the htonl routine (and friends) - * are available to do network order byte swapping. - */ -/* HAS_NTOHS - * This symbol, if defined, indicates that the ntohs routine (and friends) - * are available to do network order byte swapping. - */ -/* HAS_NTOHL - * This symbol, if defined, indicates that the ntohl routine (and friends) - * are available to do network order byte swapping. - */ -/*#undef HAS_HTONS /**/ -/*#undef HAS_HTONL /**/ -/*#undef HAS_NTOHS /**/ -/*#undef HAS_NTOHL /**/ - -/* index - * This preprocessor symbol is defined, along with rindex, if the system - * uses the strchr and strrchr routines instead. - */ -/* rindex - * This preprocessor symbol is defined, along with index, if the system - * uses the strchr and strrchr routines instead. - */ -#define index strchr /* cultural */ -#define rindex strrchr /* differences? */ - -/* HAS_ISASCII - * This symbol, if defined, indicates that the isascii routine is available - * to test characters for asciiness. - */ -#define HAS_ISASCII /**/ - -/* 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. - */ -/*#undef HAS_KILLPG /**/ - -/* HAS_LSTAT - * This symbol, if defined, indicates that the lstat() routine is - * available to stat symbolic links. - */ -/*#undef HAS_LSTAT /**/ - -/* HAS_MEMCMP - * This symbol, if defined, indicates that the memcmp routine is available - * to compare blocks of memory. If undefined, roll your own. - */ -#define HAS_MEMCMP /**/ - -/* HAS_MEMCPY - * This symbol, if defined, indicates that the memcpy routine is available - * to copy blocks of memory. Otherwise you should probably use bcopy(). - * If neither is defined, roll your own. - */ -/* SAFE_MEMCPY - * This symbol, if defined, indicates that the memcpy routine is available - * to copy potentially overlapping copy blocks of memory. Otherwise you - * should probably use memmove() or bcopy(). If neither is defined, - * roll your own. - */ -#define HAS_MEMCPY /**/ -/*#undef SAFE_MEMCPY /**/ - -/* HAS_MEMMOVE - * This symbol, if defined, indicates that the memmove routine is available - * to move potentially overlapping blocks of memory. Otherwise you - * should use bcopy() or roll your own. - */ -/*#undef HAS_MEMMOVE /**/ - -/* HAS_MEMSET - * This symbol, if defined, indicates that the memset routine is available - * to set a block of memory to a character. If undefined, roll your own. - */ -#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_MSG - * This symbol, if defined, indicates that the entire msg*(2) library is - * supported. - */ -/*#undef HAS_MSG /**/ - -/* HAS_MSGCTL - * This symbol, if defined, indicates that the msgctl() routine is - * available to control message passing. - */ -/*#undef HAS_MSGCTL /**/ - -/* HAS_MSGGET - * This symbol, if defined, indicates that the msgget() routine is - * available to get messages. - */ -/*#undef HAS_MSGGET /**/ - -/* HAS_MSGRCV - * This symbol, if defined, indicates that the msgrcv() routine is - * available to receive messages. - */ -/*#undef HAS_MSGRCV /**/ - -/* HAS_MSGSND - * This symbol, if defined, indicates that the msgsnd() routine is - * available to send messages. - */ -/*#undef HAS_MSGSND /**/ - -/* HAS_NDBM - * This symbol, if defined, indicates that ndbm.h exists and should - * be included. - */ -/*#undef HAS_NDBM /**/ - -/* HAS_ODBM - * This symbol, if defined, indicates that dbm.h exists and should - * be included. - */ -/*#undef HAS_ODBM /**/ - -/* HAS_OPEN3 - * This manifest constant lets the C program know that the three - * argument form of open(2) is available. - */ -#define HAS_OPEN3 /**/ - -/* HAS_READDIR - * This symbol, if defined, indicates that the readdir routine is available - * from the C library to read directories. - */ -#define HAS_READDIR /**/ - -/* 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_REWINDDIR - * This symbol, if defined, indicates that the rewindir routine is - * available to rewind directories. - */ -#define HAS_REWINDDIR /**/ - -/* 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_SEEKDIR - * This symbol, if defined, indicates that the seekdir routine is - * available to seek into directories. - */ -#define HAS_SEEKDIR /**/ - -/* HAS_SELECT - * This symbol, if defined, indicates that the select() subroutine - * exists. - */ -/*#undef HAS_SELECT /**/ - -/* HAS_SEM - * This symbol, if defined, indicates that the entire sem*(2) library is - * supported. - */ -/*#undef HAS_SEM /**/ - -/* HAS_SEMCTL - * This symbol, if defined, indicates that the semctl() routine is - * available to control semaphores. - */ -/*#undef HAS_SEMCTL /**/ - -/* HAS_SEMGET - * This symbol, if defined, indicates that the semget() routine is - * available to get semaphores ids. - */ -/*#undef HAS_SEMGET /**/ - -/* HAS_SEMOP - * This symbol, if defined, indicates that the semop() routine is - * available to perform semaphore operations. - */ -/*#undef HAS_SEMOP /**/ - -/* HAS_SETEGID - * This symbol, if defined, indicates that the setegid routine is available - * to change the effective gid of the current program. - */ -/*#undef HAS_SETEGID /**/ - -/* HAS_SETEUID - * This symbol, if defined, indicates that the seteuid routine is available - * to change the effective uid of the current program. - */ -/*#undef HAS_SETEUID /**/ - -/* HAS_SETPGRP - * This symbol, if defined, indicates that the setpgrp() routine is - * available to set the current process group. - */ -/*#undef HAS_SETPGRP /**/ - -/* HAS_SETPGRP2 - * This symbol, if defined, indicates that the setpgrp2() (as in DG/UX) - * routine is available to set the current process group. - */ -/*#undef HAS_SETPGRP2 /**/ - -/* HAS_SETPRIORITY - * This symbol, if defined, indicates that the setpriority() routine is - * available to set a process's priority. - */ -/*#undef 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 program. - */ -/* HAS_SETRESGID - * This symbol, if defined, indicates that the setresgid routine is - * available to change the real, effective and saved gid of the current - * program. - */ -/*#undef HAS_SETREGID /**/ -/*#undef 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 program. - */ -/* HAS_SETRESUID - * This symbol, if defined, indicates that the setresuid routine is - * available to change the real, effective and saved uid of the current - * program. - */ -/*#undef HAS_SETREUID /**/ -/*#undef HAS_SETRESUID /**/ - -/* HAS_SETRGID - * This symbol, if defined, indicates that the setrgid routine is available - * to change the real gid of the current program. - */ -/*#undef HAS_SETRGID /**/ - -/* HAS_SETRUID - * This symbol, if defined, indicates that the setruid routine is available - * to change the real uid of the current program. - */ -/*#undef HAS_SETRUID /**/ - -/* HAS_SHM - * This symbol, if defined, indicates that the entire shm*(2) library is - * supported. - */ -/*#undef HAS_SHM /**/ - -/* HAS_SHMAT - * This symbol, if defined, indicates that the shmat() routine is - * available to attach a shared memory segment. - */ -/* VOID_SHMAT - * This symbol, if defined, indicates that the shmat() routine - * returns a pointer of type void*. - */ -/*#undef HAS_SHMAT /**/ - -/*#undef VOIDSHMAT /**/ - -/* HAS_SHMCTL - * This symbol, if defined, indicates that the shmctl() routine is - * available to control a shared memory segment. - */ -/*#undef HAS_SHMCTL /**/ - -/* HAS_SHMDT - * This symbol, if defined, indicates that the shmdt() routine is - * available to detach a shared memory segment. - */ -/*#undef HAS_SHMDT /**/ - -/* HAS_SHMGET - * This symbol, if defined, indicates that the shmget() routine is - * available to get a shared memory segment id. - */ -/*#undef HAS_SHMGET /**/ - -/* 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. - */ -/* OLDSOCKET - * This symbol, if defined, indicates that the 4.1c BSD socket interface - * is supported instead of the 4.2/4.3 BSD socket interface. - */ -/*#undef HAS_SOCKET /**/ - -/*#undef HAS_SOCKETPAIR /**/ - -/*#undef OLDSOCKET /**/ - -/* STATBLOCKS - * This symbol is defined if this system has a stat structure declaring - * st_blksize and st_blocks. - */ -/*#undef STATBLOCKS /**/ - -/* STDSTDIO - * This symbol is defined if this system has a FILE structure declaring - * _ptr and _cnt in stdio.h. - * - * NOTE: [Tom Dinger, 23 February 1991] You also need the _filbuf() - * function, usually referred to by the getc() macro in stdio.h. - */ -#define STDSTDIO /**/ - -/* STRUCTCOPY - * 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 STRUCTCOPY /**/ - -/* HAS_STRERROR - * This symbol, if defined, indicates that the strerror() routine is - * available to translate error numbers to strings. - */ -#define HAS_STRERROR /**/ - -/* HAS_SYMLINK - * This symbol, if defined, indicates that the symlink routine is available - * to create symbolic links. - */ -/*#undef 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. - */ -/*#undef HAS_SYSCALL /**/ - -/* HAS_TELLDIR - * This symbol, if defined, indicates that the telldir routine is - * available to tell your location in directories. - */ -#define HAS_TELLDIR /**/ - -/* HAS_TRUNCATE - * This symbol, if defined, indicates that the truncate routine is - * available to truncate files. - */ -/*#undef HAS_TRUNCATE /**/ - -/* HAS_VFORK - * This symbol, if defined, indicates that vfork() exists. - */ -/*#undef HAS_VFORK /**/ - -/* VOIDSIG - * This symbol is defined if this system declares "void (*signal())()" in - * signal.h. The old way was to declare it as "int (*signal())()". It - * is up to the package author to declare things correctly based on the - * symbol. - */ -/* TO_SIGNAL - * This symbol's value is either "void" or "int", corresponding to the - * appropriate return "type" of a signal handler. Thus, one can declare - * a signal handler using "TO_SIGNAL (*handler())()", and define the - * handler using "TO_SIGNAL handler(sig)". - */ -#define VOIDSIG /**/ -#define TO_SIGNAL int /**/ - -/* HASVOLATILE - * This symbol, if defined, indicates that this C compiler knows about - * the volatile declaration. - */ -/*#undef HASVOLATILE /**/ - -/* 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(). - */ -/* CHARVSPRINTF - * 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 /**/ -/*#undef CHARVSPRINTF /**/ - -/* HAS_WAIT4 - * This symbol, if defined, indicates that wait4() exists. - */ -/*#undef HAS_WAIT4 /**/ - -/* HAS_WAITPID - * This symbol, if defined, indicates that waitpid() exists. - */ -/*#undef HAS_WAITPID /**/ - -/* GIDTYPE - * This symbol has a value like gid_t, int, ushort, or whatever type is - * used to declare group ids in the kernel. - */ -#define GIDTYPE int /**/ - -/* GROUPSTYPE - * This symbol has a value like gid_t, int, ushort, or whatever type is - * used in the return value of getgroups(). - */ -#define GROUPSTYPE int /**/ - -/* I_FCNTL - * This manifest constant tells the C program to include . - */ -#define I_FCNTL /**/ - -/* I_GDBM - * This symbol, if defined, indicates that gdbm.h exists and should - * be included. - */ -/*#undef I_GDBM /**/ - -/* I_GRP - * This symbol, if defined, indicates to the C program that it should - * include grp.h. - */ -/*#undef I_GRP /**/ - -/* I_NETINET_IN - * This symbol, if defined, indicates to the C program that it should - * include netinet/in.h. - */ -/* I_SYS_IN - * This symbol, if defined, indicates to the C program that it should - * include sys/in.h. - */ -/*#undef I_NETINET_IN /**/ -/*#undef I_SYS_IN /**/ - -/* I_PWD - * This symbol, if defined, indicates to the C program that it should - * include pwd.h. - */ -/* 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. - */ -/*#undef I_PWD /**/ -/*#undef PWQUOTA /**/ -/*#undef PWAGE /**/ -/*#undef PWCHANGE /**/ -/*#undef PWCLASS /**/ -/*#undef PWEXPIRE /**/ -/*#undef PWCOMMENT /**/ - -/* I_SYS_FILE - * This manifest constant tells the C program to include . - */ -/*#undef I_SYS_FILE /**/ - -/* I_SYSIOCTL - * This symbol, if defined, indicates that sys/ioctl.h exists and should - * be included. - */ -/*#undef I_SYSIOCTL /**/ - -/* I_TIME - * This symbol is defined if the program should include . - */ -/* I_SYS_TIME - * This symbol is defined if the program should include . - */ -/* SYSTIMEKERNEL - * This symbol is defined if the program should include - * with KERNEL defined. - */ -/* I_SYS_SELECT - * This symbol is defined if the program should include . - */ -#define I_TIME /**/ -/*#undef I_SYS_TIME /**/ -/*#undef SYSTIMEKERNEL /**/ -/*#undef I_SYS_SELECT /**/ - -/* I_UTIME - * This symbol, if defined, indicates to the C program that it should - * include utime.h. - */ -/*#undef I_UTIME /**/ - -/* I_VARARGS - * This symbol, if defined, indicates to the C program that it should - * include varargs.h. - */ -#define I_VARARGS /**/ - -/* I_VFORK - * This symbol, if defined, indicates to the C program that it should - * include vfork.h. - */ -/*#undef I_VFORK /**/ - -/* INTSIZE - * This symbol contains the size of an int, so that the C preprocessor - * can make decisions based on it. - */ -#define INTSIZE 2 /**/ - -/* I_DIRENT - * This symbol, if defined, indicates that the program should use the - * P1003-style directory routines, and include . - */ -/* I_SYS_DIR - * This symbol, if defined, indicates that the program should use the - * directory functions by including . - */ -/* I_NDIR - * This symbol, if defined, indicates that the program should include the - * system's version of ndir.h, rather than the one with this package. - */ -/* I_SYS_NDIR - * This symbol, if defined, indicates that the program should include the - * system's version of sys/ndir.h, rather than the one with this package. - */ -/* I_MY_DIR - * This symbol, if defined, indicates that the program should compile - * the ndir.c code provided with the package. - */ -/* 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. - */ -/*#undef I_DIRENT /**/ -#define I_SYS_DIR /**/ -/*#undef I_NDIR /**/ -/*#undef I_SYS_NDIR /**/ -/*#undef I_MY_DIR /**/ -/*#undef DIRNAMLEN /**/ - -/* MYMALLOC - * This symbol, if defined, indicates that we're using our own malloc. - */ -/* MALLOCPTRTYPE - * This symbol defines the kind of ptr returned by malloc and realloc. - */ -#define MYMALLOC /**/ - -#define MALLOCPTRTYPE void /**/ - - -/* RANDBITS - * This symbol contains the number of bits of random number the rand() - * function produces. Usual values are 15, 16, and 31. - */ -#define RANDBITS 31 /**/ - -/* SCRIPTDIR - * This symbol holds the name of the directory in which the user wants - * to keep publicly executable scripts for the package in question. It - * is often a directory that is mounted across diverse architectures. - */ -#define SCRIPTDIR "C:/bin/perl" /**/ - -/* SIG_NAME - * This symbol contains an list of signal names in order. - * - * Note: This list is specific for Microsoft C 5.1 and 6.0, which only - * support SIGINT, SIGFPE, SIGILL, SIGSEGV, and SIGABRT on - * DOS 3.x, but in addition defines SIGTERM, SIGBREAK, SIGUSR1, - * SIGUSR2, and SIGUSR3. - */ -#define SIG_NAME \ - "ZERO","HUP","INT","QUIT","ILL","TRAP","IOT","EMT","FPE","KILL",\ - "BUS","SEGV","SYS","PIPE","ALRM","TERM","USR1","USR2","TSTP","CONT",\ - "USR3","BREAK","ABRT" /**/ - -/* 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 /**/ - -/* UIDTYPE - * This symbol has a value like uid_t, int, ushort, or whatever type is - * used to declare user ids in the kernel. - */ -#define UIDTYPE int /**/ - -/* VOIDHAVE - * 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 - * - * The package designer should define VOIDWANT to indicate the requirements - * of the package. This can be done either by #defining VOIDWANT before - * including config.h, or by defining voidwant in Myinit.U. If the level - * of void support necessary is not present, config.h defines void to "int", - * VOID to the empty string, and VOIDP to "char *". - */ -/* void - * This symbol is used for void casts. On implementations which support - * void appropriately, its value is "void". Otherwise, its value maps - * to "int". - */ -/* VOID - * This symbol's value is "void" if the implementation supports void - * appropriately. Otherwise, its value is the empty string. The primary - * use of this symbol is in specifying void parameter lists for function - * prototypes. - */ -/* VOIDP - * This symbol is used for casting generic pointers. On implementations - * which support void appropriately, its value is "void *". Otherwise, - * its value is "char *". - */ -#ifndef VOIDWANT -#define VOIDWANT 1 -#endif -#define VOIDHAVE 1 -#if (VOIDHAVE & VOIDWANT) != VOIDWANT -#define void int /* is void to be avoided? */ -#define VOID -#define VOIDP (char *) -#define M_VOID /* Xenix strikes again */ -#else -#define VOID void -#define VOIDP (void *) -#endif - -/* 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 PRIVLIB "/usr/local/lib/perl" /**/ - -/* - * BINARY: - * This symbol is defined if you run under an operating system that - * distinguishes between binary and text files. If so the function - * setmode will be used to set the file into binary mode. - */ -#define BINARY - -#define S_ISUID 0 -#define S_ISGID 0 - -/* For MSC5.1, toke.c "runs out of heap space" unless CRIPPLED_CC is - * defined. - */ -#if defined(BUGGY_MSC5) || defined(BUGGY_MSC6) -#define CRIPPLED_CC /**/ -#endif - -/* MSC (5.1 and 6.0) doesn't know about S_IFBLK or S_IFIFO -- these are - * normally found in sys/stat.h - */ -#define S_IFBLK (S_IFDIR | S_IFCHR) -#define S_IFIFO 0010000 - -/* Define SUFFIX to get special DOS suffix-replacement code */ -#define SUFFIX /**/ - -/* Add this for the DOS-specific chdir() function */ -#define chdir perl_chdir - -#endif diff --git a/msdos/dir.h b/msdos/dir.h deleted file mode 100644 index d16bc37..0000000 --- a/msdos/dir.h +++ /dev/null @@ -1,63 +0,0 @@ -/* $RCSfile: dir.h,v $$Revision: 4.1 $$Date: 92/08/07 18:24:41 $ - * - * (C) Copyright 1987, 1990 Diomidis Spinellis. - * - * You may distribute under the terms of either the GNU General Public - * License or the Artistic License, as specified in the README file. - * - * $Log: dir.h,v $ - * Revision 4.1 92/08/07 18:24:41 lwall - * - * Revision 4.0.1.1 91/06/07 11:22:10 lwall - * patch4: new copyright notice - * - * Revision 4.0 91/03/20 01:34:20 lwall - * 4.0 baseline. - * - * Revision 3.0.1.1 90/03/27 16:07:08 lwall - * patch16: MSDOS support - * - * Revision 1.1 90/03/18 20:32:29 dds - * Initial revision - * - * - */ - -/* - * defines the type returned by the directory(3) functions - */ - -#ifndef __DIR_INCLUDED -#define __DIR_INCLUDED - -/*Directory entry size */ -#ifdef DIRSIZ -#undef DIRSIZ -#endif -#define DIRSIZ(rp) (sizeof(struct direct)) - -/* - * Structure of a directory entry - */ -struct direct { - ino_t d_ino; /* inode number (not used by MS-DOS) */ - int d_namlen; /* Name length */ - char d_name[13]; /* file name */ -}; - -struct _dir_struc { /* Structure used by dir operations */ - char *start; /* Starting position */ - char *curr; /* Current position */ - struct direct dirstr; /* Directory structure to return */ -}; - -typedef struct _dir_struc DIR; /* Type returned by dir operations */ - -DIR *cdecl opendir(char *filename); -struct direct *readdir(DIR *dirp); -long telldir(DIR *dirp); -void seekdir(DIR *dirp,long loc); -void rewinddir(DIR *dirp); -void closedir(DIR *dirp); - -#endif /* __DIR_INCLUDED */ diff --git a/msdos/directory.c b/msdos/directory.c deleted file mode 100644 index dd1fb64..0000000 --- a/msdos/directory.c +++ /dev/null @@ -1,185 +0,0 @@ -/* $RCSfile: directory.c,v $$Revision: 4.1 $$Date: 92/08/07 18:24:42 $ - * - * (C) Copyright 1987, 1988, 1990 Diomidis Spinellis. - * - * You may distribute under the terms of either the GNU General Public - * License or the Artistic License, as specified in the README file. - * - * $Log: directory.c,v $ - * Revision 4.1 92/08/07 18:24:42 lwall - * - * Revision 4.0.1.1 91/06/07 11:22:24 lwall - * patch4: new copyright notice - * - * Revision 4.0 91/03/20 01:34:24 lwall - * 4.0 baseline. - * - * Revision 3.0.1.1 90/03/27 16:07:37 lwall - * patch16: MSDOS support - * - * Revision 1.3 90/03/16 22:39:40 dds - * Fixed malloc problem. - * - * Revision 1.2 88/07/23 00:08:39 dds - * Added inode non-zero filling. - * - * Revision 1.1 88/07/23 00:03:50 dds - * Initial revision - * - */ - -/* - * UNIX compatible directory access functions - */ - -#include -#include -#include -#include -#include -#include -#include - -/* - * File names are converted to lowercase if the - * CONVERT_TO_LOWER_CASE variable is defined. - */ -#define CONVERT_TO_LOWER_CASE - -#define PATHLEN 65 - -#ifndef lint -static char rcsid[] = "$RCSfile: directory.c,v $$Revision: 4.1 $$Date: 92/08/07 18:24:42 $"; -#endif - -DIR * -opendir(char *filename) -{ - DIR *p; - char *oldresult, *result; - union REGS srv; - struct SREGS segregs; - register reslen = 0; - char scannamespc[PATHLEN]; - char *scanname = scannamespc; /* To take address we need a pointer */ - - /* - * Structure used by the MS-DOS directory system calls. - */ - struct dir_buff { - char reserved[21]; /* Reserved for MS-DOS */ - unsigned char attribute; /* Attribute */ - unsigned int time; /* Time */ - unsigned int date; /* Date */ - long size; /* Size of file */ - char fn[13]; /* Filename */ - } buffspc, *buff = &buffspc; - - - if (!(p = (DIR *) malloc(sizeof(DIR)))) - return NULL; - - /* Initialize result to use realloc on it */ - if (!(result = malloc(1))) { - free(p); - return NULL; - } - - /* Create the search pattern */ - strcpy(scanname, filename); - if (strchr("/\\", *(scanname + strlen(scanname) - 1)) == NULL) - strcat(scanname, "/*.*"); - else - strcat(scanname, "*.*"); - - segread(&segregs); -#if ( defined(M_I86LM) || defined(M_I86CM) || defined(M_I86HM) ) - segregs.ds = FP_SEG(buff); - srv.x.dx = FP_OFF(buff); -#else - srv.x.dx = (unsigned int) buff; -#endif - srv.h.ah = 0x1a; /* Set DTA to DS:DX */ - intdosx(&srv, &srv, &segregs); - -#if ( defined(M_I86LM) || defined(M_I86CM) || defined(M_I86HM) ) - segregs.ds = FP_SEG(scanname); - srv.x.dx = FP_OFF(scanname); -#else - srv.x.dx = (unsigned int) scanname; -#endif - srv.x.cx = 0xff; /* Search mode */ - - for (srv.h.ah = 0x4e; !intdosx(&srv, &srv, &segregs); srv.h.ah = 0x4f) { - if ((result = (char *) realloc(result, reslen + strlen(buff->fn) + 1)) == - NULL) { - free(p); - free(oldresult); - return NULL; - } - oldresult = result; -#ifdef CONVERT_TO_LOWER_CASE - strcpy(result + reslen, strlwr(buff->fn)); -#else - strcpy(result + reslen, buff->fn); -#endif - reslen += strlen(buff->fn) + 1; - } - - if (!(result = realloc(result, reslen + 1))) { - free(p); - free(oldresult); - return NULL; - } else { - p->start = result; - p->curr = result; - *(result + reslen) = '\0'; - return p; - } -} - - -struct direct * -readdir(DIR *dirp) -{ - char *p; - register len; - static dummy; - - p = dirp->curr; - len = strlen(p); - if (*p) { - dirp->curr += len + 1; - strcpy(dirp->dirstr.d_name, p); - dirp->dirstr.d_namlen = len; - /* To fool programs */ - dirp->dirstr.d_ino = ++dummy; - return &(dirp->dirstr); - } else - return NULL; -} - -long -telldir(DIR *dirp) -{ - return (long) dirp->curr; /* ouch! pointer to long cast */ -} - -void -seekdir(DIR *dirp, long loc) -{ - dirp->curr = (char *) loc; /* ouch! long to pointer cast */ -} - -void -rewinddir(DIR *dirp) -{ - dirp->curr = dirp->start; -} - -void -closedir(DIR *dirp) -{ - free(dirp->start); - free(dirp); -} diff --git a/msdos/eg/crlf.bat b/msdos/eg/crlf.bat deleted file mode 100644 index 24d7366..0000000 --- a/msdos/eg/crlf.bat +++ /dev/null @@ -1,32 +0,0 @@ -@REM=(" -@perl %0.bat %1 %2 %3 %4 %5 %6 %7 %8 %9 -@end ") if 0 ; - -# Convert all the files in the current directory from unix to MS-DOS -# line ending conventions. -# -# By Diomidis Spinellis -# -open(FILES, 'find . -print |'); -while ($file = ) { - $file =^ s/[\n\r]//; - if (-f $file) { - if (-B $file) { - print STDERR "Skipping binary file $file\n"; - next; - } - ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, - $blksize, $blocks) = stat($file); - open(IFILE, "$file"); - open(OFILE, ">xl$$"); - while () { - print OFILE; - } - close(OFILE) || die "close xl$$: $!\n"; - close(IFILE) || die "close $file: $!\n"; - unlink($file) || die "unlink $file: $!\n"; - rename("xl$$", $file) || die "rename(xl$$, $file): $!\n"; - chmod($mode, $file) || die "chmod($mode, $file: $!\n"; - utime($atime, $mtime, $file) || die "utime($atime, $mtime, $file): $!\n"; - } -} diff --git a/msdos/eg/drives.bat b/msdos/eg/drives.bat deleted file mode 100644 index c68306e..0000000 --- a/msdos/eg/drives.bat +++ /dev/null @@ -1,41 +0,0 @@ -@REM=(" -@perl %0.bat %1 %2 %3 %4 %5 %6 %7 %8 %9 -@end ") if 0 ; - -# -# Test the ioctl function for MS-DOS. Provide a list of drives and their -# characteristics. -# -# By Diomidis Spinellis. -# - -@fdnum = ("STDIN", "STDOUT", "STDERR"); -$maxdrives = 15; -for ($i = 3; $i < $maxdrives; $i++) { - open("FD$i", "nul"); - @fdnum[$i - 1] = "FD$i"; -} -@mediatype = ( - "320/360 k floppy drive", - "1.2M floppy", - "720K floppy", - "8'' single density floppy", - "8'' double density floppy", - "fixed disk", - "tape drive", - "1.44M floppy", - "other" -); -print "The system has the following drives:\n"; -for ($i = 1; $i < $maxdrives; $i++) { - if ($ret = ioctl(@fdnum[$i], 8, 0)) { - $type = ($ret == 0) ? "removable" : "fixed"; - $ret = ioctl(@fdnum[$i], 9, 0); - $location = ($ret & 0x800) ? "local" : "remote"; - ioctl(@fdnum[$i], 0x860d, $param); - @par = unpack("CCSSSC31S", $param); - $lock = (@par[2] & 2) ? "supporting door lock" : "not supporting door lock"; - printf "%c:$type $location @mediatype[@par[1]] @par[3] cylinders @par[6] - sectors/track $lock\n", ord('A') + $i - 1; - } -} diff --git a/msdos/eg/lf.bat b/msdos/eg/lf.bat deleted file mode 100644 index 9c13eef..0000000 --- a/msdos/eg/lf.bat +++ /dev/null @@ -1,33 +0,0 @@ -@REM=(" -@perl %0.bat %1 %2 %3 %4 %5 %6 %7 %8 %9 -@end ") if 0 ; - -# Convert all the files in the current directory from MS-DOS to unix -# line ending conventions. -# -# By Diomidis Spinellis -# -open(FILES, 'find . -print |'); -while ($file = ) { - $file =^ s/[\n\r]//; - if (-f $file) { - if (-B $file) { - print STDERR "Skipping binary file $file\n"; - next; - } - ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, - $blksize, $blocks) = stat($file); - open(IFILE, "$file"); - open(OFILE, ">xl$$"); - binmode OFILE || die "binmode xl$$: $!\n"; - while () { - print OFILE; - } - close(OFILE) || die "close xl$$: $!\n"; - close(IFILE) || die "close $file: $!\n"; - unlink($file) || die "unlink $file: $!\n"; - rename("xl$$", $file) || die "rename(xl$$, $file): $!\n"; - chmod($mode, $file) || die "chmod($mode, $file: $!\n"; - utime($atime, $mtime, $file) || die "utime($atime, $mtime, $file): $!\n"; - } -} diff --git a/msdos/glob.c b/msdos/glob.c deleted file mode 100644 index 19fb2ab..0000000 --- a/msdos/glob.c +++ /dev/null @@ -1,17 +0,0 @@ -/* - * Globbing for MS-DOS. Relies on the expansion done by the library - * startup code. (dds) - */ - -#include -#include - -main(int argc, char *argv[]) -{ - register i; - - for (i = 1; i < argc; i++) { - fputs(strlwr(argv[i]), stdout); - putchar(0); - } -} diff --git a/msdos/msdos.c b/msdos/msdos.c deleted file mode 100644 index 206cf5a..0000000 --- a/msdos/msdos.c +++ /dev/null @@ -1,260 +0,0 @@ -/* $RCSfile: msdos.c,v $$Revision: 4.1 $$Date: 92/08/07 18:24:49 $ - * - * (C) Copyright 1989, 1990 Diomidis Spinellis. - * - * You may distribute under the terms of either the GNU General Public - * License or the Artistic License, as specified in the README file. - * - * $Log: msdos.c,v $ - * Revision 4.1 92/08/07 18:24:49 lwall - * - * Revision 4.0.1.1 91/06/07 11:22:37 lwall - * patch4: new copyright notice - * - * Revision 4.0 91/03/20 01:34:46 lwall - * 4.0 baseline. - * - * Revision 3.0.1.1 90/03/27 16:10:41 lwall - * patch16: MSDOS support - * - * Revision 1.1 90/03/18 20:32:01 dds - * Initial revision - * - */ - -/* - * Various Unix compatibility functions for MS-DOS. - */ - -#include "EXTERN.h" -#include "perl.h" - -#include -#include - -/* - * Interface to the MS-DOS ioctl system call. - * The function is encoded as follows: - * The lowest nibble of the function code goes to AL - * The two middle nibbles go to CL - * The high nibble goes to CH - * - * The return code is -1 in the case of an error and if successful - * for functions AL = 00, 09, 0a the value of the register DX - * for functions AL = 02 - 08, 0e the value of the register AX - * for functions AL = 01, 0b - 0f the number 0 - * - * Notice that this restricts the ioctl subcodes stored in AL to 00-0f - * In the Ralf Borwn interrupt list 90.1 there are no subcodes above AL=0f - * so we are ok. - * Furthermore CH is also restriced in the same area. Where CH is used as a - * code it always is between 00-0f. In the case where it forms a count - * together with CL we arbitrarily set the highest count limit to 4095. It - * sounds reasonable for an ioctl. - * The other alternative would have been to use the pointer argument to - * point the the values of CX. The problem with this approach is that - * of accessing wild regions when DX is used as a number and not as a - * pointer. - */ -int -ioctl(int handle, unsigned int function, char *data) -{ - union REGS srv; - struct SREGS segregs; - - srv.h.ah = 0x44; - srv.h.al = (unsigned char)(function & 0x0F); - srv.x.bx = handle; - srv.x.cx = function >> 4; - segread(&segregs); -#if ( defined(M_I86LM) || defined(M_I86CM) || defined(M_I86HM) ) - segregs.ds = FP_SEG(data); - srv.x.dx = FP_OFF(data); -#else - srv.x.dx = (unsigned int) data; -#endif - intdosx(&srv, &srv, &segregs); - if (srv.x.cflag & 1) { - switch(srv.x.ax ){ - case 1: - errno = EINVAL; - break; - case 2: - case 3: - errno = ENOENT; - break; - case 4: - errno = EMFILE; - break; - case 5: - errno = EPERM; - break; - case 6: - errno = EBADF; - break; - case 8: - errno = ENOMEM; - break; - case 0xc: - case 0xd: - case 0xf: - errno = EINVAL; - break; - case 0x11: - errno = EXDEV; - break; - case 0x12: - errno = ENFILE; - break; - default: - errno = EZERO; - break; - } - return -1; - } else { - switch (function & 0xf) { - case 0: case 9: case 0xa: - return srv.x.dx; - case 2: case 3: case 4: case 5: - case 6: case 7: case 8: case 0xe: - return srv.x.ax; - case 1: case 0xb: case 0xc: case 0xd: - case 0xf: - default: - return 0; - } - } -} - - -/* - * Sleep function. - */ -void -sleep(unsigned len) -{ - time_t end; - - end = time((time_t *)0) + len; - while (time((time_t *)0) < end) - ; -} - -/* - * Just pretend that everyone is a superuser - */ -#define ROOT_UID 0 -#define ROOT_GID 0 -int -getuid(void) -{ - return ROOT_UID; -} - -int -geteuid(void) -{ - return ROOT_UID; -} - -int -getgid(void) -{ - return ROOT_GID; -} - -int -getegid(void) -{ - return ROOT_GID; -} - -int -setuid(int uid) -{ return (uid==ROOT_UID?0:-1); } - -int -setgid(int gid) -{ return (gid==ROOT_GID?0:-1); } - -/* - * The following code is based on the do_exec and do_aexec functions - * in file doio.c - */ -int -do_aspawn(really,arglast) -STR *really; -int *arglast; -{ - register STR **st = stack->ary_array; - register int sp = arglast[1]; - register int items = arglast[2] - sp; - register char **a; - char **argv; - char *tmps; - int status; - - if (items) { - New(1101,argv, items+1, char*); - a = argv; - for (st += ++sp; items > 0; items--,st++) { - if (*st) - *a++ = str_get(*st); - else - *a++ = ""; - } - *a = Nullch; - if (really && *(tmps = str_get(really))) - status = spawnvp(P_WAIT,tmps,argv); - else - status = spawnvp(P_WAIT,argv[0],argv); - Safefree(argv); - } - return status; -} - - -int -do_spawn(cmd) -char *cmd; -{ - register char **a; - register char *s; - char **argv; - char flags[10]; - int status; - char *shell, *cmd2; - - /* save an extra exec if possible */ - if ((shell = getenv("COMSPEC")) == 0) - shell = "\\command.com"; - - /* see if there are shell metacharacters in it */ - if (strchr(cmd, '>') || strchr(cmd, '<') || strchr(cmd, '|')) - doshell: - return spawnl(P_WAIT,shell,shell,"/c",cmd,(char*)0); - - New(1102,argv, strlen(cmd) / 2 + 2, char*); - - New(1103,cmd2, strlen(cmd) + 1, char); - strcpy(cmd2, cmd); - a = argv; - for (s = cmd2; *s;) { - while (*s && isspace(*s)) s++; - if (*s) - *(a++) = s; - while (*s && !isspace(*s)) s++; - if (*s) - *s++ = '\0'; - } - *a = Nullch; - if (argv[0]) - if ((status = spawnvp(P_WAIT,argv[0],argv)) == -1) { - Safefree(argv); - Safefree(cmd2); - goto doshell; - } - Safefree(cmd2); - Safefree(argv); - return status; -} diff --git a/msdos/popen.c b/msdos/popen.c deleted file mode 100644 index 0031f5e..0000000 --- a/msdos/popen.c +++ /dev/null @@ -1,186 +0,0 @@ -/* $RCSfile: popen.c,v $$Revision: 4.1 $$Date: 92/08/07 18:24:50 $ - * - * (C) Copyright 1988, 1990 Diomidis Spinellis. - * - * You may distribute under the terms of either the GNU General Public - * License or the Artistic License, as specified in the README file. - * - * $Log: popen.c,v $ - * Revision 4.1 92/08/07 18:24:50 lwall - * - * Revision 4.0.1.1 91/06/07 11:22:52 lwall - * patch4: new copyright notice - * - * Revision 4.0 91/03/20 01:34:50 lwall - * 4.0 baseline. - * - * Revision 3.0.1.2 90/08/09 04:04:42 lwall - * patch19: various MSDOS and OS/2 patches folded in - * - * Revision 3.0.1.1 90/03/27 16:11:57 lwall - * patch16: MSDOS support - * - * Revision 1.1 90/03/18 20:32:20 dds - * Initial revision - * - */ - -/* - * Popen and pclose for MS-DOS - */ - -#include -#include -#include - -/* - * Possible actions on an popened file - */ -enum action { - delete, /* Used for "r". Delete the tmp file */ - execute /* Used for "w". Execute the command. */ -}; - -/* - * Linked list of things to do at the end of the program execution. - */ -static struct todo { - FILE *f; /* File we are working on (to fclose) */ - const char *name; /* Name of the file (to unlink) */ - const char *command; /* Command to execute */ - enum action what; /* What to do (execute or delete) */ - struct todo *next; /* Next structure */ -} *todolist; - - -/* Clean up function */ -static int close_pipes(void); - -/* - * Add a file f running the command command on file name to the list - * of actions to be done at the end. The action is specified in what. - * Return -1 on failure, 0 if ok. - */ -static int -add(FILE *f, const char *command, const char *name, enum action what) -{ - struct todo *p; - - if ((p = (struct todo *) malloc(sizeof(struct todo))) == NULL) - return -1; - p->f = f; - p->command = command; - p->name = name; - p->what = what; - p->next = todolist; - todolist = p; - return 0; -} - -FILE * -mypopen(const char *command, const char *t) -{ - char buff[256]; - char *name; - FILE *f; - static init = 0; - - if (!init) - if (onexit(close_pipes) == NULL) - return NULL; - else - init++; - - if ((name = tempnam((char*)NULL, "pp")) == NULL) - return NULL; - - switch (*t) { - case 'r': - sprintf(buff, "%s >%s", command, name); - if (system(buff) || (f = fopen(name, "r")) == NULL) { - free(name); - return NULL; - } - if (add(f, command, name, delete)) { - (void)fclose(f); - (void)unlink(name); - free(name); - return NULL; - } - return f; - case 'w': - if ((f = fopen(name, "w")) == NULL) { - free(name); - return NULL; - } - if (add(f, command, name, execute)) { - (void)fclose(f); - (void)unlink(name); - free(name); - return NULL; - } - return f; - default: - free(name); - return NULL; - } -} - -int -mypclose(FILE *f) -{ - struct todo *p, **prev; - char buff[256]; - const char *name; - int status; - - for (p = todolist, prev = &todolist; p; prev = &(p->next), p = p->next) - if (p->f == f) { - *prev = p->next; - name = p->name; - switch (p->what) { - case delete: - free(p); - if (fclose(f) == EOF) { - (void)unlink(name); - status = EOF; - } else if (unlink(name) < 0) - status = EOF; - else - status = 0; - free((void*)name); - return status; - case execute: - (void)sprintf(buff, "%s <%s", p->command, p->name); - free(p); - if (fclose(f) == EOF) { - (void)unlink(name); - status = EOF; - } else if (system(buff)) { - (void)unlink(name); - status = EOF; - } else if (unlink(name) < 0) - status = EOF; - else - status = 0; - free((void*)name); - return status; - default: - return EOF; - } - } - return EOF; -} - -/* - * Clean up at the end. Called by the onexit handler. - */ -static int -close_pipes(void) -{ - struct todo *p; - - for (p = todolist; p; p = p->next) - (void)mypclose(p->f); - return 0; -} diff --git a/msdos/usage.c b/msdos/usage.c deleted file mode 100644 index 2899167..0000000 --- a/msdos/usage.c +++ /dev/null @@ -1,51 +0,0 @@ -/* usage.c - * - * Show usage message. - */ - -#include -#include - - -usage(char *myname) -{ -char * p; -char * name_p; - -name_p = myname; -if ( p = strrchr(myname,'/') ) - name_p = p+1; /* point after final '/' */ -#ifdef MSDOS -if ( p = strrchr(name_p,'\\') ) - name_p = p+1; /* point after final '\\' */ -if ( p = strrchr(name_p,':') ) - name_p = p+1; /* point after final ':' */ - printf("\nUsage: %s [-acdnpsSvw] [-Dnumber] [-i[extension]] [-Idirectory]" -#else - printf("\nUsage: %s [-acdnpPsSuUvw] [-Dnumber] [-i[extension]] [-Idirectory]" -#endif - "\n [-e \"command\"] [-x[directory]] [filename] [arguments]\n", name_p); - - printf("\n -a autosplit mode with -n or -p" - "\n -c syntaxcheck only" - "\n -d run scripts under debugger" - "\n -n assume 'while (<>) { ...script... }' loop arround your script" - "\n -p assume loop like -n but print line also like sed" -#ifndef MSDOS - "\n -P run script through C preprocessor befor compilation" -#endif - "\n -s enable some switch parsing for switches after script name" - "\n -S look for the script using PATH environment variable"); -#ifndef MSDOS - printf("\n -u dump core after compiling the script" - "\n -U allow unsafe operations"); -#endif - printf("\n -v print version number and patchlevel of perl" - "\n -w turn warnings on for compilation of your script\n" - "\n -Dnumber set debugging flags" - "\n -i[extension] edit <> files in place (make backup if extension supplied)" - "\n -Idirectory specify include directory in conjunction with -P" - "\n -e command one line of script, multiple -e options are allowed" - "\n [filename] can be ommitted, when -e is used" - "\n -x[directory] strip off text before #!perl line and perhaps cd to directory\n"); -} diff --git a/mv-if-diff b/mv-if-diff new file mode 100644 index 0000000..1112a10 --- /dev/null +++ b/mv-if-diff @@ -0,0 +1,14 @@ +: mv-if-diff file1 file2 +: move file1 to file2 if file1 and file2 are different. + +if test $# -lt 2 ; then + echo "usage: $0 file1 file2" + echo "move file1 to file2 if file1 and file2 are different." + exit 1 +fi +if cmp $1 $2 >/dev/null 2>&1; then + echo "File $2 not changed." + rm -f tmp +else + mv $1 $2 +fi diff --git a/myconfig b/myconfig new file mode 100755 index 0000000..be8b407 --- /dev/null +++ b/myconfig @@ -0,0 +1,41 @@ +#!/bin/sh + +# This script is designed to provide a handy summary of the configuration +# information being used to build perl. This is especially useful if you +# are requesting help from comp.lang.perl on usenet or via mail. + +if test -f config.sh; then TOP=.; +elif test -f ../config.sh; then TOP=..; +elif test -f ../../config.sh; then TOP=../..; +elif test -f ../../../config.sh; then TOP=../../..; +elif test -f ../../../../config.sh; then TOP=../../../..; +else + echo "Can't find the perl config.sh file produced by Configure"; exit 1 +fi +. $TOP/config.sh + +$spitshell < foo, BAR => bar}; - -package main; - -$object->mymethod("BAR"); - -mymethod $object "FOO"; - -#&mymethod($object, "BAR"); - -sub BASEOBJ'mymethod { - local $ref = shift; - print ref $ref, "\n"; - print $ref->{shift}, "\n"; -} diff --git a/op.c b/op.c index 6f4a46a..d345575 100644 --- a/op.c +++ b/op.c @@ -1,45 +1,31 @@ -/* $RCSfile: cmd.h,v $$Revision: 4.1 $$Date: 92/08/07 17:19:19 $ +/* op.c * - * Copyright (c) 1991, Larry Wall + * Copyright (c) 1991-1994, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. * - * $Log: cmd.h,v $ + */ + +/* + * "You see: Mr. Drogo, he married poor Miss Primula Brandybuck. She was + * our Mr. Bilbo's first cousin on the mother's side (her mother being the + * youngest of the Old Took's daughters); and Mr. Drogo was his second + * cousin. So Mr. Frodo is his first *and* second cousin, once removed + * either way, as the saying is, if you follow me." --the Gaffer */ #include "EXTERN.h" #include "perl.h" -/* Lowest byte of opargs */ -#define OA_MARK 1 -#define OA_FOLDCONST 2 -#define OA_RETSCALAR 4 -#define OA_TARGET 8 -#define OA_RETINTEGER 16 -#define OA_OTHERINT 32 -#define OA_DANGEROUS 64 - -/* Remaining nybbles of opargs */ -#define OA_SCALAR 1 -#define OA_LIST 2 -#define OA_AVREF 3 -#define OA_HVREF 4 -#define OA_CVREF 5 -#define OA_FILEREF 6 -#define OA_SCALARREF 7 -#define OA_OPTIONAL 8 - -void -cpy7bit(d,s,l) -register char *d; -register char *s; -register I32 l; -{ - while (l--) - *d++ = *s++ & 127; - *d = '\0'; -} +static I32 list_assignment _((OP *op)); +static OP *bad_type _((I32 n, char *t, OP *op, OP *kid)); +static OP *modkids _((OP *op, I32 type)); +static OP *no_fh_allowed _((OP *op)); +static OP *scalarboolean _((OP *op)); +static OP *too_few_arguments _((OP *op)); +static OP *too_many_arguments _((OP *op)); +static void null _((OP* op)); static OP * no_fh_allowed(op) @@ -77,19 +63,42 @@ OP *op; OP *kid; { sprintf(tokenbuf, "Type of arg %d to %s must be %s (not %s)", - n, op_name[op->op_type], t, op_name[kid->op_type]); + (int) n, op_name[op->op_type], t, op_name[kid->op_type]); yyerror(tokenbuf); return op; } +void +assertref(op) +OP *op; +{ + int type = op->op_type; + if (type != OP_AELEM && type != OP_HELEM) { + sprintf(tokenbuf, "Can't use %s as left arg of implicit ->", + op_name[type]); + yyerror(tokenbuf); + if (type == OP_RV2HV || type == OP_ENTERSUB) + warn("(Did you mean $ instead of %c?)\n", + type == OP_RV2HV ? '%' : '&'); + } +} + /* "register" allocation */ PADOFFSET pad_allocmy(name) char *name; { - PADOFFSET off = pad_alloc(OP_PADSV, SVs_PADMY); - SV *sv = NEWSV(0,0); + PADOFFSET off; + SV *sv; + + if (!(isALPHA(name[1]) || name[1] == '_' && (int)strlen(name) > 2)) { + if (!isprint(name[1])) + sprintf(name+1, "^%c", name[1] ^ 64); /* XXX is tokenbuf, really */ + croak("Can't use global %s in \"my\"",name); + } + off = pad_alloc(OP_PADSV, SVs_PADMY); + sv = NEWSV(1102,0); sv_upgrade(sv, SVt_PVNV); sv_setpv(sv, name); av_store(comppad_name, off, sv); @@ -115,7 +124,7 @@ char *name; SV **svp = AvARRAY(comppad_name); register I32 i; register CONTEXT *cx; - bool saweval; + int saweval; AV *curlist; AV *curname; CV *cv; @@ -124,6 +133,7 @@ char *name; /* The one we're looking for is probably just before comppad_name_fill. */ for (off = comppad_name_fill; off > 0; off--) { if ((sv = svp[off]) && + sv != &sv_undef && seq <= SvIVX(sv) && seq > (I32)SvNVX(sv) && strEQ(SvPVX(sv), name)) @@ -137,14 +147,14 @@ char *name; * XXX This will also probably interact badly with eval tree caching. */ - saweval = FALSE; + saweval = 0; for (i = cxstack_ix; i >= 0; i--) { cx = &cxstack[i]; switch (cx->cx_type) { default: break; case CXt_EVAL: - saweval = TRUE; + saweval = i; break; case CXt_SUB: if (!saweval) @@ -152,12 +162,13 @@ char *name; cv = cx->blk_sub.cv; if (debstash && CvSTASH(cv) == debstash) /* ignore DB'* scope */ continue; - seq = cxstack[i+1].blk_oldcop->cop_seq; + seq = cxstack[saweval].blk_oldcop->cop_seq; curlist = CvPADLIST(cv); curname = (AV*)*av_fetch(curlist, 0, FALSE); svp = AvARRAY(curname); for (off = AvFILL(curname); off > 0; off--) { if ((sv = svp[off]) && + sv != &sv_undef && seq <= SvIVX(sv) && seq > (I32)SvNVX(sv) && strEQ(SvPVX(sv), name)) @@ -165,7 +176,7 @@ char *name; PADOFFSET newoff = pad_alloc(OP_PADSV, SVs_PADMY); AV *oldpad = (AV*)*av_fetch(curlist, CvDEPTH(cv), FALSE); SV *oldsv = *av_fetch(oldpad, off, TRUE); - SV *sv = NEWSV(0,0); + SV *sv = NEWSV(1103,0); sv_upgrade(sv, SVt_PVNV); sv_setpv(sv, name); av_store(comppad_name, newoff, sv); @@ -179,6 +190,31 @@ char *name; } } + if (!saweval) + return 0; + + /* It's stupid to dup this code. main should be stored in a CV. */ + seq = cxstack[saweval].blk_oldcop->cop_seq; + svp = AvARRAY(padname); + for (off = AvFILL(padname); off > 0; off--) { + if ((sv = svp[off]) && + sv != &sv_undef && + seq <= SvIVX(sv) && + seq > (I32)SvNVX(sv) && + strEQ(SvPVX(sv), name)) + { + PADOFFSET newoff = pad_alloc(OP_PADSV, SVs_PADMY); + SV *oldsv = *av_fetch(pad, off, TRUE); + SV *sv = NEWSV(1103,0); + sv_upgrade(sv, SVt_PVNV); + sv_setpv(sv, name); + av_store(comppad_name, newoff, sv); + SvNVX(sv) = (double)curcop->cop_seq; + SvIVX(sv) = 999999999; /* A ref, intro immediately */ + av_store(comppad, newoff, SvREFCNT_inc(oldsv)); + return newoff; + } + } return 0; } @@ -191,13 +227,13 @@ I32 fill; SV *sv; if (min_intro_pending && fill < min_intro_pending) { for (off = max_intro_pending; off >= min_intro_pending; off--) { - if (sv = svp[off]) + if ((sv = svp[off]) && sv != &sv_undef) warn("%s never introduced", SvPVX(sv)); } } /* "Deintroduce" my variables that are leaving with this scope. */ for (off = AvFILL(comppad_name); off > fill; off--) { - if (sv = svp[off]) + if ((sv = svp[off]) && sv != &sv_undef) SvIVX(sv) = cop_seqmax; } } @@ -212,6 +248,8 @@ U32 tmptype; if (AvARRAY(comppad) != curpad) croak("panic: pad_alloc"); + if (pad_reset_pending) + pad_reset(); if (tmptype & SVs_PADMY) { do { sv = *av_fetch(comppad, AvFILL(comppad) + 1, TRUE); @@ -226,17 +264,17 @@ U32 tmptype; } SvFLAGS(sv) |= tmptype; curpad = AvARRAY(comppad); - DEBUG_X(fprintf(stderr, "Pad alloc %d for %s\n", retval, op_name[optype])); + DEBUG_X(fprintf(stderr, "Pad alloc %ld for %s\n", (long) retval, op_name[optype])); return (PADOFFSET)retval; } SV * -#ifndef STANDARD_C +#ifndef CAN_PROTOTYPE pad_sv(po) PADOFFSET po; #else pad_sv(PADOFFSET po) -#endif /* STANDARD_C */ +#endif /* CAN_PROTOTYPE */ { if (!po) croak("panic: pad_sv po"); @@ -245,40 +283,43 @@ pad_sv(PADOFFSET po) } void -#ifndef STANDARD_C +#ifndef CAN_PROTOTYPE pad_free(po) PADOFFSET po; #else pad_free(PADOFFSET po) -#endif /* STANDARD_C */ +#endif /* CAN_PROTOTYPE */ { + if (!curpad) + return; if (AvARRAY(comppad) != curpad) croak("panic: pad_free curpad"); if (!po) croak("panic: pad_free po"); DEBUG_X(fprintf(stderr, "Pad free %d\n", po)); - if (curpad[po]) + if (curpad[po] && curpad[po] != &sv_undef) SvPADTMP_off(curpad[po]); - if (po < padix) + if ((I32)po < padix) padix = po - 1; } void -#ifndef STANDARD_C +#ifndef CAN_PROTOTYPE pad_swipe(po) PADOFFSET po; #else pad_swipe(PADOFFSET po) -#endif /* STANDARD_C */ +#endif /* CAN_PROTOTYPE */ { if (AvARRAY(comppad) != curpad) croak("panic: pad_swipe curpad"); if (!po) croak("panic: pad_swipe po"); DEBUG_X(fprintf(stderr, "Pad swipe %d\n", po)); - curpad[po] = NEWSV(0,0); SvPADTMP_off(curpad[po]); - if (po < padix) + curpad[po] = NEWSV(1107,0); + SvPADTMP_on(curpad[po]); + if ((I32)po < padix) padix = po - 1; } @@ -290,11 +331,12 @@ pad_reset() if (AvARRAY(comppad) != curpad) croak("panic: pad_reset curpad"); DEBUG_X(fprintf(stderr, "Pad reset\n")); - for (po = AvMAX(comppad); po > 0; po--) { - if (curpad[po]) + for (po = AvMAX(comppad); po > padix_floor; po--) { + if (curpad[po] && curpad[po] != &sv_undef) SvPADTMP_off(curpad[po]); } - padix = 0; + padix = padix_floor; + pad_reset_pending = FALSE; } /* Destructor */ @@ -320,9 +362,12 @@ OP *op; case OP_NULL: op->op_targ = 0; /* Was holding old type, if any. */ break; + case OP_ENTEREVAL: + op->op_targ = 0; /* Was holding hints. */ + break; case OP_GVSV: case OP_GV: - SvREFCNT_dec((SV*)cGVOP->op_gv); + SvREFCNT_dec(cGVOP->op_gv); break; case OP_NEXTSTATE: case OP_DBSTATE: @@ -331,6 +376,17 @@ OP *op; case OP_CONST: SvREFCNT_dec(cSVOP->op_sv); break; + case OP_TRANS: + Safefree(cPVOP->op_pv); + break; + case OP_SUBST: + op_free(cPMOP->op_pmreplroot); + /* FALL THROUGH */ + case OP_MATCH: + regfree(cPMOP->op_pmregexp); + break; + default: + break; } if (op->op_targ > 0) @@ -350,17 +406,6 @@ OP* op; op->op_ppaddr = ppaddr[OP_NULL]; } -static void -unlist(op) -OP* op; -{ - OP* kid = cLISTOP->op_first; - assert(kid->op_type == OP_PUSHMARK); - cLISTOP->op_first = kid->op_sibling; - null(kid); - null(op); -} - /* Contextualizers */ #define LINKLIST(o) ((o)->op_next ? (o)->op_next : linklist((OP*)o)) @@ -402,13 +447,19 @@ OP *op; return op; } -OP * +static OP * scalarboolean(op) OP *op; { if (dowarn && - op->op_type == OP_SASSIGN && cBINOP->op_first->op_type == OP_CONST) - warn("Found = in conditional, should be =="); + op->op_type == OP_SASSIGN && cBINOP->op_first->op_type == OP_CONST) { + line_t oldline = curcop->cop_line; + + if (copline != NOLINE) + curcop->cop_line = copline; + warn("Found = in conditional, should be =="); + curcop->cop_line = oldline; + } return scalar(op); } @@ -418,7 +469,8 @@ OP *op; { OP *kid; - if (!op || (op->op_flags & OPf_KNOW)) /* assumes no premature commitment */ + /* assumes no premature commitment */ + if (!op || (op->op_flags & OPf_KNOW) || error_count) return op; op->op_flags &= ~OPf_LIST; @@ -434,6 +486,12 @@ OP *op; for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling) scalar(kid); break; + case OP_SPLIT: + if ((kid = ((LISTOP*)op)->op_first) && kid->op_type == OP_PUSHRE) { + if (!kPMOP->op_pmreplroot) + deprecate("implicit split to @_"); + } + /* FALL THROUGH */ case OP_MATCH: case OP_SUBST: case OP_NULL: @@ -468,7 +526,7 @@ OP *op; char* useless = 0; SV* sv; - if (!op) + if (!op || error_count) return op; if (op->op_flags & OPf_LIST) return op; @@ -492,6 +550,8 @@ OP *op; case OP_AV2ARYLEN: case OP_SV2LEN: case OP_REF: + case OP_REFGEN: + case OP_SREFGEN: case OP_DEFINED: case OP_HEX: case OP_OCT: @@ -551,7 +611,7 @@ OP *op; case OP_GGRNAM: case OP_GGRGID: case OP_GETLOGIN: - if (!(op->op_flags & OPf_INTRO)) + if (!(op->op_private & OPpLVAL_INTRO)) useless = op_name[op->op_type]; break; @@ -559,7 +619,7 @@ OP *op; case OP_RV2SV: case OP_RV2AV: case OP_RV2HV: - if (!(op->op_flags & OPf_INTRO) && + if (!(op->op_private & OPpLVAL_INTRO) && (!op->op_sibling || op->op_sibling->op_type != OP_READLINE)) useless = "a variable"; break; @@ -577,6 +637,7 @@ OP *op; useless = 0; else if (SvPOK(sv)) { if (strnEQ(SvPVX(sv), "di", 2) || + strnEQ(SvPVX(sv), "ds", 2) || strnEQ(SvPVX(sv), "ig", 2)) useless = 0; } @@ -606,20 +667,30 @@ OP *op; for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling) scalarvoid(kid); break; + case OP_NULL: + if (op->op_flags & OPf_STACKED) + break; case OP_ENTERTRY: case OP_ENTER: case OP_SCALAR: - case OP_NULL: if (!(op->op_flags & OPf_KIDS)) break; case OP_SCOPE: case OP_LEAVE: case OP_LEAVETRY: + case OP_LEAVELOOP: + op->op_private |= OPpLEAVE_VOID; case OP_LINESEQ: case OP_LIST: for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) scalarvoid(kid); break; + case OP_SPLIT: + if ((kid = ((LISTOP*)op)->op_first) && kid->op_type == OP_PUSHRE) { + if (!kPMOP->op_pmreplroot) + deprecate("implicit split to @_"); + } + break; } if (useless && dowarn) warn("Useless use of %s in void context", useless); @@ -644,7 +715,8 @@ OP *op; { OP *kid; - if (!op || (op->op_flags & OPf_KNOW)) /* assumes no premature commitment */ + /* assumes no premature commitment */ + if (!op || (op->op_flags & OPf_KNOW) || error_count) return op; op->op_flags |= (OPf_KNOW | OPf_LIST); @@ -717,7 +789,7 @@ OP *op; return op; } -OP * +static OP * modkids(op, type) OP *op; I32 type; @@ -739,14 +811,31 @@ I32 type; { OP *kid; SV *sv; + char mtype; - if (!op) + if (!op || error_count) return op; switch (op->op_type) { - case OP_ENTERSUBR: - if ((type == OP_UNDEF) && !(op->op_flags & OPf_STACKED)) { - op->op_type = OP_RV2CV; /* entersubr => rv2cv */ + case OP_CONST: + if (!(op->op_flags & (OPf_SPECIAL|OPf_MOD))) + goto nomod; + if (eval_start && eval_start->op_type == OP_CONST) { + compiling.cop_arybase = (I32)SvIV(((SVOP*)eval_start)->op_sv); + eval_start = 0; + } + else if (!type) { + SAVEI32(compiling.cop_arybase); + } + else if (type == OP_REFGEN) + goto nomod; + else + croak("That use of $[ is unsupported"); + break; + case OP_ENTERSUB: + if ((type == OP_UNDEF || type == OP_REFGEN) && + !(op->op_flags & OPf_STACKED)) { + op->op_type = OP_RV2CV; /* entersub => rv2cv */ op->op_ppaddr = ppaddr[OP_RV2CV]; assert(cUNOP->op_first->op_type == OP_NULL); null(((LISTOP*)cUNOP->op_first)->op_first); /* disable pushmark */ @@ -754,12 +843,41 @@ I32 type; } /* FALL THROUGH */ default: + nomod: + /* grep, foreach, subcalls, refgen */ + if (type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN) + break; sprintf(tokenbuf, "Can't modify %s in %s", op_name[op->op_type], type ? op_name[type] : "local"); yyerror(tokenbuf); return op; + case OP_PREINC: + case OP_PREDEC: + case OP_POW: + case OP_MULTIPLY: + case OP_DIVIDE: + case OP_MODULO: + case OP_REPEAT: + case OP_ADD: + case OP_SUBTRACT: + case OP_CONCAT: + case OP_LEFT_SHIFT: + case OP_RIGHT_SHIFT: + case OP_BIT_AND: + case OP_BIT_XOR: + case OP_BIT_OR: + case OP_I_MULTIPLY: + case OP_I_DIVIDE: + case OP_I_MODULO: + case OP_I_ADD: + case OP_I_SUBTRACT: + if (!(op->op_flags & OPf_STACKED)) + goto nomod; + modcount++; + break; + case OP_COND_EXPR: for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling) mod(kid, type); @@ -768,25 +886,23 @@ I32 type; case OP_RV2AV: case OP_RV2HV: case OP_RV2GV: - op->op_private = (hints & HINT_STRICT_REFS); ref(cUNOP->op_first, op->op_type); /* FALL THROUGH */ + case OP_PADAV: + case OP_PADHV: case OP_AASSIGN: case OP_ASLICE: case OP_HSLICE: case OP_NEXTSTATE: case OP_DBSTATE: + case OP_REFGEN: + case OP_CHOMP: modcount = 10000; break; case OP_RV2SV: - op->op_private = (hints & HINT_STRICT_REFS); - if (type == OP_RV2AV || type == OP_RV2HV) - op->op_private |= (type == OP_RV2AV ? OPpDEREF_AV : OPpDEREF_HV); ref(cUNOP->op_first, op->op_type); /* FALL THROUGH */ case OP_PADSV: - case OP_PADAV: - case OP_PADHV: case OP_UNDEF: case OP_GV: case OP_AV2ARYLEN: @@ -795,54 +911,65 @@ I32 type; modcount++; break; - case OP_REFGEN: - modcount++; - break; - case OP_PUSHMARK: break; - case OP_SUBSTR: + + case OP_POS: + mtype = '.'; + goto makelv; case OP_VEC: + mtype = 'v'; + goto makelv; + case OP_SUBSTR: + mtype = 'x'; + makelv: pad_free(op->op_targ); op->op_targ = pad_alloc(op->op_type, SVs_PADMY); sv = PAD_SV(op->op_targ); sv_upgrade(sv, SVt_PVLV); - sv_magic(sv, 0, op->op_type == OP_VEC ? 'v' : 'x', 0, 0); + sv_magic(sv, Nullsv, mtype, Nullch, 0); curpad[op->op_targ] = sv; - /* FALL THROUGH */ - case OP_NULL: if (op->op_flags & OPf_KIDS) mod(cBINOP->op_first, type); break; + case OP_AELEM: case OP_HELEM: ref(cBINOP->op_first, op->op_type); - op->op_private = (hints & HINT_STRICT_REFS); - if (type == OP_RV2AV || type == OP_RV2HV) - op->op_private |= (type == OP_RV2AV ? OPpDEREF_AV : OPpDEREF_HV); + modcount++; break; case OP_SCOPE: case OP_LEAVE: case OP_ENTER: + if (op->op_flags & OPf_KIDS) + mod(cLISTOP->op_last, type); + break; + + case OP_NULL: if (!(op->op_flags & OPf_KIDS)) break; - mod(cLISTOP->op_last, type); - break; - + if (op->op_targ != OP_LIST) { + mod(cBINOP->op_first, type); + break; + } + /* FALL THROUGH */ case OP_LIST: for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) mod(kid, type); break; } - op->op_flags |= OPf_LVAL; - if (!type) { + op->op_flags |= OPf_MOD; + + if (type == OP_AASSIGN || type == OP_SASSIGN) + op->op_flags |= OPf_SPECIAL|OPf_REF; + else if (!type) { + op->op_private |= OPpLVAL_INTRO; op->op_flags &= ~OPf_SPECIAL; - op->op_flags |= OPf_INTRO; } - else if (type == OP_AASSIGN || type == OP_SASSIGN) - op->op_flags |= OPf_SPECIAL; + else if (type != OP_GREPSTART && type != OP_ENTERSUB) + op->op_flags |= OPf_REF; return op; } @@ -865,16 +992,15 @@ OP *op; I32 type; { OP *kid; - SV *sv; - if (!op) + if (!op || error_count) return op; switch (op->op_type) { - case OP_ENTERSUBR: - if ((type == OP_REFGEN || type == OP_DEFINED) - && !(op->op_flags & (OPf_STACKED|OPf_PARENS))) { - op->op_type = OP_RV2CV; /* entersubr => rv2cv */ + case OP_ENTERSUB: + if ((type == OP_DEFINED) && + !(op->op_flags & OPf_STACKED)) { + op->op_type = OP_RV2CV; /* entersub => rv2cv */ op->op_ppaddr = ppaddr[OP_RV2CV]; assert(cUNOP->op_first->op_type == OP_NULL); null(((LISTOP*)cUNOP->op_first)->op_first); /* disable pushmark */ @@ -886,24 +1012,24 @@ I32 type; ref(kid, type); break; case OP_RV2SV: - op->op_private = (hints & HINT_STRICT_REFS); - if (type == OP_RV2AV || type == OP_RV2HV) - op->op_private |= (type == OP_RV2AV ? OPpDEREF_AV : OPpDEREF_HV); ref(cUNOP->op_first, op->op_type); + if (type == OP_RV2AV || type == OP_RV2HV) { + op->op_private |= (type == OP_RV2AV ? OPpDEREF_AV : OPpDEREF_HV); + op->op_flags |= OPf_MOD; + } break; case OP_RV2AV: case OP_RV2HV: - op->op_flags |= OPf_LVAL; + op->op_flags |= OPf_REF; /* FALL THROUGH */ case OP_RV2GV: - op->op_private = (hints & HINT_STRICT_REFS); ref(cUNOP->op_first, op->op_type); break; case OP_PADAV: case OP_PADHV: - op->op_flags |= OPf_LVAL; + op->op_flags |= OPf_REF; break; case OP_SCALAR: @@ -915,11 +1041,9 @@ I32 type; case OP_AELEM: case OP_HELEM: ref(cBINOP->op_first, op->op_type); - op->op_private = (hints & HINT_STRICT_REFS); - if (type == OP_RV2AV || type == OP_RV2HV || type == OP_REFGEN) { - op->op_private |= (type == OP_RV2AV ? OPpDEREF_AV : - type == OP_RV2HV ? OPpDEREF_HV : 0); - op->op_flags |= OPf_LVAL; + if (type == OP_RV2AV || type == OP_RV2HV) { + op->op_private |= (type == OP_RV2AV ? OPpDEREF_AV : OPpDEREF_HV); + op->op_flags |= OPf_MOD; } break; @@ -931,6 +1055,8 @@ I32 type; break; ref(cLISTOP->op_last, type); break; + default: + break; } return scalar(op); @@ -941,10 +1067,9 @@ my(op) OP *op; { OP *kid; - SV *sv; I32 type; - if (!op) + if (!op || error_count) return op; type = op->op_type; @@ -961,7 +1086,8 @@ OP *op; yyerror(tokenbuf); return op; } - op->op_flags |= OPf_LVAL|OPf_INTRO; + op->op_flags |= OPf_MOD; + op->op_private |= OPpLVAL_INTRO; return op; } @@ -989,7 +1115,7 @@ OP *right; if (right->op_type != OP_MATCH) left = mod(left, right->op_type); if (right->op_type == OP_TRANS) - op = newBINOP(OP_NULL, 0, scalar(left), right); + op = newBINOP(OP_NULL, OPf_STACKED, scalar(left), right); else op = prepend_elem(right->op_type, scalar(left), right); if (type == OP_NOT) @@ -1016,7 +1142,7 @@ scope(o) OP *o; { if (o) { - if (o->op_flags & OPf_PARENS) { + if (o->op_flags & OPf_PARENS || perldb) { o = prepend_elem(OP_LINESEQ, newOP(OP_ENTER, 0), o); o->op_type = OP_LEAVE; o->op_ppaddr = ppaddr[OP_LEAVE]; @@ -1037,21 +1163,62 @@ OP *o; return o; } -OP * -block_head(o, startp) -OP *o; -OP **startp; +int +block_start() { - if (!o) { - *startp = 0; - return o; + int retval = savestack_ix; + comppad_name_fill = AvFILL(comppad_name); + SAVEINT(min_intro_pending); + SAVEINT(max_intro_pending); + min_intro_pending = 0; + SAVEINT(comppad_name_fill); + SAVEINT(padix_floor); + padix_floor = padix; + pad_reset_pending = FALSE; + SAVEINT(hints); + hints &= ~HINT_BLOCK_SCOPE; + return retval; +} + +OP* +block_end(line, floor, seq) +int line; +int floor; +OP* seq; +{ + int needblockscope = hints & HINT_BLOCK_SCOPE; + OP* retval = scalarseq(seq); + if (copline > (line_t)line) + copline = line; + LEAVE_SCOPE(floor); + pad_reset_pending = FALSE; + if (needblockscope) + hints |= HINT_BLOCK_SCOPE; /* propagate out */ + pad_leavemy(comppad_name_fill); + return retval; +} + +void +newPROG(op) +OP *op; +{ + if (in_eval) { + eval_root = newUNOP(OP_LEAVEEVAL, 0, op); + eval_start = linklist(eval_root); + eval_root->op_next = 0; + peep(eval_start); + } + else { + if (!op) { + main_start = 0; + return; + } + main_root = scope(sawparens(scalarvoid(op))); + curcop = &compiling; + main_start = LINKLIST(main_root); + main_root->op_next = 0; + peep(main_start); } - o = scope(sawparens(scalarvoid(o))); - curcop = &compiling; - *startp = LINKLIST(o); - o->op_next = 0; - peep(*startp); - return o; } OP * @@ -1066,7 +1233,7 @@ I32 lex; if (dowarn && bufptr > oldbufptr && bufptr[-1] == ',') { char *s; for (s = bufptr; *s && (isALNUM(*s) || strchr("@$%, ",*s)); s++) ; - if (*s == ';' || *s == '=' && (s[1] == '@' || s[2] == '@')) + if (*s == ';' || *s == '=') warn("Parens missing around \"%s\" list", lex ? "my" : "local"); } } @@ -1096,7 +1263,6 @@ register OP *o; { register OP *curop; I32 type = o->op_type; - SV *sv; if (opargs[type] & OA_RETSCALAR) scalar(o); @@ -1104,15 +1270,19 @@ register OP *o; o->op_targ = pad_alloc(type, SVs_PADTMP); if ((opargs[type] & OA_OTHERINT) && (hints & HINT_INTEGER)) - o->op_ppaddr = ppaddr[++(o->op_type)]; + o->op_ppaddr = ppaddr[type = ++(o->op_type)]; if (!(opargs[type] & OA_FOLDCONST)) goto nope; + if (error_count) + goto nope; /* Don't try to run w/ errors */ + for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) { if (curop->op_type != OP_CONST && curop->op_type != OP_LIST && curop->op_type != OP_SCALAR && + curop->op_type != OP_NULL && curop->op_type != OP_PUSHMARK) { goto nope; } @@ -1125,7 +1295,7 @@ register OP *o; if (o->op_targ && *stack_sp == PAD_SV(o->op_targ)) /* grab pad temp? */ pad_swipe(o->op_targ); else if (SvTEMP(*stack_sp)) { /* grab mortal temp? */ - SvREFCNT_inc(*stack_sp); + (void)SvREFCNT_inc(*stack_sp); SvTEMP_off(*stack_sp); } op_free(o); @@ -1139,7 +1309,7 @@ register OP *o; return o; if (!(hints & HINT_INTEGER)) { - if (!(o->op_flags & OPf_KIDS)) + if (type == OP_DIVIDE || !(o->op_flags & OPf_KIDS)) return o; for (curop = ((UNOP*)o)->op_first; curop; curop = curop->op_sibling) { @@ -1152,9 +1322,9 @@ register OP *o; continue; return o; } + o->op_ppaddr = ppaddr[++(o->op_type)]; } - o->op_ppaddr = ppaddr[++(o->op_type)]; return o; } @@ -1163,34 +1333,25 @@ gen_constant_list(o) register OP *o; { register OP *curop; - OP *anonop; - I32 tmpmark; - I32 tmpsp; I32 oldtmps_floor = tmps_floor; - AV *av; - GV *gv; - tmpmark = stack_sp - stack_base; - anonop = newANONLIST(o); - curop = LINKLIST(anonop); - anonop->op_next = 0; - op = curop; + list(o); + if (error_count) + return o; /* Don't attempt to run with errors */ + + op = curop = LINKLIST(o); + o->op_next = 0; + pp_pushmark(); run(); - tmpsp = stack_sp - stack_base; + op = curop; + pp_anonlist(); tmps_floor = oldtmps_floor; - stack_sp = stack_base + tmpmark; o->op_type = OP_RV2AV; o->op_ppaddr = ppaddr[OP_RV2AV]; - o->op_sibling = 0; curop = ((UNOP*)o)->op_first; - ((UNOP*)o)->op_first = newSVOP(OP_CONST, 0, newSVsv(stack_sp[1])); + ((UNOP*)o)->op_first = newSVOP(OP_CONST, 0, SvREFCNT_inc(*stack_sp--)); op_free(curop); - curop = ((UNOP*)anonop)->op_first; - curop = ((UNOP*)curop)->op_first; - curop->op_sibling = 0; - op_free(anonop); - o->op_next = 0; linklist(o); return list(o); } @@ -1202,7 +1363,7 @@ I32 flags; OP* op; { OP *kid; - OP *last; + OP *last = 0; if (!op || op->op_type != OP_LIST) op = newLISTOP(OP_LIST, 0, op, Nullop); @@ -1242,19 +1403,18 @@ OP* last; if (!last) return first; - if (first->op_type == type) { - if (first->op_flags & OPf_KIDS) - ((LISTOP*)first)->op_last->op_sibling = last; - else { - first->op_flags |= OPf_KIDS; - ((LISTOP*)first)->op_first = last; - } - ((LISTOP*)first)->op_last = last; - ((LISTOP*)first)->op_children++; - return first; - } + if (first->op_type != type || type==OP_LIST && first->op_flags & OPf_PARENS) + return newLISTOP(type, 0, first, last); - return newLISTOP(type, 0, first, last); + if (first->op_flags & OPf_KIDS) + ((LISTOP*)first)->op_last->op_sibling = last; + else { + first->op_flags |= OPf_KIDS; + ((LISTOP*)first)->op_first = last; + } + ((LISTOP*)first)->op_last = last; + ((LISTOP*)first)->op_children++; + return first; } OP * @@ -1406,8 +1566,6 @@ OP* first; first = newOP(OP_STUB, 0); if (opargs[type] & OA_MARK) first = force_list(first); - else if (first->op_type == OP_LIST) - unlist(first); Newz(1101, unop, 1, UNOP); unop->op_type = type; @@ -1420,7 +1578,7 @@ OP* first; if (unop->op_next) return (OP*)unop; - return fold_constants(unop); + return fold_constants((OP *) unop); } OP * @@ -1455,7 +1613,7 @@ OP* last; binop->op_last = last = binop->op_first->op_sibling; - return fold_constants(binop); + return fold_constants((OP *)binop); } OP * @@ -1464,7 +1622,6 @@ OP *op; OP *expr; OP *repl; { - PMOP *pm = (PMOP*)op; SV *tstr = ((SVOP*)expr)->op_sv; SV *rstr = ((SVOP*)repl)->op_sv; STRLEN tlen; @@ -1541,7 +1698,7 @@ I32 flags; pmop->op_private = 0; /* link into pm list */ - if (type != OP_TRANS) { + if (type != OP_TRANS && curstash) { pmop->op_pmnext = HvPMROOT(curstash); HvPMROOT(curstash) = pmop; } @@ -1572,10 +1729,12 @@ OP *repl; p = SvPV(pat, plen); pm->op_pmflags |= PMf_SKIPWHITE; } +#ifdef NOTDEF scan_prefix(pm, p, plen); if (pm->op_pmshort && (pm->op_pmflags & PMf_SCANFIRST)) fbm_compile(pm->op_pmshort, pm->op_pmflags & PMf_FOLD); - pm->op_pmregexp = regcomp(p, p + plen, pm->op_pmflags & PMf_FOLD); +#endif + pm->op_pmregexp = regcomp(p, p + plen, pm); if (strEQ("\\s+", pm->op_pmregexp->precomp)) pm->op_pmflags |= PMf_WHITE; hoistmust(pm); @@ -1757,8 +1916,8 @@ OP *op; STRLEN len; char *name; sv = cSVOP->op_sv; - curstash = fetch_stash(sv,TRUE); name = SvPV(sv, len); + curstash = gv_stashpv(name,TRUE); sv_setpvn(curstname, name, len); op_free(op); } @@ -1771,82 +1930,48 @@ OP *op; } void -hint(aver, id, arg) +utilize(aver, id, arg) int aver; OP *id; OP *arg; { - SV *sv; - U32 bits = 0; - SV **sp = 0; - SV **mark = 0; - - if (arg) { - OP* curop = LINKLIST(arg); - arg->op_next = 0; - op = curop; - run(); - sp = stack_sp; - mark = stack_base + POPMARK; - stack_sp = mark; /* Might as well reset sp now. */ - } - if (id) { - STRLEN len; - char *name; - sv = ((SVOP*)id)->op_sv; - name = SvPV(sv, len); + OP *pack; + OP *meth; + OP *rqop; + OP *imop; - if (strEQ(name, "integer")) - bits = HINT_INTEGER; - else if (strEQ(name, "strict")) { - if (arg) { - while (++mark <= sp) { - if (strEQ(SvPV(*mark,na), "refs")) - bits |= HINT_STRICT_REFS; - else if (strEQ(SvPV(*mark,na), "subs")) - bits |= HINT_STRICT_SUBS; - else if (strEQ(SvPV(*mark,na), "vars")) - bits |= HINT_STRICT_VARS; - } - } - else - bits = HINT_STRICT_REFS|HINT_STRICT_SUBS|HINT_STRICT_VARS; - } + if (id->op_type != OP_CONST) + croak("Module name must be constant"); - if (aver) - hints |= bits; - else - hints &= ~bits; + meth = newSVOP(OP_CONST, 0, + aver + ? newSVpv("import", 6) + : newSVpv("unimport", 8) + ); + + /* Make copy of id so we don't free it twice */ + pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)id)->op_sv)); + + /* Fake up a require */ + rqop = newUNOP(OP_REQUIRE, 0, id); + + /* Fake up an import/unimport */ + imop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL, + append_elem(OP_LIST, + prepend_elem(OP_LIST, pack, list(arg)), + newUNOP(OP_METHOD, 0, meth))); + + /* Fake up the BEGIN {}, which does its thing immediately. */ + newSUB(start_subparse(), + newSVOP(OP_CONST, 0, newSVpv("BEGIN", 5)), + append_elem(OP_LINESEQ, + newSTATEOP(0, Nullch, rqop), + newSTATEOP(0, Nullch, imop) )); - op_free(id); - } - if (arg) - op_free(arg); copline = NOLINE; expect = XSTATE; } -HV* -fetch_stash(sv,create) -SV *sv; -I32 create; -{ - char tmpbuf[256]; - HV *stash; - GV *tmpgv; - char *name = SvPV(sv, na); - sprintf(tmpbuf,"%s::",name); - tmpgv = gv_fetchpv(tmpbuf,create, SVt_PVHV); - if (!tmpgv) - return 0; - if (!GvHV(tmpgv)) - GvHV(tmpgv) = newHV(); - stash = GvHV(tmpgv); - if (!HvNAME(stash)) - HvNAME(stash) = savestr(name); - return stash; -} - OP * newSLICEOP(flags, subscript, listval) I32 flags; @@ -1894,20 +2019,41 @@ register OP *op; } OP * -newASSIGNOP(flags, left, right) +newASSIGNOP(flags, left, optype, right) I32 flags; OP *left; +I32 optype; OP *right; { OP *op; + if (optype) { + if (optype == OP_ANDASSIGN || optype == OP_ORASSIGN) { + return newLOGOP(optype, 0, + mod(scalar(left), optype), + newUNOP(OP_SASSIGN, 0, scalar(right))); + } + else { + return newBINOP(optype, OPf_STACKED, + mod(scalar(left), optype), scalar(right)); + } + } + if (list_assignment(left)) { modcount = 0; + eval_start = right; /* Grandfathering $[ assignment here. Bletch. */ left = mod(left, OP_AASSIGN); + if (!eval_start) { + op_free(left); + op_free(right); + return Nullop; + } if (right && right->op_type == OP_SPLIT) { if ((op = ((LISTOP*)right)->op_first) && op->op_type == OP_PUSHRE) { PMOP *pm = (PMOP*)op; - if (left->op_type == OP_RV2AV) { + if (left->op_type == OP_RV2AV && + !(left->op_private & OPpLVAL_INTRO) ) + { op = ((UNOP*)left)->op_first; if (op->op_type == OP_GV && !pm->op_pmreplroot) { pm->op_pmreplroot = (OP*)((GVOP*)op)->op_gv; @@ -1929,7 +2075,7 @@ OP *right; list(force_list(right)), list(force_list(left)) ); op->op_private = 0; - if (!(left->op_flags & OPf_INTRO)) { + if (!(left->op_private & OPpLVAL_INTRO)) { static int generation = 0; OP *curop; OP *lastop = op; @@ -1967,9 +2113,15 @@ OP *right; right->op_flags |= OPf_STACKED; return newBINOP(OP_NULL, flags, mod(scalar(left), OP_SASSIGN), scalar(right)); } - else + else { + eval_start = right; /* Grandfathering $[ assignment here. Bletch. */ op = newBINOP(OP_SASSIGN, flags, scalar(right), mod(scalar(left), OP_SASSIGN) ); + if (!eval_start) { + op_free(op); + return Nullop; + } + } return op; } @@ -1987,7 +2139,7 @@ OP *op; I32 i; SV *sv; for (i = min_intro_pending; i <= max_intro_pending; i++) { - if (sv = svp[i]) + if ((sv = svp[i]) && sv != &sv_undef) SvIVX(sv) = 999999999; /* Don't know scope end yet. */ } min_intro_pending = 0; @@ -2012,6 +2164,7 @@ OP *op; hints |= HINT_BLOCK_SCOPE; } cop->cop_seq = cop_seqmax++; + cop->cop_arybase = curcop->cop_arybase; if (copline == NOLINE) cop->cop_line = curcop->cop_line; @@ -2026,7 +2179,7 @@ OP *op; SV **svp = av_fetch(GvAV(curcop->cop_filegv),(I32)cop->cop_line, FALSE); if (svp && *svp != &sv_undef && !SvIOK(*svp)) { SvIVX(*svp) = 1; - SvIOK_on(*svp); + (void)SvIOK_on(*svp); SvSTASH(*svp) = (HV*)cop; } } @@ -2044,6 +2197,9 @@ OP* other; LOGOP *logop; OP *op; + if (type == OP_XOR) /* Not short circuit, but here by precedence. */ + return newBINOP(type, flags, scalar(first), scalar(other)); + scalarboolean(first); /* optimize "!a && b" to "a || b", and "!a || b" to "a && b" */ if (first->op_type == OP_NOT && (first->op_flags & OPf_SPECIAL)) { @@ -2082,6 +2238,9 @@ OP* other; if (!other) return first; + if (type == OP_ANDASSIGN || type == OP_ORASSIGN) + other->op_private |= OPpASSIGN_BACKWARDS; /* other is an OP_SASSIGN */ + Newz(1101, logop, 1, LOGOP); logop->op_type = type; @@ -2215,13 +2374,13 @@ OP *block; OP* listop; OP* op; int once = block && block->op_flags & OPf_SPECIAL && - (block->op_type == OP_ENTERSUBR || block->op_type == OP_NULL); + (block->op_type == OP_ENTERSUB || block->op_type == OP_NULL); if (expr) { if (once && expr->op_type == OP_CONST && !SvTRUE(((SVOP*)expr)->op_sv)) return block; /* do {} while 0 does once */ else if (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB) - expr = newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), expr); + expr = newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr); } listop = append_elem(OP_LINESEQ, block, newOP(OP_UNSTACK, 0)); @@ -2233,7 +2392,9 @@ OP *block; op->op_next = ((LOGOP*)cUNOP->op_first)->op_other; op->op_flags |= flags; - return scope(op); + op = scope(op); + op->op_flags |= OPf_SPECIAL; /* suppress POPBLOCK curpm restoration */ + return op; } OP * @@ -2252,7 +2413,7 @@ OP *cont; OP *condop; if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB)) - expr = newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), expr); + expr = newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr); if (!block) block = newOP(OP_NULL, 0); @@ -2303,7 +2464,7 @@ OP *cont; } OP * -#ifndef STANDARD_C +#ifndef CAN_PROTOTYPE newFOROP(flags,label,forline,sv,expr,block,cont) I32 flags; char *label; @@ -2314,7 +2475,7 @@ OP*block; OP*cont; #else newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont) -#endif /* STANDARD_C */ +#endif /* CAN_PROTOTYPE */ { LOOP *loop; int padoff = 0; @@ -2340,7 +2501,8 @@ newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont sv = newGVOP(OP_GV, 0, defgv); } loop = (LOOP*)list(convert(OP_ENTERITER, 0, - append_elem(OP_LIST, force_list(expr), scalar(sv)))); + append_elem(OP_LIST, mod(force_list(expr), OP_GREPSTART), + scalar(sv)))); assert(!loop->op_next); Renew(loop, 1, LOOP); loop->op_targ = padoff; @@ -2355,12 +2517,15 @@ OP* label; { OP *op; if (type != OP_GOTO || label->op_type == OP_CONST) { - op = newPVOP(type, 0, savestr(SvPVx(((SVOP*)label)->op_sv, na))); + op = newPVOP(type, 0, savepv( + label->op_type == OP_CONST + ? SvPVx(((SVOP*)label)->op_sv, na) + : "" )); op_free(label); } else { - if (label->op_type == OP_ENTERSUBR) - label = newUNOP(OP_REFGEN, 0, ref(label, OP_REFGEN)); + if (label->op_type == OP_ENTERSUB) + label = newUNOP(OP_REFGEN, 0, mod(label, OP_REFGEN)); op = newUNOP(type, OPf_STACKED, label); } hints |= HINT_BLOCK_SCOPE; @@ -2371,53 +2536,50 @@ void cv_undef(cv) CV *cv; { - if (!CvUSERSUB(cv) && CvROOT(cv)) { + if (!CvXSUB(cv) && CvROOT(cv)) { + if (CvDEPTH(cv)) + croak("Can't undef active subroutine"); ENTER; - if (CvPADLIST(cv)) { - SV** svp = av_fetch(CvPADLIST(cv), 0, FALSE); - if (svp) { - SAVESPTR(comppad); - SAVESPTR(curpad); - comppad = (AV*)*svp; /* Need same context we had compiling */ - curpad = AvARRAY(comppad); - } - } + + SAVESPTR(curpad); + curpad = 0; + op_free(CvROOT(cv)); CvROOT(cv) = Nullop; - if (CvDEPTH(cv)) - warn("Deleting active subroutine"); /* XXX */ if (CvPADLIST(cv)) { I32 i = AvFILL(CvPADLIST(cv)); - while (i > 0) { + while (i >= 0) { SV** svp = av_fetch(CvPADLIST(cv), i--, FALSE); if (svp) - sv_free(*svp); + SvREFCNT_dec(*svp); } - sv_free(CvPADLIST(cv)); + SvREFCNT_dec((SV*)CvPADLIST(cv)); } SvREFCNT_dec(CvGV(cv)); LEAVE; } } -void +CV * newSUB(floor,op,block) I32 floor; OP *op; OP *block; { register CV *cv; - char *name = SvPVx(cSVOP->op_sv, na); - GV *gv = gv_fetchpv(name,2, SVt_PVCV); + char *name = op ? SvPVx(cSVOP->op_sv, na) : "__ANON__"; + GV *gv = gv_fetchpv(name, GV_ADDMULTI, SVt_PVCV); AV* av; char *s; + I32 ix; - sub_generation++; - if ((cv = GvCV(gv)) && !GvCVGEN(gv)) { - if (CvDEPTH(cv)) - CvDELETED(cv) = TRUE; /* probably an autoloader */ - else { - if (dowarn && CvROOT(cv)) { + if (op) + sub_generation++; + if (cv = GvCV(gv)) { + if (GvCVGEN(gv)) + cv = 0; /* just a cached method */ + else if (CvROOT(cv)) { /* already defined? */ + if (dowarn) { line_t oldline = curcop->cop_line; curcop->cop_line = copline; @@ -2425,45 +2587,54 @@ OP *block; curcop->cop_line = oldline; } SvREFCNT_dec(cv); + cv = 0; } } - Newz(101,cv,1,CV); - sv_upgrade(cv, SVt_PVCV); - SvREFCNT(cv) = 1; + if (cv) { /* must reuse cv if autoloaded */ + assert(SvREFCNT(CvGV(cv)) > 1); + SvREFCNT_dec(CvGV(cv)); + } + else { + cv = (CV*)NEWSV(1104,0); + sv_upgrade((SV *)cv, SVt_PVCV); + } GvCV(gv) = cv; GvCVGEN(gv) = 0; CvFILEGV(cv) = curcop->cop_filegv; CvGV(cv) = SvREFCNT_inc(gv); CvSTASH(cv) = curstash; - av = newAV(); - av_store(av, 0, Nullsv); + if (!block) { + CvROOT(cv) = 0; + op_free(op); + copline = NOLINE; + LEAVE_SCOPE(floor); + return cv; + } + + av = newAV(); /* Will be @_ */ + av_extend(av, 0); av_store(comppad, 0, (SV*)av); - SvOK_on(av); - AvREAL_off(av); + AvFLAGS(av) = AVf_REIFY; + + for (ix = AvFILL(comppad); ix > 0; ix--) { + if (!SvPADMY(curpad[ix])) + SvPADTMP_on(curpad[ix]); + } av = newAV(); AvREAL_off(av); if (AvFILL(comppad_name) < AvFILL(comppad)) av_store(comppad_name, AvFILL(comppad), Nullsv); - av_store(av, 0, (SV*)comppad_name); - av_store(av, 1, (SV*)comppad); + av_store(av, 0, SvREFCNT_inc((SV*)comppad_name)); + av_store(av, 1, SvREFCNT_inc((SV*)comppad)); AvFILL(av) = 1; CvPADLIST(cv) = av; - comppad_name = newAV(); - if (!block) { - CvROOT(cv) = 0; - op_free(op); - copline = NOLINE; - LEAVE_SCOPE(floor); - return; - } - CvROOT(cv) = newUNOP(OP_LEAVESUBR, 0, scalarseq(block)); + CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block)); CvSTART(cv) = LINKLIST(CvROOT(cv)); CvROOT(cv)->op_next = 0; peep(CvSTART(cv)); - CvDELETED(cv) = FALSE; if (s = strrchr(name,':')) s++; else @@ -2502,7 +2673,7 @@ OP *block; SV *sv; SV *tmpstr = sv_newmortal(); - sprintf(buf,"%s:%ld",SvPVX(GvSV(curcop->cop_filegv)), subline); + sprintf(buf,"%s:%ld",SvPVX(GvSV(curcop->cop_filegv)), (long)subline); sv = newSVpv(buf,0); sv_catpv(sv,"-"); sprintf(buf,"%ld",(long)curcop->cop_line); @@ -2513,40 +2684,69 @@ OP *block; op_free(op); copline = NOLINE; LEAVE_SCOPE(floor); + if (!op) + GvCV(gv) = 0; /* Will remember in SVOP instead. */ + return cv; } -void +#ifdef DEPRECATED +CV * newXSUB(name, ix, subaddr, filename) char *name; I32 ix; I32 (*subaddr)(); char *filename; { + CV* cv = newXS(name, (void(*)())subaddr, filename); + CvOLDSTYLE(cv) = TRUE; + CvXSUBANY(cv).any_i32 = ix; + return cv; +} +#endif + +CV * +newXS(name, subaddr, filename) +char *name; +void (*subaddr) _((CV*)); +char *filename; +{ register CV *cv; - GV *gv = gv_fetchpv(name,2, SVt_PVCV); + GV *gv = gv_fetchpv((name ? name : "__ANON__"), GV_ADDMULTI, SVt_PVCV); char *s; - sub_generation++; - if ((cv = GvCV(gv)) && !GvCVGEN(gv)) { - if (dowarn) - warn("Subroutine %s redefined",name); - if (!CvUSERSUB(cv) && CvROOT(cv)) { - op_free(CvROOT(cv)); - CvROOT(cv) = Nullop; + if (name) + sub_generation++; + if (cv = GvCV(gv)) { + if (GvCVGEN(gv)) + cv = 0; /* just a cached method */ + else if (CvROOT(cv)) { /* already defined? */ + if (dowarn) { + line_t oldline = curcop->cop_line; + + curcop->cop_line = copline; + warn("Subroutine %s redefined",name); + curcop->cop_line = oldline; + } + SvREFCNT_dec(cv); + cv = 0; } - Safefree(cv); } - Newz(101,cv,1,CV); - sv_upgrade(cv, SVt_PVCV); - SvREFCNT(cv) = 1; + if (cv) { /* must reuse cv if autoloaded */ + assert(SvREFCNT(CvGV(cv)) > 1); + SvREFCNT_dec(CvGV(cv)); + } + else { + cv = (CV*)NEWSV(1105,0); + sv_upgrade((SV *)cv, SVt_PVCV); + } GvCV(gv) = cv; CvGV(cv) = SvREFCNT_inc(gv); GvCVGEN(gv) = 0; CvFILEGV(cv) = gv_fetchfile(filename); - CvUSERSUB(cv) = subaddr; - CvUSERINDEX(cv) = ix; - CvDELETED(cv) = FALSE; - if (s = strrchr(name,':')) + CvXSUB(cv) = subaddr; + if (!name) + s = "__ANON__"; + else if (s = strrchr(name,':')) s++; else s = name; @@ -2561,6 +2761,9 @@ char *filename; av_unshift(endav, 1); av_store(endav, 0, SvREFCNT_inc(gv)); } + if (!name) + GvCV(gv) = 0; /* Will remember elsewhere instead. */ + return cv; } void @@ -2573,12 +2776,14 @@ OP *block; char *name; GV *gv; AV* av; + I32 ix; if (op) name = SvPVx(cSVOP->op_sv, na); else name = "STDOUT"; gv = gv_fetchpv(name,TRUE, SVt_PVFM); + SvMULTI_on(gv); if (cv = GvFORM(gv)) { if (dowarn) { line_t oldline = curcop->cop_line; @@ -2589,23 +2794,26 @@ OP *block; } SvREFCNT_dec(cv); } - Newz(101,cv,1,CV); - sv_upgrade(cv, SVt_PVFM); - SvREFCNT(cv) = 1; + cv = (CV*)NEWSV(1106,0); + sv_upgrade((SV *)cv, SVt_PVFM); GvFORM(gv) = cv; CvGV(cv) = SvREFCNT_inc(gv); CvFILEGV(cv) = curcop->cop_filegv; + for (ix = AvFILL(comppad); ix > 0; ix--) { + if (!SvPADMY(curpad[ix])) + SvPADTMP_on(curpad[ix]); + } + CvPADLIST(cv) = av = newAV(); AvREAL_off(av); - av_store(av, 1, (SV*)comppad); + av_store(av, 1, SvREFCNT_inc((SV*)comppad)); AvFILL(av) = 1; CvROOT(cv) = newUNOP(OP_LEAVEWRITE, 0, scalarseq(block)); CvSTART(cv) = LINKLIST(CvROOT(cv)); CvROOT(cv)->op_next = 0; peep(CvSTART(cv)); - CvDELETED(cv) = FALSE; FmLINES(cv) = 0; op_free(op); copline = NOLINE; @@ -2636,7 +2844,7 @@ newANONLIST(op) OP* op; { return newUNOP(OP_REFGEN, 0, - ref(list(convert(OP_ANONLIST, 0, op)), OP_REFGEN)); + mod(list(convert(OP_ANONLIST, 0, op)), OP_REFGEN)); } OP * @@ -2644,7 +2852,16 @@ newANONHASH(op) OP* op; { return newUNOP(OP_REFGEN, 0, - ref(list(convert(OP_ANONHASH, 0, op)), OP_REFGEN)); + mod(list(convert(OP_ANONHASH, 0, op)), OP_REFGEN)); +} + +OP * +newANONSUB(floor, block) +I32 floor; +OP *block; +{ + return newUNOP(OP_REFGEN, 0, + newSVOP(OP_ANONCODE, 0, (SV*)newSUB(floor, 0, block))); } OP * @@ -2708,10 +2925,13 @@ OP *o; } OP * -newGVREF(o) +newGVREF(type,o) +I32 type; OP *o; { - return newUNOP(OP_RV2GV, 0, scalar(o)); + if (type == OP_MAPSTART) + return newUNOP(OP_NULL, 0, o); + return newUNOP(OP_RV2GV, 0, o); } OP * @@ -2766,22 +2986,41 @@ OP *op; } OP * -ck_chop(op) +ck_spair(op) OP *op; { if (op->op_flags & OPf_KIDS) { OP* newop; + OP* kid; op = modkids(ck_fun(op), op->op_type); - if (op->op_private != 1) + kid = cUNOP->op_first; + newop = kUNOP->op_first->op_sibling; + if (newop && + (newop->op_sibling || + !(opargs[newop->op_type] & OA_RETSCALAR) || + newop->op_type == OP_PADAV || newop->op_type == OP_PADHV || + newop->op_type == OP_RV2AV || newop->op_type == OP_RV2HV)) { + return op; - newop = cUNOP->op_first->op_sibling; - if (!newop || newop->op_type != OP_RV2SV) - return op; - op_free(cUNOP->op_first); - cUNOP->op_first = newop; + } + op_free(kUNOP->op_first); + kUNOP->op_first = newop; + } + op->op_ppaddr = ppaddr[++op->op_type]; + return ck_fun(op); +} + +OP * +ck_delete(op) +OP *op; +{ + op = ck_fun(op); + if (op->op_flags & OPf_KIDS) { + OP *kid = cUNOP->op_first; + if (kid->op_type != OP_HELEM) + croak("%s argument is not a HASH element", op_name[op->op_type]); + null(kid); } - op->op_type = OP_SCHOP; - op->op_ppaddr = ppaddr[OP_SCHOP]; return op; } @@ -2840,6 +3079,7 @@ OP *op; op_free(op); op = newUNOP(OP_ENTEREVAL, 0, newSVREF(newGVOP(OP_GV, 0, defgv))); } + op->op_targ = (PADOFFSET)hints; return op; } @@ -2874,12 +3114,26 @@ ck_rvconst(op) register OP *op; { SVOP *kid = (SVOP*)cUNOP->op_first; - int iscv = (op->op_type==OP_RV2CV); + int iscv = (op->op_type==OP_RV2CV)*2; + op->op_private = (hints & HINT_STRICT_REFS); if (kid->op_type == OP_CONST) { + GV *gv = 0; kid->op_type = OP_GV; - kid->op_sv = SvREFCNT_inc(gv_fetchpv(SvPVx(kid->op_sv, na), - 1+iscv, iscv ? SVt_PVCV : SVt_PVGV)); + for (gv = 0; !gv; iscv++) { + gv = gv_fetchpv(SvPVx(kid->op_sv, na), + iscv, + iscv + ? SVt_PVCV + : op->op_type == OP_RV2SV + ? SVt_PV + : op->op_type == OP_RV2AV + ? SVt_PVAV + : op->op_type == OP_RV2HV + ? SVt_PVHV + : SVt_PVGV); + } + kid->op_sv = SvREFCNT_inc(gv); } return op; } @@ -2897,14 +3151,14 @@ OP *op; { I32 type = op->op_type; - if (op->op_flags & OPf_SPECIAL) + if (op->op_flags & OPf_REF) return op; if (op->op_flags & OPf_KIDS) { SVOP *kid = (SVOP*)cUNOP->op_first; if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) { - OP *newop = newGVOP(type, OPf_SPECIAL, + OP *newop = newGVOP(type, OPf_REF, gv_fetchpv(SvPVx(kid->op_sv, na), TRUE, SVt_PVIO)); op_free(op); return newop; @@ -2913,7 +3167,7 @@ OP *op; else { op_free(op); if (type == OP_FTTTY) - return newGVOP(type, OPf_SPECIAL, gv_fetchpv("main'STDIN", TRUE, + return newGVOP(type, OPf_REF, gv_fetchpv("main'STDIN", TRUE, SVt_PVIO)); else return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv))); @@ -2929,7 +3183,8 @@ OP *op; OP **tokid; OP *sibl; I32 numargs = 0; - register I32 oa = opargs[op->op_type] >> 8; + int type = op->op_type; + register I32 oa = opargs[type] >> OASHIFT; if (op->op_flags & OPf_STACKED) { if ((oa & OA_OPTIONAL) && (oa >> 4) && !((oa >> 4) & OA_OPTIONAL)) @@ -2947,6 +3202,8 @@ OP *op; tokid = &kid->op_sibling; kid = kid->op_sibling; } + if (!kid && opargs[type] & OA_DEFGV) + *tokid = kid = newSVREF(newGVOP(OP_GV, 0, defgv)); while (oa && kid) { numargs++; @@ -2971,7 +3228,7 @@ OP *op; gv_fetchpv(name, TRUE, SVt_PVAV) )); if (dowarn) warn("Array @%s missing the @ in argument %d of %s()", - name, numargs, op_name[op->op_type]); + name, numargs, op_name[type]); op_free(kid); kid = newop; kid->op_sibling = sibl; @@ -2979,7 +3236,7 @@ OP *op; } else if (kid->op_type != OP_RV2AV && kid->op_type != OP_PADAV) bad_type(numargs, "array", op, kid); - mod(kid, op->op_type); + mod(kid, type); break; case OA_HVREF: if (kid->op_type == OP_CONST && @@ -2989,7 +3246,7 @@ OP *op; gv_fetchpv(name, TRUE, SVt_PVHV) )); if (dowarn) warn("Hash %%%s missing the %% in argument %d of %s()", - name, numargs, op_name[op->op_type]); + name, numargs, op_name[type]); op_free(kid); kid = newop; kid->op_sibling = sibl; @@ -2997,11 +3254,11 @@ OP *op; } else if (kid->op_type != OP_RV2HV && kid->op_type != OP_PADHV) bad_type(numargs, "hash", op, kid); - mod(kid, op->op_type); + mod(kid, type); break; case OA_CVREF: { - OP *newop = newUNOP(OP_NULL, 0, scalar(kid)); + OP *newop = newUNOP(OP_NULL, 0, kid); kid->op_sibling = 0; linklist(kid); newop->op_next = newop; @@ -3030,7 +3287,7 @@ OP *op; scalar(kid); break; case OA_SCALARREF: - mod(scalar(kid), op->op_type); + mod(scalar(kid), type); break; } oa >>= 4; @@ -3042,6 +3299,11 @@ OP *op; return too_many_arguments(op); listkids(op); } + else if (opargs[type] & OA_DEFGV) { + op_free(op); + return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv))); + } + if (oa) { while (oa & OA_OPTIONAL) oa >>= 4; @@ -3055,11 +3317,11 @@ OP * ck_glob(op) OP *op; { - GV *gv = newGVgen(); - GvIOn(gv); + GV *gv = newGVgen("main"); + gv_IOadd(gv); append_elem(OP_GLOB, op, newGVOP(OP_GV, 0, gv)); scalarkids(op); - return op; + return ck_fun(op); } OP * @@ -3068,29 +3330,48 @@ OP *op; { LOGOP *gwop; OP *kid; + OPCODE type = op->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE; + op->op_ppaddr = ppaddr[OP_GREPSTART]; + Newz(1101, gwop, 1, LOGOP); + if (op->op_flags & OPf_STACKED) { + OP* k; op = ck_sort(op); + for (k = cLISTOP->op_first->op_sibling->op_next; k; k = k->op_next) { + kid = k; + } + kid->op_next = (OP*)gwop; op->op_flags &= ~OPf_STACKED; } + kid = cLISTOP->op_first->op_sibling; + if (type == OP_MAPWHILE) + list(kid); + else + scalar(kid); op = ck_fun(op); if (error_count) return op; - kid = cLISTOP->op_first->op_sibling; + kid = cLISTOP->op_first->op_sibling; if (kid->op_type != OP_NULL) croak("panic: ck_grep"); kid = kUNOP->op_first; - Newz(1101, gwop, 1, LOGOP); - gwop->op_type = OP_GREPWHILE; - gwop->op_ppaddr = ppaddr[OP_GREPWHILE]; - gwop->op_first = list(op); + gwop->op_type = type; + gwop->op_ppaddr = ppaddr[type]; + gwop->op_first = listkids(op); gwop->op_flags |= OPf_KIDS; gwop->op_private = 1; gwop->op_other = LINKLIST(kid); - gwop->op_targ = pad_alloc(OP_GREPWHILE, SVs_PADTMP); + gwop->op_targ = pad_alloc(type, SVs_PADTMP); kid->op_next = (OP*)gwop; + kid = cLISTOP->op_first->op_sibling; + if (!kid || !kid->op_sibling) + return too_few_arguments(op); + for (kid = kid->op_sibling; kid; kid = kid->op_sibling) + mod(kid, OP_GREPSTART); + return (OP*)gwop; } @@ -3111,7 +3392,7 @@ ck_lengthconst(op) OP *op; { /* XXX length optimization goes here */ - return op; + return ck_fun(op); } OP * @@ -3191,24 +3472,19 @@ OP * ck_require(op) OP *op; { - if (op->op_flags & OPf_KIDS) { /* Shall we fake a BEGIN {}? */ + if (op->op_flags & OPf_KIDS) { /* Shall we supply missing .pm? */ SVOP *kid = (SVOP*)cUNOP->op_first; if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) { - char *name = SvPVX(subname); char *s; - sv_catpvn(kid->op_sv, ".pm", 3); - if (s = strrchr(name,':')) - s++; - else - s = name; - if (strNE(s, "BEGIN")) { - op = newSTATEOP(0, Nullch, op); - newSUB(start_subparse(), - newSVOP(OP_CONST, 0, newSVpv("BEGIN", 5)), - op); - return newOP(OP_STUB,0); + for (s = SvPVX(kid->op_sv); *s; s++) { + if (*s == ':' && s[1] == ':') { + *s = '/'; + strcpy(s+1,s+2); /* known to be okay here */ + --SvCUR(kid->op_sv); + } } + sv_catpvn(kid->op_sv, ".pm", 3); } } return ck_fun(op); @@ -3269,7 +3545,6 @@ OP *op; if (kid->op_type == OP_SCOPE) { k = kid->op_next; kid->op_next = 0; - peep(k); } else if (kid->op_type == OP_LEAVE) { null(kid); /* wipe out leave */ @@ -3279,11 +3554,16 @@ OP *op; if (k->op_next == kid) k->op_next = 0; } - peep(kLISTOP->op_first); + k = kLISTOP->op_first; } + peep(k); + kid = cLISTOP->op_first->op_sibling; /* get past pushmark */ null(kid); /* wipe out rv2gv */ - kid->op_next = kid; + if (op->op_type == OP_SORT) + kid->op_next = kid; + else + kid->op_next = k; op->op_flags |= OPf_SPECIAL; } } @@ -3360,6 +3640,8 @@ OP *op; op->op_private = (hints & HINT_STRICT_REFS); if (perldb && curstash != debstash) op->op_private |= OPpDEREF_DB; + while (o = o->op_sibling) + mod(o, OP_ENTERSUB); return op; } @@ -3378,7 +3660,10 @@ OP *op; if (op->op_flags & OPf_KIDS) { SVOP *kid = (SVOP*)cUNOP->op_first; - if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) + if (kid->op_type == OP_NULL) + kid = (SVOP*)kid->op_sibling; + if (kid && + kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) op->op_flags |= OPf_SPECIAL; } return ck_fun(op); @@ -3387,19 +3672,40 @@ OP *op; /* A peephole optimizer. We visit the ops in the order they're to execute. */ void -peep(op) -register OP* op; +peep(o) +register OP* o; { register OP* oldop = 0; - if (!op || op->op_seq) + if (!o || o->op_seq) return; - for (; op; op = op->op_next) { - if (op->op_seq) - return; - switch (op->op_type) { + ENTER; + SAVESPTR(op); + SAVESPTR(curcop); + for (; o; o = o->op_next) { + if (o->op_seq) + break; + op = o; + switch (o->op_type) { + case OP_NEXTSTATE: + case OP_DBSTATE: + curcop = ((COP*)o); /* for warnings */ + break; + + case OP_CONCAT: + case OP_CONST: + case OP_JOIN: + case OP_UC: + case OP_UCFIRST: + case OP_LC: + case OP_LCFIRST: + case OP_QUOTEMETA: + if (o->op_next->op_type == OP_STRINGIFY) + null(o->op_next); + o->op_seq = ++op_seqmax; + break; case OP_STUB: - if ((op->op_flags & (OPf_KNOW|OPf_LIST)) != (OPf_KNOW|OPf_LIST)) { - op->op_seq = ++op_seqmax; + if ((o->op_flags & (OPf_KNOW|OPf_LIST)) != (OPf_KNOW|OPf_LIST)) { + o->op_seq = ++op_seqmax; break; /* Scalar stub must produce undef. List stub is noop */ } /* FALL THROUGH */ @@ -3407,63 +3713,65 @@ register OP* op; case OP_SCALAR: case OP_LINESEQ: case OP_SCOPE: - if (oldop) { - oldop->op_next = op->op_next; + if (oldop && o->op_next) { + oldop->op_next = o->op_next; continue; } - op->op_seq = ++op_seqmax; + o->op_seq = ++op_seqmax; break; case OP_GV: - if (op->op_next->op_type == OP_RV2SV) { - if (!(op->op_next->op_private & (OPpDEREF_HV|OPpDEREF_AV))) { - null(op->op_next); - op->op_flags |= op->op_next->op_flags & OPf_INTRO; - op->op_next = op->op_next->op_next; - op->op_type = OP_GVSV; - op->op_ppaddr = ppaddr[OP_GVSV]; + if (o->op_next->op_type == OP_RV2SV) { + if (!(o->op_next->op_private & (OPpDEREF_HV|OPpDEREF_AV))) { + null(o->op_next); + o->op_private |= o->op_next->op_private & OPpLVAL_INTRO; + o->op_next = o->op_next->op_next; + o->op_type = OP_GVSV; + o->op_ppaddr = ppaddr[OP_GVSV]; } } - else if (op->op_next->op_type == OP_RV2AV) { - OP* pop = op->op_next->op_next; - I32 i; + else if (o->op_next->op_type == OP_RV2AV) { + OP* pop = o->op_next->op_next; + IV i; if (pop->op_type == OP_CONST && + (op = pop->op_next) && pop->op_next->op_type == OP_AELEM && - !(pop->op_next->op_private & (OPpDEREF_HV|OPpDEREF_AV)) && - !(pop->op_next->op_flags & OPf_INTRO) && - (i = SvIV(((SVOP*)pop)->op_sv)) <= 255 && + !(pop->op_next->op_private & + (OPpDEREF_HV|OPpDEREF_AV|OPpLVAL_INTRO)) && + (i = SvIV(((SVOP*)pop)->op_sv) - compiling.cop_arybase) + <= 255 && i >= 0) { - null(op->op_next); + null(o->op_next); null(pop->op_next); null(pop); - op->op_flags &= ~OPf_LVAL; - op->op_flags |= pop->op_next->op_flags & OPf_LVAL; - op->op_next = pop->op_next->op_next; - op->op_type = OP_AELEMFAST; - op->op_ppaddr = ppaddr[OP_AELEMFAST]; - op->op_private = i; - GvAVn((GV*)cSVOP->op_sv); + o->op_flags |= pop->op_next->op_flags & OPf_MOD; + o->op_next = pop->op_next->op_next; + o->op_type = OP_AELEMFAST; + o->op_ppaddr = ppaddr[OP_AELEMFAST]; + o->op_private = (U8)i; + GvAVn((GV*)(((SVOP*)o)->op_sv)); } } - op->op_seq = ++op_seqmax; + o->op_seq = ++op_seqmax; break; + case OP_MAPWHILE: case OP_GREPWHILE: case OP_AND: case OP_OR: - op->op_seq = ++op_seqmax; + o->op_seq = ++op_seqmax; peep(cLOGOP->op_other); break; case OP_COND_EXPR: - op->op_seq = ++op_seqmax; + o->op_seq = ++op_seqmax; peep(cCONDOP->op_true); peep(cCONDOP->op_false); break; case OP_ENTERLOOP: - op->op_seq = ++op_seqmax; + o->op_seq = ++op_seqmax; peep(cLOOP->op_redoop); peep(cLOOP->op_nextop); peep(cLOOP->op_lastop); @@ -3471,14 +3779,29 @@ register OP* op; case OP_MATCH: case OP_SUBST: - op->op_seq = ++op_seqmax; - peep(cPMOP->op_pmreplroot); + o->op_seq = ++op_seqmax; + peep(cPMOP->op_pmreplstart); break; + case OP_EXEC: + o->op_seq = ++op_seqmax; + if (dowarn && o->op_next && o->op_next->op_type == OP_NEXTSTATE) { + if (o->op_next->op_sibling && + o->op_next->op_sibling->op_type != OP_DIE) { + line_t oldline = curcop->cop_line; + + curcop->cop_line = ((COP*)o->op_next)->cop_line; + warn("Statement unlikely to be reached"); + warn("(Maybe you meant system() when you said exec()?)\n"); + curcop->cop_line = oldline; + } + } + break; default: - op->op_seq = ++op_seqmax; + o->op_seq = ++op_seqmax; break; } - oldop = op; + oldop = o; } + LEAVE; } diff --git a/op.h b/op.h index b988f31..559f55c 100644 --- a/op.h +++ b/op.h @@ -1,11 +1,10 @@ -/* $RCSfile: arg.h,v $$Revision: 4.1 $$Date: 92/08/07 17:18:16 $ +/* op.h * - * Copyright (c) 1991, Larry Wall + * Copyright (c) 1991-1994, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. * - * $Log: arg.h,v $ */ /* @@ -39,10 +38,10 @@ typedef U16 PADOFFSET; PADOFFSET op_targ; \ OPCODE op_type; \ U16 op_seq; \ - char op_flags; \ - char op_private; + U8 op_flags; \ + U8 op_private; -#define GIMME (op->op_flags & OPf_KNOW ? op->op_flags & OPf_LIST : cxstack[cxstack_ix].blk_gimme) +#define GIMME (op->op_flags & OPf_KNOW ? op->op_flags & OPf_LIST : cxstack[cxstack_ix].blk_gimme & G_ARRAY) /* Public flags */ #define OPf_LIST 1 /* Do operator in list context. */ @@ -50,45 +49,55 @@ typedef U16 PADOFFSET; #define OPf_KIDS 4 /* There is a firstborn child. */ #define OPf_PARENS 8 /* This operator was parenthesized. */ /* (Or block needs explicit scope entry.) */ -#define OPf_STACKED 16 /* Some arg is arriving on the stack. */ -#define OPf_LVAL 32 /* Certified reference (lvalue). */ -#define OPf_INTRO 64 /* Lvalue must be localized */ +#define OPf_REF 16 /* Certified reference. */ + /* (Return container, not containee). */ +#define OPf_MOD 32 /* Will modify (lvalue). */ +#define OPf_STACKED 64 /* Some arg is arriving on the stack. */ #define OPf_SPECIAL 128 /* Do something weird for this op: */ /* On local LVAL, don't init local value. */ /* On OP_SORT, subroutine is inlined. */ /* On OP_NOT, inversion was implicit. */ - /* On file tests, we fstat filehandle */ + /* On OP_LEAVE, don't restore curpm. */ /* On truncate, we truncate filehandle */ /* On control verbs, we saw no label */ /* On flipflop, we saw ... instead of .. */ /* On UNOPs, saw bare parens, e.g. eof(). */ - /* On OP_ENTERSUBR || OP_NULL, saw a "do". */ + /* On OP_ENTERSUB || OP_NULL, saw a "do". */ -/* Private for OP_ASSIGN */ -#define OPpASSIGN_COMMON 1 /* Left & right have syms in common. */ +/* Private for lvalues */ +#define OPpLVAL_INTRO 128 /* Lvalue must be localized */ + +/* Private for OP_AASSIGN */ +#define OPpASSIGN_COMMON 64 /* Left & right have syms in common. */ + +/* Private for OP_SASSIGN */ +#define OPpASSIGN_BACKWARDS 64 /* Left & right switched. */ /* Private for OP_TRANS */ -#define OPpTRANS_SQUASH 1 -#define OPpTRANS_DELETE 2 -#define OPpTRANS_COMPLEMENT 4 +#define OPpTRANS_SQUASH 16 +#define OPpTRANS_DELETE 32 +#define OPpTRANS_COMPLEMENT 64 /* Private for OP_REPEAT */ -#define OPpREPEAT_DOLIST 1 /* List replication. */ +#define OPpREPEAT_DOLIST 64 /* List replication. */ -/* Private for OP_ENTERSUBR, OP_RV2?V, OP_?ELEM */ +/* Private for OP_ENTERSUB, OP_RV2?V, OP_?ELEM */ /* (lower bits carry hints) */ -#define OPpDEREF_DB 32 /* Debug subroutine. */ -#define OPpDEREF_AV 64 /* Want ref to AV. */ -#define OPpDEREF_HV 128 /* Want ref to HV. */ +#define OPpDEREF_DB 16 /* Debug subroutine. */ +#define OPpDEREF_AV 32 /* Want ref to AV. */ +#define OPpDEREF_HV 64 /* Want ref to HV. */ /* Private for OP_CONST */ -#define OPpCONST_BARE 1 /* Was a bare word (filehandle?). */ +#define OPpCONST_BARE 64 /* Was a bare word (filehandle?). */ /* Private for OP_FLIP/FLOP */ -#define OPpFLIP_LINENUM 1 /* Range arg potentially a line num. */ +#define OPpFLIP_LINENUM 64 /* Range arg potentially a line num. */ /* Private for OP_LIST */ -#define OPpLIST_GUESSED 1 /* Guessed that pushmark was needed. */ +#define OPpLIST_GUESSED 64 /* Guessed that pushmark was needed. */ + +/* Private for OP_LEAVE and friends */ +#define OPpLEAVE_VOID 64 /* No need to copy out values. */ struct op { BASEOP @@ -135,21 +144,26 @@ struct pmop { PMOP * op_pmnext; /* list of all scanpats */ REGEXP * op_pmregexp; /* compiled expression */ SV * op_pmshort; /* for a fast bypass of execute() */ - short op_pmflags; + U16 op_pmflags; char op_pmslen; }; -#define PMf_USED 1 /* pm has been used once already */ -#define PMf_ONCE 2 /* use pattern only once per reset */ -#define PMf_SCANFIRST 4 /* initial constant not anchored */ -#define PMf_ALL 8 /* initial constant is whole pat */ -#define PMf_SKIPWHITE 16 /* skip leading whitespace for split */ -#define PMf_FOLD 32 /* case insensitivity */ -#define PMf_CONST 64 /* subst replacement is constant */ -#define PMf_KEEP 128 /* keep 1st runtime pattern forever */ -#define PMf_GLOBAL 256 /* pattern had a g modifier */ -#define PMf_RUNTIME 512 /* pattern coming in on the stack */ -#define PMf_EVAL 1024 /* evaluating replacement as expr */ -#define PMf_WHITE 2048 /* pattern is \s+ */ + +#define PMf_USED 0x0001 /* pm has been used once already */ +#define PMf_ONCE 0x0002 /* use pattern only once per reset */ +#define PMf_SCANFIRST 0x0004 /* initial constant not anchored */ +#define PMf_ALL 0x0008 /* initial constant is whole pat */ +#define PMf_SKIPWHITE 0x0010 /* skip leading whitespace for split */ +#define PMf_FOLD 0x0020 /* case insensitivity */ +#define PMf_CONST 0x0040 /* subst replacement is constant */ +#define PMf_KEEP 0x0080 /* keep 1st runtime pattern forever */ +#define PMf_GLOBAL 0x0100 /* pattern had a g modifier */ +#define PMf_RUNTIME 0x0200 /* pattern coming in on the stack */ +#define PMf_EVAL 0x0400 /* evaluating replacement as expr */ +#define PMf_WHITE 0x0800 /* pattern is \s+ */ +#define PMf_MULTILINE 0x1000 /* assume multiple lines */ +#define PMf_SINGLELINE 0x2000 /* assume single line */ +#define PMf_UNUSED 0x4000 /* (unused) */ +#define PMf_EXTENDED 0x8000 /* chuck embedded whitespace */ struct svop { BASEOP @@ -210,3 +224,25 @@ struct loop { #define Nullop Null(OP*) +/* Lowest byte of opargs */ +#define OA_MARK 1 +#define OA_FOLDCONST 2 +#define OA_RETSCALAR 4 +#define OA_TARGET 8 +#define OA_RETINTEGER 16 +#define OA_OTHERINT 32 +#define OA_DANGEROUS 64 +#define OA_DEFGV 128 + +#define OASHIFT 8 + +/* Remaining nybbles of opargs */ +#define OA_SCALAR 1 +#define OA_LIST 2 +#define OA_AVREF 3 +#define OA_HVREF 4 +#define OA_CVREF 5 +#define OA_FILEREF 6 +#define OA_SCALARREF 7 +#define OA_OPTIONAL 8 + diff --git a/opcode.h b/opcode.h index dbcd3ff..b075e7b 100644 --- a/opcode.h +++ b/opcode.h @@ -5,349 +5,355 @@ typedef enum { OP_PUSHMARK, /* 3 */ OP_WANTARRAY, /* 4 */ OP_CONST, /* 5 */ - OP_INTERP, /* 6 */ - OP_GVSV, /* 7 */ - OP_GV, /* 8 */ - OP_PADSV, /* 9 */ - OP_PADAV, /* 10 */ - OP_PADHV, /* 11 */ - OP_PADANY, /* 12 */ - OP_PUSHRE, /* 13 */ - OP_RV2GV, /* 14 */ - OP_SV2LEN, /* 15 */ - OP_RV2SV, /* 16 */ - OP_AV2ARYLEN, /* 17 */ - OP_RV2CV, /* 18 */ + OP_GVSV, /* 6 */ + OP_GV, /* 7 */ + OP_PADSV, /* 8 */ + OP_PADAV, /* 9 */ + OP_PADHV, /* 10 */ + OP_PADANY, /* 11 */ + OP_PUSHRE, /* 12 */ + OP_RV2GV, /* 13 */ + OP_SV2LEN, /* 14 */ + OP_RV2SV, /* 15 */ + OP_AV2ARYLEN, /* 16 */ + OP_RV2CV, /* 17 */ + OP_ANONCODE, /* 18 */ OP_REFGEN, /* 19 */ - OP_REF, /* 20 */ - OP_BLESS, /* 21 */ - OP_BACKTICK, /* 22 */ - OP_GLOB, /* 23 */ - OP_READLINE, /* 24 */ - OP_RCATLINE, /* 25 */ - OP_REGCMAYBE, /* 26 */ - OP_REGCOMP, /* 27 */ - OP_MATCH, /* 28 */ - OP_SUBST, /* 29 */ - OP_SUBSTCONT, /* 30 */ - OP_TRANS, /* 31 */ - OP_SASSIGN, /* 32 */ - OP_AASSIGN, /* 33 */ - OP_SCHOP, /* 34 */ + OP_SREFGEN, /* 20 */ + OP_REF, /* 21 */ + OP_BLESS, /* 22 */ + OP_BACKTICK, /* 23 */ + OP_GLOB, /* 24 */ + OP_READLINE, /* 25 */ + OP_RCATLINE, /* 26 */ + OP_REGCMAYBE, /* 27 */ + OP_REGCOMP, /* 28 */ + OP_MATCH, /* 29 */ + OP_SUBST, /* 30 */ + OP_SUBSTCONT, /* 31 */ + OP_TRANS, /* 32 */ + OP_SASSIGN, /* 33 */ + OP_AASSIGN, /* 34 */ OP_CHOP, /* 35 */ - OP_DEFINED, /* 36 */ - OP_UNDEF, /* 37 */ - OP_STUDY, /* 38 */ - OP_PREINC, /* 39 */ - OP_I_PREINC, /* 40 */ - OP_PREDEC, /* 41 */ - OP_I_PREDEC, /* 42 */ - OP_POSTINC, /* 43 */ - OP_I_POSTINC, /* 44 */ - OP_POSTDEC, /* 45 */ - OP_I_POSTDEC, /* 46 */ - OP_POW, /* 47 */ - OP_MULTIPLY, /* 48 */ - OP_I_MULTIPLY, /* 49 */ - OP_DIVIDE, /* 50 */ - OP_I_DIVIDE, /* 51 */ - OP_MODULO, /* 52 */ - OP_I_MODULO, /* 53 */ - OP_REPEAT, /* 54 */ - OP_ADD, /* 55 */ - OP_I_ADD, /* 56 */ - OP_SUBTRACT, /* 57 */ - OP_I_SUBTRACT, /* 58 */ - OP_CONCAT, /* 59 */ - OP_LEFT_SHIFT, /* 60 */ - OP_RIGHT_SHIFT, /* 61 */ - OP_LT, /* 62 */ - OP_I_LT, /* 63 */ - OP_GT, /* 64 */ - OP_I_GT, /* 65 */ - OP_LE, /* 66 */ - OP_I_LE, /* 67 */ - OP_GE, /* 68 */ - OP_I_GE, /* 69 */ - OP_EQ, /* 70 */ - OP_I_EQ, /* 71 */ - OP_NE, /* 72 */ - OP_I_NE, /* 73 */ - OP_NCMP, /* 74 */ - OP_I_NCMP, /* 75 */ - OP_SLT, /* 76 */ - OP_SGT, /* 77 */ - OP_SLE, /* 78 */ - OP_SGE, /* 79 */ - OP_SEQ, /* 80 */ - OP_SNE, /* 81 */ - OP_SCMP, /* 82 */ - OP_BIT_AND, /* 83 */ - OP_XOR, /* 84 */ - OP_BIT_OR, /* 85 */ - OP_NEGATE, /* 86 */ - OP_I_NEGATE, /* 87 */ - OP_NOT, /* 88 */ - OP_COMPLEMENT, /* 89 */ - OP_ATAN2, /* 90 */ - OP_SIN, /* 91 */ - OP_COS, /* 92 */ - OP_RAND, /* 93 */ - OP_SRAND, /* 94 */ - OP_EXP, /* 95 */ - OP_LOG, /* 96 */ - OP_SQRT, /* 97 */ - OP_INT, /* 98 */ - OP_HEX, /* 99 */ - OP_OCT, /* 100 */ - OP_ABS, /* 101 */ - OP_LENGTH, /* 102 */ - OP_SUBSTR, /* 103 */ - OP_VEC, /* 104 */ - OP_INDEX, /* 105 */ - OP_RINDEX, /* 106 */ - OP_SPRINTF, /* 107 */ - OP_FORMLINE, /* 108 */ - OP_ORD, /* 109 */ - OP_CHR, /* 110 */ - OP_CRYPT, /* 111 */ - OP_UCFIRST, /* 112 */ - OP_LCFIRST, /* 113 */ - OP_UC, /* 114 */ - OP_LC, /* 115 */ - OP_RV2AV, /* 116 */ - OP_AELEMFAST, /* 117 */ - OP_AELEM, /* 118 */ - OP_ASLICE, /* 119 */ - OP_EACH, /* 120 */ - OP_VALUES, /* 121 */ - OP_KEYS, /* 122 */ - OP_DELETE, /* 123 */ - OP_RV2HV, /* 124 */ - OP_HELEM, /* 125 */ - OP_HSLICE, /* 126 */ - OP_UNPACK, /* 127 */ - OP_PACK, /* 128 */ - OP_SPLIT, /* 129 */ - OP_JOIN, /* 130 */ - OP_LIST, /* 131 */ - OP_LSLICE, /* 132 */ - OP_ANONLIST, /* 133 */ - OP_ANONHASH, /* 134 */ - OP_SPLICE, /* 135 */ - OP_PUSH, /* 136 */ - OP_POP, /* 137 */ - OP_SHIFT, /* 138 */ - OP_UNSHIFT, /* 139 */ - OP_SORT, /* 140 */ - OP_REVERSE, /* 141 */ - OP_GREPSTART, /* 142 */ - OP_GREPWHILE, /* 143 */ - OP_RANGE, /* 144 */ - OP_FLIP, /* 145 */ - OP_FLOP, /* 146 */ - OP_AND, /* 147 */ - OP_OR, /* 148 */ - OP_COND_EXPR, /* 149 */ - OP_ANDASSIGN, /* 150 */ - OP_ORASSIGN, /* 151 */ - OP_METHOD, /* 152 */ - OP_ENTERSUBR, /* 153 */ - OP_LEAVESUBR, /* 154 */ - OP_CALLER, /* 155 */ - OP_WARN, /* 156 */ - OP_DIE, /* 157 */ - OP_RESET, /* 158 */ - OP_LINESEQ, /* 159 */ - OP_NEXTSTATE, /* 160 */ - OP_DBSTATE, /* 161 */ - OP_UNSTACK, /* 162 */ - OP_ENTER, /* 163 */ - OP_LEAVE, /* 164 */ - OP_SCOPE, /* 165 */ - OP_ENTERITER, /* 166 */ - OP_ITER, /* 167 */ - OP_ENTERLOOP, /* 168 */ - OP_LEAVELOOP, /* 169 */ - OP_RETURN, /* 170 */ - OP_LAST, /* 171 */ - OP_NEXT, /* 172 */ - OP_REDO, /* 173 */ - OP_DUMP, /* 174 */ - OP_GOTO, /* 175 */ - OP_EXIT, /* 176 */ - OP_NSWITCH, /* 177 */ - OP_CSWITCH, /* 178 */ - OP_OPEN, /* 179 */ - OP_CLOSE, /* 180 */ - OP_PIPE_OP, /* 181 */ - OP_FILENO, /* 182 */ - OP_UMASK, /* 183 */ - OP_BINMODE, /* 184 */ - OP_TIE, /* 185 */ - OP_UNTIE, /* 186 */ - OP_DBMOPEN, /* 187 */ - OP_DBMCLOSE, /* 188 */ - OP_SSELECT, /* 189 */ - OP_SELECT, /* 190 */ - OP_GETC, /* 191 */ - OP_READ, /* 192 */ - OP_ENTERWRITE, /* 193 */ - OP_LEAVEWRITE, /* 194 */ - OP_PRTF, /* 195 */ - OP_PRINT, /* 196 */ - OP_SYSREAD, /* 197 */ - OP_SYSWRITE, /* 198 */ - OP_SEND, /* 199 */ - OP_RECV, /* 200 */ - OP_EOF, /* 201 */ - OP_TELL, /* 202 */ - OP_SEEK, /* 203 */ - OP_TRUNCATE, /* 204 */ - OP_FCNTL, /* 205 */ - OP_IOCTL, /* 206 */ - OP_FLOCK, /* 207 */ - OP_SOCKET, /* 208 */ - OP_SOCKPAIR, /* 209 */ - OP_BIND, /* 210 */ - OP_CONNECT, /* 211 */ - OP_LISTEN, /* 212 */ - OP_ACCEPT, /* 213 */ - OP_SHUTDOWN, /* 214 */ - OP_GSOCKOPT, /* 215 */ - OP_SSOCKOPT, /* 216 */ - OP_GETSOCKNAME, /* 217 */ - OP_GETPEERNAME, /* 218 */ - OP_LSTAT, /* 219 */ - OP_STAT, /* 220 */ - OP_FTRREAD, /* 221 */ - OP_FTRWRITE, /* 222 */ - OP_FTREXEC, /* 223 */ - OP_FTEREAD, /* 224 */ - OP_FTEWRITE, /* 225 */ - OP_FTEEXEC, /* 226 */ - OP_FTIS, /* 227 */ - OP_FTEOWNED, /* 228 */ - OP_FTROWNED, /* 229 */ - OP_FTZERO, /* 230 */ - OP_FTSIZE, /* 231 */ - OP_FTMTIME, /* 232 */ - OP_FTATIME, /* 233 */ - OP_FTCTIME, /* 234 */ - OP_FTSOCK, /* 235 */ - OP_FTCHR, /* 236 */ - OP_FTBLK, /* 237 */ - OP_FTFILE, /* 238 */ - OP_FTDIR, /* 239 */ - OP_FTPIPE, /* 240 */ - OP_FTLINK, /* 241 */ - OP_FTSUID, /* 242 */ - OP_FTSGID, /* 243 */ - OP_FTSVTX, /* 244 */ - OP_FTTTY, /* 245 */ - OP_FTTEXT, /* 246 */ - OP_FTBINARY, /* 247 */ - OP_CHDIR, /* 248 */ - OP_CHOWN, /* 249 */ - OP_CHROOT, /* 250 */ - OP_UNLINK, /* 251 */ - OP_CHMOD, /* 252 */ - OP_UTIME, /* 253 */ - OP_RENAME, /* 254 */ - OP_LINK, /* 255 */ - OP_SYMLINK, /* 256 */ - OP_READLINK, /* 257 */ - OP_MKDIR, /* 258 */ - OP_RMDIR, /* 259 */ - OP_OPEN_DIR, /* 260 */ - OP_READDIR, /* 261 */ - OP_TELLDIR, /* 262 */ - OP_SEEKDIR, /* 263 */ - OP_REWINDDIR, /* 264 */ - OP_CLOSEDIR, /* 265 */ - OP_FORK, /* 266 */ - OP_WAIT, /* 267 */ - OP_WAITPID, /* 268 */ - OP_SYSTEM, /* 269 */ - OP_EXEC, /* 270 */ - OP_KILL, /* 271 */ - OP_GETPPID, /* 272 */ - OP_GETPGRP, /* 273 */ - OP_SETPGRP, /* 274 */ - OP_GETPRIORITY, /* 275 */ - OP_SETPRIORITY, /* 276 */ - OP_TIME, /* 277 */ - OP_TMS, /* 278 */ - OP_LOCALTIME, /* 279 */ - OP_GMTIME, /* 280 */ - OP_ALARM, /* 281 */ - OP_SLEEP, /* 282 */ - OP_SHMGET, /* 283 */ - OP_SHMCTL, /* 284 */ - OP_SHMREAD, /* 285 */ - OP_SHMWRITE, /* 286 */ - OP_MSGGET, /* 287 */ - OP_MSGCTL, /* 288 */ - OP_MSGSND, /* 289 */ - OP_MSGRCV, /* 290 */ - OP_SEMGET, /* 291 */ - OP_SEMCTL, /* 292 */ - OP_SEMOP, /* 293 */ - OP_REQUIRE, /* 294 */ - OP_DOFILE, /* 295 */ - OP_ENTEREVAL, /* 296 */ - OP_LEAVEEVAL, /* 297 */ - OP_EVALONCE, /* 298 */ - OP_ENTERTRY, /* 299 */ - OP_LEAVETRY, /* 300 */ - OP_GHBYNAME, /* 301 */ - OP_GHBYADDR, /* 302 */ - OP_GHOSTENT, /* 303 */ - OP_GNBYNAME, /* 304 */ - OP_GNBYADDR, /* 305 */ - OP_GNETENT, /* 306 */ - OP_GPBYNAME, /* 307 */ - OP_GPBYNUMBER, /* 308 */ - OP_GPROTOENT, /* 309 */ - OP_GSBYNAME, /* 310 */ - OP_GSBYPORT, /* 311 */ - OP_GSERVENT, /* 312 */ - OP_SHOSTENT, /* 313 */ - OP_SNETENT, /* 314 */ - OP_SPROTOENT, /* 315 */ - OP_SSERVENT, /* 316 */ - OP_EHOSTENT, /* 317 */ - OP_ENETENT, /* 318 */ - OP_EPROTOENT, /* 319 */ - OP_ESERVENT, /* 320 */ - OP_GPWNAM, /* 321 */ - OP_GPWUID, /* 322 */ - OP_GPWENT, /* 323 */ - OP_SPWENT, /* 324 */ - OP_EPWENT, /* 325 */ - OP_GGRNAM, /* 326 */ - OP_GGRGID, /* 327 */ - OP_GGRENT, /* 328 */ - OP_SGRENT, /* 329 */ - OP_EGRENT, /* 330 */ - OP_GETLOGIN, /* 331 */ - OP_SYSCALL, /* 332 */ + OP_SCHOP, /* 36 */ + OP_CHOMP, /* 37 */ + OP_SCHOMP, /* 38 */ + OP_DEFINED, /* 39 */ + OP_UNDEF, /* 40 */ + OP_STUDY, /* 41 */ + OP_POS, /* 42 */ + OP_PREINC, /* 43 */ + OP_I_PREINC, /* 44 */ + OP_PREDEC, /* 45 */ + OP_I_PREDEC, /* 46 */ + OP_POSTINC, /* 47 */ + OP_I_POSTINC, /* 48 */ + OP_POSTDEC, /* 49 */ + OP_I_POSTDEC, /* 50 */ + OP_POW, /* 51 */ + OP_MULTIPLY, /* 52 */ + OP_I_MULTIPLY, /* 53 */ + OP_DIVIDE, /* 54 */ + OP_I_DIVIDE, /* 55 */ + OP_MODULO, /* 56 */ + OP_I_MODULO, /* 57 */ + OP_REPEAT, /* 58 */ + OP_ADD, /* 59 */ + OP_I_ADD, /* 60 */ + OP_SUBTRACT, /* 61 */ + OP_I_SUBTRACT, /* 62 */ + OP_CONCAT, /* 63 */ + OP_STRINGIFY, /* 64 */ + OP_LEFT_SHIFT, /* 65 */ + OP_RIGHT_SHIFT, /* 66 */ + OP_LT, /* 67 */ + OP_I_LT, /* 68 */ + OP_GT, /* 69 */ + OP_I_GT, /* 70 */ + OP_LE, /* 71 */ + OP_I_LE, /* 72 */ + OP_GE, /* 73 */ + OP_I_GE, /* 74 */ + OP_EQ, /* 75 */ + OP_I_EQ, /* 76 */ + OP_NE, /* 77 */ + OP_I_NE, /* 78 */ + OP_NCMP, /* 79 */ + OP_I_NCMP, /* 80 */ + OP_SLT, /* 81 */ + OP_SGT, /* 82 */ + OP_SLE, /* 83 */ + OP_SGE, /* 84 */ + OP_SEQ, /* 85 */ + OP_SNE, /* 86 */ + OP_SCMP, /* 87 */ + OP_BIT_AND, /* 88 */ + OP_BIT_XOR, /* 89 */ + OP_BIT_OR, /* 90 */ + OP_NEGATE, /* 91 */ + OP_I_NEGATE, /* 92 */ + OP_NOT, /* 93 */ + OP_COMPLEMENT, /* 94 */ + OP_ATAN2, /* 95 */ + OP_SIN, /* 96 */ + OP_COS, /* 97 */ + OP_RAND, /* 98 */ + OP_SRAND, /* 99 */ + OP_EXP, /* 100 */ + OP_LOG, /* 101 */ + OP_SQRT, /* 102 */ + OP_INT, /* 103 */ + OP_HEX, /* 104 */ + OP_OCT, /* 105 */ + OP_ABS, /* 106 */ + OP_LENGTH, /* 107 */ + OP_SUBSTR, /* 108 */ + OP_VEC, /* 109 */ + OP_INDEX, /* 110 */ + OP_RINDEX, /* 111 */ + OP_SPRINTF, /* 112 */ + OP_FORMLINE, /* 113 */ + OP_ORD, /* 114 */ + OP_CHR, /* 115 */ + OP_CRYPT, /* 116 */ + OP_UCFIRST, /* 117 */ + OP_LCFIRST, /* 118 */ + OP_UC, /* 119 */ + OP_LC, /* 120 */ + OP_QUOTEMETA, /* 121 */ + OP_RV2AV, /* 122 */ + OP_AELEMFAST, /* 123 */ + OP_AELEM, /* 124 */ + OP_ASLICE, /* 125 */ + OP_EACH, /* 126 */ + OP_VALUES, /* 127 */ + OP_KEYS, /* 128 */ + OP_DELETE, /* 129 */ + OP_EXISTS, /* 130 */ + OP_RV2HV, /* 131 */ + OP_HELEM, /* 132 */ + OP_HSLICE, /* 133 */ + OP_UNPACK, /* 134 */ + OP_PACK, /* 135 */ + OP_SPLIT, /* 136 */ + OP_JOIN, /* 137 */ + OP_LIST, /* 138 */ + OP_LSLICE, /* 139 */ + OP_ANONLIST, /* 140 */ + OP_ANONHASH, /* 141 */ + OP_SPLICE, /* 142 */ + OP_PUSH, /* 143 */ + OP_POP, /* 144 */ + OP_SHIFT, /* 145 */ + OP_UNSHIFT, /* 146 */ + OP_SORT, /* 147 */ + OP_REVERSE, /* 148 */ + OP_GREPSTART, /* 149 */ + OP_GREPWHILE, /* 150 */ + OP_MAPSTART, /* 151 */ + OP_MAPWHILE, /* 152 */ + OP_RANGE, /* 153 */ + OP_FLIP, /* 154 */ + OP_FLOP, /* 155 */ + OP_AND, /* 156 */ + OP_OR, /* 157 */ + OP_XOR, /* 158 */ + OP_COND_EXPR, /* 159 */ + OP_ANDASSIGN, /* 160 */ + OP_ORASSIGN, /* 161 */ + OP_METHOD, /* 162 */ + OP_ENTERSUB, /* 163 */ + OP_LEAVESUB, /* 164 */ + OP_CALLER, /* 165 */ + OP_WARN, /* 166 */ + OP_DIE, /* 167 */ + OP_RESET, /* 168 */ + OP_LINESEQ, /* 169 */ + OP_NEXTSTATE, /* 170 */ + OP_DBSTATE, /* 171 */ + OP_UNSTACK, /* 172 */ + OP_ENTER, /* 173 */ + OP_LEAVE, /* 174 */ + OP_SCOPE, /* 175 */ + OP_ENTERITER, /* 176 */ + OP_ITER, /* 177 */ + OP_ENTERLOOP, /* 178 */ + OP_LEAVELOOP, /* 179 */ + OP_RETURN, /* 180 */ + OP_LAST, /* 181 */ + OP_NEXT, /* 182 */ + OP_REDO, /* 183 */ + OP_DUMP, /* 184 */ + OP_GOTO, /* 185 */ + OP_EXIT, /* 186 */ + OP_OPEN, /* 187 */ + OP_CLOSE, /* 188 */ + OP_PIPE_OP, /* 189 */ + OP_FILENO, /* 190 */ + OP_UMASK, /* 191 */ + OP_BINMODE, /* 192 */ + OP_TIE, /* 193 */ + OP_UNTIE, /* 194 */ + OP_DBMOPEN, /* 195 */ + OP_DBMCLOSE, /* 196 */ + OP_SSELECT, /* 197 */ + OP_SELECT, /* 198 */ + OP_GETC, /* 199 */ + OP_READ, /* 200 */ + OP_ENTERWRITE, /* 201 */ + OP_LEAVEWRITE, /* 202 */ + OP_PRTF, /* 203 */ + OP_PRINT, /* 204 */ + OP_SYSREAD, /* 205 */ + OP_SYSWRITE, /* 206 */ + OP_SEND, /* 207 */ + OP_RECV, /* 208 */ + OP_EOF, /* 209 */ + OP_TELL, /* 210 */ + OP_SEEK, /* 211 */ + OP_TRUNCATE, /* 212 */ + OP_FCNTL, /* 213 */ + OP_IOCTL, /* 214 */ + OP_FLOCK, /* 215 */ + OP_SOCKET, /* 216 */ + OP_SOCKPAIR, /* 217 */ + OP_BIND, /* 218 */ + OP_CONNECT, /* 219 */ + OP_LISTEN, /* 220 */ + OP_ACCEPT, /* 221 */ + OP_SHUTDOWN, /* 222 */ + OP_GSOCKOPT, /* 223 */ + OP_SSOCKOPT, /* 224 */ + OP_GETSOCKNAME, /* 225 */ + OP_GETPEERNAME, /* 226 */ + OP_LSTAT, /* 227 */ + OP_STAT, /* 228 */ + OP_FTRREAD, /* 229 */ + OP_FTRWRITE, /* 230 */ + OP_FTREXEC, /* 231 */ + OP_FTEREAD, /* 232 */ + OP_FTEWRITE, /* 233 */ + OP_FTEEXEC, /* 234 */ + OP_FTIS, /* 235 */ + OP_FTEOWNED, /* 236 */ + OP_FTROWNED, /* 237 */ + OP_FTZERO, /* 238 */ + OP_FTSIZE, /* 239 */ + OP_FTMTIME, /* 240 */ + OP_FTATIME, /* 241 */ + OP_FTCTIME, /* 242 */ + OP_FTSOCK, /* 243 */ + OP_FTCHR, /* 244 */ + OP_FTBLK, /* 245 */ + OP_FTFILE, /* 246 */ + OP_FTDIR, /* 247 */ + OP_FTPIPE, /* 248 */ + OP_FTLINK, /* 249 */ + OP_FTSUID, /* 250 */ + OP_FTSGID, /* 251 */ + OP_FTSVTX, /* 252 */ + OP_FTTTY, /* 253 */ + OP_FTTEXT, /* 254 */ + OP_FTBINARY, /* 255 */ + OP_CHDIR, /* 256 */ + OP_CHOWN, /* 257 */ + OP_CHROOT, /* 258 */ + OP_UNLINK, /* 259 */ + OP_CHMOD, /* 260 */ + OP_UTIME, /* 261 */ + OP_RENAME, /* 262 */ + OP_LINK, /* 263 */ + OP_SYMLINK, /* 264 */ + OP_READLINK, /* 265 */ + OP_MKDIR, /* 266 */ + OP_RMDIR, /* 267 */ + OP_OPEN_DIR, /* 268 */ + OP_READDIR, /* 269 */ + OP_TELLDIR, /* 270 */ + OP_SEEKDIR, /* 271 */ + OP_REWINDDIR, /* 272 */ + OP_CLOSEDIR, /* 273 */ + OP_FORK, /* 274 */ + OP_WAIT, /* 275 */ + OP_WAITPID, /* 276 */ + OP_SYSTEM, /* 277 */ + OP_EXEC, /* 278 */ + OP_KILL, /* 279 */ + OP_GETPPID, /* 280 */ + OP_GETPGRP, /* 281 */ + OP_SETPGRP, /* 282 */ + OP_GETPRIORITY, /* 283 */ + OP_SETPRIORITY, /* 284 */ + OP_TIME, /* 285 */ + OP_TMS, /* 286 */ + OP_LOCALTIME, /* 287 */ + OP_GMTIME, /* 288 */ + OP_ALARM, /* 289 */ + OP_SLEEP, /* 290 */ + OP_SHMGET, /* 291 */ + OP_SHMCTL, /* 292 */ + OP_SHMREAD, /* 293 */ + OP_SHMWRITE, /* 294 */ + OP_MSGGET, /* 295 */ + OP_MSGCTL, /* 296 */ + OP_MSGSND, /* 297 */ + OP_MSGRCV, /* 298 */ + OP_SEMGET, /* 299 */ + OP_SEMCTL, /* 300 */ + OP_SEMOP, /* 301 */ + OP_REQUIRE, /* 302 */ + OP_DOFILE, /* 303 */ + OP_ENTEREVAL, /* 304 */ + OP_LEAVEEVAL, /* 305 */ + OP_ENTERTRY, /* 306 */ + OP_LEAVETRY, /* 307 */ + OP_GHBYNAME, /* 308 */ + OP_GHBYADDR, /* 309 */ + OP_GHOSTENT, /* 310 */ + OP_GNBYNAME, /* 311 */ + OP_GNBYADDR, /* 312 */ + OP_GNETENT, /* 313 */ + OP_GPBYNAME, /* 314 */ + OP_GPBYNUMBER, /* 315 */ + OP_GPROTOENT, /* 316 */ + OP_GSBYNAME, /* 317 */ + OP_GSBYPORT, /* 318 */ + OP_GSERVENT, /* 319 */ + OP_SHOSTENT, /* 320 */ + OP_SNETENT, /* 321 */ + OP_SPROTOENT, /* 322 */ + OP_SSERVENT, /* 323 */ + OP_EHOSTENT, /* 324 */ + OP_ENETENT, /* 325 */ + OP_EPROTOENT, /* 326 */ + OP_ESERVENT, /* 327 */ + OP_GPWNAM, /* 328 */ + OP_GPWUID, /* 329 */ + OP_GPWENT, /* 330 */ + OP_SPWENT, /* 331 */ + OP_EPWENT, /* 332 */ + OP_GGRNAM, /* 333 */ + OP_GGRGID, /* 334 */ + OP_GGRENT, /* 335 */ + OP_SGRENT, /* 336 */ + OP_EGRENT, /* 337 */ + OP_GETLOGIN, /* 338 */ + OP_SYSCALL, /* 339 */ OP_max } opcode; -#define MAXO 333 +#define MAXO 340 #ifndef DOINIT -extern char *op_name[]; +EXT char *op_name[]; #else -char *op_name[] = { +EXT char *op_name[] = { "null operation", "stub", "scalar", "pushmark", "wantarray", "constant item", - "interpreted string", "scalar variable", "glob value", "private variable", @@ -357,10 +363,12 @@ char *op_name[] = { "push regexp", "ref-to-glob cast", "scalar value length", - "ref-to-scalar cast", + "scalar deref", "array length", - "subroutine reference", + "subroutine deref", + "anonymous subroutine", "reference constructor", + "scalar ref constructor", "reference-type operator", "bless", "backticks", @@ -375,11 +383,14 @@ char *op_name[] = { "character translation", "scalar assignment", "list assignment", - "scalar chop", "chop", + "scalar chop", + "safe chop", + "scalar safe chop", "defined operator", "undef operator", "study", + "match position", "preincrement", "integer preincrement", "predecrement", @@ -401,6 +412,7 @@ char *op_name[] = { "subtraction", "integer subtraction", "concatenation", + "string", "left bitshift", "right bitshift", "numeric lt", @@ -415,7 +427,7 @@ char *op_name[] = { "integer eq", "numeric ne", "integer ne", - "spaceship", + "spaceship operator", "integer spaceship", "string lt", "string gt", @@ -424,9 +436,9 @@ char *op_name[] = { "string eq", "string ne", "string comparison", - "bit and", - "xor", - "bit or", + "bitwise and", + "bitwise xor", + "bitwise or", "negate", "integer negate", "not", @@ -457,6 +469,7 @@ char *op_name[] = { "lower case first", "upper case", "lower case", + "quote metachars", "array deref", "known array element", "array element", @@ -465,6 +478,7 @@ char *op_name[] = { "values", "keys", "delete", + "exists operator", "associative array deref", "associative array elem", "associative array slice", @@ -485,11 +499,14 @@ char *op_name[] = { "reverse", "grep", "grep iterator", + "map", + "map iterator", "flipflop", "range (or flip)", "range (or flop)", "logical and", "logical or", + "logical xor", "conditional expression", "logical and assignment", "logical or assignment", @@ -518,8 +535,6 @@ char *op_name[] = { "dump", "goto", "exit", - "numeric switch", - "character switch", "open", "close", "pipe", @@ -639,7 +654,6 @@ char *op_name[] = { "do 'file'", "eval string", "eval exit", - "eval constant string", "eval block", "eval block exit", "gethostbyname", @@ -677,379 +691,386 @@ char *op_name[] = { }; #endif -OP * ck_chop P((OP* op)); -OP * ck_concat P((OP* op)); -OP * ck_eof P((OP* op)); -OP * ck_eval P((OP* op)); -OP * ck_exec P((OP* op)); -OP * ck_formline P((OP* op)); -OP * ck_ftst P((OP* op)); -OP * ck_fun P((OP* op)); -OP * ck_glob P((OP* op)); -OP * ck_grep P((OP* op)); -OP * ck_index P((OP* op)); -OP * ck_lengthconst P((OP* op)); -OP * ck_lfun P((OP* op)); -OP * ck_listiob P((OP* op)); -OP * ck_match P((OP* op)); -OP * ck_null P((OP* op)); -OP * ck_repeat P((OP* op)); -OP * ck_require P((OP* op)); -OP * ck_rfun P((OP* op)); -OP * ck_rvconst P((OP* op)); -OP * ck_select P((OP* op)); -OP * ck_shift P((OP* op)); -OP * ck_sort P((OP* op)); -OP * ck_split P((OP* op)); -OP * ck_subr P((OP* op)); -OP * ck_svconst P((OP* op)); -OP * ck_trunc P((OP* op)); +OP * ck_concat _((OP* op)); +OP * ck_delete _((OP* op)); +OP * ck_eof _((OP* op)); +OP * ck_eval _((OP* op)); +OP * ck_exec _((OP* op)); +OP * ck_formline _((OP* op)); +OP * ck_ftst _((OP* op)); +OP * ck_fun _((OP* op)); +OP * ck_glob _((OP* op)); +OP * ck_grep _((OP* op)); +OP * ck_index _((OP* op)); +OP * ck_lengthconst _((OP* op)); +OP * ck_lfun _((OP* op)); +OP * ck_listiob _((OP* op)); +OP * ck_match _((OP* op)); +OP * ck_null _((OP* op)); +OP * ck_repeat _((OP* op)); +OP * ck_require _((OP* op)); +OP * ck_rfun _((OP* op)); +OP * ck_rvconst _((OP* op)); +OP * ck_select _((OP* op)); +OP * ck_shift _((OP* op)); +OP * ck_sort _((OP* op)); +OP * ck_spair _((OP* op)); +OP * ck_split _((OP* op)); +OP * ck_subr _((OP* op)); +OP * ck_svconst _((OP* op)); +OP * ck_trunc _((OP* op)); -OP * pp_null P((void)); -OP * pp_stub P((void)); -OP * pp_scalar P((void)); -OP * pp_pushmark P((void)); -OP * pp_wantarray P((void)); -OP * pp_const P((void)); -OP * pp_interp P((void)); -OP * pp_gvsv P((void)); -OP * pp_gv P((void)); -OP * pp_padsv P((void)); -OP * pp_padav P((void)); -OP * pp_padhv P((void)); -OP * pp_padany P((void)); -OP * pp_pushre P((void)); -OP * pp_rv2gv P((void)); -OP * pp_sv2len P((void)); -OP * pp_rv2sv P((void)); -OP * pp_av2arylen P((void)); -OP * pp_rv2cv P((void)); -OP * pp_refgen P((void)); -OP * pp_ref P((void)); -OP * pp_bless P((void)); -OP * pp_backtick P((void)); -OP * pp_glob P((void)); -OP * pp_readline P((void)); -OP * pp_rcatline P((void)); -OP * pp_regcmaybe P((void)); -OP * pp_regcomp P((void)); -OP * pp_match P((void)); -OP * pp_subst P((void)); -OP * pp_substcont P((void)); -OP * pp_trans P((void)); -OP * pp_sassign P((void)); -OP * pp_aassign P((void)); -OP * pp_schop P((void)); -OP * pp_chop P((void)); -OP * pp_defined P((void)); -OP * pp_undef P((void)); -OP * pp_study P((void)); -OP * pp_preinc P((void)); -OP * pp_i_preinc P((void)); -OP * pp_predec P((void)); -OP * pp_i_predec P((void)); -OP * pp_postinc P((void)); -OP * pp_i_postinc P((void)); -OP * pp_postdec P((void)); -OP * pp_i_postdec P((void)); -OP * pp_pow P((void)); -OP * pp_multiply P((void)); -OP * pp_i_multiply P((void)); -OP * pp_divide P((void)); -OP * pp_i_divide P((void)); -OP * pp_modulo P((void)); -OP * pp_i_modulo P((void)); -OP * pp_repeat P((void)); -OP * pp_add P((void)); -OP * pp_i_add P((void)); -OP * pp_subtract P((void)); -OP * pp_i_subtract P((void)); -OP * pp_concat P((void)); -OP * pp_left_shift P((void)); -OP * pp_right_shift P((void)); -OP * pp_lt P((void)); -OP * pp_i_lt P((void)); -OP * pp_gt P((void)); -OP * pp_i_gt P((void)); -OP * pp_le P((void)); -OP * pp_i_le P((void)); -OP * pp_ge P((void)); -OP * pp_i_ge P((void)); -OP * pp_eq P((void)); -OP * pp_i_eq P((void)); -OP * pp_ne P((void)); -OP * pp_i_ne P((void)); -OP * pp_ncmp P((void)); -OP * pp_i_ncmp P((void)); -OP * pp_slt P((void)); -OP * pp_sgt P((void)); -OP * pp_sle P((void)); -OP * pp_sge P((void)); -OP * pp_seq P((void)); -OP * pp_sne P((void)); -OP * pp_scmp P((void)); -OP * pp_bit_and P((void)); -OP * pp_xor P((void)); -OP * pp_bit_or P((void)); -OP * pp_negate P((void)); -OP * pp_i_negate P((void)); -OP * pp_not P((void)); -OP * pp_complement P((void)); -OP * pp_atan2 P((void)); -OP * pp_sin P((void)); -OP * pp_cos P((void)); -OP * pp_rand P((void)); -OP * pp_srand P((void)); -OP * pp_exp P((void)); -OP * pp_log P((void)); -OP * pp_sqrt P((void)); -OP * pp_int P((void)); -OP * pp_hex P((void)); -OP * pp_oct P((void)); -OP * pp_abs P((void)); -OP * pp_length P((void)); -OP * pp_substr P((void)); -OP * pp_vec P((void)); -OP * pp_index P((void)); -OP * pp_rindex P((void)); -OP * pp_sprintf P((void)); -OP * pp_formline P((void)); -OP * pp_ord P((void)); -OP * pp_chr P((void)); -OP * pp_crypt P((void)); -OP * pp_ucfirst P((void)); -OP * pp_lcfirst P((void)); -OP * pp_uc P((void)); -OP * pp_lc P((void)); -OP * pp_rv2av P((void)); -OP * pp_aelemfast P((void)); -OP * pp_aelem P((void)); -OP * pp_aslice P((void)); -OP * pp_each P((void)); -OP * pp_values P((void)); -OP * pp_keys P((void)); -OP * pp_delete P((void)); -OP * pp_rv2hv P((void)); -OP * pp_helem P((void)); -OP * pp_hslice P((void)); -OP * pp_unpack P((void)); -OP * pp_pack P((void)); -OP * pp_split P((void)); -OP * pp_join P((void)); -OP * pp_list P((void)); -OP * pp_lslice P((void)); -OP * pp_anonlist P((void)); -OP * pp_anonhash P((void)); -OP * pp_splice P((void)); -OP * pp_push P((void)); -OP * pp_pop P((void)); -OP * pp_shift P((void)); -OP * pp_unshift P((void)); -OP * pp_sort P((void)); -OP * pp_reverse P((void)); -OP * pp_grepstart P((void)); -OP * pp_grepwhile P((void)); -OP * pp_range P((void)); -OP * pp_flip P((void)); -OP * pp_flop P((void)); -OP * pp_and P((void)); -OP * pp_or P((void)); -OP * pp_cond_expr P((void)); -OP * pp_andassign P((void)); -OP * pp_orassign P((void)); -OP * pp_method P((void)); -OP * pp_entersubr P((void)); -OP * pp_leavesubr P((void)); -OP * pp_caller P((void)); -OP * pp_warn P((void)); -OP * pp_die P((void)); -OP * pp_reset P((void)); -OP * pp_lineseq P((void)); -OP * pp_nextstate P((void)); -OP * pp_dbstate P((void)); -OP * pp_unstack P((void)); -OP * pp_enter P((void)); -OP * pp_leave P((void)); -OP * pp_scope P((void)); -OP * pp_enteriter P((void)); -OP * pp_iter P((void)); -OP * pp_enterloop P((void)); -OP * pp_leaveloop P((void)); -OP * pp_return P((void)); -OP * pp_last P((void)); -OP * pp_next P((void)); -OP * pp_redo P((void)); -OP * pp_dump P((void)); -OP * pp_goto P((void)); -OP * pp_exit P((void)); -OP * pp_nswitch P((void)); -OP * pp_cswitch P((void)); -OP * pp_open P((void)); -OP * pp_close P((void)); -OP * pp_pipe_op P((void)); -OP * pp_fileno P((void)); -OP * pp_umask P((void)); -OP * pp_binmode P((void)); -OP * pp_tie P((void)); -OP * pp_untie P((void)); -OP * pp_dbmopen P((void)); -OP * pp_dbmclose P((void)); -OP * pp_sselect P((void)); -OP * pp_select P((void)); -OP * pp_getc P((void)); -OP * pp_read P((void)); -OP * pp_enterwrite P((void)); -OP * pp_leavewrite P((void)); -OP * pp_prtf P((void)); -OP * pp_print P((void)); -OP * pp_sysread P((void)); -OP * pp_syswrite P((void)); -OP * pp_send P((void)); -OP * pp_recv P((void)); -OP * pp_eof P((void)); -OP * pp_tell P((void)); -OP * pp_seek P((void)); -OP * pp_truncate P((void)); -OP * pp_fcntl P((void)); -OP * pp_ioctl P((void)); -OP * pp_flock P((void)); -OP * pp_socket P((void)); -OP * pp_sockpair P((void)); -OP * pp_bind P((void)); -OP * pp_connect P((void)); -OP * pp_listen P((void)); -OP * pp_accept P((void)); -OP * pp_shutdown P((void)); -OP * pp_gsockopt P((void)); -OP * pp_ssockopt P((void)); -OP * pp_getsockname P((void)); -OP * pp_getpeername P((void)); -OP * pp_lstat P((void)); -OP * pp_stat P((void)); -OP * pp_ftrread P((void)); -OP * pp_ftrwrite P((void)); -OP * pp_ftrexec P((void)); -OP * pp_fteread P((void)); -OP * pp_ftewrite P((void)); -OP * pp_fteexec P((void)); -OP * pp_ftis P((void)); -OP * pp_fteowned P((void)); -OP * pp_ftrowned P((void)); -OP * pp_ftzero P((void)); -OP * pp_ftsize P((void)); -OP * pp_ftmtime P((void)); -OP * pp_ftatime P((void)); -OP * pp_ftctime P((void)); -OP * pp_ftsock P((void)); -OP * pp_ftchr P((void)); -OP * pp_ftblk P((void)); -OP * pp_ftfile P((void)); -OP * pp_ftdir P((void)); -OP * pp_ftpipe P((void)); -OP * pp_ftlink P((void)); -OP * pp_ftsuid P((void)); -OP * pp_ftsgid P((void)); -OP * pp_ftsvtx P((void)); -OP * pp_fttty P((void)); -OP * pp_fttext P((void)); -OP * pp_ftbinary P((void)); -OP * pp_chdir P((void)); -OP * pp_chown P((void)); -OP * pp_chroot P((void)); -OP * pp_unlink P((void)); -OP * pp_chmod P((void)); -OP * pp_utime P((void)); -OP * pp_rename P((void)); -OP * pp_link P((void)); -OP * pp_symlink P((void)); -OP * pp_readlink P((void)); -OP * pp_mkdir P((void)); -OP * pp_rmdir P((void)); -OP * pp_open_dir P((void)); -OP * pp_readdir P((void)); -OP * pp_telldir P((void)); -OP * pp_seekdir P((void)); -OP * pp_rewinddir P((void)); -OP * pp_closedir P((void)); -OP * pp_fork P((void)); -OP * pp_wait P((void)); -OP * pp_waitpid P((void)); -OP * pp_system P((void)); -OP * pp_exec P((void)); -OP * pp_kill P((void)); -OP * pp_getppid P((void)); -OP * pp_getpgrp P((void)); -OP * pp_setpgrp P((void)); -OP * pp_getpriority P((void)); -OP * pp_setpriority P((void)); -OP * pp_time P((void)); -OP * pp_tms P((void)); -OP * pp_localtime P((void)); -OP * pp_gmtime P((void)); -OP * pp_alarm P((void)); -OP * pp_sleep P((void)); -OP * pp_shmget P((void)); -OP * pp_shmctl P((void)); -OP * pp_shmread P((void)); -OP * pp_shmwrite P((void)); -OP * pp_msgget P((void)); -OP * pp_msgctl P((void)); -OP * pp_msgsnd P((void)); -OP * pp_msgrcv P((void)); -OP * pp_semget P((void)); -OP * pp_semctl P((void)); -OP * pp_semop P((void)); -OP * pp_require P((void)); -OP * pp_dofile P((void)); -OP * pp_entereval P((void)); -OP * pp_leaveeval P((void)); -OP * pp_evalonce P((void)); -OP * pp_entertry P((void)); -OP * pp_leavetry P((void)); -OP * pp_ghbyname P((void)); -OP * pp_ghbyaddr P((void)); -OP * pp_ghostent P((void)); -OP * pp_gnbyname P((void)); -OP * pp_gnbyaddr P((void)); -OP * pp_gnetent P((void)); -OP * pp_gpbyname P((void)); -OP * pp_gpbynumber P((void)); -OP * pp_gprotoent P((void)); -OP * pp_gsbyname P((void)); -OP * pp_gsbyport P((void)); -OP * pp_gservent P((void)); -OP * pp_shostent P((void)); -OP * pp_snetent P((void)); -OP * pp_sprotoent P((void)); -OP * pp_sservent P((void)); -OP * pp_ehostent P((void)); -OP * pp_enetent P((void)); -OP * pp_eprotoent P((void)); -OP * pp_eservent P((void)); -OP * pp_gpwnam P((void)); -OP * pp_gpwuid P((void)); -OP * pp_gpwent P((void)); -OP * pp_spwent P((void)); -OP * pp_epwent P((void)); -OP * pp_ggrnam P((void)); -OP * pp_ggrgid P((void)); -OP * pp_ggrent P((void)); -OP * pp_sgrent P((void)); -OP * pp_egrent P((void)); -OP * pp_getlogin P((void)); -OP * pp_syscall P((void)); +OP * pp_null _((void)); +OP * pp_stub _((void)); +OP * pp_scalar _((void)); +OP * pp_pushmark _((void)); +OP * pp_wantarray _((void)); +OP * pp_const _((void)); +OP * pp_gvsv _((void)); +OP * pp_gv _((void)); +OP * pp_padsv _((void)); +OP * pp_padav _((void)); +OP * pp_padhv _((void)); +OP * pp_padany _((void)); +OP * pp_pushre _((void)); +OP * pp_rv2gv _((void)); +OP * pp_sv2len _((void)); +OP * pp_rv2sv _((void)); +OP * pp_av2arylen _((void)); +OP * pp_rv2cv _((void)); +OP * pp_anoncode _((void)); +OP * pp_refgen _((void)); +OP * pp_srefgen _((void)); +OP * pp_ref _((void)); +OP * pp_bless _((void)); +OP * pp_backtick _((void)); +OP * pp_glob _((void)); +OP * pp_readline _((void)); +OP * pp_rcatline _((void)); +OP * pp_regcmaybe _((void)); +OP * pp_regcomp _((void)); +OP * pp_match _((void)); +OP * pp_subst _((void)); +OP * pp_substcont _((void)); +OP * pp_trans _((void)); +OP * pp_sassign _((void)); +OP * pp_aassign _((void)); +OP * pp_chop _((void)); +OP * pp_schop _((void)); +OP * pp_chomp _((void)); +OP * pp_schomp _((void)); +OP * pp_defined _((void)); +OP * pp_undef _((void)); +OP * pp_study _((void)); +OP * pp_pos _((void)); +OP * pp_preinc _((void)); +OP * pp_i_preinc _((void)); +OP * pp_predec _((void)); +OP * pp_i_predec _((void)); +OP * pp_postinc _((void)); +OP * pp_i_postinc _((void)); +OP * pp_postdec _((void)); +OP * pp_i_postdec _((void)); +OP * pp_pow _((void)); +OP * pp_multiply _((void)); +OP * pp_i_multiply _((void)); +OP * pp_divide _((void)); +OP * pp_i_divide _((void)); +OP * pp_modulo _((void)); +OP * pp_i_modulo _((void)); +OP * pp_repeat _((void)); +OP * pp_add _((void)); +OP * pp_i_add _((void)); +OP * pp_subtract _((void)); +OP * pp_i_subtract _((void)); +OP * pp_concat _((void)); +OP * pp_stringify _((void)); +OP * pp_left_shift _((void)); +OP * pp_right_shift _((void)); +OP * pp_lt _((void)); +OP * pp_i_lt _((void)); +OP * pp_gt _((void)); +OP * pp_i_gt _((void)); +OP * pp_le _((void)); +OP * pp_i_le _((void)); +OP * pp_ge _((void)); +OP * pp_i_ge _((void)); +OP * pp_eq _((void)); +OP * pp_i_eq _((void)); +OP * pp_ne _((void)); +OP * pp_i_ne _((void)); +OP * pp_ncmp _((void)); +OP * pp_i_ncmp _((void)); +OP * pp_slt _((void)); +OP * pp_sgt _((void)); +OP * pp_sle _((void)); +OP * pp_sge _((void)); +OP * pp_seq _((void)); +OP * pp_sne _((void)); +OP * pp_scmp _((void)); +OP * pp_bit_and _((void)); +OP * pp_bit_xor _((void)); +OP * pp_bit_or _((void)); +OP * pp_negate _((void)); +OP * pp_i_negate _((void)); +OP * pp_not _((void)); +OP * pp_complement _((void)); +OP * pp_atan2 _((void)); +OP * pp_sin _((void)); +OP * pp_cos _((void)); +OP * pp_rand _((void)); +OP * pp_srand _((void)); +OP * pp_exp _((void)); +OP * pp_log _((void)); +OP * pp_sqrt _((void)); +OP * pp_int _((void)); +OP * pp_hex _((void)); +OP * pp_oct _((void)); +OP * pp_abs _((void)); +OP * pp_length _((void)); +OP * pp_substr _((void)); +OP * pp_vec _((void)); +OP * pp_index _((void)); +OP * pp_rindex _((void)); +OP * pp_sprintf _((void)); +OP * pp_formline _((void)); +OP * pp_ord _((void)); +OP * pp_chr _((void)); +OP * pp_crypt _((void)); +OP * pp_ucfirst _((void)); +OP * pp_lcfirst _((void)); +OP * pp_uc _((void)); +OP * pp_lc _((void)); +OP * pp_quotemeta _((void)); +OP * pp_rv2av _((void)); +OP * pp_aelemfast _((void)); +OP * pp_aelem _((void)); +OP * pp_aslice _((void)); +OP * pp_each _((void)); +OP * pp_values _((void)); +OP * pp_keys _((void)); +OP * pp_delete _((void)); +OP * pp_exists _((void)); +OP * pp_rv2hv _((void)); +OP * pp_helem _((void)); +OP * pp_hslice _((void)); +OP * pp_unpack _((void)); +OP * pp_pack _((void)); +OP * pp_split _((void)); +OP * pp_join _((void)); +OP * pp_list _((void)); +OP * pp_lslice _((void)); +OP * pp_anonlist _((void)); +OP * pp_anonhash _((void)); +OP * pp_splice _((void)); +OP * pp_push _((void)); +OP * pp_pop _((void)); +OP * pp_shift _((void)); +OP * pp_unshift _((void)); +OP * pp_sort _((void)); +OP * pp_reverse _((void)); +OP * pp_grepstart _((void)); +OP * pp_grepwhile _((void)); +OP * pp_mapstart _((void)); +OP * pp_mapwhile _((void)); +OP * pp_range _((void)); +OP * pp_flip _((void)); +OP * pp_flop _((void)); +OP * pp_and _((void)); +OP * pp_or _((void)); +OP * pp_xor _((void)); +OP * pp_cond_expr _((void)); +OP * pp_andassign _((void)); +OP * pp_orassign _((void)); +OP * pp_method _((void)); +OP * pp_entersub _((void)); +OP * pp_leavesub _((void)); +OP * pp_caller _((void)); +OP * pp_warn _((void)); +OP * pp_die _((void)); +OP * pp_reset _((void)); +OP * pp_lineseq _((void)); +OP * pp_nextstate _((void)); +OP * pp_dbstate _((void)); +OP * pp_unstack _((void)); +OP * pp_enter _((void)); +OP * pp_leave _((void)); +OP * pp_scope _((void)); +OP * pp_enteriter _((void)); +OP * pp_iter _((void)); +OP * pp_enterloop _((void)); +OP * pp_leaveloop _((void)); +OP * pp_return _((void)); +OP * pp_last _((void)); +OP * pp_next _((void)); +OP * pp_redo _((void)); +OP * pp_dump _((void)); +OP * pp_goto _((void)); +OP * pp_exit _((void)); +OP * pp_open _((void)); +OP * pp_close _((void)); +OP * pp_pipe_op _((void)); +OP * pp_fileno _((void)); +OP * pp_umask _((void)); +OP * pp_binmode _((void)); +OP * pp_tie _((void)); +OP * pp_untie _((void)); +OP * pp_dbmopen _((void)); +OP * pp_dbmclose _((void)); +OP * pp_sselect _((void)); +OP * pp_select _((void)); +OP * pp_getc _((void)); +OP * pp_read _((void)); +OP * pp_enterwrite _((void)); +OP * pp_leavewrite _((void)); +OP * pp_prtf _((void)); +OP * pp_print _((void)); +OP * pp_sysread _((void)); +OP * pp_syswrite _((void)); +OP * pp_send _((void)); +OP * pp_recv _((void)); +OP * pp_eof _((void)); +OP * pp_tell _((void)); +OP * pp_seek _((void)); +OP * pp_truncate _((void)); +OP * pp_fcntl _((void)); +OP * pp_ioctl _((void)); +OP * pp_flock _((void)); +OP * pp_socket _((void)); +OP * pp_sockpair _((void)); +OP * pp_bind _((void)); +OP * pp_connect _((void)); +OP * pp_listen _((void)); +OP * pp_accept _((void)); +OP * pp_shutdown _((void)); +OP * pp_gsockopt _((void)); +OP * pp_ssockopt _((void)); +OP * pp_getsockname _((void)); +OP * pp_getpeername _((void)); +OP * pp_lstat _((void)); +OP * pp_stat _((void)); +OP * pp_ftrread _((void)); +OP * pp_ftrwrite _((void)); +OP * pp_ftrexec _((void)); +OP * pp_fteread _((void)); +OP * pp_ftewrite _((void)); +OP * pp_fteexec _((void)); +OP * pp_ftis _((void)); +OP * pp_fteowned _((void)); +OP * pp_ftrowned _((void)); +OP * pp_ftzero _((void)); +OP * pp_ftsize _((void)); +OP * pp_ftmtime _((void)); +OP * pp_ftatime _((void)); +OP * pp_ftctime _((void)); +OP * pp_ftsock _((void)); +OP * pp_ftchr _((void)); +OP * pp_ftblk _((void)); +OP * pp_ftfile _((void)); +OP * pp_ftdir _((void)); +OP * pp_ftpipe _((void)); +OP * pp_ftlink _((void)); +OP * pp_ftsuid _((void)); +OP * pp_ftsgid _((void)); +OP * pp_ftsvtx _((void)); +OP * pp_fttty _((void)); +OP * pp_fttext _((void)); +OP * pp_ftbinary _((void)); +OP * pp_chdir _((void)); +OP * pp_chown _((void)); +OP * pp_chroot _((void)); +OP * pp_unlink _((void)); +OP * pp_chmod _((void)); +OP * pp_utime _((void)); +OP * pp_rename _((void)); +OP * pp_link _((void)); +OP * pp_symlink _((void)); +OP * pp_readlink _((void)); +OP * pp_mkdir _((void)); +OP * pp_rmdir _((void)); +OP * pp_open_dir _((void)); +OP * pp_readdir _((void)); +OP * pp_telldir _((void)); +OP * pp_seekdir _((void)); +OP * pp_rewinddir _((void)); +OP * pp_closedir _((void)); +OP * pp_fork _((void)); +OP * pp_wait _((void)); +OP * pp_waitpid _((void)); +OP * pp_system _((void)); +OP * pp_exec _((void)); +OP * pp_kill _((void)); +OP * pp_getppid _((void)); +OP * pp_getpgrp _((void)); +OP * pp_setpgrp _((void)); +OP * pp_getpriority _((void)); +OP * pp_setpriority _((void)); +OP * pp_time _((void)); +OP * pp_tms _((void)); +OP * pp_localtime _((void)); +OP * pp_gmtime _((void)); +OP * pp_alarm _((void)); +OP * pp_sleep _((void)); +OP * pp_shmget _((void)); +OP * pp_shmctl _((void)); +OP * pp_shmread _((void)); +OP * pp_shmwrite _((void)); +OP * pp_msgget _((void)); +OP * pp_msgctl _((void)); +OP * pp_msgsnd _((void)); +OP * pp_msgrcv _((void)); +OP * pp_semget _((void)); +OP * pp_semctl _((void)); +OP * pp_semop _((void)); +OP * pp_require _((void)); +OP * pp_dofile _((void)); +OP * pp_entereval _((void)); +OP * pp_leaveeval _((void)); +OP * pp_entertry _((void)); +OP * pp_leavetry _((void)); +OP * pp_ghbyname _((void)); +OP * pp_ghbyaddr _((void)); +OP * pp_ghostent _((void)); +OP * pp_gnbyname _((void)); +OP * pp_gnbyaddr _((void)); +OP * pp_gnetent _((void)); +OP * pp_gpbyname _((void)); +OP * pp_gpbynumber _((void)); +OP * pp_gprotoent _((void)); +OP * pp_gsbyname _((void)); +OP * pp_gsbyport _((void)); +OP * pp_gservent _((void)); +OP * pp_shostent _((void)); +OP * pp_snetent _((void)); +OP * pp_sprotoent _((void)); +OP * pp_sservent _((void)); +OP * pp_ehostent _((void)); +OP * pp_enetent _((void)); +OP * pp_eprotoent _((void)); +OP * pp_eservent _((void)); +OP * pp_gpwnam _((void)); +OP * pp_gpwuid _((void)); +OP * pp_gpwent _((void)); +OP * pp_spwent _((void)); +OP * pp_epwent _((void)); +OP * pp_ggrnam _((void)); +OP * pp_ggrgid _((void)); +OP * pp_ggrent _((void)); +OP * pp_sgrent _((void)); +OP * pp_egrent _((void)); +OP * pp_getlogin _((void)); +OP * pp_syscall _((void)); #ifndef DOINIT -extern OP * (*ppaddr[])(); +EXT OP * (*ppaddr[])(); #else -OP * (*ppaddr[])() = { +EXT OP * (*ppaddr[])() = { pp_null, pp_stub, pp_scalar, pp_pushmark, pp_wantarray, pp_const, - pp_interp, pp_gvsv, pp_gv, pp_padsv, @@ -1062,7 +1083,9 @@ OP * (*ppaddr[])() = { pp_rv2sv, pp_av2arylen, pp_rv2cv, + pp_anoncode, pp_refgen, + pp_srefgen, pp_ref, pp_bless, pp_backtick, @@ -1077,11 +1100,14 @@ OP * (*ppaddr[])() = { pp_trans, pp_sassign, pp_aassign, - pp_schop, pp_chop, + pp_schop, + pp_chomp, + pp_schomp, pp_defined, pp_undef, pp_study, + pp_pos, pp_preinc, pp_i_preinc, pp_predec, @@ -1103,6 +1129,7 @@ OP * (*ppaddr[])() = { pp_subtract, pp_i_subtract, pp_concat, + pp_stringify, pp_left_shift, pp_right_shift, pp_lt, @@ -1127,7 +1154,7 @@ OP * (*ppaddr[])() = { pp_sne, pp_scmp, pp_bit_and, - pp_xor, + pp_bit_xor, pp_bit_or, pp_negate, pp_i_negate, @@ -1159,6 +1186,7 @@ OP * (*ppaddr[])() = { pp_lcfirst, pp_uc, pp_lc, + pp_quotemeta, pp_rv2av, pp_aelemfast, pp_aelem, @@ -1167,6 +1195,7 @@ OP * (*ppaddr[])() = { pp_values, pp_keys, pp_delete, + pp_exists, pp_rv2hv, pp_helem, pp_hslice, @@ -1187,17 +1216,20 @@ OP * (*ppaddr[])() = { pp_reverse, pp_grepstart, pp_grepwhile, + pp_mapstart, + pp_mapwhile, pp_range, pp_flip, pp_flop, pp_and, pp_or, + pp_xor, pp_cond_expr, pp_andassign, pp_orassign, pp_method, - pp_entersubr, - pp_leavesubr, + pp_entersub, + pp_leavesub, pp_caller, pp_warn, pp_die, @@ -1220,8 +1252,6 @@ OP * (*ppaddr[])() = { pp_dump, pp_goto, pp_exit, - pp_nswitch, - pp_cswitch, pp_open, pp_close, pp_pipe_op, @@ -1341,7 +1371,6 @@ OP * (*ppaddr[])() = { pp_dofile, pp_entereval, pp_leaveeval, - pp_evalonce, pp_entertry, pp_leavetry, pp_ghbyname, @@ -1380,16 +1409,15 @@ OP * (*ppaddr[])() = { #endif #ifndef DOINIT -extern OP * (*check[])(); +EXT OP * (*check[])(); #else -OP * (*check[])() = { +EXT OP * (*check[])() = { ck_null, /* null */ ck_null, /* stub */ ck_fun, /* scalar */ ck_null, /* pushmark */ ck_null, /* wantarray */ ck_svconst, /* const */ - ck_null, /* interp */ ck_null, /* gvsv */ ck_null, /* gv */ ck_null, /* padsv */ @@ -1402,7 +1430,9 @@ OP * (*check[])() = { ck_rvconst, /* rv2sv */ ck_null, /* av2arylen */ ck_rvconst, /* rv2cv */ - ck_null, /* refgen */ + ck_null, /* anoncode */ + ck_spair, /* refgen */ + ck_null, /* srefgen */ ck_fun, /* ref */ ck_fun, /* bless */ ck_null, /* backtick */ @@ -1417,11 +1447,14 @@ OP * (*check[])() = { ck_null, /* trans */ ck_null, /* sassign */ ck_null, /* aassign */ + ck_spair, /* chop */ ck_null, /* schop */ - ck_chop, /* chop */ + ck_spair, /* chomp */ + ck_null, /* schomp */ ck_rfun, /* defined */ ck_lfun, /* undef */ ck_fun, /* study */ + ck_lfun, /* pos */ ck_lfun, /* preinc */ ck_lfun, /* i_preinc */ ck_lfun, /* predec */ @@ -1443,6 +1476,7 @@ OP * (*check[])() = { ck_null, /* subtract */ ck_null, /* i_subtract */ ck_concat, /* concat */ + ck_fun, /* stringify */ ck_null, /* left_shift */ ck_null, /* right_shift */ ck_null, /* lt */ @@ -1467,7 +1501,7 @@ OP * (*check[])() = { ck_null, /* sne */ ck_null, /* scmp */ ck_null, /* bit_and */ - ck_null, /* xor */ + ck_null, /* bit_xor */ ck_null, /* bit_or */ ck_null, /* negate */ ck_null, /* i_negate */ @@ -1499,6 +1533,7 @@ OP * (*check[])() = { ck_fun, /* lcfirst */ ck_fun, /* uc */ ck_fun, /* lc */ + ck_fun, /* quotemeta */ ck_rvconst, /* rv2av */ ck_null, /* aelemfast */ ck_null, /* aelem */ @@ -1506,7 +1541,8 @@ OP * (*check[])() = { ck_fun, /* each */ ck_fun, /* values */ ck_fun, /* keys */ - ck_null, /* delete */ + ck_delete, /* delete */ + ck_delete, /* exists */ ck_rvconst, /* rv2hv */ ck_null, /* helem */ ck_null, /* hslice */ @@ -1516,8 +1552,8 @@ OP * (*check[])() = { ck_fun, /* join */ ck_null, /* list */ ck_null, /* lslice */ - ck_null, /* anonlist */ - ck_null, /* anonhash */ + ck_fun, /* anonlist */ + ck_fun, /* anonhash */ ck_fun, /* splice */ ck_fun, /* push */ ck_shift, /* pop */ @@ -1527,17 +1563,20 @@ OP * (*check[])() = { ck_fun, /* reverse */ ck_grep, /* grepstart */ ck_null, /* grepwhile */ + ck_grep, /* mapstart */ + ck_null, /* mapwhile */ ck_null, /* range */ ck_null, /* flip */ ck_null, /* flop */ ck_null, /* and */ ck_null, /* or */ + ck_null, /* xor */ ck_null, /* cond_expr */ ck_null, /* andassign */ ck_null, /* orassign */ ck_null, /* method */ - ck_subr, /* entersubr */ - ck_null, /* leavesubr */ + ck_subr, /* entersub */ + ck_null, /* leavesub */ ck_fun, /* caller */ ck_fun, /* warn */ ck_fun, /* die */ @@ -1560,8 +1599,6 @@ OP * (*check[])() = { ck_null, /* dump */ ck_null, /* goto */ ck_fun, /* exit */ - ck_null, /* nswitch */ - ck_null, /* cswitch */ ck_fun, /* open */ ck_fun, /* close */ ck_fun, /* pipe_op */ @@ -1681,7 +1718,6 @@ OP * (*check[])() = { ck_fun, /* dofile */ ck_eval, /* entereval */ ck_null, /* leaveeval */ - ck_null, /* evalonce */ ck_null, /* entertry */ ck_null, /* leavetry */ ck_fun, /* ghbyname */ @@ -1722,17 +1758,16 @@ OP * (*check[])() = { #ifndef DOINIT EXT U32 opargs[]; #else -U32 opargs[] = { +EXT U32 opargs[] = { 0x00000000, /* null */ 0x00000000, /* stub */ 0x00000104, /* scalar */ 0x00000004, /* pushmark */ 0x00000014, /* wantarray */ 0x00000004, /* const */ - 0x00000000, /* interp */ 0x00000044, /* gvsv */ 0x00000044, /* gv */ - 0x00000000, /* padsv */ + 0x00000004, /* padsv */ 0x00000000, /* padav */ 0x00000000, /* padhv */ 0x00000000, /* padany */ @@ -1742,11 +1777,13 @@ U32 opargs[] = { 0x00000044, /* rv2sv */ 0x00000014, /* av2arylen */ 0x00000040, /* rv2cv */ - 0x0000020e, /* refgen */ - 0x0000090c, /* ref */ + 0x00000000, /* anoncode */ + 0x00000201, /* refgen */ + 0x00000106, /* srefgen */ + 0x0000098c, /* ref */ 0x00009104, /* bless */ 0x00000008, /* backtick */ - 0x00000008, /* glob */ + 0x00001108, /* glob */ 0x00000008, /* readline */ 0x00000008, /* rcatline */ 0x00000104, /* regcmaybe */ @@ -1757,20 +1794,23 @@ U32 opargs[] = { 0x00000114, /* trans */ 0x00000004, /* sassign */ 0x00002208, /* aassign */ - 0x00000008, /* schop */ - 0x00000209, /* chop */ - 0x00000914, /* defined */ + 0x0000020d, /* chop */ + 0x0000098c, /* schop */ + 0x0000020d, /* chomp */ + 0x0000098c, /* schomp */ + 0x00000994, /* defined */ 0x00000904, /* undef */ - 0x0000090c, /* study */ - 0x00000124, /* preinc */ - 0x00000114, /* i_preinc */ - 0x00000124, /* predec */ - 0x00000114, /* i_predec */ - 0x0000012c, /* postinc */ - 0x0000011c, /* i_postinc */ - 0x0000012c, /* postdec */ - 0x0000011c, /* i_postdec */ - 0x0000112e, /* pow */ + 0x0000098c, /* study */ + 0x0000098c, /* pos */ + 0x00000164, /* preinc */ + 0x00000154, /* i_preinc */ + 0x00000164, /* predec */ + 0x00000154, /* i_predec */ + 0x0000016c, /* postinc */ + 0x0000015c, /* i_postinc */ + 0x0000016c, /* postdec */ + 0x0000015c, /* i_postdec */ + 0x0000110e, /* pow */ 0x0000112e, /* multiply */ 0x0000111e, /* i_multiply */ 0x0000112e, /* divide */ @@ -1783,6 +1823,7 @@ U32 opargs[] = { 0x0000112e, /* subtract */ 0x0000111e, /* i_subtract */ 0x0000110e, /* concat */ + 0x0000010e, /* stringify */ 0x0000111e, /* left_shift */ 0x0000111e, /* right_shift */ 0x00001136, /* lt */ @@ -1807,38 +1848,39 @@ U32 opargs[] = { 0x00001116, /* sne */ 0x0000111e, /* scmp */ 0x0000110e, /* bit_and */ - 0x0000110e, /* xor */ + 0x0000110e, /* bit_xor */ 0x0000110e, /* bit_or */ 0x0000012e, /* negate */ 0x0000011e, /* i_negate */ 0x00000116, /* not */ 0x0000010e, /* complement */ 0x0000110e, /* atan2 */ - 0x0000090e, /* sin */ - 0x0000090e, /* cos */ + 0x0000098e, /* sin */ + 0x0000098e, /* cos */ 0x0000090c, /* rand */ 0x00000904, /* srand */ - 0x0000090e, /* exp */ - 0x0000090e, /* log */ - 0x0000090e, /* sqrt */ - 0x0000090e, /* int */ - 0x0000091c, /* hex */ - 0x0000091c, /* oct */ - 0x0000090e, /* abs */ - 0x0000011c, /* length */ + 0x0000098e, /* exp */ + 0x0000098e, /* log */ + 0x0000098e, /* sqrt */ + 0x0000098e, /* int */ + 0x0000099c, /* hex */ + 0x0000099c, /* oct */ + 0x0000098e, /* abs */ + 0x0000099c, /* length */ 0x0009110c, /* substr */ 0x0001111c, /* vec */ 0x0009111c, /* index */ 0x0009111c, /* rindex */ 0x0000210d, /* sprintf */ 0x00002105, /* formline */ - 0x0000091e, /* ord */ - 0x0000090e, /* chr */ + 0x0000099e, /* ord */ + 0x0000098e, /* chr */ 0x0000110e, /* crypt */ - 0x0000010a, /* ucfirst */ - 0x0000010a, /* lcfirst */ - 0x0000010a, /* uc */ - 0x0000010a, /* lc */ + 0x0000010e, /* ucfirst */ + 0x0000010e, /* lcfirst */ + 0x0000010e, /* uc */ + 0x0000010e, /* lc */ + 0x0000010e, /* quotemeta */ 0x00000048, /* rv2av */ 0x00001304, /* aelemfast */ 0x00001304, /* aelem */ @@ -1846,7 +1888,8 @@ U32 opargs[] = { 0x00000408, /* each */ 0x00000408, /* values */ 0x00000408, /* keys */ - 0x00001404, /* delete */ + 0x00000104, /* delete */ + 0x00000114, /* exists */ 0x00000048, /* rv2hv */ 0x00001404, /* helem */ 0x00002401, /* hslice */ @@ -1856,9 +1899,9 @@ U32 opargs[] = { 0x0000210d, /* join */ 0x00000201, /* list */ 0x00022400, /* lslice */ - 0x00000201, /* anonlist */ - 0x00000201, /* anonhash */ - 0x00291301, /* splice */ + 0x00000205, /* anonlist */ + 0x00000205, /* anonhash */ + 0x00299301, /* splice */ 0x0000231d, /* push */ 0x00000304, /* pop */ 0x00000304, /* shift */ @@ -1867,17 +1910,20 @@ U32 opargs[] = { 0x00000209, /* reverse */ 0x00002541, /* grepstart */ 0x00000048, /* grepwhile */ + 0x00002541, /* mapstart */ + 0x00000048, /* mapwhile */ 0x00001100, /* range */ 0x00001100, /* flip */ 0x00000000, /* flop */ 0x00000000, /* and */ 0x00000000, /* or */ + 0x00001106, /* xor */ 0x00000000, /* cond_expr */ 0x00000004, /* andassign */ 0x00000004, /* orassign */ 0x00000040, /* method */ - 0x00000241, /* entersubr */ - 0x00000000, /* leavesubr */ + 0x00000249, /* entersub */ + 0x00000000, /* leavesub */ 0x00000908, /* caller */ 0x0000021d, /* warn */ 0x0000025d, /* die */ @@ -1892,7 +1938,7 @@ U32 opargs[] = { 0x00000040, /* enteriter */ 0x00000000, /* iter */ 0x00000040, /* enterloop */ - 0x00000004, /* leaveloop */ + 0x00000000, /* leaveloop */ 0x00000241, /* return */ 0x00000044, /* last */ 0x00000044, /* next */ @@ -1900,8 +1946,6 @@ U32 opargs[] = { 0x00000044, /* dump */ 0x00000044, /* goto */ 0x00000944, /* exit */ - 0x00000040, /* nswitch */ - 0x00000040, /* cswitch */ 0x0000961c, /* open */ 0x00000e14, /* close */ 0x00006614, /* pipe_op */ @@ -1942,47 +1986,47 @@ U32 opargs[] = { 0x00111614, /* ssockopt */ 0x00000614, /* getsockname */ 0x00000614, /* getpeername */ - 0x00000600, /* lstat */ - 0x00000600, /* stat */ - 0x00000614, /* ftrread */ - 0x00000614, /* ftrwrite */ - 0x00000614, /* ftrexec */ - 0x00000614, /* fteread */ - 0x00000614, /* ftewrite */ - 0x00000614, /* fteexec */ - 0x00000614, /* ftis */ - 0x00000614, /* fteowned */ - 0x00000614, /* ftrowned */ - 0x00000614, /* ftzero */ - 0x0000061c, /* ftsize */ - 0x0000060c, /* ftmtime */ - 0x0000060c, /* ftatime */ - 0x0000060c, /* ftctime */ - 0x00000614, /* ftsock */ - 0x00000614, /* ftchr */ - 0x00000614, /* ftblk */ - 0x00000614, /* ftfile */ - 0x00000614, /* ftdir */ - 0x00000614, /* ftpipe */ - 0x00000614, /* ftlink */ - 0x00000614, /* ftsuid */ - 0x00000614, /* ftsgid */ - 0x00000614, /* ftsvtx */ + 0x00000680, /* lstat */ + 0x00000680, /* stat */ + 0x00000694, /* ftrread */ + 0x00000694, /* ftrwrite */ + 0x00000694, /* ftrexec */ + 0x00000694, /* fteread */ + 0x00000694, /* ftewrite */ + 0x00000694, /* fteexec */ + 0x00000694, /* ftis */ + 0x00000694, /* fteowned */ + 0x00000694, /* ftrowned */ + 0x00000694, /* ftzero */ + 0x0000069c, /* ftsize */ + 0x0000068c, /* ftmtime */ + 0x0000068c, /* ftatime */ + 0x0000068c, /* ftctime */ + 0x00000694, /* ftsock */ + 0x00000694, /* ftchr */ + 0x00000694, /* ftblk */ + 0x00000694, /* ftfile */ + 0x00000694, /* ftdir */ + 0x00000694, /* ftpipe */ + 0x00000694, /* ftlink */ + 0x00000694, /* ftsuid */ + 0x00000694, /* ftsgid */ + 0x00000694, /* ftsvtx */ 0x00000614, /* fttty */ - 0x00000614, /* fttext */ - 0x00000614, /* ftbinary */ + 0x00000694, /* fttext */ + 0x00000694, /* ftbinary */ 0x0000091c, /* chdir */ 0x0000021d, /* chown */ - 0x0000091c, /* chroot */ - 0x0000021d, /* unlink */ + 0x0000099c, /* chroot */ + 0x0000029d, /* unlink */ 0x0000021d, /* chmod */ 0x0000021d, /* utime */ 0x0000111c, /* rename */ 0x0000111c, /* link */ 0x0000111c, /* symlink */ - 0x0000090c, /* readlink */ + 0x0000098c, /* readlink */ 0x0000111c, /* mkdir */ - 0x0000091c, /* rmdir */ + 0x0000099c, /* rmdir */ 0x00001614, /* open_dir */ 0x00000600, /* readdir */ 0x0000060c, /* telldir */ @@ -1997,14 +2041,14 @@ U32 opargs[] = { 0x0000025d, /* kill */ 0x0000001c, /* getppid */ 0x0000091c, /* getpgrp */ - 0x0000111c, /* setpgrp */ + 0x0000991c, /* setpgrp */ 0x0000111c, /* getpriority */ 0x0001111c, /* setpriority */ 0x0000001c, /* time */ 0x00000000, /* tms */ 0x00000908, /* localtime */ 0x00000908, /* gmtime */ - 0x0000091c, /* alarm */ + 0x0000099c, /* alarm */ 0x0000091c, /* sleep */ 0x0001111d, /* shmget */ 0x0001111d, /* shmctl */ @@ -2017,11 +2061,10 @@ U32 opargs[] = { 0x0001111d, /* semget */ 0x0011111d, /* semctl */ 0x0001111d, /* semop */ - 0x00000940, /* require */ + 0x000009c0, /* require */ 0x00000140, /* dofile */ 0x00000140, /* entereval */ 0x00000100, /* leaveeval */ - 0x00000140, /* evalonce */ 0x00000000, /* entertry */ 0x00000000, /* leavetry */ 0x00000100, /* ghbyname */ @@ -2047,14 +2090,14 @@ U32 opargs[] = { 0x00000100, /* gpwnam */ 0x00000100, /* gpwuid */ 0x00000000, /* gpwent */ - 0x0000001c, /* spwent */ - 0x0000001c, /* epwent */ + 0x00000014, /* spwent */ + 0x00000014, /* epwent */ 0x00000100, /* ggrnam */ 0x00000100, /* ggrgid */ 0x00000000, /* ggrent */ - 0x0000001c, /* sgrent */ - 0x0000001c, /* egrent */ + 0x00000014, /* sgrent */ + 0x00000014, /* egrent */ 0x0000000c, /* getlogin */ - 0x0000211c, /* syscall */ + 0x0000211d, /* syscall */ }; #endif diff --git a/opcode.pl b/opcode.pl index 953cb52..351f6af 100755 --- a/opcode.pl +++ b/opcode.pl @@ -33,9 +33,9 @@ print "\n#define MAXO ", scalar @ops, "\n\n"; print < ck_null t rcatline append I/O operator ck_null t @@ -208,24 +210,27 @@ trans character translation ck_null is S sassign scalar assignment ck_null s aassign list assignment ck_null t L L -schop scalar chop ck_null t -chop chop ck_chop mt L -defined defined operator ck_rfun is S? +chop chop ck_spair mts L +schop scalar chop ck_null stu S? +chomp safe chop ck_spair mts L +schomp scalar safe chop ck_null stu S? +defined defined operator ck_rfun isu S? undef undef operator ck_lfun s S? -study study ck_fun st S? - -preinc preincrement ck_lfun Is S -i_preinc integer preincrement ck_lfun is S -predec predecrement ck_lfun Is S -i_predec integer predecrement ck_lfun is S -postinc postincrement ck_lfun Ist S -i_postinc integer postincrement ck_lfun ist S -postdec postdecrement ck_lfun Ist S -i_postdec integer postdecrement ck_lfun ist S +study study ck_fun stu S? +pos match position ck_lfun stu S? + +preinc preincrement ck_lfun dIs S +i_preinc integer preincrement ck_lfun dis S +predec predecrement ck_lfun dIs S +i_predec integer predecrement ck_lfun dis S +postinc postincrement ck_lfun dIst S +i_postinc integer postincrement ck_lfun dist S +postdec postdecrement ck_lfun dIst S +i_postdec integer postdecrement ck_lfun dist S # Ordinary operators. -pow exponentiation ck_null Ifst S S +pow exponentiation ck_null fst S S multiply multiplication ck_null Ifst S S i_multiply integer multiplication ck_null ifst S S @@ -240,6 +245,7 @@ i_add integer addition ck_null ifst S S subtract subtraction ck_null Ifst S S i_subtract integer subtraction ck_null ifst S S concat concatenation ck_concat fst S S +stringify string ck_fun fst S left_shift left bitshift ck_null ifst S S right_shift right bitshift ck_null ifst S S @@ -256,7 +262,7 @@ eq numeric eq ck_null Iifs S S i_eq integer eq ck_null ifs S S ne numeric ne ck_null Iifs S S i_ne integer ne ck_null ifs S S -ncmp spaceship ck_null Iifst S S +ncmp spaceship operator ck_null Iifst S S i_ncmp integer spaceship ck_null ifst S S slt string lt ck_null ifs S S @@ -267,9 +273,9 @@ seq string eq ck_null ifs S S sne string ne ck_null ifs S S scmp string comparison ck_null ifst S S -bit_and bit and ck_null fst S S -xor xor ck_null fst S S -bit_or bit or ck_null fst S S +bit_and bitwise and ck_null fst S S +bit_xor bitwise xor ck_null fst S S +bit_or bitwise or ck_null fst S S negate negate ck_null Ifst S i_negate integer negate ck_null ifst S @@ -279,22 +285,22 @@ complement 1's complement ck_null fst S # High falutin' math. atan2 atan2 ck_fun fst S S -sin sin ck_fun fst S? -cos cos ck_fun fst S? +sin sin ck_fun fstu S? +cos cos ck_fun fstu S? rand rand ck_fun st S? srand srand ck_fun s S? -exp exp ck_fun fst S? -log log ck_fun fst S? -sqrt sqrt ck_fun fst S? +exp exp ck_fun fstu S? +log log ck_fun fstu S? +sqrt sqrt ck_fun fstu S? -int int ck_fun fst S? -hex hex ck_fun ist S? -oct oct ck_fun ist S? -abs abs ck_fun fst S? +int int ck_fun fstu S? +hex hex ck_fun istu S? +oct oct ck_fun istu S? +abs abs ck_fun fstu S? # String stuff. -length length ck_lengthconst ist S +length length ck_lengthconst istu S? substr substr ck_fun st S S S? vec vec ck_fun ist S S S @@ -303,13 +309,14 @@ rindex rindex ck_index ist S S S? sprintf sprintf ck_fun mst S L formline formline ck_formline ms S L -ord ord ck_fun ifst S? -chr chr ck_fun fst S? +ord ord ck_fun ifstu S? +chr chr ck_fun fstu S? crypt crypt ck_fun fst S S -ucfirst upper case first ck_fun ft S -lcfirst lower case first ck_fun ft S -uc upper case ck_fun ft S -lc lower case ck_fun ft S +ucfirst upper case first ck_fun fst S +lcfirst lower case first ck_fun fst S +uc upper case ck_fun fst S +lc lower case ck_fun fst S +quotemeta quote metachars ck_fun fst S # Arrays. @@ -323,7 +330,8 @@ aslice array slice ck_null m A L each each ck_fun t H values values ck_fun t H keys keys ck_fun t H -delete delete ck_null s H S +delete delete ck_delete s S +exists exists operator ck_delete is S rv2hv associative array deref ck_rvconst dt helem associative array elem ck_null s H S hslice associative array slice ck_null m H L @@ -339,10 +347,10 @@ join join ck_fun mst S L list list ck_null m L lslice list slice ck_null 0 H L L -anonlist anonymous list ck_null m L -anonhash anonymous hash ck_null m L +anonlist anonymous list ck_fun ms L +anonhash anonymous hash ck_fun ms L -splice splice ck_fun m A S S? L +splice splice ck_fun m A S? S? L push push ck_fun imst A L pop pop ck_shift s A shift shift ck_shift s A @@ -353,6 +361,9 @@ reverse reverse ck_fun mt L grepstart grep ck_grep dm C L grepwhile grep iterator ck_null dt +mapstart map ck_grep dm C L +mapwhile map iterator ck_null dt + # Range stuff. range flipflop ck_null 0 S S @@ -363,13 +374,14 @@ flop range (or flop) ck_null 0 and logical and ck_null 0 or logical or ck_null 0 +xor logical xor ck_null fs S S cond_expr conditional expression ck_null 0 andassign logical and assignment ck_null s orassign logical or assignment ck_null s method method lookup ck_null d -entersubr subroutine entry ck_subr dm L -leavesubr subroutine exit ck_null 0 +entersub subroutine entry ck_subr dmt L +leavesub subroutine exit ck_null 0 caller caller ck_fun t S? warn warn ck_fun imst L die die ck_fun dimst L @@ -385,7 +397,7 @@ scope block ck_null 0 enteriter foreach loop entry ck_null d iter foreach loop iterator ck_null 0 enterloop loop entry ck_null d -leaveloop loop exit ck_null s +leaveloop loop exit ck_null 0 return return ck_fun dm L last last ck_null ds next next ck_null ds @@ -394,8 +406,8 @@ dump dump ck_null ds goto goto ck_null ds exit exit ck_fun ds S? -nswitch numeric switch ck_null d -cswitch character switch ck_null d +#nswitch numeric switch ck_null d +#cswitch character switch ck_null d # I/O. @@ -457,50 +469,50 @@ getpeername getpeername ck_fun is F # Stat calls. -lstat lstat ck_ftst 0 F -stat stat ck_ftst 0 F -ftrread -R ck_ftst is F -ftrwrite -W ck_ftst is F -ftrexec -X ck_ftst is F -fteread -r ck_ftst is F -ftewrite -w ck_ftst is F -fteexec -x ck_ftst is F -ftis -e ck_ftst is F -fteowned -O ck_ftst is F -ftrowned -o ck_ftst is F -ftzero -z ck_ftst is F -ftsize -s ck_ftst ist F -ftmtime -M ck_ftst st F -ftatime -A ck_ftst st F -ftctime -C ck_ftst st F -ftsock -S ck_ftst is F -ftchr -c ck_ftst is F -ftblk -b ck_ftst is F -ftfile -f ck_ftst is F -ftdir -d ck_ftst is F -ftpipe -p ck_ftst is F -ftlink -l ck_ftst is F -ftsuid -u ck_ftst is F -ftsgid -g ck_ftst is F -ftsvtx -k ck_ftst is F +lstat lstat ck_ftst u F +stat stat ck_ftst u F +ftrread -R ck_ftst isu F +ftrwrite -W ck_ftst isu F +ftrexec -X ck_ftst isu F +fteread -r ck_ftst isu F +ftewrite -w ck_ftst isu F +fteexec -x ck_ftst isu F +ftis -e ck_ftst isu F +fteowned -O ck_ftst isu F +ftrowned -o ck_ftst isu F +ftzero -z ck_ftst isu F +ftsize -s ck_ftst istu F +ftmtime -M ck_ftst stu F +ftatime -A ck_ftst stu F +ftctime -C ck_ftst stu F +ftsock -S ck_ftst isu F +ftchr -c ck_ftst isu F +ftblk -b ck_ftst isu F +ftfile -f ck_ftst isu F +ftdir -d ck_ftst isu F +ftpipe -p ck_ftst isu F +ftlink -l ck_ftst isu F +ftsuid -u ck_ftst isu F +ftsgid -g ck_ftst isu F +ftsvtx -k ck_ftst isu F fttty -t ck_ftst is F -fttext -T ck_ftst is F -ftbinary -B ck_ftst is F +fttext -T ck_ftst isu F +ftbinary -B ck_ftst isu F # File calls. chdir chdir ck_fun ist S? chown chown ck_fun imst L -chroot chroot ck_fun ist S? -unlink unlink ck_fun imst L +chroot chroot ck_fun istu S? +unlink unlink ck_fun imstu L chmod chmod ck_fun imst L utime utime ck_fun imst L rename rename ck_fun ist S S link link ck_fun ist S S symlink symlink ck_fun ist S S -readlink readlink ck_fun st S? +readlink readlink ck_fun stu S? mkdir mkdir ck_fun ist S S -rmdir rmdir ck_fun ist S? +rmdir rmdir ck_fun istu S? # Directory calls. @@ -521,7 +533,7 @@ exec exec ck_exec dimst S? L kill kill ck_fun dimst L getppid getppid ck_null ist getpgrp getpgrp ck_fun ist S? -setpgrp setpgrp ck_fun ist S S +setpgrp setpgrp ck_fun ist S? S? getpriority getpriority ck_fun ist S S setpriority setpriority ck_fun ist S S S @@ -531,7 +543,7 @@ time time ck_null ist tms times ck_null 0 localtime localtime ck_fun t S? gmtime gmtime ck_fun t S? -alarm alarm ck_fun ist S? +alarm alarm ck_fun istu S? sleep sleep ck_fun ist S? # Shared memory. @@ -556,11 +568,11 @@ semop semop ck_fun imst S S S # Eval. -require require ck_require d S? +require require ck_require du S? dofile do 'file' ck_fun d S entereval eval string ck_eval d S leaveeval eval exit ck_null 0 S -evalonce eval constant string ck_null d S +#evalonce eval constant string ck_null d S entertry eval block ck_null 0 leavetry eval block exit ck_null 0 @@ -589,15 +601,15 @@ eservent endservent ck_null is gpwnam getpwnam ck_fun 0 S gpwuid getpwuid ck_fun 0 S gpwent getpwent ck_null 0 -spwent setpwent ck_null ist -epwent endpwent ck_null ist +spwent setpwent ck_null is +epwent endpwent ck_null is ggrnam getgrnam ck_fun 0 S ggrgid getgrgid ck_fun 0 S ggrent getgrent ck_null 0 -sgrent setgrent ck_null ist -egrent endgrent ck_null ist +sgrent setgrent ck_null is +egrent endgrent ck_null is getlogin getlogin ck_null st # Miscellaneous. -syscall syscall ck_fun ist S L +syscall syscall ck_fun imst S L diff --git a/os2/Makefile b/os2/Makefile deleted file mode 100644 index 97d190f..0000000 --- a/os2/Makefile +++ /dev/null @@ -1,65 +0,0 @@ -# -# Makefile for compiling Perl under OS/2 -# -# Needs Microsoft C 6.00 and NMAKE -# - -EXP = c:\ms\lib\setargv.obj -link /noe - -DEF = os2\perl.def -BAD = os2\perl.bad - -OBJ = array.obj cmd.obj cons.obj consarg.obj doarg.obj doio.obj \ - dolist.obj dump.obj eval.obj form.obj hash.obj perl.obj perly.obj \ - regcomp.obj regexec.obj stab.obj str.obj toke.obj util.obj -OBJO = os2.obj popen.obj suffix.obj director.obj alarm.obj crypt.obj - -LIBS = lgdbm.lib - -YACC=bison -YFLAGS=-d - -CC=cl -nologo -CCL=cl -nologo -B2C2L -B3C3L - -CFLAGS=-W1 -AL -Zep -J -G2s -Olt -Gt 2048 -DDEBUGGING -#CFLAGS=-W1 -AL -Ziep -J -G2 -Od -Gt 2048 -DDEBUGGING - -LDFLAGS=-AL -Lp -F 8000 -#LDFLAGS=-AL -Lp -Zi -Li -F 8000 - -STRIP=bind -nologo -#STRIP=rem - -.c.obj: - $(CC) -c $(CFLAGS) $< - -{os2}.c{}.obj: - $(CC) -c $(CFLAGS) -I. -Ios2 $< - -all: perl.exe perlglob.exe - -perl.exe: $(OBJ) $(OBJO) - $(CC) $(LDFLAGS) $(OBJ) $(OBJO) $(LIBS) os2\perl.def -o $@ $(EXP) - $(STRIP) $@ -n @$(BAD) - -$(OBJ) $(OBJO): config.h -perl.obj str.obj cons.obj toke.obj: perly.h - -config.h: os2\config.h - cp os2\config.h config.h - -perly.c perly.h: perly.y - $(YACC) $(YFLAGS) -o $*.c $*.y - -eval.obj: eval.c - $(CCL) -c $(CFLAGS) $*.c -toke.obj: toke.c - $(CCL) -c $(CFLAGS) $*.c - -perlglob.exe: os2\glob.c os2\director.c - $(CC) -Zep -G2s -Olt -Lp os2\glob.c $(DEF) -o $@ $(EXP) - $(STRIP) $@ -n @$(BAD) - -clean: - -rm perly.c perly.h config.h *.obj >nul diff --git a/os2/README.OS2 b/os2/README.OS2 deleted file mode 100644 index 2cca20c..0000000 --- a/os2/README.OS2 +++ /dev/null @@ -1,434 +0,0 @@ - Notes on the OS/2 Perl port - - Raymond Chen - (rjc@math.princeton.edu) - - Kai Uwe Rommel - (rommel@lan.informatik.tu-muenchen.dbp.de) - --1. Background. - -This port was based on the MS-DOS port by Diomidis Spinellis. - -0. Set-up. - -First copy the files in the os2 directory into the parent -directory. Also install the file msdos/dir.h in your include -directory. - -1. Compiling. - -Perl has been compiled under MS-DOS using the Microsoft C compiler -version 6.0. Before compiling install dir.h as . You will -need a Unix-like make program and something like yacc (e.g. bison). I -just ran yacc on my UNIX box and downloaded the resulting y.tab.[ch] -files. Compilation takes 45 minutes on a 16MHz 386 machine running -no jobs other than the compiler, so you will probably need something to -do in the meantime. Like, say, lunch. (Compilation time does not -include formatting the manual.) If you compile with optimization -turned off, it takes about half as long. - -The executable is 270k (perlsym.exe is 473k; if you compile -without optimization, the sizes are 329K/531K), and the top level -directory needs 800K for sources, 550K for object code, and 800K for the -executables, assuming you want to build both perl.exe and perlsym.exe -with full optimization. - -The makefile will compile glob for you which you will need to place -somewhere in your path so that perl globbing will work correctly. All -the tests were run, although some modifications were necessary because -OS/2 isn't UNIX. The tests that failed failed because of limitations of -the operating system and aren't the fault of the compiler. a2p and s2p -were not tested. - -In the eg directory you will find the syscalls.pl header file, -and a sample program that demonstrates some of the improvements -of the OS/2 version over the MS-DOS version and some of the -system calls. - -2. Using OS/2 Perl - -The OS/2 version of perl has much of the functionality of the Unix -version. Here are some things that don't work: sockets, password -functions, [gs]et[eug]id, dbm functions, fork. - -One thing that doesn't work is "split" with no arguments. Somehow, -yylval.arg is empty ... [[ Wait, sorry, I fixed that. --rjc ]] - -Care has been taken to implement the rest, although the implementation -might not be the best possible. Here are short notes on the tricky -bits: - -2.1. In-place editing. - -Files currently can be edited in-place provided you are creating a -backup. Considerable effort is made to ensure that a reasonable -name for the backup is selected, while still remaining within -the 8.3 contraints of the FAT filesystem. (HPFS users have nothing -to worry about, since HPFS doesn't have the stupid 8.3 rule.) - -The rules for how OS/2 perl combines your filename with the suffix -(the thing passed to "-i") are rather complicated, but the basic -idea is that the "obvious" name is chosen. - -Here are the rules: - -Style 0: Append the suffix exactly as UNIX perl would do it. - If the filesystem likes it, use it. (HPFS will always - swallow it. FAT will rarely accept it.) - -Style 1: If the suffix begins with a '.', change the file extension - to whatever you supplied. If the name matches the original - name, use the fallback method. - -Style 2: If the suffix is a single character, not a '.', try to add the - suffix to the following places, using the first one that works. - [1] Append to extension. - [2] Append to filename, - [3] Replace end of extension, - [4] Replace end of filename. - If the name matches the original name, use the fallback method. - -Style 3: Any other case: Ignore the suffix completely and use the - fallback method. - -Fallback method: Change the extension to ".$$$". If that matches the - original name, then change the extension to ".~~~". - -If filename is more than 1000 characters long, we die a horrible -death. Sorry. - -Examples, assuming style 0 failed. - -suffix = ".bak" (style 1) - foo.bar => foo.bak - foo.bak => foo.$$$ (fallback) - foo.$$$ => foo.~~~ (fallback) - makefile => makefile.bak - -suffix = "~" (style 2) - foo.c => foo.c~ - foo.c~ => foo.c~~ - foo.c~~ => foo~.c~~ - foo~.c~~ => foo~~.c~~ - foo~~~~~.c~~ => foo~~~~~.$$$ (fallback) - - foo.pas => foo~.pas - makefile => makefile.~ - longname.fil => longname.fi~ - longname.fi~ => longnam~.fi~ - longnam~.fi~ => longnam~.$$$ - -2.2. Directory access. - -Are implemented, but in order to support telldir() and seekdir(), -they operate by reading in the entire directory at opendir(), -then handing out pieces of it each time you do a readdir(). - -2.3. Pipes and redirection. - -Pipes and redirection are supported. Although OS/2 does not -terminate programs which try to write to closed pipes, perl will -kill them for you if you do it like this: - - open(I, "long-running-program|"); - ... process a few lines ... - close(I); # discard the rest ... - -The killing works like this: We wait until the child program either -closes its stdout or tries to write to it. If it writes to its stdout, -we kill it. Otherwise, we cwait for it. This is pretty much what UNIX -does by default. - -All pipe commands are given to cmd.exe (or your COMSPEC) for execution as - - CMD /c your-command-line - -so you can go ahead and load it up with any goofy things you want, -like 2>1 redirection, more pipes, && || etc. - -The pipe() function is also supported, so you can go ahead and -make your own funky file descriptor connections before piping off -a process. However, you have to mark the descriptor you are -retaining as NOINHERIT before spawning, else you are in deadlock city. -Unfortunately, there's no way to mark the handle as NOINHERIT yet. -It's on my wish list. - -2.4. Syscall and Ioctl - -IOCtl is not supported because the API is very different from the -UNIX API. Instead, IOCtl is supported as a syscall. Here are -the syscalls I've written so far: - - $OS2_GetVersion = 0; - $OS2_Shutdown = 1; - $OS2_Beep = 2; - $OS2_PhysicalDisk = 3; - $OS2_Config = 4; - $OS2_IOCtl = 5; - $OS2_QCurDisk = 6; - $OS2_SelectDisk = 7; - $OS2_SetMaxFH = 8; - $OS2_Sleep = 9; - $OS2_StartSession = 10; - $OS2_StopSession = 11; - $OS2_SelectSession = 12; - -The arguments you pass are handed off to OS/2 without interpretation, -and the return value is returned straight to you. However, you don't -have to supply arguments for the ones whose descriptions are "must be -zero"; perl will supply the mandatory zeros for you. - -2.5. Binary file access - -Files are opened in text mode by default. This means that CR LF pairs -are translated to LF. If binary access is needed the `binarymode' -function should be used. There is currently no way to reverse the -effect of the binary function. If that is needed close and reopen the -file. - -2.6. Priority - -The getpriority and setpriority functions are implemented, but since -OS/2 priorities are different from UNIX priorities, the arguments aren't -the same. Basically, the arguments you pass are handed directly to -OS/2. The only exception is the last argument to setpriority. To make -it easier to make delta priorities, if the priority class is 0xff, it -is changed to 0. That way, you can write - - setpriority(0,0,-2) - -instead of - - setpriority(0,0,0xfe) - -to decrease the delta by 2. - -2.7. Interpreter startup. - -The effect of the Unix #!/bin/perl interpreter startup can be obtained -under OS/2 by giving the script a .cmd extension and beginning the script -with the line - - extproc C:\binp\perl.exe -S - -You should provide the appropriate path to your executable, and -the -S option is necessary so that perl can find your script. - -2.8. The kill function. - -UNIX and OS/2 have different ideas about the kill function. I've -done a pretty feeble job of taking perl's UNIXish approach and -trying to jam it into the OS/2 way. No doubt you'll find that -your kill()s aren't working. My apologies in advance. - -3. Bug reports. - -I don't normally have access to an OS/2 machine, so if you find -a bug, you can go ahead and tell me about it, but the odds that -I'd be able to fix it are slim. - -4. Wish list. - -4.1. OS/2. - -Make ENOPIPE a fatal error. - -Permit linking of files. (Allegedly, they're working on this.) - -Get a fork. - -Make CMD.EXE pass through the return code of its child. - -4.2 perl. - -Provide a nice way to add new functions to perl without having -to understand the innards of perl. Not being fluent in perl -innards hacking, I added my extra functions via syscall. - -4.3. My port. - -4.3.1. In-place editing. - -Make more idiot-proof. - -Allow in-place editing without backup. (How?) - -4.3.2. Spawning and piping. - -Make popen() cleverer. Currently, it blindly hands everything -off to CMD.EXE. This wastes an exec if the command line didn't -have any shell metacharacters and if the program being run -is not a batch file. - -Clever spawning is carried out by do_spawn. We should try -to make popen() do much of the same sort of preprocessing -as do_spawn does (which means, of course, that we probably -should yank out code to be dished off into a subroutine). - -In do_spawn(), use DosExecPgm instead of spawnl in order to get more -precise reasons why the child terminated (RESULTCODES). - - - July 1990 - - Raymond Chen - 1817 Oxford St. Apt 6 - Berkeley, CA 94709-1828 USA - ------------------------ -I picked up the OS/2 port with patches 19-28. When compiling, I found -out that os2.c and director.c were missing. I had to rewrite them because -even the original author of the port (Raymond Chen) did no longer have them. - -I had directory routines laying around, this was no big deal. -I rewrote os2.c, but did not implement the syscall() as described above. -I had not the time and did not really need it. Feel free ... - -Changes to above described port: - -- the small program GLOB is now named PERLGLOB for better ordering in - my /bin directory - -- added help page (well, a graphical user interface would be overkill - but a simple help page should be in every program :-) - -- several cosmetic changes in standard distribution files because of - naming conventions etc., #ifdef'd OS2 - -- syscall() not supported as noted above - -- chdir now recognizes also drive letters and changes also the drive - -- new mypopen(), mypclose() functions and simulation routines for DOS mode, - they are selected automatically in real mode -- the new pclose() does not kill the child, my experience is that this is - not needed. - -- setpriority is now: setpriority(class, pid, val) - see description of DosSetPrty() for class and val meanings -- getpriority is now: getpriority(dummy, pid) - see description of DosGetPrty() - -- kill is now: kill(pid, sig) - where sig can be 0 (kill process) - 1-3 (send process flags A-C, see DosFlagProcess()) - if pid is less than zero, the signal is sent to the whole - process tree originating at -pid. - -The following files are now new with patch >=29: - -readme.os2 this file - -dir.h sys/dir.h -director.c directory routines -os2.c kernel of OS/2 port (see below) -popen.c new popen.c -mktemp.c enhanced mktemp(), uses TMP env. variable, used by popen.c -alarm.c PD implementation for alarm() -alarm.h header for alarm.c - -perl.cs Compiler Shell script for perl itself -perl.def linker definition file for perl -perl.bad names of protect-only API calls for BIND -perlglob.cs Compiler Shell script for perl globbing program -perlglob.def linker definition file for perlglob -a2p.cs Compiler Shell script for a2p (see below) -a2p.def linker definition file for a2p -makefile Makefile, not tested - -perlsh.cmd the converted perlsh -perldb.dif changes required for perldb.pl (change for your needs) -selfrun.cmd sample selfrunning perl script for OS/2 -selfrun.bat sample selfrunning perl script for DOS mode - -Note: I don't use make but my own utility, the Compiler Shell CS. -It was posted in comp.binaries.os2 or you can ask me for the newest -version. The .CS files are the "makefiles" for it. - -Note: MS C 6.00 is required. C 5.1 is not capable of compiling perl, -especially not with -DDEBUGGING - - - August 1990 - - Kai Uwe Rommel - rommel@lan.informatik.tu-muenchen.dbp.de - Zennerstr. 1 - D-8000 Muenchen 70 - - -+ I have verified with patchlevel 37, that the OS/2 port compiles, - after doing two minor changes. HPFS filenames support was also added. - Some bugs were fixed. -+ To compile, - - you need the bison parser generator - - copy config.h from os2 into the main perl directory (important !) - - copy perl.cs and perlglob.cs from the os2 subdir to the main dir - - copy a2p.cs from os2 to x2p - - say "bison -d perl.y" - "ren perl_tab.c perl.c" and - "ren perl_tab.h perly.h" in the main directory - - say "cs perl" and - "cs perlglob" in the main directory - - say "cs a2p" in the x2p subdir -+ If you don't have CS or don't want to use it, you have to - construct a makefile ... -+ If you have GNU gdbm, you can define NDBM in config.h and link with a - large model library of gdbm. -+ I am not sure if I can verify the OS/2 port with each release - from Larry Wall. Therefore, in future releases there may be - changes required to compile perl for OS/2. - October 1990 - Kai Uwe Rommel - rommel@lan.informatik.tu-muenchen.dbp.de - - -Verified patchlevel 40. -Some bugs were fixed. Added alarm() support (using PD implementation). - - - November 1990 - - Kai Uwe Rommel - rommel@lan.informatik.tu-muenchen.dbp.de -Verified perl 4.0 at patchlevel 10 -Changes: -- some minor corrections and updates in various files -- new os2/config.h created from original config.H -- added support for crypt(), PD routine by A.Tanenbaum in new os2/crypt.c -- added support for wait4pid() in os2.c -- fixed/added support for -P option (requires a standard CPP for OS/2) -- os2/mktemp.c deleted, no longer needed -- new Makefile created for MS C 6.00 and it's NMAKE -- with os2/perl.cs, bison has no longer to be called manually -I have successfully run most tests. Diffs are in os2/tests.dif. -Often, only command names, shell expansion etc. have to be changed. -Test that still don't run are Unix-specific ones or fail because -of CR/LF-problems: -- io/argv.t, io/inplace.t, op/exec.t, op/glob.t (minor problems) -- io/fs.t, io/pipe.t op/fork.t, op/magic.t, op/time.t - (under OS/2 not supported features of Unix) -- op/pat.t (bug, not yet fixed) -Remember to remove the HAS_GDBM symbol from os2/config.h or -get GNU gdbm for OS/2. - June 1991 - Kai Uwe Rommel - rommel@lan.informatik.tu-muenchen.dbp.de -Verified perl 4.0 at patchlevel 19 -Minor fixes. Previous fixes at PL10 were not included into distribution. - November 1991 - Kai Uwe Rommel - rommel@informatik.tu-muenchen.dbp.de - - -Verified patchlevel 44. -Only two #ifdefs added to eval.c. Stack size for A2P had to be corrected. -PERLGLOB separated from DOS version because of HPFS support. - -[Note: instead of #ifdef'ing eval.c I fixed it in perl.h--lwall] - - January 1991 - - Kai Uwe Rommel - rommel@lan.informatik.tu-muenchen.dbp.de diff --git a/os2/a2p.cs b/os2/a2p.cs deleted file mode 100644 index 063ec25..0000000 --- a/os2/a2p.cs +++ /dev/null @@ -1,8 +0,0 @@ -(-W1 -Od -Ocgelt a2p.y{a2py.c}) -(-W1 -Od -Ocgelt hash.c str.c util.c walk.c) - -setargv.obj -..\os2\perl.def -a2p.exe - --AL -LB -S0x9000 diff --git a/os2/a2p.def b/os2/a2p.def deleted file mode 100644 index a14bc63..0000000 --- a/os2/a2p.def +++ /dev/null @@ -1 +0,0 @@ -(deprecated) diff --git a/os2/alarm.c b/os2/alarm.c deleted file mode 100644 index 974e238..0000000 --- a/os2/alarm.c +++ /dev/null @@ -1,149 +0,0 @@ -/* - * This software is Copyright 1989 by Jack Hudler. - * - * Permission is hereby granted to copy, reproduce, redistribute or otherwise - * use this software as long as: there is no monetary profit gained - * specifically from the use or reproduction or this software, it is not - * sold, rented, traded or otherwise marketed, and this copyright notice is - * included prominently in any copy made. - * - * The author make no claims as to the fitness or correctness of this software - * for any use whatsoever, and it is provided as is. Any use of this software - * is at the user's own risk. - * - */ - -/****************************** Module Header ******************************\ -* Module Name: alarm.c -* Created : 11-08-89 -* Author : Jack Hudler [jack@csccat.lonestar.org] -* Copyright : 1988 Jack Hudler. -* Function : Unix like alarm signal simulator. -\***************************************************************************/ - -/* Tested using OS2 1.2 with Microsoft C 5.1 and 6.0. */ - -#define INCL_DOSPROCESS -#define INCL_DOSSIGNALS -#define INCL_DOS -#include - -#include -#include -#include - -#include "alarm.h" - -#define ALARM_STACK 4096 /* This maybe over kill, but the page size is 4K */ - -static PBYTE pbAlarmStack; -static SEL selAlarmStack; -static TID tidAlarm; -static PID pidMain; -static BOOL bAlarmInit=FALSE; -static BOOL bAlarmRunning=FALSE; -static USHORT uTime; - -static VOID FAR alarm_thread ( VOID ) -{ - while(1) - { - if (bAlarmRunning) - { - DosSleep(1000L); - uTime--; - if (uTime==0L) - { - // send signal to the main process.. I could have put raise() here - // however that would require the use of the multithreaded library, - // and it does not contain raise()! - // I tried it with the standard library, this signaled ok, but a - // test printf in the signal would not work and even caused SEGV. - // So I signal the process through OS/2 and then the process - // signals itself. - if (bAlarmRunning) - DosFlagProcess(pidMain,FLGP_PID, PFLG_A,1); - bAlarmRunning=FALSE; - } - } - else - DosSleep(500L); - } -} - -static VOID PASCAL FAR AlarmSignal(USHORT usSigArg,USHORT usSigNum) -{ - /* - * this is not executed from the thread. The thread triggers Process - * flag A which is in the main processes scope, this inturn triggers - * (via the raise) SIGUSR1 which is defined to SIGALRM. - */ - raise(SIGUSR1); -} - -static void alarm_init(void) -{ - PFNSIGHANDLER pfnPrev; - USHORT pfAction; - PIDINFO pid; - - bAlarmInit = TRUE; - - if (!DosAllocSeg( ALARM_STACK, (PSEL) &selAlarmStack, SEG_NONSHARED )) - { - OFFSETOF(pbAlarmStack) = ALARM_STACK - 2; - SELECTOROF(pbAlarmStack) = selAlarmStack; - /* Create the thread */ - if (DosCreateThread( alarm_thread, &tidAlarm, pbAlarmStack )) - { - fprintf(stderr,"Alarm thread failed to start.\n"); - exit(1); - } - /* Setup the signal handler for Process Flag A */ - if (DosSetSigHandler(AlarmSignal,&pfnPrev,&pfAction,SIGA_ACCEPT,SIG_PFLG_A)) - { - fprintf(stderr,"SigHandler Failed to install.\n"); - exit(1); - } - /* Save main process ID, we'll need it for triggering the signal */ - DosGetPID(&pid); - pidMain = pid.pid; - } - else - exit(1); -} - -unsigned alarm(unsigned sec) -{ - if (!bAlarmInit) alarm_init(); - - if (sec) - { - uTime = sec; - bAlarmRunning = TRUE; - } - else - bAlarmRunning = FALSE; - - return 0; -} - -#ifdef TESTING -/* A simple test to see if it works */ -BOOL x; - -void timeout(void) -{ - fprintf(stderr,"ALARM TRIGGERED!!\n"); - DosBeep(1000,500); - x++; -} - -void main(void) -{ - (void) signal(SIGALRM, timeout); - (void) alarm(1L); - printf("ALARM RUNNING!!\n"); - while(!x); -} -#endif diff --git a/os2/alarm.h b/os2/alarm.h deleted file mode 100644 index b5fe694..0000000 --- a/os2/alarm.h +++ /dev/null @@ -1,2 +0,0 @@ -#define SIGALRM SIGUSR1 -unsigned alarm(unsigned); diff --git a/os2/config.h b/os2/config.h deleted file mode 100644 index b37cf5e..0000000 --- a/os2/config.h +++ /dev/null @@ -1,910 +0,0 @@ -/* manually edited version for OS/2 with MS C 6.00 - check the HAS_?DBM symbols and if you have such a library ... - June 1991, Kai Uwe Rommel */ - -#ifndef config_h -#define config_h -/* config.h - * 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. - */ - -#define OS2 - -/* OS/2 supports some additional things MS-DOS doesn't. - */ -#define S_ISUID 0 -#define S_ISGID 0 - -#define HAS_ALARM -#define HAS_GETPPID -#define HAS_PIPE -#define HAS_KILL -#define HAS_WAIT -#define HAS_UMASK -#define HAS_GDBM - -/* EUNICE - * This symbol, if defined, indicates that the program is being compiled - * under the EUNICE package under VMS. The program will need to handle - * things like files that don't go away the first time you unlink them, - * due to version numbering. It will also need to compensate for lack - * of a respectable link() command. - */ -/* VMS - * This symbol, if defined, indicates that the program is running under - * VMS. It is currently only set in conjunction with the EUNICE symbol. - */ -/*#undef EUNICE /**/ -/*#undef VMS /**/ - -/* ALIGNBYTES - * This symbol contains the number of bytes required to align a double. - * Usual values are 2, 4, and 8. - */ -#define ALIGNBYTES 2 /**/ - -/* BIN - * This symbol holds the name of the directory in which the user wants - * to keep publicly executable images for the package in question. It - * is most often a local directory such as /usr/local/bin. - */ -#define BIN "c:/bin" /**/ - -/* BYTEORDER - * This symbol contains an encoding of the order of bytes in a long. - * Usual values (in octal) are 01234, 04321, 02143, 03412... - */ -#define BYTEORDER 0x1234 /**/ - -/* 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". - */ -/* 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 "". - */ -#define CPPSTDIN "cpp -P" -#define CPPMINUS "" - -/* HAS_BCMP - * This symbol, if defined, indicates that the bcmp routine is available - * to compare blocks of memory. If undefined, use memcmp. If that's - * not available, roll your own. - */ -/* #define HAS_BCMP /**/ - -/* HAS_BCOPY - * This symbol, if defined, indicates that the bcopy routine is available - * to copy blocks of memory. Otherwise you should probably use memcpy(). - */ -/* #define HAS_BCOPY /**/ - -/* HAS_BZERO - * This symbol, if defined, indicates that the bzero routine is available - * to zero blocks of memory. Otherwise you should probably use memset() - * or roll your own. - */ -/* #define HAS_BZERO /**/ - -/* CASTNEGFLOAT - * This symbol, if defined, indicates that this C compiler knows how to - * cast negative or large floating point 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: - * 1 = couldn't cast < 0 - * 2 = couldn't cast >= 0x80000000 - */ -#define CASTNEGFLOAT /**/ -#define CASTFLAGS 1 /**/ - -/* CHARSPRINTF - * This symbol is defined if this system declares "char *sprintf()" in - * stdio.h. The trend seems to be to declare it as "int sprintf()". It - * is up to the package author to declare sprintf correctly based on the - * symbol. - */ -/* #define CHARSPRINTF /**/ - -/* 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. - */ -#undef HAS_CHSIZE /**/ - -/* HAS_CRYPT - * This symbol, if defined, indicates that the crypt routine is available - * to encrypt passwords and the like. - */ -#define HAS_CRYPT /**/ - -/* CSH - * This symbol, if defined, indicates that the C-shell exists. - * If defined, contains the full pathname of csh. - */ -/* #define CSH "/bin/csh" /**/ - -/* 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. - */ -/*#undef DOSUID /**/ - -/* HAS_DUP2 - * This symbol, if defined, indicates that the dup2 routine is available - * to dup file descriptors. Otherwise you should use dup(). - */ -#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 /**/ - -/* 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_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_GETHOSTENT - * This symbol, if defined, indicates that the gethostent() routine is - * available to lookup host names in some data base or other. - */ -/*#undef HAS_GETHOSTENT /**/ - -/* HAS_GETPGRP - * This symbol, if defined, indicates that the getpgrp() routine is - * available to get the current process group. - */ -/* #define HAS_GETPGRP /**/ - -/* HAS_GETPGRP2 - * This symbol, if defined, indicates that the getpgrp2() (as in DG/UX) - * routine is available to get the current process group. - */ -/*#undef HAS_GETPGRP2 /**/ - -/* HAS_GETPRIORITY - * This symbol, if defined, indicates that the getpriority() routine is - * available to get a process's priority. - */ -#define HAS_GETPRIORITY /**/ - -/* HAS_HTONS - * This symbol, if defined, indicates that the htons routine (and friends) - * are available to do network order byte swapping. - */ -/* HAS_HTONL - * This symbol, if defined, indicates that the htonl routine (and friends) - * are available to do network order byte swapping. - */ -/* HAS_NTOHS - * This symbol, if defined, indicates that the ntohs routine (and friends) - * are available to do network order byte swapping. - */ -/* HAS_NTOHL - * This symbol, if defined, indicates that the ntohl routine (and friends) - * are available to do network order byte swapping. - */ -/* #define HAS_HTONS /**/ -/* #define HAS_HTONL /**/ -/* #define HAS_NTOHS /**/ -/* #define HAS_NTOHL /**/ - -/* index - * This preprocessor symbol is defined, along with rindex, if the system - * uses the strchr and strrchr routines instead. - */ -/* rindex - * This preprocessor symbol is defined, along with index, if the system - * uses the strchr and strrchr routines instead. - */ -#define index strchr /* cultural */ -#define rindex strrchr /* differences? */ - -/* HAS_ISASCII - * This symbol, if defined, indicates that the isascii routine is available - * to test characters for asciiness. - */ -/*#undef HAS_ISASCII /**/ - -/* 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_LSTAT - * This symbol, if defined, indicates that the lstat() routine is - * available to stat symbolic links. - */ -/* #define HAS_LSTAT /**/ - -/* HAS_MEMCMP - * This symbol, if defined, indicates that the memcmp routine is available - * to compare blocks of memory. If undefined, roll your own. - */ -#define HAS_MEMCMP /**/ - -/* HAS_MEMCPY - * This symbol, if defined, indicates that the memcpy routine is available - * to copy blocks of memory. Otherwise you should probably use bcopy(). - * If neither is defined, roll your own. - */ -/* SAFE_MEMCPY - * This symbol, if defined, indicates that the memcpy routine is available - * to copy potentially overlapping copy blocks of memory. Otherwise you - * should probably use memmove() or bcopy(). If neither is defined, - * roll your own. - */ -#define HAS_MEMCPY /**/ -/*#undef SAFE_MEMCPY /**/ - -/* HAS_MEMMOVE - * This symbol, if defined, indicates that the memmove routine is available - * to move potentially overlapping blocks of memory. Otherwise you - * should use bcopy() or roll your own. - */ -/*#undef HAS_MEMMOVE /**/ - -/* HAS_MEMSET - * This symbol, if defined, indicates that the memset routine is available - * to set a block of memory to a character. If undefined, roll your own. - */ -#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_MSG - * This symbol, if defined, indicates that the entire msg*(2) library is - * supported. - */ -/* #define HAS_MSG /**/ - -/* HAS_MSGCTL - * This symbol, if defined, indicates that the msgctl() routine is - * available to control message passing. - */ -/* #define HAS_MSGCTL /**/ - -/* HAS_MSGGET - * This symbol, if defined, indicates that the msgget() routine is - * available to get messages. - */ -/* #define HAS_MSGGET /**/ - -/* HAS_MSGRCV - * This symbol, if defined, indicates that the msgrcv() routine is - * available to receive messages. - */ -/* #define HAS_MSGRCV /**/ - -/* HAS_MSGSND - * This symbol, if defined, indicates that the msgsnd() routine is - * available to send messages. - */ -/* #define HAS_MSGSND /**/ - -/* HAS_NDBM - * This symbol, if defined, indicates that ndbm.h exists and should - * be included. - */ -/* #define HAS_NDBM /**/ - -/* HAS_ODBM - * This symbol, if defined, indicates that dbm.h exists and should - * be included. - */ -/* #define HAS_ODBM /**/ - -/* HAS_OPEN3 - * This manifest constant lets the C program know that the three - * argument form of open(2) is available. - */ -#define HAS_OPEN3 /**/ - -/* HAS_READDIR - * This symbol, if defined, indicates that the readdir routine is available - * from the C library to read directories. - */ -#define HAS_READDIR /**/ - -/* 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_REWINDDIR - * This symbol, if defined, indicates that the rewindir routine is - * available to rewind directories. - */ -#define HAS_REWINDDIR /**/ - -/* 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_SEEKDIR - * This symbol, if defined, indicates that the seekdir routine is - * available to seek into directories. - */ -#define HAS_SEEKDIR /**/ - -/* HAS_SELECT - * This symbol, if defined, indicates that the select() subroutine - * exists. - */ -/* #define HAS_SELECT /**/ - -/* HAS_SEM - * This symbol, if defined, indicates that the entire sem*(2) library is - * supported. - */ -/* #define HAS_SEM /**/ - -/* HAS_SEMCTL - * This symbol, if defined, indicates that the semctl() routine is - * available to control semaphores. - */ -/* #define HAS_SEMCTL /**/ - -/* HAS_SEMGET - * This symbol, if defined, indicates that the semget() routine is - * available to get semaphores ids. - */ -/* #define HAS_SEMGET /**/ - -/* HAS_SEMOP - * This symbol, if defined, indicates that the semop() routine is - * available to perform semaphore operations. - */ -/* #define HAS_SEMOP /**/ - -/* 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_SETPGRP - * This symbol, if defined, indicates that the setpgrp() routine is - * available to set the current process group. - */ -/* #define HAS_SETPGRP /**/ - -/* HAS_SETPGRP2 - * This symbol, if defined, indicates that the setpgrp2() (as in DG/UX) - * routine is available to set the current process group. - */ -/*#undef 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 program. - */ -/* HAS_SETRESGID - * This symbol, if defined, indicates that the setresgid routine is - * available to change the real, effective and saved gid of the current - * program. - */ -/* #define HAS_SETREGID /**/ -/*#undef 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 program. - */ -/* HAS_SETRESUID - * This symbol, if defined, indicates that the setresuid routine is - * available to change the real, effective and saved uid of the current - * program. - */ -/* #define HAS_SETREUID /**/ -/*#undef 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_SHM - * This symbol, if defined, indicates that the entire shm*(2) library is - * supported. - */ -/* #define HAS_SHM /**/ - -/* HAS_SHMAT - * This symbol, if defined, indicates that the shmat() routine is - * available to attach a shared memory segment. - */ -/* VOID_SHMAT - * This symbol, if defined, indicates that the shmat() routine - * returns a pointer of type void*. - */ -/* #define HAS_SHMAT /**/ - -/*#undef VOIDSHMAT /**/ - -/* HAS_SHMCTL - * This symbol, if defined, indicates that the shmctl() routine is - * available to control a shared memory segment. - */ -/* #define HAS_SHMCTL /**/ - -/* HAS_SHMDT - * This symbol, if defined, indicates that the shmdt() routine is - * available to detach a shared memory segment. - */ -/* #define HAS_SHMDT /**/ - -/* HAS_SHMGET - * This symbol, if defined, indicates that the shmget() routine is - * available to get a shared memory segment id. - */ -/* #define HAS_SHMGET /**/ - -/* 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. - */ -/* OLDSOCKET - * This symbol, if defined, indicates that the 4.1c BSD socket interface - * is supported instead of the 4.2/4.3 BSD socket interface. - */ -/* #define HAS_SOCKET /**/ - -/* #define HAS_SOCKETPAIR /**/ - -/*#undef OLDSOCKET /**/ - -/* STATBLOCKS - * This symbol is defined if this system has a stat structure declaring - * st_blksize and st_blocks. - */ -/* #define STATBLOCKS /**/ - -/* STDSTDIO - * This symbol is defined if this system has a FILE structure declaring - * _ptr and _cnt in stdio.h. - */ -#define STDSTDIO /**/ - -/* STRUCTCOPY - * 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 STRUCTCOPY /**/ - -/* HAS_STRERROR - * This symbol, if defined, indicates that the strerror() routine is - * available to translate error numbers to strings. - */ -/*#undef HAS_STRERROR /**/ - -/* 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_TELLDIR - * This symbol, if defined, indicates that the telldir routine is - * available to tell your location in directories. - */ -#define HAS_TELLDIR /**/ - -/* HAS_TRUNCATE - * This symbol, if defined, indicates that the truncate routine is - * available to truncate files. - */ -/* #define HAS_TRUNCATE /**/ - -/* HAS_VFORK - * This symbol, if defined, indicates that vfork() exists. - */ -/* #define HAS_VFORK /**/ - -/* VOIDSIG - * This symbol is defined if this system declares "void (*signal())()" in - * signal.h. The old way was to declare it as "int (*signal())()". It - * is up to the package author to declare things correctly based on the - * symbol. - */ -/* TO_SIGNAL - * This symbol's value is either "void" or "int", corresponding to the - * appropriate return "type" of a signal handler. Thus, one can declare - * a signal handler using "TO_SIGNAL (*handler())()", and define the - * handler using "TO_SIGNAL handler(sig)". - */ -#define VOIDSIG /**/ -#define TO_SIGNAL void /**/ - -/* HASVOLATILE - * This symbol, if defined, indicates that this C compiler knows about - * the volatile declaration. - */ -#define HASVOLATILE /**/ - -/* 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(). - */ -/* CHARVSPRINTF - * 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 CHARVSPRINTF /**/ - -/* HAS_WAIT4 - * This symbol, if defined, indicates that wait4() exists. - */ -/* #define HAS_WAIT4 /**/ - -/* HAS_WAITPID - * This symbol, if defined, indicates that waitpid() exists. - */ -#define HAS_WAITPID /**/ - -/* GIDTYPE - * This symbol has a value like gid_t, int, ushort, or whatever type is - * used to declare group ids in the kernel. - */ -#define GIDTYPE int /**/ - -/* GROUPSTYPE - * This symbol has a value like gid_t, int, ushort, or whatever type is - * used in the return value of getgroups(). - */ -#define GROUPSTYPE int /**/ - -/* I_FCNTL - * This manifest constant tells the C program to include . - */ -/*#undef I_FCNTL /**/ - -/* I_GDBM - * This symbol, if defined, indicates that gdbm.h exists and should - * be included. - */ -#define I_GDBM /**/ - -/* I_GRP - * This symbol, if defined, indicates to the C program that it should - * include grp.h. - */ -/* #define I_GRP /**/ - -/* I_NETINET_IN - * This symbol, if defined, indicates to the C program that it should - * include netinet/in.h. - */ -/* I_SYS_IN - * This symbol, if defined, indicates to the C program that it should - * include sys/in.h. - */ -/* #define I_NETINET_IN /**/ -/*#undef I_SYS_IN /**/ - -/* I_PWD - * This symbol, if defined, indicates to the C program that it should - * include pwd.h. - */ -/* 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. - */ -/* #define I_PWD /**/ -/*#undef PWQUOTA /**/ -/* #define PWAGE /**/ -/*#undef PWCHANGE /**/ -/*#undef PWCLASS /**/ -/*#undef PWEXPIRE /**/ -/* #define PWCOMMENT /**/ - -/* I_SYS_FILE - * This manifest constant tells the C program to include . - */ -/* #define I_SYS_FILE /**/ - -/* I_SYSIOCTL - * This symbol, if defined, indicates that sys/ioctl.h exists and should - * be included. - */ -/* #define I_SYSIOCTL /**/ - -/* I_TIME - * This symbol is defined if the program should include . - */ -/* I_SYS_TIME - * This symbol is defined if the program should include . - */ -/* SYSTIMEKERNEL - * This symbol is defined if the program should include - * with KERNEL defined. - */ -/* I_SYS_SELECT - * This symbol is defined if the program should include . - */ -#define I_TIME /**/ -/* #define I_SYS_TIME /**/ -/*#undef SYSTIMEKERNEL /**/ -/*#undef I_SYS_SELECT /**/ - -/* I_UTIME - * This symbol, if defined, indicates to the C program that it should - * include utime.h. - */ -/* #define I_UTIME /**/ - -/* I_VARARGS - * This symbol, if defined, indicates to the C program that it should - * include varargs.h. - */ -#define I_VARARGS /**/ - -/* I_VFORK - * This symbol, if defined, indicates to the C program that it should - * include vfork.h. - */ -/* #define I_VFORK /**/ - -/* INTSIZE - * This symbol contains the size of an int, so that the C preprocessor - * can make decisions based on it. - */ -#define INTSIZE 2 /**/ - -/* I_DIRENT - * This symbol, if defined, indicates that the program should use the - * P1003-style directory routines, and include . - */ -/* I_SYS_DIR - * This symbol, if defined, indicates that the program should use the - * directory functions by including . - */ -/* I_NDIR - * This symbol, if defined, indicates that the program should include the - * system's version of ndir.h, rather than the one with this package. - */ -/* I_SYS_NDIR - * This symbol, if defined, indicates that the program should include the - * system's version of sys/ndir.h, rather than the one with this package. - */ -/* I_MY_DIR - * This symbol, if defined, indicates that the program should compile - * the ndir.c code provided with the package. - */ -/* 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. - */ -/* #define I_DIRENT /**/ -#define I_SYS_DIR /**/ -/*#undef I_NDIR /**/ -/*#undef I_SYS_NDIR /**/ -/*#undef I_MY_DIR /**/ -#define DIRNAMLEN /**/ - -/* MYMALLOC - * This symbol, if defined, indicates that we're using our own malloc. - */ -/* MALLOCPTRTYPE - * This symbol defines the kind of ptr returned by malloc and realloc. - */ -#define MYMALLOC /**/ - -#define MALLOCPTRTYPE void /**/ - - -/* RANDBITS - * This symbol contains the number of bits of random number the rand() - * function produces. Usual values are 15, 16, and 31. - */ -#define RANDBITS 15 /**/ - -/* SCRIPTDIR - * This symbol holds the name of the directory in which the user wants - * to keep publicly executable scripts for the package in question. It - * is often a directory that is mounted across diverse architectures. - */ -#define SCRIPTDIR "c:/bin/perl" /**/ - -/* SIG_NAME - * This symbol contains an list of signal names in order. - */ -#define SIG_NAME \ - "ZERO","HUP","INT","QUIT","ILL","TRAP","IOT","EMT","FPE",\ - /* 0 1 2 3 4 5 6 7 8 */\ - "KILL","BUS","SEGV","SYS","PIPE","UALRM","TERM","ALRM","USR2","CLD",\ - /* 9 10 11 12 13 14 15 16 17 18 */\ - "PWR","USR3","BREAK","ABRT" - /*19 20 21 22 */ - -/* 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 /**/ - -/* UIDTYPE - * This symbol has a value like uid_t, int, ushort, or whatever type is - * used to declare user ids in the kernel. - */ -#define UIDTYPE int /**/ - -/* VOIDHAVE - * 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 - * - * The package designer should define VOIDWANT to indicate the requirements - * of the package. This can be done either by #defining VOIDWANT before - * including config.h, or by defining voidwant in Myinit.U. If the level - * of void support necessary is not present, config.h defines void to "int", - * VOID to the empty string, and VOIDP to "char *". - */ -/* void - * This symbol is used for void casts. On implementations which support - * void appropriately, its value is "void". Otherwise, its value maps - * to "int". - */ -/* VOID - * This symbol's value is "void" if the implementation supports void - * appropriately. Otherwise, its value is the empty string. The primary - * use of this symbol is in specifying void parameter lists for function - * prototypes. - */ -/* VOIDP - * This symbol is used for casting generic pointers. On implementations - * which support void appropriately, its value is "void *". Otherwise, - * its value is "char *". - */ -#ifndef VOIDWANT -#define VOIDWANT 7 -#endif -#define VOIDHAVE 7 -#if (VOIDHAVE & VOIDWANT) != VOIDWANT -#define void int /* is void to be avoided? */ -#define VOID -#define VOIDP (char *) -#define M_VOID /* Xenix strikes again */ -#else -#define VOID void -#define VOIDP (void *) -#endif - -/* 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 PRIVLIB "c:/bin/perl" /**/ - -/* - * BINARY: - * This symbol is defined if you run under an operating system that - * distinguishes between binary and text files. If so the function - * setmode will be used to set the file into binary mode. - */ -#define BINARY - -#endif diff --git a/os2/crypt.c b/os2/crypt.c deleted file mode 100644 index 9f9b562..0000000 --- a/os2/crypt.c +++ /dev/null @@ -1,276 +0,0 @@ -/* From Andy Tanenbaum's book "Computer Networks", - rewritten in C -*/ - -struct block { - unsigned char b_data[64]; -}; - -struct ordering { - unsigned char o_data[64]; -}; - -static struct block key; - -static struct ordering InitialTr = { - 58,50,42,34,26,18,10, 2,60,52,44,36,28,20,12, 4, - 62,54,46,38,30,22,14, 6,64,56,48,40,32,24,16, 8, - 57,49,41,33,25,17, 9, 1,59,51,43,35,27,19,11, 3, - 61,53,45,37,29,21,13, 5,63,55,47,39,31,23,15, 7, -}; - -static struct ordering FinalTr = { - 40, 8,48,16,56,24,64,32,39, 7,47,15,55,23,63,31, - 38, 6,46,14,54,22,62,30,37, 5,45,13,53,21,61,29, - 36, 4,44,12,52,20,60,28,35, 3,43,11,51,19,59,27, - 34, 2,42,10,50,18,58,26,33, 1,41, 9,49,17,57,25, -}; - -static struct ordering swap = { - 33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48, - 49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64, - 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, -}; - -static struct ordering KeyTr1 = { - 57,49,41,33,25,17, 9, 1,58,50,42,34,26,18, - 10, 2,59,51,43,35,27,19,11, 3,60,52,44,36, - 63,55,47,39,31,23,15, 7,62,54,46,38,30,22, - 14, 6,61,53,45,37,29,21,13, 5,28,20,12, 4, -}; - -static struct ordering KeyTr2 = { - 14,17,11,24, 1, 5, 3,28,15, 6,21,10, - 23,19,12, 4,26, 8,16, 7,27,20,13, 2, - 41,52,31,37,47,55,30,40,51,45,33,48, - 44,49,39,56,34,53,46,42,50,36,29,32, -}; - -static struct ordering etr = { - 32, 1, 2, 3, 4, 5, 4, 5, 6, 7, 8, 9, - 8, 9,10,11,12,13,12,13,14,15,16,17, - 16,17,18,19,20,21,20,21,22,23,24,25, - 24,25,26,27,28,29,28,29,30,31,32, 1, -}; - -static struct ordering ptr = { - 16, 7,20,21,29,12,28,17, 1,15,23,26, 5,18,31,10, - 2, 8,24,14,32,27, 3, 9,19,13,30, 6,22,11, 4,25, -}; - -static unsigned char s_boxes[8][64] = { -{ 14, 4,13, 1, 2,15,11, 8, 3,10, 6,12, 5, 9, 0, 7, - 0,15, 7, 4,14, 2,13, 1,10, 6,12,11, 9, 5, 3, 8, - 4, 1,14, 8,13, 6, 2,11,15,12, 9, 7, 3,10, 5, 0, - 15,12, 8, 2, 4, 9, 1, 7, 5,11, 3,14,10, 0, 6,13, -}, - -{ 15, 1, 8,14, 6,11, 3, 4, 9, 7, 2,13,12, 0, 5,10, - 3,13, 4, 7,15, 2, 8,14,12, 0, 1,10, 6, 9,11, 5, - 0,14, 7,11,10, 4,13, 1, 5, 8,12, 6, 9, 3, 2,15, - 13, 8,10, 1, 3,15, 4, 2,11, 6, 7,12, 0, 5,14, 9, -}, - -{ 10, 0, 9,14, 6, 3,15, 5, 1,13,12, 7,11, 4, 2, 8, - 13, 7, 0, 9, 3, 4, 6,10, 2, 8, 5,14,12,11,15, 1, - 13, 6, 4, 9, 8,15, 3, 0,11, 1, 2,12, 5,10,14, 7, - 1,10,13, 0, 6, 9, 8, 7, 4,15,14, 3,11, 5, 2,12, -}, - -{ 7,13,14, 3, 0, 6, 9,10, 1, 2, 8, 5,11,12, 4,15, - 13, 8,11, 5, 6,15, 0, 3, 4, 7, 2,12, 1,10,14, 9, - 10, 6, 9, 0,12,11, 7,13,15, 1, 3,14, 5, 2, 8, 4, - 3,15, 0, 6,10, 1,13, 8, 9, 4, 5,11,12, 7, 2,14, -}, - -{ 2,12, 4, 1, 7,10,11, 6, 8, 5, 3,15,13, 0,14, 9, - 14,11, 2,12, 4, 7,13, 1, 5, 0,15,10, 3, 9, 8, 6, - 4, 2, 1,11,10,13, 7, 8,15, 9,12, 5, 6, 3, 0,14, - 11, 8,12, 7, 1,14, 2,13, 6,15, 0, 9,10, 4, 5, 3, -}, - -{ 12, 1,10,15, 9, 2, 6, 8, 0,13, 3, 4,14, 7, 5,11, - 10,15, 4, 2, 7,12, 9, 5, 6, 1,13,14, 0,11, 3, 8, - 9,14,15, 5, 2, 8,12, 3, 7, 0, 4,10, 1,13,11, 6, - 4, 3, 2,12, 9, 5,15,10,11,14, 1, 7, 6, 0, 8,13, -}, - -{ 4,11, 2,14,15, 0, 8,13, 3,12, 9, 7, 5,10, 6, 1, - 13, 0,11, 7, 4, 9, 1,10,14, 3, 5,12, 2,15, 8, 6, - 1, 4,11,13,12, 3, 7,14,10,15, 6, 8, 0, 5, 9, 2, - 6,11,13, 8, 1, 4,10, 7, 9, 5, 0,15,14, 2, 3,12, -}, - -{ 13, 2, 8, 4, 6,15,11, 1,10, 9, 3,14, 5, 0,12, 7, - 1,15,13, 8,10, 3, 7, 4,12, 5, 6,11, 0,14, 9, 2, - 7,11, 4, 1, 9,12,14, 2, 0, 6,10,13,15, 3, 5, 8, - 2, 1,14, 7, 4,10, 8,13,15,12, 9, 0, 3, 5, 6,11, -}, -}; - -static int rots[] = { - 1,1,2,2,2,2,2,2,1,2,2,2,2,2,2,1, -}; - -static void transpose(struct block *data, struct ordering *t, int n) -{ - struct block x; - - x = *data; - - while (n-- > 0) { - data->b_data[n] = x.b_data[t->o_data[n] - 1]; - } -} - -static void rotate(struct block *key) -{ - register unsigned char *p = key->b_data; - register unsigned char *ep = &(key->b_data[55]); - int data0 = key->b_data[0], data28 = key->b_data[28]; - - while (p++ < ep) *(p-1) = *p; - key->b_data[27] = (char) data0; - key->b_data[55] = (char) data28; -} - -static struct ordering *EP = &etr; - -static void f(int i, struct block *key, struct block *a, struct block *x) -{ - struct block e, ikey, y; - int k; - register unsigned char *p, *q, *r; - - e = *a; - transpose(&e, EP, 48); - for (k = rots[i]; k; k--) rotate(key); - ikey = *key; - transpose(&ikey, &KeyTr2, 48); - p = &(y.b_data[48]); - q = &(e.b_data[48]); - r = &(ikey.b_data[48]); - while (p > y.b_data) { - *--p = *--q ^ *--r; - } - q = x->b_data; - for (k = 0; k < 8; k++) { - register int xb, r; - - r = *p++ << 5; - r += *p++ << 3; - r += *p++ << 2; - r += *p++ << 1; - r += *p++; - r += *p++ << 4; - - xb = s_boxes[k][r]; - - *q++ = (char) (xb >> 3) & 1; - *q++ = (char) (xb>>2) & 1; - *q++ = (char) (xb>>1) & 1; - *q++ = (char) (xb & 1); - } - transpose(x, &ptr, 32); -} - -void definekey(char *k) -{ - - key = *((struct block *) k); - transpose(&key, &KeyTr1, 56); -} - -void encrypt(char *blck, int edflag) -{ - register struct block *p = (struct block *) blck; - register int i; - - transpose(p, &InitialTr, 64); - for (i = 15; i>= 0; i--) { - int j = edflag ? i : 15 - i; - register int k; - struct block b, x; - - b = *p; - for (k = 31; k >= 0; k--) { - p->b_data[k] = b.b_data[k + 32]; - } - f(j, &key, p, &x); - for (k = 31; k >= 0; k--) { - p->b_data[k+32] = b.b_data[k] ^ x.b_data[k]; - } - } - transpose(p, &swap, 64); - transpose(p, &FinalTr, 64); -} - -char *crypt(char *pw, char *salt) -{ - - char pwb[66]; - static char result[16]; - register char *p = pwb; - struct ordering new_etr; - register int i; - - while (*pw && p < &pwb[64]) { - register int j = 7; - - while (j--) { - *p++ = (*pw >> j) & 01; - } - pw++; - *p++ = 0; - } - while (p < &pwb[64]) *p++ = 0; - - definekey(p = pwb); - - while (p < &pwb[66]) *p++ = 0; - - new_etr = etr; - EP = &new_etr; - for (i = 0; i < 2; i++) { - register char c = *salt++; - register int j; - - result[i] = c; - if ( c > 'Z') c -= 6 + 7 + '.'; /* c was a lower case letter */ - else if ( c > '9') c -= 7 + '.';/* c was upper case letter */ - else c -= '.'; /* c was digit, '.' or '/'. */ - /* now, 0 <= c <= 63 */ - for (j = 0; j < 6; j++) { - if ((c >> j) & 01) { - int t = 6*i + j; - int temp = new_etr.o_data[t]; - new_etr.o_data[t] = new_etr.o_data[t+24]; - new_etr.o_data[t+24] = (char) temp; - } - } - } - - if (result[1] == 0) result[1] = result[0]; - - for (i = 0; i < 25; i++) encrypt(pwb,0); - EP = &etr; - - p = pwb; - pw = result+2; - while (p < &pwb[66]) { - register int c = 0; - register int j = 6; - - while (j--) { - c <<= 1; - c |= *p++; - } - c += '.'; /* becomes >= '.' */ - if (c > '9') c += 7; /* not in [./0-9], becomes upper */ - if (c > 'Z') c += 6; /* not in [A-Z], becomes lower */ - *pw++ = (char) c; - } - *pw = 0; - return result; -} diff --git a/os2/dir.h b/os2/dir.h deleted file mode 100644 index 8ebfae9..0000000 --- a/os2/dir.h +++ /dev/null @@ -1,76 +0,0 @@ -/* - * @(#) dir.h 1.4 87/11/06 Public Domain. - * - * A public domain implementation of BSD directory routines for - * MS-DOS. Written by Michael Rendell ({uunet,utai}michael@garfield), - * August 1987 - * - * Enhanced and ported to OS/2 by Kai Uwe Rommel; added scandir() prototype - * December 1989, February 1990 - * Change of MAXPATHLEN for HPFS, October 1990 - */ - - -#define MAXNAMLEN 256 -#define MAXPATHLEN 256 - -#define A_RONLY 0x01 -#define A_HIDDEN 0x02 -#define A_SYSTEM 0x04 -#define A_LABEL 0x08 -#define A_DIR 0x10 -#define A_ARCHIVE 0x20 - - -struct direct -{ - ino_t d_ino; /* a bit of a farce */ - int d_reclen; /* more farce */ - int d_namlen; /* length of d_name */ - char d_name[MAXNAMLEN + 1]; /* null terminated */ - /* nonstandard fields */ - long d_size; /* size in bytes */ - unsigned d_mode; /* DOS or OS/2 file attributes */ - unsigned d_time; - unsigned d_date; -}; - -/* The fields d_size and d_mode are extensions by me (Kai Uwe Rommel). - * The find_first and find_next calls deliver this data without any extra cost. - * If this data is needed, these fields save a lot of extra calls to stat() - * (each stat() again performs a find_first call !). - */ - -struct _dircontents -{ - char *_d_entry; - long _d_size; - unsigned _d_mode, _d_time, _d_date; - struct _dircontents *_d_next; -}; - -typedef struct _dirdesc -{ - int dd_id; /* uniquely identify each open directory */ - long dd_loc; /* where we are in directory entry is this */ - struct _dircontents *dd_contents; /* pointer to contents of dir */ - struct _dircontents *dd_cp; /* pointer to current position */ -} -DIR; - - -extern int attributes; - -extern DIR *opendir(char *); -extern struct direct *readdir(DIR *); -extern void seekdir(DIR *, long); -extern long telldir(DIR *); -extern void closedir(DIR *); -#define rewinddir(dirp) seekdir(dirp, 0L) - -extern int scandir(char *, struct direct ***, - int (*)(struct direct *), - int (*)(struct direct *, struct direct *)); - -extern int getfmode(char *); -extern int setfmode(char *, unsigned); diff --git a/os2/director.c b/os2/director.c deleted file mode 100644 index 3966d3d..0000000 --- a/os2/director.c +++ /dev/null @@ -1,250 +0,0 @@ -/* - * @(#)dir.c 1.4 87/11/06 Public Domain. - * - * A public domain implementation of BSD directory routines for - * MS-DOS. Written by Michael Rendell ({uunet,utai}michael@garfield), - * August 1897 - * Ported to OS/2 by Kai Uwe Rommel - * December 1989, February 1990 - * Change for HPFS support, October 1990 - */ - -#include -#include -#include - -#include -#include -#include -#include -#include - -#define INCL_NOPM -#include - - -#ifndef PERLGLOB -int attributes = A_DIR | A_HIDDEN; - - -static char *getdirent(char *); -static void free_dircontents(struct _dircontents *); - -static HDIR hdir; -static USHORT count; -static FILEFINDBUF find; -static BOOL lower; - - -DIR *opendir(char *name) -{ - struct stat statb; - DIR *dirp; - char c; - char *s; - struct _dircontents *dp; - char nbuf[MAXPATHLEN + 1]; - - strcpy(nbuf, name); - - if ( ((c = nbuf[strlen(nbuf) - 1]) == '\\' || c == '/') && - (strlen(nbuf) > 1) ) - { - nbuf[strlen(nbuf) - 1] = 0; - - if ( nbuf[strlen(nbuf) - 1] == ':' ) - strcat(nbuf, "\\."); - } - else - if ( nbuf[strlen(nbuf) - 1] == ':' ) - strcat(nbuf, "."); - - if (stat(nbuf, &statb) < 0 || (statb.st_mode & S_IFMT) != S_IFDIR) - return NULL; - - if ( (dirp = malloc(sizeof(DIR))) == NULL ) - return NULL; - - if ( nbuf[strlen(nbuf) - 1] == '.' ) - strcpy(nbuf + strlen(nbuf) - 1, "*.*"); - else - if ( ((c = nbuf[strlen(nbuf) - 1]) == '\\' || c == '/') && - (strlen(nbuf) == 1) ) - strcat(nbuf, "*.*"); - else - strcat(nbuf, "\\*.*"); - - dirp -> dd_loc = 0; - dirp -> dd_contents = dirp -> dd_cp = NULL; - - if ((s = getdirent(nbuf)) == NULL) - return dirp; - - do - { - if (((dp = malloc(sizeof(struct _dircontents))) == NULL) || - ((dp -> _d_entry = malloc(strlen(s) + 1)) == NULL) ) - { - if (dp) - free(dp); - free_dircontents(dirp -> dd_contents); - - return NULL; - } - - if (dirp -> dd_contents) - dirp -> dd_cp = dirp -> dd_cp -> _d_next = dp; - else - dirp -> dd_contents = dirp -> dd_cp = dp; - - strcpy(dp -> _d_entry, s); - dp -> _d_next = NULL; - - dp -> _d_size = find.cbFile; - dp -> _d_mode = find.attrFile; - dp -> _d_time = *(unsigned *) &(find.ftimeLastWrite); - dp -> _d_date = *(unsigned *) &(find.fdateLastWrite); - } - while ((s = getdirent(NULL)) != NULL); - - dirp -> dd_cp = dirp -> dd_contents; - - return dirp; -} - - -void closedir(DIR * dirp) -{ - free_dircontents(dirp -> dd_contents); - free(dirp); -} - - -struct direct *readdir(DIR * dirp) -{ - static struct direct dp; - - if (dirp -> dd_cp == NULL) - return NULL; - - dp.d_namlen = dp.d_reclen = - strlen(strcpy(dp.d_name, dirp -> dd_cp -> _d_entry)); - - dp.d_ino = 0; - - dp.d_size = dirp -> dd_cp -> _d_size; - dp.d_mode = dirp -> dd_cp -> _d_mode; - dp.d_time = dirp -> dd_cp -> _d_time; - dp.d_date = dirp -> dd_cp -> _d_date; - - dirp -> dd_cp = dirp -> dd_cp -> _d_next; - dirp -> dd_loc++; - - return &dp; -} - - -void seekdir(DIR * dirp, long off) -{ - long i = off; - struct _dircontents *dp; - - if (off >= 0) - { - for (dp = dirp -> dd_contents; --i >= 0 && dp; dp = dp -> _d_next); - - dirp -> dd_loc = off - (i + 1); - dirp -> dd_cp = dp; - } -} - - -long telldir(DIR * dirp) -{ - return dirp -> dd_loc; -} - - -static void free_dircontents(struct _dircontents * dp) -{ - struct _dircontents *odp; - - while (dp) - { - if (dp -> _d_entry) - free(dp -> _d_entry); - - dp = (odp = dp) -> _d_next; - free(odp); - } -} - - -static -#endif -int IsFileSystemFAT(char *dir) -{ - USHORT nDrive; - ULONG lMap; - BYTE bData[64], bName[3]; - USHORT cbData; - - if ( _osmode == DOS_MODE ) - return TRUE; - else - { - /* We separate FAT and HPFS file systems here. - * Filenames read from a FAT system are converted to lower case - * while the case of filenames read from a HPFS (and other future - * file systems, like Unix-compatibles) is preserved. - */ - - if ( isalpha(dir[0]) && (dir[1] == ':') ) - nDrive = toupper(dir[0]) - '@'; - else - DosQCurDisk(&nDrive, &lMap); - - bName[0] = (char) (nDrive + '@'); - bName[1] = ':'; - bName[2] = 0; - - cbData = sizeof(bData); - - if ( !DosQFSAttach(bName, 0U, 1U, bData, &cbData, 0L) ) - return !strcmp(bData + (*(USHORT *) (bData + 2) + 7), "FAT"); - else - return FALSE; - - /* End of this ugly code */ - } -} - -#ifndef PERLGLOB -static char *getdirent(char *dir) -{ - int done; - - if (dir != NULL) - { /* get first entry */ - lower = IsFileSystemFAT(dir); - - hdir = HDIR_CREATE; - count = 1; - done = DosFindFirst(dir, &hdir, attributes, - &find, sizeof(find), &count, 0L); - } - else /* get next entry */ - done = DosFindNext(hdir, &find, sizeof(find), &count); - - if ( lower ) - strlwr(find.achName); - - if (done == 0) - return find.achName; - else - { - DosFindClose(hdir); - return NULL; - } -} -#endif diff --git a/os2/eg/alarm.pl b/os2/eg/alarm.pl deleted file mode 100644 index e244df4..0000000 --- a/os2/eg/alarm.pl +++ /dev/null @@ -1,17 +0,0 @@ -sub handler { - local($sig) = @_; - print "Caught a SIG$sig -- shutting down\n"; - exit(0); -} - -$SIG{'ALRM'} = 'handler'; -$SIG{'INT'} = 'handler'; # Ctrl-C pressed -$SIG{'BREAK'} = 'handler'; # Ctrl-Break pressed -$SIG{'TERM'} = 'handler'; # Killed by another process - -print "Starting execution ...\n"; -alarm(10); - -while ( <> ) { -} -print "Normal exit.\n"; diff --git a/os2/eg/os2.pl b/os2/eg/os2.pl deleted file mode 100644 index 411d327..0000000 --- a/os2/eg/os2.pl +++ /dev/null @@ -1,71 +0,0 @@ -extproc C:\binp\misc\perl.exe -S -#!perl - -# os2.pl: Demonstrates the OS/2 system calls and shows off some of the -# features in common with the UNIX version. - -do "syscalls.pl" || die "Cannot load syscalls.pl ($!)"; - -# OS/2 version number. - - $version = " "; syscall($OS2_GetVersion,$version); - ($minor, $major) = unpack("CC", $version); - print "You are using OS/2 version ", int($major/10), - ".", int($minor/10), "\n\n"; - -# Process ID. - print "This process ID is $$ and its parent's ID is ", - getppid(), "\n\n"; - -# Priority. - - printf "Current priority is %x\n", getpriority(0,0); - print "Changing priority by +5\n"; - print "Failed!\n" unless setpriority(0,0,+5); - printf "Priority is now %x\n\n", getpriority(0,0); - -# Beep. - print "Here is an A440.\n\n"; - syscall($OS2_Beep,440,50); - -# Pipes. Unlike MS-DOS, OS/2 supports true asynchronous pipes. - open(ROT13, '|perl -pe y/a-zA-Z/n-za-mN-ZA-M/') || die; - select(ROT13); $|=1; select(STDOUT); - print "Type two lines of stuff, and I'll ROT13 it while you wait.\n". - "If you type fast, you might be able to type both of your\n". - "lines before I get a chance to translate the first line.\n"; - $_ = ; print ROT13 $_; - $_ = ; print ROT13 $_; - close(ROT13); - print "Thanks.\n\n"; - -# Inspecting the disks. - print "Let's look at the disks you have installed...\n\n"; - - $x = "\0\0"; - syscall($OS2_Config, $x, 2); - print "You have ", unpack("S", $x), " floppy disks,\n"; - - $x = " "; - syscall($OS2_PhysicalDisk, 1, $x, 2, 0, 0); - ($numdisks) = unpack("S", $x); - - print "and $numdisks partitionable disks.\n\n"; - for ($i = 1; $i <= $numdisks; $i++) { - $disk = $i . ":"; - $handle = " "; - syscall($OS2_PhysicalDisk, 2, $handle, 2, $disk, 3); - ($numhandle) = unpack("S", $handle); - $zero = pack("C", 0); - $parmblock = " " x 16; - syscall($OS2_IOCtl, $parmblock, $zero, 0x63, 9, $numhandle); - ($x, $cylinders, $heads, $sect) = unpack("SSSS", $parmblock); - print "Hard drive #$i:\n"; - print " cylinders: $cylinders\n"; - print " heads: $heads\n"; - print " sect/trk: $sect\n"; - syscall($OS2_PhysicalDisk, 3, 0, 0, $handle, 2); - } - -# I won't bother with the other stuff. You get the idea. - diff --git a/os2/eg/syscalls.pl b/os2/eg/syscalls.pl deleted file mode 100644 index 2356f2e..0000000 --- a/os2/eg/syscalls.pl +++ /dev/null @@ -1,16 +0,0 @@ -# OS/2 syscall values - -$OS2_GetVersion = 0; -$OS2_Shutdown = 1; -$OS2_Beep = 2; -$OS2_PhysicalDisk = 3; -$OS2_Config = 4; -$OS2_IOCtl = 5; -$OS2_QCurDisk = 6; -$OS2_SelectDisk = 7; -$OS2_SetMaxFH = 8; -$OS2_Sleep = 9; -$OS2_StartSession = 10; -$OS2_StopSession = 11; -$OS2_SelectSession = 12; -1; diff --git a/os2/glob.c b/os2/glob.c deleted file mode 100644 index 75b0084..0000000 --- a/os2/glob.c +++ /dev/null @@ -1,21 +0,0 @@ -/* - * Globbing for OS/2. Relies on the expansion done by the library - * startup code. - */ - -#define PERLGLOB -#include "director.c" - -int main(int argc, char **argv) -{ - SHORT i; - USHORT r; - CHAR *f; - - for (i = 1; i < argc; i++) - { - f = IsFileSystemFAT(argv[i]) ? strlwr(argv[i]) : argv[i]; - DosWrite(1, f, strlen(f) + 1, &r); - } - return argc - 1; -} diff --git a/os2/makefile b/os2/makefile deleted file mode 100644 index 9d5fac4..0000000 --- a/os2/makefile +++ /dev/null @@ -1,125 +0,0 @@ -# -# Makefile for compiling Perl under OS/2 -# -# Needs a Unix compatible make. -# This makefile works for an initial compilation. It does not -# include all dependencies and thus is unsuitable for serious -# development work. Hey, I'm just inheriting what Diomidis gave me. -# -# Originally by Diomidis Spinellis, March 1990 -# Adjusted for OS/2 port by Raymond Chen, June 1990 -# - -# Source files -SRC = array.c cmd.c cons.c consarg.c doarg.c doio.c dolist.c dump.c \ -eval.c form.c hash.c perl.y perly.c regcomp.c regexec.c \ -stab.c str.c toke.c util.c os2.c popen.c director.c suffix.c mktemp.c - -# Object files -OBJ = perl.obj array.obj cmd.obj cons.obj consarg.obj doarg.obj doio.obj \ -dolist.obj dump.obj eval.obj form.obj hash.obj perly.obj regcomp.obj \ -regexec.obj stab.obj str.obj toke.obj util.obj os2.obj popen.obj \ -director.obj suffix.obj mktemp.obj - -# Files in the OS/2 distribution -DOSFILES=config.h director.c dir.h makefile os2.c popen.c suffix.c \ -mktemp.c readme.os2 - -# Yacc flags -YFLAGS=-d - -# Manual pages -MAN=perlman.1 perlman.2 perlman.3 perlman.4 - -CC=cl -# CBASE = flags everybody gets -# CPLAIN = flags for modules that give the compiler indigestion -# CFLAGS = flags for milder modules -# PERL = which version of perl to build -# -# For preliminary building: No optimization, DEBUGGING set, symbols included. -#CBASE=-AL -Zi -G2 -Gs -DDEBUGGING -#CPLAIN=$(CBASE) -Od -#CFLAGS=$(CBASE) -Od -#PERL=perlsym.exe - -# For the final build: Optimization on, symbols stripped. -CBASE=-AL -Zi -G2 -Gs -DDEBUGGING -CPLAIN=$(CBASE) -Olt -CFLAGS=$(CBASE) -Oeglt -PERL=perl.exe - -# Destination directory for executables -DESTDIR=\usr\bin - -# Deliverables -# -all: $(PERL) glob.exe - -perl.exe: $(OBJ) perl.arp - link @perl.arp,perl,nul,/stack:32767 /NOE; - exehdr /nologo /newfiles /pmtype:windowcompat perl.exe >nul - -perlsym.exe: $(OBJ) perl.arp - link @perl.arp,perlsym,nul,/stack:32767 /NOE /CODE; - exehdr /nologo /newfiles /pmtype:windowcompat perlsym.exe >nul - -perl.arp: - echo array+cmd+cons+consarg+doarg+doio+dolist+dump+ >perl.arp - echo eval+form+hash+perl+perly+regcomp+regexec+stab+suffix+ >>perl.arp - echo str+toke+util+os2+popen+director+\c600\lib\setargv >>perl.arp - -glob.exe: glob.c - $(CC) glob.c setargv.obj -link /NOE - exehdr /nologo /newfiles /pmtype:windowcompat glob.exe >nul - -array.obj: array.c - $(CC) $(CPLAIN) -c array.c -cmd.obj: cmd.c -cons.obj: cons.c perly.h -consarg.obj: consarg.c -# $(CC) $(CPLAIN) -c consarg.c -doarg.obj: doarg.c -doio.obj: doio.c -dolist.obj: dolist.c -dump.obj: dump.c -eval.obj: eval.c evalargs.xc - $(CC) /B2c2l /B3c3l $(CFLAGS) -c eval.c -form.obj: form.c -hash.obj: hash.c -perl.obj: perl.y -perly.obj: perly.c -regcomp.obj: regcomp.c -regexec.obj: regexec.c -stab.obj: stab.c - $(CC) $(CPLAIN) -c stab.c -str.obj: str.c -suffix.obj: suffix.c -toke.obj: toke.c - $(CC) /B3c3l $(CFLAGS) -c toke.c -util.obj: util.c -# $(CC) $(CPLAIN) -c util.c -perly.h: ytab.h - cp ytab.h perly.h -director.obj: director.c -popen.obj: popen.c -os2.obj: os2.c - -perl.1: $(MAN) - nroff -man $(MAN) >perl.1 - -install: all - exepack perl.exe $(DESTDIR)\perl.exe - exepack glob.exe $(DESTDIR)\glob.exe - -clean: - rm -f *.obj *.exe perl.1 perly.h perl.arp - -tags: - ctags *.c *.h *.xc - -dosperl: - mv $(DOSFILES) ../perl30.new - -doskit: - mv $(DOSFILES) ../os2 diff --git a/os2/mktemp.c b/os2/mktemp.c deleted file mode 100644 index a14bc63..0000000 --- a/os2/mktemp.c +++ /dev/null @@ -1 +0,0 @@ -(deprecated) diff --git a/os2/os2.c b/os2/os2.c deleted file mode 100644 index a0aa0ac..0000000 --- a/os2/os2.c +++ /dev/null @@ -1,298 +0,0 @@ -/* $RCSfile: os2.c,v $$Revision: 4.1 $$Date: 92/08/07 18:25:20 $ - * - * (C) Copyright 1989, 1990 Diomidis Spinellis. - * - * You may distribute under the terms of either the GNU General Public - * License or the Artistic License, as specified in the README file. - * - * $Log: os2.c,v $ - * Revision 4.1 92/08/07 18:25:20 lwall - * - * Revision 4.0.1.2 92/06/08 14:32:30 lwall - * patch20: new OS/2 support - * - * Revision 4.0.1.1 91/06/07 11:23:06 lwall - * patch4: new copyright notice - * - * Revision 4.0 91/03/20 01:36:21 lwall - * 4.0 baseline. - * - * Revision 3.0.1.2 90/11/10 01:42:38 lwall - * patch38: more msdos/os2 upgrades - * - * Revision 3.0.1.1 90/10/15 17:49:55 lwall - * patch29: Initial revision - * - * Revision 3.0.1.1 90/03/27 16:10:41 lwall - * patch16: MSDOS support - * - * Revision 1.1 90/03/18 20:32:01 dds - * Initial revision - * - */ - -#define INCL_DOS -#define INCL_NOPM -#include - -/* - * Various Unix compatibility functions for OS/2 - */ - -#include -#include -#include - -#include "EXTERN.h" -#include "perl.h" - - -/* dummies */ - -int ioctl(int handle, unsigned int function, char *data) -{ return -1; } - -int userinit() -{ return -1; } - -int syscall() -{ return -1; } - - -/* extended chdir() */ - -int chdir(char *path) -{ - if ( path[0] != 0 && path[1] == ':' ) - if ( DosSelectDisk(toupper(path[0]) - '@') ) - return -1; - - return DosChDir(path, 0L); -} - - -/* priorities */ - -int setpriority(int class, int pid, int val) -{ - int flag = 0; - - if ( pid < 0 ) - { - flag++; - pid = -pid; - } - - return DosSetPrty(flag ? PRTYS_PROCESSTREE : PRTYS_PROCESS, class, val, pid); -} - -int getpriority(int which /* ignored */, int pid) -{ - USHORT val; - - if ( DosGetPrty(PRTYS_PROCESS, &val, pid) ) - return -1; - else - return val; -} - - -/* get parent process id */ - -int getppid(void) -{ - PIDINFO pi; - - DosGetPID(&pi); - return pi.pidParent; -} - - -/* wait for specific pid */ -int wait4pid(int pid, int *status, int flags) -{ - RESULTCODES res; - int endpid, rc; - if ( DosCwait(DCWA_PROCESS, flags ? DCWW_NOWAIT : DCWW_WAIT, - &res, &endpid, pid) ) - return -1; - *status = res.codeResult; - return endpid; -} -/* kill */ - -int kill(int pid, int sig) -{ - int flag = 0; - - if ( pid < 0 ) - { - flag++; - pid = -pid; - } - - switch ( sig & 3 ) - { - - case 0: - DosKillProcess(flag ? DKP_PROCESSTREE : DKP_PROCESS, pid); - break; - - case 1: /* FLAG A */ - DosFlagProcess(pid, flag ? FLGP_SUBTREE : FLGP_PID, PFLG_A, 0); - break; - - case 2: /* FLAG B */ - DosFlagProcess(pid, flag ? FLGP_SUBTREE : FLGP_PID, PFLG_B, 0); - break; - - case 3: /* FLAG C */ - DosFlagProcess(pid, flag ? FLGP_SUBTREE : FLGP_PID, PFLG_C, 0); - break; - - } -} - - -/* Sleep function. */ -void -sleep(unsigned len) -{ - DosSleep(len * 1000L); -} - -/* Just pretend that everyone is a superuser */ - -int setuid() -{ return 0; } - -int setgid() -{ return 0; } - -int getuid(void) -{ return 0; } - -int geteuid(void) -{ return 0; } - -int getgid(void) -{ return 0; } - -int getegid(void) -{ return 0; } - -/* - * The following code is based on the do_exec and do_aexec functions - * in file doio.c - */ -int -do_aspawn(really,arglast) -STR *really; -int *arglast; -{ - register STR **st = stack->ary_array; - register int sp = arglast[1]; - register int items = arglast[2] - sp; - register char **a; - char **argv; - char *tmps; - int status; - - if (items) { - New(1101,argv, items+1, char*); - a = argv; - for (st += ++sp; items > 0; items--,st++) { - if (*st) - *a++ = str_get(*st); - else - *a++ = ""; - } - *a = Nullch; - if (really && *(tmps = str_get(really))) - status = spawnvp(P_WAIT,tmps,argv); - else - status = spawnvp(P_WAIT,argv[0],argv); - Safefree(argv); - } - return status; -} - -char *getenv(char *name); - -int -do_spawn(cmd) -char *cmd; -{ - register char **a; - register char *s; - char **argv; - char flags[10]; - int status; - char *shell, *cmd2; - - /* save an extra exec if possible */ - if ((shell = getenv("COMSPEC")) == 0) - shell = "C:\\OS2\\CMD.EXE"; - - /* see if there are shell metacharacters in it */ - if (strchr(cmd, '>') || strchr(cmd, '<') || strchr(cmd, '|') - || strchr(cmd, '&') || strchr(cmd, '^')) - doshell: - return spawnl(P_WAIT,shell,shell,"/C",cmd,(char*)0); - - New(1102,argv, strlen(cmd) / 2 + 2, char*); - - New(1103,cmd2, strlen(cmd) + 1, char); - strcpy(cmd2, cmd); - a = argv; - for (s = cmd2; *s;) { - while (*s && isspace(*s)) s++; - if (*s) - *(a++) = s; - while (*s && !isspace(*s)) s++; - if (*s) - *s++ = '\0'; - } - *a = Nullch; - if (argv[0]) - if ((status = spawnvp(P_WAIT,argv[0],argv)) == -1) { - Safefree(argv); - Safefree(cmd2); - goto doshell; - } - Safefree(cmd2); - Safefree(argv); - return status; -} - -usage(char *myname) -{ -#ifdef MSDOS - printf("\nUsage: %s [-acdnpPsSvw] [-0[octal]] [-Dnumber] [-i[extension]] [-Idirectory]" -#else - printf("\nUsage: %s [-acdnpPsSuUvw] [-Dnumber] [-i[extension]] [-Idirectory]" -#endif - "\n [-e \"command\"] [-x[directory]] [filename] [arguments]\n", myname); - - printf("\n -a autosplit mode with -n or -p" - "\n -c syntaxcheck only" - "\n -d run scripts under debugger" - "\n -n assume 'while (<>) { ...script... }' loop arround your script" - "\n -p assume loop like -n but print line also like sed" - "\n -P run script through C preprocessor befor compilation" - "\n -s enable some switch parsing for switches after script name" - "\n -S look for the script using PATH environment variable"); -#ifndef MSDOS - printf("\n -u dump core after compiling the script" - "\n -U allow unsafe operations"); -#endif - printf("\n -v print version number and patchlevel of perl" - "\n -w turn warnings on for compilation of your script\n" - "\n -0[octal] specify record separator (0, if no argument)" - "\n -Dnumber set debugging flags (argument is a bit mask)" - "\n -i[extension] edit <> files in place (make backup if extension supplied)" - "\n -Idirectory specify include directory in conjunction with -P" - "\n -e command one line of script, multiple -e options are allowed" - "\n [filename] can be ommitted, when -e is used" - "\n -x[directory] strip off text before #!perl line and perhaps cd to directory\n"); -} diff --git a/os2/perl.bad b/os2/perl.bad deleted file mode 100644 index 8dd016c..0000000 --- a/os2/perl.bad +++ /dev/null @@ -1,8 +0,0 @@ -DOSMAKEPIPE -DOSCWAIT -DOSKILLPROCESS -DOSFLAGPROCESS -DOSSETPRTY -DOSGETPRTY -DOSQFSATTACH -DOSCREATETHREAD diff --git a/os2/perl.cs b/os2/perl.cs deleted file mode 100644 index 000d2c0..0000000 --- a/os2/perl.cs +++ /dev/null @@ -1,21 +0,0 @@ -(-W1 -Od -Olt -DDEBUGGING -Gt2048 -array.c cmd.c cons.c consarg.c doarg.c doio.c dolist.c dump.c form.c -hash.c perl.c regcomp.c regexec.c stab.c str.c util.c -) -(-W1 -Od -Olt -DDEBUGGING -Gt2048 (-d perly.y)) -(-W1 -Od -Olt -B2C2L -B3C3L -DDEBUGGING eval.c toke.c) -(-W1 -Od -Olt -I. -Ios2 -os2\os2.c os2\popen.c os2\suffix.c -os2\director.c os2\alarm.c os2\crypt.c -) - -; link with this library if you have GNU gdbm for OS/2 -; remember to enable the GDBM symbol in config.h before compiling -llibgdbm.lib - -setargv.obj -os2\perl.def -os2\perl.bad -perl.exe - --AL -LB -S0x8000 diff --git a/os2/perl.def b/os2/perl.def deleted file mode 100644 index 7c0fca0..0000000 --- a/os2/perl.def +++ /dev/null @@ -1,2 +0,0 @@ -NAME WINDOWCOMPAT NEWFILES -DESCRIPTION 'PERL 4.0 - for MS-DOS and OS/2' diff --git a/os2/perldb.dif b/os2/perldb.dif deleted file mode 100644 index e69de29..0000000 diff --git a/os2/perlglob.bad b/os2/perlglob.bad deleted file mode 100644 index a14bc63..0000000 --- a/os2/perlglob.bad +++ /dev/null @@ -1 +0,0 @@ -(deprecated) diff --git a/os2/perlglob.cs b/os2/perlglob.cs deleted file mode 100644 index b5fc1c9..0000000 --- a/os2/perlglob.cs +++ /dev/null @@ -1,9 +0,0 @@ -os2\glob.c - -setargv.obj - -os2\perl.def -os2\perl.bad -perlglob.exe - --AS -LB -S0x1000 diff --git a/os2/perlglob.def b/os2/perlglob.def deleted file mode 100644 index a14bc63..0000000 --- a/os2/perlglob.def +++ /dev/null @@ -1 +0,0 @@ -(deprecated) diff --git a/os2/perlsh.cmd b/os2/perlsh.cmd deleted file mode 100644 index c583af7..0000000 --- a/os2/perlsh.cmd +++ /dev/null @@ -1,19 +0,0 @@ -extproc perl -x -#!perl - -# Poor man's perl shell. - -# Simply type two carriage returns every time you want to evaluate. -# Note that it must be a complete perl statement--don't type double -# carriage return in the middle of a loop. - -print "Perl shell\n> "; - -$/ = ''; # set paragraph mode -$SHlinesep = "\n"; - -while ($SHcmd = <>) { - $/ = $SHlinesep; - eval $SHcmd; print $@ || "\n> "; - $SHlinesep = $/; $/ = ''; -} diff --git a/os2/popen.c b/os2/popen.c deleted file mode 100644 index b9522b5..0000000 --- a/os2/popen.c +++ /dev/null @@ -1,241 +0,0 @@ -/* added real/protect mode branch at runtime and real mode version - * names changed for perl - * Kai Uwe Rommel - */ - -/* -Several people in the past have asked about having Unix-like pipe -calls in OS/2. The following source file, adapted from 4.3 BSD Unix, -uses a #define to give you a pipe(2) call, and contains function -definitions for popen(3) and pclose(3). Anyone with problems should -send mail to me; they seem to work fine. - -Mark Towfigh -Racal Interlan, Inc. -----------------------------------cut-here------------------------------------ -*/ - -/* - * The following code segment is derived from BSD 4.3 Unix. See - * copyright below. Any bugs, questions, improvements, or problems - * should be sent to Mark Towfigh (towfiq@interlan.interlan.com). - * - * Racal InterLan Inc. - */ - -/* - * Copyright (c) 1980 Regents of the University of California. - * All rights reserved. The Berkeley software License Agreement - * specifies the terms and conditions for redistribution. - */ - -#include -#include -#include -#include -#include -#include - -#define INCL_NOPM -#define INCL_DOS -#include - -static FILE *dos_popen(const char *cmd, const char *flags); -static int dos_pclose(FILE *pipe); - -/* - * emulate Unix pipe(2) call - */ - -#define tst(a,b) (*mode == 'r'? (b) : (a)) -#define READH 0 -#define WRITEH 1 - -static int popen_pid[20]; - -FILE *mypopen(char *cmd, char *mode) -{ - int p[2]; - register myside, hisside, save_stream; - char *shell = getenv("COMPSPEC"); - - if ( shell == NULL ) - shell = "C:\\OS2\\CMD.EXE"; - - if ( _osmode == DOS_MODE ) - return dos_popen(cmd, mode); - - if ( _pipe(p, 4096, 0) ) - return NULL; - - myside = tst(p[WRITEH], p[READH]); - hisside = tst(p[READH], p[WRITEH]); - - /* set up file descriptors for remote function */ - save_stream = dup(tst(0, 1)); /* don't lose stdin/out! */ - if (dup2(hisside, tst(0, 1)) < 0) - { - perror("dup2"); - return NULL; - } - close(hisside); - - /* - * make sure that we can close our side of the pipe, by - * preventing it from being inherited! - */ - - /* set no-inheritance flag */ - DosSetFHandState(myside, OPEN_FLAGS_NOINHERIT); - - /* execute the command: it will inherit our other file descriptors */ - popen_pid[myside] = spawnlp(P_NOWAIT, shell, shell, "/C", cmd, NULL); - - /* now restore our previous file descriptors */ - if (dup2(save_stream, tst(0, 1)) < 0) /* retrieve stdin/out */ - { - perror("dup2"); - return NULL; - } - close(save_stream); - - return fdopen(myside, mode); /* return a FILE pointer */ -} - -int mypclose(FILE *ptr) -{ - register f; - int status; - - if ( _osmode == DOS_MODE ) - return dos_pclose(ptr); - - f = fileno(ptr); - fclose(ptr); - - /* wait for process to terminate */ - cwait(&status, popen_pid[f], WAIT_GRANDCHILD); - - return status; -} - - -int pipe(int *filedes) -{ - int res; - - if ( res = _pipe(filedes, 4096, 0) ) - return res; - - DosSetFHandState(filedes[0], OPEN_FLAGS_NOINHERIT); - DosSetFHandState(filedes[1], OPEN_FLAGS_NOINHERIT); - return 0; -} - - -/* this is the MS-DOS version */ - -typedef enum { unopened = 0, reading, writing } pipemode; - -static struct -{ - char *name; - char *command; - pipemode pmode; -} -pipes[_NFILE]; - -static FILE *dos_popen(const char *command, const char *mode) -{ - FILE *current; - char name[128]; - char *tmp = getenv("TMP"); - int cur; - pipemode curmode; - - /* - ** decide on mode. - */ - if(strchr(mode, 'r') != NULL) - curmode = reading; - else if(strchr(mode, 'w') != NULL) - curmode = writing; - else - return NULL; - - /* - ** get a name to use. - */ - strcpy(name, tmp ? tmp : "\\"); - if ( name[strlen(name) - 1] != '\\' ) - strcat(name, "\\"); - strcat(name, "piXXXXXX"); - mktemp(name); - - /* - ** If we're reading, just call system to get a file filled with - ** output. - */ - if(curmode == reading) - { - char cmd[256]; - sprintf(cmd,"%s > %s", command, name); - system(cmd); - - if((current = fopen(name, mode)) == NULL) - return NULL; - } - else - { - if((current = fopen(name, mode)) == NULL) - return NULL; - } - - cur = fileno(current); - pipes[cur].name = strdup(name); - pipes[cur].command = strdup(command); - pipes[cur].pmode = curmode; - - return current; -} - -static int dos_pclose(FILE * current) -{ - int cur = fileno(current), rval; - char command[256]; - - /* - ** check for an open file. - */ - if(pipes[cur].pmode == unopened) - return -1; - - if(pipes[cur].pmode == reading) - { - /* - ** input pipes are just files we're done with. - */ - rval = fclose(current); - unlink(pipes[cur].name); - } - else - { - /* - ** output pipes are temporary files we have - ** to cram down the throats of programs. - */ - fclose(current); - sprintf(command,"%s < %s", pipes[cur].command, pipes[cur].name); - rval = system(command); - unlink(pipes[cur].name); - } - - /* - ** clean up current pipe. - */ - free(pipes[cur].name); - free(pipes[cur].command); - pipes[cur].pmode = unopened; - - return rval; -} diff --git a/os2/s2p.cmd b/os2/s2p.cmd deleted file mode 100755 index d0a1246..0000000 --- a/os2/s2p.cmd +++ /dev/null @@ -1,678 +0,0 @@ -extproc perl -Sx -#!perl - -$bin = 'c:/bin'; - -# $RCSfile: s2p.cmd,v $$Revision: 4.1 $$Date: 92/08/07 18:25:37 $ -# -# $Log: s2p.cmd,v $ -# Revision 4.1 92/08/07 18:25:37 lwall -# -# Revision 4.0 91/03/20 01:37:09 lwall -# 4.0 baseline. -# -# Revision 3.0.1.6 90/10/20 02:21:43 lwall -# patch37: changed some ". config.sh" to ". ./config.sh" -# -# Revision 3.0.1.5 90/10/16 11:32:40 lwall -# patch29: s2p modernized -# -# Revision 3.0.1.4 90/08/09 05:50:43 lwall -# patch19: s2p didn't translate \n right -# -# Revision 3.0.1.3 90/03/01 10:31:21 lwall -# patch9: s2p didn't handle \< and \> -# -# Revision 3.0.1.2 89/11/17 15:51:27 lwall -# patch5: in s2p, line labels without a subsequent statement were done wrong -# patch5: s2p left residue in /tmp -# -# Revision 3.0.1.1 89/11/11 05:08:25 lwall -# patch2: in s2p, + within patterns needed backslashing -# patch2: s2p was printing out some debugging info to the output file -# -# Revision 3.0 89/10/18 15:35:02 lwall -# 3.0 baseline -# -# Revision 2.0.1.1 88/07/11 23:26:23 root -# patch2: s2p didn't put a proper prologue on output script -# -# Revision 2.0 88/06/05 00:15:55 root -# Baseline version 2.0. -# -# - -$indent = 4; -$shiftwidth = 4; -$l = '{'; $r = '}'; - -while ($ARGV[0] =~ /^-/) { - $_ = shift; - last if /^--/; - if (/^-D/) { - $debug++; - open(BODY,'>-'); - next; - } - if (/^-n/) { - $assumen++; - next; - } - if (/^-p/) { - $assumep++; - next; - } - die "I don't recognize this switch: $_\n"; -} - -unless ($debug) { - open(BODY,">sperl$$") || - &Die("Can't open temp file: $!\n"); -} - -if (!$assumen && !$assumep) { - print BODY <<'EOT'; -while ($ARGV[0] =~ /^-/) { - $_ = shift; - last if /^--/; - if (/^-n/) { - $nflag++; - next; - } - die "I don't recognize this switch: $_\\n"; -} - -EOT -} - -print BODY <<'EOT'; - -#ifdef PRINTIT -#ifdef ASSUMEP -$printit++; -#else -$printit++ unless $nflag; -#endif -#endif -LINE: while (<>) { -EOT - -LINE: while (<>) { - - # Wipe out surrounding whitespace. - - s/[ \t]*(.*)\n$/$1/; - - # Perhaps it's a label/comment. - - if (/^:/) { - s/^:[ \t]*//; - $label = &make_label($_); - if ($. == 1) { - $toplabel = $label; - } - $_ = "$label:"; - if ($lastlinewaslabel++) { - $indent += 4; - print BODY &tab, ";\n"; - $indent -= 4; - } - if ($indent >= 2) { - $indent -= 2; - $indmod = 2; - } - next; - } else { - $lastlinewaslabel = ''; - } - - # Look for one or two address clauses - - $addr1 = ''; - $addr2 = ''; - if (s/^([0-9]+)//) { - $addr1 = "$1"; - } - elsif (s/^\$//) { - $addr1 = 'eof()'; - } - elsif (s|^/||) { - $addr1 = &fetchpat('/'); - } - if (s/^,//) { - if (s/^([0-9]+)//) { - $addr2 = "$1"; - } elsif (s/^\$//) { - $addr2 = "eof()"; - } elsif (s|^/||) { - $addr2 = &fetchpat('/'); - } else { - &Die("Invalid second address at line $.\n"); - } - $addr1 .= " .. $addr2"; - } - - # Now we check for metacommands {, }, and ! and worry - # about indentation. - - s/^[ \t]+//; - # a { to keep vi happy - if ($_ eq '}') { - $indent -= 4; - next; - } - if (s/^!//) { - $if = 'unless'; - $else = "$r else $l\n"; - } else { - $if = 'if'; - $else = ''; - } - if (s/^{//) { # a } to keep vi happy - $indmod = 4; - $redo = $_; - $_ = ''; - $rmaybe = ''; - } else { - $rmaybe = "\n$r"; - if ($addr2 || $addr1) { - $space = ' ' x $shiftwidth; - } else { - $space = ''; - } - $_ = &transmogrify(); - } - - # See if we can optimize to modifier form. - - if ($addr1) { - if ($_ !~ /[\n{}]/ && $rmaybe && !$change && - $_ !~ / if / && $_ !~ / unless /) { - s/;$/ $if $addr1;/; - $_ = substr($_,$shiftwidth,1000); - } else { - $_ = "$if ($addr1) $l\n$change$_$rmaybe"; - } - $change = ''; - next LINE; - } -} continue { - @lines = split(/\n/,$_); - for (@lines) { - unless (s/^ *<<--//) { - print BODY &tab; - } - print BODY $_, "\n"; - } - $indent += $indmod; - $indmod = 0; - if ($redo) { - $_ = $redo; - $redo = ''; - redo LINE; - } -} -if ($lastlinewaslabel++) { - $indent += 4; - print BODY &tab, ";\n"; - $indent -= 4; -} - -print BODY "}\n"; -if ($appendseen || $tseen || !$assumen) { - $printit++ if $dseen || (!$assumen && !$assumep); - print BODY <<'EOT'; - -continue { -#ifdef PRINTIT -#ifdef DSEEN -#ifdef ASSUMEP - print if $printit++; -#else - if ($printit) - { print; } - else - { $printit++ unless $nflag; } -#endif -#else - print if $printit; -#endif -#else - print; -#endif -#ifdef TSEEN - $tflag = ''; -#endif -#ifdef APPENDSEEN - if ($atext) { print $atext; $atext = ''; } -#endif -} -EOT -} - -close BODY; - -unless ($debug) { - open(HEAD,">sperl2$$.c") - || &Die("Can't open temp file 2: $!\n"); - print HEAD "#define PRINTIT\n" if ($printit); - print HEAD "#define APPENDSEEN\n" if ($appendseen); - print HEAD "#define TSEEN\n" if ($tseen); - print HEAD "#define DSEEN\n" if ($dseen); - print HEAD "#define ASSUMEN\n" if ($assumen); - print HEAD "#define ASSUMEP\n" if ($assumep); - if ($opens) {print HEAD "$opens\n";} - open(BODY,"sperl$$") - || &Die("Can't reopen temp file: $!\n"); - while () { - print HEAD $_; - } - close HEAD; - - print <<"EOT"; -#!$bin/perl -eval 'exec $bin/perl -S \$0 \$*' - if \$running_under_some_shell; - -EOT - open(BODY,"cc -E sperl2$$.c |") || - &Die("Can't reopen temp file: $!\n"); - while () { - /^# [0-9]/ && next; - /^[ \t]*$/ && next; - s/^<><>//; - print; - } -} - -&Cleanup; -exit; - -sub Cleanup { - unlink "sperl$$", "sperl2$$", "sperl2$$.c"; -} -sub Die { - &Cleanup; - die $_[0]; -} -sub tab { - "\t" x ($indent / 8) . ' ' x ($indent % 8); -} -sub make_filehandle { - local($_) = $_[0]; - local($fname) = $_; - s/[^a-zA-Z]/_/g; - s/^_*//; - substr($_,0,1) =~ y/a-z/A-Z/ if /^[a-z]/; - if (!$seen{$_}) { - $opens .= <<"EOT"; -open($_,'>$fname') || die "Can't create $fname"; -EOT - } - $seen{$_} = $_; -} - -sub make_label { - local($label) = @_; - $label =~ s/[^a-zA-Z0-9]/_/g; - if ($label =~ /^[0-9_]/) { $label = 'L' . $label; } - $label = substr($label,0,8); - - # Could be a reserved word, so capitalize it. - substr($label,0,1) =~ y/a-z/A-Z/ - if $label =~ /^[a-z]/; - - $label; -} - -sub transmogrify { - { # case - if (/^d/) { - $dseen++; - chop($_ = <<'EOT'); -<<--#ifdef PRINTIT -$printit = ''; -<<--#endif -next LINE; -EOT - next; - } - - if (/^n/) { - chop($_ = <<'EOT'); -<<--#ifdef PRINTIT -<<--#ifdef DSEEN -<<--#ifdef ASSUMEP -print if $printit++; -<<--#else -if ($printit) - { print; } -else - { $printit++ unless $nflag; } -<<--#endif -<<--#else -print if $printit; -<<--#endif -<<--#else -print; -<<--#endif -<<--#ifdef APPENDSEEN -if ($atext) {print $atext; $atext = '';} -<<--#endif -$_ = <>; -<<--#ifdef TSEEN -$tflag = ''; -<<--#endif -EOT - next; - } - - if (/^a/) { - $appendseen++; - $command = $space . '$atext .=' . "\n<<--'"; - $lastline = 0; - while (<>) { - s/^[ \t]*//; - s/^[\\]//; - unless (s|\\$||) { $lastline = 1;} - s/'/\\'/g; - s/^([ \t]*\n)/<><>$1/; - $command .= $_; - $command .= '<<--'; - last if $lastline; - } - $_ = $command . "';"; - last; - } - - if (/^[ic]/) { - if (/^c/) { $change = 1; } - $addr1 = '$iter = (' . $addr1 . ')'; - $command = $space . 'if ($iter == 1) { print' - . "\n<<--'"; - $lastline = 0; - while (<>) { - s/^[ \t]*//; - s/^[\\]//; - unless (s/\\$//) { $lastline = 1;} - s/'/\\'/g; - s/^([ \t]*\n)/<><>$1/; - $command .= $_; - $command .= '<<--'; - last if $lastline; - } - $_ = $command . "';}"; - if ($change) { - $dseen++; - $change = "$_\n"; - chop($_ = <<"EOT"); -<<--#ifdef PRINTIT -$space\$printit = ''; -<<--#endif -${space}next LINE; -EOT - } - last; - } - - if (/^s/) { - $delim = substr($_,1,1); - $len = length($_); - $repl = $end = 0; - $inbracket = 0; - for ($i = 2; $i < $len; $i++) { - $c = substr($_,$i,1); - if ($c eq $delim) { - if ($inbracket) { - substr($_, $i, 0) = '\\'; - $i++; - $len++; - } - else { - if ($repl) { - $end = $i; - last; - } else { - $repl = $i; - } - } - } - elsif ($c eq '\\') { - $i++; - if ($i >= $len) { - $_ .= 'n'; - $_ .= <>; - $len = length($_); - $_ = substr($_,0,--$len); - } - elsif (substr($_,$i,1) =~ /^[n]$/) { - ; - } - elsif (!$repl && - substr($_,$i,1) =~ /^[(){}\w]$/) { - $i--; - $len--; - substr($_, $i, 1) = ''; - } - elsif (!$repl && - substr($_,$i,1) =~ /^[<>]$/) { - substr($_,$i,1) = 'b'; - } - } - elsif ($c eq '[' && !$repl) { - $i++ if substr($_,$i,1) eq '^'; - $i++ if substr($_,$i,1) eq ']'; - $inbracket = 1; - } - elsif ($c eq ']') { - $inbracket = 0; - } - elsif (!$repl && index("()+",$c) >= 0) { - substr($_, $i, 0) = '\\'; - $i++; - $len++; - } - } - &Die("Malformed substitution at line $.\n") - unless $end; - $pat = substr($_, 0, $repl + 1); - $repl = substr($_, $repl+1, $end-$repl-1); - $end = substr($_, $end + 1, 1000); - $dol = '$'; - $repl =~ s/\$/\\$/; - $repl =~ s'&'$&'g; - $repl =~ s/[\\]([0-9])/$dol$1/g; - $subst = "$pat$repl$delim"; - $cmd = ''; - while ($end) { - if ($end =~ s/^g//) { - $subst .= 'g'; - next; - } - if ($end =~ s/^p//) { - $cmd .= ' && (print)'; - next; - } - if ($end =~ s/^w[ \t]*//) { - $fh = &make_filehandle($end); - $cmd .= " && (print $fh \$_)"; - $end = ''; - next; - } - &Die("Unrecognized substitution command". - "($end) at line $.\n"); - } - chop ($_ = <<"EOT"); -<<--#ifdef TSEEN -$subst && \$tflag++$cmd; -<<--#else -$subst$cmd; -<<--#endif -EOT - next; - } - - if (/^p/) { - $_ = 'print;'; - next; - } - - if (/^w/) { - s/^w[ \t]*//; - $fh = &make_filehandle($_); - $_ = "print $fh \$_;"; - next; - } - - if (/^r/) { - $appendseen++; - s/^r[ \t]*//; - $file = $_; - $_ = "\$atext .= `cat $file 2>/dev/null`;"; - next; - } - - if (/^P/) { - $_ = 'print $1 if /(^.*\n)/;'; - next; - } - - if (/^D/) { - chop($_ = <<'EOT'); -s/^.*\n//; -redo LINE if $_; -next LINE; -EOT - next; - } - - if (/^N/) { - chop($_ = <<'EOT'); -$_ .= <>; -<<--#ifdef TSEEN -$tflag = ''; -<<--#endif -EOT - next; - } - - if (/^h/) { - $_ = '$hold = $_;'; - next; - } - - if (/^H/) { - $_ = '$hold .= $_ ? $_ : "\n";'; - next; - } - - if (/^g/) { - $_ = '$_ = $hold;'; - next; - } - - if (/^G/) { - $_ = '$_ .= $hold ? $hold : "\n";'; - next; - } - - if (/^x/) { - $_ = '($_, $hold) = ($hold, $_);'; - next; - } - - if (/^b$/) { - $_ = 'next LINE;'; - next; - } - - if (/^b/) { - s/^b[ \t]*//; - $lab = &make_label($_); - if ($lab eq $toplabel) { - $_ = 'redo LINE;'; - } else { - $_ = "goto $lab;"; - } - next; - } - - if (/^t$/) { - $_ = 'next LINE if $tflag;'; - $tseen++; - next; - } - - if (/^t/) { - s/^t[ \t]*//; - $lab = &make_label($_); - $_ = q/if ($tflag) {$tflag = ''; /; - if ($lab eq $toplabel) { - $_ .= 'redo LINE;}'; - } else { - $_ .= "goto $lab;}"; - } - $tseen++; - next; - } - - if (/^=/) { - $_ = 'print "$.\n";'; - next; - } - - if (/^q/) { - chop($_ = <<'EOT'); -close(ARGV); -@ARGV = (); -next LINE; -EOT - next; - } - } continue { - if ($space) { - s/^/$space/; - s/(\n)(.)/$1$space$2/g; - } - last; - } - $_; -} - -sub fetchpat { - local($outer) = @_; - local($addr) = $outer; - local($inbracket); - local($prefix,$delim,$ch); - - # Process pattern one potential delimiter at a time. - - DELIM: while (s#^([^\]+(|)[\\/]*)([]+(|)[\\/])##) { - $prefix = $1; - $delim = $2; - if ($delim eq '\\') { - s/(.)//; - $ch = $1; - $delim = '' if $ch =~ /^[(){}A-Za-mo-z]$/; - $ch = 'b' if $ch =~ /^[<>]$/; - $delim .= $ch; - } - elsif ($delim eq '[') { - $inbracket = 1; - s/^\^// && ($delim .= '^'); - s/^]// && ($delim .= ']'); - } - elsif ($delim eq ']') { - $inbracket = 0; - } - elsif ($inbracket || $delim ne $outer) { - $delim = '\\' . $delim; - } - $addr .= $prefix; - $addr .= $delim; - if ($delim eq $outer && !$inbracket) { - last DELIM; - } - } - $addr; -} diff --git a/os2/selfrun.bat b/os2/selfrun.bat deleted file mode 100755 index 9ec8a29..0000000 --- a/os2/selfrun.bat +++ /dev/null @@ -1,12 +0,0 @@ -@echo off -perl -x %0.bat -goto exit -#!perl - -printf " -This is a self-running perl script for DOS. - -" - -__END__ -:exit diff --git a/os2/selfrun.cmd b/os2/selfrun.cmd deleted file mode 100644 index 471a959..0000000 --- a/os2/selfrun.cmd +++ /dev/null @@ -1,7 +0,0 @@ -extproc perl -x -#!perl - -printf " -This is a self-running perl script using the -extproc feature of the OS/2 command processor. -" diff --git a/os2/suffix.c b/os2/suffix.c deleted file mode 100644 index d766da3..0000000 --- a/os2/suffix.c +++ /dev/null @@ -1,147 +0,0 @@ -/* - * Suffix appending for in-place editing under MS-DOS and OS/2. - * - * Here are the rules: - * - * Style 0: Append the suffix exactly as standard perl would do it. - * If the filesystem groks it, use it. (HPFS will always - * grok it. FAT will rarely accept it.) - * - * Style 1: The suffix begins with a '.'. The extension is replaced. - * If the name matches the original name, use the fallback method. - * - * Style 2: The suffix is a single character, not a '.'. Try to add the - * suffix to the following places, using the first one that works. - * [1] Append to extension. - * [2] Append to filename, - * [3] Replace end of extension, - * [4] Replace end of filename. - * If the name matches the original name, use the fallback method. - * - * Style 3: Any other case: Ignore the suffix completely and use the - * fallback method. - * - * Fallback method: Change the extension to ".$$$". If that matches the - * original name, then change the extension to ".~~~". - * - * If filename is more than 1000 characters long, we die a horrible - * death. Sorry. - * - * The filename restriction is a cheat so that we can use buf[] to store - * assorted temporary goo. - * - * Examples, assuming style 0 failed. - * - * suffix = ".bak" (style 1) - * foo.bar => foo.bak - * foo.bak => foo.$$$ (fallback) - * foo.$$$ => foo.~~~ (fallback) - * makefile => makefile.bak - * - * suffix = "~" (style 2) - * foo.c => foo.c~ - * foo.c~ => foo.c~~ - * foo.c~~ => foo~.c~~ - * foo~.c~~ => foo~~.c~~ - * foo~~~~~.c~~ => foo~~~~~.$$$ (fallback) - * - * foo.pas => foo~.pas - * makefile => makefile.~ - * longname.fil => longname.fi~ - * longname.fi~ => longnam~.fi~ - * longnam~.fi~ => longnam~.$$$ - * - */ - -#include "EXTERN.h" -#include "perl.h" -#ifdef OS2 -#define INCL_DOSFILEMGR -#define INCL_DOSERRORS -#include -#endif /* OS2 */ - -static char suffix1[] = ".$$$"; -static char suffix2[] = ".~~~"; - -#define ext (&buf[1000]) - -add_suffix(str,suffix) -register STR *str; -register char *suffix; -{ - int baselen; - int extlen; - char *s, *t, *p; - STRLEN slen; - - if (!(str->str_pok)) (void)str_2ptr(str); - if (str->str_cur > 1000) - fatal("Cannot do inplace edit on long filename (%d characters)", str->str_cur); - -#ifdef OS2 - /* Style 0 */ - slen = str->str_cur; - str_cat(str, suffix); - if (valid_filename(str->str_ptr)) return; - - /* Fooey, style 0 failed. Fix str before continuing. */ - str->str_ptr[str->str_cur = slen] = '\0'; -#endif /* OS2 */ - - slen = strlen(suffix); - t = buf; baselen = 0; s = str->str_ptr; - while ( (*t = *s) && *s != '.') { - baselen++; - if (*s == '\\' || *s == '/') baselen = 0; - s++; t++; - } - p = t; - - t = ext; extlen = 0; - while (*t++ = *s++) extlen++; - if (extlen == 0) { ext[0] = '.'; ext[1] = 0; extlen++; } - - if (*suffix == '.') { /* Style 1 */ - if (strEQ(ext, suffix)) goto fallback; - strcpy(p, suffix); - } else if (suffix[1] == '\0') { /* Style 2 */ - if (extlen < 4) { - ext[extlen] = *suffix; - ext[++extlen] = '\0'; - } else if (baselen < 8) { - *p++ = *suffix; - } else if (ext[3] != *suffix) { - ext[3] = *suffix; - } else if (buf[7] != *suffix) { - buf[7] = *suffix; - } else goto fallback; - strcpy(p, ext); - } else { /* Style 3: Panic */ -fallback: - (void)bcopy(strEQ(ext, suffix1) ? suffix2 : suffix1, p, 4+1); - } - str_set(str, buf); -} - -#ifdef OS2 -int -valid_filename(s) -char *s; -{ - HFILE hf; - USHORT usAction; - - switch(DosOpen(s, &hf, &usAction, 0L, 0, FILE_OPEN, - OPEN_ACCESS_READONLY | OPEN_SHARE_DENYNONE, 0L)) { - case ERROR_INVALID_NAME: - case ERROR_FILENAME_EXCED_RANGE: - return 0; - case NO_ERROR: - DosClose(hf); - /*FALLTHROUGH*/ - default: - return 1; - } -} -#endif /* OS2 */ diff --git a/os2/tests.dif b/os2/tests.dif deleted file mode 100644 index e0ad6fb..0000000 --- a/os2/tests.dif +++ /dev/null @@ -1,589 +0,0 @@ -diff -cbBwr perl-4.019/t/base/term.t new/t/base/term.t -*** perl-4.019/t/base/term.t Wed Mar 20 08:47:14 1991 ---- new/t/base/term.t Sun Jun 16 20:39:50 1991 -*************** -*** 29,35 **** - - # check <> pseudoliteral - -! open(try, "/dev/null") || (die "Can't open /dev/null."); - if ( eq '') { - print "ok 5\n"; - } ---- 29,35 ---- - - # check <> pseudoliteral - -! open(try, "nul") || (die "Can't open /dev/null."); - if ( eq '') { - print "ok 5\n"; - } -diff -cbBwr perl-4.019/t/cmd/while.t new/t/cmd/while.t -*** perl-4.019/t/cmd/while.t Wed Mar 20 08:46:28 1991 ---- new/t/cmd/while.t Sun Jun 16 20:52:36 1991 -*************** -*** 90,96 **** - if (!eof || $bad) {print "not ok 8\n";} else {print "ok 8\n";} - if (!$badcont) {print "ok 9\n";} else {print "not ok 9\n";} - -! `/bin/rm -f Cmd.while.tmp`; - - #$x = 0; - #while (1) { ---- 90,97 ---- - if (!eof || $bad) {print "not ok 8\n";} else {print "ok 8\n";} - if (!$badcont) {print "ok 9\n";} else {print "not ok 9\n";} - -! close(fh); -! `del Cmd.while.tmp`; - - #$x = 0; - #while (1) { -diff -cbBwr perl-4.019/t/comp/cpp.t new/t/comp/cpp.t -*** perl-4.019/t/comp/cpp.t Wed Mar 20 08:48:44 1991 ---- new/t/comp/cpp.t Sun Jun 16 20:54:00 1991 -*************** -*** 32,39 **** - print TRY '#define OK "ok 3\n"' . "\n"; - close TRY; - -! $pwd=`pwd`; - $pwd =~ s/\n//; -! $x = `./perl -P Comp.cpp.tmp`; - print $x; - unlink "Comp.cpp.tmp", "Comp.cpp.inc"; ---- 32,39 ---- - print TRY '#define OK "ok 3\n"' . "\n"; - close TRY; - -! $pwd=`cd`; - $pwd =~ s/\n//; -! $x = `perl -P Comp.cpp.tmp`; - print $x; - unlink "Comp.cpp.tmp", "Comp.cpp.inc"; -diff -cbBwr perl-4.019/t/comp/script.t new/t/comp/script.t -*** perl-4.019/t/comp/script.t Wed Mar 20 08:48:50 1991 ---- new/t/comp/script.t Sun Jun 16 21:05:02 1991 -*************** -*** 4,10 **** - - print "1..3\n"; - -! $x = `./perl -e 'print "ok\n";'`; - - if ($x eq "ok\n") {print "ok 1\n";} else {print "not ok 1\n";} - ---- 4,10 ---- - - print "1..3\n"; - -! $x = `perl -e "print \\\"ok\\n\\\";"`; - - if ($x eq "ok\n") {print "ok 1\n";} else {print "not ok 1\n";} - -*************** -*** 12,23 **** - print try 'print "ok\n";'; print try "\n"; - close try; - -! $x = `./perl Comp.script`; - - if ($x eq "ok\n") {print "ok 2\n";} else {print "not ok 2\n";} - -! $x = `./perl ) {print \$.,\$_;}' Io.argv.tmp Io.argv.tmp`; - - if ($x eq "1a line\n2a line\n") {print "ok 1\n";} else {print "not ok 1\n";} - -! $x = `echo foo|./perl -e 'while (<>) {print $_;}' Io.argv.tmp -`; - - if ($x eq "a line\nfoo\n") {print "ok 2\n";} else {print "not ok 2\n";} - -! $x = `echo foo|./perl -e 'while (<>) {print $_;}'`; - - 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'); - while (<>) { - $y .= $. . $_; - if (eof()) { ---- 8,26 ---- - print try "a line\n"; - close try; - -! $x = `perl -e "while (<>) {print \$.,\$_;}" Io.argv.tmp Io.argv.tmp`; - - if ($x eq "1a line\n2a line\n") {print "ok 1\n";} else {print "not ok 1\n";} - -! $x = `echo foo | perl -e "while (<>) {print $_;}" Io.argv.tmp -`; - - if ($x eq "a line\nfoo\n") {print "ok 2\n";} else {print "not ok 2\n";} - -! $x = `echo foo | perl -e "while (<>) {print $_;}"`; - - if ($x eq "foo\n") {print "ok 3\n";} else {print "not ok 3 :$x:\n";} - -! @ARGV = ('Io.argv.tmp', 'Io.argv.tmp', 'nul', 'Io.argv.tmp'); - while (<>) { - $y .= $. . $_; - if (eof()) { -*************** -*** 33,36 **** - else - {print "not ok 5\n";} - -! `/bin/rm -f Io.argv.tmp`; ---- 33,36 ---- - else - {print "not ok 5\n";} - -! `del Io.argv.tmp`; -diff -cbBwr perl-4.019/t/io/pipe.t new/t/io/pipe.t -*** perl-4.019/t/io/pipe.t Wed Mar 20 08:48:38 1991 ---- new/t/io/pipe.t Sun Jun 16 21:25:14 1991 -*************** -*** 5,11 **** - $| = 1; - print "1..8\n"; - -! open(PIPE, "|-") || (exec 'tr', '[A-Z]', '[a-z]'); - print PIPE "OK 1\n"; - print PIPE "ok 2\n"; - close PIPE; ---- 5,11 ---- - $| = 1; - print "1..8\n"; - -! open(PIPE, "|-") || (exec 'tr.exe', '[A-Z]', '[a-z]'); - print PIPE "OK 1\n"; - print PIPE "ok 2\n"; - close PIPE; -*************** -*** 18,24 **** - } - else { - print STDOUT "not ok 3\n"; -! exec 'echo', 'not ok 4'; - } - - pipe(READER,WRITER) || die "Can't open pipe"; ---- 18,24 ---- - } - else { - print STDOUT "not ok 3\n"; -! exec 'perlglob', 'not ok 4'; - } - - pipe(READER,WRITER) || die "Can't open pipe"; -diff -cbBwr perl-4.019/t/op/exec.t new/t/op/exec.t -*** perl-4.019/t/op/exec.t Wed Mar 20 08:48:46 1991 ---- new/t/op/exec.t Sun Jun 16 21:39:32 1991 -*************** -*** 7,21 **** - - print "not ok 1\n" if system "echo ok \\1"; # shell interpreted - print "not ok 2\n" if system "echo ok 2"; # split and directly called -! print "not ok 3\n" if system "echo", "ok", "3"; # directly called - -! if (system "true") {print "not ok 4\n";} else {print "ok 4\n";} - -! if ((system "/bin/sh -c 'exit 1'") != 256) { print "not "; } - print "ok 5\n"; - -! if ((system "lskdfj") == 255 << 8) {print "ok 6\n";} else {print "not ok 6\n";} - - unless (exec "lskdjfalksdjfdjfkls") {print "ok 7\n";} else {print "not ok 7\n";} - -! exec "echo","ok","8"; ---- 7,21 ---- - - print "not ok 1\n" if system "echo ok \\1"; # shell interpreted - print "not ok 2\n" if system "echo ok 2"; # split and directly called -! print "not ok 3\n" if system "perlglob", "ok", "3", "\n"; # directly called - -! if (system "expr 1 >nul") {print "not ok 4\n";} else {print "ok 4\n";} - -! if ((system "sh -c \"exit 1\"") != 1) { print "not "; } - print "ok 5\n"; - -! if ((system "lskdfj") == 1) {print "ok 6\n";} else {print "not ok 6\n";} - - unless (exec "lskdjfalksdjfdjfkls") {print "ok 7\n";} else {print "not ok 7\n";} - -! exec "perlglob","ok","8"; -diff -cbBwr perl-4.019/t/op/glob.t new/t/op/glob.t -*** perl-4.019/t/op/glob.t Wed Mar 20 08:48:54 1991 ---- new/t/op/glob.t Sun Jun 16 21:43:26 1991 -*************** -*** 7,13 **** - @ops = ; - $list = join(' ',@ops); - -! chop($otherway = `echo op/*`); - - print $list eq $otherway ? "ok 1\n" : "not ok 1\n$list\n$otherway\n"; - ---- 7,13 ---- - @ops = ; - $list = join(' ',@ops); - -! chop($otherway = `perlglob op/*`); - - print $list eq $otherway ? "ok 1\n" : "not ok 1\n$list\n$otherway\n"; - -diff -cbBwr perl-4.019/t/op/goto.t new/t/op/goto.t -*** perl-4.019/t/op/goto.t Wed Mar 20 08:48:46 1991 ---- new/t/op/goto.t Sun Jun 16 21:50:54 1991 -*************** -*** 29,34 **** - print "#2\t:$foo: == 4\n"; - if ($foo == 4) {print "ok 2\n";} else {print "not ok 2\n";} - -! $x = `./perl -e 'goto foo;' 2>&1`; - print "#3\t/label/ in :$x"; - if ($x =~ /label/) {print "ok 3\n";} else {print "not ok 3\n";} ---- 29,34 ---- - print "#2\t:$foo: == 4\n"; - if ($foo == 4) {print "ok 2\n";} else {print "not ok 2\n";} - -! $x = `perl -e "goto foo;" 2>&1`; - print "#3\t/label/ in :$x"; - if ($x =~ /label/) {print "ok 3\n";} else {print "not ok 3\n";} -diff -cbBwr perl-4.019/t/op/magic.t new/t/op/magic.t -*** perl-4.019/t/op/magic.t Wed Mar 20 08:48:36 1991 ---- new/t/op/magic.t Sun Jun 16 21:56:14 1991 -*************** -*** 7,13 **** - print "1..5\n"; - - eval '$ENV{"foo"} = "hi there";'; # check that ENV is inited inside eval -! if (`echo \$foo` eq "hi there\n") {print "ok 1\n";} else {print "not ok 1\n";} - - unlink 'ajslkdfpqjsjfk'; - $! = 0; ---- 7,13 ---- - print "1..5\n"; - - eval '$ENV{"foo"} = "hi there";'; # check that ENV is inited inside eval -! if (`echo %foo%` eq "hi there\n") {print "ok 1\n";} else {print "not ok 1\n";} - - unlink 'ajslkdfpqjsjfk'; - $! = 0; -*************** -*** 17,30 **** - # the next tests are embedded inside system simply because sh spits out - # a newline onto stderr when a child process kills itself with SIGINT. - -! system './perl', - '-e', '$| = 1; # command buffering', - -! '-e', '$SIG{"INT"} = "ok3"; kill 2,$$;', -! '-e', '$SIG{"INT"} = "IGNORE"; kill 2,$$; print "ok 4\n";', -! '-e', '$SIG{"INT"} = "DEFAULT"; kill 2,$$; print "not ok\n";', - -! '-e', 'sub ok3 { print "ok 3\n" if pop(@_) eq "INT"; }'; - - @val1 = @ENV{keys(%ENV)}; # can we slice ENV? - @val2 = values(%ENV); ---- 17,30 ---- - # the next tests are embedded inside system simply because sh spits out - # a newline onto stderr when a child process kills itself with SIGINT. - -! system 'perl', - '-e', '$| = 1; # command buffering', - -! '-e', '$SIG{"TERM"} = "ok3"; kill 0,$$;', -! '-e', '$SIG{"TERM"} = "IGNORE"; kill 0,$$; print "ok 4\n";', -! '-e', '$SIG{"TERM"} = "DEFAULT"; kill 0,$$; print "not ok\n";', - -! '-e', 'sub ok3 { print "ok 3\n" if pop(@_) eq "TERM"; }'; - - @val1 = @ENV{keys(%ENV)}; # can we slice ENV? - @val2 = values(%ENV); -diff -cbBwr perl-4.019/t/op/mkdir.t new/t/op/mkdir.t -*** perl-4.019/t/op/mkdir.t Wed Mar 20 08:48:54 1991 ---- new/t/op/mkdir.t Sun Jun 16 22:00:06 1991 -*************** -*** 4,14 **** - - print "1..7\n"; - -! `rm -rf blurfl`; - - print (mkdir('blurfl',0777) ? "ok 1\n" : "not ok 1\n"); - print (mkdir('blurfl',0777) ? "not ok 2\n" : "ok 2\n"); -! print ($! =~ /exist/ ? "ok 3\n" : "not ok 3\n"); - print (-d 'blurfl' ? "ok 4\n" : "not ok 4\n"); - print (rmdir('blurfl') ? "ok 5\n" : "not ok 5\n"); - print (rmdir('blurfl') ? "not ok 6\n" : "ok 6\n"); ---- 4,14 ---- - - print "1..7\n"; - -! `rm -r blurfl`; - - print (mkdir('blurfl',0777) ? "ok 1\n" : "not ok 1\n"); - print (mkdir('blurfl',0777) ? "not ok 2\n" : "ok 2\n"); -! print ($! =~ /denied/ ? "ok 3\n" : "not ok 3\n"); - print (-d 'blurfl' ? "ok 4\n" : "not ok 4\n"); - print (rmdir('blurfl') ? "ok 5\n" : "not ok 5\n"); - print (rmdir('blurfl') ? "not ok 6\n" : "ok 6\n"); -diff -cbBwr perl-4.019/t/op/split.t new/t/op/split.t -*** perl-4.019/t/op/split.t Wed Mar 20 08:48:24 1991 ---- new/t/op/split.t Sun Jun 16 22:04:02 1991 -*************** -*** 47,53 **** - print $_ eq '1:2:3:4:5:6:::' ? "ok 10\n" : "not ok 10 $_\n"; - - # Does assignment to a list imply split to one more field than that? -! $foo = `./perl -D1024 -e '(\$a,\$b) = split;' 2>&1`; - print $foo =~ /DEBUGGING/ || $foo =~ /num\(3\)/ ? "ok 11\n" : "not ok 11\n"; - - # Can we say how many fields to split to when assigning to a list? ---- 47,53 ---- - print $_ eq '1:2:3:4:5:6:::' ? "ok 10\n" : "not ok 10 $_\n"; - - # Does assignment to a list imply split to one more field than that? -! $foo = `perl -D1024 -e "(\$a,\$b) = split;" 2>&1`; - print $foo =~ /DEBUGGING/ || $foo =~ /num\(3\)/ ? "ok 11\n" : "not ok 11\n"; - - # Can we say how many fields to split to when assigning to a list? -diff -cbBwr perl-4.019/t/op/stat.t new/t/op/stat.t -*** perl-4.019/t/op/stat.t Fri Nov 22 22:04:46 1991 ---- new/t/op/stat.t Fri Nov 22 22:16:40 1991 -*************** -*** 4,12 **** - - print "1..56\n"; - -! chop($cwd = `pwd`); - -! $DEV = `ls -l /dev`; - - unlink "Op.stat.tmp"; - open(FOO, ">Op.stat.tmp"); ---- 4,12 ---- - - print "1..56\n"; - -! chop($cwd = `cd`); - -! $DEV = `ls -l`; - - unlink "Op.stat.tmp"; - open(FOO, ">Op.stat.tmp"); -*************** -*** 23,29 **** - - sleep 2; - -! `rm -f Op.stat.tmp2; ln Op.stat.tmp Op.stat.tmp2; chmod 644 Op.stat.tmp`; - - ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, - $blksize,$blocks) = stat('Op.stat.tmp'); ---- 23,29 ---- - - sleep 2; - -! `del Op.stat.tmp2; ln Op.stat.tmp Op.stat.tmp2; chmod 644 Op.stat.tmp 2>nul`; - - ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime, - $blksize,$blocks) = stat('Op.stat.tmp'); -*************** -*** 73,80 **** - if (-d '.') {print "ok 23\n";} else {print "not ok 23\n";} - if (! -f '.') {print "ok 24\n";} else {print "not ok 24\n";} - -! if (`ls -l perl` =~ /^l.*->/) { -! if (-l 'perl') {print "ok 25\n";} else {print "not ok 25\n";} - } - else { - print "ok 25\n"; ---- 73,80 ---- - if (-d '.') {print "ok 23\n";} else {print "not ok 23\n";} - if (! -f '.') {print "ok 24\n";} else {print "not ok 24\n";} - -! if (`ls -l perl.exe` =~ /^l.*->/) { -! if (-l 'perl.exe') {print "ok 25\n";} else {print "not ok 25\n";} - } - else { - print "ok 25\n"; -*************** -*** 83,89 **** - if (-o 'Op.stat.tmp') {print "ok 26\n";} else {print "not ok 26\n";} - - if (-e 'Op.stat.tmp') {print "ok 27\n";} else {print "not ok 27\n";} -! `rm -f Op.stat.tmp Op.stat.tmp2`; - if (! -e 'Op.stat.tmp') {print "ok 28\n";} else {print "not ok 28\n";} - - if ($DEV !~ /\nc.* (\S+)\n/) ---- 83,89 ---- - if (-o 'Op.stat.tmp') {print "ok 26\n";} else {print "not ok 26\n";} - - if (-e 'Op.stat.tmp') {print "ok 27\n";} else {print "not ok 27\n";} -! `del Op.stat.tmp Op.stat.tmp2 2>nul`; - if (! -e 'Op.stat.tmp') {print "ok 28\n";} else {print "not ok 28\n";} - - if ($DEV !~ /\nc.* (\S+)\n/) -*************** -*** 113,119 **** - $cnt = $uid = 0; - - die "Can't run op/stat.t test 35 without pwd working" unless $cwd; -! chdir '/usr/bin' || die "Can't cd to /usr/bin"; - while (defined($_ = <*>)) { - $cnt++; - $uid++ if -u; ---- 113,119 ---- - $cnt = $uid = 0; - - die "Can't run op/stat.t test 35 without pwd working" unless $cwd; -! chdir '../os2' || die "Can't cd to ../os2"; - while (defined($_ = <*>)) { - $cnt++; - $uid++ if -u; -*************** -*** 124,138 **** - # I suppose this is going to fail somewhere... - if ($uid > 0 && $uid < $cnt) {print "ok 35\n";} else {print "not ok 35\n";} - -! unless (open(tty,"/dev/tty")) { -! print STDERR "Can't open /dev/tty--run t/TEST outside of make.\n"; - } - if (-t tty) {print "ok 36\n";} else {print "not ok 36\n";} - if (-c tty) {print "ok 37\n";} else {print "not ok 37\n";} - close(tty); - if (! -t tty) {print "ok 38\n";} else {print "not ok 38\n";} -! open(null,"/dev/null"); -! if (! -t null || -e '/xenix') {print "ok 39\n";} else {print "not ok 39\n";} - close(null); - if (-t) {print "ok 40\n";} else {print "not ok 40\n";} - ---- 124,138 ---- - # I suppose this is going to fail somewhere... - if ($uid > 0 && $uid < $cnt) {print "ok 35\n";} else {print "not ok 35\n";} - -! unless (open(tty,"con")) { -! print STDERR "Can't open con--run t/TEST outside of make.\n"; - } - if (-t tty) {print "ok 36\n";} else {print "not ok 36\n";} - if (-c tty) {print "ok 37\n";} else {print "not ok 37\n";} - close(tty); - if (! -t tty) {print "ok 38\n";} else {print "not ok 38\n";} -! open(null,"nul"); -! if (! -t null || -e 'c:/os2krnl') {print "ok 39\n";} else {print "not ok 39\n";} - close(null); - if (-t) {print "ok 40\n";} else {print "not ok 40\n";} - -*************** -*** 141,148 **** - if (-T 'op/stat.t') {print "ok 41\n";} else {print "not ok 41\n";} - if (! -B 'op/stat.t') {print "ok 42\n";} else {print "not ok 42\n";} - -! if (-B './perl') {print "ok 43\n";} else {print "not ok 43\n";} -! if (! -T './perl') {print "ok 44\n";} else {print "not ok 44\n";} - - open(FOO,'op/stat.t'); - eval { -T FOO; }; ---- 141,148 ---- - if (-T 'op/stat.t') {print "ok 41\n";} else {print "not ok 41\n";} - if (! -B 'op/stat.t') {print "ok 42\n";} else {print "not ok 42\n";} - -! if (-B 'perl.exe') {print "ok 43\n";} else {print "not ok 43\n";} -! if (! -T 'perl.exe') {print "ok 44\n";} else {print "not ok 44\n";} - - open(FOO,'op/stat.t'); - eval { -T FOO; }; -*************** -*** 172,176 **** - } - close(FOO); - -! if (-T '/dev/null') {print "ok 55\n";} else {print "not ok 55\n";} -! if (-B '/dev/null') {print "ok 56\n";} else {print "not ok 56\n";} ---- 172,176 ---- - } - close(FOO); - -! if (-T 'nul') {print "ok 55\n";} else {print "not ok 55\n";} -! if (-B 'nul') {print "ok 56\n";} else {print "not ok 56\n";} -diff -cbBwr perl-4.019/t/TEST new/t/TEST -*** perl-4.019/t/TEST Tue Jun 11 23:32:06 1991 ---- new/t/TEST Sun Jun 16 20:47:38 1991 -*************** -*** 16,22 **** - - if ($ARGV[0] eq '') { - @ARGV = split(/[ \n]/, -! `echo base/*.t comp/*.t cmd/*.t io/*.t; echo op/*.t lib/*.t`); - } - - open(CONFIG,"../config.sh"); ---- 16,22 ---- - - if ($ARGV[0] eq '') { - @ARGV = split(/[ \n]/, -! `ls base/*.t comp/*.t cmd/*.t io/*.t op/*.t lib/*.t`); - } - - open(CONFIG,"../config.sh"); -*************** -*** 35,41 **** - chop($te); - print "$te" . '.' x (15 - length($te)); - if ($sharpbang) { -! open(results,"./$test|") || (print "can't run.\n"); - } else { - open(script,"$test") || die "Can't run $test.\n"; - $_ =