From: Jarkko Hietaniemi <jhi@iki.fi>
Date: Tue, 13 Feb 2001 02:22:36 +0000 (+0000)
Subject: Merge ebcdic.c (only one function, ebcdic_control()) into util.c.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a926ef6bf408292b4a3963e296e2683a36825a5e;p=p5sagit%2Fp5-mst-13.2.git

Merge ebcdic.c (only one function, ebcdic_control()) into util.c.

p4raw-id: //depot/perl@8783
---

diff --git a/MANIFEST b/MANIFEST
index 61af6b5..f02ed7e 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -89,7 +89,6 @@ doio.c			I/O operations
 doop.c			Support code for various operations
 dosish.h		Some defines for MS/DOSish machines
 dump.c			Debugging output
-ebcdic.c		EBCDIC support routines
 emacs/cperl-mode.el	An alternate perl-mode
 emacs/e2ctags.pl	etags to ctags converter
 emacs/ptags		Creates smart TAGS file
diff --git a/ebcdic.c b/ebcdic.c
deleted file mode 100644
index d86d50b..0000000
--- a/ebcdic.c
+++ /dev/null
@@ -1,41 +0,0 @@
-#include "EXTERN.h"
-#define PERL_IN_EBCDIC_C
-#include "perl.h"
-
-/* in ASCII order, not that it matters */
-static const char controllablechars[] = "?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_";
- 
-int
-ebcdic_control(int ch)
-{
-    	if (ch > 'a') {
-	        char *ctlp;
- 
- 	       if (islower(ch))
-  	              ch = toupper(ch);
- 
- 	       if ((ctlp = strchr(controllablechars, ch)) == 0) {
-  	              Perl_die(aTHX_ "unrecognised control character '%c'\n", ch);
-     	       }
- 
-        	if (ctlp == controllablechars)
-         	       return('\177'); /* DEL */
-        	else
-         	       return((unsigned char)(ctlp - controllablechars - 1));
-	} else { /* Want uncontrol */
-        	if (ch == '\177' || ch == -1)
-                	return('?');
-        	else if (ch == '\157')
-                	return('\177');
-        	else if (ch == '\174')
-                	return('\000');
-        	else if (ch == '^')    /* '\137' in 1047, '\260' in 819 */
-                	return('\036');
-        	else if (ch == '\155')
-                	return('\037');
-        	else if (0 < ch && ch < (sizeof(controllablechars) - 1))
-                	return(controllablechars[ch+1]);
-        	else
-                	Perl_die(aTHX_ "invalid control request: '\\%03o'\n", ch & 0xFF);
-	}
-}
diff --git a/embed.h b/embed.h
index 6d2eea6..1150e98 100644
--- a/embed.h
+++ b/embed.h
@@ -1159,6 +1159,9 @@
 #  if defined(LEAKTEST)
 #define xstat			S_xstat
 #  endif
+#  if defined(EBCDIC)
+#define ebcdic_control		Perl_ebcdic_control
+#  endif
 #endif
 #if defined(PERL_OBJECT)
 #endif
@@ -2633,6 +2636,9 @@
 #  if defined(LEAKTEST)
 #define xstat(a)		S_xstat(aTHX_ a)
 #  endif
+#  if defined(EBCDIC)
+#define ebcdic_control(a)	Perl_ebcdic_control(aTHX_ a)
+#  endif
 #endif
 #if defined(PERL_OBJECT)
 #endif
@@ -5112,6 +5118,10 @@
 #define S_xstat			CPerlObj::S_xstat
 #define xstat			S_xstat
 #  endif
+#  if defined(EBCDIC)
+#define Perl_ebcdic_control	CPerlObj::Perl_ebcdic_control
+#define ebcdic_control		Perl_ebcdic_control
+#  endif
 #endif
 #if defined(PERL_OBJECT)
 #endif
diff --git a/embed.pl b/embed.pl
index e350a45..2e93faa 100755
--- a/embed.pl
+++ b/embed.pl
@@ -2553,6 +2553,9 @@ s	|SV*	|mess_alloc
 #  if defined(LEAKTEST)
 s	|void	|xstat		|int
 #  endif
+#  if defined(EBCDIC)
+p	|int	|ebcdic_control	|int ch
+#  endif
 #endif
 
 #if defined(PERL_OBJECT)
diff --git a/handy.h b/handy.h
index 9d7e096..9ac2e29 100644
--- a/handy.h
+++ b/handy.h
@@ -483,7 +483,6 @@ Converts the specified character to lowercase.
 #define isBLANK_LC_utf8(c)	isBLANK(c) /* could be wrong */
 
 #ifdef EBCDIC
-EXT int ebcdic_control (int);
 #  define toCTRL(c)	ebcdic_control(c)
 #else
   /* This conversion works both ways, strangely enough. */
