Integrate with Sarathy. I overruled on perldelta

and perldiag.

p4raw-id: //depot/cfgperl@3833

15 files changed, 775 insertions, 280 deletions

diff --git a/README.win32 b/README.win32
index 5ed7a79a3c..6f7af5476d 100644
--- a/README.win32
+++ b/README.win32
@@ -206,7 +206,7 @@ instructions carefully.
 Type "dmake" (or "nmake" if you are using that make).
 
 This should build everything.  Specifically, it will create perl.exe,
-perl.dll (or perlcore.dll), and perlglob.exe at the perl toplevel, and
+perl.dll (or perl56.dll), and perlglob.exe at the perl toplevel, and
 various other extension dll's under the lib\auto directory.  If the build
 fails for any reason, make sure you have done the previous steps correctly.
 
diff --git a/emacs/cperl-mode.el b/emacs/cperl-mode.el
index 3d7be098c0..371d420321 100644
--- a/emacs/cperl-mode.el
+++ b/emacs/cperl-mode.el
@@ -46,9 +46,9 @@
 
 ;;; Commentary:
 
-;; $Id: cperl-mode.el 4.5 1998/07/28 08:55:41 vera Exp vera $
+;; $Id: cperl-mode.el,v 4.19 1998/12/10 03:31:23 ilya Exp ilya $
 
