36 files changed, 697 insertions, 285 deletions
diff --git a/Configure b/Configure
index 97dc199307..b8618cbe2b 100755
--- a/Configure
+++ b/Configure
@@ -465,6 +465,8 @@ usedl=''
 fpostype=''
 gidtype=''
 groupstype=''
+d_sched_yield=''
+d_pthread_yield=''
 h_fcntl=''
 h_sysfile=''
 db_hashtype=''
@@ -601,6 +603,7 @@ installprivlib=''
 privlib=''
 privlibexp=''
 prototype=''
+pthreads_created_joinable=''
 randbits=''
 installscript=''
 scriptdir=''
@@ -2598,32 +2601,8 @@ $undef$define) . ./whoa; eval "$var=\$tu";;
 *) eval "$var=$val";;
 esac'
 
-$cat <<EOM
-
-Perl 5.004 can be compiled for binary compatibility with 5.003.
-If you decide to do so, you will be able to continue using any
-extensions that were compiled for Perl 5.003.  However, binary
-compatibility forces Perl to expose some of its internal symbols
-in the same way that 5.003 did.  So you may have symbol conflicts
-if you embed a binary-compatible Perl in other programs.
-
-EOM
-case "$d_bincompat3" in
-"$undef") dflt=n ;;
-*) dflt=y ;;
-esac
-rp='Binary compatibility with Perl 5.003?'
-. ./myread
-case "$ans" in
-y*) val="$define" ;;
-*)  val="$undef" ;;
-esac
-set d_bincompat3
-eval $setvar
-case "$d_bincompat3" in
-"$define") bincompat3=y ;;
-*) bincompat3=n ;;
-esac
+: bincompat3 is no more even possible starting with 5.005
+d_bincompat3=$undef
 
 : make some quick guesses about what we are up against
 echo " "
@@ -8573,6 +8552,24 @@ EOM
 *)  groupstype="$gidtype";;
 esac
 
+case "$usethreads" in
+$define)
+
+    : see if sched_yield exists
+    set sched_yield d_sched_yield
+    eval $inlibc
+    
+    : see if pthread_yield exists
+    set pthread_yield d_pthread_yield
+    eval $inlibc
+
+    ;;
+*)
+    d_sched_yield=$undef
+    d_pthread_yield=$undef
+    ;;
+esac
+
 : see what type lseek is declared as in the kernel
 set off_t lseektype long stdio.h sys/types.h
 eval $typedef
@@ -9920,6 +9917,53 @@ val="$t_gdbm"
 set i_gdbm
 eval $setvar
 
+: test whether pthreads are created in joinable -- aka undetached -- state
+if test "X$usethreads" != X; then
+echo " "
+echo 'Checking whether pthreads are created joinable.' >&4
+	$cat >try.c <<EOCP
+/* Note: this program returns 1 if detached, 0 if not.
+ * Easier this way because the PTHREAD_CREATE_DETACHED is more
+ * portable than the obsolete PTHREAD_CREATE_UNDETACHED.
+ * Testing for joinable (aka undetached) as opposed to detached
+ * is then again logically more sensible because that's
+ * the more modern default state in the pthreads implementations. */
+#include <pthread.h>
+#include <stdio.h>
+int main() {
+    pthread_attr_t attr;
+    int detachstate;
+    pthread_attr_init(&attr);
+    pthread_attr_getdetachstate(&attr, &detachstate);
+    printf("%s\n",
+           detachstate == PTHREAD_CREATE_DETACHED ?
+           "detached" : "joinable");
+    exit(0);
+}
+EOCP
+    if $cc $ccflags $ldflags -o try try.c $libs >/dev/null 2>&1; then
+	yyy=`./try`
+    else
+	echo "(I can't seem to compile the test program--assuming they are.)"
+	yyy=joinable
+    fi
+    case "$yyy" in
+    joinable)
+      val="$define"
+      echo "Yup, they are."
+      ;;
+    *)
+      val="$undef"
+      echo "Nope, they aren't."
+      ;;
+    esac
+    set d_pthreads_created_joinable
+    eval $setvar
+    $rm -f try try.*
+else
+    d_pthreads_created_joinable=$undef
+fi
+
 echo " "
 echo "Looking for extensions..." >&4
 cd ../ext
@@ -10295,6 +10339,7 @@ d_phostname='$d_phostname'
 d_pipe='$d_pipe'
 d_poll='$d_poll'
 d_portable='$d_portable'
+d_pthread_yield='$d_pthread_yield'
 d_pwage='$d_pwage'
 d_pwchange='$d_pwchange'
 d_pwclass='$d_pwclass'
@@ -10309,6 +10354,7 @@ d_rmdir='$d_rmdir'
 d_safebcpy='$d_safebcpy'
 d_safemcpy='$d_safemcpy'
 d_sanemcmp='$d_sanemcmp'
+d_sched_yield='$d_sched_yield'
 d_seekdir='$d_seekdir'
 d_select='$d_select'
 d_sem='$d_sem'
@@ -10562,6 +10608,7 @@ prefixexp='$prefixexp'
 privlib='$privlib'
 privlibexp='$privlibexp'
 prototype='$prototype'
+pthreads_created_joinable='$pthreads_created_joinable'
 randbits='$randbits'
 ranlib='$ranlib'
 rd_nodata='$rd_nodata'
diff --git a/INSTALL b/INSTALL
index 488a1ce870..f8931aea76 100644
--- a/INSTALL
+++ b/INSTALL
@@ -445,36 +445,25 @@ some of the main things you can change.
 
 =head2 Binary Compatibility With Earlier Versions of Perl 5
 
-If you have dynamically loaded extensions that you built under
-perl 5.003 and that you wish to continue to use with perl 5.004, then you
-need to ensure that 5.004 remains binary compatible with 5.003.
-
-Starting with Perl 5.003, all functions in the Perl C source code have
-been protected by default by the prefix Perl_ (or perl_) so that you
-may link with third-party libraries without fear of namespace
-collisions.  This change broke compatibility with version 5.002, so
-installing 5.003 or 5.004 over 5.002 or earlier will force you to
-re-build and install all of your dynamically loadable extensions.
-(The standard extensions supplied with Perl are handled
+For Perl 5.004 it was possible to be binary compatible with 5.003.
+Starting from Perl 5.005 this is no more possible because there were
+many deep and far-reaching changes to the language internals.
+
+If you have dynamically loaded extensions that you built under perl
+5.003 or 5.004 and the so-called 'bincompat3' mode (the default mode)
+and that you wish to continue to use with perl 5.005, you may need to
+reinstall the extensions.
+
+Background: starting with Perl 5.003, all functions in the Perl C
+source code have been protected by default by the prefix Perl_ (or
+perl_) so that you may link with third-party libraries without fear of
+namespace collisions.  This change broke compatibility with version
+5.002, so installing 5.003 or 5.004 over 5.002 or earlier will force
+you to re-build and install all of your dynamically loadable
+extensions.  (The standard extensions supplied with Perl are handled
 automatically).  You can turn off this namespace protection by adding
 -DNO_EMBED to your ccflags variable in config.sh.
 
-Perl 5.003's namespace protection was incomplete, but this has
-been fixed in 5.004.  However, some sites may need to maintain
-complete binary compatibility with Perl 5.003.  If you are building
-Perl for such a site, then when Configure asks if you want binary
-compatibility, answer "y".
-
-On the other hand, if you are embedding perl into another application
-and want the maximum namespace protection, then you probably ought to
-answer "n" when Configure asks if you want binary compatibility, or
-disable it from the Configure command line with
-
-	sh Configure -Ud_bincompat3
-
-The default answer of "y" to maintain binary compatibility is probably
-appropriate for almost everyone.
-
 In a related issue, old extensions may possibly be affected by the
 changes in the Perl language in the current release.  Please see
 pod/perldelta.pod for a description of what's changed.
diff --git a/MANIFEST b/MANIFEST
index deb1303b19..bca11c9d9e 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -110,6 +110,7 @@ eg/van/vanish		A program to put files in a trashcan
 eg/who			A sample who program
 eg/wrapsuid		A setuid script wrapper generator
 emacs/cperl-mode.el	An alternate perl-mode
+emacs/ptags		Creates smart TAGS file
 embed.h			Maps symbols to safer names
 embed.pl		Produces embed.h
 ext/DB_File/DB_File.pm		Berkeley DB extension Perl module
@@ -730,6 +731,7 @@ t/op/arith.t		See if arithmetic works
 t/op/array.t		See if array operations work
 t/op/assignwarn.t	See if OP= operators warn correctly for undef targets
 t/op/auto.t		See if autoincrement et all work
+t/op/avhv.t		See if pseudo-hashes work
 t/op/bop.t		See if bitops work
 t/op/chop.t		See if chop works
 t/op/closure.t		See if closures work
diff --git a/Makefile.SH b/Makefile.SH
index fb6974196a..2e90be0d73 100644
--- a/Makefile.SH
+++ b/Makefile.SH
@@ -557,6 +557,9 @@ Makefile: Makefile.SH ./config.sh
 distcheck: FORCE
 	perl '-MExtUtils::Manifest=&fullcheck' -e 'fullcheck()'
 
+etags:
+	sh emacs/ptags
+
 # AUTOMATICALLY GENERATED MAKE DEPENDENCIES--PUT NOTHING BELOW THIS LINE
 # If this runs make out of memory, delete /usr/include lines.
 !NO!SUBS!
diff --git a/config_h.SH b/config_h.SH
index 75751439c6..7b625e3119 100644
--- a/config_h.SH
+++ b/config_h.SH
@@ -566,6 +566,18 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
  */
 #$d_poll HAS_POLL		/**/
 
+/* HAS_PTHREAD_YIELD:
+ *	This symbol, if defined, indicates that the pthread_yield routine is
+ *	available to yield the execution of the current thread.
+ */
+#$d_pthread_yield HAS_PTHREAD_YIELD
+
+/* HAS_SCHED_YIELD:
+ *	This symbol, if defined, indicates that the sched_yield routine is
+ *	available to yield the execution of the current thread.
+ */
+#$d_sched_yield HAS_SCHED_YIELD
+
 /* HAS_READDIR:
  *	This symbol, if defined, indicates that the readdir routine is
  *	available to read directory entries. You may have to include
@@ -1624,6 +1636,12 @@ sed <<!GROK!THIS! >config.h -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un-
  */
 #$d_sfio	USE_SFIO		/**/
 
+/* PTHREADS_CREATED_JOINABLE:
+ *	This symbol, if defined, indicates that pthreads are created
+ *	in the joinable (aka undetached) state.
+ */
+#$d_pthreads_created_joinable	PTHREADS_CREATED_JOINABLE		/**/
+
 /* Sigjmp_buf:
  *	This is the buffer type to be used with Sigsetjmp and Siglongjmp.
  */
diff --git a/cv.h b/cv.h
index d5ffdc2196..0eeedfd7cf 100644
--- a/cv.h
+++ b/cv.h
@@ -30,7 +30,7 @@ struct xpvcv {
     CV *	xcv_outside;
 #ifdef USE_THREADS
     perl_mutex *xcv_mutexp;
-    struct thread *xcv_owner;	/* current owner thread */
+    struct perl_thread *xcv_owner;	/* current owner thread */
 #endif /* USE_THREADS */
     cv_flags_t	xcv_flags;
 };
diff --git a/emacs/cperl-mode.el b/emacs/cperl-mode.el
index b00d77a115..e3dea854e5 100644
--- a/emacs/cperl-mode.el
+++ b/emacs/cperl-mode.el
@@ -32,7 +32,7 @@
 ;;; Corrections made by Ilya Zakharevich ilya@math.mps.ohio-state.edu
 ;;; XEmacs changes by Peter Arius arius@informatik.uni-erlangen.de
 
-;; $Id: cperl-mode.el,v 1.39 1997/10/14 08:28:00 ilya Exp ilya $
+;; $Id: cperl-mode.el,v 1.41 1997/11/17 18:09:39 ilya Exp ilya $
 
 ;;; To use this mode put the following into your .emacs file:
 
@@ -463,6 +463,28 @@
 ;;;  `cperl-find-pods-heres' somehow maybe called when string-face is undefined
 ;;;   - put a stupid workaround for 20.1
 
+;;;; After 1.39:
+;;;  Could indent here-docs for comments;
+;;;  These problems fixed:
+;;;;;;;  s/foo/\\bar/	- backslash at start of subst (made into two chunk)
+;;;;;;;  s[foo] <blah>e	- "e" part delimited by "different" <> (will match)
+;;;  Matching brackets honor prefices, may expand abbreviations;
+;;;  When expanding abbrevs, will remove last char only after
+;;;    self-inserted whitespace;
+;;;  More convenient "Refress hard constructs" in menu;
+;;;  `cperl-add-tags-recurse', `cperl-add-tags-recurse-noxs'
+;;;    added (for -batch mode);
+;;;  Better handling of errors when scanning for Perl constructs;
+;;;;;;;  Possible "problem" with class hierarchy in Perl distribution 
+;;;;;;;    directory: ./ext duplicates ./lib;
+;;;  Write relative paths for generated TAGS;
+
+;;;; After 1.40:
+;;;  s  /// may be separated by "\n\f" too;
+;;;  `s  #blah' recognized as a comment;
+;;;  Would highlight s/abc//s wrong;
+;;;  Debugging code in `cperl-electric-keywords' was leaking a message;
+
 (defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version))
 
 (defvar cperl-extra-newline-before-brace nil
@@ -965,6 +987,7 @@ progress indicator for indentation (with `imenu' loaded).
 	    cperl-use-syntax-table-text-property]
 	   ["Contract a group in regexp" cperl-contract-level
 	    cperl-use-syntax-table-text-property]
+	   ["Refresh \"hard\" constructions" cperl-find-pods-heres t]
 	   "----"
 	   ["Indent region" cperl-indent-region (cperl-use-region-p)]
 	   ["Comment region" cperl-comment-region (cperl-use-region-p)]
@@ -1004,7 +1027,6 @@ progress indicator for indentation (with `imenu' loaded).
 	      (cperl-write-tags nil t t t) t]
 	     ["Add tags for Perl files in (sub)directories"
 	      (cperl-write-tags nil nil t t) t])
