perl5.005_03 (stock)

6 files changed, 125 insertions, 114 deletions

diff --git a/gnu/usr.bin/perl/ext/SDBM_File/Makefile.PL b/gnu/usr.bin/perl/ext/SDBM_File/Makefile.PL
index 02dfd7d84ff..749478551fe 100644
--- a/gnu/usr.bin/perl/ext/SDBM_File/Makefile.PL
+++ b/gnu/usr.bin/perl/ext/SDBM_File/Makefile.PL
@@ -6,21 +6,30 @@ use ExtUtils::MakeMaker;
 # which perform the corresponding actions in the subdirectory.
 
 $define = ($^O eq 'MSWin32') ? '-DMSDOS' : '';
+if ($^O eq 'MSWin32') { $myextlib = 'sdbm\\libsdbm$(LIB_EXT)'; }
+else                  { $myextlib = 'sdbm/libsdbm$(LIB_EXT)';  }
 
 WriteMakefile(
-    NAME	=> 'SDBM_File',
-    MYEXTLIB => 'sdbm'.($^O eq 'MSWin32' ? '\\' : '/').'libsdbm$(LIB_EXT)',
-    MAN3PODS 	=> ' ', 	# Pods will be built by installman.
-    XSPROTOARG => '-noprototypes', 		# XXX remove later?
-    VERSION_FROM => 'SDBM_File.pm',
-    DEFINE => $define,
-);
-
+              NAME	=> 'SDBM_File',
+              MYEXTLIB => $myextlib,
+              MAN3PODS 	=> {}, 	# Pods will be built by installman.
+              XSPROTOARG => '-noprototypes', 		# XXX remove later?
+              VERSION_FROM => 'SDBM_File.pm',
+              DEFINE => $define,
+             );
 
 sub MY::postamble {
+  if ($^O ne 'VMS') {
     '
 $(MYEXTLIB): sdbm/Makefile
 	cd sdbm && $(MAKE) all
 ';
+  } else {
+  '   
+$(MYEXTLIB) : [.sdbm]descrip.mms
+	set def [.sdbm]
+    $(MMS) all
+    set def [-]
+';  
+  }
 }
-
diff --git a/gnu/usr.bin/perl/ext/SDBM_File/sdbm/Makefile.PL b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/Makefile.PL
index 50fd83eb253..e6fdcf93069 100644
--- a/gnu/usr.bin/perl/ext/SDBM_File/sdbm/Makefile.PL
+++ b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/Makefile.PL
@@ -1,33 +1,65 @@
 use ExtUtils::MakeMaker;
 
 $define = '-DSDBM -DDUFF';
-$define .= ' -DWIN32' if ($^O eq 'MSWin32');
+$define .= ' -DWIN32 -DPERL_STATIC_SYMS' if ($^O eq 'MSWin32');
+
+if ($^O eq 'VMS') {  # Old VAXC compiler can't handle Duff's device
+    require Config;
+    $define =~ s/\s+-DDUFF// if $Config::Config{'vms_cc_type'} eq 'vaxc';
+}
 
 WriteMakefile(
     NAME      => 'sdbm', # (doesn't matter what the name is here) oh yes it does
-    LINKTYPE  => 'static',
+#    LINKTYPE  => 'static',
     DEFINE    => $define,
     INC       => '-I$(PERL_INC)', # force PERL_INC dir ahead of system -I's
-    SKIP      => [qw(dynamic dynamic_lib)],
+    INST_ARCHLIB => '.',
+    SKIP      => [qw(dynamic dynamic_lib dlsyms)],
     OBJECT    => '$(O_FILES)',
     clean     => {'FILES' => 'dbu libsdbm.a dbd dba dbe x-dbu *.dir *.pag'},
     H         => [qw(tune.h sdbm.h pair.h $(PERL_INC)/config.h)],
     C         => [qw(sdbm.c pair.c hash.c)]
 );
 