-;;; Before (future?) RMS Emacs 20.3: To use this mode put the following into
+;;; Before RMS Emacs 20.3: To use this mode put the following into
 ;;; your .emacs file:
 
 ;; (autoload 'perl-mode "cperl-mode" "alternate mode for editing Perl programs" t)
@@ -66,7 +66,7 @@
 ;;; `cperl-non-problems', `cperl-praise', `cperl-speed'.            <<<<<<
 
 ;;; Additional useful commands to put into your .emacs file (before
-;;; (future?) RMS Emacs 20.3):
+;;; RMS Emacs 20.3):
 
 ;; (setq auto-mode-alist
 ;;      (append '(("\\.\\([pP][Llm]\\|al\\)$" . perl-mode))  auto-mode-alist ))
@@ -501,12 +501,12 @@
 ;;;  Debugging code in `cperl-electric-keywords' was leaking a message;
 
 ;;;; After 1.41:
-;;;  RMS changes for (future?) 20.3 merged
+;;;  RMS changes for 20.3 merged
 
 ;;;; 2.0.1.0: RMS mode (has 3 misprints)
 
 ;;;; After 2.0:
-;;;  RMS whitespace changes for (future?) 20.3 merged
+;;;  RMS whitespace changes for 20.3 merged
 
 ;;;; After 2.1:
 ;;;  History updated
@@ -800,6 +800,114 @@
 ;;;				`constant-face' was backward.
 ;;;  (`font-lock-other-type-face'): Done via `defface' too.
 
+;;;; After 4.5:
+;;;  (`cperl-init-faces-weak'):	use `cperl-force-face'.
+;;;  (`cperl-after-block-p'):	After END/BEGIN we are a block.
+;;;  (`cperl-mode'):		`font-lock-unfontify-region-function' 
+;;;				was set to a wrong function.
+;;;  (`cperl-comment-indent'):	Commenting __END__ was not working.
+;;;  (`cperl-indent-for-comment'):	Likewise.
+;;;				(Indenting is still misbehaving at toplevel.)
+
+;;;; After 4.5:
+;;;  (`cperl-unwind-to-safe'):	Signature changed, unwinds end too.
+;;;  (`cperl-find-pods-heres'):	mark qq[]-etc sections as syntax-type=string
+;;;  (`cperl-fontify-syntaxically'): Unwinds start and end to go out of 
+;;;				     long strings (not very successful).
+
+;;;   >>>>  CPerl should be usable in write mode too now <<<<
+
+;;;  (`cperl-syntaxify-by-font-lock'): Better default - off in text-mode.
+;;;  (`cperl-tips'): 		Updated docs.
+;;;  (`cperl-problems'):	Updated docs.
+
+;;;; After 4.6:
+;;;  (`cperl-calculate-indent'):	Did not consider `,' as continuation mark for statements.
+;;;  (`cperl-write-tags'):	Correct for XEmacs's `visit-tags-table-buffer'.
+
+;;;; After 4.7:
+;;;  (`cperl-calculate-indent'): Avoid parse-data optimization at toplevel.
+;;;				 Should indent correctly at toplevel too.
+;;;  (`cperl-tags-hier-init'):	Gross hack to pretend we work (are we?).
+;;;  (`cperl-find-pods-heres'):	Was not processing sub protos after a comment ine.
+;;;				Was treating $a++ <= 5 as a glob.
+
+;;;; After 4.8:
+;;;  (toplevel):		require custom unprotected => failure on 19.28.
+;;;  (`cperl-xemacs-p')		defined when compile too
+;;;  (`cperl-tags-hier-init'):	Another try to work around XEmacs problems
+;;;				Better progress messages.
+;;;  (`cperl-find-tags'):	Was writing line/pos in a wrong order, 
+;;;				pos off by 1 and not at beg-of-line.
+;;;  (`cperl-etags-snarf-tag'): New macro
+;;;  (`cperl-etags-goto-tag-location'): New macro
+;;;  (`cperl-write-tags'):	When removing old TAGS info was not 
+;;;				relativizing filename
+
+;;;; After 4.9:
+;;;  (`cperl-version'):		New variable.  New menu entry
+
+;;;; After 4.10:
+;;;  (`cperl-tips'):		Updated.
+;;;  (`cperl-non-problems'):	Updated.
+;;;  random:			References to future 20.3 removed.
+
+;;;; After 4.11:
+;;;  (`perl-font-lock-keywords'): Would not highlight `sub foo($$);'.
+;;;  Docstrings:		Menu was described as `CPerl' instead of `Perl'
+
+;;;; After 4.12:
+;;;  (`cperl-toggle-construct-fix'): Was toggling to t instead of 1.
+;;;  (`cperl-ps-print-init'):	Associate `cperl-array-face', `cperl-hash-face'
+;;;				remove `font-lock-emphasized-face'.
+;;;				remove `font-lock-other-emphasized-face'.
+;;;				remove `font-lock-reference-face'.
+;;;				remove `font-lock-keyword-face'.
+;;;				Use `eval-after-load'.
+;;;  (`cperl-init-faces'):	remove init `font-lock-other-emphasized-face'.
+;;;				remove init `font-lock-emphasized-face'.
+;;;				remove init `font-lock-keyword-face'.
+;;;  (`cperl-tips-faces'):	New variable and an entry into Mini-docs.
+;;;  (`cperl-indent-region'):	Do not indent whitespace lines
+;;;  (`cperl-indent-exp'):	Was not processing else-blocks.
+;;;  (`cperl-calculate-indent'): Remove another parse-data optimization
+;;;				 at toplevel: would indent correctly.
+;;;  (`cperl-get-state'):	NOP line removed.
+
+;;;; After 4.13:
+;;;  (`cperl-ps-print-init'):	Remove not-CPerl-related faces.
+;;;  (`cperl-ps-print'):	New function and menu entry.
+;;;  (`cperl-ps-print-face-properties'):	New configuration variable.
+;;;  (`cperl-invalid-face'):	New configuration variable.
+;;;  (`cperl-nonoverridable-face'):	New face.  Renamed from
+;;;					`font-lock-other-type-face'.
+;;;  (`perl-font-lock-keywords'):	Highlight trailing whitespace
+;;;  (`cperl-contract-levels'):	Documentation corrected.
+;;;  (`cperl-contract-level'):	Likewise.
+
+;;;; After 4.14:
+;;;  (`cperl-ps-print'): `ps-print-face-extension-alist' was not in old Emaxen,
+;;;				same with `ps-extend-face-list'
+;;;  (`cperl-ps-extend-face-list'):	New macro.
+
+;;;; After 4.15:
+;;;  (`cperl-init-faces'):	Interpolate `cperl-invalid-face'.
+;;;  (`cperl-forward-re'):	Emit a meaningful error instead of a cryptic
+;;;				one for uncomplete REx near end-of-buffer.
+;;;  (`cperl-find-pods-heres'):	Tolerate unfinished REx at end-of-buffer.
+
+;;;; After 4.16:
+;;;  (`cperl-find-pods-heres'): `unwind-protect' was left commented.
+
+;;;; After 4.17:
+;;;  (`cperl-invalid-face'):	Change to ''underline.
+
+;;;; After 4.18:
+;;;  (`cperl-find-pods-heres'):	/ and ? after : start a REx.
+;;;  (`cperl-after-expr-p'):	Skip labels when checking
+;;;  (`cperl-calculate-indent'): Correct for labels when calculating 
+;;;					indentation of continuations.
+;;;				Docstring updated.
 ;;; Code:
 
 
@@ -808,6 +916,7 @@
       (condition-case nil
 	  (require 'custom)
 	(error nil))
+      (defconst cperl-xemacs-p (string-match "XEmacs\\|Lucid" emacs-version))
       (or (fboundp 'defgroup)
 	  (defmacro defgroup (name val doc &rest arr)
 	    nil))
@@ -826,6 +935,11 @@
 		  ((fboundp 'valid-color-name-p) (` (valid-color-name-p (, col))))
 		  ;; XEmacs 19.11
 		  (t (` (x-valid-color-name-p (, col)))))))
+      (if (fboundp 'ps-extend-face-list)
+	  (defmacro cperl-ps-extend-face-list (arg)
+	    (` (ps-extend-face-list (, arg))))
+	(defmacro cperl-ps-extend-face-list (arg)
+	  (` (error "This version of Emacs has no `ps-extend-face-list'."))))
       (defmacro cperl-is-face (arg)	; Takes quoted arg
 	    (cond ((fboundp 'find-face)
 		   (` (find-face (, arg))))
@@ -846,9 +960,31 @@
 	     (or (cperl-is-face (quote (, arg)))
 		 (cperl-make-face (, arg) (, descr)))
 	     (or (boundp (quote (, arg))) ; We use unquoted variants too
-		 (defconst (, arg) (quote (, arg)) (, descr))))))))
+		 (defconst (, arg) (quote (, arg)) (, descr))))))
+      (if cperl-xemacs-p
+	  (defmacro cperl-etags-snarf-tag (file line)
+	    (` (progn
+		 (beginning-of-line 2)
+		 (list (, file) (, line)))))
+	(defmacro cperl-etags-snarf-tag (file line)
+	  (` (etags-snarf-tag))))
+      (if cperl-xemacs-p
+	  (defmacro cperl-etags-goto-tag-location (elt)
+	    (` ;;(progn
+		 ;; (switch-to-buffer (get-file-buffer (elt (, elt) 0)))
+		 ;; (set-buffer (get-file-buffer (elt (, elt) 0)))
+		 ;; Probably will not work due to some save-excursion???
+		 ;; Or save-file-position?
+		 ;; (message "Did I get to line %s?" (elt (, elt) 1))
+		 (goto-line (string-to-int (elt (, elt) 1)))))
+	    ;;)
+	(defmacro cperl-etags-goto-tag-location (elt)
+	  (` (etags-goto-tag-location (, elt)))))))
+
+(condition-case nil
+    (require 'custom)
+  (error nil))				; Already fixed by eval-when-compile
 
-(require 'custom)
 (defun cperl-choose-color (&rest list)
   (let (answer)
     (while list
@@ -1100,6 +1236,11 @@ Font for POD headers."
   :type 'face
   :group 'cperl-faces)
 
+(defcustom cperl-invalid-face ''underline ; later evaluated by `font-lock'
+  "*The result of evaluation of this expression highlights trailing whitespace."
+  :type 'face
+  :group 'cperl-faces)
+
 (defcustom cperl-pod-here-fontify '(featurep 'font-lock)
   "*Not-nil after evaluation means to highlight pod and here-docs sections."
   :type 'boolean
@@ -1214,7 +1355,8 @@ may be merged to be on the same line when indenting a region."
   :group 'cperl-indentation-details)
 
 (defcustom cperl-syntaxify-by-font-lock 
-  (boundp 'parse-sexp-lookup-properties)
+  (and window-system 
+       (boundp 'parse-sexp-lookup-properties))
   "*Non-nil means that CPerl uses `font-lock's routines for syntaxification.
 Having it TRUE may be not completely debugged yet."
   :type '(choice (const message) boolean)
@@ -1227,6 +1369,25 @@ when syntaxifying a chunk of buffer."
   :type 'boolean
   :group 'cperl-speed)
 
+(defcustom cperl-ps-print-face-properties
+  '((font-lock-keyword-face		nil nil		bold shadow)
+    (font-lock-variable-name-face	nil nil		bold)
+    (font-lock-function-name-face	nil nil		bold italic box)
+    (font-lock-constant-face		nil "LightGray"	bold)
+    (cperl-array-face			nil "LightGray"	bold underline)
+    (cperl-hash-face			nil "LightGray"	bold italic underline)
+    (font-lock-comment-face		nil "LightGray"	italic)
+    (font-lock-string-face		nil nil		italic underline)
+    (cperl-nonoverridable-face		nil nil		italic underline)
+    (font-lock-type-face		nil nil		underline)
+    (underline				nil "LightGray"	strikeout))
+  "List given as an argument to `ps-extend-face-list' in `cperl-ps-print'."
+  :type '(repeat (cons symbol 
+		       (cons (choice (const nil) string)
+			     (cons (choice (const nil) string)
+				   (repeat symbol)))))
+  :group 'cperl-faces)
+
 (if window-system
     (progn
       (defvar cperl-dark-background 
@@ -1234,7 +1395,7 @@ when syntaxifying a chunk of buffer."
       (defvar cperl-dark-foreground 
 	(cperl-choose-color "orchid1" "orange"))
 
-      (defface font-lock-other-type-face
+      (defface cperl-nonoverridable-face
 	(` ((((class grayscale) (background light))
 	     (:background "Gray90" :italic t :underline t))
 	    (((class grayscale) (background dark))
@@ -1285,6 +1446,13 @@ and/or
 Subdirectory `cperl-mode' may contain yet newer development releases and/or
 patches to related files.
 
+For best results apply to an older Emacs the patches from
+  ftp://ftp.math.ohio-state.edu/pub/users/ilya/cperl-mode/patches
+\(this upgrades syntax-parsing abilities of RMS Emaxen v19.34 and 
+v20.2 up to the level of RMS Emacs v20.3 - a must for a good Perl
+mode.)  You will not get much from XEmacs, it's syntax abilities are
+too primitive.
+
 Get support packages choose-color.el (or font-lock-extra.el before
 19.30), imenu-go.el from the same place.  \(Look for other files there
 too... ;-).  Get a patch for imenu.el in 19.29.  Note that for 19.30 and
@@ -1300,20 +1468,25 @@ older version was on
   http://www.metronet.com:70/9/perlinfo/perl5/manual/perl5-info.tar.gz
 
 If you use imenu-go, run imenu on perl5-info buffer (you can do it
-from CPerl menu).  If many files are related, generate TAGS files from
-Tools/Tags submenu in CPerl menu.
+from Perl menu).  If many files are related, generate TAGS files from
+Tools/Tags submenu in Perl menu.
 
 If some class structure is too complicated, use Tools/Hierarchy-view
-from CPerl menu, or hierarchic view of imenu. The second one uses the
+from Perl menu, or hierarchic view of imenu. The second one uses the
 current buffer only, the first one requires generation of TAGS from
-CPerl/Tools/Tags menu beforehand.
+Perl/Tools/Tags menu beforehand.
+
+Run Perl/Tools/Insert-spaces-if-needed to fix your lazy typing.
+
+Switch auto-help on/off with Perl/Tools/Auto-help.
 
-Run CPerl/Tools/Insert-spaces-if-needed to fix your lazy typing.
+Though with contemporary Emaxen CPerl mode should maintain the correct
+parsing of Perl even when editing, sometimes it may be lost.  Fix this by
 
-Switch auto-help on/off with CPerl/Tools/Auto-help.
+  M-x norm RET
 
-Before reporting (non-)problems look in the problem section on what I
-know about them.")
+Before reporting (non-)problems look in the problem section of online
+micro-docs on what I know about CPerl problems.")
 
 (defvar cperl-problems 'please-ignore-this-line
 "Some faces will not be shown on some versions of Emacs unless you
@@ -1322,13 +1495,14 @@ install choose-color.el, available from
 
 Emacs had a _very_ restricted syntax parsing engine until RMS's Emacs
 20.1.  Most problems below are corrected starting from this version of
-Emacs, and all of them should go with (future) RMS's version 20.3.
+Emacs, and all of them should go with RMS's version 20.3.
+(Or apply patches to Emacs 19.33/34 - see tips.)
 
 Note that even with newer Emacsen interaction of `font-lock' and
 syntaxification is not cleaned up.  You may get slightly different
 colors basing on the order of fontification and syntaxification.  This
 might be corrected by setting `cperl-syntaxify-by-font-lock' to t, but
-the corresponding code is still extremely buggy.
+the corresponding code may still contain some bugs.
 
 Even with older Emacsen CPerl mode tries to corrects some Emacs
 misunderstandings, however, for efficiency reasons the degree of
@@ -1350,9 +1524,10 @@ to insert it as $ {aaa} (legal in perl5, not in perl4).
 Similar problems arise in regexps, when /(\\s|$)/ should be rewritten
 as /($|\\s)/.  Note that such a transposition is not always possible.
 
-The solution is to upgrade your Emacs.  Note that RMS's 20.2 has some
-bugs related to `syntax-table' text properties.  Patches are available
-on the main CPerl download site, and on CPAN.
+The solution is to upgrade your Emacs or patch an older one.  Note
+that RMS's 20.2 has some bugs related to `syntax-table' text
+properties.  Patches are available on the main CPerl download site,
+and on CPAN.
 
 If these bugs cannot be fixed on your machine (say, you have an inferior
 environment and cannot recompile), you may still disable all the fancy stuff
@@ -1360,7 +1535,9 @@ via `cperl-use-syntax-table-text-property'." )
 
 (defvar cperl-non-problems 'please-ignore-this-line
 "As you know from `problems' section, Perl syntax is too hard for CPerl on 
-older Emacsen.
+older Emacsen.  Here is what you can do if you cannot upgrade, or if
+you want to switch off these capabilities on RMS Emacs 20.2 (+patches) or 20.3
+or better.  Please skip this docs if you run a capable Emacs already.
 
 Most of the time, if you write your own code, you may find an equivalent
 \(and almost as readable) expression (what is discussed below is usually
@@ -1419,8 +1596,11 @@ as far as bugs reports I see are concerned.")
 
 1) It does 99% of Perl syntax correct (as opposed to 80-90% in Perl
 mode - but the latter number may have improved too in last years) even 
-without `syntax-table' property; When using this property, it should 
-handle 99.995% of lines correct - or somesuch.
+with old Emaxen which do not support `syntax-table' property.
+
+When using `syntax-table' property for syntax assist hints, it should
+handle 99.995% of lines correct - or somesuch.  It automatically
+updates syntax assist hints when you edit your script.
 
 2) It is generally believed to be \"the most user-friendly Emacs
 package\" whatever it may mean (I doubt that the people who say similar
@@ -1471,6 +1651,7 @@ voice);
 
         n) Highlights (by user-choice) either 3-delimiters constructs
 	   (such as tr/a/b/), or regular expressions and `y/tr'.
+	m) Highlights trailing whitespace.
 
 5) The indentation engine was very smart, but most of tricks may be
 not needed anymore with the support for `syntax-table' property.  Has
@@ -1533,6 +1714,41 @@ B) Speed of editing operations.
     of, say, long POD sections.
 ")
 
+(defvar cperl-tips-faces 'please-ignore-this-line
+  "CPerl mode uses following faces for highlighting:
+
+  cperl-array-face		Array names
+  cperl-hash-face		Hash names
+  font-lock-comment-face	Comments, PODs and whatever is considered
+				syntaxically to be not code
+  font-lock-constant-face	HERE-doc delimiters, labels, delimiters of
+				2-arg operators s/y/tr/ or of RExen,
+  font-lock-function-name-face	Special-cased m// and s//foo/, _ as 
+				a target of a file tests, file tests,
+				subroutine names at the moment of definition
+				(except those conflicting with Perl operators),
+				package names (when recognized), format names
+  font-lock-keyword-face	Control flow switch constructs, declarators
+  cperl-nonoverridable-face	Non-overridable keywords, modifiers of RExen
+  font-lock-string-face		Strings, qw() constructs, RExen, POD sections,
+				literal parts and the terminator of formats
+				and whatever is syntaxically considered
+				as string literals
+  font-lock-type-face		Overridable keywords
+  font-lock-variable-name-face	Variable declarations, indirect array and
+				hash names, POD headers/item names
+  cperl-invalid-face		Trailing whitespace
+
+Note that in several situations the highlighting tries to inform about
+possible confusion, such as different colors for function names in
+declarations depending on what they (do not) override, or special cases
+m// and s/// which do not do what one would expect them to do.
+
+Help with best setup of these faces for printout requested (for each of 
+the faces: please specify bold, italic, underline, shadow and box.)
+
+\(Not finished.)")
+
 
 
 ;;; Portability stuff:
@@ -1774,6 +1990,8 @@ B) Speed of editing operations.
 	    ["Insert spaces if needed" cperl-find-bad-style t]
 	    ["Class Hierarchy from TAGS" cperl-tags-hier-init t]
 	    ;;["Update classes" (cperl-tags-hier-init t) tags-table-list]
+	    ["CPerl pretty print (exprmntl)" cperl-ps-print 
+	     (fboundp 'ps-extend-face-list)]
 	    ["Imenu on info" cperl-imenu-on-info (featurep 'imenu)]
 	    ("Tags"
 ;;;	     ["Create tags for current file" cperl-etags t]
@@ -1832,7 +2050,11 @@ B) Speed of editing operations.
 	    ["Non-problems" (describe-variable 'cperl-non-problems) t]
 	    ["Speed" (describe-variable 'cperl-speed) t]
 	    ["Praise" (describe-variable 'cperl-praise) t]
-	    ["CPerl mode" (describe-function 'cperl-mode) t]))))
+	    ["Faces" (describe-variable 'cperl-tips-faces) t]
+	    ["CPerl mode" (describe-function 'cperl-mode) t]
+	    ["CPerl version" 
+	     (message "The version of master-file for this CPerl is %s" 
+		      cperl-version) t]))))
   (error nil))
 
 (autoload 'c-macro-expand "cmacexp"
@@ -2147,7 +2369,7 @@ or as help on variables `cperl-tips', `cperl-problems',
 	;; Fix broken font-lock:
 	(or (boundp 'font-lock-unfontify-region-function)
 	    (set 'font-lock-unfontify-region-function
-		  'font-lock-default-unfontify-buffer))
+		  'font-lock-default-unfontify-region))
 	(make-variable-buffer-local 'font-lock-unfontify-region-function)
 	(set 'font-lock-unfontify-region-function 
 	      'cperl-font-lock-unfontify-region-function)
@@ -2225,13 +2447,28 @@ or as help on variables `cperl-tips', `cperl-problems',
 ;; based on its context.  Do fallback if comment is found wrong.
 
 (defvar cperl-wrong-comment)
+(defvar cperl-st-cfence '(14))		; Comment-fence
+(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 . ?\<))
+
 
 (defun cperl-comment-indent ()
-  (let ((p (point)) (c (current-column)) was)
+  (let ((p (point)) (c (current-column)) was phony)
     (if (looking-at "^#") 0		; Existing comment at bol stays there.
       ;; Wrong comment found
       (save-excursion
-	(setq was (cperl-to-comment-or-eol))
+	(setq was (cperl-to-comment-or-eol)
+	      phony (eq (get-text-property (point) 'syntax-table)
+			cperl-st-cfence))
+	(if phony
+	    (progn
+	      (re-search-forward "#\\|$") ; Hmm, what about embedded #?
+	      (if (eq (preceding-char) ?\#)
+		  (forward-char -1))
+	      (setq was nil)))
 	(if (= (point) p)
 	    (progn
 	      (skip-chars-backward " \t")
@@ -2935,11 +3172,13 @@ Return the amount the indentation changed by."
 	 (looking-at "[a-zA-Z_][a-zA-Z0-9_]*:[^:]"))))
 
 (defun cperl-get-state (&optional parse-start start-state)
-  ;; returns list (START STATE DEPTH PRESTART), START is a good place
-  ;; to start parsing, STATE is what is returned by
-  ;; `parse-partial-sexp'.  DEPTH is true is we are immediately after
-  ;; end of block which contains START.  PRESTART is the position
-  ;; basing on which START was found.
+  ;; returns list (START STATE DEPTH PRESTART),
+  ;; START is a good place to start parsing, or equal to
+  ;; PARSE-START if preset, 
+  ;; STATE is what is returned by `parse-partial-sexp'.
+  ;; DEPTH is true is we are immediately after end of block
+  ;; which contains START.
+  ;; PRESTART is the position basing on which START was found.
   (save-excursion
     (let ((start-point (point)) depth state start prestart)
       (if (and parse-start
@@ -2960,7 +3199,6 @@ Return the amount the indentation changed by."
 	    (beginning-of-line 2)))	; Go to the next line.
 	(if start (goto-char start)))	; Not at the start of file
       (setq start (point))
-      (if (< start start-point) (setq parse-start start))
       (or state (setq state (parse-partial-sexp start start-point -1 nil start-state)))
       (list start state depth prestart))))
 
@@ -2990,7 +3228,10 @@ Return the amount the indentation changed by."
 (defun cperl-calculate-indent (&optional parse-data) ; was parse-start
   "Return appropriate indentation for current line as Perl code.
 In usual case returns an integer: the column to indent to.
-Returns nil if line starts inside a string, t if in a comment."
+Returns nil if line starts inside a string, t if in a comment.
+
+Will not correct the indentation for labels, but will correct it for braces
+and closing parentheses and brackets.."
   (save-excursion
     (if (or
 	 (memq (get-text-property (point) 'syntax-type) 
@@ -3030,19 +3271,21 @@ Returns nil if line starts inside a string, t if in a comment."
       (goto-char pre-indent-point)
       (let* ((case-fold-search nil)
 	     (s-s (cperl-get-state (car parse-data) (nth 1 parse-data)))
-	     (start (nth 0 s-s))
+	     (start (or (nth 2 parse-data) 
+			(nth 0 s-s)))
 	     (state (nth 1 s-s))
 	     (containing-sexp (car (cdr state)))
-	     (start-indent (save-excursion
-			     (goto-char start)
-			     (- (current-indentation)
-				(if (nth 2 s-s) cperl-indent-level 0))))
 	     old-indent)
-	(if parse-data
+	(if (and 
+	     ;;containing-sexp		;; We are buggy at toplevel :-(
+	     parse-data) 
 	    (progn
 	      (setcar parse-data pre-indent-point)
 	      (setcar (cdr parse-data) state)
-	      (setq old-indent (nth 2 parse-data))))
+	      (or (nth 2 parse-data)
+		  (setcar (cddr parse-data) start))
+	      ;; Before this point: end of statement
+	      (setq old-indent (nth 3 parse-data))))
 	;;      (or parse-start (null symbol)
 	;;	  (setq parse-start (symbol-value symbol) 
 	;;		start-indent (nth 2 parse-start) 
@@ -3092,7 +3335,10 @@ Returns nil if line starts inside a string, t if in a comment."
 	       ;; unless that ends in a closeparen without semicolon,
 	       ;; in which case this line is the first argument decl.
 	       (skip-chars-forward " \t")
-	       (+ start-indent
+	       (+ (save-excursion
+		    (goto-char start)
+		    (- (current-indentation)
+		       (if (nth 2 s-s) cperl-indent-level 0)))
 		  (if (= char-after ?{) cperl-continued-brace-offset 0)
 		  (progn
 		    (cperl-backward-to-noncomment (or old-indent (point-min)))
@@ -3101,10 +3347,12 @@ Returns nil if line starts inside a string, t if in a comment."
 		    ;; or function's arg decls.  Set basic-indent accordingly.
 		    ;; Now add a little if this is a continuation line.
 		    (if (or (bobp)
+			    (eq (point) old-indent) ; old-indent was at comment
 			    (eq (preceding-char) ?\;)
 			    ;;  Had ?\) too
 			    (and (eq (preceding-char) ?\})
-				 (cperl-after-block-and-statement-beg start))
+				 (cperl-after-block-and-statement-beg
+				  (point-min)))	; Was start - too close
 			    (memq char-after (append ")]}" nil))
 			    (and (eq (preceding-char) ?\:) ; label
 				 (progn
@@ -3114,7 +3362,7 @@ Returns nil if line starts inside a string, t if in a comment."
 			(progn
 			  (if (and parse-data
 				   (not (eq char-after ?\C-j)))
-			      (setcdr (cdr parse-data)
+			      (setcdr (cddr parse-data)
 				      (list pre-indent-point)))
 			  0)
 		      cperl-continued-statement-offset))))
@@ -3146,11 +3394,13 @@ Returns nil if line starts inside a string, t if in a comment."
 	       (cperl-backward-to-noncomment containing-sexp)
 	       ;; Back up over label lines, since they don't
 	       ;; affect whether our line is a continuation.
-	       (while (or (eq (preceding-char) ?\,)
+	       ;; (Had \, too)
+	       (while ;;(or (eq (preceding-char) ?\,)
 			  (and (eq (preceding-char) ?:)
 			       (or;;(eq (char-after (- (point) 2)) ?\') ; ????
 				(memq (char-syntax (char-after (- (point) 2)))
-				      '(?w ?_)))))
+				      '(?w ?_))))
+			  ;;)
 		 (if (eq (preceding-char) ?\,)
 		     ;; Will go to beginning of line, essentially.
 		     ;; Will ignore embedded sexpr XXXX.
@@ -3166,12 +3416,22 @@ Returns nil if line starts inside a string, t if in a comment."
 		   ;; This line is continuation of preceding line's statement;
 		   ;; indent  `cperl-continued-statement-offset'  more than the
 		   ;; previous line of the statement.
+		   ;;
+		   ;; There might be a label on this line, just
+		   ;; consider it bad style and ignore it.
 		   (progn
 		     (cperl-backward-to-start-of-continued-exp containing-sexp)
 		     (+ (if (memq char-after (append "}])" nil))
 			    0		; Closing parenth
 			  cperl-continued-statement-offset)
-			(current-column)
+			(if (looking-at "\\w+[ \t]*:")
+			    (if (> (current-indentation) cperl-min-label-indent)
+				(- (current-indentation) cperl-label-offset)
+			      ;; Do not move `parse-data', this should
+			      ;; be quick anyway (this comment comes 
+			      ;;from different location):
+			      (cperl-calculate-indent))
+			  (current-column))
 			(if (eq char-after ?\{)
 			    cperl-continued-brace-offset 0)))
 		 ;; This line starts a new statement.
@@ -3487,13 +3747,6 @@ Returns true if comment is found."
 (defsubst cperl-1+ (p)
   (min (point-max) (1+ p)))
 
-(defvar cperl-st-cfence '(14))		; Comment-fence
-(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
@@ -3537,7 +3790,7 @@ Returns true if comment is found."
     (skip-chars-forward " \t")
     ;; ender means matching-char matcher.
     (setq b (point) 
-	  starter (char-after b)
+	  starter (if (eobp) 0 (char-after b))
 	  ender (cdr (assoc starter cperl-starters)))
     ;; What if starter == ?\\  ????
     (if set-st
@@ -3642,11 +3895,15 @@ Returns true if comment is found."
 ;;		Start-to-end is marked `here-doc-group' ==> t
 ;;		The body is marked `syntax-type' ==> `here-doc'
 ;;		The delimiter is marked `syntax-type' ==> `here-doc-delim'
-;;	a) FORMATs: 
+;;	c) FORMATs: 
 ;;		After-initial-line--to-end is marked `syntax-type' ==> `format'
+;;	d) 'Q'uoted string: 
+;;		part between markers inclusive is marked `syntax-type' ==> `string'
 
-(defun cperl-unwind-to-safe (before)
-  (let ((pos (point)))
+(defun cperl-unwind-to-safe (before &optional end)
+  ;; if BEFORE, go to the previous start-of-line on each step of unwinding
+  (let ((pos (point)) opos)
+    (setq opos pos)
     (while (and pos (get-text-property pos 'syntax-type))
       (setq pos (previous-single-property-change pos 'syntax-type))
       (if pos
@@ -3657,7 +3914,14 @@ Returns true if comment is found."
 		(setq pos (point)))
 	    (goto-char (setq pos (cperl-1- pos))))
 	;; Up to the start
-	(goto-char (point-min))))))
+	(goto-char (point-min))))
+    (if end
+	;; Do the same for end, going small steps
+	(progn
+	  (while (and end (get-text-property end 'syntax-type))
+	    (setq pos end
+		  end (next-single-property-change end 'syntax-type)))
+	  (or end pos)))))
 
 (defun cperl-find-pods-heres (&optional min max non-inter end ignore-max)
   "Scans the buffer for hard-to-parse Perl constructions.
@@ -3693,10 +3957,10 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 	       (if (boundp 'font-lock-function-name-face)
 		   font-lock-function-name-face
 		 'font-lock-function-name-face))
-	      (font-lock-other-type-face 
-	       (if (boundp 'font-lock-other-type-face)
-		   font-lock-other-type-face
-		 'font-lock-other-type-face))
+	      (cperl-nonoverridable-face 
+	       (if (boundp 'cperl-nonoverridable-face)
+		   cperl-nonoverridable-face
+		 'cperl-nonoverridable-face))
 	      (stop-point (if ignore-max 
 			      (point-max)
 			    max))
@@ -3970,6 +4234,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 		      i b
 		      c (char-after (match-beginning b1))
 		      bb (char-after (1- (match-beginning b1)))	; tmp holder
+		      ;; bb == "Not a stringy"
 		      bb (if (eq b1 10) ; user variables/whatever
 			     (or
 			      (memq bb '(?\$ ?\@ ?\% ?\* ?\#)) ; $#y
@@ -3980,6 +4245,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 					    ?\&))))
 			   ;; <file> or <$file>
 			   (and (eq c ?\<)
+				;; Do not stringify <FH> :
 				(save-match-data
 				  (looking-at 
 				   "\\s *\\$?\\([_a-zA-Z:][_a-zA-Z0-9:]*\\s *\\)?>"))))
@@ -3995,10 +4261,10 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 				 ;; What is below: regexp-p?
 				 (and
 				  (or (memq (preceding-char)
-					    (append (if (eq c ?\?)
+					    (append (if (memq c '(?\? ?\<))
 							;; $a++ ? 1 : 2
-							"~{(=|&*!,;"
-						      "~{(=|&+-*!,;") nil))
+							"~{(=|&*!,;:"
+						      "~{(=|&+-*!,;:") nil))
 				      (and (eq (preceding-char) ?\})
 					   (cperl-after-block-p (point-min)))
 				      (and (eq (char-syntax (preceding-char)) ?w)
@@ -4069,9 +4335,11 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 		      ;; Considered as 1arg form
 		      (progn
 			(cperl-commentify b (point) t)
+			(put-text-property b (point) 'syntax-type 'string)
 			(and go
-			     (setq e1 (1+ e1))
-			     (forward-char 1)))
+			     (setq e1 (cperl-1+ e1))
+			     (or (eobp)
+				 (forward-char 1))))
 		    (cperl-commentify b i t)
 		    (if (looking-at "\\sw*e") ; s///e
 			(progn
@@ -4083,8 +4351,10 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 			  (if (and tag (eq (preceding-char) ?\>))
 			      (progn
 				(cperl-modify-syntax-type (1- (point)) cperl-st-ket)
-				(cperl-modify-syntax-type i cperl-st-bra))))
+				(cperl-modify-syntax-type i cperl-st-bra)))
+			  (put-text-property b i 'syntax-type 'string))
 		      (cperl-commentify b1 (point) t)
+		      (put-text-property b (point) 'syntax-type 'string)
 		      (if qtag
 			  (cperl-modify-syntax-type (1+ i) cperl-st-punct))
 		      (setq tail nil)))
@@ -4094,7 +4364,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 			(forward-word 1) ; skip modifiers s///s
 			(if tail (cperl-commentify tail (point) t))
 			(cperl-postpone-fontification 
-			 e1 (point) 'face font-lock-other-type-face)))
+			 e1 (point) 'face cperl-nonoverridable-face)))
 		  ;; Check whether it is m// which means "previous match"
 		  ;; and highlight differently
 		  (if (and (eq e (+ 2 b))
@@ -4118,7 +4388,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 				       (not (eq ?\< (char-after b)))))))
 			(progn
 			  (cperl-postpone-fontification 
-			   b (1+ b) 'face font-lock-constant-face)
+			   b (cperl-1+ b) 'face font-lock-constant-face)
 			  (cperl-postpone-fontification 
 			   (1- e) e 'face font-lock-constant-face))))
 		  (if i2
@@ -4136,8 +4406,8 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 			  '(?\$ ?\@ ?\% ?\& ?\*))
 		    nil
 		  (setq state (parse-partial-sexp 
-			       state-point (1- b) nil nil state)
-			state-point (1- b))
+			       state-point b nil nil state)
+			state-point b)
 		  (if (or (nth 3 state) (nth 4 state))
 		      nil
 		    ;; Mark as string
@@ -4233,7 +4503,7 @@ the sections using `cperl-pod-head-face', `cperl-pod-face',
 	      (if (eq (char-syntax (preceding-char)) ?w) ; else {}
 		  (save-excursion
 		    (forward-sexp -1)
-		    (or (looking-at "\\(else\\|grep\\|map\\)\\>")
+		    (or (looking-at "\\(else\\|grep\\|map\\|BEGIN\\|END\\)\\>")
 			;; sub f {}
 			(progn
 			  (cperl-backward-to-noncomment lim)
@@ -4257,11 +4527,19 @@ CHARS is a string that contains good characters to have before us (however,
 	(setq p (point))
 	(beginning-of-line)
 	(if (looking-at "^[ \t]*\\(#\\|$\\)") nil ; Only comment, skip
-	  ;; Else: last iteration (What to do with labels?)
+	  ;; Else: last iteration, or a label
 	  (cperl-to-comment-or-eol) 
 	  (skip-chars-backward " \t")
 	  (if (< p (point)) (goto-char p))
-	  (setq stop t)))
+	  (setq p (point))
+	  (if (and (eq (preceding-char) ?:)
+		   (progn
+		     (forward-char -1)
+		     (skip-chars-backward " \t\n\f" lim)
+		     (eq (char-syntax (preceding-char)) ?w)))
+	      (forward-sexp -1)		; Possibly label.  Skip it
+	    (goto-char p)
+	    (setq stop t))))
       (or (bobp)			; ???? Needed
 	  (eq (point) lim)
 	  (progn
@@ -4300,8 +4578,9 @@ CHARS is a string that contains good characters to have before us (however,
 
 (defun cperl-indent-exp ()
   "Simple variant of indentation of continued-sexp.
-Should be slow.  Will not indent comment if it starts at `comment-indent'
-or looks like continuation of the comment on the previous line.
+
+Will not indent comment if it starts at `comment-indent' or looks like
+continuation of the comment on the previous line.
 
 If `cperl-indent-region-fix-constructs', will improve spacing on 
 conditional/loop constructs."
@@ -4319,7 +4598,10 @@ conditional/loop constructs."
 	  (while (< (point) tmp-end)
 	    (parse-partial-sexp (point) tmp-end nil t) ; To start-sexp or eol
 	    (or (eolp) (forward-sexp 1)))
-	  (if (> (point) tmp-end) (progn (end-of-line) (setq tmp-end (point)))
+	  (if (> (point) tmp-end)
+	      (save-excursion
+		(end-of-line)
+		(setq tmp-end (point)))
 	    (setq done t)))
 	(goto-char tmp-end)
 	(setq tmp-end (point-marker)))
@@ -4328,16 +4610,18 @@ conditional/loop constructs."
       (cperl-indent-region (point) tmp-end))))
 
 (defun cperl-fix-line-spacing (&optional end parse-data)
-  "Improve whitespace in a conditional/loop construct."
+  "Improve whitespace in a conditional/loop construct.
+Returns some position at the last line."
   (interactive)
   (or end
       (setq end (point-max)))
-  (let (p pp ml have-brace
+  (let (p pp ml have-brace ret
 	  (ee (save-excursion (end-of-line) (point)))
 	  (cperl-indent-region-fix-constructs
 	   (or cperl-indent-region-fix-constructs 1)))
     (save-excursion
       (beginning-of-line)
+      (setq ret (point))
       ;;  }? continue 
       ;;  blah; }
       (if (not 
@@ -4429,8 +4713,11 @@ conditional/loop constructs."
 			(progn
 			  (delete-horizontal-space)
 			  (insert "\n")
+			  (setq ret (point))
 			  (if (cperl-indent-line parse-data)
-			      (cperl-fix-line-spacing end parse-data)))
+			      (progn 
+				(cperl-fix-line-spacing end parse-data)
+				(setq ret (point)))))
 		      (insert
 		       (make-string cperl-indent-region-fix-constructs ?\ ))))
 		   ((and (looking-at "[ \t]*\n")
@@ -4457,8 +4744,9 @@ conditional/loop constructs."
 			      (goto-char (1+ pp))
 			      (delete-horizontal-space)
 			      (insert "\n")
+			      (setq ret (point))
 			      (if (cperl-indent-line parse-data)
-				  (cperl-fix-line-spacing end parse-data))))))))))
+				  (setq ret (cperl-fix-line-spacing end parse-data)))))))))))
       (beginning-of-line)
       (setq p (point) pp (save-excursion (end-of-line) (point))) ; May be different from ee.
       ;; Now check whether there is a hanging `}'
@@ -4494,10 +4782,12 @@ conditional/loop constructs."
 		  (and (eq (preceding-char) ?\} )
 		       (cperl-after-block-p (point-min)))
 		  (insert ";"))
-	      (insert "\n"))
+	      (insert "\n")
+	      (setq ret (point)))
 	    (if (cperl-indent-line parse-data)
-		(cperl-fix-line-spacing end parse-data))
-	    (beginning-of-line)))))))
+		(setq ret (cperl-fix-line-spacing end parse-data)))
+	    (beginning-of-line)))))
+    ret))
 
 (defvar cperl-update-start)		; Do not need to make them local
 (defvar cperl-update-end)
@@ -4518,9 +4808,9 @@ conditional/loop constructs."
   (cperl-update-syntaxification end end)
   (save-excursion
     (let (cperl-update-start cperl-update-end (h-a-c after-change-functions))
-      (let (st comm old-comm-indent new-comm-indent p pp i
+      (let (st comm old-comm-indent new-comm-indent p pp i empty
 	       (indent-info (if cperl-emacs-can-parse
-				(list nil nil) ; Cannot use '(), since will modify
+				(list nil nil nil) ; Cannot use '(), since will modify
 			      nil))
 	       after-change-functions	; Speed it up!
 	       (pm 0) (imenu-scanning-message "Indenting... (%3d%%)"))
@@ -4539,13 +4829,18 @@ conditional/loop constructs."
 	       (imenu-progress-message 
 		pm (/ (* 100 (- (point) start)) (- end start -1))))
 	  (setq st (point))
-	  (if (and (setq comm (looking-at "[ \t]*#"))
-		   (or (eq (current-indentation) (or old-comm-indent 
-						     comment-column))
-		       (setq old-comm-indent nil)))
+	  (if (or
+	       (setq empty (looking-at "[ \t]*\n"))
+	       (and (setq comm (looking-at "[ \t]*#"))
+		    (or (eq (current-indentation) (or old-comm-indent 
+						      comment-column))
+			(setq old-comm-indent nil))))
 	      (if (and old-comm-indent
+		       (not empty)
 		       (= (current-indentation) old-comm-indent)
-		       (not (eq (get-text-property (point) 'syntax-type) 'pod)))
+		       (not (eq (get-text-property (point) 'syntax-type) 'pod))
+		       (not (eq (get-text-property (point) 'syntax-table)
+				cperl-st-cfence)))
 		  (let ((comment-column new-comm-indent))
 		    (indent-for-comment)))
 	    (progn 
@@ -4554,12 +4849,15 @@ conditional/loop constructs."
 		  (not i)
 		  (progn
 		    (if cperl-indent-region-fix-constructs
-			(cperl-fix-line-spacing end indent-info))
+			(goto-char (cperl-fix-line-spacing end indent-info)))
 		    (if (setq old-comm-indent 
 			      (and (cperl-to-comment-or-eol)
 				   (not (memq (get-text-property (point) 
 								 'syntax-type)
 					      '(pod here-doc)))
+				   (not (eq (get-text-property (point) 
+							       'syntax-table)
+					    cperl-st-cfence))
 				   (current-column)))
 			(progn (indent-for-comment)
 			       (skip-chars-backward " \t")
@@ -4917,7 +5215,10 @@ indentation and initial hashes.  Behaves usually outside of comment."
 (defun cperl-init-faces-weak ()
   ;; Allow `cperl-find-pods-heres' to run.
   (or (boundp 'font-lock-constant-face)
-      (setq font-lock-constant-face 'font-lock-constant-face)))
+      (cperl-force-face font-lock-constant-face
+                        "Face for constant and label names")
+      ;;(setq font-lock-constant-face 'font-lock-constant-face)
+      ))
 
 (defun cperl-init-faces ()
   (condition-case errs
@@ -4932,6 +5233,7 @@ indentation and initial hashes.  Behaves usually outside of comment."
 	  (setq 
 	   t-font-lock-keywords
 	   (list
+	    (list "[ \t]+$" 0 cperl-invalid-face t)
 	    (cons
 	     (concat
 	      "\\(^\\|[^$@%&\\]\\)\\<\\("
@@ -5038,14 +5340,14 @@ indentation and initial hashes.  Behaves usually outside of comment."
 	      "u\\(se\\|n\\(shift\\|ti\\(l\\|e\\)\\|def\\|less\\)\\)\\|"
 	      "while\\|y\\|__\\(END\\|DATA\\)__" ;__DATA__ added manually
 	      "\\|[sm]"			; Added manually
-	      "\\)\\>") 2 'font-lock-other-type-face)
+	      "\\)\\>") 2 'cperl-nonoverridable-face)
 	    ;;		(mapconcat 'identity
 	    ;;			   '("#endif" "#else" "#ifdef" "#ifndef" "#if"
 	    ;;			     "#include" "#define" "#undef")
 	    ;;			   "\\|")
 	    '("-[rwxoRWXOezsfdlpSbctugkTBMAC]\\>\\([ \t]+_\\>\\)?" 0
 	      font-lock-function-name-face keep) ; Not very good, triggers at "[a-z]"
-	    '("\\<sub[ \t]+\\([^ \t{;]+\\)[ \t]*\\(([^()]*)[ \t]*\\)?[#{\n]" 1
+	    '("\\<sub[ \t]+\\([^ \t{;()]+\\)[ \t]*\\(([^()]*)[ \t]*\\)?[#{\n]" 1
 	      font-lock-function-name-face)
 	    '("\\<\\(package\\|require\\|use\\|import\\|no\\|bootstrap\\)[ \t]+\\([a-zA-z_][a-zA-z_0-9:]*\\)[ \t;]" ; require A if B;
 	      2 font-lock-function-name-face)
@@ -5140,12 +5442,6 @@ indentation and initial hashes.  Behaves usually outside of comment."
 		    nil
 		    [nil		nil		t		t	t]
 		    nil)
-	      (list 'font-lock-keyword-face
-		    ["Purple"		"LightSteelBlue" "DimGray"	"Gray90"]
-		    nil
-		    [nil		nil		t		t	t]
-		    nil
-		    nil)
 	      (list 'font-lock-function-name-face
 		    (vector
 		     "Blue"		"LightSkyBlue"	"Gray50"	"LightGray"
@@ -5178,7 +5474,7 @@ indentation and initial hashes.  Behaves usually outside of comment."
 		    nil
 		    [nil		nil		t		t	t]
 		    )
-	      (list 'font-lock-other-type-face
+	      (list 'cperl-nonoverridable-face
 		    ["chartreuse3"	("orchid1" "orange")
 		     nil		"Gray80"]
 		    [nil		nil		"gray90"]
@@ -5216,12 +5512,10 @@ indentation and initial hashes.  Behaves usually outside of comment."
 			    "Face for variable names")
 	  (cperl-force-face font-lock-type-face
 			    "Face for data types")
-	  (cperl-force-face font-lock-other-type-face
+	  (cperl-force-face cperl-nonoverridable-face
 			    "Face for data types from another group")
 	  (cperl-force-face font-lock-comment-face
 			    "Face for comments")
-	  (cperl-force-face font-lock-keyword-face
-			    "Face for keywords")
 	  (cperl-force-face font-lock-function-name-face
 			    "Face for function names")
 	  (cperl-force-face cperl-hash-face
@@ -5234,9 +5528,9 @@ indentation and initial hashes.  Behaves usually outside of comment."
 	  ;;    (defconst font-lock-type-face
 	  ;;	'font-lock-type-face
 	  ;;	"Face to use for data types."))
-	  ;;(or (boundp 'font-lock-other-type-face)
-	  ;;    (defconst font-lock-other-type-face
-	  ;;	'font-lock-other-type-face
+	  ;;(or (boundp 'cperl-nonoverridable-face)
+	  ;;    (defconst cperl-nonoverridable-face
+	  ;;	'cperl-nonoverridable-face
 	  ;;	"Face to use for data types from another group."))
 	  ;;(if (not cperl-xemacs-p) nil
 	  ;;  (or (boundp 'font-lock-comment-face)
@@ -5260,6 +5554,11 @@ indentation and initial hashes.  Behaves usually outside of comment."
 	       (cperl-is-face 'font-lock-other-emphasized-face)) 
 	      (copy-face 'font-lock-other-emphasized-face 
 			 'cperl-hash-face))
+	  (if (and
+	       (not (cperl-is-face 'cperl-nonoverridable-face)) 
+	       (cperl-is-face 'font-lock-other-type-face)) 
+	      (copy-face 'font-lock-other-type-face 
+			 'cperl-nonoverridable-face))
 	  ;;(or (boundp 'cperl-hash-face)
 	  ;;    (defconst cperl-hash-face
 	  ;;	'cperl-hash-face
@@ -5308,54 +5607,54 @@ indentation and initial hashes.  Behaves usually outside of comment."
 				       "pink")))
 	       (t
 		(set-face-background 'font-lock-type-face "gray90"))))
-	    (if (cperl-is-face 'font-lock-other-type-face)
+	    (if (cperl-is-face 'cperl-nonoverridable-face)
 		nil
-	      (copy-face 'font-lock-type-face 'font-lock-other-type-face)
+	      (copy-face 'font-lock-type-face 'cperl-nonoverridable-face)
 	      (cond
 	       ((eq background 'light)
-		(set-face-foreground 'font-lock-other-type-face
+		(set-face-foreground 'cperl-nonoverridable-face
 				     (if (x-color-defined-p "chartreuse3")
 					 "chartreuse3"
 				       "chartreuse")))
 	       ((eq background 'dark)
-		(set-face-foreground 'font-lock-other-type-face
+		(set-face-foreground 'cperl-nonoverridable-face
 				     (if (x-color-defined-p "orchid1")
 					 "orchid1"
 				       "orange")))))
-	    (if (cperl-is-face 'font-lock-other-emphasized-face) nil
-	      (copy-face 'bold-italic 'font-lock-other-emphasized-face)
-	      (cond
-	       ((eq background 'light)
-		(set-face-background 'font-lock-other-emphasized-face
-				     (if (x-color-defined-p "lightyellow2")
-					 "lightyellow2"
-				       (if (x-color-defined-p "lightyellow")
-					   "lightyellow"
-					 "light yellow"))))
-	       ((eq background 'dark)
-		(set-face-background 'font-lock-other-emphasized-face
-				     (if (x-color-defined-p "navy")
-					 "navy"
-				       (if (x-color-defined-p "darkgreen")
-					   "darkgreen"
-					 "dark green"))))
-	       (t (set-face-background 'font-lock-other-emphasized-face "gray90"))))
-	    (if (cperl-is-face 'font-lock-emphasized-face) nil
-	      (copy-face 'bold 'font-lock-emphasized-face)
-	      (cond
-	       ((eq background 'light)
-		(set-face-background 'font-lock-emphasized-face
-				     (if (x-color-defined-p "lightyellow2")
-					 "lightyellow2"
-				       "lightyellow")))
-	       ((eq background 'dark)
-		(set-face-background 'font-lock-emphasized-face
-				     (if (x-color-defined-p "navy")
-					 "navy"
-				       (if (x-color-defined-p "darkgreen")
-					   "darkgreen"
-					 "dark green"))))
-	       (t (set-face-background 'font-lock-emphasized-face "gray90"))))
+;;;	    (if (cperl-is-face 'font-lock-other-emphasized-face) nil
+;;;	      (copy-face 'bold-italic 'font-lock-other-emphasized-face)
+;;;	      (cond
+;;;	       ((eq background 'light)
+;;;		(set-face-background 'font-lock-other-emphasized-face
+;;;				     (if (x-color-defined-p "lightyellow2")
+;;;					 "lightyellow2"
+;;;				       (if (x-color-defined-p "lightyellow")
+;;;					   "lightyellow"
+;;;					 "light yellow"))))
+;;;	       ((eq background 'dark)
+;;;		(set-face-background 'font-lock-other-emphasized-face
+;;;				     (if (x-color-defined-p "navy")
+;;;					 "navy"
+;;;				       (if (x-color-defined-p "darkgreen")
+;;;					   "darkgreen"
+;;;					 "dark green"))))
+;;;	       (t (set-face-background 'font-lock-other-emphasized-face "gray90"))))
+;;;	    (if (cperl-is-face 'font-lock-emphasized-face) nil
+;;;	      (copy-face 'bold 'font-lock-emphasized-face)
+;;;	      (cond
+;;;	       ((eq background 'light)
+;;;		(set-face-background 'font-lock-emphasized-face
+;;;				     (if (x-color-defined-p "lightyellow2")
+;;;					 "lightyellow2"
+;;;				       "lightyellow")))
+;;;	       ((eq background 'dark)
+;;;		(set-face-background 'font-lock-emphasized-face
+;;;				     (if (x-color-defined-p "navy")
+;;;					 "navy"
+;;;				       (if (x-color-defined-p "darkgreen")
+;;;					   "darkgreen"
+;;;					 "dark green"))))
+;;;	       (t (set-face-background 'font-lock-emphasized-face "gray90"))))
 	    (if (cperl-is-face 'font-lock-variable-name-face) nil
 	      (copy-face 'italic 'font-lock-variable-name-face))
 	    (if (cperl-is-face 'font-lock-constant-face) nil
@@ -5366,30 +5665,79 @@ indentation and initial hashes.  Behaves usually outside of comment."
 
 (defun cperl-ps-print-init ()
   "Initialization of `ps-print' components for faces used in CPerl."
-  ;; Guard against old versions
-  (defvar ps-underlined-faces nil)
-  (defvar ps-bold-faces nil)
-  (defvar ps-italic-faces nil)
-  (setq ps-bold-faces
-	(append '(font-lock-emphasized-face
-		  font-lock-keyword-face 
-		  font-lock-variable-name-face 
-		  font-lock-constant-face 
-		  font-lock-reference-face 
-		  font-lock-other-emphasized-face) 
-		ps-bold-faces))
-  (setq ps-italic-faces
-	(append '(font-lock-other-type-face
-		  font-lock-constant-face 
-		  font-lock-reference-face 
-		  font-lock-other-emphasized-face)
-		ps-italic-faces))
-  (setq ps-underlined-faces
-	(append '(font-lock-emphasized-face
-		  font-lock-other-emphasized-face 
-		  font-lock-other-type-face font-lock-type-face)
-		ps-underlined-faces))
-  (cons 'font-lock-type-face ps-underlined-faces))
+  (eval-after-load "ps-print"
+    '(setq ps-bold-faces
+	   ;; 			font-lock-variable-name-face 
+	   ;;			font-lock-constant-face
+	   (append '(cperl-array-face
+		     cperl-hash-face) 
+		   ps-bold-faces)
+	   ps-italic-faces
+	   ;;			font-lock-constant-face
+	   (append '(cperl-nonoverridable-face
+		     cperl-hash-face)
+		   ps-italic-faces)
+	   ps-underlined-faces
+	   ;;	     font-lock-type-face
+	   (append '(cperl-array-face
+		     cperl-hash-face
+		     underline
+		     cperl-nonoverridable-face)
+		   ps-underlined-faces))))
+
+(defvar ps-print-face-extension-alist)
+
+(defun cperl-ps-print (&optional file)
+  "Pretty-print in CPerl style.
+If optional argument FILE is an empty string, prints to printer, otherwise
+to the file FILE.  If FILE is nil, prompts for a file name.
+
+Style of printout regulated by the variable `cperl-ps-print-face-properties'."
+  (interactive)
+  (or file 
+      (setq file (read-from-minibuffer 
+		  "Print to file (if empty - to printer): "
+		  (concat (buffer-file-name) ".ps")
+		  nil nil 'file-name-history)))
+  (or (> (length file) 0)
+      (setq file nil))
+  (require 'ps-print)			; To get ps-print-face-extension-alist
+  (let ((ps-print-color-p t)
+	(ps-print-face-extension-alist ps-print-face-extension-alist))
+    (cperl-ps-extend-face-list cperl-ps-print-face-properties)
+    (ps-print-buffer-with-faces file)))
+
+;;; (defun cperl-ps-print-init ()
+;;;   "Initialization of `ps-print' components for faces used in CPerl."
+;;;   ;; Guard against old versions
+;;;   (defvar ps-underlined-faces nil)
+;;;   (defvar ps-bold-faces nil)
+;;;   (defvar ps-italic-faces nil)
+;;;   (setq ps-bold-faces
+;;; 	(append '(font-lock-emphasized-face
+;;; 		  cperl-array-face
+;;; 		  font-lock-keyword-face 
+;;; 		  font-lock-variable-name-face 
+;;; 		  font-lock-constant-face 
+;;; 		  font-lock-reference-face 
+;;; 		  font-lock-other-emphasized-face
+;;; 		  cperl-hash-face) 
+;;; 		ps-bold-faces))
+;;;   (setq ps-italic-faces
+;;; 	(append '(cperl-nonoverridable-face
+;;; 		  font-lock-constant-face 
+;;; 		  font-lock-reference-face 
+;;; 		  font-lock-other-emphasized-face
+;;; 		  cperl-hash-face)
+;;; 		ps-italic-faces))
+;;;   (setq ps-underlined-faces
+;;; 	(append '(font-lock-emphasized-face
+;;; 		  cperl-array-face
+;;; 		  font-lock-other-emphasized-face
+;;; 		  cperl-hash-face
+;;; 		  cperl-nonoverridable-face font-lock-type-face)
+;;; 		ps-underlined-faces))
+;;;   (cons 'font-lock-type-face ps-underlined-faces))
 
 
 (if (cperl-enable-font-lock) (cperl-windowed-init))
@@ -5457,7 +5805,7 @@ indentation and initial hashes.  Behaves usually outside of comment."
      ;;(cperl-extra-newline-before-brace .  nil) ; ???
      (cperl-continued-statement-offset .  4)))
   "(Experimental) list of variables to set to get a particular indentation style.
-Should be used via `cperl-set-style' or via CPerl menu.")
+Should be used via `cperl-set-style' or via Perl menu.")
 
 (defun cperl-set-style (style)
   "Set CPerl-mode variables to use one of several different indentation styles.
@@ -5799,7 +6147,9 @@ See `cperl-lazy-help-time' too."
   "Toggle whether `indent-region'/`indent-sexp' fix whitespace too."
   (interactive)
   (setq cperl-indent-region-fix-constructs 
-	(not cperl-indent-region-fix-constructs))
+	(if cperl-indent-region-fix-constructs
+	    nil
+	  1))
   (message "indent-region/indent-sexp will %sbe automatically fix whitespace." 
 	   (if cperl-indent-region-fix-constructs "" "not ")))
 
@@ -5889,8 +6239,10 @@ See `cperl-lazy-help-time' too."
 	      (lambda (elt)
 		(cond ((string-match "^[_a-zA-Z]" (car elt))
 		       (goto-char (cdr elt))
+		       (beginning-of-line) ; pos should be of the start of the line
 		       (list (car elt) 
-			     (point) (count-lines 1 (point))
+			     (point) 
+			     (1+ (count-lines 1 (point))) ; 1+ since at beg-o-l
 			     (buffer-substring (progn
 						 (skip-chars-forward 
 						  ":_a-zA-Z0-9")
@@ -5911,9 +6263,9 @@ See `cperl-lazy-help-time' too."
 			  (substring (car elt) 8)
 			(car elt) )
 		      1
-		      (number-to-string (elt elt 1))
+		      (number-to-string (elt elt 2)) ; Line
 		      ","
-		      (number-to-string (elt elt 2))
+		      (number-to-string (1- (elt elt 1))) ; Char pos 0-based
 		      "\n")
 	      (if (and (string-match "^[_a-zA-Z]+::" (car elt))
 		       (string-match "^sub[ \t]+\\([_a-zA-Z]+\\)[^:_a-zA-Z]"
@@ -5965,11 +6317,13 @@ Use as
       (setq topdir default-directory))
   (let ((tags-file-name "TAGS")
 	(case-fold-search (eq system-type 'emx))
-	xs)
+	xs rel)
     (save-excursion
       (cond (inbuffer nil)		; Already there
 	    ((file-exists-p tags-file-name)
-	     (visit-tags-table-buffer tags-file-name))
+	     (if cperl-xemacs-p
+		 (visit-tags-table-buffer)
+	      (visit-tags-table-buffer tags-file-name)))
 	    (t (set-buffer (find-file-noselect tags-file-name))))
       (cond
        (dir
@@ -6000,7 +6354,12 @@ Use as
 		  (erase (erase-buffer))
 		  (t
 		   (goto-char 1)
-		   (if (search-forward (concat "\f\n" file ",") nil t)
+		   (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))))
+		   (if (search-forward (concat "\f\n" rel ",") nil t)
 		       (progn
 			 (search-backward "\f\n")
 			 (delete-region (point)
@@ -6052,11 +6411,12 @@ Use as
 	    (setq ;;str (buffer-substring (match-beginning 1) (match-end 1))
 		  name (buffer-substring (match-beginning 2) (match-end 2))
 		  ;;pos (buffer-substring (match-beginning 3) (match-end 3))
-		  line (buffer-substring (match-beginning 4) (match-end 4))
+		  line (buffer-substring (match-beginning 3) (match-end 3))
 		  ord (if pack 1 0)
-		  info (etags-snarf-tag) ; Moves to beginning of the next line
 		  file (file-of-tag)
-		  fileind (format "%s:%s" file line))
+		  fileind (format "%s:%s" file line)
+		  ;; Moves to beginning of the next line:
+		  info (cperl-etags-snarf-tag file line))
 	    ;; Move back
 	    (forward-char -1)
 	    ;; Make new member of hierarchy name ==> file ==> pos if needed
@@ -6082,22 +6442,31 @@ One may build such TAGS files from CPerl mode menu."
   (require 'etags)
   (require 'imenu)
   (if (or update (null (nth 2 cperl-hierarchy)))
-      (let (pack name cons1 to l1 l2 l3 l4
+      (let (pack name cons1 to l1 l2 l3 l4 b
 		 (remover (function (lambda (elt) ; (name (file1...) (file2..))
 				      (or (nthcdr 2 elt)
 					  ;; Only in one file
 					  (setcdr elt (cdr (nth 1 elt))))))))
 	;; (setq cperl-hierarchy '(() () ())) ; Would write into '() later!
 	(setq cperl-hierarchy (list l1 l2 l3))
-	(or tags-table-list
-	    (call-interactively 'visit-tags-table))
-	(message "Updating list of classes...")
-	(mapcar 
-	 (function
-	  (lambda (tagsfile)
-	    (set-buffer (get-file-buffer tagsfile))
-	    (cperl-tags-hier-fill)))
-	 tags-table-list)
+	(if cperl-xemacs-p		; Not checked
+	    (progn
+	      (or tags-file-name
+		  ;; Does this work in XEmacs?
+		  (call-interactively 'visit-tags-table))
+	      (message "Updating list of classes...")
+	      (set-buffer (get-file-buffer tags-file-name))
+	      (cperl-tags-hier-fill))
+	  (or tags-table-list
+	      (call-interactively 'visit-tags-table))
+	  (mapcar 
+	   (function
+	    (lambda (tagsfile)
+	      (message "Updating list of classes... %s" tagsfile)
+	      (set-buffer (get-file-buffer tagsfile))
+	      (cperl-tags-hier-fill)))
+	   tags-table-list)
+	  (message "Updating list of classes... postprocessing..."))
 	(mapcar remover (car cperl-hierarchy))
 	(mapcar remover (nth 1 cperl-hierarchy))
 	(setq to (list nil (cons "Packages: " (nth 1 cperl-hierarchy))
@@ -6122,7 +6491,7 @@ One may build such TAGS files from CPerl mode menu."
   (if (vectorp update) 
       (progn
 	(find-file (elt update 0))
-	(etags-goto-tag-location (elt update 1))))
+	(cperl-etags-goto-tag-location (elt update 1))))
   (if (eq update -999) (cperl-tags-hier-init t)))
 
 (defun cperl-tags-treeify (to level)
@@ -7127,7 +7496,7 @@ We suppose that the regexp is scanned already."
       (or done (forward-char -1)))))
 
 (defun cperl-contract-level ()
-  "Find an enclosing group in regexp and contract it.  Unfinished.
+  "Find an enclosing group in regexp and contract it.
 \(Experimental, may change semantics, recheck the result.)
 We suppose that the regexp is scanned already."
   (interactive)
@@ -7150,7 +7519,7 @@ We suppose that the regexp is scanned already."
 	(just-one-space))))))
 
 (defun cperl-contract-levels ()
-  "Find an enclosing group in regexp and contract all the kids.  Unfinished.
+  "Find an enclosing group in regexp and contract all the kids.
 \(Experimental, may change semantics, recheck the result.)
 We suppose that the regexp is scanned already."
   (interactive)
@@ -7388,9 +7757,12 @@ We suppose that the regexp is scanned already."
 
 (defvar cperl-d-l nil)
 (defun cperl-fontify-syntaxically (end)
-  (and cperl-syntaxify-unwind
-       (cperl-unwind-to-safe t))
-  (let ((start (point)) (dbg (point)))
+  ;; Some vars for debugging only
+  (let (start (dbg (point)) (iend end) 
+	(istate (car cperl-syntax-state)))
+    (and cperl-syntaxify-unwind
+	 (setq end (cperl-unwind-to-safe t end)))
+    (setq start (point))
     (or cperl-syntax-done-to
 	(setq cperl-syntax-done-to (point-min)))
     (if (or (not (boundp 'font-lock-hot-pass))
@@ -7410,9 +7782,10 @@ We suppose that the regexp is scanned already."
 	;;(princ (format "Syntaxifying %s..%s from %s to %s\n" 
 		;;       dbg end start cperl-syntax-done-to)))
     (if (eq cperl-syntaxify-by-font-lock 'message)
-	(message "Syntaxified %s..%s from %s to %s, state at %s" 
-		 dbg end start cperl-syntax-done-to
-		 (car cperl-syntax-state))) ; For debugging 
+	(message "Syntaxified %s..%s from %s to %s(%s), state %s-->%s" 
+		 dbg iend 
+		 start end cperl-syntax-done-to 
+		 istate (car cperl-syntax-state))) ; For debugging 
     nil))				; Do not iterate
 
 (defun cperl-fontify-update (end)
@@ -7434,6 +7807,12 @@ We suppose that the regexp is scanned already."
 	  (goto-char from)
 	  (cperl-fontify-syntaxically to)))))
 
+(defvar cperl-version 
+  (let ((v  "$Revision: 4.19 $"))
+    (string-match ":\\s *\\([0-9.]+\\)" v)
+    (substring v (match-beginning 1) (match-end 1)))
+  "Version of IZ-supported CPerl package this file is based on.")
+
 (provide 'cperl-mode)
 
 ;;; cperl-mode.el ends here
diff --git a/globals.c b/globals.c
index fc88f31b3c..9777273ee6 100644
--- a/globals.c
+++ b/globals.c
@@ -35,13 +35,20 @@ CPerlObj::CPerlObj(IPerlMem* ipM, IPerlEnv* ipE, IPerlStdIO* ipStd,
 void*
 CPerlObj::operator new(size_t nSize, IPerlMem *pvtbl)
 {
-    if(pvtbl != NULL)
+    if(pvtbl)
 	return pvtbl->pMalloc(pvtbl, nSize);
 
     return NULL;
 }
 
 void
+CPerlObj::operator delete(void *pPerl, IPerlMem *pvtbl)
+{
+    if(pvtbl)
+	pvtbl->pFree(pvtbl, pPerl);
+}
+
+void
 CPerlObj::Init(void)
 {
 }
diff --git a/installperl b/installperl
index 39dafa8ba7..faf1c70ca6 100755
--- a/installperl
+++ b/installperl
@@ -158,7 +158,7 @@ if ($Is_Cygwin) {
   };
 } else {
   $perldll = 'perl.' . $dlext;
-  $perldll = 'perlcore.' . $dlext if $Config{'ccflags'} =~ /PERL_OBJECT/i;
+  $perldll = 'perl56.' . $dlext if $Config{'ccflags'} =~ /PERL_OBJECT/i;
 }
 
 -f $perldll || die "No perl DLL built\n";
diff --git a/iperlsys.h b/iperlsys.h
index 00bcf97c4a..f6e19acb84 100644
--- a/iperlsys.h
+++ b/iperlsys.h
@@ -546,17 +546,21 @@ struct IPerlDirInfo
 struct IPerlEnv;
 typedef char*		(*LPEnvGetenv)(struct IPerlEnv*, const char*);
 typedef int		(*LPEnvPutenv)(struct IPerlEnv*, const char*);
-typedef char *		(*LPEnvGetenv_len)(struct IPerlEnv*,
+typedef char*		(*LPEnvGetenv_len)(struct IPerlEnv*,
 				    const char *varname, unsigned long *len);
 typedef int		(*LPEnvUname)(struct IPerlEnv*, struct utsname *name);
 typedef void		(*LPEnvClearenv)(struct IPerlEnv*);
-typedef unsigned long	(*LPEnvOsID)(struct IPerlEnv*);
+typedef void*		(*LPEnvGetChildenv)(struct IPerlEnv*);
+typedef void		(*LPEnvFreeChildenv)(struct IPerlEnv*, void* env);
+typedef char*		(*LPEnvGetChilddir)(struct IPerlEnv*);
+typedef void		(*LPEnvFreeChilddir)(struct IPerlEnv*, char* dir);
 #ifdef HAS_ENVGETENV
-typedef char *		(*LPENVGetenv)(struct IPerlEnv*, const char *varname);
-typedef char *		(*LPENVGetenv_len)(struct IPerlEnv*,
+typedef char*		(*LPENVGetenv)(struct IPerlEnv*, const char *varname);
+typedef char*		(*LPENVGetenv_len)(struct IPerlEnv*,
 				    const char *varname, unsigned long *len);
 #endif
 #ifdef WIN32
+typedef unsigned long	(*LPEnvOsID)(struct IPerlEnv*);
 typedef char*		(*LPEnvLibPath)(struct IPerlEnv*, char*);
 typedef char*		(*LPEnvSiteLibPath)(struct IPerlEnv*, char*);
 #endif
@@ -568,6 +572,10 @@ struct IPerlEnv
     LPEnvGetenv_len	pGetenv_len;
     LPEnvUname		pEnvUname;
     LPEnvClearenv	pClearenv;
+    LPEnvGetChildenv	pGetChildenv;
+    LPEnvFreeChildenv	pFreeChildenv;
+    LPEnvGetChilddir	pGetChilddir;
+    LPEnvFreeChilddir	pFreeChilddir;
 #ifdef HAS_ENVGETENV
     LPENVGetenv		pENVGetenv;
     LPENVGetenv_len	pENVGetenv_len;
@@ -591,10 +599,16 @@ struct IPerlEnvInfo
 	(*PL_Env->pGetenv)(PL_Env,(str))
 #define PerlEnv_getenv_len(str,l)				\
 	(*PL_Env->pGetenv_len)(PL_Env,(str), (l))
-#define PerlEnv_Clear()						\
-	(*PL_Env->pClearenv)(PL_Env)
-#define PerlEnv_Clear()						\
+#define PerlEnv_clearenv()					\
 	(*PL_Env->pClearenv)(PL_Env)
+#define PerlEnv_get_childenv()					\
+	(*PL_Env->pGetChildenv)(PL_Env)
+#define PerlEnv_free_childenv(e)				\
+	(*PL_Env->pFreeChildenv)(PL_Env, (e))
+#define PerlEnv_get_childdir()					\
+	(*PL_Env->pGetChilddir)(PL_Env)
+#define PerlEnv_free_childdir(d)				\
+	(*PL_Env->pFreeChilddir)(PL_Env, (d))
 #ifdef HAS_ENVGETENV
 #  define PerlEnv_ENVgetenv(str)				\
 	(*PL_Env->pENVGetenv)(PL_Env,(str))
@@ -622,6 +636,11 @@ struct IPerlEnvInfo
 #define PerlEnv_putenv(str)		putenv((str))
 #define PerlEnv_getenv(str)		getenv((str))
 #define PerlEnv_getenv_len(str,l)	getenv_len((str), (l))
+#define PerlEnv_clear()			clearenv()
+#define PerlEnv_get_childenv()		get_childenv()
+#define PerlEnv_free_childenv(e)	free_childenv((e))
+#define PerlEnv_get_childdir()		get_childdir()
+#define PerlEnv_free_childdir(d)	free_childdir((d))
 #ifdef HAS_ENVGETENV
 #  define PerlEnv_ENVgetenv(str)	ENVgetenv((str))
 #  define PerlEnv_ENVgetenv_len(str,l)	ENVgetenv_len((str), (l))
diff --git a/makedef.pl b/makedef.pl
index 676d229283..8a79bae431 100644
--- a/makedef.pl
+++ b/makedef.pl
@@ -68,7 +68,7 @@ close(CFG);
 if ($PLATFORM eq 'win32') {
     warn join(' ',keys %define)."\n";
     if ($define{PERL_OBJECT}) {
-	print "LIBRARY PerlCore\n";
+	print "LIBRARY Perl56\n";
 	print "DESCRIPTION 'Perl interpreter'\n";
 	print "EXPORTS\n";
 #    output_symbol("perl_alloc");
diff --git a/perl.h b/perl.h
index 8446d0949d..86657049f6 100644
--- a/perl.h
+++ b/perl.h
@@ -2482,6 +2482,7 @@ public:
 	CPerlObj(IPerlMem*, IPerlEnv*, IPerlStdIO*, IPerlLIO*, IPerlDir*, IPerlSock*, IPerlProc*);
 	void Init(void);
 	void* operator new(size_t nSize, IPerlMem *pvtbl);
+	static void operator delete(void* pPerl, IPerlMem *pvtbl);
 #endif /* PERL_OBJECT */
 
 #ifdef PERL_GLOBAL_STRUCT
diff --git a/pod/perllexwarn.pod b/pod/perllexwarn.pod
index 484e211000..81f44cca3a 100644
--- a/pod/perllexwarn.pod
+++ b/pod/perllexwarn.pod
@@ -314,8 +314,8 @@ The experimental features need bottomed out.
     the module should be revisited.
 
   octal
-    'octal' controls illegal octal characters warning but 'unsafe'
-    illegal hexadecimal and binary characters warning.  
+    'octal' controls illegal octal characters warning, but 'unsafe' controls
+    illegal hexadecimal and binary characters warnings.
 
 =head1 SEE ALSO
 
diff --git a/toke.c b/toke.c
index d02ac5a67d..23a8cb4f72 100644
--- a/toke.c
+++ b/toke.c
@@ -11,9 +11,8 @@
  *   "It all comes from here, the stench and the peril."  --Frodo
  */
 
-/* toke.c
- *
- * This file is the tokenizer for Perl.  It's closely linked to the
+/*
+ * This file is the lexer for Perl.  It's closely linked to the
  * parser, perly.y.  
  *
  * The main routine is yylex(), which returns the next token.
@@ -109,7 +108,7 @@ int* yychar_pointer = NULL;
 
 /*
  * Convenience functions to return different tokens and prime the
- * tokenizer for the next token.  They all take an argument.
+ * lexer for the next token.  They all take an argument.
  *
  * TOKEN        : generic token (used for '(', DOLSHARP, etc)
  * OPERATOR     : generic operator
@@ -126,7 +125,7 @@ int* yychar_pointer = NULL;
  * BAop         : bitwise and
  * SHop         : shift operator
  * PWop         : power operator
- * PMop         : matching operator
+ * PMop         : pattern-matching operator
  * Aop          : addition-level operator
  * Mop          : multiplication-level operator
  * Eop          : equality-testing operator
@@ -274,7 +273,6 @@ S_missingterm(pTHX_ char *s)
 
 /*
  * Perl_deprecate
- * Warns that something is deprecated.  Duh.
  */
 
 void
@@ -287,8 +285,7 @@ Perl_deprecate(pTHX_ char *s)
 
 /*
  * depcom
- * Deprecate a comma-less variable list.  Called from three places
- * in the tokenizer.
+ * Deprecate a comma-less variable list.
  */
 
 STATIC void
@@ -298,8 +295,8 @@ S_depcom(pTHX)
 }
 
 /*
- * text filters for win32 carriage-returns, utf16-to-utf8 and
- * utf16-to-utf8-reversed, whatever that is.
+ * experimental text filters for win32 carriage-returns, utf16-to-utf8 and
+ * utf16-to-utf8-reversed.
  */
 
 #ifdef WIN32
@@ -346,8 +343,8 @@ S_utf16rev_textfilter(pTHX_ int idx, SV *sv, int maxlen)
 
 /*
  * Perl_lex_start
- * Initialize variables.  Called by perl.c.  It uses the Perl stack
- * to save its state (for recursive calls to the parser).
+ * Initialize variables.  Uses the Perl save_stack to save its state (for
+ * recursive calls to the parser).
  */
 
 void
@@ -417,8 +414,8 @@ Perl_lex_start(pTHX_ SV *line)
 
 /*
  * Perl_lex_end
- * Tidy up.  Called from pp_ctl.c in the sv_compile_2op(), doeval(),
- * and pp_leaveeval() subroutines.
+ * Finalizer for lexing operations.  Must be called when the parser is
+ * done with the lexer.
  */
 
 void
@@ -433,8 +430,8 @@ Perl_lex_end(pTHX)
  * or pinball tables.  Its name is short for "increment line".  It
  * increments the current line number in PL_curcop->cop_line and checks
  * to see whether the line starts with a comment of the form
- *    # line 500
- * If so, it sets the current line number to the number in the comment.
+ *    # line 500 "foo.pm"
+ * If so, it sets the current line number and file to the values in the comment.
  */
 
 STATIC void
@@ -521,8 +518,10 @@ S_skipspace(pTHX_ register char *s)
 	    return s;
 
 	/* try to recharge the buffer */
-	if ((s = filter_gets(PL_linestr, PL_rsfp, (prevlen = SvCUR(PL_linestr)))) == Nullch) {
-	  /* end of file.  Add on the -p or -n magic */
+	if ((s = filter_gets(PL_linestr, PL_rsfp,
+			     (prevlen = SvCUR(PL_linestr)))) == Nullch)
+	{
+	    /* end of file.  Add on the -p or -n magic */
 	    if (PL_minus_n || PL_minus_p) {
 		sv_setpv(PL_linestr,PL_minus_p ?
 			 ";}continue{print or die qq(-p destination: $!\\n)" :
@@ -534,7 +533,8 @@ S_skipspace(pTHX_ register char *s)
 		sv_setpv(PL_linestr,";");
 
 	    /* reset variables for next time we lex */
-	    PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = s = PL_linestart = SvPVX(PL_linestr);
+	    PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = s = PL_linestart
+		= SvPVX(PL_linestr);
 	    PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
 
 	    /* Close the filehandle.  Could be from -P preprocessor,
@@ -673,11 +673,11 @@ S_lop(pTHX_ I32 f, expectation x, char *s)
 
 /*
  * S_force_next
- * When the tokenizer realizes it knows the next token (for instance,
+ * When the lexer realizes it knows the next token (for instance,
  * it is reordering tokens for the parser) then it can call S_force_next
- * to make the current token be the next one.  It will also set 
- * PL_nextval, and possibly PL_expect to ensure the lexer handles the
- * token correctly.
+ * to know what token to return the next time the lexer is called.  Caller
+ * will need to set PL_nextval[], and possibly PL_expect to ensure the lexer
+ * handles the token correctly.
  */
 
 STATIC void 
@@ -705,7 +705,7 @@ S_force_next(pTHX_ I32 type)
  *       a keyword (do this if the word is a label, e.g. goto FOO)
  *   int allow_pack : if true, : characters will also be allowed (require,
  *       use, etc. do this)
- *   int allow_initial_tick : used by the "sub" tokenizer only.
+ *   int allow_initial_tick : used by the "sub" lexer only.
  */
 
 STATIC char *
@@ -740,12 +740,11 @@ S_force_word(pTHX_ register char *start, int token, int check_keyword, int allow
 
 /*
  * S_force_ident
- * Called when the tokenizer wants $foo *foo &foo etc, but the program
+ * Called when the lexer wants $foo *foo &foo etc, but the program
  * text only contains the "foo" portion.  The first argument is a pointer
  * to the "foo", and the second argument is the type symbol to prefix.
  * Forces the next token to be a "WORD".
- * Creates the symbol if it didn't already exist (through the gv_fetchpv
- * call).
+ * Creates the symbol if it didn't already exist (via gv_fetchpv()).
  */
 
 STATIC void
@@ -960,7 +959,8 @@ S_sublex_push(pTHX)
     PL_linestr = PL_lex_stuff;
     PL_lex_stuff = Nullsv;
 
-    PL_bufend = PL_bufptr = PL_oldbufptr = PL_oldoldbufptr = PL_linestart = SvPVX(PL_linestr);
+    PL_bufend = PL_bufptr = PL_oldbufptr = PL_oldoldbufptr = PL_linestart
+	= SvPVX(PL_linestr);
     PL_bufend += SvCUR(PL_linestr);
     SAVEFREESV(PL_linestr);
 
@@ -1127,10 +1127,10 @@ S_scan_const(pTHX_ char *start)
 	? (PL_sublex_info.sub_op->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF))
 	: UTF;
     I32 thisutf = (PL_lex_inwhat == OP_TRANS && PL_sublex_info.sub_op)
-	? (PL_sublex_info.sub_op->op_private & (PL_lex_repl ? OPpTRANS_FROM_UTF : OPpTRANS_TO_UTF))
+	? (PL_sublex_info.sub_op->op_private & (PL_lex_repl ?
+						OPpTRANS_FROM_UTF : OPpTRANS_TO_UTF))
 	: UTF;
-    /* leaveit is the set of acceptably-backslashed characters */
-    char *leaveit =
+    char *leaveit =			/* set of acceptably-backslashed characters */
 	PL_lex_inpat
 	    ? "\\.^$@AGZdDwWsSbBpPXC+*?|()-nrtfeaxcz0123456789[{]} \t\n\r\f\v#"
 	    : "";
@@ -1145,8 +1145,8 @@ S_scan_const(pTHX_ char *start)
 		I32 max;			/* last character in range */
 
 		i = d - SvPVX(sv);		/* remember current offset */
-		SvGROW(sv, SvLEN(sv) + 256);	/* expand the sv -- there'll never be more'n 256 chars in a range for it to grow by */
-		d = SvPVX(sv) + i;		/* restore d after the grow potentially has changed the ptr */
+		SvGROW(sv, SvLEN(sv) + 256);	/* never more than 256 chars in a range */
+		d = SvPVX(sv) + i;		/* refresh d after realloc */
 		d -= 2;				/* eat the first char and the - */
 
 		min = (U8)*d;			/* first char in range */
@@ -1437,7 +1437,6 @@ S_scan_const(pTHX_ char *start)
 /* S_intuit_more
  * Returns TRUE if there's more to the expression (e.g., a subscript),
  * FALSE otherwise.
- * This is the one truly awful dwimmer necessary to conflate C and sed.
  *
  * It deals with "$foo[3]" and /$foo[3]/ and /$foo[0123456789$]+/
  *
@@ -1454,6 +1453,8 @@ S_scan_const(pTHX_ char *start)
  * anything else returns TRUE
  */
 
+/* This is the one truly awful dwimmer necessary to conflate C and sed. */
+
 STATIC int
 S_intuit_more(pTHX_ register char *s)
 {
diff --git a/utils/perldoc.PL b/utils/perldoc.PL
index 8c1c6968d1..7dc478b4e7 100644
--- a/utils/perldoc.PL
+++ b/utils/perldoc.PL
@@ -313,10 +313,9 @@ sub printout {
     my $err;
 
     if ($opt_t) {
-	open(TMP,">>$tmp")
-		or warn("Can't open $tmp: $!"), return;
-	Pod::Text::pod2text($file,*TMP);
-	close TMP;
+	open(OUT,">>$tmp") or warn("Can't open $tmp: $!"), return;
+	Pod::Text->new()->parse_from_file($file,\*OUT);
+	close OUT;
     }
     elsif (not $opt_u) {
 	my $cmd = "pod2man --lax $file | nroff -man";
diff --git a/win32/Makefile b/win32/Makefile
index 2da82c2ffa..8750f0587c 100644
--- a/win32/Makefile
+++ b/win32/Makefile
@@ -341,8 +341,8 @@ EXTUTILSDIR	= $(LIBDIR)\extutils
 #
 # various targets
 !IF "$(USE_OBJECT)" == "define"
-PERLIMPLIB	= ..\perlcore.lib
-PERLDLL		= ..\perlcore.dll
+PERLIMPLIB	= ..\perl56.lib
+PERLDLL		= ..\perl56.dll
 !ELSE
 PERLIMPLIB	= ..\perl.lib
 PERLDLL		= ..\perl.dll
diff --git a/win32/bin/pl2bat.pl b/win32/bin/pl2bat.pl
index d3a9c0b779..cdbac6f273 100644
--- a/win32/bin/pl2bat.pl
+++ b/win32/bin/pl2bat.pl
@@ -251,16 +251,20 @@ be used.
 
 One approach is:
 
-    #!perl
-    while( <DATA> ) {
-	last   if  /^__END__$/;
-	[...]
-    }
-    __END__
-    lines of data
-    to be processed
-    __END__
-    :endofperl
+    .  #!perl
+    .  while( <DATA> ) {
+    .	  last   if  /^__END__$/;
+    .	  [...]
+    .  }
+    .  __END__
+    .  lines of data
+    .  to be processed
+    .  __END__
+    .  :endofperl
+
+The dots in the first column are only there to prevent F<cmd.exe> to interpret
+the C<:endofperl> line in this documentation.  Otherwise F<pl2bat.bat> itself
+wouldn't work.  See the previous item. :-)
 
 =item The batch file always "succeeds"
 
diff --git a/win32/makefile.mk b/win32/makefile.mk
index 738f1f5ef3..f2460a835b 100644
--- a/win32/makefile.mk
+++ b/win32/makefile.mk
@@ -502,8 +502,8 @@ PERL95EXE	= ..\perl95.exe
 .ENDIF
 
 .IF "$(USE_OBJECT)" == "define"
-PERLIMPLIB	*= ..\perlcore$(a)
-PERLDLL		= ..\perlcore.dll
+PERLIMPLIB	*= ..\perl56$(a)
+PERLDLL		= ..\perl56.dll
 .ELSE
 PERLIMPLIB	*= ..\perl$(a)
 PERLDLL		= ..\perl.dll
diff --git a/win32/perllib.c b/win32/perllib.c
index cba7e41881..10b252a8db 100644
--- a/win32/perllib.c
+++ b/win32/perllib.c
@@ -91,6 +91,49 @@ PerlEnvUname(struct IPerlEnv*, struct utsname *name)
     return win32_uname(name);
 }
 
+void
+PerlEnvClearenv(struct IPerlEnv*)
+{
+    dTHXo;
+    char *envv = GetEnvironmentStrings();
+    char *cur = envv;
+    STRLEN len;
+    while (*cur) {
+	char *end = strchr(cur,'=');
+	if (end && end != cur) {
+	    *end = '\0';
+	    my_setenv(cur,Nullch);
+	    *end = '=';
+	    cur = end + strlen(end+1)+2;
+	}
+	else if ((len = strlen(cur)))
+	    cur += len+1;
+    }
+    FreeEnvironmentStrings(envv);
+}
+
+void*
+PerlEnvGetChildEnv(struct IPerlEnv*)
+{
+    return NULL;
+}
+
+void
+PerlEnvFreeChildEnv(struct IPerlEnv*, void* env)
+{
+}
+
+char*
+PerlEnvGetChildDir(struct IPerlEnv*)
+{
+    return NULL;
+}
+
+void
+PerlEnvFreeChildDir(struct IPerlEnv*, char* dir)
+{
+}
+
 unsigned long
 PerlEnvOsId(struct IPerlEnv*)
 {
@@ -115,7 +158,11 @@ struct IPerlEnv perlEnv =
     PerlEnvPutenv,
     PerlEnvGetenv_len,
     PerlEnvUname,
-    NULL,
+    PerlEnvClearenv,
+    PerlEnvGetChildEnv,
+    PerlEnvFreeChildEnv,
+    PerlEnvGetChildDir,
+    PerlEnvFreeChildDir,
     PerlEnvOsId,
     PerlEnvLibPath,
     PerlEnvSiteLibPath,
@@ -375,6 +422,8 @@ PerlStdIOInit(struct IPerlStdIO*)
 void
 PerlStdIOInitOSExtras(struct IPerlStdIO*)
 {
+    dTHXo;
+    xs_init(pPerl);
     Perl_init_os_extras();
 }
 
@@ -1407,7 +1456,7 @@ EXTERN_C int perl_parse(PerlInterpreter* sv_interp, void (*xsinit)(CPerlObj*), i
     CPerlObj* pPerl = (CPerlObj*)sv_interp;
     try
     {
-	retVal = pPerl->perl_parse(xs_init, argc, argv, env);
+	retVal = pPerl->perl_parse(xsinit, argc, argv, env);
     }
 /*
     catch(int x)
@@ -1427,13 +1476,9 @@ EXTERN_C int perl_parse(PerlInterpreter* sv_interp, void (*xsinit)(CPerlObj*), i
 
 #undef PL_perl_destruct_level
 #define PL_perl_destruct_level int dummy
-#undef w32_perldll_handle
-#define w32_perldll_handle g_w32_perldll_handle
-HANDLE g_w32_perldll_handle;
-#else
-extern HANDLE w32_perldll_handle;
 #endif /* PERL_OBJECT */
 
+extern HANDLE w32_perldll_handle;
 static DWORD g_TlsAllocIndex;
 
 EXTERN_C DllExport bool
@@ -1486,7 +1531,12 @@ RunPerl(int argc, char **argv, char **env)
     perl_construct( my_perl );
     PL_perl_destruct_level = 0;
 
+#ifdef PERL_OBJECT
+    /* PERL_OBJECT build sets Dynaloader in PerlStdIOInitOSExtras */
+    exitstatus = perl_parse(my_perl, NULL, argc, argv, env);
+#else
     exitstatus = perl_parse(my_perl, xs_init, argc, argv, env);
+#endif
     if (!exitstatus) {
 	exitstatus = perl_run( my_perl );
     }
@@ -1518,9 +1568,7 @@ DllMain(HANDLE hModule,		/* DLL module handle */
 #endif
 	g_TlsAllocIndex = TlsAlloc();
 	DisableThreadLibraryCalls(hModule);
-#ifndef PERL_OBJECT
 	w32_perldll_handle = hModule;
-#endif
 	break;
 
 	/* The DLL is detaching from a process due to
diff --git a/win32/win32.c b/win32/win32.c
index b28b042d66..e705e4d765 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -2475,6 +2475,35 @@ GIVE_UP:
     return Nullch;
 }
 
+/* The following are just place holders.
+ * Some hosts may provide and environment that the OS is
+ * not tracking, therefore, these host must provide that
+ * environment and the current directory to CreateProcess
+ */
+
+void*
+get_childenv(void)
+{
+    return NULL;
+}
+
+void
+free_childenv(void*)
+{
+}
+
+char*
+get_childdir(void)
+{
+    return NULL;
+}
+
+void
+free_childdir(char*)
+{
+}
+
+
 /* XXX this needs to be made more compatible with the spawnvp()
  * provided by the various RTLs.  In particular, searching for
  * *.{com,bat,cmd} files (as done by the RTLs) is unimplemented.
@@ -2494,6 +2523,8 @@ win32_spawnvp(int mode, const char *cmdname, const char *const *argv)
 #else
     dTHXo;
     DWORD ret;
+    void* env;
+    char* dir;
     STARTUPINFO StartupInfo;
     PROCESS_INFORMATION ProcessInformation;
     DWORD create = 0;
@@ -2502,6 +2533,9 @@ win32_spawnvp(int mode, const char *cmdname, const char *const *argv)
 			     	             ? &argv[1] : argv);
     char *fullcmd = Nullch;
 
+    env = PerlEnv_get_childenv();
+    dir = PerlEnv_get_childdir();
+
     switch(mode) {
     case P_NOWAIT:	/* asynch + remember result */
 	if (w32_num_children >= MAXIMUM_WAIT_OBJECTS) {
@@ -2544,8 +2578,8 @@ RETRY:
 		       NULL,		/* thread attributes */
 		       TRUE,		/* inherit handles */
 		       create,		/* creation flags */
-		       NULL,		/* inherit environment */
-		       NULL,		/* inherit cwd */
+		       (LPVOID)env,	/* inherit environment */
+		       dir,		/* inherit cwd */
 		       &StartupInfo,
 		       &ProcessInformation))
     {
@@ -2580,7 +2614,10 @@ RETRY:
     }
 
     CloseHandle(ProcessInformation.hThread);
+
 RETVAL:
+    PerlEnv_free_childenv(env);
+    PerlEnv_free_childdir(dir);
     Safefree(cmd);
     Safefree(fullcmd);
     return (int)ret;