-	    ["Recalculate \"hard\" constructions" cperl-find-pods-heres t]
 	    ["Define word at point" imenu-go-find-at-position 
 	     (fboundp 'imenu-go-find-at-position)]
 	    ["Help on function" cperl-info-on-command t]
@@ -1463,7 +1485,7 @@ char is \"{\", insert extra newline before only if
 		   (if cperl-auto-newline 
 		       (progn (cperl-indent-line) (newline) t) nil)))
 	  (progn
-	    (insert last-command-char)
+	    (self-insert-command (prefix-numeric-value arg))
 	    (cperl-indent-line)
 	    (if cperl-auto-newline
 		(setq insertpos (1- (point))))
@@ -1502,7 +1524,7 @@ char is \"{\", insert extra newline before only if
 	 (save-excursion
 	   (skip-chars-backward "$")
 	   (looking-at "\\(\\$\\$\\)*\\$\\([^\\$]\\|$\\)"))
-	 (insert ? ))
+	 (insert ?\ ))
     (if (cperl-after-expr-p nil "{;)") nil (setq cperl-auto-newline nil))
     (cperl-electric-brace arg)
     (and (cperl-val 'cperl-electric-parens)
@@ -1532,18 +1554,22 @@ char is \"{\", insert extra newline before only if
 	     (>= (save-excursion (cperl-to-comment-or-eol) (point)) (point))
 	     ;;(not (save-excursion (search-backward "#" beg t)))
 	     (if (eq last-command-char ?<)
-		 (cperl-after-expr-p nil "{;(,:=")
+		 (progn
+		   (and abbrev-mode ; later it is too late, may be after `for'
+			(expand-abbrev))
+		   (cperl-after-expr-p nil "{;(,:="))
 	       1))
 	(progn
-	  (insert last-command-char)
+	  (self-insert-command (prefix-numeric-value arg))
 	  (if other-end (goto-char (marker-position other-end)))
-	  (insert (cdr (assoc last-command-char '((?{ .?})
-						  (?[ . ?])
-						  (?( . ?))
-						  (?< . ?>)))))
-	  (forward-char -1))
-      (insert last-command-char)
-      )))
+	  (insert (make-string 
+		   (prefix-numeric-value arg)
+		   (cdr (assoc last-command-char '((?{ .?})
+						   (?[ . ?])
+						   (?( . ?))
+						   (?< . ?>))))))
+	  (forward-char (- (prefix-numeric-value arg))))
+      (self-insert-command (prefix-numeric-value arg)))))
 
 (defun cperl-electric-rparen (arg)
   "Insert a matching pair of parentheses if marking is active.
@@ -1566,21 +1592,25 @@ If not, or if we are not at the end of marking range, would self-insert."
 	     ;;(not (save-excursion (search-backward "#" beg t)))
 	     )
 	(progn
-	  (insert last-command-char)
+	  (self-insert-command (prefix-numeric-value arg))
 	  (setq p (point))
 	  (if other-end (goto-char other-end))
-	  (insert (cdr (assoc last-command-char '((?\} . ?\{)
+	  (insert (make-string
+		   (prefix-numeric-value arg)
+		   (cdr (assoc last-command-char '((?\} . ?\{)
 						  (?\] . ?\[)
 						  (?\) . ?\()
-						  (?\> . ?\<)))))
+						  (?\> . ?\<))))))
 	  (goto-char (1+ p)))
-      (call-interactively 'self-insert-command)
-      )))
+      (self-insert-command (prefix-numeric-value arg)))))
 
 (defun cperl-electric-keyword ()
   "Insert a construction appropriate after a keyword."
   (let ((beg (save-excursion (beginning-of-line) (point))) 
-	(dollar (eq last-command-char ?$)))
+	(dollar (and (eq last-command-char ?$)
+		     (eq this-command 'self-insert-command)))
+	(delete (and (memq last-command-char '(?\ ?\n ?\t ?\f))
+		     (memq this-command '(self-insert-command newline)))))
     (and (save-excursion
 	   (backward-sexp 1)
 	   (cperl-after-expr-p nil "{;:"))
@@ -1609,9 +1639,12 @@ If not, or if we are not at the end of marking range, would self-insert."
 	   (or (looking-at "[ \t]\\|$") (insert " "))
 	   (cperl-indent-line)
 	   (if dollar (progn (search-backward "$")
+			     (delete-char 1)
+			     (forward-char -1)
 			     (forward-char 1))
 	     (search-backward ")"))
-	   (cperl-putback-char del-back-ch)))))
+	   (if delete
+	       (cperl-putback-char del-back-ch))))))
 
 (defun cperl-electric-else ()
   "Insert a construction appropriate after a keyword."
@@ -1754,7 +1787,7 @@ If not, or if we are not at the end of marking range, would self-insert."
 		       (let ((pps (parse-partial-sexp (point) end)))
 			 (or (nth 3 pps) (nth 4 pps) (nth 5 pps))))))))
 	(progn
-	  (insert last-command-char)
+	  (self-insert-command (prefix-numeric-value arg))
 	  ;;(forward-char -1)
 	  (if auto (setq insertpos (point-marker)))
 	  ;;(forward-char 1)
@@ -2435,6 +2468,14 @@ Returns true if comment is found."
 (defvar cperl-st-sfence '(15))		; String-fence
 (defvar cperl-st-punct '(1))
 (defvar cperl-st-word '(2))
+(defvar cperl-st-bra '(4 . ?\>))
+(defvar cperl-st-ket '(5 . ?\<))
+
+(defsubst cperl-modify-syntax-type (at how)
+  (if (< at (point-max))
+      (progn
+	(put-text-property at (1+ at) 'syntax-table how)
+	(put-text-property at (1+ at) 'rear-nonsticky t))))
 
 (defun cperl-protect-defun-start (s e)
   ;; C code looks for "^\\s(" to skip comment backward in "hard" situations
@@ -2448,21 +2489,18 @@ Returns true if comment is found."
       (progn
 	;; We suppose that e is _after_ the end of construction, as after eol.
 	(setq string (if string cperl-st-sfence cperl-st-cfence))
-	(put-text-property bb (1+ bb) 'syntax-table string)
-	(put-text-property bb (1+ bb) 'rear-nonsticky t)
-	(put-text-property (1- e) e 'syntax-table string)
-	(put-text-property (1- e) e 'rear-nonsticky t)
+	(cperl-modify-syntax-type bb string)
+	(cperl-modify-syntax-type (1- e) string)
 	(if (and (eq string cperl-st-sfence) (> (- e 2) bb))
 	    (put-text-property (1+ bb) (1- e) 
 			       'syntax-table cperl-string-syntax-table))
 	(cperl-protect-defun-start bb e))))
 
-(defun cperl-forward-re (is-2arg set-st st-l err-l argument
-				 &optional ostart oend)
-  ;; Unfinished
+(defun cperl-forward-re (lim end is-2arg set-st st-l err-l argument
+			     &optional ostart oend)
   ;; Works *before* syntax recognition is done
   ;; May modify syntax-type text property if the situation is too hard
-  (let (b starter ender st i i2)
+  (let (b starter ender st i i2 go-forward)
     (skip-chars-forward " \t")
     ;; ender means matching-char matcher.
     (setq b (point) 
@@ -2512,22 +2550,20 @@ Returns true if comment is found."
 	  (and is-2arg			; Have trailing part
 	       (not ender)
 	       (eq (following-char) starter) ; Empty trailing part
-	       (if (eq (char-syntax (following-char)) ?.)
-		   (setq is-2arg nil)	; Ignore the tail
-		 ;; Make trailing letter into punctuation
-		 (setq is-2arg nil)	; Ignore the tail
-		 (put-text-property (point) (1+ (point))
-				    'syntax-table cperl-st-punct)
-		 (put-text-property (point) (1+ (point)) 'rear-nonsticky t)))
+	       (progn
+		 (or (eq (char-syntax (following-char)) ?.)
+		     ;; Make trailing letter into punctuation
+		     (cperl-modify-syntax-type (point) cperl-st-punct))
+		 (setq is-2arg nil go-forward t))) ; Ignore the tail
 	  (if is-2arg			; Not number => have second part
 	      (progn
 		(setq i (point) i2 i)
 		(if ender
-		    (if (eq (char-syntax (following-char)) ?\ )
+		    (if (memq (following-char) '(?\  ?\t ?\n ?\f))
 			(progn
-			  (while (looking-at "\\s *#")
-			    (beginning-of-line 2))
-			  (skip-chars-forward " \t\n\f")
+			  (if (looking-at "[ \t\n\f]+\\(#[^\n]*\n[ \t\n\f]*\\)+")
+			      (goto-char (match-end 0))
+			    (skip-chars-forward " \t\n\f"))
 			  (setq i2 (point))))
 		  (forward-char -1))
 		(modify-syntax-entry starter (if (eq starter ?\\) "\\" ".") st)
@@ -2535,22 +2571,24 @@ Returns true if comment is found."
 		(setq set-st nil)
 		(setq 
 		 ender
-		 (cperl-forward-re nil t st-l err-l argument starter ender)
+		 (cperl-forward-re lim end nil t st-l err-l argument starter ender)
 		 ender (nth 2 ender)))))
-      (error (goto-char (point-max))
-	     (message
-	      "End of `%s%s%c ... %c' string not found: %s"
-	      argument
-	      (if ostart (format "%c ... %c" ostart (or oend ostart)) "")
-	      starter (or ender starter) bb)
-	     (or (car err-l) (setcar err-l b))))
+      (error (goto-char lim)
+	     (setq set-st nil)
+	     (or end
+		 (message
+		  "End of `%s%s%c ... %c' string not found: %s"
+		  argument
+		  (if ostart (format "%c ... %c" ostart (or oend ostart)) "")
+		  starter (or ender starter) bb)
+		 (or (car err-l) (setcar err-l b)))))
     (if set-st
 	(progn
 	  (modify-syntax-entry starter (if (eq starter ?\\) "\\" ".") st)
 	  (if ender (modify-syntax-entry ender "." st))))
-    (list i i2 ender starter)))
+    (list i i2 ender starter go-forward)))
 
