(*
    Copyright 2016 Anton Krotov

    This file is part of Compiler.

    Compiler is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    Compiler is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with Compiler. If not, see <http://www.gnu.org/licenses/>.
*)

MODULE ERRORS;

IMPORT H := HOST;

TYPE

  STRING = ARRAY 1024 OF CHAR;

  CP = ARRAY 256 OF INTEGER;

VAR

  cp: CP;


PROCEDURE utf8(code: INTEGER; VAR uchar: STRING);
BEGIN
  uchar[0] := 0X;
  IF code < 80H THEN
    uchar[0] := CHR(code);
    uchar[1] := 0X
  ELSIF code < 800H THEN
    uchar[1] := CHR(ROR(LSL(code, 26), 26) + 80H);
    uchar[0] := CHR(ASR(code, 6) + 0C0H);
    uchar[2] := 0X
  ELSIF code < 10000H THEN
    uchar[2] := CHR(ROR(LSL(code, 26), 26) + 80H);
    code := ASR(code, 6);
    uchar[1] := CHR(ROR(LSL(code, 26), 26) + 80H);
    uchar[0] := CHR(ASR(code, 6) + 0E0H);
    uchar[3] := 0X
(*
  ELSIF code < 200000H THEN
  ELSIF code < 4000000H THEN
  ELSE	*)
  END
END utf8;

PROCEDURE InitCP(VAR cp: CP);
VAR i: INTEGER;
BEGIN
   FOR i := 0H TO 7FH DO
     cp[i] := i
   END
END InitCP;

PROCEDURE Init8(VAR cp: CP; VAR n: INTEGER; a, b, c, d, e, f, g, h: INTEGER);
BEGIN
  cp[n] := a; INC(n);
  cp[n] := b; INC(n);
  cp[n] := c; INC(n);
  cp[n] := d; INC(n);
  cp[n] := e; INC(n);
  cp[n] := f; INC(n);
  cp[n] := g; INC(n);
  cp[n] := h; INC(n);
END Init8;

PROCEDURE InitCP866(VAR cp: CP);
VAR n, i: INTEGER;
BEGIN
   FOR i := 0410H TO 043FH DO
     cp[i - 0410H + 80H] := i
   END;
   FOR i := 0440H TO 044FH DO
     cp[i - 0440H + 0E0H] := i
   END;

   n := 0B0H;
   Init8(cp, n, 2591H, 2592H, 2593H, 2502H, 2524H, 2561H, 2562H, 2556H);
   Init8(cp, n, 2555H, 2563H, 2551H, 2557H, 255DH, 255CH, 255BH, 2510H);
   Init8(cp, n, 2514H, 2534H, 252CH, 251CH, 2500H, 253CH, 255EH, 255FH);
   Init8(cp, n, 255AH, 2554H, 2569H, 2566H, 2560H, 2550H, 256CH, 2567H);
   Init8(cp, n, 2568H, 2564H, 2565H, 2559H, 2558H, 2552H, 2553H, 256BH);
   Init8(cp, n, 256AH, 2518H, 250CH, 2588H, 2584H, 258CH, 2590H, 2580H);

   n := 0F0H;
   Init8(cp, n, 0401H, 0451H, 0404H, 0454H, 0407H, 0457H, 040EH, 045EH);
   Init8(cp, n, 00B0H, 2219H, 00B7H, 221AH, 2116H, 00A4H, 25A0H, 00A0H);

   InitCP(cp)
END InitCP866;

PROCEDURE concat(VAR L: STRING; R: STRING);
VAR i, n, pos: INTEGER;
BEGIN
  n := LENGTH(R);
  i := 0;
  pos := LENGTH(L);
  WHILE (i <= n) & (pos < LEN(L)) DO
    L[pos] := R[i];
    INC(pos);
    INC(i)
  END
END concat;

PROCEDURE Utf8(VAR str: STRING);
VAR i: INTEGER; in, out, u: STRING;
BEGIN
  in := str;
  out := "";
  FOR i := 0 TO LENGTH(in) - 1 DO
    utf8(cp[ORD(in[i])], u);
    concat(out, u)
  END;
  str := out