+sub MY::constants {
+  package MY;
+  my $r = shift->SUPER::constants();
+  if ($^O eq 'VMS') {
+    $r =~ s/^INST_STATIC =.*$/INST_STATIC = libsdbm\$(LIB_EXT)/m
+  }
+  return $r;
+}
+
 sub MY::post_constants {
+  package MY;
+  if ($^O eq 'VMS') {
+    shift->SUPER::post_constants();
+  } else {
 '
 INST_STATIC = libsdbm$(LIB_EXT)
 '
+  }
 }
 
 sub MY::top_targets {
-	'
+    my $r = '
 all :: static
+	$(NOECHO) $(NOOP)
 
 config ::
+	$(NOECHO) $(NOOP)
 
 lint:
 	lint -abchx $(LIBSRCS)
+
 ';
+    $r .= '
+# This is a workaround, the problem is that our old GNU make exports
+# variables into the environment so $(MYEXTLIB) is set in here to this
+# value which can not be built.
+sdbm/libsdbm.a:
+	$(NOECHO) $(NOOP)
+' unless $^O eq 'VMS';
+
+    return $r;
 }
diff --git a/gnu/usr.bin/perl/ext/SDBM_File/sdbm/pair.c b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/pair.c
index 23bbfe9a67c..a9a805a4aa3 100644
--- a/gnu/usr.bin/perl/ext/SDBM_File/sdbm/pair.c
+++ b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/pair.c
@@ -7,11 +7,8 @@
  * page-level routines
  */
 
-#ifndef lint
-static char rcsid[] = "$Id: pair.c,v 1.10 90/12/13 13:00:35 oz Exp $";
-#endif
-
 #include "config.h"
+#include "EXTERN.h"
 #include "sdbm.h"
 #include "tune.h"
 #include "pair.h"
@@ -44,9 +41,7 @@ static int seepair proto((char *, int, char *, int));
  */
 
 int
-fitpair(pag, need)
-char *pag;
-int need;
+fitpair(char *pag, int need)
 {
 	register int n;
 	register int off;
@@ -63,10 +58,7 @@ int need;
 }
 
 void
-putpair(pag, key, val)
-char *pag;
-datum key;
-datum val;
+putpair(char *pag, datum key, datum val)
 {
 	register int n;
 	register int off;
@@ -92,9 +84,7 @@ datum val;
 }
 
 datum
