############################################################################
#
#	File:     ebcdic.icn
#
#	Subject:  Procedures to convert between ASCII and EBCDIC
#
#	Author:   Alan Beale
#
#	Date:     August 14, 1996
#
############################################################################
#
#   This file is in the public domain.
#
############################################################################
#
#     These procedures assist in use of the ASCII and EBCDIC character sets,
#     regardless of the native character set of the host:
#
#     Ascii128()    Returns a 128-byte string of ASCII characters in
#                   numerical order.  Ascii128() should be used in
#                   preference to &ascii for applications which might
#                   run on an EBCDIC host.
#
#     Ascii256()    Returns a 256-byte string representing the 256-
#                   character ASCII character set.  On an EBCDIC host,
#                   the order of the second 128 characters is essentially
#                   arbitrary.
#
#     Ebcdic()      Returns a 256-byte string of EBCDIC characters in
#                   numerical order.
#
#     AsciiChar(i)  Returns the character whose ASCII representation is i.
#
#     AsciiOrd(c)   Returns the position of the character c in the ASCII
#                   collating sequence.
#
#     EbcdicChar(i) Returns the character whose EBCDIC representation is i.
#
#     EbcdicOrd(c)  Returns the position of the character c in the EBCDIC
#                   collating sequence.
#
#     MapEtoA(s)    Maps a string of EBCDIC characters to the equivalent
#                   ASCII string, according to a plausible mapping.
#
#     MapAtoE(s)    Maps a string of ASCII characters to the equivalent
#                   EBCDIC string, according to a plausible mapping.
#
#     Control(c)    Returns the "control character" associated with the
#                   character c.  On an EBCDIC host, with $ representing
#                   an EBCDIC character with no 7-bit ASCII equivalent,
#                   Control("$") may not be identical to "\^$", as
#                   translated by ICONT (and neither result is particularly
#                   meaningful).
#
############################################################################
#
#   Notes:
#
#       There is no universally accepted mapping between ASCII and EBCDIC.
#       See the SHARE Inc. publication "ASCII and EBCDIC Character Set and
#       Code Issues in Systems Application Architecture" for more information
#       than you would ever want to have on this subject.
#
#       The mapping of the first 128 characters defined below by Ascii128()
#       is the most commonly accepted mapping, even though it probably
#       is not exactly like the mapping used by your favorite PC to mainframe
#       file transfer utility.  The mapping of the second 128 characters
#       is quite arbitrary, except that where an alternate translation of
#       ASCII char(n) is popular, this translation is assigned to
#       Ascii256()[n+129].
#
#       The behavior of all functions in this package is controlled solely
#       by the string literals in the _Eascii() procedure.  Therefore you
#       may modify these strings to taste, and still obtain consistent
#       results, provided that each character appears exactly once in the
#       result of _Eascii().
#
#       Yes, it's really true that the EBCDIC "\n" (NL, char(16r15)) is not
#       the same as "\l" (LF, char(16r25)).  How can that be?  "Don't blame
#       me, man, I didn't do it."
#
############################################################################

procedure _Eascii()
    static EinAorder
    initial
        EinAorder :=
#            NUL SOH STX ETX EOT ENQ ACK BEL BS  HT  NL  VT  FF  CR  SO  SI
           "\x00\x01\x02\x03\x37\x2d\x2e\x2f\x16\x05\x15\x0b\x0c\x0d\x0e\x0f"||
#            DLE DC1 DC2 DC3 DC4 NAK SYN ETB CAN EM  SUB ESC FS  GS  RS  US
           "\x10\x11\x12\x13\x3c\x3d\x32\x26\x18\x19\x3f\x27\x1c\x1d\x1e\x1f"||
#            sp  !   "   #   $   %   &   '   (   )   *   +   ,   -   .   /
           "\x40\x5a\x7f\x7b\x5b\x6c\x50\x7d\x4d\x5d\x5c\x4e\x6b\x60\x4b\x61"||
#            0   1   2   3   4   5   6   7   8   9   :   ;   <   =   >   ?
           "\xf0\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9\x7a\x5e\x4c\x7e\x6e\x6f"||
#            @   A   B   C   D   E   F   G   H   I   J   K   L   M   N   O
           "\x7c\xc1\xc2\xc3\xc4\xc5\xc6\xc7\xc8\xc9\xd1\xd2\xd3\xd4\xd5\xd6"||
#            P   Q   R   S   T   U   V   W   X   Y   Z   $<  \   $>  ^   _
           "\xd7\xd8\xd9\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\xad\xe0\xbd\x5f\x6d"||
#            `   a   b   c   d   e   f   g   h   i   j   k   l   m   n   o
           "\x79\x81\x82\x83\x84\x85\x86\x87\x88\x89\x91\x92\x93\x94\x95\x96"||
#            p   q   r   s   t   u   v   w   x   y   z   $(  |   $)  ~   DEL
           "\x97\x98\x99\xa2\xa3\xa4\xa5\xa6\xa7\xa8\xa9\xc0\x4f\xd0\xa1\x07"||
           "\x04\x06\x08\x09\x0a\x14\x17\x1a\x1b\x20\x25\x21\x22\x23\x24\x28_
            \x29\x2a\x2b\x2c\x30\x31\x33\x34\x35\x36\x38\x39\x3a\x3b\x3e\xff_
            \x41\x42\x43\x44\x4a\x45\x46\x47\x48\x49\x51\x52\x53\x54\x55\x56_
            \x57\x58\x59\x62\x63\x64\x65\x66\x67\x68\x69\x70\x71\x72\x73\x74_
            \x75\x76\x77\x78\x80\x8a\x8c\x8d\x8e\x8f\x90\x9a\x9c\x9d\x9e\x9f_
            \xa0\xaa\xab\xac\xae\xaf\xb0\xb1\xb2\xb3\xb4\xb5\xb6\xb7\xb8\xb9_
            \xba\xbb\xbc\xbe\xbf\xca\xcb\xcc\xcd\xce\xcf\xda\xdb\xdc\xdd\xde_
            \xdf\xe1\xea\xeb\xec\xed\xee\xef\xfa\xfb\xfc\x8b\x6a\x9b\xfd\xfe"
    return EinAorder
end

procedure Ascii128()
    if "\l" == "\n" then return string(&ascii)
    return _Eascii()[1+:128]
end

procedure Ascii256()
    if "\l" == "\n" then return string(&cset)
    return _Eascii()
end

procedure Ebcdic()
    if "\l" ~== "\n" then return &cset
    return map(&cset, _Eascii(), &cset)
end

procedure AsciiChar(i)
    if "\l" == "\n" then return char(i)
    return _Eascii()[0 < i+1] | runerr(205,i)
end

procedure AsciiOrd(c)
    if "\l" == "\n" then return ord(c)
    return ord(MapEtoA(c))
end

procedure EbcdicChar(i)
    if "\l" ~== "\n" then return char(i)
    return map(char(i), _Eascii(), &cset)
end

procedure EbcdicOrd(c)
    if "\l" ~== "\n" then return ord(c)
    return ord(MapAtoE(c))
end

procedure MapEtoA(s)
    return map(s, _Eascii(), &cset)
end

procedure MapAtoE(s)
    return map(s, &cset, _Eascii())
end

procedure Control(c)
    return AsciiChar(iand(AsciiOrd(c),16r1f))
end