END Utf8;

PROCEDURE ErrorMsg*(code: INTEGER; VAR msg: ARRAY OF CHAR);
VAR str: STRING;
BEGIN
  CASE code OF
  |  1: str := "ожидалась 'H' или 'X'"
  |  2: str := "ожидалась цифра"
  |  3: str := "строка не содержит закрывающей кавычки"
  |  4: str := "недопустимый символ"
  |  5: str := "целочисленное переполнение"
  |  6: str := "слишком большое значение символьной константы"
  |  7: str := "вещественное переполнение"
  |  8: str := "переполнение порядка вещественного числа"
  |  9: str := "вещественное антипереполнение"
  | 10: str := "слишком длинный идентификатор"
  | 11: str := "слишком длинная строковая константа"

  | 21: str := "ожидалось 'MODULE'"
  | 22: str := "ожидался идентификатор"
  | 23: str := "ожидалась ';'"
  | 24: str := "ожидалось 'END'"
  | 25: str := "ожидалась '.'"
  | 26: str := "идентификатор не совпадает с именем модуля"
  | 27: str := "неожиданный конец файла"
  | 28: str := "ожидалась ',', ';' или ':='"
  | 29: str := "ожидалась ',' или ';'"
  | 30: str := "идентификатор переопределен"
  | 31: str := "циклический импорт"
  | 32: str := "модуль не найден или ошибка доступа"
  | 33: str := "имя модуля не совпадает с именем файла модуля"
  | 34: str := "неправильный формат строки машинных кодов"
  | 35: str := "ожидалось '='"
  | 36: str := "синтаксическая ошибка в выражении"
  | 37: str := "операция не применима"
  | 38: str := "ожидалась ')'"
  | 39: str := "ожидалoсь 'ARRAY', 'RECORD', 'POINTER' или 'PROCEDURE'"
  | 40: str := "ожидалoсь 'TO'"
  | 41: str := "ожидалoсь 'OF'"
  | 42: str := "неопределенный идентификатор"
  | 43: str := "требуется переменная, процедура или строковая константа"
  | 44: str := "ожидалoсь 'cdecl', 'stdcall' или 'winapi'"
  | 45: str := "флаг вызова недопускается для локальных процедур"
  | 46: str := "деление на нуль"
  | 47: str := "требуется идентификатор типа-записи или типа-указателя"
  | 48: str := "целочисленное деление на нуль"
  | 49: str := "значение левого операнда вне диапазона 0..31"
  | 50: str := "флаг [winapi] доступен только для платформы Windows"
  | 51: str := "ожидалась '}'"
  | 52: str := "требуется выражение типа INTEGER"
  | 53: str := "значение выражения вне диапазона 0..31"
  | 54: str := "левая граница диапазона больше правой"
  | 55: str := "требуется константа типа CHAR"
  | 56: str := "ожидалась '('"
  | 57: str := "требуется выражение числового типа"

  | 59: str := "недостаточно параметров"
  | 60: str := "недопустимый параметр"
  | 61: str := "ожидалась ','"
  | 62: str := "требуется константное выражение"
  | 63: str := "требуется переменная"
  | 64: str := "файл не найден или ошибка доступа"
  | 65: str := "модуль RTL не найден"
  | 66: str := "требуется выражение типа REAL или LONGREAL"
  | 67: str := "невозможно создать файл, возможно файл открыт или диск защищен от записи"
  | 68: str := "требуется выражение типа CHAR, SET или BOOLEAN"
  | 69: str := "невозможно записать файл"
  | 70: str := "требуется выражение типа LONGREAL"
  | 71: str := "требуется выражение типа REAL"
  | 72: str := "недостаточно памяти для завершения компиляции"
  | 73: str := "процедура не возвращающая результат недопустима в выражениях"
  | 74: str := "значение выражения вне целочисленного диапазона"
  | 75: str := "рекурсивное определение константы"
  | 76: str := "значение выражения вне диапазона 0..255"
  | 77: str := "ожидался идентификатор типа"
  | 78: str := "длина типа-массива должна быть больше нуля"
  | 79: str := "ожидалось 'OF' или ','"
  | 80: str := "ожидался идентификатор типа-записи"
  | 81: str := "базовый тип типа-указателя должен быть записью"
  | 82: str := "тип результата процедуры не может быть записью или массивом"
  | 83: str := "размер типа слишком велик"
  | 84: str := "ожидался идентификатор или 'VAR'"
  | 85: str := "ожидалась ',' или ':'"
  | 86: str := "ожидалось 'END' или ';'"
  | 87: str := "идентификатор не совпадает с именем процедуры"

  | 89: str := "экспорт локального идентификатора недопустим"
  | 90: str := "тип ARRAY или RECORD недопустим"
  | 91: str := "требуется идентификатор вещественного типа"

  | 93: str := "размер данных слишком велик"
  | 94: str := "строка длины, отличной от 1 недопустима"
  | 95: str := "значение выражения должно быть в диапазоне 0..127"
  | 96: str := "недопустимое рекурсивное определение типа"
  | 97: str := "недостаточно вещественных регистров, упростите выражение"
  | 98: str := "ожидалось 'THEN'"
  | 99: str := "поле записи не найдено"
  |100: str := "метка дублирована"
  |101: str := "идентификатор типа недопустим в выражениях"
  |102: str := "требуется массив"
  |103: str := "ожидалoсь 'union' или 'noalign'"
  |104: str := "требуется указатель"
  |105: str := "требуется запись"
  |106: str := "требуется идентификатор типа-записи"
  |107: str := "требуется идентификатор типа-указателя"
  |108: str := "недопустимая охрана типа"
  |109: str := "ожидалась ']'"
  |110: str := "размерность открытого массива слишком велика"
  |111: str := "системные флаги требуют импорта модуля SYSTEM"
  |112: str := "расширение записи не может быть [noalign] или [union]"
  |113: str := "базовый тип записи не может быть [noalign] или [union]"
  |114: str := "несовместимый параметр"
  |115: str := "переменная доступна только для чтения"
  |116: str := "нельзя использовать локальную процедуру"
  |117: str := "требуется выражение типа BOOLEAN"
  |118: str := "ожидалось 'DO'"
  |119: str := "ожидалось 'UNTIL'"
  |120: str := "ожидалось ':='"
  |121: str := "расширение имени файла главного модуля должно быть 'ob07'"
  |122: str := "значение выражения не может быть равным нулю"
  |123: str := "'RETURN' недопустим в процедуре, не возвращающей результат"
  |124: str := "ожидалось 'RETURN'"
  |125: str := "тип выражения не соответствует типу результата процедуры"
  |126: str := "требуется идентификатор переменной"
  |127: str := "счетчик цикла FOR не должен быть параметром"
  |128: str := "тип переменной должен быть INTEGER"
  |129: str := "переменная должна быть локальной"
  |130: str := "нельзя использовать константу"
  |131: str := "несовместимость по присваиванию"
  |132: str := "вызов процедуры-функции допускается только в составе выражения"
  |133: str := "идентификаторы 'lib_init' и 'version' зарезервированы"

  |138: str := "тип переменной должен быть SET"

  |141: str := "требуется строка или символьный массив"

  |143: str := "требуется символьный массив"

  |145: str := "тип переменной должен быть POINTER"

  |149: str := "тип переменной должен быть REAL или LONGREAL"
  |150: str := "требуется строковая константа"

  |155: str := "ожидалась '(' или ':='"
  |156: str := "требуется выражение типа INTEGER или CHAR"
  |157: str := "ожидалась ':'"
  |158: str := "не найдена процедура в модуле RTL"
  |159: str := "нарушение границ массива"
  |160: str := "ожидался идентификатор константы"
  |161: str := "требуется константа типа INTEGER"
  END;
  IF H.OS = "LNX" THEN
    Utf8(str)
  END;
  COPY(str, msg)
END ErrorMsg;

BEGIN
  InitCP866(cp)
END ERRORS.