OberonCore

(* Модуль читает поток байт в кодировке UTF-8 и возвращает номер символа в таблице UNICODE.
   В общем случае варианты представления одного символа в кодировке UTF-8 выглядят так:
   (1 байт)  0aaa aaaa
   (2 байта) 110x xxxx 10xx xxxx
   (3 байта) 1110 xxxx 10xx xxxx 10xx xxxx
   (4 байта) 1111 0xxx 10xx xxxx 10xx xxxx 10xx xxxx
   Данная кодировка позволяет кодировать символы в диапозонах: U+0000..U+D7FF и U+E000..U+10FFFF.
   В случае, если встретился неизвестный символ, он будет кодироваться как U+FFFD.
   BOM представляет собой байты EF, BB и BF (что является трёхбайтовой реализацией символа FEFF).
   Символ должен быть закодирован минимально возможным количеством байт, удлиненные коды запрещены.
*)
MODULE UTF8Reader;

  IMPORT Reader;

  CONST bufSize = 7;

  VAR buf: ARRAY bufSize OF CHAR; (* Фактически используется только 4 элемента буфера, 3 элемента нужны чтобы не было выхода
                                     за границы массива при сдвиге элементов массива. *)
    len: INTEGER;

  (* Сдвигает элементы массива. *)
  PROCEDURE Shift(n: INTEGER);
  VAR i: INTEGER;
  BEGIN
    (*PRE: (0 < n) & (n <= 4) & (bufSize >= 4+3) *)
    buf[0] := buf[n];
    buf[1] := buf[n+1];
    buf[2] := buf[n+2];
    len := len - n;
  END Shift;

  (* Проверяет не первый байт символа на то, что он существует и что он находится в заданных интервалах. *)
  PROCEDURE CheckTail(n: INTEGER): BOOLEAN;
  VAR res: BOOLEAN;
    code: INTEGER;
  BEGIN
    (*PRE: (1 <= n) & (n <= 3) *)
    IF len > n THEN
      code := ORD(buf[n]);
      res := (128 <= code) & (code <= 191);
    ELSE
      res := FALSE;
    END;
    RETURN res
  END CheckTail;

  PROCEDURE FillBuffer(r: Reader.Reader);
  BEGIN
    (* Заполняем буфер *) 
    WHILE (len < 4) & ~r.eof DO
      r.GetChar(r, buf[len]);
      IF ~r.eof THEN
        len := len + 1;
      END;
    END;
  END FillBuffer;

  (* Возвращает FALSE, когда нет больше символов для чтения.
    В случае ошибки возвращает символ замены: FFFD. *)
  PROCEDURE Read*(r: Reader.Reader; VAR point: INTEGER): BOOLEAN;
  VAR res, err: BOOLEAN;
    c0, c1: INTEGER;
  BEGIN                   
    (*PRE: len < 4 *)   
    FillBuffer(r);
    IF len > 0 THEN
      res := TRUE;
      err := FALSE;
      c0 := ORD(buf[0]);
      IF c0 < 128 THEN    (* 0000 0000 <= c0 <= 0aaa aaaa *)
        point := c0;
        Shift(1);
      ELSIF (192 <= c0) & (c0 <= 223) THEN (* 1100 0000 <=  c0 <  1101 1111. *)
        IF CheckTail(1) THEN
          point := 64*(c0 MOD 32) + (ORD(buf[1]) MOD 64);
          IF point < 128 THEN (* Избыточное кодирование. *)
            err := TRUE;
          ELSE
            Shift(2);
          END;
        ELSE
          err := TRUE;
        END;
      ELSIF (224 <= c0) & (c0 <= 239) THEN (* 1110 0000 <= c0 <= 1110 1111 *)
        IF CheckTail(1) & CheckTail(2) THEN
          point := 64*64*(c0 MOD 16) + 64*(ORD(buf[1]) MOD 64) + (ORD(buf[2]) MOD 64);
          IF point < 2048 THEN (* Избыточное кодирование *)
            err := TRUE;
          ELSIF (0D800H <= point) & (point <= 0DFFFH) THEN
            err := TRUE;
          ELSE
            Shift(3);
          END;
        ELSE 
          err := TRUE;
        END;
      ELSIF (240 <= c0) & (c0 <= 247) THEN (* 1111 0000 <= c0 <= 1111 0111 *)
        IF CheckTail(1) & CheckTail(2) & CheckTail(3) THEN
          point := 64*64*64*(c0 MOD 8) + 64*64*(ORD(buf[1]) MOD 64) + 64*(ORD(buf[2]) MOD 64) + (ORD(buf[3]) MOD 64);
          IF point < 65536 THEN (* Избыточное кодирование *)
            err := TRUE;
          ELSIF point > 10FFFFH THEN
            err := TRUE;
          ELSE
            Shift(4);
          END;
        ELSE
          err := TRUE;
        END;
      ELSE
        err := TRUE;
      END;
      IF err THEN
        point := 0FFFDH;
        Shift(1);
      END;
    ELSE
      res := FALSE;
    END;
    RETURN res
  END Read;

  (* Сбрасывает буфер *)
  PROCEDURE Init*;
  VAR i: INTEGER;
  BEGIN
    len := 0;
    FOR i:= 0 TO bufSize-1 DO
      buf[i] := 0X;
    END;
    (*POST: (len = 0) *)
  END Init;

BEGIN
  Init;
END UTF8Reader.

      (* 0000 0000-0000 007F  0xxxxxxx *)
   FOR init := 0 TO 7FH DO CodeLength[init] := 1X END;
      (* ???? ????-???? ????  10xxxxxx *)
   FOR init := 80H TO 0BFH DO CodeLength[init] := CodeLengthBad END;   (* non-starting byte - never change this w/o grepping for 7X *)
      (* 0000 0080-0000 07FF  110xxxxx 10xxxxxx *)
   FOR init := 0C0H TO 0DFH DO CodeLength[init] := 2X END;
      (* 0000 0800-0000 FFFF  1110xxxx 10xxxxxx 10xxxxxx *)
   FOR init := 0E0H TO 0EFH DO CodeLength[init] := 3X END;
      (* 0001 0000-001F FFFF  11110xxx 10xxxxxx 10xxxxxx 10xxxxxx *)
   FOR init := 0F0H TO 0F7H DO CodeLength[init] := 4X END;
      (* 0020 0000-03FF FFFF  111110xx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx *)
   FOR init := 0F8H TO 0FBH DO CodeLength[init] := 5X END;
      (* 0400 0000-7FFF FFFF  1111110x 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx 10xxxxxx *)
   FOR init := 0FCH TO 0FDH DO CodeLength[init] := 6X END

Идентификаторы — это последовательности букв и цифр. Первая литера идентификатора должна быть буквой.