/* REXX
 |
 | Name: Bit2Char
 |
 | Author: David Alcock
 |         dalcock@csw.com
 |
 | Purpose: Given a binary string, show the hex and characters that
 |          it represents.
 |
 |          When issued on ASCII machines like OS/2 and MSDOS,
 |          the characters will also be shown in EBCDIC.
 |
 | Sample Invocation: "BIT2CHAR 1101011011010010"
 |
 |                    Results in the output (on MVS/TSO):
 |
 |                      Char: OK
 |                      Hex:  D6D2
 |                      Bit:  1101011011010010
 */
 
arg bstr 
if bstr == "" then bstr = "1101011011010010" /* Default: OK */
 
/* Note: I do not check to ensure that binary strings are full
         8 byte multiples!!!!! */
bstrn = length(bstr) / 8
loc = 1
xstr = ""
do i = 1 to bstrn
   xstr = xstr||b2x(substr(bstr,loc,8)) /* Turn 8 bits into 2 byte hex */
   loc = loc + 8
   end
nchar = x2c(xstr) /* Convert hex string to Native character */
 
/*
 |  ISO 8859-1 to CECP 1047 (Extended de-facto EBCDIC):
 */
 
toEBCDIC =           '00010203372D2E2F1605250B0C0D0E0F'x  /* 00 */
toEBCDIC = toEBCDIC||'101112133C3D322618193F271C1D1E1F'x  /* 10 */
toEBCDIC = toEBCDIC||'405A7F7B5B6C507D4D5D5C4E6B604B61'x  /* 20 */
toEBCDIC = toEBCDIC||'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F'x  /* 30 */
toEBCDIC = toEBCDIC||'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6'x  /* 40 */
toEBCDIC = toEBCDIC||'D7D8D9E2E3E4E5E6E7E8E9ADE0BD5F6D'x  /* 50 */
toEBCDIC = toEBCDIC||'79818283848586878889919293949596'x  /* 60 */
toEBCDIC = toEBCDIC||'979899A2A3A4A5A6A7A8A9C04FD0A107'x  /* 70 */
toEBCDIC = toEBCDIC||'202122232415061728292A2B2C090A1B'x  /* 80 */
toEBCDIC = toEBCDIC||'30311A333435360838393A3B04143EFF'x  /* 90 */
toEBCDIC = toEBCDIC||'41AA4AB19FB26AB5BBB49A8AB0CAAFBC'x  /* A0 */
toEBCDIC = toEBCDIC||'908FEAFABEA0B6B39DDA9B8BB7B8B9AB'x  /* B0 */
toEBCDIC = toEBCDIC||'6465626663679E687471727378757677'x  /* C0 */
toEBCDIC = toEBCDIC||'AC69EDEEEBEFECBF80FDFEFBFCBAAE59'x  /* D0 */
toEBCDIC = toEBCDIC||'4445424643479C485451525358555657'x  /* E0 */
toEBCDIC = toEBCDIC||'8C49CDCECBCFCCE170DDDEDBDC8D8EDF'x  /* F0 */
 
/*
 | CECP 1047 (Extended de-facto EBCDIC) to ISO 8859-1:
 */
 
toASCII =          '000102039C09867F978D8E0B0C0D0E0F'x  /* 00 */
toASCII = toASCII||'101112139D8508871819928F1C1D1E1F'x  /* 10 */
toASCII = toASCII||'80818283840A171B88898A8B8C050607'x  /* 20 */
toASCII = toASCII||'909116939495960498999A9B14159E1A'x  /* 30 */
toASCII = toASCII||'20A0E2E4E0E1E3E5E7F1A22E3C282B7C'x  /* 40 */
toASCII = toASCII||'26E9EAEBE8EDEEEFECDF21242A293B5E'x  /* 50 */
toASCII = toASCII||'2D2FC2C4C0C1C3C5C7D1A62C255F3E3F'x  /* 60 */
toASCII = toASCII||'F8C9CACBC8CDCECFCC603A2340273D22'x  /* 70 */
toASCII = toASCII||'D8616263646566676869ABBBF0FDFEB1'x  /* 80 */
toASCII = toASCII||'B06A6B6C6D6E6F707172AABAE6B8C6A4'x  /* 90 */
toASCII = toASCII||'B57E737475767778797AA1BFD05BDEAE'x  /* A0 */
toASCII = toASCII||'ACA3A5B7A9A7B6BCBDBEDDA8AF5DB4D7'x  /* B0 */
toASCII = toASCII||'7B414243444546474849ADF4F6F2F3F5'x  /* C0 */
toASCII = toASCII||'7D4A4B4C4D4E4F505152B9FBFCF9FAFF'x  /* D0 */
toASCII = toASCII||'5CF7535455565758595AB2D4D6D2D3D5'x  /* E0 */
toASCII = toASCII||'30313233343536373839B3DBDCD9DA9F'x  /* F0 */
 
/*
 | Hex table to aid in translating all 8-bit characters
 */
 
hextable =             '000102030405060708090A0B0C0D0E0F'x   /* 00 */
hextable = hextable || '101112131415161718191A1B1C1D1E1F'x   /* 10 */
hextable = hextable || '202122232425262728292A2B2C2D2E2F'x   /* 20 */
hextable = hextable || '303132333435363738393A3B3C3D3E3F'x   /* 30 */
hextable = hextable || '404142434445464748494A4B4C4D4E4F'x   /* 40 */
hextable = hextable || '505152535455565758595A5B5C5D5E5F'x   /* 50 */
hextable = hextable || '606162636465666768696A6B6C6D6E6F'x   /* 60 */
hextable = hextable || '707172737475767778797A7B7C7D7E7F'x   /* 70 */
hextable = hextable || '808182838485868788898A8B8C8D8E8F'x   /* 80 */
hextable = hextable || '909192939495969798999A9B9C9D9E9F'x   /* 90 */
hextable = hextable || 'A0A1A2A3A4A5A6A7A8A9AAABACADAEAF'x   /* A0 */
hextable = hextable || 'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF'x   /* B0 */
hextable = hextable || 'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF'x   /* C0 */
hextable = hextable || 'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF'x   /* D0 */
hextable = hextable || 'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF'x   /* E0 */
hextable = hextable || 'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF'x   /* F0 */
 
mtype = address()
select
  when mtype == "CMD"     then call show_ebcdic /* OS/2 & OREXX */
  when mtype == "COMMAND" then call show_ebcdic /* MSDOS? */
  when mtype == "TSO"     then call show_ascii  /* MVS/TSO */
  when mtype == "CMS"     then call show_ascii  /* VM/CMS */
  otherwise
       say "Char:" nchar
       say "Hex: " xstr
       say "Bit: " bstr
end /* of "select" */
 
exit
 
show_ebcdic:
say "Char:" nchar "(ASCII)"
say "Hex: " xstr
say "Bit: " bstr
say " "
say "CECP 1047 code page (Extended de-facto EBCDIC)" ,
    "character translation:"
say "> "translate(x2c(xstr),hextable,toEBCDIC)
return
 
show_ascii:
say "Char:" nchar "(EBCDIC)"
say "Hex: " xstr
say "Bit: " bstr
say " "
say "ISO 8859-1 code page (ASCII) character translation:"
say "> "translate(x2c(xstr),hextable,toASCII)
return