diff --git a/hints/os390.sh b/hints/os390.sh
index 54787e8..6f4f39b 100644
--- a/hints/os390.sh
+++ b/hints/os390.sh
@@ -139,14 +139,6 @@ case "$archname" in
 '') archname="$osname" ;;
 esac
 
-# Architecture related object files.
-# ebcdic.c contains special \cX mapping code for EBCDIC char sets.
-# Prepend your preference with Configure -Darchobs=your_preference.o.
-case "$archname" in
-'') archobjs="ebcdic.o" ;;
-*) archobjs="$archobjs ebcdic.o" ;;
-esac
-
 # We have our own cppstdin script.  This is not a variable since 
 # Configure sees the presence of the script file.
 # We put system header -D definitions in so that Configure
diff --git a/hints/posix-bc.sh b/hints/posix-bc.sh
index 5c45832..6275233 100644
--- a/hints/posix-bc.sh
+++ b/hints/posix-bc.sh
@@ -92,10 +92,3 @@ esac
 #'') ldlibpthname=LIBPATH ;;
 #esac
 
-# Architecture related object files.
-# ebcdic.c contains special \cX mapping code for EBCDIC char sets.
-# Prepend your preference with Configure -Darchobs=your_preference.o.
-case "$archname" in
-'') archobjs="ebcdic.o" ;;
-*) archobjs="$archobjs ebcdic.o" ;;
-esac
diff --git a/hints/vmesa.sh b/hints/vmesa.sh
index 81ab6a4..2c95fd3 100644
--- a/hints/vmesa.sh
+++ b/hints/vmesa.sh
@@ -24,7 +24,7 @@ d_access='define'
 d_alarm='define'
 d_archlib='define'
 # randbits='15'
-archobjs="ebcdic.o vmesa.o"
+archobjs="vmesa.o"
 d_attribut='undef'
 d_bcmp='define'
 d_bcopy='define'
diff --git a/objXSUB.h b/objXSUB.h
index d1c2eee..5925567 100644
--- a/objXSUB.h
+++ b/objXSUB.h
@@ -2331,6 +2331,8 @@
 #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT)
 #  if defined(LEAKTEST)
 #  endif
+#  if defined(EBCDIC)
+#  endif
 #endif
 #if defined(PERL_OBJECT)
 #endif
diff --git a/perlapi.c b/perlapi.c
index 4cdb104..05e6c7a 100644
--- a/perlapi.c
+++ b/perlapi.c
@@ -4153,6 +4153,8 @@ Perl_sys_intern_init(pTHXo)
 #if defined(PERL_IN_UTIL_C) || defined(PERL_DECL_PROT)
 #  if defined(LEAKTEST)
 #  endif
+#  if defined(EBCDIC)
+#  endif
 #endif
 #if defined(PERL_OBJECT)
 #endif
diff --git a/proto.h b/proto.h
index 807fab1..f932454 100644
--- a/proto.h
+++ b/proto.h
@@ -1282,6 +1282,9 @@ STATIC SV*	S_mess_alloc(pTHX);
 #  if defined(LEAKTEST)
 STATIC void	S_xstat(pTHX_ int);
 #  endif
+#  if defined(EBCDIC)
+PERL_CALLCONV int	Perl_ebcdic_control(pTHX_ int ch);
+#  endif
 #endif
 
 #if defined(PERL_OBJECT)
diff --git a/util.c b/util.c
index 1fb9ef2..d603e82 100644
--- a/util.c
+++ b/util.c
@@ -3997,3 +3997,40 @@ Perl_report_evil_fh(pTHX_ GV *gv, IO *io, I32 op)
 			func, pars);
     }
 }
+
+#ifdef EBCDIC
+int
+Perl_ebcdic_control(pTHX_ int ch)
+{
+    	if (ch > 'a') {
+	        char *ctlp;
+ 
+ 	       if (islower(ch))
+  	              ch = toupper(ch);
+ 
+ 	       if ((ctlp = strchr(controllablechars, ch)) == 0) {
+  	              Perl_die(aTHX_ "unrecognised control character '%c'\n", ch);
+     	       }
+ 
+        	if (ctlp == controllablechars)
+         	       return('\177'); /* DEL */
+        	else
+         	       return((unsigned char)(ctlp - controllablechars - 1));
+	} else { /* Want uncontrol */
+        	if (ch == '\177' || ch == -1)
+                	return('?');
+        	else if (ch == '\157')
+                	return('\177');
+        	else if (ch == '\174')
+                	return('\000');
+        	else if (ch == '^')    /* '\137' in 1047, '\260' in 819 */
+                	return('\036');
+        	else if (ch == '\155')
+                	return('\037');
+        	else if (0 < ch && ch < (sizeof(controllablechars) - 1))
+                	return(controllablechars[ch+1]);
+        	else
+                	Perl_die(aTHX_ "invalid control request: '\\%03o'\n", ch & 0xFF);
+	}
+}
+#endif