perl 5.0 alpha 2perl-5a2

[editor's note: from history.perl.org.  The sparc executables
originally included in the distribution are not in this commit.]

1 files changed, 58 insertions, 0 deletions

diff --git a/do/trans b/do/trans
new file mode 100644
index 0000000000..f4c5503b43
--- /dev/null
+++ b/do/trans
@@ -0,0 +1,58 @@
+int
+do_trans(TARG,arg)
+STR *TARG;
+ARG *arg;
+{
+    register short *tbl;
+    register char *s;
+    register int matches = 0;
+    register int ch;
+    register char *send;
+    register char *d;
+    register int squash = arg[2].arg_len & 1;
+
+    tbl = (short*) arg[2].arg_ptr.arg_cval;
+    s = str_get(TARG);
+    send = s + TARG->str_cur;
+    if (!tbl || !s)
+	fatal("panic: do_trans");
+#ifdef DEBUGGING
+    if (debug & 8) {
+	deb("2.TBL\n");
+    }
+#endif
+    if (!arg[2].arg_len) {
+	while (s < send) {
+	    if ((ch = tbl[*s & 0377]) >= 0) {
+		matches++;
+		*s = ch;
+	    }
+	    s++;
+	}
+    }
+    else {
+	d = s;
+	while (s < send) {
+	    if ((ch = tbl[*s & 0377]) >= 0) {
+		*d = ch;
+		if (matches++ && squash) {
+		    if (d[-1] == *d)
+			matches--;
+		    else
+			d++;
+		}
+		else
+		    d++;
+	    }
+	    else if (ch == -1)		/* -1 is unmapped character */
+		*d++ = *s;		/* -2 is delete character */
+	    s++;
+	}
+	matches += send - d;	/* account for disappeared chars */
+	*d = '\0';
+	TARG->str_cur = d - TARG->str_ptr;
+    }
+    STABSET(TARG);
+    return matches;
+}
+