This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
UNIVERSAL::can and UNIVERSAL::isa should return undef when
[perl5.git] / ebcdic.c
1 #include "EXTERN.h"
2 #define PERL_IN_EBCDIC_C
3 #include "perl.h"
4
5 /* in ASCII order, not that it matters */
6 static const char controllablechars[] = "?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_";
7  
8 int
9 ebcdic_control(int ch)
10 {
11         if (ch > 'a') {
12                 char *ctlp;
13  
14                if (islower(ch))
15                       ch = toupper(ch);
16  
17                if ((ctlp = strchr(controllablechars, ch)) == 0) {
18                       Perl_die(aTHX_ "unrecognised control character '%c'\n", ch);
19                }
20  
21                 if (ctlp == controllablechars)
22                        return('\177'); /* DEL */
23                 else
24                        return((unsigned char)(ctlp - controllablechars - 1));
25         } else { /* Want uncontrol */
26                 if (ch == '\177' || ch == -1)
27                         return('?');
28                 else if (ch == '\157')
29                         return('\177');
30                 else if (ch == '\174')
31                         return('\000');
32                 else if (ch == '^')    /* '\137' in 1047, '\260' in 819 */
33                         return('\036');
34                 else if (ch == '\155')
35                         return('\037');
36                 else if (0 < ch && ch < (sizeof(controllablechars) - 1))
37                         return(controllablechars[ch+1]);
38                 else
39                         Perl_die(aTHX_ "invalid control request: '\\%03o'\n", ch & 0xFF);
40         }
41 }