4 files changed, 33 insertions, 3 deletions

diff --git a/usr.bin/vgrind/regexp.c b/usr.bin/vgrind/regexp.c
index 2022edb4b0de..472b6d420fa5 100644
--- a/usr.bin/vgrind/regexp.c
+++ b/usr.bin/vgrind/regexp.c
@@ -263,7 +263,7 @@ expconv()
 	    OCNT(cs) = ccre - cs;		/* offset to next symbol */
 	    break;
 
-	/* reurn from a recursion */
+	/* return from a recursion */
 	case ')':
 	    if (acs != NIL) {
 		do {
diff --git a/usr.bin/vgrind/vfontedpr.c b/usr.bin/vgrind/vfontedpr.c
index 3be249b053e4..bd153a8c4fec 100644
--- a/usr.bin/vgrind/vfontedpr.c
+++ b/usr.bin/vgrind/vfontedpr.c
@@ -117,6 +117,7 @@ char	*l_combeg;		/* string introducing a comment */
 char	*l_comend;		/* string ending a comment */
 char	 l_escape;		/* character used to  escape characters */
 char	*l_keywds[BUFSIZ/2];	/* keyword table address */
+char	*l_nocom;		/* regexp for non-comments */
 char	*l_prcbeg;		/* regular expr for procedure begin */
 char    *l_strbeg;		/* delimiter for string constant */
 char    *l_strend;		/* delimiter for string constant */
@@ -274,6 +275,8 @@ main(argc, argv)
 	l_chrbeg = convexp(cp);
 	cgetustr(defs, "le", &cp);
 	l_chrend = convexp(cp);
+	cgetustr(defs, "nc", &cp);
+	l_nocom = convexp(cp);
 	l_escape = '\\';
 	l_onecase = (cgetcap(defs, "oc", ':') != NULL);
 	l_toplex = (cgetcap(defs, "tl", ':') != NULL);
@@ -358,6 +361,7 @@ putScp(os)
     char *chrptr;			/* end of a character const delimiter */
     char *blksptr;			/* end of a lexical block start */
     char *blkeptr;			/* end of a lexical block end */
+    char *nocomptr;			/* end of a non-comment delimiter */
 
     _start = os;			/* remember the start for expmatch */
     _escaped = FALSE;
@@ -385,6 +389,17 @@ skip:
 	    acmptr = expmatch (s, l_acmbeg, dummy);
 	    strptr = expmatch (s, l_strbeg, dummy);
 	    chrptr = expmatch (s, l_chrbeg, dummy);
+	    nocomptr = expmatch (s, l_nocom, dummy);
+
+	    /* start of non-comment? */
+	    if (nocomptr != NIL)
+		if ((nocomptr <= comptr || comptr == NIL)
+		  && (nocomptr <= acmptr || acmptr == NIL)) {
+		    /* continue after non-comment */
+		    putKcp (s, nocomptr-1, FALSE);
+		    s = nocomptr;
+		    continue;
+		}
 
 	    /* start of a comment? */
 	    if (comptr != NIL)
@@ -445,7 +460,8 @@ skip:
 		if (blkeptr < blksptr || blksptr == NIL) {
 		    putKcp (s, blkeptr - 1, FALSE);
 		    s = blkeptr;
-		    blklevel--;
+		    if (blklevel > 0 /* sanity */)
+			    blklevel--;
 		    if (psptr >= 0 && plstack[psptr] >= blklevel) {
 
 			/* end of current procedure */
@@ -619,6 +635,9 @@ putcp(c)
 	case '\f':
 		break;
 
+	case '\r':
+		break;
+
 	case '{':
 		ps("\\*(+K{\\*(-K");
 		break;
diff --git a/usr.bin/vgrind/vgrindefs.5 b/usr.bin/vgrind/vgrindefs.5
index 4ac752275bff..c2060a214881 100644
--- a/usr.bin/vgrind/vgrindefs.5
+++ b/usr.bin/vgrind/vgrindefs.5
@@ -54,6 +54,8 @@ The following table names and describes each field.
 .Pp
 .Bl -column Namexxx Tpexxx
 .Sy Name	Type	Description
+.It "ab	str	regular expression for the start of an alternate comment"
+.It "ae	str	regular expression for the end of an alternate comment"
 .It "pb	str	regular expression for start of a procedure"
 .It "bb	str	regular expression for start of a lexical block"
 .It "be	str	regular expression for the end of a lexical block"
@@ -63,11 +65,20 @@ The following table names and describes each field.
 .It "se	str	regular expression for the end of a string"
 .It "lb	str	regular expression for the start of a character constant"
 .It "le	str	regular expression for the end of a character constant"
+.It "nc	str	regular expression for a non-comment (see below)"
 .It "tl	bool	present means procedures are only defined at the top lexical level"
 .It "oc	bool	present means upper and lower case are equivalent"
 .It "kw	str	a list of keywords separated by spaces"
 .El
 .Pp
+Non-comments are required to describe a certain context where a
+sequence that would normally start a comment loses its special
+meaning.  A typical example for this can be found in Perl, where
+comments are normally starting with
+.Ql # ,
+while the string
+.Ql $#
+is an operator on an array.
 .Sh EXAMPLES
 The following entry, which describes the C language, is 
 typical of a language entry.
diff --git a/usr.bin/vgrind/vgrindefs.src b/usr.bin/vgrind/vgrindefs.src
index becf7732ae98..a5e12eee0c37 100644
--- a/usr.bin/vgrind/vgrindefs.src
+++ b/usr.bin/vgrind/vgrindefs.src
@@ -150,7 +150,7 @@ C++|c++:\
 #   &packagename'function;
 #
 Perl|perl|pl:\
-	:pb=sub\d\p\d:bb={:be=}:cb=#:ce=$:tl:\
+	:pb=sub\d\p\d:bb={:be=}:cb=#:ce=$:nc=\$#:tl:\
 	:ab=&:ae=(;|\d|,):\
 	:sb=":se=(\e"|$):lb=':le=(\e'|$):\
 	:kw=do if unless while until else elsif for foreach continue\