diff options
| -rw-r--r-- | MANIFEST | 1 | ||||
| -rw-r--r-- | ebcdic.c | 41 | ||||
| -rw-r--r-- | embed.h | 10 | ||||
| -rwxr-xr-x | embed.pl | 3 | ||||
| -rw-r--r-- | handy.h | 1 | ||||
| -rw-r--r-- | hints/os390.sh | 8 | ||||
| -rw-r--r-- | hints/posix-bc.sh | 7 | ||||
| -rw-r--r-- | hints/vmesa.sh | 2 | ||||
| -rw-r--r-- | objXSUB.h | 2 | ||||
| -rw-r--r-- | perlapi.c | 2 | ||||
| -rw-r--r-- | proto.h | 3 | ||||
| -rw-r--r-- | util.c | 37 |
12 files changed, 58 insertions, 59 deletions
@@ -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 d86d50bd32..0000000000 --- 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); - } -} @@ -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 @@ -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) @@ -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 54787e8d9a..6f4f39b0e6 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 5c45832534..6275233992 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 81ab6a4f44..2c95fd353f 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' @@ -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 @@ -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 @@ -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) @@ -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 |