-(defun cperl-find-pods-heres (&optional min max)
+(defun cperl-find-pods-heres (&optional min max non-inter end)
   "Scans the buffer for hard-to-parse Perl constructions.
 If `cperl-pod-here-fontify' is not-nil after evaluation, will fontify 
 the sections using `cperl-pod-head-face', `cperl-pod-face', 
@@ -2559,11 +2597,11 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
   (or min (setq min (point-min)))
   (or max (setq max (point-max)))
   (let (face head-face here-face b e bb tag qtag b1 e1 argument i c tail state 
-	     (cperl-pod-here-fontify (eval cperl-pod-here-fontify))
+	     (cperl-pod-here-fontify (eval cperl-pod-here-fontify)) go
 	     (case-fold-search nil) (inhibit-read-only t) (buffer-undo-list t)
 	     (modified (buffer-modified-p))
 	     (after-change-functions nil)
-	     (state-point (point-min)) 
+	     (state-point (point-min))
 	     (st-l '(nil)) (err-l '(nil)) i2
 	     ;; Somehow font-lock may be not loaded yet...
 	     (font-lock-string-face (if (boundp 'font-lock-string-face)
@@ -2614,7 +2652,8 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
     (unwind-protect
 	(progn
 	  (save-excursion
-	    (message "Scanning for \"hard\" Perl constructions...")
+	    (or non-inter
+		(message "Scanning for \"hard\" Perl constructions..."))
 	    (if cperl-pod-here-fontify
 		;; We had evals here, do not know why...
 		(setq face cperl-pod-face
@@ -2635,14 +2674,14 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 		;;  "\\(\\`\n?\\|\n\n\\)=" 
 		(if (looking-at "\n*cut\\>")
 		    (progn
-		      (message "=cut is not preceded by a pod section")
+		      (message "=cut is not preceded by a POD section")
 		      (or (car err-l) (setcar err-l (point))))
 		  (beginning-of-line)
 		
 		  (setq b (point) bb b)
 		  (or (re-search-forward "\n\n=cut\\>" max 'toend)
 		      (progn
-			(message "Cannot find the end of a pod section")
+			(message "End of a POD section not marked by =cut")
 			(or (car err-l) (setcar err-l b))))
 		  (beginning-of-line 2)	; An empty line after =cut is not POD!
 		  (setq e (point))
@@ -2799,7 +2838,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 		      bb (and		; user variables/whatever
 			  (match-beginning 10)
 			  (or
-			   (memq bb '(?\$ ?\@ ?\% ?\*))
+			   (memq bb '(?\$ ?\@ ?\% ?\* ?\#)) ; $#y
 			   (and (eq bb ?-) (eq c ?s)) ; -s file test
 			   (and (eq bb ?\&) ; &&m/blah/
 				(not (eq (char-after 
@@ -2812,21 +2851,32 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 			     (progn
 			       (goto-char (match-beginning b1))
 			       (cperl-backward-to-noncomment (point-min))
-			       (not (or (memq (preceding-char)
-					      (append (if (eq c ?\?)
-							  ;; $a++ ? 1 : 2
-							  "~{(=|&*!,;"
-							"~{(=|&+-*!,;") nil))
-					(and (eq (preceding-char) ?\})
-					     (cperl-after-block-p (point-min)))
-					(and (eq (char-syntax (preceding-char)) ?w)
-					     (progn
-					       (forward-sexp -1)
-					       (looking-at 
-						"\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\)\\>")))
-					(and (eq (preceding-char) ?.)
-					     (eq (char-after (- (point) 2)) ?.))
-					(bobp))))
+			       (not 
+				;; What is below: regexp-p?
+				(and
+				 (or (memq (preceding-char)
+					   (append (if (eq c ?\?)
+						       ;; $a++ ? 1 : 2
+						       "~{(=|&*!,;"
+						     "~{(=|&+-*!,;") nil))
+				     (and (eq (preceding-char) ?\})
+					  (cperl-after-block-p (point-min)))
+				     (and (eq (char-syntax (preceding-char)) ?w)
+					  (progn
+					    (forward-sexp -1)
+					    (looking-at 
+					     "\\(while\\|if\\|unless\\|until\\|and\\|or\\|not\\|xor\\|split\\|grep\\|map\\|print\\)\\>")))
+				     (and (eq (preceding-char) ?.)
+					  (eq (char-after (- (point) 2)) ?.))
+				     (bobp))
+				 ;;  m|blah| ? foo : bar;
+				 (not
+				  (and (eq c ?\?)
+				       cperl-use-syntax-table-text-property 
+				       (not (bobp))
+				       (progn
+					 (forward-char -1)
+					 (looking-at "\\s|")))))))
 			     b (1- b))))
 		(or bb (setq state (parse-partial-sexp 
 				    state-point b nil nil state)
@@ -2834,28 +2884,45 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 		(goto-char b)
 		(if (or bb (nth 3 state) (nth 4 state))
 		    (goto-char i)
-		  (skip-chars-forward " \t")
+		  (if (looking-at "[ \t\n\f]+\\(#[^\n]*\n[ \t\n\f]*\\)+")
+		      (goto-char (match-end 0))
+		    (skip-chars-forward " \t\n\f"))
 		  ;; qtag means two-arg matcher, may be reset to
 		  ;;   2 or 3 later if some special quoting is needed.
 		  ;; e1 means matching-char matcher.
 		  (setq b (point)
-			i (cperl-forward-re 
+			i (cperl-forward-re max end
 			   (string-match "^\\([sy]\\|tr\\)$" argument)
 			   t st-l err-l argument)
 			i2 (nth 1 i)	; start of the second part
 			e1 (nth 2 i)	; ender, true if matching second part
+			go (nth 4 i)	; There is a 1-char part after the end
 			i (car i)	; intermediate point
-			tail (if (and i (not e1)) (1- (point))))
+			tail (if (and i (not e1)) (1- (point)))
+			e nil)		; need to preserve backslashitis
 		  ;; Commenting \\ is dangerous, what about ( ?
 		  (and i tail
 		       (eq (char-after i) ?\\)
-		       (setq i nil tail nil))
+		       (setq e t))
 		  (if (null i)
-		      (cperl-commentify b (point) t)
+		      (progn
+			(cperl-commentify b (point) t)
+			(if go (forward-char 1)))
 		    (cperl-commentify b i t)
 		    (if (looking-at "\\sw*e") ; s///e
-			(cperl-find-pods-heres i2 (1- (point)))
+			(progn
+			  (and
+			   ;; silent:
+			   (cperl-find-pods-heres i2 (1- (point)) t end)
+			   ;; Error
+			   (goto-char (1+ max)))
+			  (if (and e1 (eq (preceding-char) ?\>))
+			      (progn
+				(cperl-modify-syntax-type (1- (point)) cperl-st-ket)
+				(cperl-modify-syntax-type i cperl-st-bra))))
 		      (cperl-commentify i2 (point) t)
+		      (if e
+		       (cperl-modify-syntax-type (1+ i) cperl-st-punct))
 		      (setq tail nil)))
 		  (if (eq (char-syntax (following-char)) ?w)
 		      (progn
@@ -2883,16 +2950,13 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 			     state-point (1- b) nil nil state)
 		      state-point (1- b))
 		(if (nth 3 state)	; in string
-		    (progn
-		      (put-text-property (1- b) b 'syntax-table cperl-st-punct)
-		      (put-text-property (1- b) b 'rear-nonsticky t)))
+		    (cperl-modify-syntax-type (1- b) cperl-st-punct))
 		(goto-char (1+ b)))
 	       ;; 1+6+2+1+1+2=13 extra () before this:
 	       ;;    "\\$\\(['{]\\)"
 	       ((match-beginning 14)	; ${
 		(setq bb (match-beginning 0))
-		(put-text-property bb (1+ bb) 'syntax-table cperl-st-punct)
-		(put-text-property bb (1+ bb) 'rear-nonsticky t))
+		(cperl-modify-syntax-type bb cperl-st-punct))
 	       ;; 1+6+2+1+1+2+1=14 extra () before this:
 	       ;;    "\\(\\<sub[ \t\n\f]+\\|[&*$@%]\\)[a-zA-Z0-9_]*'")
 	       ((match-beginning 15)	; old $abc'efg syntax
@@ -2917,8 +2981,15 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 		    nil
 		  ;; (put-text-property b (1+ bb) 'syntax-type 'pod) ; Cheat
 		  (cperl-commentify b bb nil)
-		  )
-		(goto-char bb))))
+		  (setq end t))
+		(goto-char bb)))
+	      (if (> (point) max)
+		  (progn
+		    (if end 
+			(message "Garbage after __END__/__DATA__ ignored")
+		      (message "Unbalanced syntax found while scanning")
+		      (or (car err-l) (setcar err-l b)))
+		    (goto-char max))))
 ;;;	    (while (re-search-forward "\\(\\`\n?\\|\n\n\\)=" max t)
 ;;;	      (if (looking-at "\n*cut\\>")
 ;;;		  (progn
@@ -3013,13 +3084,15 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 ;;;					'syntax-type 'format)
 ;;;		     (cperl-put-do-not-fontify b (match-beginning 0)))
 ;;;		    (t (message "End of format `%s' not found." name))))
-)
+	    )
 	  (if (car err-l) (goto-char (car err-l))
-	    (message "Scan for \"hard\" Perl constructions completed.")))
+	    (or noninteractive
+		(message "Scan for \"hard\" Perl constructions completed."))))
       (and (buffer-modified-p)
 	   (not modified)
 	   (set-buffer-modified-p nil))
-      (set-syntax-table cperl-mode-syntax-table))))
+      (set-syntax-table cperl-mode-syntax-table))
+    (car err-l)))
 
 (defun cperl-backward-to-noncomment (lim)
   ;; Stops at lim or after non-whitespace that is not in comment
@@ -3150,9 +3223,12 @@ inclusive."
 	    (cperl-indent-line 'indent-info)
 	    (or comm
 		(progn
-		  (if (setq old-comm-indent (and (cperl-to-comment-or-eol)
-						 (not (eq (get-text-property (point) 'syntax-type) 'pod))
-						 (current-column)))
+		  (if (setq old-comm-indent 
+			    (and (cperl-to-comment-or-eol)
+				 (not (memq (get-text-property (point) 
+							       'syntax-type)
+					    '(pod here-doc)))
+				 (current-column)))
 		      (progn (indent-for-comment)
 			     (skip-chars-backward " \t")
 			     (skip-chars-backward "#")
@@ -3319,13 +3395,16 @@ indentation and initial hashes. Behaves usually outside of comment."
 	packages ends-ranges p
 	(prev-pos 0) char fchar index index1 name (end-range 0) package)
     (goto-char (point-min))
-    (imenu-progress-message prev-pos 0)
+    (if noninteractive
+	(message "Scanning Perl for index")
+      (imenu-progress-message prev-pos 0))
     ;; Search for the function
     (progn ;;save-match-data
       (while (re-search-forward
 	      (or regexp imenu-example--function-name-regexp-perl)
 	      nil t)
-	(imenu-progress-message prev-pos)
+	(or noninteractive
+	    (imenu-progress-message prev-pos))
 	;;(backward-up-list 1)
 	(cond
 	 ((and				; Skip some noise if building tags
@@ -3395,7 +3474,8 @@ indentation and initial hashes. Behaves usually outside of comment."
 	  (setq index1 (cons (concat "=" name) (cdr index)))
 	  (push index index-pod-alist)
 	  (push index1 index-unsorted-alist)))))
-    (imenu-progress-message prev-pos 100)
+    (or noninteractive
+	(imenu-progress-message prev-pos 100))
     (setq index-alist 
 	  (if (default-value 'imenu-sort-function)
 	      (sort index-alist (default-value 'imenu-sort-function))
@@ -4271,13 +4351,16 @@ in subdirectories too."
   (let ((index-alist '()) 
 	(prev-pos 0) index index1 name package prefix)
     (goto-char (point-min))
-    (imenu-progress-message prev-pos 0)
+    (if noninteractive
+	(message "Scanning XSUB for index")
+      (imenu-progress-message prev-pos 0))
     ;; Search for the function
     (progn ;;save-match-data
       (while (re-search-forward
 	      "^\\([ \t]*MODULE\\>[^\n]*\\<PACKAGE[ \t]*=[ \t]*\\([a-zA-Z_][a-zA-Z_0-9:]*\\)\\>\\|\\([a-zA-Z_][a-zA-Z_0-9]*\\)(\\|[ \t]*BOOT:\\)"
 	      nil t)
-	(imenu-progress-message prev-pos)
+	(or noninteractive
+	    (imenu-progress-message prev-pos))
 	(cond
 	 ((match-beginning 2)	; SECTION
 	  (setq package (buffer-substring (match-beginning 2) (match-end 2)))
@@ -4305,24 +4388,28 @@ in subdirectories too."
 	  (setq index (imenu-example--name-and-position))
 	  (setcar index (concat package "::BOOT:"))
 	  (push index index-alist)))))
-    (imenu-progress-message prev-pos 100)
+    (or noninteractive
+	(imenu-progress-message prev-pos 100))
     ;;(setq index-alist 
     ;;      (if (default-value 'imenu-sort-function)
     ;;          (sort index-alist (default-value 'imenu-sort-function))
     ;;          (nreverse index-alist)))
     index-alist))
 
-(defun cperl-find-tags (file xs)
-  (let (ind (b (get-buffer cperl-tmp-buffer)) lst elt pos ret
+(defun cperl-find-tags (file xs topdir)
+  (let (ind (b (get-buffer cperl-tmp-buffer)) lst elt pos ret rel
 	    (cperl-pod-here-fontify nil))
     (save-excursion
       (if b (set-buffer b)
 	  (cperl-setup-tmp-buf))
       (erase-buffer)
       (setq file (car (insert-file-contents file)))
-      (message "Scanning file %s..." file)
-      (if cperl-use-syntax-table-text-property-for-tags
-	  (cperl-find-pods-heres))
+      (message "Scanning file %s ..." file)
+      (if (and cperl-use-syntax-table-text-property-for-tags
+	       (not xs))
+	  (condition-case err		; after __END__ may have garbage
+	      (cperl-find-pods-heres)
+	    (error (message "While scanning for syntax: %s" err))))
       (if xs
 	  (setq lst (cperl-xsub-scan))
 	(setq ind (imenu-example--create-perl-index))
@@ -4370,19 +4457,43 @@ in subdirectories too."
 				  lst))))))
       (setq pos (point))
       (goto-char 1)
-      (insert "\f\n" file "," (number-to-string (1- pos)) "\n")
+      (setq rel file)
+      ;; On case-preserving filesystems (EMX on OS/2) case might be encoded in properties
+      (set-text-properties 0 (length rel) nil rel)
+      (and (equal topdir (substring rel 0 (length topdir)))
+	   (setq rel (substring file (length topdir))))
+      (insert "\f\n" rel "," (number-to-string (1- pos)) "\n")
       (setq ret (buffer-substring 1 (point-max)))
       (erase-buffer)
-      (message "Scanning file %s finished" file)
+      (or noninteractive
+	  (message "Scanning file %s finished" file))
       ret)))
 
-(defun cperl-write-tags (&optional file erase recurse dir inbuffer)
+(defun cperl-add-tags-recurse-noxs ()
+  "Add to TAGS data for Perl and XSUB files in the current directory and kids.
+Use as
+  emacs -batch -q -no-site-file -l emacs/cperl-mode.el \
+        -f cperl-add-tags-recurse 
+"
+  (cperl-write-tags nil nil t t nil t))
+
+(defun cperl-add-tags-recurse ()
+  "Add to TAGS file data for Perl files in the current directory and kids.
+Use as
+  emacs -batch -q -no-site-file -l emacs/cperl-mode.el \
+        -f cperl-add-tags-recurse 
+"
+  (cperl-write-tags nil nil t t))
+
+(defun cperl-write-tags (&optional file erase recurse dir inbuffer noxs topdir)
   ;; If INBUFFER, do not select buffer, and do not save
   ;; If ERASE is `ignore', do not erase, and do not try to delete old info.
   (require 'etags)
   (if file nil
     (setq file (if dir default-directory (buffer-file-name)))
     (if (and (not dir) (buffer-modified-p)) (error "Save buffer first!")))
+  (or topdir
+      (setq topdir default-directory))
   (let ((tags-file-name "TAGS")
 	(case-fold-search (eq system-type 'emx))
 	xs)
@@ -4407,28 +4518,31 @@ in subdirectories too."
 				nil)
 			       ((not (file-directory-p file))
 				(if (string-match cperl-scan-files-regexp file)
-				    (cperl-write-tags file erase recurse nil t)))
+				    (cperl-write-tags file erase recurse nil t noxs topdir)))
 			       ((not recurse) nil)
-			       (t (cperl-write-tags file erase recurse t t)))))
+			       (t (cperl-write-tags file erase recurse t t noxs topdir)))))
 		  files))
 	)
        (t
 	(setq xs (string-match "\\.xs$" file))
-	(cond ((eq erase 'ignore) (goto-char (point-max)))
-	      (erase (erase-buffer))
-	      (t
-	       (goto-char 1)
-	       (if (search-forward (concat "\f\n" file ",") nil t)
-		   (progn
-		     (search-backward "\f\n")
-		     (delete-region (point)
-				    (save-excursion
-				      (forward-char 1)
-				      (if (search-forward "\f\n" nil 'toend)
-				       (- (point) 2)
-				       (point-max)))))
-		 (goto-char (point-max)))))
-	(insert (cperl-find-tags file xs))))
+	(if (not (and xs noxs))
+	    (progn
+	      (cond ((eq erase 'ignore) (goto-char (point-max)))
+		  (erase (erase-buffer))
+		  (t
+		   (goto-char 1)
+		   (if (search-forward (concat "\f\n" file ",") nil t)
+		       (progn
+			 (search-backward "\f\n")
+			 (delete-region (point)
+					(save-excursion
+					  (forward-char 1)
+					  (if (search-forward "\f\n" 
+							      nil 'toend)
+					      (- (point) 2)
+					    (point-max)))))
+		     (goto-char (point-max)))))
+	      (insert (cperl-find-tags file xs topdir))))))
       (if inbuffer nil		; Delegate to the caller
 	(save-buffer 0)		; No backup
 	(if (fboundp 'initialize-new-tags-table) ; Do we need something special in XEmacs?
@@ -4901,7 +5015,7 @@ than a line. Your contribution to update/shorten it is appreciated."
 ... !~ ...	Search pattern, substitution, or translation (negated).
 $!	In numeric context: errno. In a string context: error string.
 $\"	The separator which joins elements of arrays interpolated in strings.
-$#	The output format for printed numbers. Initial value is %.20g.
+$#	The output format for printed numbers. Initial value is %.15g or close.
 $$	Process number of this script. Changes in the fork()ed child process.
 $%	The current page number of the currently selected output channel.
 
diff --git a/emacs/ptags b/emacs/ptags
new file mode 100755
index 0000000000..8831988c92
--- /dev/null
+++ b/emacs/ptags
@@ -0,0 +1,121 @@
+# Make a TAGS file for emacs ``M-x find-tag'' from all <c,h,y,xs> source files.
+# (``make realclean'' first to avoid generated files, or ``make'' first
+# to get tags from all files.)
+#
+# (IZ: to be a happier jumper: install 'imenu-go.el' from
+#      ftp://ftp.math.ohio-state.edu/pub/users/ilya/emacs.)
+#
+# (Some tags should probably live in their own subdirs, like those in x2p/,
+# but I have never been interested in x2p anyway.)
+#
+# Hallvard B Furuseth <h.b.furuseth@usit.uio.no>, Aug -96.
+#
+# Ilya Zakharevich, Oct 97: minor comments, add CPerl scan;
+#   Use Hallvard's scan for XS files - since he processes the "C" part too -
+#   but with a lot of improvements: now it is no worse than CPerl's one.
+
+# Avoid builitin on OS/2:
+if test ! -z "$OS2_SHELL"; then alias find=gnufind; fi
+
+# Insure proper order (.h after .c, .xs before .c in subdirs):
+topfiles="`echo ' ' *.y *.c *.h ' ' | sed 's/ embed.h / /'`"
+subdirfiles="`( find ./*/* -name '*.[cy]' -print | sort ; find ./*/* -name '*.[hH]' -print | sort )`"
+xsfiles="`find . -name '*.xs' -print | sort`"
+
+# What is `etags -d'?
+
+# These are example lines for global variables and PP-code:
+## IEXT SV *       Iparsehook;
+## IEXT char *     Isplitstr IINIT(" ");
+## dEXTCONST char rcsid[] = "perl.c\nPatch level: ###\n";
+## PP(pp_const)
+
+set x	-d -l c \
+	-r '/[dI]?EXT\(CONST\)?[ \t*]+\([a-zA-Z_0-9]+[ \t*]+\)*\([a-zA-Z_0-9]+\)[ \t]*\($\|;\|\[\|[ \t]I+NIT[ \t]*(\|\/\*\)/\3/' \
+	-r '/IEXT[ \t][^\/]*[ \t*]I\([a-zA-Z_][a-zA-Z_0-9]*\)[\[; \t]/\1/'  \
+	-r '/PP[ \t]*([ \t]*\([^ \t()]*\)[ \t]*)/\1/'
+
+shift
+
+rm -f TAGS.tmp TAGS.tm2
+
+# Process lines like this: #define MEM_ALIGNBYTES $alignbytes      /**/
+etags -o TAGS.tmp \
+	-l none -r '/#\(\$[a-zA-Z_0-9]+\|define\)[ \t]+\([a-zA-Z_0-9]+\)/\2/' \
+	config_h.SH
+etags -o TAGS.tmp -a "$@" $topfiles
+etags -o TAGS.tmp -a -D -l none -r '/#define.*\t\(Perl_.*\)/\1/' embed.h
+
+# Add MODULE lines to TAG files (to be postprocessed later),
+#   and BOOT: lines (in DynaLoader processed twice?)
+
+# This skips too many XSUBs:
+
+# etags -o TAGS.tmp -a -d -l c \
+# 	-r '/MODULE[ \t=]+\(.*PACKAGE[ \t]*=[ \t]*\)?\([^ \t]+\)\([ \t]*PREFIX[ \t]*=[ \t]*\([^ \t]+\)\)?/\2/' \
+# 	-r '/[ \t]*BOOT:/' \
+# 	$xsfiles
+
+etags -o TAGS.tmp -a -d -l c \
+	-r '/MODULE[ \t=]+\(.*PACKAGE[ \t]*=[ \t]*\)?\([^ \t]+\)\([ \t]*PREFIX[ \t]*=[ \t]*\([^ \t]+\)\)?/\2/' \
+	-r '/[ \t]*BOOT:/' \
+	-r '/\([_a-zA-Z][a-zA-Z0-9_:]*\)(/' \
+	$xsfiles
+
+#	-r '/MODULE[ \t=]+\(.*PACKAGE[ \t]*=[ \t]*\)?\([^ \t]+\)/\2/' \
+#	-r '/MODULE.*PREFIX[ \t]*=[ \t]*\([^ \t]+\)/\1/'	\
+#	$xsfiles
+
+etags -o TAGS.tmp -a "$@" $subdirfiles
+
+if ! test -f emacs/cperl-mode.elc ; then
+    ( cd emacs; emacs -batch -q -no-site-file -f batch-byte-compile cperl-mode.el )
+fi
+
+# This should work with newer Emaxen
+
+cp TAGS.tmp TAGS
+if emacs -batch -q -no-site-file -l emacs/cperl-mode.elc -f cperl-add-tags-recurse-noxs ; then
+    mv TAGS TAGS.tmp
+fi
+
+perl -w014pe '
+    $update  = s/^PP\(\177\d+,\d+\n//gm;
+    $update += s/^(I?EXT.*[ \t])IINIT[ \t]*\((\177)/$1$2/gm;
+    if (/^\n*[^\s,]+\.xs,/s) {
+	$mod = $cmod = $bmod = $pref = "";
+	s/^(.*\n)\1+/$1/mg;			# Remove duplicate lines
+	$_ = join("", map {
+	    if (/^MODULE[ \t]*=[ \t]*(\S+)(?:[ \t]+PACKAGE[ \t]*=[ \t]*(\S+))?[ \t\177]/m) {
+		$mod = $+;
+		($bmod = $mod) =~ tr/:/_/;
+		$cmod = "XS_${bmod}_";
+		$pref = "";
+		if (s/[ \t]+PREFIX[ \t]*=[ \t]*([^\s\177]+)(\177)/$+/) {
+		    $pref = $1;
+		    $pref =~ s/([^\w\s])/\\$1/g;
+		    $pref = "(?:$pref)?";
+		}
+	    } elsif ($mod ne "") {
+		# Ref points for Module::subr, XS_Module_subr, subr
+		s/^($pref(\w+)[ \t()]*\177)(\d+,\d+)$/$1${mod}::${2}\01$3\n$1$2\01$3\n$1$cmod$2\01$3/gm;
+		# Ref for Module::bootstrap bootstrap boot_Module
+		s/^([ \t]*BOOT:\177)(\d+,\d+)$/$1${mod}::bootstrap\01$2\n${1}bootstrap\01$2\n${1}boot_$bmod\01$2/gm;
+	    }
+	    $_;
+	} split(/(\nMODULE[ \t]*=[^\n\177]+\177)/));
+
+	$update = 1;
+    }
+    if ($update) {
+	$chars = chomp;
+	s/^((\n.+,)\d+)/ $2 . (length($_) - length($1) - 1) /e;
+	$_ .= ("\f" x $chars);
+    }' TAGS.tmp > TAGS.tm2
+
+rm -f TAGS
+mv TAGS.tm2 TAGS
+rm -f TAGS.tmp
+
+
+
diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs
index 959f3425eb..b6e8a03792 100644
--- a/ext/DB_File/DB_File.xs
+++ b/ext/DB_File/DB_File.xs
@@ -52,6 +52,11 @@
 #include "perl.h"
 #include "XSUB.h"
 
+/* Being the Berkeley DB we prefer the <sys/cdefs.h> (which will be
+ * shortly #included by the <db.h>) __attribute__ to the possibly
+ * already defined __attribute__, for example by GNUC or by Perl. */
+#undef __attribute__
+
 #include <db.h>
 /* #ifdef DB_VERSION_MAJOR */
 /* #include <db_185.h> */
diff --git a/ext/DynaLoader/dl_aix.xs b/ext/DynaLoader/dl_aix.xs
index 746666636a..548fe41a9c 100644
--- a/ext/DynaLoader/dl_aix.xs
+++ b/ext/DynaLoader/dl_aix.xs
@@ -77,6 +77,18 @@ static int readExports(ModulePtr);
 static void terminate(void);
 static void *findMain(void);
 
+char *strerrorcat(char *str, int err) {
+    char buf[8192];
+    strerror_r(err, buf, sizeof(buf));
+    strcat(str,buf);
+    return str;
+}
+char *strerrorcpy(char *str, int err) {
+    char buf[8192];
+    strerror_r(err, buf, sizeof(buf));
+    strcpy(str,buf);
+    return str;
+}
   
 /* ARGSUSED */
 void *dlopen(char *path, int mode)
@@ -106,14 +118,14 @@ void *dlopen(char *path, int mode)
 	if (mp == NULL) {
 		errvalid++;
 		strcpy(errbuf, "Newz: ");
-		strcat(errbuf, strerror(errno));
+		strerrorcat(errbuf, errno);
 		return NULL;
 	}
 	
 	if ((mp->name = savepv(path)) == NULL) {
 		errvalid++;
 		strcpy(errbuf, "savepv: ");
-		strcat(errbuf, strerror(errno));
+		strerrorcat(errbuf, errno);
 		safefree(mp);
 		return NULL;
 	}
@@ -136,14 +148,14 @@ void *dlopen(char *path, int mode)
 		if (errno == ENOEXEC) {
 			char *tmp[BUFSIZ/sizeof(char *)];
 			if (loadquery(L_GETMESSAGES, tmp, sizeof(tmp)) == -1)
-				strcpy(errbuf, strerror(errno));
+				strerrorcpy(errbuf, errno);
 			else {
 				char **p;
 				for (p = tmp; *p; p++)
 					caterr(*p);
 			}
 		} else
-			strcat(errbuf, strerror(errno));
+			strerrorcat(errbuf, errno);
 		return NULL;
 	}
 	mp->refCnt = 1;
@@ -153,7 +165,7 @@ void *dlopen(char *path, int mode)
 		dlclose(mp);
 		errvalid++;
 		strcpy(errbuf, "loadbind: ");
-		strcat(errbuf, strerror(errno));
+		strerrorcat(errbuf, errno);
 		return NULL;
 	}
 	if (readExports(mp) == -1) {
@@ -194,7 +206,7 @@ static void caterr(char *s)
 		strcat(errbuf, p);
 		break;
 	case L_ERROR_ERRNO:
-		strcat(errbuf, strerror(atoi(++p)));
+		strerrorcat(errbuf, atoi(++p));
 		break;
 	default:
 		strcat(errbuf, s);
@@ -241,7 +253,7 @@ int dlclose(void *handle)
 	result = unload(mp->entry);
 	if (result == -1) {
 		errvalid++;
-		strcpy(errbuf, strerror(errno));
+		strerrorcpy(errbuf, errno);
 	}
 	if (mp->exports) {
 		register ExportPtr ep;
@@ -306,7 +318,7 @@ static int readExports(ModulePtr mp)
 		if (errno != ENOENT) {
 			errvalid++;
 			strcpy(errbuf, "readExports: ");
-			strcat(errbuf, strerror(errno));
+			strerrorcat(errbuf, errno);
 			return -1;
 		}
 		/*
@@ -317,7 +329,7 @@ static int readExports(ModulePtr mp)
 		if ((buf = safemalloc(size)) == NULL) {
 			errvalid++;
 			strcpy(errbuf, "readExports: ");
-			strcat(errbuf, strerror(errno));
+			strerrorcat(errbuf, errno);
 			return -1;
 		}
 		while ((i = loadquery(L_GETINFO, buf, size)) == -1 && errno == ENOMEM) {
@@ -326,14 +338,14 @@ static int readExports(ModulePtr mp)
 			if ((buf = safemalloc(size)) == NULL) {
 				errvalid++;
 				strcpy(errbuf, "readExports: ");
-				strcat(errbuf, strerror(errno));
+				strerrorcat(errbuf, errno);
 				return -1;
 			}
 		}
 		if (i == -1) {
 			errvalid++;
 			strcpy(errbuf, "readExports: ");
-			strcat(errbuf, strerror(errno));
+			strerrorcat(errbuf, errno);
 			safefree(buf);
 			return -1;
 		}
@@ -357,7 +369,7 @@ static int readExports(ModulePtr mp)
 		if (!ldp) {
 			errvalid++;
 			strcpy(errbuf, "readExports: ");
-			strcat(errbuf, strerror(errno));
+			strerrorcat(errbuf, errno);
 			return -1;
 		}
 	}
@@ -382,7 +394,7 @@ static int readExports(ModulePtr mp)
 	if ((ldbuf = (char *)safemalloc(sh.s_size)) == NULL) {
 		errvalid++;
 		strcpy(errbuf, "readExports: ");
-		strcat(errbuf, strerror(errno));
+		strerrorcat(errbuf, errno);
 		while(ldclose(ldp) == FAILURE)
 			;
 		return -1;
@@ -423,7 +435,7 @@ static int readExports(ModulePtr mp)
 	if (mp->exports == NULL) {
 		errvalid++;
 		strcpy(errbuf, "readExports: ");
-		strcat(errbuf, strerror(errno));
+		strerrorcat(errbuf, errno);
 		safefree(ldbuf);
 		while(ldclose(ldp) == FAILURE)
 			;
@@ -468,7 +480,7 @@ static void * findMain(void)
 	if ((buf = safemalloc(size)) == NULL) {
 		errvalid++;
 		strcpy(errbuf, "findMain: ");
-		strcat(errbuf, strerror(errno));
+		strerrorcat(errbuf, errno);
 		return NULL;
 	}
 	while ((i = loadquery(L_GETINFO, buf, size)) == -1 && errno == ENOMEM) {
@@ -477,14 +489,14 @@ static void * findMain(void)
 		if ((buf = safemalloc(size)) == NULL) {
 			errvalid++;
 			strcpy(errbuf, "findMain: ");
-			strcat(errbuf, strerror(errno));
+			strerrorcat(errbuf, errno);
 			return NULL;
 		}
 	}
 	if (i == -1) {
 		errvalid++;
 		strcpy(errbuf, "findMain: ");
-		strcat(errbuf, strerror(errno));
+		strerrorcat(errbuf, errno);
 		safefree(buf);
 		return NULL;
 	}
diff --git a/ext/Thread/Makefile.PL b/ext/Thread/Makefile.PL
index d699091cc1..bed0db43d7 100644
--- a/ext/Thread/Makefile.PL
+++ b/ext/Thread/Makefile.PL
@@ -1,2 +1,6 @@
 use ExtUtils::MakeMaker;
-WriteMakefile(NAME => "Thread");
+WriteMakefile(
+	NAME => 'Thread',
+	VERSION_FROM => 'Thread.pm'
+	);
+
diff --git a/ext/Thread/Thread.pm b/ext/Thread/Thread.pm
index 1936142e52..48ca3047b9 100644
--- a/ext/Thread/Thread.pm
+++ b/ext/Thread/Thread.pm
@@ -1,6 +1,10 @@
 package Thread;
 require Exporter;
 require DynaLoader;
+use vars qw($VERSION @ISA @EXPORT);
+
+$VERSION = "1.0";
+
 @ISA = qw(Exporter DynaLoader);
 @EXPORT_OK = qw(yield cond_signal cond_broadcast cond_wait async);
 
diff --git a/ext/Thread/Thread.xs b/ext/Thread/Thread.xs
index 0844312dd4..c0d551d612 100644
--- a/ext/Thread/Thread.xs
+++ b/ext/Thread/Thread.xs
@@ -16,13 +16,13 @@ static U32 threadnum = 0;
 static int sig_pipe[2];
             
 #ifndef THREAD_RET_TYPE
-typedef struct thread *Thread;
+typedef struct perl_thread *Thread;
 #define THREAD_RET_TYPE void *
 #define THREAD_RET_CAST(x) ((THREAD_RET_TYPE) x)
 #endif
 
 static void
-remove_thread(struct thread *t)
+remove_thread(struct perl_thread *t)
 {
 #ifdef USE_THREADS
     DEBUG_L(WITH_THR(PerlIO_printf(PerlIO_stderr(),
@@ -106,8 +106,8 @@ threadstart(void *arg)
 
     /*
      * It's safe to wait until now to set the thread-specific pointer
-     * from our pthread_t structure to our struct thread, since we're
-     * the only thread who can get at it anyway.
+     * from our pthread_t structure to our struct perl_thread, since
+     * we're the only thread who can get at it anyway.
      */
     SET_THR(thr);
 
@@ -128,12 +128,12 @@ threadstart(void *arg)
 	av_store(av, 0, &sv_no);
 	av_store(av, 1, newSVsv(thr->errsv));
 	DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p died: %s\n",
-			      SvPV(thr->errsv, na));
+			      SvPV(thr->errsv, na)));
     } else {
 	DEBUG_L(STMT_START {
 	    for (i = 1; i <= retval; i++) {
 		PerlIO_printf(PerlIO_stderr(), "%p return[%d] = %s\n",
-				thr, i, SvPEEK(sp[i - 1]));)
+				thr, i, SvPEEK(sp[i - 1]));
 	    }
 	} STMT_END);
 	av_store(av, 0, &sv_yes);
@@ -234,8 +234,27 @@ newthread (SV *startsv, AV *initargs, char *classname)
     sigfillset(&fullmask);
     if (sigprocmask(SIG_SETMASK, &fullmask, &oldmask) == -1)
 	croak("panic: sigprocmask");
+#ifdef PTHREADS_CREATED_JOINABLE
     err = pthread_create(&thr->self, pthread_attr_default,
 			 threadstart, (void*) thr);
+#else
+    {
+	pthread_attr_t attr;
+
+	err = pthread_attr_init(&attr);
+	if (err == 0) {
+#ifdef PTHREAD_CREATE_UNDETACHED
+	  err = pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_UNDETACHED);
+#else
+	  croak("panic: pthread_attr_setdetachstate");
+#endif
+	  if (err == 0) 
+	    err = pthread_create(&thr->self, &attr,
+				 threadstart, (void*) thr);
+	}
+	pthread_attr_destroy(&attr);
+    }
+#endif
     /* Go */
     MUTEX_UNLOCK(&thr->mutex);
 #endif
diff --git a/fakethr.h b/fakethr.h
index e09a757b6d..8b1e76ff9b 100644
--- a/fakethr.h
+++ b/fakethr.h
@@ -1,12 +1,12 @@
 typedef int perl_mutex;
 typedef int perl_key;
 
-typedef struct thread *perl_thread;
+typedef struct perl_thread *perl_os_thread;
 /* With fake threads, thr is global(ish) so we don't need dTHR */
 #define dTHR extern int errno
 
 struct perl_wait_queue {
-    struct thread *		thread;
+    struct perl_thread *	thread;
     struct perl_wait_queue *	next;
 };
 typedef struct perl_wait_queue *perl_cond;
@@ -14,7 +14,7 @@ typedef struct perl_wait_queue *perl_cond;
 /* Ask thread.h to include our per-thread extras */
 #define HAVE_THREAD_INTERN
 struct thread_intern {
-    perl_thread next_run, prev_run;     /* Linked list of runnable threads */
+    perl_os_thread next_run, prev_run;  /* Linked list of runnable threads */
     perl_cond   wait_queue;             /* Wait queue that we are waiting on */
     IV          private;                /* Holds data across time slices */
     I32         savemark;               /* Holds MARK for thread join values */
diff --git a/global.sym b/global.sym
index d7f78306f7..4be609a207 100644
--- a/global.sym
+++ b/global.sym
@@ -188,6 +188,8 @@ rsfp_filters
 rshift_amg
 rshift_ass_amg
 runops
+runops_debug
+runops_standard
 savestack
 savestack_ix
 savestack_max
diff --git a/hints/aix.sh b/hints/aix.sh
index 2c42151ea6..41706ac3a6 100644
--- a/hints/aix.sh
+++ b/hints/aix.sh
@@ -1,6 +1,8 @@
 # hints/aix.sh
 # AIX 3.x.x hints thanks to Wayne Scott <wscott@ichips.intel.com>
 # AIX 4.1 hints thanks to Christopher Chan-Nui <channui@austin.ibm.com>.
+# AIX 4.1 pthreading by Christopher Chan-Nui <channui@austin.ibm.com> and
+#         Jarkko Hietaniemi <jhi@iki.fi>.
 # Merged on Mon Feb  6 10:22:35 EST 1995 by
 #   Andy Dougherty  <doughera@lafcol.lafayette.edu>
 
@@ -74,3 +76,32 @@ lddlflags='-H512 -T512 -bhalt:4 -bM:SRE -bI:$(PERL_INC)/perl.exp -bE:$(BASEEXT).
 
 ;;
 esac
+
+if [ "X$usethreads" != "X" ]; then
+    ccflags="-DUSE_THREADS -DNEED_PTHREAD_INIT $ccflags"
+    cppflags="-DUSE_THREADS -DNEED_PTHREAD_INIT $cppflags"
+    case "$cc" in
+    xlc_r | cc_r)
+	;;
+    cc | '') 
+	cc=xlc_r
+        ;;
+    *)
+	case "$cc" in
+	gcc)
+	    echo >&4 "You cannot use POSIX threads from GNU cc in AIX."
+	    ;;
+	*)
+	    echo >&4 "Unknown C compiler."
+	    ;;
+	esac
+	echo >&4 "You should use the AIX C compilers called xlc_r or cc_r."
+	echo >&4 "Cannot continue, aborting."
+	exit 1
+	;;
+    esac
+
+    # Add the POSIX threads library and use the re-entrant libc.
+
+    lddlflags=`echo $lddlflags | sed 's/ -lc$/ -lpthreads -lc_r/'`
+fi
diff --git a/hv.c b/hv.c
index f3ab6ccbb9..e495e91769 100644
--- a/hv.c
+++ b/hv.c
@@ -216,6 +216,29 @@ hv_fetch_ent(HV *hv, SV *keysv, I32 lval, register U32 hash)
     return 0;
 }
 
+static void
+hv_magic_check (hv, needs_copy, needs_store)
+HV *hv;
+bool *needs_copy;
+bool *needs_store;
+{
+    MAGIC *mg = SvMAGIC(hv);
+    *needs_copy = FALSE;
+    *needs_store = TRUE;
+    while (mg) {
+	if (isUPPER(mg->mg_type)) {
+	    *needs_copy = TRUE;
+	    switch (mg->mg_type) {
+	    case 'P':
+	    case 'I':
+	    case 'S':
+		*needs_store = FALSE;
+	    }
+	}
+	mg = mg->mg_moremagic;
+    }
+}
+
 SV**
 hv_store(HV *hv, char *key, U32 klen, SV *val, register U32 hash)
 {
@@ -229,15 +252,14 @@ hv_store(HV *hv, char *key, U32 klen, SV *val, register U32 hash)
 
     xhv = (XPVHV*)SvANY(hv);
     if (SvMAGICAL(hv)) {
-	mg_copy((SV*)hv, val, key, klen);
-	if (!xhv->xhv_array
-	    && (SvMAGIC(hv)->mg_moremagic
-		|| (SvMAGIC(hv)->mg_type != 'E'
-#ifdef OVERLOAD
-		    && SvMAGIC(hv)->mg_type != 'A'
-#endif /* OVERLOAD */
-		    )))
-	    return 0;
+	bool needs_copy;
+	bool needs_store;
+	hv_magic_check (hv, &needs_copy, &needs_store);
+	if (needs_copy) {
+	    mg_copy((SV*)hv, val, key, klen);
+	    if (!xhv->xhv_array && !needs_store)
+		return 0;
+	}
     }
     if (!hash)
 	PERL_HASH(hash, key, klen);
@@ -295,20 +317,19 @@ hv_store_ent(HV *hv, SV *keysv, SV *val, register U32 hash)
     xhv = (XPVHV*)SvANY(hv);
     if (SvMAGICAL(hv)) {
 	dTHR;
-	bool save_taint = tainted;
-	if (tainting)
-	    tainted = SvTAINTED(keysv);
-	keysv = sv_2mortal(newSVsv(keysv));
-	mg_copy((SV*)hv, val, (char*)keysv, HEf_SVKEY);
-	TAINT_IF(save_taint);
-	if (!xhv->xhv_array
-	    && (SvMAGIC(hv)->mg_moremagic
-		|| (SvMAGIC(hv)->mg_type != 'E'
-#ifdef OVERLOAD
-		    && SvMAGIC(hv)->mg_type != 'A'
-#endif /* OVERLOAD */
-		    )))
-	  return Nullhe;
+ 	bool needs_copy;
+ 	bool needs_store;
+ 	hv_magic_check (hv, &needs_copy, &needs_store);
+ 	if (needs_copy) {
+ 	    bool save_taint = tainted;
+ 	    if (tainting)
+ 		tainted = SvTAINTED(keysv);
+ 	    keysv = sv_2mortal(newSVsv(keysv));
+ 	    mg_copy((SV*)hv, val, (char*)keysv, HEf_SVKEY);
+ 	    TAINT_IF(save_taint);
+ 	    if (!xhv->xhv_array && !needs_store)
+ 		return Nullhe;
+ 	}
     }
 
     key = SvPV(keysv, klen);
diff --git a/malloc.c b/malloc.c
index 00ca55663f..ae3773acc0 100644
--- a/malloc.c
+++ b/malloc.c
@@ -2,6 +2,8 @@
  *
  */
 
+#define EMBEDMYMALLOC
+
 #if defined(PERL_CORE) && !defined(DEBUGGING_MSTATS)
 #  define DEBUGGING_MSTATS
 #endif 
@@ -189,6 +191,7 @@ emergency_sbrk(size)
     }
 
     if (!emergency_buffer) {		
+	dTHR;
 	/* First offense, give a possibility to recover by dieing. */
 	/* No malloc involved here: */
 	GV **gvp = (GV**)hv_fetch(defstash, "^M", 2, 0);
diff --git a/op.c b/op.c
index 029aac85a7..590aa006c9 100644
--- a/op.c
+++ b/op.c
@@ -3739,8 +3739,10 @@ newSVREF(OP *o)
 	o->op_ppaddr = ppaddr[OP_PADSV];
 	return o;
     }
-    else if (o->op_type == OP_THREADSV)
+    else if (o->op_type == OP_THREADSV && !(o->op_flags & OPpDONE_SVREF)) {
+	o->op_flags |= OPpDONE_SVREF;
 	return o;
+    }
     return newUNOP(OP_RV2SV, 0, scalar(o));
 }
 
diff --git a/op.h b/op.h
index e3d3f3d93e..fbb5b8c8dd 100644
--- a/op.h
+++ b/op.h
@@ -131,8 +131,8 @@ typedef U32 PADOFFSET;
 /* Private for OP_SORT, OP_PRTF, OP_SPRINTF, string cmp'n, and case changers */
 #define OPpLOCALE		64	/* Use locale */
 
-/* Private for OP_SPECIFIC */
-#define OPpPM_NOT_CONST		64	/* Not constant enough for pmruntime */
+/* Private for OP_THREADSV */
+#define OPpDONE_SVREF		64	/* Been through newSVREF once */
 
 struct op {
     BASEOP
diff --git a/os2/os2.c b/os2/os2.c
index 8a292e30f2..44f99c4c24 100644
--- a/os2/os2.c
+++ b/os2/os2.c
@@ -1147,6 +1147,7 @@ Perl_OS2_init(char **env)
 {
     char *shell;
 
+    MALLOC_INIT;
     settmppath();
     OS2_Perl_data.xs_init = &Xs_OS2_init;
     if (environ == NULL) {
diff --git a/os2/os2ish.h b/os2/os2ish.h
index b62e3d04d4..9a3d267ae5 100644
--- a/os2/os2ish.h
+++ b/os2/os2ish.h
@@ -74,7 +74,7 @@ void Perl_OS2_init(char **);
     _wildcard(argcp, argvp);			\
     Perl_OS2_init(env);	} STMT_END
 
-#define PERL_SYS_TERM()
+#define PERL_SYS_TERM()		MALLOC_TERM
 
 /* #define PERL_SYS_TERM() STMT_START {	\
     if (Perl_HAB_set) WinTerminate(Perl_hab);	} STMT_END */
diff --git a/patchlevel.h b/patchlevel.h
index c5dff601ed..499b311d2f 100644
--- a/patchlevel.h
+++ b/patchlevel.h
@@ -1,5 +1,5 @@
 #define PATCHLEVEL 4
-#define SUBVERSION 54
+#define SUBVERSION 55
 
 /*
 	local_patches -- list of locally applied less-than-subversion patches.
diff --git a/perl.c b/perl.c
index 3608f0dd34..8257b36408 100644
--- a/perl.c
+++ b/perl.c
@@ -70,7 +70,7 @@ static void init_debugger _((void));
 static void init_lexer _((void));
 static void init_main_stash _((void));
 #ifdef USE_THREADS
-static struct thread * init_main_thread _((void));
+static struct perl_thread * init_main_thread _((void));
 #endif /* USE_THREADS */
 static void init_perllib _((void));
 static void init_postdump_symbols _((int, char **, char **));
@@ -112,7 +112,7 @@ perl_construct(register PerlInterpreter *sv_interp)
 #ifdef USE_THREADS
     int i;
 #ifndef FAKE_THREADS
-    struct thread *thr;
+    struct perl_thread *thr;
 #endif /* FAKE_THREADS */
 #endif /* USE_THREADS */
     
@@ -134,7 +134,6 @@ perl_construct(register PerlInterpreter *sv_interp)
 	if (pthread_key_create(&thr_key, 0))
 	    croak("panic: pthread_key_create");
 #endif
-	MUTEX_INIT(&malloc_mutex);
 	MUTEX_INIT(&sv_mutex);
 	/*
 	 * Safe to use basic SV functions from now on (though
@@ -529,7 +528,6 @@ perl_destruct(register PerlInterpreter *sv_interp)
     DEBUG_P(debprofdump());
 #ifdef USE_THREADS
     MUTEX_DESTROY(&sv_mutex);
-    MUTEX_DESTROY(&malloc_mutex);
     MUTEX_DESTROY(&eval_mutex);
     COND_DESTROY(&eval_cond);
 
@@ -2780,13 +2778,13 @@ incpush(char *p, int addsubdirs)
 }
 
 #ifdef USE_THREADS
-static struct thread *
+static struct perl_thread *
 init_main_thread()
 {
-    struct thread *thr;
+    struct perl_thread *thr;
     XPV *xpv;
 
-    Newz(53, thr, 1, struct thread);
+    Newz(53, thr, 1, struct perl_thread);
     curcop = &compiling;
     thr->cvcache = newHV();
     thr->threadsv = newAV();
diff --git a/perl.h b/perl.h
index 724384f9e9..c05d4a91c3 100644
--- a/perl.h
+++ b/perl.h
@@ -1058,7 +1058,7 @@ union any {
 };
 
 #ifdef USE_THREADS
-#define ARGSproto struct thread *thr
+#define ARGSproto struct perl_thread *thr
 #else
 #define ARGSproto void
 #endif /* USE_THREADS */
@@ -1343,6 +1343,14 @@ typedef Sighandler_t Sigsave_t;
 # define RUNOPS_DEFAULT runops_standard
 #endif
 
+#ifdef MYMALLOC
+#  define MALLOC_INIT MUTEX_INIT(&malloc_mutex)
+#  define MALLOC_TERM MUTEX_DESTROY(&malloc_mutex)
+#else
+#  define MALLOC_INIT
+#  define MALLOC_TERM
+#endif
+
 /*
  * These need prototyping here because <proto.h> isn't
  * included until after runops is initialised.
@@ -1362,18 +1370,18 @@ int runops_debug _((void));
 /* global state */
 EXT PerlInterpreter *	curinterp;	/* currently running interpreter */
 #ifdef USE_THREADS
-EXT perl_key		thr_key;	/* For per-thread struct thread ptr */
+EXT perl_key		thr_key;	/* For per-thread struct perl_thread* */
 EXT perl_mutex		sv_mutex;	/* Mutex for allocating SVs in sv.c */
 EXT perl_mutex		malloc_mutex;	/* Mutex for malloc */
 EXT perl_mutex		eval_mutex;	/* Mutex for doeval */
 EXT perl_cond		eval_cond;	/* Condition variable for doeval */
-EXT struct thread *	eval_owner;	/* Owner thread for doeval */
+EXT struct perl_thread *	eval_owner;	/* Owner thread for doeval */
 EXT int			nthreads;	/* Number of threads currently */
 EXT perl_mutex		threads_mutex;	/* Mutex for nthreads and thread list */
 EXT perl_cond		nthreads_cond;	/* Condition variable for nthreads */
 EXT char *		threadsv_names INIT(THREADSV_NAMES);
 #ifdef FAKE_THREADS
-EXT struct thread *	thr;		/* Currently executing (fake) thread */
+EXT struct perl_thread *	thr;	/* Currently executing (fake) thread */
 #endif
 #endif /* USE_THREADS */
 
@@ -1959,7 +1967,7 @@ IEXT SV *	Imess_sv;
 
 #ifdef USE_THREADS
 /* threads stuff */
-IEXT SV *	Ithrsv;		/* holds struct thread for main thread */
+IEXT SV *	Ithrsv;		/* holds struct perl_thread for main thread */
 #endif /* USE_THREADS */
 
 #undef IEXT
@@ -2301,6 +2309,10 @@ EXT bool	numeric_local INIT(TRUE);    /* Assume local numerics */
 #define PERL_SCRIPT_MODE "r"
 #endif
 
+#ifndef PERL_SCRIPT_MODE
+#define PERL_SCRIPT_MODE "r"
+#endif
+
 /*
  * nice_chunk and nice_chunk size need to be set
  * and queried under the protection of sv_mutex
diff --git a/plan9/plan9ish.h b/plan9/plan9ish.h
index 3a5ad5eb1a..9c8bd5049f 100644
--- a/plan9/plan9ish.h
+++ b/plan9/plan9ish.h
@@ -98,9 +98,9 @@
 #define ABORT() kill(getpid(),SIGABRT);
 
 #define BIT_BUCKET "/dev/null"
-#define PERL_SYS_INIT(c,v)
+#define PERL_SYS_INIT(c,v)	MALLOC_INIT
 #define dXSUB_SYS
-#define PERL_SYS_TERM()
+#define PERL_SYS_TERM()		MALLOC_TERM
 
 /*
  * fwrite1() should be a routine with the same calling sequence as fwrite(),
diff --git a/pp.h b/pp.h
index bc39f80055..1914fcc5b5 100644
--- a/pp.h
+++ b/pp.h
@@ -9,7 +9,7 @@
 
 #ifdef USE_THREADS
 #define ARGS thr
-#define dARGS struct thread *thr;
+#define dARGS struct perl_thread *thr;
 #else
 #define ARGS
 #define dARGS
diff --git a/pp_ctl.c b/pp_ctl.c
index d79145c719..d9f985e8e4 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -546,11 +546,12 @@ PP(pp_grepstart)
     ENTER;					/* enter outer scope */
 
     SAVETMPS;
-#if 0
-    SAVE_DEFSV;
-#else
+#ifdef USE_THREADS
+    /* SAVE_DEFSV does *not* suffice here */
     save_sptr(av_fetch(thr->threadsv, find_threadsv("_"), FALSE));
-#endif
+#else
+    SAVESPTR(GvSV(defgv));
+#endif /* USE_THREADS */
     ENTER;					/* enter inner scope */
     SAVESPTR(curpm);
 
diff --git a/proto.h b/proto.h
index 35ef574f7b..202331be98 100644
--- a/proto.h
+++ b/proto.h
@@ -341,7 +341,7 @@ OP*	newUNOP _((I32 type, I32 flags, OP* first));
 OP*	newWHILEOP _((I32 flags, I32 debuggable, LOOP* loop,
 		      I32 whileline, OP* expr, OP* block, OP* cont));
 #ifdef USE_THREADS
-struct thread *	new_struct_thread _((struct thread *t));
+struct perl_thread *	new_struct_thread _((struct perl_thread *t));
 #endif
 PerlIO*	nextargv _((GV* gv));
 char*	ninstr _((char* big, char* bigend, char* little, char* lend));
diff --git a/sv.h b/sv.h
index 42a6a1bc95..1adaffe719 100644
--- a/sv.h
+++ b/sv.h
@@ -246,7 +246,7 @@ struct xpvfm {
     CV *	xcv_outside;
 #ifdef USE_THREADS
     perl_mutex *xcv_mutexp;	/* protects xcv_owner */
-    struct thread *xcv_owner;	/* current owner thread */
+    struct perl_thread *xcv_owner;	/* current owner thread */
 #endif /* USE_THREADS */
     cv_flags_t	xcv_flags;
 
diff --git a/thread.h b/thread.h
index 79059db8fc..656a693b36 100644
--- a/thread.h
+++ b/thread.h
@@ -5,7 +5,7 @@
 #else
 
 /* POSIXish threads */
-typedef pthread_t perl_thread;
+typedef pthread_t perl_os_thread;
 #ifdef OLD_PTHREADS_API
 #  define pthread_mutexattr_init(a) pthread_mutexattr_create(a)
 #  define pthread_mutexattr_settype(a,t) pthread_mutexattr_setkind_np(a,t)
@@ -26,7 +26,11 @@ typedef pthread_t perl_thread;
 #endif
 
 #ifndef YIELD
-#  define YIELD sched_yield()
+#  ifdef HAS_PTHREAD_YIELD
+#    define YIELD pthread_yield()
+#  else
+#    define YIELD sched_yield()
+#  endif
 #endif
 
 #ifndef MUTEX_INIT
@@ -109,15 +113,15 @@ typedef pthread_t perl_thread;
 
 #ifndef THR
 #  ifdef OLD_PTHREADS_API
-struct thread *getTHR _((void));
+struct perl_thread *getTHR _((void));
 #    define THR getTHR()
 #  else
-#    define THR ((struct thread *) pthread_getspecific(thr_key))
+#    define THR ((struct perl_thread *) pthread_getspecific(thr_key))
 #  endif /* OLD_PTHREADS_API */
 #endif /* THR */
 
 #ifndef dTHR
-#  define dTHR struct thread *thr = THR
+#  define dTHR struct perl_thread *thr = THR
 #endif /* dTHR */
 
 #ifndef INIT_THREADS
@@ -134,7 +138,7 @@ struct thread *getTHR _((void));
 #  define THREAD_RET_CAST(p)	((void *)(p))
 #endif /* THREAD_RET */
 
-struct thread {
+struct perl_thread {
     /* The fields that used to be global */
     /* Important ones in the first cache line (if alignment is done right) */
     SV **	Tstack_sp;
@@ -216,7 +220,7 @@ struct thread {
 
     SV *	oursv;
     HV *	cvcache;
-    perl_thread	self;			/* Underlying thread object */
+    perl_os_thread	self;		/* Underlying thread object */
     U32		flags;
     AV *	threadsv;		/* Per-thread SVs ($_, $@ etc.) */
     AV *	specific;		/* Thread-specific user data */
@@ -224,7 +228,7 @@ struct thread {
     HV *	errhv;			/* HV for what was %@ in pp_ctl.c */
     perl_mutex	mutex;			/* For the fields others can change */
     U32		tid;
-    struct thread *next, *prev;		/* Circular linked list of threads */
+    struct perl_thread *next, *prev;		/* Circular linked list of threads */
     JMPENV	Tstart_env;	        /* Top of top_env longjmp() chain */ 
 #ifdef HAVE_THREAD_INTERN
     struct thread_intern i;		/* Platform-dependent internals */
@@ -232,7 +236,7 @@ struct thread {
     char	trailing_nul;		/* For the sake of thrsv and oursv */
 };
 
-typedef struct thread *Thread;
+typedef struct perl_thread *Thread;
 
 /* Values and macros for thr->flags */
 #define THRf_STATE_MASK	7
diff --git a/unixish.h b/unixish.h
index a13e2bd86a..e4687ce50f 100644
--- a/unixish.h
+++ b/unixish.h
@@ -109,14 +109,14 @@
 #ifndef PERL_SYS_INIT
 #ifdef PERL_SCO5
 /* this should be set in a hint file, not here */
-#  define PERL_SYS_INIT(c,v)	fpsetmask(0)
+#  define PERL_SYS_INIT(c,v)	fpsetmask(0); MALLOC_INIT
 #else
-#  define PERL_SYS_INIT(c,v)
+#  define PERL_SYS_INIT(c,v)	MALLOC_INIT
 #endif
 #endif
 
 #ifndef PERL_SYS_TERM
-#define PERL_SYS_TERM()
+#define PERL_SYS_TERM()		MALLOC_TERM
 #endif
 
 #define BIT_BUCKET "/dev/null"
diff --git a/util.c b/util.c
index ab6ddd7d61..8f515f9515 100644
--- a/util.c
+++ b/util.c
@@ -2322,7 +2322,7 @@ void
 perl_cond_signal(cp)
 perl_cond *cp;
 {
-    perl_thread t;
+    perl_os_thread t;
     perl_cond cond = *cp;
     
     if (!cond)
@@ -2343,7 +2343,7 @@ void
 perl_cond_broadcast(cp)
 perl_cond *cp;
 {
-    perl_thread t;
+    perl_os_thread t;
     perl_cond cond, cond_next;
     
     for (cond = *cp; cond; cond = cond_next) {
@@ -2382,14 +2382,14 @@ perl_cond *cp;
 #endif /* FAKE_THREADS */
 
 #ifdef OLD_PTHREADS_API
-struct thread *
+struct perl_thread *
 getTHR _((void))
 {
     pthread_addr_t t;
 
     if (pthread_getspecific(thr_key, &t))
 	croak("panic: pthread_getspecific");
-    return (struct thread *) t;
+    return (struct perl_thread *) t;
 }
 #endif /* OLD_PTHREADS_API */
 
@@ -2438,20 +2438,20 @@ condpair_magic(SV *sv)
  * called. The use by ext/Thread/Thread.xs in core perl (where t is the
  * thread calling new_struct_thread) clearly satisfies this constraint.
  */
-struct thread *
-new_struct_thread(struct thread *t)
+struct perl_thread *
+new_struct_thread(struct perl_thread *t)
 {
-    struct thread *thr;
+    struct perl_thread *thr;
     SV *sv;
     SV **svp;
     I32 i;
 
     sv = newSVpv("", 0);
-    SvGROW(sv, sizeof(struct thread) + 1);
-    SvCUR_set(sv, sizeof(struct thread));
+    SvGROW(sv, sizeof(struct perl_thread) + 1);
+    SvCUR_set(sv, sizeof(struct perl_thread));
     thr = (Thread) SvPVX(sv);
     /* debug */
-    memset(thr, 0xab, sizeof(struct thread));
+    memset(thr, 0xab, sizeof(struct perl_thread));
     markstack = 0;
     scopestack = 0;
     savestack = 0;
diff --git a/vms/vmsish.h b/vms/vmsish.h
index 410031cca3..f0de807920 100644
--- a/vms/vmsish.h
+++ b/vms/vmsish.h
@@ -233,8 +233,8 @@
 #endif
 
 #define BIT_BUCKET "_NLA0:"
-#define PERL_SYS_INIT(c,v)  vms_image_init((c),(v))
-#define PERL_SYS_TERM()
+#define PERL_SYS_INIT(c,v)	vms_image_init((c),(v)), MALLOC_INIT
+#define PERL_SYS_TERM()		MALLOC_TERM
 #define dXSUB_SYS
 #define HAS_KILL
 #define HAS_WAIT
diff --git a/win32/win32thread.c b/win32/win32thread.c
index c0c3c60239..3e63327638 100644
--- a/win32/win32thread.c
+++ b/win32/win32thread.c
@@ -29,7 +29,7 @@ Perl_alloc_thread_key(void)
 }
 
 void
-Perl_set_thread_self(struct thread *thr)
+Perl_set_thread_self(struct perl_thread *thr)
 {
 #ifdef USE_THREADS
     /* Set thr->self.  GetCurrentThread() retrurns a pseudo handle, need
@@ -47,7 +47,7 @@ Perl_set_thread_self(struct thread *thr)
 
 #ifdef USE_THREADS
 int
-Perl_thread_create(struct thread *thr, thread_func_t *fn)
+Perl_thread_create(struct perl_thread *thr, thread_func_t *fn)
 {
     DWORD junk;
 
diff --git a/win32/win32thread.h b/win32/win32thread.h
index 38e66e9fc9..0d92ffc96f 100644
--- a/win32/win32thread.h
+++ b/win32/win32thread.h
@@ -2,7 +2,7 @@
 #define _WIN32THREAD_H
 typedef struct win32_cond { LONG waiters; HANDLE sem; } perl_cond;
 typedef DWORD perl_key;
-typedef HANDLE perl_thread;
+typedef HANDLE perl_os_thread;
 
 #ifndef DONT_USE_CRITICAL_SECTION
 
@@ -97,7 +97,7 @@ typedef HANDLE perl_mutex;
 	}							\
     } STMT_END
 
-
+#define THR ((struct perl_thread *) TlsGetValue(thr_key))
 #define THREAD_CREATE(t, f)	Perl_thread_create(t, f)
 #define THREAD_POST_CREATE(t)	NOOP
 #define THREAD_RET_TYPE		DWORD WINAPI
@@ -118,11 +118,10 @@ extern __declspec(thread) struct thread *Perl_current_thread;
 #endif
 
 void Perl_alloc_thread_key _((void));
-int Perl_thread_create _((struct thread *thr, thread_func_t *fn));
-void Perl_set_thread_self _((struct thread *thr));
-struct thread *Perl_getTHR _((void));
-void Perl_setTHR _((struct thread *t));
-
+int Perl_thread_create _((struct perl_thread *thr, thread_func_t *fn));
+void Perl_set_thread_self _((struct perl_thread *thr));
+struct perl_thread *Perl_getTHR _((void));
+void Perl_setTHR _((struct perl_thread *t));
 END_EXTERN_C
 
 #define INIT_THREADS NOOP