-getpair(pag, key)
-char *pag;
-datum key;
+getpair(char *pag, datum key)
 {
 	register int i;
 	register int n;
@@ -114,9 +104,7 @@ datum key;
 
 #ifdef SEEDUPS
 int
-duppair(pag, key)
-char *pag;
-datum key;
+duppair(char *pag, datum key)
 {
 	register short *ino = (short *) pag;
 	return ino[0] > 0 && seepair(pag, ino[0], key.dptr, key.dsize) > 0;
@@ -124,9 +112,7 @@ datum key;
 #endif
 
 datum
-getnkey(pag, num)
-char *pag;
-int num;
+getnkey(char *pag, int num)
 {
 	datum key;
 	register int off;
@@ -145,9 +131,7 @@ int num;
 }
 
 int
-delpair(pag, key)
-char *pag;
-datum key;
+delpair(char *pag, datum key)
 {
 	register int n;
 	register int i;
@@ -219,11 +203,7 @@ datum key;
  * return 0 if not found.
  */
 static int
-seepair(pag, n, key, siz)
-char *pag;
-register int n;
-register char *key;
-register int siz;
+seepair(char *pag, register int n, register char *key, register int siz)
 {
 	register int i;
 	register int off = PBLKSIZ;
@@ -239,10 +219,7 @@ register int siz;
 }
 
 void
-splpage(pag, new, sbit)
-char *pag;
-char *new;
-long sbit;
+splpage(char *pag, char *New, long int sbit)
 {
 	datum key;
 	datum val;
@@ -254,7 +231,7 @@ long sbit;
 
 	(void) memcpy(cur, pag, PBLKSIZ);
 	(void) memset(pag, 0, PBLKSIZ);
-	(void) memset(new, 0, PBLKSIZ);
+	(void) memset(New, 0, PBLKSIZ);
 
 	n = ino[0];
 	for (ino++; n > 0; ino += 2) {
@@ -265,14 +242,14 @@ long sbit;
 /*
  * select the page pointer (by looking at sbit) and insert
  */
-		(void) putpair((exhash(key) & sbit) ? new : pag, key, val);
+		(void) putpair((exhash(key) & sbit) ? New : pag, key, val);
 
 		off = ino[1];
 		n -= 2;
 	}
 
 	debug(("%d split %d/%d\n", ((short *) cur)[0] / 2, 
-	       ((short *) new)[0] / 2,
+	       ((short *) New)[0] / 2,
 	       ((short *) pag)[0] / 2));
 }
 
@@ -283,8 +260,7 @@ long sbit;
  * this could be made more rigorous.
  */
 int
-chkpage(pag)
-char *pag;
+chkpage(char *pag)
 {
 	register int n;
 	register int off;
diff --git a/gnu/usr.bin/perl/ext/SDBM_File/sdbm/sdbm.c b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/sdbm.c
index c2d9cbd47de..c147e45b43a 100644
--- a/gnu/usr.bin/perl/ext/SDBM_File/sdbm/sdbm.c
+++ b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/sdbm.c
@@ -7,10 +7,7 @@
  * core routines
  */
 
-#ifndef lint
-static char rcsid[] = "$Id: sdbm.c,v 1.16 90/12/13 13:01:31 oz Exp $";
-#endif
-
+#include "INTERN.h"
 #include "config.h"
 #include "sdbm.h"
 #include "tune.h"
@@ -39,7 +36,7 @@ extern int errno;
 
 extern Malloc_t malloc proto((MEM_SIZE));
 extern Free_t free proto((Malloc_t));
-extern Off_t lseek();
+extern Off_t lseek(int, Off_t, int);
 #endif
 
 /*
@@ -72,13 +69,8 @@ static long masks[] = {
 	001777777777, 003777777777, 007777777777, 017777777777
 };
 
-datum nullitem = {NULL, 0};
-
 DBM *
-sdbm_open(file, flags, mode)
-register char *file;
-register int flags;
-register int mode;
+sdbm_open(register char *file, register int flags, register int mode)
 {
 	register DBM *db;
 	register char *dirname;
@@ -92,7 +84,7 @@ register int mode;
  */
 	n = strlen(file) * 2 + strlen(DIRFEXT) + strlen(PAGFEXT) + 2;
 
-	if ((dirname = malloc((unsigned) n)) == NULL)
+	if ((dirname = (char *) malloc((unsigned) n)) == NULL)
 		return errno = ENOMEM, (DBM *) NULL;
 /*
  * build the file names
@@ -107,11 +99,7 @@ register int mode;
 }
 
 DBM *
-sdbm_prep(dirname, pagname, flags, mode)
-char *dirname;
-char *pagname;
-int flags;
-int mode;
+sdbm_prep(char *dirname, char *pagname, int flags, int mode)
 {
 	register DBM *db;
 	struct stat dstat;
@@ -170,8 +158,7 @@ int mode;
 }
 
 void
-sdbm_close(db)
-register DBM *db;
+sdbm_close(register DBM *db)
 {
 	if (db == NULL)
 		errno = EINVAL;
@@ -183,9 +170,7 @@ register DBM *db;
 }
 
 datum
-sdbm_fetch(db, key)
-register DBM *db;
-datum key;
+sdbm_fetch(register DBM *db, datum key)
 {
 	if (db == NULL || bad(key))
 		return errno = EINVAL, nullitem;
@@ -197,9 +182,7 @@ datum key;
 }
 
 int
-sdbm_delete(db, key)
-register DBM *db;
-datum key;
+sdbm_delete(register DBM *db, datum key)
 {
 	if (db == NULL || bad(key))
 		return errno = EINVAL, -1;
@@ -223,11 +206,7 @@ datum key;
 }
 
 int
-sdbm_store(db, key, val, flags)
-register DBM *db;
-datum key;
-datum val;
-int flags;
+sdbm_store(register DBM *db, datum key, datum val, int flags)
 {
 	int need;
 	register long hash;
@@ -285,22 +264,19 @@ int flags;
  * giving up.
  */
 static int
-makroom(db, hash, need)
-register DBM *db;
-long hash;
-int need;
+makroom(register DBM *db, long int hash, int need)
 {
 	long newp;
 	char twin[PBLKSIZ];
 	char *pag = db->pagbuf;
-	char *new = twin;
+	char *New = twin;
 	register int smax = SPLTMAX;
 
 	do {
 /*
  * split the current page
  */
-		(void) splpage(pag, new, db->hmask + 1);
+		(void) splpage(pag, New, db->hmask + 1);
 /*
  * address of the new page
  */
@@ -319,10 +295,10 @@ int need;
 			    || write(db->pagf, db->pagbuf, PBLKSIZ) < 0)
 				return 0;
 			db->pagbno = newp;
-			(void) memcpy(pag, new, PBLKSIZ);
+			(void) memcpy(pag, New, PBLKSIZ);
 		}
 		else if (lseek(db->pagf, OFF_PAG(newp), SEEK_SET) < 0
-			 || write(db->pagf, new, PBLKSIZ) < 0)
+			 || write(db->pagf, New, PBLKSIZ) < 0)
 			return 0;
 
 		if (!setdbit(db, db->curbit))
@@ -363,8 +339,7 @@ int need;
  * deletions aren't taken into account. (ndbm bug)
  */
 datum
-sdbm_firstkey(db)
-register DBM *db;
+sdbm_firstkey(register DBM *db)
 {
 	if (db == NULL)
 		return errno = EINVAL, nullitem;
@@ -382,8 +357,7 @@ register DBM *db;
 }
 
 datum
-sdbm_nextkey(db)
-register DBM *db;
+sdbm_nextkey(register DBM *db)
 {
 	if (db == NULL)
 		return errno = EINVAL, nullitem;
@@ -394,9 +368,7 @@ register DBM *db;
  * all important binary trie traversal
  */
 static int
-getpage(db, hash)
-register DBM *db;
-register long hash;
+getpage(register DBM *db, register long int hash)
 {
 	register int hbit;
 	register long dbit;
@@ -435,9 +407,7 @@ register long hash;
 }
 
 static int
-getdbit(db, dbit)
-register DBM *db;
-register long dbit;
+getdbit(register DBM *db, register long int dbit)
 {
 	register long c;
 	register long dirb;
@@ -458,9 +428,7 @@ register long dbit;
 }
 
 static int
-setdbit(db, dbit)
-register DBM *db;
-register long dbit;
+setdbit(register DBM *db, register long int dbit)
 {
 	register long c;
 	register long dirb;
@@ -469,6 +437,7 @@ register long dbit;
 	dirb = c / DBLKSIZ;
 
 	if (dirb != db->dirbno) {
+		(void) memset(db->dirbuf, 0, DBLKSIZ);
 		if (lseek(db->dirf, OFF_DIR(dirb), SEEK_SET) < 0
 		    || read(db->dirf, db->dirbuf, DBLKSIZ) < 0)
 			return 0;
@@ -494,8 +463,7 @@ register long dbit;
  * the page, try the next page in sequence
  */
 static datum
-getnext(db)
-register DBM *db;
+getnext(register DBM *db)
 {
 	datum key;
 
diff --git a/gnu/usr.bin/perl/ext/SDBM_File/sdbm/sdbm.h b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/sdbm.h
index fdd9165145c..84d5f75468c 100644
--- a/gnu/usr.bin/perl/ext/SDBM_File/sdbm/sdbm.h
+++ b/gnu/usr.bin/perl/ext/SDBM_File/sdbm/sdbm.h
@@ -9,7 +9,11 @@
 #define PAIRMAX 1008			/* arbitrary on PBLKSIZ-N */
 #define SPLTMAX	10			/* maximum allowed splits */
 					/* for a single insertion */
+#ifdef VMS
+#define DIRFEXT	".sdbm_dir"
+#else
 #define DIRFEXT	".dir"
+#endif
 #define PAGFEXT	".pag"
 
 typedef struct {
@@ -47,9 +51,13 @@ typedef struct {
 	int dsize;
 } datum;
 
-extern datum nullitem;
+EXTCONST datum nullitem
+#ifdef DOINIT
+                        = {0, 0}
+#endif
+                                   ;
 
-#ifdef __STDC__
+#if defined(__STDC__) || defined(__cplusplus) || defined(CAN_PROTOTYPE)
 #define proto(p) p
 #else
 #define proto(p) ()
@@ -116,15 +124,22 @@ extern long sdbm_hash proto((char *, int));
 #include <ctype.h>
 #include <setjmp.h>
 
-#ifdef I_UNISTD
+#if defined(I_UNISTD)
 #include <unistd.h>
 #endif
 
-#if !defined(MSDOS) && !defined(WIN32)
-#   ifdef PARAM_NEEDS_TYPES
-#	include <sys/types.h>
+#ifdef VMS
+#  include <file.h>
+#  include <unixio.h>
+#endif
+
+#ifdef I_SYS_PARAM
+#   if !defined(MSDOS) && !defined(WIN32) && !defined(VMS)
+#       ifdef PARAM_NEEDS_TYPES
+#	    include <sys/types.h>
+#       endif
+#       include <sys/param.h>
 #   endif
-#   include <sys/param.h>
 #endif
 
 #ifndef _TYPES_		/* If types.h defines this it's easy. */
@@ -183,6 +198,10 @@ extern long sdbm_hash proto((char *, int));
 
 #ifdef I_MEMORY
 #include <memory.h>
+#endif      
+
+#ifdef __cplusplus
+#define HAS_MEMCPY
 #endif
 
 #ifdef HAS_MEMCPY
@@ -233,13 +252,15 @@ extern long sdbm_hash proto((char *, int));
 #  endif
 #else
 #   ifndef memcmp
-#	/* maybe we should have included the full embedding header... */
+	/* maybe we should have included the full embedding header... */
 #	ifdef NO_EMBED
 #	    define memcmp my_memcmp
 #	else
 #	    define memcmp Perl_my_memcmp
 #	endif
+#ifndef __cplusplus
 	extern int memcmp proto((char*, char*, int));
+#endif
 #   endif
 #endif /* HAS_MEMCMP */
 
@@ -258,7 +279,12 @@ extern long sdbm_hash proto((char *, int));
 #endif
 
 #ifdef I_NETINET_IN
-#   include <netinet/in.h>
+#  ifdef VMS
+#    include <in.h>
+#  else
+#    include <netinet/in.h>
+#  endif
 #endif
 
 #endif /* Include guard */
+
diff --git a/gnu/usr.bin/perl/ext/SDBM_File/typemap b/gnu/usr.bin/perl/ext/SDBM_File/typemap
index a9b73d8b811..317a8f3886c 100644
--- a/gnu/usr.bin/perl/ext/SDBM_File/typemap
+++ b/gnu/usr.bin/perl/ext/SDBM_File/typemap
@@ -14,8 +14,8 @@ FATALFUNC		T_OPAQUEPTR
 
 INPUT
 T_DATUM
-	$var.dptr = SvPV($arg, na);
-	$var.dsize = (int)na;
+	$var.dptr = SvPV($arg, PL_na);
+	$var.dsize = (int)PL_na;
 T_GDATUM
 	UNIMPLEMENTED
 OUTPUT