MODULE HostLang;

  IMPORT S := SYSTEM, Kernel, stdlib := C99stdlib, locale := C99locale,
    iconv := C99iconv, errno := C99errno, macro := C99macro;

  CONST
    maxLen = 32;

    (* modes *)
    replace* = 0; pep383x* = 1; pep383* = 2;

  VAR
    lang-, country-, encoding-: ARRAY maxLen OF CHAR;
    c2sc, sc2c, invalid: iconv.iconv_t;

  PROCEDURE StringToHost* (IN in: ARRAY OF CHAR; OUT out: ARRAY OF SHORTCHAR; mode: INTEGER; OUT res: INTEGER);
    VAR i, j, err: INTEGER; maxlen, len, count: iconv.size_t; inadr, outadr: Kernel.ADDRESS; sch: SHORTCHAR;
  BEGIN
    ASSERT(mode IN {replace..pep383}, 20);
    ASSERT(c2sc # invalid, 100);
    i := 0; err := 0;
    outadr := S.ADR(out[0]);
    maxlen := LEN(out) - 1;
    WHILE (err = 0) & (in[i] # 0X) DO
      j := i;
      WHILE (in[i] # 0X) & ((in[i] < 0D800X) OR (in[i] > 0D8FFX)) DO INC(i) END;
      len := (i - j) * 2;
      WHILE (err = 0) & (len > 0) & (maxlen > 0) DO
        inadr := S.ADR(in[j]);
        count := iconv.iconv(c2sc, inadr, len, outadr, maxlen);
        IF count # 0 THEN
          CASE macro.errno() OF
          | errno.EILSEQ:
               IF mode = replace THEN
                 IF maxlen < 1 THEN
                   err := 1
                 ELSE
                   sch := "?";
                   S.PUT(outadr, sch); INC(outadr); DEC(maxlen);
                   INC(j); DEC(len, 2)
                 END
               ELSE
                 err := 3
               END;
          | errno.E2BIG: err := 1 (* unexpected end of out *)
          | errno.EINVAL: HALT(101) (* unexpected end of input *)
          | errno.EBADF: HALT(102) (* invalid iconv descriptor *)
          ELSE HALT(103) (* unknown error *)
          END
        END
      END;
      WHILE (err = 0) & (in[i] >= 0D800X) & (in[i] <= 0D8FFX) DO
        IF maxlen < 1 THEN
          err := 1
        ELSE
          sch := SHORT(CHR(ORD(in[i]) MOD 256));
          IF (mode IN {replace, pep383x}) OR (sch > 7FX) THEN
            S.PUT(outadr, sch); INC(outadr); DEC(maxlen);
            INC(i)
          ELSE
            err := 3
          END
        END
      END
    END;
    sch := 0X;
    S.PUT(outadr, sch);
    res := err
  END StringToHost;

  PROCEDURE HostToString* (IN in: ARRAY OF SHORTCHAR; OUT out: ARRAY OF CHAR; mode: INTEGER; OUT res: INTEGER);
    VAR err: INTEGER; maxin, maxout, count: iconv.size_t; inadr, outadr: Kernel.ADDRESS; sch: SHORTCHAR; ch: CHAR;
  BEGIN
    ASSERT(mode IN {replace..pep383}, 20);
    ASSERT(sc2c # invalid, 100);
    err := 0;
    inadr := S.ADR(in[0]);
    outadr := S.ADR(out[0]);
    maxin := LEN(in$); maxout := LEN(out) * 2 - 2;
    WHILE (err = 0) & (maxout > 1) & (maxin > 0) DO
      count := iconv.iconv(sc2c, inadr, maxin, outadr, maxout);
      IF count # 0 THEN
        CASE macro.errno() OF
        | errno.EILSEQ, errno.EINVAL, errno.E2BIG:
            IF maxout < 2 THEN
              err := 1 (* unexpected end of output buffer *)
            ELSIF maxin < 1 THEN
              err := 2 (* unexpected end of input buffer *)
            ELSE
              IF mode = replace THEN
                sch := "?"; ch := "?"; INC(inadr); DEC(maxin);
              ELSE
                S.GET(inadr, sch); INC(inadr); DEC(maxin);
                ch := CHR(0D800H + ORD(sch));
              END;
              IF (mode IN {replace, pep383x}) OR (sch > 7FX) THEN
                S.PUT(outadr, ch); INC(outadr, 2); DEC(maxout, 2)
              ELSE
                err := 3 (* invalid char *)
              END
            END
        | errno.EBADF: HALT(101)
        ELSE HALT(102)
        END
      END
    END;
    ch := 0X;
    S.PUT(outadr, ch);
    res := err
  END HostToString;

  PROCEDURE Init;
    VAR p: POINTER TO ARRAY [untagged] OF SHORTCHAR; i, j: INTEGER; enc: ARRAY 32 OF SHORTCHAR;
  BEGIN
    invalid := S.VAL(iconv.iconv_t, -1);
    p := locale.setlocale(locale.LC_ALL, "");
    IF p = NIL THEN
      p := stdlib.getenv("LANG");
      IF p = NIL THEN
        p := ""
      END
    END;
    i := 0; j := 0;
    WHILE (p[i] # 0X) & (p[i] # "_") & (p[i] # ".") DO
      lang[j] := p[i];
      INC(i); INC(j)
    END;
    lang[j] := 0X;
    IF p[i] = "_" THEN
      INC(i); j := 0;
      WHILE (p[i] # 0X) & (p[i] # ".") DO
        country[j] := p[i];
        INC(i); INC(j)
      END;
      country[j] := 0X
    END;
    enc := "ASCII";
    IF p[i] = "." THEN
      INC(i); j := 0;
      WHILE p[i] # 0X DO
        enc[j] := p[i];
        INC(i); INC(j)
      END;
      enc[j] := 0X
    END;
    IF (lang = "C") OR (lang = "POSIX") THEN
      lang := ""
    END;
    sc2c := invalid; c2sc := invalid;
    IF Kernel.littleEndian THEN sc2c := iconv.iconv_open("UCS-2LE", enc)
    ELSE sc2c := iconv.iconv_open("UCS-2BE", enc)
    END;
    IF sc2c = invalid THEN enc := "ASCII";
      IF Kernel.littleEndian THEN sc2c := iconv.iconv_open("UCS-2LE", enc)
      ELSE sc2c := iconv.iconv_open("UCS-2BE", enc)
      END;
      ASSERT(c2sc # invalid, 100) (* ascii to ucs2 not supported? *)
    END;
    IF Kernel.littleEndian THEN c2sc := iconv.iconv_open(enc, "UCS-2LE")
    ELSE c2sc := iconv.iconv_open(enc, "UCS-2BE");
    END;
    ASSERT(c2sc # invalid, 101); (* ucs2 to ascii not supported? *)
    encoding := enc$
  END Init;

  (**
    Do not close iconv descriptors!
    It can lead to quiet traps on program termination and bugs like
    not removed temp files.
  **)

BEGIN
  Init
END HostLang.