summaryrefslogtreecommitdiff
path: root/ext
diff options
context:
space:
mode:
authorLarry Wall <lwall@netlabs.com>1994-10-17 23:00:00 +0000
committerLarry Wall <lwall@netlabs.com>1994-10-17 23:00:00 +0000
commita0d0e21ea6ea90a22318550944fe6cb09ae10cda (patch)
treefaca1018149b736b1142f487e44d1ff2de5cc1fa /ext
parent85e6fe838fb25b257a1b363debf8691c0992ef71 (diff)
downloadperl-a0d0e21ea6ea90a22318550944fe6cb09ae10cda.tar.gz
perl 5.000perl-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 :-(. ]
Diffstat (limited to 'ext')
-rw-r--r--ext/DB_File/DB_File.pm248
-rw-r--r--ext/DB_File/DB_File.xs945
-rw-r--r--ext/DB_File/DB_File_BS6
-rw-r--r--ext/DB_File/Makefile.SH207
-rw-r--r--ext/DB_File/typemap39
-rw-r--r--ext/DynaLoader/DynaLoader.doc257
-rw-r--r--ext/DynaLoader/DynaLoader.pm243
-rw-r--r--ext/DynaLoader/Makefile.SH185
-rw-r--r--ext/DynaLoader/README53
-rw-r--r--ext/DynaLoader/dl_aix.xs582
-rw-r--r--ext/DynaLoader/dl_dld.xs173
-rw-r--r--ext/DynaLoader/dl_dlopen.xs201
-rw-r--r--ext/DynaLoader/dl_hpux.xs101
-rw-r--r--ext/DynaLoader/dl_next.xs213
-rw-r--r--ext/DynaLoader/dl_none.xs19
-rw-r--r--ext/DynaLoader/dl_vms.xs324
-rw-r--r--ext/DynaLoader/dlutils.c85
-rw-r--r--ext/Fcntl/Fcntl.pm51
-rw-r--r--ext/Fcntl/Fcntl.xs181
-rw-r--r--ext/Fcntl/MANIFEST4
-rw-r--r--ext/Fcntl/Makefile.SH207
-rw-r--r--ext/GDBM_File/GDBM_File.pm47
-rw-r--r--ext/GDBM_File/GDBM_File.xs218
-rw-r--r--ext/GDBM_File/Makefile.SH213
-rw-r--r--ext/GDBM_File/typemap (renamed from ext/dbm/typemap)0
-rw-r--r--ext/NDBM_File/Makefile.SH213
-rw-r--r--ext/NDBM_File/NDBM_File.pm11
-rw-r--r--ext/NDBM_File/NDBM_File.xs70
-rw-r--r--ext/NDBM_File/typemap25
-rw-r--r--ext/ODBM_File/Makefile.SH213
-rw-r--r--ext/ODBM_File/ODBM_File.pm11
-rw-r--r--ext/ODBM_File/ODBM_File.xs (renamed from ext/dbm/ODBM_File.xs)29
-rw-r--r--ext/ODBM_File/typemap25
-rw-r--r--ext/POSIX/Makefile.SH207
-rw-r--r--ext/POSIX/POSIX.pm1023
-rw-r--r--ext/POSIX/POSIX.xs (renamed from ext/posix/POSIX.xs)690
-rw-r--r--ext/POSIX/typemap13
-rw-r--r--ext/README114
-rw-r--r--ext/SDBM_File/Makefile.SH216
-rw-r--r--ext/SDBM_File/SDBM_File.pm11
-rw-r--r--ext/SDBM_File/SDBM_File.xs71
-rw-r--r--ext/SDBM_File/sdbm/CHANGES (renamed from ext/dbm/sdbm/CHANGES)0
-rw-r--r--ext/SDBM_File/sdbm/COMPARE (renamed from ext/dbm/sdbm/COMPARE)0
-rw-r--r--ext/SDBM_File/sdbm/Makefile.SH (renamed from ext/dbm/sdbm/Makefile.SH)41
-rw-r--r--ext/SDBM_File/sdbm/README (renamed from ext/dbm/sdbm/README)0
-rw-r--r--ext/SDBM_File/sdbm/README.too (renamed from ext/dbm/sdbm/README.too)0
-rw-r--r--ext/SDBM_File/sdbm/biblio (renamed from ext/dbm/sdbm/biblio)0
-rw-r--r--ext/SDBM_File/sdbm/dba.c (renamed from ext/dbm/sdbm/dba.c)0
-rw-r--r--ext/SDBM_File/sdbm/dbd.c (renamed from ext/dbm/sdbm/dbd.c)0
-rw-r--r--ext/SDBM_File/sdbm/dbe.1 (renamed from ext/dbm/sdbm/dbe.1)0
-rw-r--r--ext/SDBM_File/sdbm/dbe.c (renamed from ext/dbm/sdbm/dbe.c)0
-rw-r--r--ext/SDBM_File/sdbm/dbm.c (renamed from ext/dbm/sdbm/dbm.c)0
-rw-r--r--ext/SDBM_File/sdbm/dbm.h (renamed from ext/dbm/sdbm/dbm.h)0
-rw-r--r--ext/SDBM_File/sdbm/dbu.c (renamed from ext/dbm/sdbm/dbu.c)0
-rwxr-xr-xext/SDBM_File/sdbm/grind (renamed from ext/dbm/sdbm/grind)0
-rw-r--r--ext/SDBM_File/sdbm/hash.c (renamed from ext/dbm/sdbm/hash.c)0
-rw-r--r--ext/SDBM_File/sdbm/linux.patches (renamed from ext/dbm/sdbm/linux.patches)0
-rw-r--r--ext/SDBM_File/sdbm/makefile.sdbm (renamed from ext/dbm/sdbm/makefile.sdbm)0
-rw-r--r--ext/SDBM_File/sdbm/pair.c (renamed from ext/dbm/sdbm/pair.c)2
-rw-r--r--ext/SDBM_File/sdbm/pair.h (renamed from ext/dbm/sdbm/pair.h)0
-rw-r--r--ext/SDBM_File/sdbm/readme.ms (renamed from ext/dbm/sdbm/readme.ms)0
-rw-r--r--ext/SDBM_File/sdbm/readme.ps (renamed from ext/dbm/sdbm/readme.ps)0
-rw-r--r--ext/SDBM_File/sdbm/sdbm.3 (renamed from ext/dbm/sdbm/sdbm.3)0
-rw-r--r--ext/SDBM_File/sdbm/sdbm.c (renamed from ext/dbm/sdbm/sdbm.c)0
-rw-r--r--ext/SDBM_File/sdbm/sdbm.h (renamed from ext/dbm/sdbm/sdbm.h)39
-rw-r--r--ext/SDBM_File/sdbm/tune.h (renamed from ext/dbm/sdbm/tune.h)0
-rw-r--r--ext/SDBM_File/sdbm/util.c (renamed from ext/dbm/sdbm/util.c)0
-rw-r--r--ext/SDBM_File/typemap25
-rw-r--r--ext/Socket/Makefile.SH207
-rw-r--r--ext/Socket/Socket.pm116
-rw-r--r--ext/Socket/Socket.xs565
-rw-r--r--ext/curses/Makefile16
-rw-r--r--ext/curses/bsdcurses.mus698
-rw-r--r--ext/curses/curses.mus889
-rw-r--r--ext/curses/pager190
-rw-r--r--ext/dbm/GDBM_File.c310
-rw-r--r--ext/dbm/GDBM_File.xs76
-rw-r--r--ext/dbm/GDBM_File.xs.bak122
-rw-r--r--ext/dbm/Makefile20
-rw-r--r--ext/dbm/NDBM_File.c267
-rw-r--r--ext/dbm/NDBM_File.xs58
-rw-r--r--ext/dbm/ODBM_File.c246
-rw-r--r--ext/dbm/SDBM_File.c0
-rw-r--r--ext/dbm/SDBM_File.c.bak267
-rwxr-xr-xext/dbm/SDBM_File.sobin73728 -> 0 bytes
-rw-r--r--ext/dbm/SDBM_File.xs58
l---------ext/dbm/perl1
-rw-r--r--ext/dbm/sdbm/.pure0
-rwxr-xr-xext/dbm/sdbm/.r5884
-rwxr-xr-xext/dbm/sdbm/Makefile47
-rw-r--r--ext/dbm/sdbm/libsdbm.abin35114 -> 0 bytes
-rw-r--r--ext/dbm/sdbm/libsdbm_pure_q552_110.abin11826 -> 0 bytes
-rw-r--r--ext/dbm/sdbm/makefile55
-rw-r--r--ext/dl/dl.c54
-rw-r--r--ext/dl/dl_hpux.c71
-rw-r--r--ext/dl/dl_next.c69
-rw-r--r--ext/dl/dl_sunos.c56
-rw-r--r--ext/dl/eg/Makefile20
-rw-r--r--ext/dl/eg/Makefile.att18
-rw-r--r--ext/dl/eg/main.c28
-rwxr-xr-xext/dl/eg/testbin24576 -> 0 bytes
-rw-r--r--ext/dl/eg/test.c4
-rwxr-xr-xext/dl/eg/test1bin24576 -> 0 bytes
-rw-r--r--ext/dl/eg/test1.c11
-rw-r--r--ext/man2mus66
-rw-r--r--ext/mus135
-rw-r--r--ext/posix/typemap11
-rw-r--r--ext/typemap155
-rw-r--r--ext/typemap.oi99
-rw-r--r--ext/typemap.xlib97
-rw-r--r--ext/typemap.xpm7
-rwxr-xr-xext/util/extliblist151
-rw-r--r--ext/util/make_ext74
-rw-r--r--ext/util/mkbootstrap5
-rwxr-xr-xext/xsubpp196
-rwxr-xr-xext/xsubpp.bak529
-rwxr-xr-xext/xvarpp161
117 files changed, 9010 insertions, 10950 deletions
diff --git a/ext/DB_File/DB_File.pm b/ext/DB_File/DB_File.pm
new file mode 100644
index 0000000000..d66ab2cabe
--- /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 0000000000..c83f976d93
--- /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 <db.h>
+
+#include <fcntl.h>
+
+#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 0000000000..9282c49881
--- /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 0000000000..7422b00eab
--- /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 0000000000..242fa041d2
--- /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 0000000000..85d606ff9b
--- /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 0000000000..61d9a8566e
--- /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 <bailey@HMIVAX.HUMGEN.UPENN.EDU>)
+# 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 0000000000..2b10fefd1a
--- /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 0000000000..19dd8e72f6
--- /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 0000000000..f8bace1314
--- /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 <stdio.h>
+#include <errno.h>
+#include <string.h>
+#include <stdlib.h>
+#include <sys/types.h>
+#include <sys/ldr.h>
+#include <a.out.h>
+#include <ldfcn.h>
+
+/*
+ * 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 0000000000..31f625a26d
--- /dev/null
+++ b/ext/DynaLoader/dl_dld.xs
@@ -0,0 +1,173 @@
+/*
+ * Written 3/1/94, Robert Sanders <Robert.Sanders@linux.org>
+ *
+ * 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 <dld.h> /* GNU DLD header file */
+#include <unistd.h>
+
+#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 0000000000..ffd3dbc422
--- /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 <dlfcn.h> /* the dynamic linker include file for Sunos/Solaris */
+#else
+#include <nlist.h>
+#include <link.h>
+#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 0000000000..0558e40eaa
--- /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 <dl.h>
+#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 0000000000..9bc5cd81c2
--- /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 <mach-o/rld.h>
+#include <streams/streams.h>
+
+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<psize-1; i++) {
+ p[i] = SvPVx(*av_fetch(av_resolve, i-1, TRUE), na);
+ }
+ p[psize-1] = 0;
+ rld_success = rld_load(nxerr, (struct mach_header **)0, p,
+ (const char *) 0);
+ safefree((char*) p);
+ if (rld_success) {
+ result = path;
+ } else {
+ TransferError(nxerr);
+ result = (char*) 0;
+ }
+ CloseError(nxerr);
+ return result;
+}
+
+int
+dlclose(handle) /* stub only */
+void *handle;
+{
+ return 0;
+}
+
+void *
+dlsym(handle, symbol)
+void *handle;
+char *symbol;
+{
+ NXStream *nxerr = OpenError();
+ char symbuf[1024];
+ unsigned long symref = 0;
+
+ sprintf(symbuf, "_%s", symbol);
+ if (!rld_lookup(nxerr, symbuf, &symref)) {
+ TransferError(nxerr);
+ }
+ CloseError(nxerr);
+ return (void*) symref;
+}
+
+
+/* ----- code from dl_dlopen.xs below here ----- */
+
+
+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;
+ 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:
+ 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_none.xs b/ext/DynaLoader/dl_none.xs
new file mode 100644
index 0000000000..5a193e4346
--- /dev/null
+++ b/ext/DynaLoader/dl_none.xs
@@ -0,0 +1,19 @@
+/* dl_none.xs
+ *
+ * Stubs for platforms that do not support dynamic linking
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+MODULE = DynaLoader PACKAGE = DynaLoader
+
+char *
+dl_error()
+ CODE:
+ RETVAL = "Not implemented";
+ OUTPUT:
+ RETVAL
+
+# end.
diff --git a/ext/DynaLoader/dl_vms.xs b/ext/DynaLoader/dl_vms.xs
new file mode 100644
index 0000000000..8486ae260c
--- /dev/null
+++ b/ext/DynaLoader/dl_vms.xs
@@ -0,0 +1,324 @@
+/* dl_vms.xs
+ *
+ * Platform: OpenVMS, VAX or AXP
+ * Author: Charles Bailey bailey@genetics.upenn.edu
+ * Revised: 4-Sep-1994
+ *
+ * Implementation Note
+ * This section is added as an aid to users and DynaLoader developers, in
+ * order to clarify the process of dynamic linking under VMS.
+ * dl_vms.xs uses the supported VMS dynamic linking call, which allows
+ * a running program to map an arbitrary file of executable code and call
+ * routines within that file. This is done via the VMS RTL routine
+ * lib$find_image_symbol, whose calling sequence is as follows:
+ * status = lib$find_image_symbol(imgname,symname,symval,defspec);
+ * where
+ * status = a standard VMS status value (unsigned long int)
+ * imgname = a fixed-length string descriptor, passed by
+ * reference, containing the NAME ONLY of the image
+ * file to be mapped. An attempt will be made to
+ * translate this string as a logical name, so it may
+ * not contain any characters which are not allowed in
+ * logical names. If no translation is found, imgname
+ * is used directly as the name of the image file.
+ * symname = a fixed-length string descriptor, passed by
+ * reference, containing the name of the routine
+ * to be located.
+ * symval = an unsigned long int, passed by reference, into
+ * which is written the entry point address of the
+ * routine whose name is specified in symname.
+ * defspec = a fixed-length string descriptor, passed by
+ * reference, containing a default file specification
+ * whichis used to fill in any missing parts of the
+ * image file specification after the imgname argument
+ * is processed.
+ * In order to accommodate the handling of the imgname argument, the routine
+ * dl_expandspec() is provided for use by perl code (e.g. dl_findfile)
+ * which wants to see what image file lib$find_image_symbol would use if
+ * it were passed a given file specification. The file specification passed
+ * to dl_expandspec() and dl_load_file() can be partial or complete, and can
+ * use VMS or Unix syntax; these routines perform the necessary conversions.
+ * In general, writers of perl extensions need only conform to the
+ * procedures set out in the DynaLoader documentation, and let the details
+ * be taken care of by the routines here and in DynaLoader.pm. If anyone
+ * comes across any incompatibilities, please let me know. Thanks.
+ *
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#include "dlutils.c" /* dl_debug, LastError; SaveError not used */
+/* N.B.:
+ * dl_debug and LastError are static vars; you'll need to deal
+ * with them appropriately if you need context independence
+ */
+
+#include <descrip.h>
+#include <fscndef.h>
+#include <lib$routines.h>
+#include <rms.h>
+#include <ssdef.h>
+
+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 0000000000..0ce082182c
--- /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 0000000000..c4fd2ff550
--- /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 0000000000..2a360951f9
--- /dev/null
+++ b/ext/Fcntl/Fcntl.xs
@@ -0,0 +1,181 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#include <fcntl.h>
+
+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 0000000000..e5ff6bfe76
--- /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 0000000000..064228e512
--- /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 0000000000..23422f7a2e
--- /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 0000000000..c6dc484fa1
--- /dev/null
+++ b/ext/GDBM_File/GDBM_File.xs
@@ -0,0 +1,218 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#include <gdbm.h>
+#include <fcntl.h>
+
+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 0000000000..974c8deef8
--- /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
index a6b0e5faa8..a6b0e5faa8 100644
--- a/ext/dbm/typemap
+++ b/ext/GDBM_File/typemap
diff --git a/ext/NDBM_File/Makefile.SH b/ext/NDBM_File/Makefile.SH
new file mode 100644
index 0000000000..56016cae03
--- /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 0000000000..e40fe854fe
--- /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 0000000000..52c08ebe76
--- /dev/null
+++ b/ext/NDBM_File/NDBM_File.xs
@@ -0,0 +1,70 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include <ndbm.h>
+
+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/NDBM_File/typemap b/ext/NDBM_File/typemap
new file mode 100644
index 0000000000..a6b0e5faa8
--- /dev/null
+++ b/ext/NDBM_File/typemap
@@ -0,0 +1,25 @@
+#
+#################################### DBM SECTION
+#
+
+datum T_DATUM
+gdatum T_GDATUM
+NDBM_File T_PTROBJ
+GDBM_File T_PTROBJ
+SDBM_File T_PTROBJ
+ODBM_File T_PTROBJ
+DB_File T_PTROBJ
+DBZ_File T_PTROBJ
+FATALFUNC T_OPAQUEPTR
+
+INPUT
+T_DATUM
+ $var.dptr = SvPV($arg, na);
+ $var.dsize = (int)na;
+T_GDATUM
+ UNIMPLEMENTED
+OUTPUT
+T_DATUM
+ sv_setpvn($arg, $var.dptr, $var.dsize);
+T_GDATUM
+ sv_usepvn($arg, $var.dptr, $var.dsize);
diff --git a/ext/ODBM_File/Makefile.SH b/ext/ODBM_File/Makefile.SH
new file mode 100644
index 0000000000..02cf6e13ab
--- /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 0000000000..d844c673c3
--- /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/dbm/ODBM_File.xs b/ext/ODBM_File/ODBM_File.xs
index 04d7b9e7cf..15737a0de8 100644
--- a/ext/dbm/ODBM_File.xs
+++ b/ext/ODBM_File/ODBM_File.xs
@@ -11,11 +11,11 @@
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)
+#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;
@@ -26,7 +26,7 @@ static int dbmrefcnt;
MODULE = ODBM_File PACKAGE = ODBM_File PREFIX = odbm_
ODBM_File
-odbm_new(dbtype, filename, flags, mode)
+odbm_TIEHASH(dbtype, filename, flags, mode)
char * dbtype
char * filename
int flags
@@ -61,28 +61,35 @@ DESTROY(db)
dbmclose();
datum
-odbm_fetch(db, key)
+odbm_FETCH(db, key)
ODBM_File db
datum key
int
-odbm_store(db, key, value, flags = DBM_REPLACE)
+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_DELETE(db, key)
ODBM_File db
datum key
datum
-odbm_firstkey(db)
+odbm_FIRSTKEY(db)
ODBM_File db
datum
-odbm_nextkey(db, key)
+odbm_NEXTKEY(db, key)
ODBM_File db
datum key
diff --git a/ext/ODBM_File/typemap b/ext/ODBM_File/typemap
new file mode 100644
index 0000000000..a6b0e5faa8
--- /dev/null
+++ b/ext/ODBM_File/typemap
@@ -0,0 +1,25 @@
+#
+#################################### DBM SECTION
+#
+
+datum T_DATUM
+gdatum T_GDATUM
+NDBM_File T_PTROBJ
+GDBM_File T_PTROBJ
+SDBM_File T_PTROBJ
+ODBM_File T_PTROBJ
+DB_File T_PTROBJ
+DBZ_File T_PTROBJ
+FATALFUNC T_OPAQUEPTR
+
+INPUT
+T_DATUM
+ $var.dptr = SvPV($arg, na);
+ $var.dsize = (int)na;
+T_GDATUM
+ UNIMPLEMENTED
+OUTPUT
+T_DATUM
+ sv_setpvn($arg, $var.dptr, $var.dsize);
+T_GDATUM
+ sv_usepvn($arg, $var.dptr, $var.dsize);
diff --git a/ext/POSIX/Makefile.SH b/ext/POSIX/Makefile.SH
new file mode 100644
index 0000000000..13a8faa116
--- /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 0000000000..3fa292df6a
--- /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 <STDIN>;
+}
+
+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
index a439494dac..941e59a795 100644
--- a/ext/posix/POSIX.xs
+++ b/ext/POSIX/POSIX.xs
@@ -1,16 +1,19 @@
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
-
#include <ctype.h>
+#ifdef I_DIRENT /* XXX maybe better to just rely on perl.h? */
#include <dirent.h>
+#endif
#include <errno.h>
#include <fcntl.h>
#ifdef I_FLOAT
#include <float.h>
#endif
#include <grp.h>
+#ifdef I_LIMITS
#include <limits.h>
+#endif
#include <locale.h>
#include <math.h>
#ifdef I_PWD
@@ -24,33 +27,83 @@
#ifdef I_STDDEF
#include <stddef.h>
#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 <termios.h>
+#endif
#include <stdio.h>
+#ifdef I_STDLIB
#include <stdlib.h>
+#endif
#include <string.h>
#include <sys/stat.h>
#include <sys/times.h>
#include <sys/types.h>
+#ifdef HAS_UNAME
#include <sys/utsname.h>
-#include <sys/wait.h>
-#if defined(I_TERMIOS) && !defined(CR3)
-#include <termios.h>
#endif
+#include <sys/wait.h>
#include <time.h>
#include <unistd.h>
+#ifdef I_UTIME
#include <utime.h>
+#endif
+typedef FILE * InputStream;
+typedef FILE * OutputStream;
typedef int SysRet;
+typedef long SysRetLong;
typedef sigset_t* POSIX__SigSet;
typedef HV* POSIX__SigAction;
-
-#define HAS_UNAME
-
-#ifndef HAS_GETPGRP
-#define getpgrp() not_here("getpgrp")
+#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
@@ -60,8 +113,11 @@ typedef HV* POSIX__SigAction;
#ifndef HAS_SETSID
#define setsid() not_here("setsid")
#endif
-#ifndef HAS_SYMLINK
-#define symlink(a,b) not_here("symlink")
+#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")
@@ -79,6 +135,63 @@ typedef HV* POSIX__SigAction;
#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;
@@ -87,7 +200,8 @@ char *s;
return -1;
}
-int constant(name, arg)
+static double
+constant(name, arg)
char *name;
int arg;
{
@@ -1066,7 +1180,7 @@ int arg;
#endif
break;
case 'N':
- if (strEQ(name, "NULL")) return NULL;
+ if (strEQ(name, "NULL")) return 0;
if (strEQ(name, "NAME_MAX"))
#ifdef NAME_MAX
return NAME_MAX;
@@ -2040,7 +2154,7 @@ new(packname = "POSIX::SigSet", ...)
int i;
RETVAL = (sigset_t*)safemalloc(sizeof(sigset_t));
sigemptyset(RETVAL);
- for (i = 2; i <= items; i++)
+ for (i = 1; i < items; i++)
sigaddset(RETVAL, SvIV(ST(i)));
}
OUTPUT:
@@ -2050,7 +2164,7 @@ void
DESTROY(sigset)
POSIX::SigSet sigset
CODE:
- safefree(sigset);
+ safefree((char *)sigset);
SysRet
sigaddset(sigset, sig)
@@ -2076,9 +2190,252 @@ sigismember(sigset, sig)
int sig
-MODULE = POSIX PACKAGE = POSIX
+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
@@ -2219,11 +2576,12 @@ SysRet
open(filename, flags = O_RDONLY, mode = 0666)
char * filename
int flags
- int mode
+ Mode_t mode
HV *
localeconv()
CODE:
+#ifdef HAS_LOCALECONV
struct lconv *lcbuf;
RETVAL = newHV();
if (lcbuf = localeconv()) {
@@ -2284,6 +2642,9 @@ localeconv()
hv_store(RETVAL, "n_sign_posn", 11,
newSViv(lcbuf->n_sign_posn), 0);
}
+#else
+ localeconv(); /* A stub to call not_here(). */
+#endif
OUTPUT:
RETVAL
@@ -2326,7 +2687,6 @@ 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)));
@@ -2345,7 +2705,6 @@ 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)));
@@ -2401,7 +2760,9 @@ sigaction(sig, action, oldaction = 0)
/* 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));
+ unsigned long tmp;
+ tmp = (unsigned long)SvNV((SV*)SvRV(*svp));
+ sigset = (sigset_t*) tmp;
act.sa_mask = *sigset;
}
else
@@ -2419,12 +2780,17 @@ sigaction(sig, action, oldaction = 0)
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"))
- sigset = (sigset_t*)(unsigned long)SvNV((SV*)SvRV(*svp));
+ 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");
@@ -2453,21 +2819,6 @@ 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
@@ -2486,7 +2837,7 @@ dup2(fd1, fd2)
int fd2
SysRet
-lseek()
+lseek(fd, offset, whence)
int fd
Off_t offset
int whence
@@ -2499,7 +2850,6 @@ int
pipe()
PPCODE:
int fds[2];
- sp--;
if (pipe(fds) != -1) {
EXTEND(sp,2);
PUSHs(sv_2mortal(newSViv(fds[0])));
@@ -2507,16 +2857,18 @@ pipe()
}
SysRet
-read()
- CODE:
- int fd;
- char * buffer;
- size_t nbytes;
-
- RETVAL = read(fd, buffer, nbytes);
- croak("POSIX::read() not implemented yet\n");
- OUTPUT:
- RETVAL
+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)
@@ -2546,8 +2898,8 @@ tcsetpgrp(fd, pgrp_id)
int
uname()
PPCODE:
+#ifdef HAS_UNAME
struct utsname buf;
- sp--;
if (uname(&buf) >= 0) {
EXTEND(sp, 5);
PUSHs(sv_2mortal(newSVpv(buf.sysname, 0)));
@@ -2556,15 +2908,241 @@ uname()
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()
+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:
- int fd;
- char * buffer;
- size_t nbytes;
+ {
+ 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
- RETVAL = write(fd, buffer, nbytes);
- croak("POSIX::write() not implemented yet\n");
+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 0000000000..45e0862ff0
--- /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 a80a650d7b..0000000000
--- 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 0000000000..1f181e3b09
--- /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 0000000000..1f93e52893
--- /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 0000000000..97f9c1f9f4
--- /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
index f7296d1b3a..f7296d1b3a 100644
--- a/ext/dbm/sdbm/CHANGES
+++ b/ext/SDBM_File/sdbm/CHANGES
diff --git a/ext/dbm/sdbm/COMPARE b/ext/SDBM_File/sdbm/COMPARE
index a595e831d2..a595e831d2 100644
--- a/ext/dbm/sdbm/COMPARE
+++ b/ext/SDBM_File/sdbm/COMPARE
diff --git a/ext/dbm/sdbm/Makefile.SH b/ext/SDBM_File/sdbm/Makefile.SH
index 9a19fa2ed5..521c97270a 100644
--- a/ext/dbm/sdbm/Makefile.SH
+++ b/ext/SDBM_File/sdbm/Makefile.SH
@@ -1,3 +1,10 @@
+: 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=../..;
@@ -6,19 +13,18 @@ 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
-: 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)"
+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
@@ -33,16 +39,23 @@ $spitshell >Makefile <<!GROK!THIS!
#
#
CC = $cc
-ranlib = $ranlib
+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.
+# To use an alternate make, set \$altmake in config.sh.
MAKE = ${altmake-make}
+# The following are used to build and install shared libraries for
+# dynamic loading.
+LDDLFLAGS = $lddlflags
+CCDLFLAGS = $ccdlflags
+CCCDLFLAGS = $cccdlflags
+
!GROK!THIS!
: In the following dollars and backticks do not need the extra backslash.
@@ -51,15 +64,17 @@ SHELL = /bin/sh
CCCMD = `sh $(shellflags) $(TOP)/cflags $@`
.c.o:
- $(CCCMD) -I$(TOP) -DSDBM -DDUFF $*.c
+ $(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
+ $(RANLIB) libsdbm.a
$(LIBOBJS): $(HDRS)
@@ -75,6 +90,10 @@ realclean: clean
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
index cd7312cc57..cd7312cc57 100644
--- a/ext/dbm/sdbm/README
+++ b/ext/SDBM_File/sdbm/README
diff --git a/ext/dbm/sdbm/README.too b/ext/SDBM_File/sdbm/README.too
index c2d095944d..c2d095944d 100644
--- a/ext/dbm/sdbm/README.too
+++ b/ext/SDBM_File/sdbm/README.too
diff --git a/ext/dbm/sdbm/biblio b/ext/SDBM_File/sdbm/biblio
index 0be09fa005..0be09fa005 100644
--- a/ext/dbm/sdbm/biblio
+++ b/ext/SDBM_File/sdbm/biblio
diff --git a/ext/dbm/sdbm/dba.c b/ext/SDBM_File/sdbm/dba.c
index 4f227e5245..4f227e5245 100644
--- a/ext/dbm/sdbm/dba.c
+++ b/ext/SDBM_File/sdbm/dba.c
diff --git a/ext/dbm/sdbm/dbd.c b/ext/SDBM_File/sdbm/dbd.c
index 697a547597..697a547597 100644
--- a/ext/dbm/sdbm/dbd.c
+++ b/ext/SDBM_File/sdbm/dbd.c
diff --git a/ext/dbm/sdbm/dbe.1 b/ext/SDBM_File/sdbm/dbe.1
index 3b32272684..3b32272684 100644
--- a/ext/dbm/sdbm/dbe.1
+++ b/ext/SDBM_File/sdbm/dbe.1
diff --git a/ext/dbm/sdbm/dbe.c b/ext/SDBM_File/sdbm/dbe.c
index 2a306f276e..2a306f276e 100644
--- a/ext/dbm/sdbm/dbe.c
+++ b/ext/SDBM_File/sdbm/dbe.c
diff --git a/ext/dbm/sdbm/dbm.c b/ext/SDBM_File/sdbm/dbm.c
index 1388230e2d..1388230e2d 100644
--- a/ext/dbm/sdbm/dbm.c
+++ b/ext/SDBM_File/sdbm/dbm.c
diff --git a/ext/dbm/sdbm/dbm.h b/ext/SDBM_File/sdbm/dbm.h
index 1196953d96..1196953d96 100644
--- a/ext/dbm/sdbm/dbm.h
+++ b/ext/SDBM_File/sdbm/dbm.h
diff --git a/ext/dbm/sdbm/dbu.c b/ext/SDBM_File/sdbm/dbu.c
index 106262872e..106262872e 100644
--- a/ext/dbm/sdbm/dbu.c
+++ b/ext/SDBM_File/sdbm/dbu.c
diff --git a/ext/dbm/sdbm/grind b/ext/SDBM_File/sdbm/grind
index 23728b7d49..23728b7d49 100755
--- a/ext/dbm/sdbm/grind
+++ b/ext/SDBM_File/sdbm/grind
diff --git a/ext/dbm/sdbm/hash.c b/ext/SDBM_File/sdbm/hash.c
index eb585ac102..eb585ac102 100644
--- a/ext/dbm/sdbm/hash.c
+++ b/ext/SDBM_File/sdbm/hash.c
diff --git a/ext/dbm/sdbm/linux.patches b/ext/SDBM_File/sdbm/linux.patches
index cb7b1b7d8e..cb7b1b7d8e 100644
--- a/ext/dbm/sdbm/linux.patches
+++ b/ext/SDBM_File/sdbm/linux.patches
diff --git a/ext/dbm/sdbm/makefile.sdbm b/ext/SDBM_File/sdbm/makefile.sdbm
index c959c1fab5..c959c1fab5 100644
--- a/ext/dbm/sdbm/makefile.sdbm
+++ b/ext/SDBM_File/sdbm/makefile.sdbm
diff --git a/ext/dbm/sdbm/pair.c b/ext/SDBM_File/sdbm/pair.c
index 575b34c6c1..a02c73f28f 100644
--- a/ext/dbm/sdbm/pair.c
+++ b/ext/SDBM_File/sdbm/pair.c
@@ -193,6 +193,8 @@ datum key;
}
#else
#ifdef HAS_MEMMOVE
+ dst -= m;
+ src -= m;
memmove(dst, src, m);
#else
while (m--)
diff --git a/ext/dbm/sdbm/pair.h b/ext/SDBM_File/sdbm/pair.h
index bd66d02fd2..bd66d02fd2 100644
--- a/ext/dbm/sdbm/pair.h
+++ b/ext/SDBM_File/sdbm/pair.h
diff --git a/ext/dbm/sdbm/readme.ms b/ext/SDBM_File/sdbm/readme.ms
index 01ca17ccdf..01ca17ccdf 100644
--- a/ext/dbm/sdbm/readme.ms
+++ b/ext/SDBM_File/sdbm/readme.ms
diff --git a/ext/dbm/sdbm/readme.ps b/ext/SDBM_File/sdbm/readme.ps
index 2b0c675595..2b0c675595 100644
--- a/ext/dbm/sdbm/readme.ps
+++ b/ext/SDBM_File/sdbm/readme.ps
diff --git a/ext/dbm/sdbm/sdbm.3 b/ext/SDBM_File/sdbm/sdbm.3
index f0f2d07c84..f0f2d07c84 100644
--- a/ext/dbm/sdbm/sdbm.3
+++ b/ext/SDBM_File/sdbm/sdbm.3
diff --git a/ext/dbm/sdbm/sdbm.c b/ext/SDBM_File/sdbm/sdbm.c
index d09adccdd3..d09adccdd3 100644
--- a/ext/dbm/sdbm/sdbm.c
+++ b/ext/SDBM_File/sdbm/sdbm.c
diff --git a/ext/dbm/sdbm/sdbm.h b/ext/SDBM_File/sdbm/sdbm.h
index f94b054999..927e2c2e30 100644
--- a/ext/dbm/sdbm/sdbm.h
+++ b/ext/SDBM_File/sdbm/sdbm.h
@@ -123,12 +123,6 @@ extern long sdbm_hash proto((char *, int));
# define STANDARD_C 1
#endif
-#if defined(STANDARD_C)
-# define P(args) args
-#else
-# define P(args) ()
-#endif
-
#include <stdio.h>
#include <ctype.h>
#include <setjmp.h>
@@ -150,10 +144,6 @@ extern long sdbm_hash proto((char *, int));
# endif
#endif
-#ifdef I_UNISTD
-#include <unistd.h>
-#endif
-
#include <sys/stat.h>
#ifndef SEEK_SET
@@ -167,25 +157,28 @@ extern long sdbm_hash proto((char *, int));
/* Use all the "standard" definitions? */
#ifdef STANDARD_C
# include <stdlib.h>
-# ifdef I_STRING
-# include <string.h>
-# endif
-# define MEM_SIZE size_t
-#else
-# ifdef I_MEMORY
-# include <memory.h>
-# endif
- typedef unsigned int MEM_SIZE;
#endif /* STANDARD_C */
-#if defined(HAS_MEMCMP) && defined(mips) && defined(ultrix)
+#define MEM_SIZE Size_t
+
+#ifdef I_STRING
+#include <string.h>
+#else
+#include <strings.h>
+#endif
+
+#ifdef I_MEMORY
+#include <memory.h>
+#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 P((char*, char*, int));
+ extern char * memcpy _((char*, char*, int));
# endif
# endif
#else
@@ -201,7 +194,7 @@ extern long sdbm_hash proto((char *, int));
#ifdef HAS_MEMSET
# if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
# ifndef memset
- extern char *memset P((char*, int, int));
+ extern char *memset _((char*, int, int));
# endif
# endif
# define memzero(d,l) memset(d,0,l)
@@ -218,7 +211,7 @@ extern long sdbm_hash proto((char *, int));
#ifdef HAS_MEMCMP
# if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
# ifndef memcmp
- extern int memcmp P((char*, char*, int));
+ extern int memcmp _((char*, char*, int));
# endif
# endif
#else
diff --git a/ext/dbm/sdbm/tune.h b/ext/SDBM_File/sdbm/tune.h
index b95c8c8634..b95c8c8634 100644
--- a/ext/dbm/sdbm/tune.h
+++ b/ext/SDBM_File/sdbm/tune.h
diff --git a/ext/dbm/sdbm/util.c b/ext/SDBM_File/sdbm/util.c
index 4b03d89f09..4b03d89f09 100644
--- a/ext/dbm/sdbm/util.c
+++ b/ext/SDBM_File/sdbm/util.c
diff --git a/ext/SDBM_File/typemap b/ext/SDBM_File/typemap
new file mode 100644
index 0000000000..a6b0e5faa8
--- /dev/null
+++ b/ext/SDBM_File/typemap
@@ -0,0 +1,25 @@
+#
+#################################### DBM SECTION
+#
+
+datum T_DATUM
+gdatum T_GDATUM
+NDBM_File T_PTROBJ
+GDBM_File T_PTROBJ
+SDBM_File T_PTROBJ
+ODBM_File T_PTROBJ
+DB_File T_PTROBJ
+DBZ_File T_PTROBJ
+FATALFUNC T_OPAQUEPTR
+
+INPUT
+T_DATUM
+ $var.dptr = SvPV($arg, na);
+ $var.dsize = (int)na;
+T_GDATUM
+ UNIMPLEMENTED
+OUTPUT
+T_DATUM
+ sv_setpvn($arg, $var.dptr, $var.dsize);
+T_GDATUM
+ sv_usepvn($arg, $var.dptr, $var.dsize);
diff --git a/ext/Socket/Makefile.SH b/ext/Socket/Makefile.SH
new file mode 100644
index 0000000000..064228e512
--- /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 0000000000..a05c0a0a0c
--- /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 0000000000..7a0bf465b2
--- /dev/null
+++ b/ext/Socket/Socket.xs
@@ -0,0 +1,565 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#include <sys/socket.h>
+
+#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 107702f303..0000000000
--- 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 7129418ab6..0000000000
--- 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 <curses.h>
-
-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 35510f4da7..0000000000
--- 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 <curses.h>
-
-#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 407bc50670..0000000000
--- 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 f940a594cc..0000000000
--- a/ext/dbm/GDBM_File.c
+++ /dev/null
@@ -1,310 +0,0 @@
-#include "EXTERN.h"
-#include "perl.h"
-#include "XSUB.h"
-#include <gdbm.h>
-
-#include <fcntl.h>
-
-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 2c619cbe42..0000000000
--- a/ext/dbm/GDBM_File.xs
+++ /dev/null
@@ -1,76 +0,0 @@
-#include "EXTERN.h"
-#include "perl.h"
-#include "XSUB.h"
-#include <gdbm.h>
-
-#include <fcntl.h>
-
-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 03b86c5739..0000000000
--- a/ext/dbm/GDBM_File.xs.bak
+++ /dev/null
@@ -1,122 +0,0 @@
-#include "EXTERN.h"
-#include "perl.h"
-#include "XSUB.h"
-#include <gdbm.h>
-
-#include <fcntl.h>
-
-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 970724dd2a..0000000000
--- 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 b321ac4252..0000000000
--- a/ext/dbm/NDBM_File.c
+++ /dev/null
@@ -1,267 +0,0 @@
-#include "EXTERN.h"
-#include "perl.h"
-#include "XSUB.h"
-#include <ndbm.h>
-
-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 5f4f78b974..0000000000
--- a/ext/dbm/NDBM_File.xs
+++ /dev/null
@@ -1,58 +0,0 @@
-#include "EXTERN.h"
-#include "perl.h"
-#include "XSUB.h"
-#include <ndbm.h>
-
-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 1aea2cec53..0000000000
--- 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 <dbm.h>
-
-#include <fcntl.h>
-
-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/SDBM_File.c b/ext/dbm/SDBM_File.c
deleted file mode 100644
index e69de29bb2..0000000000
--- a/ext/dbm/SDBM_File.c
+++ /dev/null
diff --git a/ext/dbm/SDBM_File.c.bak b/ext/dbm/SDBM_File.c.bak
deleted file mode 100644
index 06fedb383d..0000000000
--- 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 87f4749b2c..0000000000
--- a/ext/dbm/SDBM_File.so
+++ /dev/null
Binary files differ
diff --git a/ext/dbm/SDBM_File.xs b/ext/dbm/SDBM_File.xs
deleted file mode 100644
index 25cb67c1fc..0000000000
--- 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 899dc46edb..0000000000
--- 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 e69de29bb2..0000000000
--- a/ext/dbm/sdbm/.pure
+++ /dev/null
diff --git a/ext/dbm/sdbm/.r b/ext/dbm/sdbm/.r
deleted file mode 100755
index c72dbf15f5..0000000000
--- 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 <history
-X
-Xreal 5:56.9
-Xuser 13.3
-Xsys 26.3
-X% ls -s
-Xtotal 14251
-X 5 README 2 dbd.c 1 hash.c 1 pair.h
-X 0 SCRIPT 5 dbd.o 1 hash.o 5 pair.o
-X 1 WISHLIST 62 dbm 3130 history 1 port.h
-X 46 dba 5 dbm.c 11 howtodbm.txt 11 sdbm.c
-X 3 dba.c 8 dbm.o 14 libsdbm.a 2 sdbm.h
-X 6 dba.o 4 foo.dir 1 makefile 8 sdbm.o
-X 46 dbd 10810 foo.pag 6 pair.c 60 x-dbm
-X% ls -l foo.*
-X-rw-r--r-- 1 oz 4096 Sep 28 15:48 foo.dir
-X-rw-r--r-- 1 oz 11069440 Sep 28 15:48 foo.pag
-X%
-X% /bin/time x-dbm build bar <history
-X
-Xreal 5:59.4
-Xuser 24.7
-Xsys 29.1
-X%
-X% ls -s
-Xtotal 27612
-X 5 README 46 dbd 1 hash.c 5 pair.o
-X 1 SCRIPT 2 dbd.c 1 hash.o 1 port.h
-X 1 WISHLIST 5 dbd.o 3130 history 11 sdbm.c
-X 4 bar.dir 62 dbm 11 howtodbm.txt 2 sdbm.h
-X13356 bar.pag 5 dbm.c 14 libsdbm.a 8 sdbm.o
-X 46 dba 8 dbm.o 1 makefile 60 x-dbm
-X 3 dba.c 4 foo.dir 6 pair.c
-X 6 dba.o 10810 foo.pag 1 pair.h
-X%
-X% ls -l bar.*
-X-rw-r--r-- 1 oz 4096 Sep 28 15:54 bar.dir
-X-rw-r--r-- 1 oz 13676544 Sep 28 15:54 bar.pag
-X%
-X% dba foo | tail
-X#10801: ok. no entries.
-X#10802: ok. no entries.
-X#10803: ok. no entries.
-X#10804: ok. no entries.
-X#10805: ok. no entries.
-X#10806: ok. no entries.
-X#10807: ok. no entries.
-X#10808: ok. no entries.
-X#10809: ok. 11 entries 67% used free 337.
-X10810 pages (6036 holes): 65073 entries
-X%
-X% dba bar | tail
-X#13347: ok. no entries.
-X#13348: ok. no entries.
-X#13349: ok. no entries.
-X#13350: ok. no entries.
-X#13351: ok. no entries.
-X#13352: ok. no entries.
-X#13353: ok. no entries.
-X#13354: ok. no entries.
-X#13355: ok. 7 entries 33% used free 676.
-X13356 pages (8643 holes): 65073 entries
-X%
-X% exit
-Xscript done on Thu Sep 28 16:08:45 1989
-X
-END_OF_FILE
-if test 2832 -ne `wc -c <'COMPARE'`; then
- echo shar: \"'COMPARE'\" unpacked with wrong size!
-fi
-# end of 'COMPARE'
-fi
-if test -f 'README' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'README'\"
-else
-echo shar: Extracting \"'README'\" \(11457 characters\)
-sed "s/^X//" >'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 <build|creat|look|insert|cat|delete> 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 <stdio.h>
-X#include <sys/file.h>
-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 <stdio.h>
-X#include <sys/file.h>
-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 <database> [-m r|w|rw] [-crtvx] -a|-d|-f|-F|-s [<key> [<content>]]
-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 <stdio.h>
-X#ifndef VMS
-X#include <sys/file.h>
-X#include <ndbm.h>
-X#else
-X#include "file.h"
-X#include "ndbm.h"
-X#endif
-X#include <ctype.h>
-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 <ndbm.h>
-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 <stdio.h>
-X#include <sys/file.h>
-X#ifdef SDBM
-X#include "sdbm.h"
-X#else
-X#include <ndbm.h>
-X#endif
-X#include <string.h>
-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 <memory.h>
-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.\" <text>\*f for a footnote number..
-X.\" .FS
-X.\" \*F <footnote text>
-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 <build|creat|look|insert|cat|delete> 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(<build|creat|look|insert|cat|delete>)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 <sdbm.h>
-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 <key,value> 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 <sys/types.h>
-X#include <sys/stat.h>
-X#ifdef BSD42
-X#include <sys/file.h>
-X#else
-X#include <fcntl.h>
-X#include <memory.h>
-X#endif
-X#include <errno.h>
-X#include <string.h>
-X
-X#ifdef __STDC__
-X#include <stddef.h>
-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 <unistd.h>
-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 <stdio.h>
-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 80b09cd37b..0000000000
--- 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/libsdbm.a b/ext/dbm/sdbm/libsdbm.a
deleted file mode 100644
index baf4b73942..0000000000
--- a/ext/dbm/sdbm/libsdbm.a
+++ /dev/null
Binary files 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 3b426e8154..0000000000
--- a/ext/dbm/sdbm/libsdbm_pure_q552_110.a
+++ /dev/null
Binary files differ
diff --git a/ext/dbm/sdbm/makefile b/ext/dbm/sdbm/makefile
deleted file mode 100644
index c959c1fab5..0000000000
--- 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/dl/dl.c b/ext/dl/dl.c
deleted file mode 100644
index d514f81897..0000000000
--- a/ext/dl/dl.c
+++ /dev/null
@@ -1,54 +0,0 @@
-#include <dlfcn.h>
-
-#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 57adcc6188..0000000000
--- a/ext/dl/dl_hpux.c
+++ /dev/null
@@ -1,71 +0,0 @@
-/*
-Date: Mon, 25 Apr 94 14:15:30 PDT
-From: Jeff Okamoto <okamoto@hpcc101.corp.hp.com>
-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 <dl.h>
-
-#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 66e95121de..0000000000
--- 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 <mach-o/rld.h>
-#include <streams/streams.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);
- 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 badd66d678..0000000000
--- 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 <dlfcn.h>
-#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 d1ae210730..0000000000
--- 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 435b916f67..0000000000
--- 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 ac0155453e..0000000000
--- a/ext/dl/eg/main.c
+++ /dev/null
@@ -1,28 +0,0 @@
-#include <dlfcn.h>
-#include <stdio.h>
-
-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 2a8b92570e..0000000000
--- a/ext/dl/eg/test
+++ /dev/null
Binary files differ
diff --git a/ext/dl/eg/test.c b/ext/dl/eg/test.c
deleted file mode 100644
index a66db198cf..0000000000
--- 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 e9a37e9e53..0000000000
--- a/ext/dl/eg/test1
+++ /dev/null
Binary files differ
diff --git a/ext/dl/eg/test1.c b/ext/dl/eg/test1.c
deleted file mode 100644
index fc7b1b2cc2..0000000000
--- a/ext/dl/eg/test1.c
+++ /dev/null
@@ -1,11 +0,0 @@
-#include <dlfcn.h>
-
-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 a3046784f4..0000000000
--- 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 b1675fdc58..0000000000
--- 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 <<EOF;
- case US_$funcname:
- if (items != $items)
- fatal("Usage: &$funcname($namelist)");
- else {
-EOF
- if ($rettype eq 'void') {
- print <<EOF;
- int retval = 1;
-EOF
- }
- else {
- print <<EOF;
- $rettype retval;
-EOF
- }
- foreach $i (1..@names) {
- $mode = $modes[$i-1];
- $type = $types[$i-1];
- $name = $names[$i-1];
- if ($type =~ /^[A-Z]+\*$/) {
- $cast = "*($type*)";
- }
- else {
- $cast = "($type)";
- }
- $what = ($type =~ /^(struct\s+\w+|char|[A-Z]+)\s*\*$/ ? "get" : "gnum");
- $type .= "\t" if length($type) < 4;
- $cast .= "\t" if length($cast) < 8;
- $x = "\t" x (length($name) < 6);
- if ($mode =~ /O/) {
- if ($what eq 'gnum') {
- push(@outies, "\t str_numset(st[$i], (double) $name);\n");
- push(@callnames, "&$name");
- }
- else {
- push(@outies, "\t str_set(st[$i], (char*) $name);\n");
- push(@callnames, "$name");
- }
- }
- else {
- push(@callnames, $name);
- }
- if ($mode =~ /I/) {
- print <<EOF;
- $type $name =$x $cast str_$what(st[$i]);
-EOF
- }
- elsif ($type =~ /char/) {
- print <<EOF;
- char ${name}[133];
-EOF
- }
- else {
- print <<EOF;
- $type $name;
-EOF
- }
- }
- $callnames = join(', ', @callnames);
- $outies = join("\n",@outies);
- if ($rettype eq 'void') {
- print <<EOF;
-$pre (void)$funcname($callnames);
-EOF
- }
- else {
- print <<EOF;
-$pre retval = $funcname($callnames);
-EOF
- }
- if ($rettype =~ /^(struct\s+\w+|char)\s*\*$/) {
- print <<EOF;
- str_set(st[0], (char*) retval);
-EOF
- }
- elsif ($rettype =~ /^[A-Z]+\s*\*$/) {
- print <<EOF;
- str_nset(st[0], (char*) &retval, sizeof retval);
-EOF
- }
- else {
- print <<EOF;
- str_numset(st[0], (double) retval);
-EOF
- }
- print $outies if $outies;
- print $post if $post;
- if (/^END/) {
- print "\t}\n\treturn sp;\n";
- }
- else {
- redo;
- }
- }
- elsif (/^END/) {
- print "\t}\n\treturn sp;\n";
- }
- else {
- print;
- }
-}
diff --git a/ext/posix/typemap b/ext/posix/typemap
deleted file mode 100644
index e339f10c49..0000000000
--- 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 1d0c9baef3..98493e7c04 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 fc93718b93..0000000000
--- 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 b04d13048a..0000000000
--- 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 d1312767f5..0000000000
--- 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 0000000000..2b8938fa4d
--- /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 0000000000..fba77c0c9f
--- /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 0000000000..6c3a7e10ed
--- /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 bb6972008b..1e13118ad5 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 (<F>) {
- 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 (<F>) {
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 (<F>) {
- 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<<EOF if $except;
# if (errbuf[0])
# croak(errbuf);
EOF
+
+ print Q<<EOF unless $PPCODE;
+# XSRETURN(1);
+EOF
+
print Q<<EOF;
-# return ax;
#]]
#
EOF
@@ -397,24 +432,32 @@ EOF
# print initialization routine
print qq/extern "C"\n/ if $cplusplus;
print Q<<"EOF";
-#int boot_$Module(ix,ax,items)
-#int ix;
-#int ax;
-#int items;
+#XS(boot_$Module_cname)
#[[
+# dXSARGS;
# char* file = __FILE__;
#
EOF
for (@Func_name) {
$pname = shift(@Func_pname);
- print " newXSUB(\"$pname\", 0, XS_$_, file);\n";
+ print " newXS(\"$pname\", XS_$_, file);\n";
+}
+
+if (@BootCode)
+{
+ print "\n /* Initialisation Section */\n\n" ;
+ print grep (s/$/\n/, @BootCode) ;
+ print " /* End of Initialisation Section */\n\n" ;
}
+
+print " ST(0) = &sv_yes;\n";
+print " XSRETURN(1);\n";
print "}\n";
sub output_init {
local($type, $num, $init) = @_;
- local($arg) = "ST($num)";
+ local($arg) = "ST(" . ($num - 1) . ")";
eval qq/print " $init\\\n"/;
}
@@ -423,7 +466,7 @@ sub blurt { warn @_; $errors++ }
sub generate_init {
local($type, $num, $var) = @_;
- local($arg) = "ST($num)";
+ local($arg) = "ST(" . ($num - 1) . ")";
local($argoff) = $num - 1;
local($ntype);
local($tk);
@@ -443,7 +486,7 @@ sub generate_init {
$subexpr =~ s/\$arg/ST(ix_$var)/g;
$subexpr =~ s/\n\t/\n\t\t/g;
$subexpr =~ s/is not of (.*")/[arg %d] is not of $1, ix_$var + 1/g;
- $subexpr =~ s/\$var/$var[ix_$var - $argoff]/;
+ $subexpr =~ s/\$var/${var}[ix_$var - $argoff]/;
$expr =~ s/DO_ARRAY_ELEM/$subexpr/;
}
if (defined($defaults{$var})) {
@@ -461,7 +504,7 @@ sub generate_init {
sub generate_output {
local($type, $num, $var) = @_;
- local($arg) = "ST($num)";
+ local($arg) = "ST(" . ($num - ($num != 0)) . ")";
local($argoff) = $num - 1;
local($ntype);
@@ -483,18 +526,27 @@ sub generate_output {
$subexpr =~ s/\$var/${var}[ix_$var]/g;
$subexpr =~ s/\n\t/\n\t\t/g;
$expr =~ s/DO_ARRAY_ELEM\n/$subexpr/;
- eval "print qq\f$expr\f";
+ eval "print qq\a$expr\a";
}
- elsif ($arg eq 'ST(0)') {
+ elsif ($var eq 'RETVAL') {
if ($expr =~ /^\t\$arg = /) {
- eval "print qq\f$expr\f";
+ eval "print qq\a$expr\a";
print "\tsv_2mortal(ST(0));\n";
}
else {
print "\tST(0) = sv_newmortal();\n";
- eval "print qq\f$expr\f";
+ eval "print qq\a$expr\a";
}
}
+ elsif ($arg =~ /^ST\(\d+\)$/) {
+ eval "print qq\a$expr\a";
+ }
+ elsif ($arg =~ /^ST\(\d+\)$/) {
+ eval "print qq\a$expr\a";
+ }
+ elsif ($arg =~ /^ST\(\d+\)$/) {
+ eval "print qq\a$expr\a";
+ }
}
}
@@ -510,3 +562,55 @@ sub map_type {
}
exit $errors;
+
+##############################################################################
+
+ # 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 XSUBPP 1 "August 9, 1994"
+.AT 3
+.SH NAME
+xsubpp \- compiler to convert Perl XS code into C code
+.SH SYNOPSIS
+.B xsubpp [-C++] [-except] [-typemap typemap] file.xs
+.SH DESCRIPTION
+.I xsubpp
+will compile XS code into C code by embedding the constructs necessary to
+let C functions manipulate Perl values and creates the glue necessary to let
+Perl access those functions. The compiler uses typemaps to determine how
+to map C function parameters and variables to Perl values.
+.PP
+The compiler will search for typemap files called
+.I typemap.
+It will use the following search path to find default typemaps, with the
+rightmost typemap taking precedence.
+.br
+.nf
+ ../../../typemap:../../typemap:../typemap:typemap
+.fi
+.SH OPTIONS
+.TP
+.B \-C++
+.br
+Adds ``extern "C"'' to the C code.
+.TP
+.B \-except
+Adds exception handling stubs to the C code.
+.TP
+.B \-typemap typemap
+Indicates that a user-supplied typemap should take precedence over the
+default typemaps. This option may be used multiple times, with the last
+typemap having the highest precedence.
+.SH ENVIRONMENT
+No environment variables are used.
+.SH AUTHOR
+Larry Wall
+.SH "SEE ALSO"
+perl(1)
+.ex
diff --git a/ext/xsubpp.bak b/ext/xsubpp.bak
deleted file mode 100755
index 0f309e3cd2..0000000000
--- a/ext/xsubpp.bak
+++ /dev/null
@@ -1,529 +0,0 @@
-#!/usr/bin/perl
-# $Header$
-
-$usage = "Usage: xsubpp [-a] [-s] [-c] typemap file.xs\n";
-die $usage unless (@ARGV >= 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 (<TYPEMAP>) {
- 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 (<F>) {
- 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 (<F>) {
- # 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 <<EOF if $eflag;
- }
- BEGHANDLERS
- CATCHALL
- croak("%s: %s\\tpropagated", Xname, Xreason);
- ENDHANDLERS
-EOF
- print <<EOF if !$eflag;
- }
-EOF
- if (/^\s*CASE\s*:/) {
- unshift(@_, $_);
- }
-}
- print <<EOF;
- return sp;
-}
-
-EOF
-}
-
-# print initialization routine
-print qq/extern "C"\n/ if $cflag;
-print <<"EOF";
-int init_$Module(ix,sp,items)
-int ix;
-int sp;
-int items;
-{
- char* file = __FILE__;
-
-EOF
-
-for (@Func_name) {
- $pname = shift(@Func_pname);
- print " newXSUB(\"$pname\", 0, XS_$_, file);\n";
-}
-print "}\n";
-
-sub output_init {
- local($type, $num, $init) = @_;
- local($arg) = "ST($num)";
-
- eval qq/print " $init\\\n"/;
-}
-
-sub generate_init {
- local($type, $num, $var) = @_;
- local($arg) = "ST($num)";
- local($argoff) = $num - 1;
- local($ntype);
-
- die "$type not in typemap" if !defined($type_kind{$type});
- ($ntype = $type) =~ s/\s*\*/Ptr/g;
- $subtype = $ntype;
- $subtype =~ s/Ptr$//;
- $subtype =~ s/Array$//;
- $expr = $input_expr{$type_kind{$type}};
- if ($expr =~ /DO_ARRAY_ELEM/) {
- $subexpr = $input_expr{$type_kind{$subtype}};
- $subexpr =~ s/ntype/subtype/g;
- $subexpr =~ s/\$arg/ST(ix_$var)/g;
- $subexpr =~ s/\n\t/\n\t\t/g;
- $subexpr =~ s/is not of (.*")/[arg %d] is not of $1, ix_$var + 1/g;
- $subexpr =~ s/\$var/$var[ix_$var - $argoff]/;
- $expr =~ s/DO_ARRAY_ELEM/$subexpr/;
- }
- if (defined($defaults{$var})) {
- $expr =~ s/(\t+)/$1 /g;
- $expr =~ s/ /\t/g;
- eval qq/print "\\t$var;\\n"/;
- $deferred .= eval qq/"\\n\\tif (items < $num)\\n\\t $var = $defaults{$var};\\n\\telse {\\n$expr;\\n\\t}\\n"/;
- } elsif ($expr !~ /^\t\$var =/) {
- eval qq/print "\\t$var;\\n"/;
- $deferred .= eval qq/"\\n$expr;\\n"/;
- } else {
- eval qq/print "$expr;\\n"/;
- }
-}
-
-sub generate_output {
- local($type, $num, $var) = @_;
- local($arg) = "ST($num)";
- local($argoff) = $num - 1;
- local($ntype);
-
- if ($type =~ /^array\(([^,]*),(.*)\)/) {
- print "\tsv_setpvn($arg, (char *)$var, $2 * sizeof($1)), XFree((char *)$var);\n";
- } else {
- die "$type not in typemap" if !defined($type_kind{$type});
- ($ntype = $type) =~ s/\s*\*/Ptr/g;
- $ntype =~ s/\(\)//g;
- $subtype = $ntype;
- $subtype =~ s/Ptr$//;
- $subtype =~ s/Array$//;
- $expr = $output_expr{$type_kind{$type}};
- if ($expr =~ /DO_ARRAY_ELEM/) {
- $subexpr = $output_expr{$type_kind{$subtype}};
- $subexpr =~ s/ntype/subtype/g;
- $subexpr =~ s/\$arg/ST(ix_$var)/g;
- $subexpr =~ s/\$var/${var}[ix_$var]/g;
- $subexpr =~ s/\n\t/\n\t\t/g;
- $expr =~ s/DO_ARRAY_ELEM\n/$subexpr/;
- }
- elsif ($arg eq 'ST(0)') {
- print "\tST(0) = sv_mortalcopy(&sv_undef);\n";
- }
- eval "print qq\f$expr\f";
- }
-}
-
-sub map_type {
- local($type) = @_;
-
- if ($type =~ /^array\(([^,]*),(.*)\)/) {
- return "$1 *";
- } else {
- return $type;
- }
-}
diff --git a/ext/xvarpp b/ext/xvarpp
deleted file mode 100755
index cdb2bd0388..0000000000
--- a/ext/xvarpp
+++ /dev/null
@@ -1,161 +0,0 @@
-#!/usr/bin/perl
-# $Header$
-
-$usage = "Usage: xvar [-a] [-c] typemap file.xv\n";
-die $usage unless (@ARGV >= 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 (<TYPEMAP>) {
- 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 (<F>) {
- 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 <<EOF;
-static struct varinfo varinfo [] = {
-EOF
-
-while (<F>) {
- 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 <<EOF if $aflag;
-};
-
-static unsigned long varinfolen = sizeof(varinfo)/sizeof(*varinfo);
-
-static int UV_val(int ix, SV *sv)
-{
- return common_UV_val(varinfo, varinfolen, ix, sv);
-}
-
-static int UV_set(int ix, SV *sv)
-{
- return common_UV_set(varinfo, varinfolen, ix, sv);
-}
-EOF
-print <<EOF if !$aflag;
-};
-
-static unsigned long varinfolen = sizeof(varinfo)/sizeof(*varinfo);
-
-static int UV_val(ix, sv)
-int ix;
-SV *sv;
-{
- return common_UV_val(varinfo, varinfolen, ix, sv);
-}
-
-static int UV_set(ix, sv)
-int ix;
-SV *sv;
-{
- return common_UV_set(varinfo, varinfolen, ix, sv);
-}
-
-EOF
-print qq/extern "C"\n/ if $cflag;
-print <<EOF;
-void init_$Module()
-{
- int i;
- struct ufuncs uf;
-
- uf.uf_set = UV_set;
- uf.uf_val = UV_val;
- for (i = 0; i < varinfolen; i++) {
- uf.uf_index = i;
- magicname(varinfo[i].vname, (char *)&uf, sizeof uf);
- }
-}
-
-EOF