OberonCore

Библиотека  Wiki  Форум  BlackBox  Компоненты  Проекты
Текущее время: Четверг, 28 Март, 2024 18:27

Часовой пояс: UTC + 3 часа




Форум закрыт Эта тема закрыта, вы не можете редактировать и оставлять сообщения в ней.  [ Сообщений: 46 ]  На страницу Пред.  1, 2, 3  След.
Автор Сообщение
СообщениеДобавлено: Пятница, 26 Октябрь, 2012 04:25 

Зарегистрирован: Суббота, 26 Ноябрь, 2005 02:12
Сообщения: 473
Откуда: KZ
Евгений Темиргалеев писал(а):
1) Александр, запишите постусловие для state (как-то не очень сочетаются OUT state: BOOLEAN и d.st := -1; RETURN из середины (не зря Вирт это дело в О-7 убрал))


Записано в EncCodecs.
Код:
post:
  fLen = 0: ok (не ошибка),
    state: декодер в состоянии ожидания продолжения незаконченной последовательности
  fLen > 0: ошибка при обработке символа f[fR]
    state: не определено


Если убрать RETURN, то надо вставлять 3 проверки: в условии WHILE, после CASE, после WHILE.

Цитата:
2) Что выдает Ваш декодер для C0H 80H ? (см. http://www.ietf.org/rfc/rfc3629.txt, 10 Security Considerations)


Ошибки исправил.
Код:
PROCEDURE (d: Decoder) Decode (IN f: ARRAY OF SHORTCHAR; VAR fR, fLen: INTEGER; VAR t: ARRAY OF CHAR; VAR tW: INTEGER; OUT state: BOOLEAN);
   VAR x: INTEGER;
BEGIN
   WHILE fLen > 0 DO
      x := ORD(f[fR]);

(* http://www.lemoda.net/c/utf8-to-ucs2/index.html *)
(* http://tools.ietf.org/html/rfc3629 *)
      CASE d.st OF 0:
         CASE x OF 0..127:
            t[tW] := CHR(x); INC(tW)
         | 194 (* !!! *)..223:
            d.b := x MOD 32;
            d.st := 1
         | 224..239:
            d.b := x MOD 16;
            d.st := 2
         ELSE (* unexpected shortchar *)
            d.st := -1;
            RETURN
         END
      | 1:
         CASE x OF 128..191:
            t[tW] := CHR(d.b * 64 + x MOD 64); INC(tW);
            d.st := 0
         ELSE (* unexpected shortchar *)
            d.st := -1;
            RETURN
         END
      | 2:
         CASE x OF 128..159:
            IF d.b = 0 THEN (* !!! *) (* unexpected shortchar *)
               d.st := -1;
               RETURN
            ELSE
               d.b := d.b * 64 + x MOD 64;
               d.st := 1
            END
         | 160..191:
            d.b := d.b * 64 + x MOD 64;
            d.st := 1
         ELSE (* unexpected shortchar *)
            d.st := -1;
            RETURN
         END
      END;

      INC(fR); DEC(fLen)
   END;

   CASE d.st OF 0: state := FALSE
   | 1,2: state := TRUE
   END
END Decode;


Тесты:
Код:
MODULE TestEnc3;

   (* Test UTF-8 encoder/decoder *)

   IMPORT Codecs := EncCodecs, EncStdCodecs, Log;

   (* encode and decode all possible characters *)
   PROCEDURE Do1*;
      VAR s: ARRAY 65536 OF CHAR;
         ss: ARRAY 65536 * 3 OF SHORTCHAR;
         i: INTEGER;
         fR, fLen, tW: INTEGER;
         st: BOOLEAN;
         e: Codecs.Encoder;
         d: Codecs.Decoder;
   BEGIN
      i := 0; WHILE i < 65536 DO s[i] := CHR(i); INC(i) END;

      e := Codecs.dir.NewEncoder("UTF-8");
      ASSERT(e # NIL, 100);
      d := Codecs.dir.NewDecoder("UTF-8");
      ASSERT(e # NIL, 101);

      fR := 0; fLen := 65536; tW := 0;
      e.Encode(s, fR, fLen, ss, tW);
      ASSERT(fLen = 0, 102);
      Log.Int(tW); Log.Ln;

      i := 0; WHILE i < 65536 DO s[i] := 0X; INC(i) END;

      fR := 0; fLen := tW; tW := 0;
      d.Decode(ss, fR, fLen, s, tW, st);
      ASSERT(fLen = 0, 103);
      ASSERT(~st, 104);
      ASSERT(tW = 65536, 105);

      i := 0; WHILE i < 65536 DO ASSERT(s[i] = CHR(i), 106); INC(i) END
   END Do1;

   (* decode and encode all possible 2 B and 3 B shortchar sequences *)
   PROCEDURE Do2*;
      VAR s: ARRAY 1 OF CHAR;
         ss, ss1: ARRAY 3 OF SHORTCHAR;
         i: INTEGER;
         fR, fLen, tW: INTEGER;
         st: BOOLEAN;
         e: Codecs.Encoder;
         d: Codecs.Decoder;
         c0, c1, c2: INTEGER;
   BEGIN
      e := Codecs.dir.NewEncoder("UTF-8");
      ASSERT(e # NIL, 100);
      d := Codecs.dir.NewDecoder("UTF-8");
      ASSERT(e # NIL, 101);

      (* check 2 B sequences *)
      i := 0;
      WHILE i < 65536 DO
         IF i MOD 256 > 127 THEN
            ss[0] := SHORT(CHR(i MOD 256));
            ss[1] := SHORT(CHR(i DIV 256));
            d.Reset;
            fR := 0; fLen := 2; tW := 0;
            d.Decode(ss, fR, fLen, s, tW, st);
            IF (fLen = 0) & ~st THEN
               ASSERT(tW = 1, 102);
               fR := 0; fLen := 1; tW := 0;
               e.Encode(s, fR, fLen, ss1, tW);
               ASSERT(fLen = 0, 103);
               ASSERT(tW = 2, 104);
               ASSERT(ORD(ss1[0]) + 256 * ORD(ss1[1]) = i, 105)
            END
         END;
         INC(i)
      END;

      (* check 3 B sequences *)
      i := 0;
      WHILE i < 1000000H DO
         c0 := i MOD 256;
         c1 := i DIV 256 MOD 256;
         c2 := i DIV 65536;
         IF (c0 > 127) & (c1 > 127) & (c2 > 127) THEN
            ss[0] := SHORT(CHR(c0));
            ss[1] := SHORT(CHR(c1));
            ss[2] := SHORT(CHR(c2));
            d.Reset;
            fR := 0; fLen := 3; tW := 0;
            d.Decode(ss, fR, fLen, s, tW, st);
            IF (fLen = 0) & ~st THEN
               ASSERT(tW = 1, 106);
               fR := 0; fLen := 1; tW := 0;
               e.Encode(s, fR, fLen, ss1, tW);
               ASSERT(fLen = 0, 107);
               ASSERT(tW = 3, 108);
               ASSERT(ORD(ss1[0]) + 256 * ORD(ss1[1]) + 65536 * ORD(ss1[2]) = i, 109)
            END
         END;
         INC(i)
      END;
   END Do2;

   (* http://tools.ietf.org/html/rfc3629, section 7 *)
   PROCEDURE Do3*;
      VAR s: ARRAY 100 OF CHAR;
         ss: ARRAY 100 OF SHORTCHAR;
         e: Codecs.Encoder;
         d: Codecs.Decoder;

      PROCEDURE T (IN s: ARRAY OF CHAR; sLen: INTEGER; IN ss: ARRAY OF SHORTCHAR; ssLen: INTEGER);
         VAR s1: ARRAY 100 OF CHAR;
            ss1: ARRAY 100 OF SHORTCHAR;
            i: INTEGER;
            fR, fLen, tW: INTEGER;
            st: BOOLEAN;
      BEGIN
         fR := 0; fLen := sLen; tW := 0;
         e.Encode(s, fR, fLen, ss1, tW);
         ASSERT(fLen = 0, 102);
         ASSERT(tW = ssLen, 103);
         i := 0; WHILE i < tW DO ASSERT(ss[i] = ss1[i], 104); INC(i) END;

         fR := 0; fLen := ssLen; tW := 0;
         d.Decode(ss, fR, fLen, s1, tW, st);
         ASSERT(fLen = 0, 105);
         ASSERT(~st, 106);
         ASSERT(tW = sLen, 107);
         i := 0; WHILE i < tW DO ASSERT(s[i] = s1[i], 108); INC(i) END
      END T;
      
   BEGIN
      e := Codecs.dir.NewEncoder("UTF-8");
      ASSERT(e # NIL, 100);
      d := Codecs.dir.NewDecoder("UTF-8");
      ASSERT(e # NIL, 101);

      s[0] := 0041X; s[1] := 2262X; s[2] := 0391X; s[3] := 002EX;
      ss[0] := 41X; ss[1] := 0E2X; ss[2] := 89X; ss[3] := 0A2X; ss[4] := 0CEX; ss[5] := 91X; ss[6] := 2EX;
      T(s, 4, ss, 7);

      s[0] := 0D55CX; s[1] := 0AD6DX; s[2] := 0C5B4X;
      ss[0] := 0EDX; ss[1] := 95X; ss[2] := 9CX; ss[3] := 0EAX; ss[4] := 0B5X; ss[5] := 0ADX; ss[6] := 0ECX; ss[7] := 96X; ss[8] := 0B4X;
      T(s, 3, ss, 9);

      s[0] := 65E5X; s[1] := 672CX; s[2] := 8A9EX;
      ss[0] := 0E6X; ss[1] := 97X; ss[2] := 0A5X; ss[3] := 0E6X; ss[4] := 9CX; ss[5] := 0ACX; ss[6] := 0E8X; ss[7] := 0AAX; ss[8] := 9EX;
      T(s, 3, ss, 9)
   END Do3;

END TestEnc3.

(!)TestEnc3.Do1
(!)TestEnc3.Do2
(!)TestEnc3.Do3


Цитата:
3) Проверки через SET эффективнее, чем арифметические (хотя преобразования могут выглядеть громоздко).
BITS(x) * {6, 7} = {7} --> MOV reg, x ; AND reg, 192 ; CMP reg, 128 ; усл. переход
(x >= 128) & (x < 192) --> MOV reg, x ; CMP x, 128 ; усл. переход1 ; CMP x, 192 ; усл. переход 2


Верно.

Цитата:
И всякие x MOD 32 в идеале надо писать тоже через SET. Потому что set * по определению есть AND, а для MOD 2^n это хотя и ожидаемая, но оптимизация. Аналогично x * 2^n и x DIV 2^n в идеале писать через ASH.


DIV/MOD 2^n оптимизирует любой нормальный компилятор. DIV/MOD нагляднее.


Ещё улучшил генератор EncStdMaps.
Пример:
Код:
MODULE EncStdMap_cp1251;

   (* This file was generated automatically *)

   (* Source: http://www.unicode.org/Public/MAPPINGS/VENDORS/MICSFT/WINDOWS/CP1251.TXT *)

   IMPORT Codecs := EncCodecs;

   TYPE
      Encoder = POINTER TO RECORD (Codecs.Encoder) END;
      Decoder = POINTER TO RECORD (Codecs.Decoder) END;

   (* Encoder *)

   PROCEDURE (e: Encoder) Encode (IN f: ARRAY OF CHAR; VAR fR, fLen: INTEGER; VAR t: ARRAY OF SHORTCHAR; VAR tW: INTEGER);
      VAR x, y: INTEGER;
   BEGIN
      WHILE fLen > 0 DO
         x := ORD(f[fR]);
         CASE x OF
         | 00H..7FH,0A0H,0A4H,0A6H,0A7H,0A9H,0ABH..0AEH,0B0H,0B1H,0B5H..0B7H,0BBH: y := x
         | 0409H,040CH: y := -037FH + x
         | 040AH: y := 8CH
         | 040BH: y := 8EH
         | 040EH: y := 0A1H
         | 0490H: y := 0A5H
         | 0408H: y := 0A3H
         | 0410H..044FH: y := -0350H + x
         | 0491H: y := 0B4H
         | 0404H: y := 0AAH
         | 0401H: y := 0A8H
         | 0407H: y := 0AFH
         | 0406H: y := 0B2H
         | 0453H: y := 83H
         | 0405H: y := 0BDH
         | 0452H: y := 90H
         | 045FH: y := 9FH
         | 0459H,045CH: y := -03BFH + x
         | 045AH: y := 9CH
         | 045BH: y := 9EH
         | 045EH: y := 0A2H
         | 2122H: y := 99H
         | 2039H: y := 8BH
         | 2116H: y := 0B9H
         | 2030H: y := 89H
         | 20ACH: y := 88H
         | 0456H: y := 0B3H
         | 2026H: y := 85H
         | 203AH: y := 9BH
         | 0458H: y := 0BCH
         | 201EH,2020H,2021H: y := -1F9AH + x
         | 0454H: y := 0BAH
         | 0451H: y := 0B8H
         | 0457H: y := 0BFH
         | 0455H: y := 0BEH
         | 040FH: y := 8FH
         | 2013H,2014H: y := -1F7DH + x
         | 201AH: y := 82H
         | 2022H: y := 95H
         | 201CH,201DH: y := -1F89H + x
         | 2018H,2019H: y := -1F87H + x
         | 0402H,0403H: y := -0382H + x
         ELSE
            RETURN
         END;
         t[tW] := SHORT(CHR(y)); INC(tW);
         INC(fR); DEC(fLen)
      END
   END Encode;

   PROCEDURE NewEncoder* (): Codecs.Encoder;
      VAR e: Encoder;
   BEGIN
      NEW(e); RETURN e
   END NewEncoder;

   (* Decoder *)

   PROCEDURE (d: Decoder) Decode (IN f: ARRAY OF SHORTCHAR; VAR fR, fLen: INTEGER; VAR t: ARRAY OF CHAR; VAR tW: INTEGER; OUT state: BOOLEAN);
      VAR x, y: INTEGER;
   BEGIN
      WHILE fLen > 0 DO
         x := ORD(f[fR]);
         CASE x OF
         | 00H..7FH,0A0H,0A4H,0A6H,0A7H,0A9H,0ABH..0AEH,0B0H,0B1H,0B5H..0B7H,0BBH: y := x
         | 8FH: y := 040FH
         | 80H,81H: y := 0382H + x
         | 91H,92H: y := 1F87H + x
         | 93H,94H: y := 1F89H + x
         | 95H: y := 2022H
         | 0BFH: y := 0457H
         | 0BEH: y := 0455H
         | 82H: y := 201AH
         | 0B8H: y := 0451H
         | 84H,86H,87H: y := 1F9AH + x
         | 0BCH: y := 0458H
         | 0BAH: y := 0454H
         | 9BH: y := 203AH
         | 85H: y := 2026H
         | 0B3H: y := 0456H
         | 88H: y := 20ACH
         | 89H: y := 2030H
         | 8BH: y := 2039H
         | 0B9H: y := 2116H
         | 99H: y := 2122H
         | 0A2H: y := 045EH
         | 9EH: y := 045BH
         | 9CH: y := 045AH
         | 9AH,9DH: y := 03BFH + x
         | 9FH: y := 045FH
         | 90H: y := 0452H
         | 0BDH: y := 0405H
         | 83H: y := 0453H
         | 0B2H: y := 0406H
         | 0AFH: y := 0407H
         | 0A8H: y := 0401H
         | 0AAH: y := 0404H
         | 0B4H: y := 0491H
         | 0C0H..0FFH: y := 0350H + x
         | 0A3H: y := 0408H
         | 0A5H: y := 0490H
         | 0A1H: y := 040EH
         | 8EH: y := 040BH
         | 96H,97H: y := 1F7DH + x
         | 8CH: y := 040AH
         | 8AH,8DH: y := 037FH + x
         ELSE
            RETURN
         END;
         t[tW] := CHR(y); INC(tW);
         INC(fR); DEC(fLen)
      END;
      state := FALSE
   END Decode;

   PROCEDURE (d: Decoder) Reset, EMPTY;

   PROCEDURE NewDecoder* (): Codecs.Decoder;
      VAR d: Decoder;
   BEGIN
      NEW(d); RETURN d
   END NewDecoder;

END EncStdMap_cp1251.


Вернуться к началу
 Профиль  
 
СообщениеДобавлено: Пятница, 26 Октябрь, 2012 10:39 
Модератор
Аватара пользователя

Зарегистрирован: Среда, 16 Ноябрь, 2005 00:53
Сообщения: 4625
Откуда: Россия, Орёл
Alexander Shiryaev писал(а):
Цитата:
И всякие x MOD 32 в идеале надо писать тоже через SET. Потому что set * по определению есть AND, а для MOD 2^n это хотя и ожидаемая, но оптимизация. Аналогично x * 2^n и x DIV 2^n в идеале писать через ASH.


DIV/MOD 2^n оптимизирует любой нормальный компилятор. DIV/MOD нагляднее.
В идеале. Наглядность наглядностью, но если уж алгоритм вылизывается, лучше чтобы он был как можно точнее записан (отображался точно). Потому что даже в таких простых оптимизациях и нормальных компиляторах имеются траблы.


Вернуться к началу
 Профиль  
 
СообщениеДобавлено: Суббота, 27 Октябрь, 2012 04:11 

Зарегистрирован: Суббота, 26 Ноябрь, 2005 02:12
Сообщения: 473
Откуда: KZ
Реализовал Dialog.LanguageHook на основе переменной окружения LANG (в модуле HostLang):
Код:
MODULE HostLang;

   (*
      LANG environment variable support
      Dialog.LanguageHook implementation
   *)

   IMPORT Dialog, Libc := LinLibc, Codecs := EncCodecs;

   CONST
      defLang = "";
      defCountry = "";
      defEnc = "ASCII";

   TYPE
      LanguageHook = POINTER TO RECORD (Dialog.LanguageHook) END;

   VAR
      lang-: Dialog.Language;
      enc-: Codecs.Encoding;

   PROCEDURE ParseLang (OUT lang, country, enc: ARRAY OF CHAR);
      VAR env: Libc.PtrSTR;
         i, j: INTEGER;

      PROCEDURE Default;
      BEGIN
         lang := defLang;
         country := defCountry;
         enc := defEnc
      END Default;

      PROCEDURE IsValidEncChar (x: SHORTCHAR): BOOLEAN;
      BEGIN
         RETURN ((x >= 'A') & (x <= 'Z')) OR ((x >= '0') & (x <= '9')) OR (x = '-') OR (x = '_')
            OR ((x >= 'a') & (x <= 'z'))
      END IsValidEncChar;

   BEGIN
      env := Libc.getenv("LANG");
      IF env # NIL THEN
         IF env$ = "C" THEN
            lang := ""; country := ""; enc := "ASCII"
         ELSE
            i := 0;
            WHILE (i < 2) & (env[i] >= 'a') & (env[i] <= 'z') & (i < LEN(lang) - 1) DO
               lang[i] := env[i];
               INC(i)
            END;
            IF (i = 2) & (env[i] = '_') & (i < LEN(lang)) THEN
               lang[i] := 0X;
               INC(i);
               j := 0;
               WHILE (i < 5) & (env[i] >= 'A') & (env[i] <= 'Z') & (j < LEN(country) - 1) DO
                  country[j] := env[i];
                  INC(j); INC(i)
               END;
               IF (i = 5) & (env[i] = '.') & (j < LEN(country)) THEN
                  country[j] := 0X;
                  INC(i);
                  j := 0;
                  WHILE IsValidEncChar(env[i]) & (j < LEN(enc) - 1) DO
                     enc[j] := env[i];
                     INC(j); INC(i)
                  END;
                  IF (env[i] = 0X) & (j < LEN(enc)) THEN
                     enc[j] := 0X
                  ELSE Default
                  END
               ELSE Default
               END
            ELSE Default
            END
         END
      ELSE Default
      END
   END ParseLang;

   PROCEDURE (hook: LanguageHook) SetLanguage (
      lang: Dialog.Language; persistent: BOOLEAN; OUT ok: BOOLEAN
   );
   BEGIN
      ok := (lang = "") OR (LEN(lang$) = 2)
   END SetLanguage;

   PROCEDURE (hook: LanguageHook) GetPersistentLanguage (OUT l: Dialog.Language);
      VAR res: INTEGER; s: ARRAY 32 OF CHAR;
   BEGIN
      (* l := ""; *) l := lang
   END GetPersistentLanguage;

   PROCEDURE Init;
      VAR languageHook: LanguageHook;
         country: ARRAY 3 OF CHAR;
   BEGIN
      ParseLang(lang, country, enc);
      NEW(languageHook); Dialog.SetLanguageHook(languageHook); Dialog.ResetLanguage
   END Init;

BEGIN
   Init
END HostLang.


Упростил интерфейс Console:
Код:
MODULE Console;

   TYPE
      Console* = POINTER TO ABSTRACT RECORD END;

   VAR
      cons: Console;

   (* Console *)

   PROCEDURE (c: Console) WriteStr- (IN s: ARRAY OF CHAR), NEW, ABSTRACT;
   PROCEDURE (c: Console) WriteChar- (ch: CHAR), NEW, ABSTRACT;
   PROCEDURE (c: Console) WriteLn-, NEW, ABSTRACT;

   (*
      post:
         s = "": end of input or input error
         s # "": line with end of line postfix
   *)
   PROCEDURE (c: Console) ReadLn- (OUT s: ARRAY OF CHAR), NEW, ABSTRACT;


   PROCEDURE WriteStr* (IN text: ARRAY OF CHAR);
   BEGIN
      cons.WriteStr(text)
   END WriteStr;

   PROCEDURE WriteChar* (c: CHAR);
   BEGIN
      cons.WriteChar(c)
   END WriteChar;

   PROCEDURE WriteLn*;
   BEGIN
      cons.WriteLn
   END WriteLn;

   PROCEDURE ReadLn* (OUT text: ARRAY OF CHAR);
   BEGIN
      cons.ReadLn(text)
   END ReadLn;


   PROCEDURE SetConsole* (c: Console);
   BEGIN
      cons := c
   END SetConsole;

END Console.

Переписал реализацию Console:
Код:
MODULE HostConsole;

   (*
      Console implementation for Linux
   *)

   IMPORT SYSTEM, Console, Libc := LinLibc, Codecs := EncCodecs, HostLang;

   CONST
      defCh = '?';

   TYPE
      Cons = POINTER TO RECORD (Console.Console) END;

   VAR
      cons: Cons;
      e: Codecs.Encoder;
      d: Codecs.Decoder;

   PROCEDURE (cons: Cons) ReadLn (OUT s: ARRAY OF CHAR);
      CONST
         maxLineLen = 1023; (* without null terminating shortchar *)
      VAR
         i: INTEGER;
         str: Libc.PtrSTR;
         ss: ARRAY maxLineLen+1 OF SHORTCHAR;
         fR, fLen, tW: INTEGER;
         st: BOOLEAN;
   BEGIN
      ss[LEN(ss)-1] := 0X;
      str := Libc.fgets(ss, LEN(ss), Libc.stdin);
      IF (str # NIL) & (ss[LEN(ss)-1] = 0X) THEN
         fLen := LEN(ss$);
         IF fLen < LEN(s) THEN
            IF d # NIL THEN
               d.Reset;
               fR := 0; tW := 0;
               d.Decode(ss, fR, fLen, s, tW, st);
               IF (fLen = 0) & ~st THEN
                  s[tW] := 0X
               ELSE
                  s[0] := 0X
               END
            ELSE
               i := 0;
               WHILE (ss[i] > 0X) & (ss[i] < 80X) DO
                  s[i] := ss[i];
                  INC(i)
               END;
               IF ss[i] = 0X THEN
                  s[i] := 0X
               ELSE
                  s[0] := 0X
               END
            END
         ELSE
            s[0] := 0X
         END
      ELSE
         s[0] := 0X
      END
   END ReadLn;

   PROCEDURE Printf (IN s: ARRAY OF CHAR; len: INTEGER);
      CONST
         maxShortCharsPerChar = 3; (* UTF-8 *)
         ssLen = 128; (* >= maxShortCharsPerChar + 1 *)
      VAR
         ss: ARRAY ssLen OF SHORTCHAR;
         res: INTEGER;
         fR, fLen, tW, n: INTEGER;
   BEGIN
      fR := 0;
      WHILE len > 0 DO
         tW := 0;
         IF e # NIL THEN
            fLen := MIN(len, (LEN(ss) - 1) DIV maxShortCharsPerChar); n := fLen;
            REPEAT
               e.Encode(s, fR, fLen, ss, tW);
               IF fLen # 0 THEN
                  ss[tW] := defCh; INC(tW);
                  INC(fR); DEC(fLen)
               END
            UNTIL fLen = 0
         ELSE
            fLen := MIN(len, LEN(ss) - 1); n := fLen;
            WHILE fLen > 0 DO
               IF s[fR] < 80X THEN
                  ss[tW] := SHORT(s[fR])
               ELSE
                  ss[tW] := defCh
               END;
               INC(tW);
               INC(fR); DEC(fLen)
            END
         END;
         ss[tW] := 0X;
         res := Libc.printf(ss);
         res := Libc.fflush(Libc.NULL);

         len := len - n
      END
   END Printf;

   PROCEDURE (cons: Cons) WriteChar (c: CHAR);
      VAR s: ARRAY 1 OF CHAR;
   BEGIN
      s[0] := c;
      Printf(s, 1)
   END WriteChar;

   PROCEDURE (cons: Cons) WriteStr (IN text: ARRAY OF CHAR);
   BEGIN
      Printf(text, LEN(text$))
   END WriteStr;

   PROCEDURE (cons: Cons) WriteLn;
   BEGIN
      Printf(0AX, 1)
   END WriteLn;

   PROCEDURE Init;
   BEGIN
      IF Codecs.dir # NIL THEN
         e := Codecs.dir.NewEncoder(HostLang.enc);
         d := Codecs.dir.NewDecoder(HostLang.enc)
      END;

      NEW(cons);
      Console.SetConsole(cons)
   END Init;

BEGIN
   Init
END HostConsole.


Теперь поддерживаются любые языки и кодировки. Заработали строковые ресурсы (Rsrc/lang/Strings.odc).

Осталось реализовать преобразование кодировки имён файлов в HostFiles.


Последний раз редактировалось Alexander Shiryaev Воскресенье, 28 Октябрь, 2012 23:24, всего редактировалось 2 раз(а).

Вернуться к началу
 Профиль  
 
СообщениеДобавлено: Суббота, 27 Октябрь, 2012 20:36 
Модератор
Аватара пользователя

Зарегистрирован: Среда, 16 Ноябрь, 2005 00:53
Сообщения: 4625
Откуда: Россия, Орёл
Alexander Shiryaev писал(а):
Теперь поддерживаются любые языки и кодировки. Заработали строковые ресурсы (Rsrc/lang/Strings.odc).
Хорошо. Только с коцепцией Dialog.Lang, кажется, пока не всё гладко. Во-первых, тов. Горячев, если не изменяет память, правил реализацию Dialog в bb16community --- чтобы если в /lang/ строки нету, то она бралась из файла по-умолчанию. Во-вторых язык по-умолчанию вообще-говоря может быть разный.

Alexander Shiryaev писал(а):
Осталось реализовать преобразование кодировки имён файлов в HostFiles.
Этим сейчас занимаюсь.


Вернуться к началу
 Профиль  
 
СообщениеДобавлено: Понедельник, 29 Октябрь, 2012 02:37 

Зарегистрирован: Суббота, 26 Ноябрь, 2005 02:12
Сообщения: 473
Откуда: KZ
В общем случае реализовывать преобразование кодировки файлов в HostFiles через EncCodecs и использовать реализацию EncStdCodecs не получится, потому что при попытке доступа к файлу, получится переполнение стека, т.к. EncStdCodecs.dir.NewEncoder(кодировка) будет вызывать Meta.Lookup, Meta.Lookup будет вызывать HostFiles.Old(путь к EncStdMap_xxx), HostFiles будет вызывать EncCodecs.dir.New(эта же самая кодировка) и т.д.

Поэтому получается, что толку от подсистемы Enc для наших системных применений нет, я её удалю. Надо всё делать напрямую через libiconv или mbtowc*,wctomb*, без использования каких-либо дополнительных/промежуточных модулей.


Вернуться к началу
 Профиль  
 
СообщениеДобавлено: Понедельник, 29 Октябрь, 2012 08:37 
Модератор
Аватара пользователя

Зарегистрирован: Среда, 16 Ноябрь, 2005 00:53
Сообщения: 4625
Откуда: Россия, Орёл
Alexander Shiryaev писал(а):
В общем случае реализовывать преобразование кодировки файлов в HostFiles через EncCodecs и использовать реализацию EncStdCodecs не получится,... Надо всё делать напрямую через libiconv или mbtowc*,wctomb*, без использования каких-либо дополнительных/промежуточных модулей.
(не считая общих соображений) потому напрямую и сделано. Хотел было пару дней тому Вам про это писать, но подумал что Вы и сами знаете, поскольку известно, что для HostFiles требуется статическая линковка. Думал что Вы просто делаете общее средство, чтобы было...


Вернуться к началу
 Профиль  
 
СообщениеДобавлено: Понедельник, 29 Октябрь, 2012 08:43 
Модератор
Аватара пользователя

Зарегистрирован: Среда, 16 Ноябрь, 2005 00:53
Сообщения: 4625
Откуда: Россия, Орёл
Alexander Shiryaev писал(а):
Поэтому получается, что толку от подсистемы Enc для наших системных применений нет, я её удалю.
Для системных нет, согласен.

Вообще же, если Вы систему довели до ума, можно в коллекцию положить. Хотя и имеется подобная тулза от тов. Горячева, поддерживать её некому...


Вернуться к началу
 Профиль  
 
СообщениеДобавлено: Понедельник, 29 Октябрь, 2012 18:08 
Модератор
Аватара пользователя

Зарегистрирован: Среда, 16 Ноябрь, 2005 00:53
Сообщения: 4625
Откуда: Россия, Орёл
Тест гоняется. Единственная штука, которая мне пока точно не ясна --- если генерить строки случайно, мешая литеры как попало, то Ucs2ToMb отрабатывает без ошибок, а в обратную сторону у MbToUcs2 ужо облом выходит (result = 1). Кто знает, чем это объяснить? Есть предположение, что это может быть связано с "модифицирующими" литерами (надстрочные знаки всякие и т.п.).
Код:
   VAR minCh, maxCh: CHAR;
...
   PROCEDURE MakeRandomStr (minLen, maxLen: INTEGER; OUT s: ARRAY OF CHAR);
      VAR   i, len, chRange: INTEGER;
   BEGIN
      ASSERT((0 <= minLen) & (minLen <= maxLen), 20);
      i := 0; len := minLen + Random(maxLen - minLen + 1);
      chRange := ORD(maxCh) - ORD(minCh) + 1;
      WHILE i < len DO
         s[i] := CHR(ORD(minCh) + Random(chRange));
         INC(i)
      END;
      s[i] := 0X
   END MakeRandomStr;
...
minCh := " "; maxCh := 0FFFFX;

Код:
   PROCEDURE Ucs2ToMb (IN x: ARRAY OF CHAR; OUT y: ShortName(* ARRAY OF SHORTCHAR *));
      CONST   mbLenMax = LinLibc.MB_LEN_MAX;
      VAR
         res, i, j, len: INTEGER;
         ch: LinLibc.wchar_t;
         state: LinLibc.mbstate_t;
   BEGIN
      i := 0; ch := ORD(x[0]); j := 0; len := LEN(y); (* ASSERT(len >= mbLenMax, 20); *)
      state.__count := 0; state.__value.__wch := 0;
      res := LinLibc.wcrtomb(y[0], ch, state);
      WHILE (ch # 0) & (res > 0) & (len - res >= mbLenMax) DO
         INC(j, res); DEC(len, res);
         INC(i); ch := ORD(x[i]);
         res := LinLibc.wcrtomb(y[j], ch, state)
      END;
      ASSERT(ch = 0, 100);
      y[j] := 0X
   END Ucs2ToMb;

   PROCEDURE MbToUcs2 (VAR x: ARRAY OF SHORTCHAR; OUT y: ARRAY OF CHAR; OUT result: INTEGER);
      VAR
         res, i, len, j, outLen: INTEGER; ch: LinLibc.wchar_t;
         state: LinLibc.mbstate_t;
   BEGIN
      i := 0; len := LEN(x); j := 0; outLen := LEN(y);
      state.__count := 0; state.__value.__wch := 0;
      res := LinLibc.mbrtowc(ch, x[0], len, state);
      WHILE (res > 0) & ((0 <= ch) & (ch < 10000H)) & (j < outLen) DO
         y[j] := CHR(ch); INC(j);
         INC(i, res); DEC(len, res);
         res := LinLibc.mbrtowc(ch, x[i], len, state)
      END;
      IF res = 0 THEN
         y[j] := 0X; result := 0
      ELSIF (res = -2) OR (res = -1) THEN
         result := -res   (* некорректно сформированная цепочка *)
      ELSIF ~((0 <= ch) & (ch < 10000H)) THEN
         result := 3   (* непредставимая литера *)
      ELSIF j = outLen THEN
         result := 4   (* результат не влезает *)
      ELSE
         HALT(100)   (* засада *)
      END
   END MbToUcs2;
Тестовая выдача (текстом сюда не вставляется целиком).
Вложение:
TestHostFilesMbUcs2.log.utf8.7z [2.75 КБ]
Скачиваний: 457

Системный браузер про каличные имена пишет как есть. В ББ реализовал так, что эти элементы не видны --- не включаются в списки Files.dir.FileList/LocList. Подобное поведение унаследовано от предыдущей реализации, которая игнорирует имена, которые не влезают в HostFiles.FullName.
Вложение:
Снимок.png
Снимок.png [ 24.92 КБ | Просмотров: 14908 ]


Вернуться к началу
 Профиль  
 
СообщениеДобавлено: Понедельник, 29 Октябрь, 2012 18:14 
Модератор
Аватара пользователя

Зарегистрирован: Среда, 16 Ноябрь, 2005 00:53
Сообщения: 4625
Откуда: Россия, Орёл
Попробовал системные цепоченые функции, результат тот же: в "ту" сторону нормально, обратно --- нет.
Код:
   PROCEDURE Ucs2ToUcs4 (IN s2: ARRAY OF CHAR; OUT s4: ARRAY OF INTEGER);
      VAR   i: INTEGER; ch: CHAR;
   BEGIN
      i := 0; ch := s2[0];
      WHILE ch # 0X DO
         s4[i] := ORD(ch);
         INC(i); ch := s2[i]
      END;
      s4[i] := 0
   END Ucs2ToUcs4;

   PROCEDURE Ucs4ToUcs2 (IN s4: ARRAY OF INTEGER; OUT s2: ARRAY OF CHAR);
      VAR   i: INTEGER; ch: INTEGER;
   BEGIN
      i := 0; ch := s4[0];
      WHILE ch # 0 DO
         ASSERT((0 <= ch) & (ch < 10000H), 100); s2[i] := CHR(ch);
         INC(i); ch := s4[i]
      END;
      s2[i] := 0X
   END Ucs4ToUcs2;

   PROCEDURE Ucs2ToMb (IN x: ARRAY OF CHAR; OUT y: ARRAY OF SHORTCHAR);
      VAR   res: LinLibc.size_t; s4: ARRAY LEN(FullName) OF INTEGER;
   BEGIN
      Ucs2ToUcs4(x, s4);
      res := LinLibc.wcstombs(y, s4, LEN(y));
      ASSERT((0 <= res) & (res < LEN(y)), 100)
   END Ucs2ToMb;

   PROCEDURE MbToUcs2 (IN x: ARRAY OF SHORTCHAR; OUT y: ARRAY OF CHAR; OUT result: INTEGER);
      VAR   res: LinLibc.size_t; s4: ARRAY LEN(FullName) OF INTEGER;
   BEGIN
      res := LinLibc.mbstowcs(s4, x, LEN(s4));
      IF (0 <= res) & (res < LEN(s4)) THEN
         result := 0; Ucs4ToUcs2(s4, y)
      ELSE
         result := 1
      END
   END MbToUcs2;


Вернуться к началу
 Профиль  
 
СообщениеДобавлено: Понедельник, 29 Октябрь, 2012 18:34 

Зарегистрирован: Суббота, 26 Ноябрь, 2005 02:12
Сообщения: 473
Откуда: KZ
Евгений Темиргалеев писал(а):
...для HostFiles требуется статическая линковка. Думал что Вы просто делаете общее средство, чтобы было...


Для HostFiles требуется, но не требуется для EncStdCodecs.

Вообще можно описанную проблему решить, если хранить имена файлов и каталогов в HostFiles.Locator и в HostFiles.File как ShortName, а не FullName. Но для этого надо делать много правок HostFiles, пока не считаю это целесообразным.


Вернуться к началу
 Профиль  
 
СообщениеДобавлено: Понедельник, 29 Октябрь, 2012 18:41 

Зарегистрирован: Суббота, 26 Ноябрь, 2005 02:12
Сообщения: 473
Откуда: KZ
Евгений Темиргалеев писал(а):
Попробовал системные цепоченые функции, результат тот же: в "ту" сторону нормально, обратно --- нет.

Надо смотреть, какие именно символы не преобразуются.


Вернуться к началу
 Профиль  
 
СообщениеДобавлено: Вторник, 30 Октябрь, 2012 02:54 

Зарегистрирован: Суббота, 26 Ноябрь, 2005 02:12
Сообщения: 473
Откуда: KZ
Реализовал преобразование кодировки имён файлов и каталогов и переменных окружения в HostFiles через iconv:
Код:
MODULE LinIconv ["libc.so.6"]; (* Linux *)

   IMPORT Libc := LinLibc;

   CONST
      NULL* = Libc.NULL;

   TYPE
      PtrVoid = Libc.PtrVoid;
      PtrSTR* = Libc.PtrSTR;
      PtrLSTR* = POINTER TO ARRAY [untagged] OF CHAR;
      size_t* = Libc.size_t;

      iconv_t* = PtrVoid;

   PROCEDURE [ccall] iconv_open* (tocode, fromcode: PtrSTR): iconv_t;
   PROCEDURE [ccall] iconv_close* (cd: iconv_t): INTEGER;

   PROCEDURE [ccall] iconv* (cd: iconv_t; VAR [nil] inbuf: PtrSTR; VAR inbytesleft: size_t; VAR [nil] outbuf: PtrSTR; VAR outbytesleft: size_t): size_t;

   PROCEDURE [ccall] iconv_encode* ["iconv"] (cd: iconv_t; VAR [nil] inbuf: PtrLSTR; VAR inbytesleft: size_t; VAR [nil] outbuf: PtrSTR; VAR outbytesleft: size_t): size_t;

   PROCEDURE [ccall] iconv_decode* ["iconv"] (cd: iconv_t; VAR [nil] inbuf: PtrSTR; VAR inbytesleft: size_t; VAR [nil] outbuf: PtrLSTR; VAR outbytesleft: size_t): size_t;

END LinIconv.

MODULE LinIconv ["libiconv.so.6"]; (* OpenBSD *)

   IMPORT Libc := LinLibc;

   CONST
      NULL* = Libc.NULL;

   TYPE
      PtrVoid = Libc.PtrVoid;
      PtrSTR* = Libc.PtrSTR;
      PtrLSTR* = POINTER TO ARRAY [untagged] OF CHAR;
      size_t* = Libc.size_t;

      iconv_t* = PtrVoid;

   PROCEDURE [ccall] iconv_open* ["libiconv_open"] (tocode, fromcode: PtrSTR): iconv_t;
   PROCEDURE [ccall] iconv_close* ["libiconv_close"] (cd: iconv_t): INTEGER;

   PROCEDURE [ccall] iconv* ["libiconv"] (cd: iconv_t; VAR [nil] inbuf: PtrSTR; VAR inbytesleft: size_t; VAR [nil] outbuf: PtrSTR; VAR outbytesleft: size_t): size_t;

   PROCEDURE [ccall] iconv_encode* ["libiconv"] (cd: iconv_t; VAR [nil] inbuf: PtrLSTR; VAR inbytesleft: size_t; VAR [nil] outbuf: PtrSTR; VAR outbytesleft: size_t): size_t;

   PROCEDURE [ccall] iconv_decode* ["libiconv"] (cd: iconv_t; VAR [nil] inbuf: PtrSTR; VAR inbytesleft: size_t; VAR [nil] outbuf: PtrLSTR; VAR outbytesleft: size_t): size_t;

END LinIconv.

MODULE HostFiles;

   IMPORT SYSTEM, Kernel, Files, LinLibc, Iconv := LinIconv;

   ...

   TYPE
      FullName* = ARRAY pathLen OF CHAR;
      ShortName = ARRAY pathLen * 4 OF SHORTCHAR;
      Encoding = ARRAY 32 OF SHORTCHAR;

   ...

   VAR
      e, d: Iconv.iconv_t;

   ...

   (* encoding translation functions *)

   PROCEDURE GetEnc (OUT enc: Encoding; OUT ok: BOOLEAN);
      VAR env: LinLibc.PtrSTR;
         i, j: INTEGER;

      PROCEDURE IsSLetter (c: SHORTCHAR): BOOLEAN;
      BEGIN
         RETURN (c >= 'a') & (c <= 'z')
      END IsSLetter;

      PROCEDURE IsBLetter (c: SHORTCHAR): BOOLEAN;
      BEGIN
         RETURN (c >= 'A') & (c <= 'Z')
      END IsBLetter;

      PROCEDURE IsValidEncChar (x: SHORTCHAR): BOOLEAN;
      BEGIN
         RETURN ((x >= 'A') & (x <= 'Z')) OR ((x >= '0') & (x <= '9')) OR (x = '-') OR (x = '_')
            OR ((x >= 'a') & (x <= 'z'))
      END IsValidEncChar;

   BEGIN
      env := LinLibc.getenv("LANG");
      IF env # NIL THEN
         IF env$ = "C" THEN
            enc := "ASCII"; ok := TRUE
         ELSE
            IF IsSLetter(env[0]) & IsSLetter(env[1]) & (env[2] = '_')
            & IsBLetter(env[3]) & IsBLetter(env[4]) & (env[5] = '.') THEN
               i := 6; j := 0;
               WHILE IsValidEncChar(env[i]) & (j < LEN(enc) - 1) DO
                  enc[j] := env[i];
                  INC(j); INC(i)
               END;
               IF (env[i] = 0X) & (j < LEN(enc)) THEN
                  enc[j] := 0X; ok := TRUE
               ELSE ok := FALSE
               END
            ELSE ok := FALSE
            END
         END
      ELSE ok := FALSE
      END
   END GetEnc;

   PROCEDURE InitConv;
      VAR enc: Encoding; ok: BOOLEAN;
   BEGIN
      GetEnc(enc, ok);
      IF ok THEN
         e := Iconv.iconv_open(enc, "UCS-2LE");
         d := Iconv.iconv_open("UCS-2LE", enc)
      ELSE e := -1; d := -1
      END
   END InitConv;

   PROCEDURE CloseConv;
      VAR res: INTEGER;
   BEGIN
      IF e # -1 THEN res := Iconv.iconv_close(e); e := -1 END;
      IF d # -1 THEN res := Iconv.iconv_close(d); d := -1 END
   END CloseConv;

   PROCEDURE ResetCodec (c: Iconv.iconv_t): BOOLEAN;
      VAR res, fLen, tLen: Iconv.size_t;
   BEGIN
      ASSERT(c # -1, 20);
      fLen := 0; tLen := 0;
      res := Iconv.iconv(c, NIL, fLen, NIL, tLen);
      RETURN res # -1
   END ResetCodec;

   PROCEDURE Short (IN f: FullName; OUT t: ShortName; OUT ok: BOOLEAN);
      VAR fR, fLen, tLen: INTEGER;
         from: Iconv.PtrLSTR; to: Iconv.PtrSTR; res: Iconv.size_t;
   BEGIN
      (* do not use encoder for basic set of chars *)
      fR := 0; WHILE (f[fR] >= ' ') & (f[fR] <= '~') DO t[fR] := SHORT(f[fR]); INC(fR) END;
      IF f[fR] = 0X THEN t[fR] := 0X; ok := TRUE
      ELSIF (e # -1) & ResetCodec(e) THEN
         from := f; to := t; fLen := LEN(f$) * SIZE(CHAR) (* 2 *); tLen := LEN(t) - 1;
         res := Iconv.iconv_encode(e, from, fLen, to, tLen);
         IF (res >= 0) & (fLen = 0) & (tLen >= 0) THEN to[0] := 0X; ok := TRUE
         ELSE t[0] := 0X; ok := FALSE
         END
      ELSE t[0] := 0X; ok := FALSE
      END
   END Short;

   PROCEDURE Long (IN f: ShortName; OUT t: FullName; OUT ok: BOOLEAN);
      VAR fR, fLen, tLen: INTEGER;
         from: Iconv.PtrSTR; to: Iconv.PtrLSTR; res: Iconv.size_t;
   BEGIN
      (* do not use decoder for basic set of chars *)
      fR := 0; WHILE (f[fR] >= ' ') & (f[fR] <= '~') & (fR < LEN(t) - 1) DO t[fR] := f[fR]; INC(fR) END;
      IF f[fR] = 0X THEN
         IF fR < LEN(t) THEN t[fR] := 0X; ok := TRUE
         ELSE t[0] := 0X; ok := FALSE (* f is too long *)
         END
      ELSIF (d # -1) & ResetCodec(d) THEN
         from := f; to := t; fLen := LEN(f$); tLen := (LEN(t) - 1) * SIZE(CHAR) (* 2 *);
         res := Iconv.iconv_decode(d, from, fLen, to, tLen);
         IF (res >= 0) & (fLen = 0) & (tLen >= 0) THEN to[0] := 0X; ok := TRUE
         ELSE t[0] := 0X; ok := FALSE
         END
      ELSE t[0] := 0X; ok := FALSE
      END
   END Long;

   (* end of encoding translation functions *)

   далее в тексте вызовы shortName := SHORT(fullName$) заменены на Short(fullName, shortName, ok1)

   ...

   PROCEDURE Init;
      CONST bbServerDir = "BB_PRIMARY_DIR"; bbWorkDir = "BB_SECONDARY_DIR";
      VAR res: INTEGER; attr: SET; p: LinLibc.PtrSTR;
         buf: LinLibc.stat_t; isDir, def1: BOOLEAN;
         ok1: BOOLEAN; fname: FullName;
   BEGIN
      InitConv;

      wildcard := "*"; NEW(dir);

      p := LinLibc.getenv(bbServerDir);   (* p = NIL -> undefined *)
      def1 := FALSE;
      IF p # NIL THEN
         Long(p$, fname, ok1);
         IF ok1 THEN
            Stat(fname, buf, res);
            IF res = ok THEN
               ModeToAttr(buf.st_mode, attr, isDir);
               def1 := isDir
            END
         END;
         IF ~def1 THEN Msg("HostFiles: Value of " + bbServerDir + " isn't directory, using cwd") END
      END;
      IF ~def1 THEN
         p := NIL;
         p := LinLibc.getcwd(p, 0);
         Long(p$, fname, ok1);
         IF ~ok1 THEN fname := "." END;
         LinLibc.free(SYSTEM.VAL(LinLibc.PtrVoid, p))
      END;
      startupDir := fname; startupLen := LEN(startupDir$);
      dir.startup := NewLocator(startupDir);
      dir.startup.rootLen := 0;

      p := LinLibc.getenv(bbWorkDir);   (* p = NIL -> undefined *)
      IF def1 & (p # NIL) THEN
         Long(p$, fname, ok1);
         IF ok1 THEN
            Stat(fname, buf, res);
            ok1 := res = ok;
            IF ok1 THEN
               ModeToAttr(buf.st_mode, attr, isDir);
               ok1 := isDir
            END
         END;
         IF ~serverVersion THEN
            (* - *)
         ELSIF ok1 THEN
            dir.startup := NewLocator(fname); dir.startup.rootLen := LEN(fname$)
         ELSE
            Msg("HostFiles: Value of " + bbWorkDir + " isn't directory, server configuration isn't enabled")
         END
      END;

      dir.temp := NewLocator(LinLibc.P_tmpdir);
      Files.SetDir(dir)
   END Init;

BEGIN
   Init
CLOSE
   CloseConv
END HostFiles.

Полностью HostFiles для Linux.

Проверял в Ubuntu и в Fedora Core с кодировкой UTF-8 ("UTF8" тоже работает), в OpenBSD -- с KOI8-R.


Последний раз редактировалось Alexander Shiryaev Воскресенье, 04 Ноябрь, 2012 11:20, всего редактировалось 1 раз.

Вернуться к началу
 Профиль  
 
СообщениеДобавлено: Вторник, 30 Октябрь, 2012 07:14 

Зарегистрирован: Суббота, 26 Ноябрь, 2005 02:12
Сообщения: 473
Откуда: KZ
Убрал подсистему Enc.

Переписал преобразование кодировки в HostConsole на основе iconv:
Код:
MODULE HostConsole; (* Linux *)

   IMPORT SYSTEM, Console, Libc := LinLibc, Iconv := LinIconv, HostLang;

   CONST
      defCh = '?';

   TYPE
      Cons = POINTER TO RECORD (Console.Console) END;

   VAR
      cons: Cons;
      e, d: Iconv.iconv_t;

   PROCEDURE ResetCodec (c: Iconv.iconv_t): BOOLEAN;
      VAR res, fLen, tLen: Iconv.size_t;
   BEGIN
      fLen := 0; tLen := 0;
      res := Iconv.iconv(c, NIL, fLen, NIL, tLen);
      RETURN res # -1
   END ResetCodec;

   PROCEDURE (cons: Cons) ReadLn (OUT s: ARRAY OF CHAR);
      CONST
         maxLineLen = 1023; (* without null terminating shortchar *)
      VAR
         i: INTEGER;
         str: Libc.PtrSTR;
         ss: ARRAY maxLineLen+1 OF SHORTCHAR;
         fR, fLen, tW, tLen: INTEGER;
         st: BOOLEAN;
         res: Iconv.size_t;
         from: Iconv.PtrSTR; to: Iconv.PtrLSTR;
   BEGIN
      ss[LEN(ss)-1] := 0X;
      str := Libc.fgets(ss, LEN(ss), Libc.stdin);
      IF (str # NIL) & (ss[LEN(ss)-1] = 0X) THEN
         fLen := LEN(ss$);
         IF fLen < LEN(s) THEN
            IF d # -1 THEN
               IF ResetCodec(d) THEN
                  from := ss; to := s; tLen := (LEN(s) - 1) * SIZE(CHAR) (* 2 *);
                  res := Iconv.iconv_decode(d, from, fLen, to, tLen);
                  IF (res >= 0) & (fLen = 0) & (tLen >= 0) THEN to[0] := 0X
                  ELSE s[0] := 0X
                  END
               ELSE s[0] := 0X
               END
            ELSE
               i := 0;
               WHILE (ss[i] > 0X) & (ss[i] < 80X) DO s[i] := ss[i]; INC(i) END;
               IF ss[i] = 0X THEN s[i] := 0X
               ELSE s[0] := 0X
               END
            END
         ELSE s[0] := 0X
         END
      ELSE s[0] := 0X
      END
   END ReadLn;

   PROCEDURE Printf (IN s: ARRAY OF CHAR; len: INTEGER);
      CONST
         maxShortCharsPerChar = 4;
         ssLen = 128; (* >= maxShortCharsPerChar + 1 *)
      VAR
         ss: ARRAY ssLen OF SHORTCHAR;
         fR, fLen, tW, tLen, n: INTEGER;
         res: INTEGER;
         res1: Iconv.size_t;
         from: Iconv.PtrLSTR; to: Iconv.PtrSTR;
   BEGIN
      fR := 0; from := s;
      WHILE len > 0 DO
         tW := 0; to := ss;
         IF e # -1 THEN
            tLen := LEN(ss) - 1;
            n := MIN(len, tLen DIV maxShortCharsPerChar);
            fLen := n * SIZE(CHAR) (* 2 *);
            REPEAT
               res1 := Iconv.iconv_encode(e, from, fLen, to, tLen);
               IF ~((res1 >= 0) & (fLen = 0) & (tLen >= 0)) THEN
                  ASSERT(tLen >= 0, 100);
                  ASSERT(fLen >= SIZE(CHAR), 101);
                  ASSERT(ResetCodec(e), 102);
                  to[0] := defCh; to := SYSTEM.VAL(Iconv.PtrSTR, SYSTEM.VAL(INTEGER, to) + 1);
                  DEC(tLen);
                  from := SYSTEM.VAL(Iconv.PtrLSTR, SYSTEM.VAL(INTEGER, from) + SIZE(CHAR));
                  DEC(fLen, SIZE(CHAR))
               END
            UNTIL fLen = 0;
            to[0] := 0X
         ELSE
            fLen := MIN(len, LEN(ss) - 1); n := fLen;
            WHILE fLen > 0 DO
               IF s[fR] < 80X THEN ss[tW] := SHORT(s[fR])
               ELSE ss[tW] := defCh
               END;
               INC(tW);
               INC(fR); DEC(fLen)
            END;
            ss[tW] := 0X
         END;
         res := Libc.printf(ss);
         res := Libc.fflush(Libc.NULL);

         len := len - n
      END
   END Printf;

   PROCEDURE (cons: Cons) WriteChar (c: CHAR);
      VAR s: ARRAY 1 OF CHAR;
   BEGIN
      s[0] := c;
      Printf(s, 1)
   END WriteChar;

   PROCEDURE (cons: Cons) WriteStr (IN text: ARRAY OF CHAR);
   BEGIN
      Printf(text, LEN(text$))
   END WriteStr;

   PROCEDURE (cons: Cons) WriteLn;
   BEGIN
      Printf(0AX, 1)
   END WriteLn;

   PROCEDURE Init;
   BEGIN
      e := Iconv.iconv_open(HostLang.enc, "UCS-2LE");
      d := Iconv.iconv_open("UCS-2LE", HostLang.enc);

      NEW(cons);
      Console.SetConsole(cons)
   END Init;

   PROCEDURE Close;
      VAR res: INTEGER;
   BEGIN
      IF e # -1 THEN res := Iconv.iconv_close(e) END;
      IF d # -1 THEN res := Iconv.iconv_close(d) END
   END Close;

BEGIN
   Init
CLOSE
   Close
END HostConsole.


Вернуться к началу
 Профиль  
 
СообщениеДобавлено: Вторник, 30 Октябрь, 2012 10:51 
Модератор
Аватара пользователя

Зарегистрирован: Среда, 16 Ноябрь, 2005 00:53
Сообщения: 4625
Откуда: Россия, Орёл
Alexander Shiryaev писал(а):
Реализовал преобразование кодировки имён файлов и каталогов и переменных окружения в HostFiles через iconv:
...
Проверял в Ubuntu и в Fedora Core с кодировкой UTF-8 ("UTF8" тоже работает), в OpenBSD -- с KOI8-R.
Тест из дельты пробовали? Симметрично преобразование идёт или нет?


Вернуться к началу
 Профиль  
 
СообщениеДобавлено: Среда, 31 Октябрь, 2012 09:00 
Модератор
Аватара пользователя

Зарегистрирован: Среда, 16 Ноябрь, 2005 00:53
Сообщения: 4625
Откуда: Россия, Орёл
Попробовал сам. Ucs2ToMb трэпует. Нужно ещё смотреть. Если в libc стандартные (ISO С) функции так "хорошо" сделаны, что некорректные последовательности не распознают, то в идеале придётся переходить на iconv.


Вернуться к началу
 Профиль  
 
СообщениеДобавлено: Среда, 31 Октябрь, 2012 09:06 
Модератор
Аватара пользователя

Зарегистрирован: Среда, 16 Ноябрь, 2005 00:53
Сообщения: 4625
Откуда: Россия, Орёл
Alexander Shiryaev писал(а):
Код:
PROCEDURE Init;
   BEGIN
      e := Iconv.iconv_open(HostLang.enc, "UCS-2LE");
      d := Iconv.iconv_open("UCS-2LE", HostLang.enc);

      NEW(cons);
      Console.SetConsole(cons)
   END Init;
Насчёт LE советую обратить внимание на Kernel.littleEndian и реализацию Stores.


Вернуться к началу
 Профиль  
 
СообщениеДобавлено: Четверг, 01 Ноябрь, 2012 03:06 

Зарегистрирован: Суббота, 26 Ноябрь, 2005 02:12
Сообщения: 473
Откуда: KZ
Евгений Темиргалеев писал(а):
Насчёт LE советую обратить внимание на Kernel.littleEndian и реализацию Stores.


Да, надо так:
Код:
IF Kernel.littleEndian THEN
   e := Iconv.iconv_open(HostLang.enc, "UCS-2LE");
   d := Iconv.iconv_open("UCS-2LE", HostLang.enc)
ELSE
   e := Iconv.iconv_open(HostLang.enc, "UCS-2BE");
   d := Iconv.iconv_open("UCS-2BE", HostLang.enc)
END;


Вернуться к началу
 Профиль  
 
СообщениеДобавлено: Четверг, 01 Ноябрь, 2012 10:32 
Модератор
Аватара пользователя

Зарегистрирован: Среда, 16 Ноябрь, 2005 00:53
Сообщения: 4625
Откуда: Россия, Орёл
А может быть можно проще, "UCS-2"?


Вернуться к началу
 Профиль  
 
СообщениеДобавлено: Четверг, 01 Ноябрь, 2012 17:13 

Зарегистрирован: Суббота, 26 Ноябрь, 2005 02:12
Сообщения: 473
Откуда: KZ
Нет. Надо указать в Iconv порядок следования байтов в CHAR, используемый в BlackBox. Iconv не может этого знать.

На практике, конечно, порядок следования байт в BlackBox должен быть таким же, как в UCS-2-INTERNAL в Iconv, но этого никто гарантировать не может.


Вернуться к началу
 Профиль  
 
СообщениеДобавлено: Четверг, 01 Ноябрь, 2012 19:19 
Модератор
Аватара пользователя

Зарегистрирован: Среда, 16 Ноябрь, 2005 00:53
Сообщения: 4625
Откуда: Россия, Орёл
В Блэкбокс может использоваться только тот же самый порядок байт, что и на оборудовании, на котором выполняется маш. код, поскольку речь во время выполнения ПО идёт об использовании CHAR как внутреннего представления, но не как внешнего. Для кода iconv, выполняющегося на том же самом оборудовании, должен быть тот же самый внутренний порядок байт. Это разумно.


Вернуться к началу
 Профиль  
 
Показать сообщения за:  Поле сортировки  
Форум закрыт Эта тема закрыта, вы не можете редактировать и оставлять сообщения в ней.  [ Сообщений: 46 ]  На страницу Пред.  1, 2, 3  След.

Часовой пояс: UTC + 3 часа


Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 2


Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

Найти:
Вся информация, размещаемая участниками на конференции (тексты сообщений, вложения и пр.) © 2005-2024, участники конференции «OberonCore», если специально не оговорено иное.
Администрация не несет ответственности за мнения, стиль и достоверность высказываний участников, равно как и за безопасность материалов, предоставляемых участниками во вложениях.
Без разрешения участников и ссылки на конференцию «OberonCore» любое воспроизведение и/или копирование высказываний полностью и/или по частям запрещено.
Powered by phpBB® Forum Software © phpBB Group
Русская поддержка phpBB