OberonCore

Библиотека  Wiki  Форум  BlackBox  Компоненты  Проекты
Текущее время: Вторник, 19 Март, 2024 06:08

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




Начать новую тему Ответить на тему  [ Сообщений: 7 ] 
Автор Сообщение
 Заголовок сообщения: Отладочная консоль
СообщениеДобавлено: Вторник, 22 Август, 2006 13:38 
Модератор
Аватара пользователя

Зарегистрирован: Понедельник, 14 Ноябрь, 2005 18:39
Сообщения: 9459
Откуда: Россия, Орёл
Выкладываю полезный модуль - отладочное консольное окно. Очень полезно для ввода/вывода из ядра и других мест, где тот же StdLog неприменим...
Испольуется просто - при загрузке модуля автоматически откроется консольное окно. Вывод можно перенаправить в файл.
Код:
MODULE Terminal;
(**

   Console input / output
   (useful for low-level debugging)
   Author: Ilya Ermakov

**)
      
   IMPORT WinApi, S := SYSTEM;
   
   CONST
      charCode* = -1; decimal* = 10; hexadecimal* = -2; roman* = -3;
      digitspace* = 08FX;
      showBase* = TRUE; hideBase* = FALSE;
      minLongIntRev = "8085774586302733229";   (* reversed string of -MIN(LONGINT) *)
      ln = 0DX + 0AX;
      
   VAR
      in, out: WinApi.HANDLE;
      res, n: INTEGER;
      buf: ARRAY 1024 OF SHORTCHAR;
      digits: ARRAY 17 OF SHORTCHAR;
      cs: WinApi.CRITICAL_SECTION;
      
   PROCEDURE BeginAtomic* ;
   BEGIN
      WinApi.EnterCriticalSection(cs)
   END BeginAtomic;
   
   PROCEDURE EndAtomic* ;
   BEGIN
      WinApi.LeaveCriticalSection(cs)
   END EndAtomic;

   PROCEDURE IntToString (x: LONGINT; OUT s: ARRAY OF SHORTCHAR);
      VAR j, k: INTEGER; ch: SHORTCHAR; a: ARRAY 32 OF SHORTCHAR;
   BEGIN
      IF x # MIN(LONGINT) THEN
         IF x < 0 THEN s[0] := "-"; k := 1; x := -x ELSE k := 0 END;
         j := 0; REPEAT a[j] := SHORT(CHR(x MOD 10 + ORD("0"))); x := x DIV 10; INC(j) UNTIL x = 0
      ELSE
         a := minLongIntRev; s[0] := "-"; k := 1;
         j := 0; WHILE a[j] # 0X DO INC(j) END
      END;
      ASSERT(k + j < LEN(s), 23);
      REPEAT DEC(j); ch := a[j]; s[k] := ch; INC(k) UNTIL j = 0;
      s[k] := 0X
   END IntToString;
   
   PROCEDURE StringToInt (IN s: ARRAY OF SHORTCHAR; OUT x: INTEGER; OUT res: INTEGER);
      CONST hexLimit = MAX(INTEGER) DIV 8 + 1;
      VAR i, j, k, digits: INTEGER; ch, top: CHAR; neg: BOOLEAN; base: INTEGER;
   BEGIN
      res := 0; i := 0; ch := s[0];
      WHILE (ch # 0X) & (ch <= " ") OR (ch = 8BX) OR (ch = 8FX) OR (ch = 0A0X) DO   (* ignore leading blanks *)
         INC(i); ch := s[i]
      END;
      j := i; top := "0";
      WHILE (ch # 0X) & (ch # "H") & (ch # "X") & (ch # "%") DO
         IF ch > top THEN top := ch END;
         INC(j); ch := s[j]
      END;
      IF (ch = "H") OR (ch = "X") THEN
         x := 0; ch := s[i];
         IF ("0" <= ch) & (ch <= "9") OR ("A" <= ch) & (ch <= "F") THEN
            WHILE ch = "0" DO INC(i); ch := s[i] END;
            digits := 0;
            WHILE (res = 0) & (("0" <= ch) & (ch <= "9") OR ("A" <= ch) & (ch <= "F")) DO
               IF ch < "A" THEN k := ORD(ch) - ORD("0")
               ELSE k := ORD(ch) - ORD("A") + 10
               END;
               IF digits < 8 THEN
                  x := x MOD hexLimit;
                  IF x >= hexLimit DIV 2 THEN x := x - hexLimit END;
                  x := x * 16 + k; INC(i); ch := s[i]
               ELSE res := 1
               END;
               INC(digits)
            END;
            IF res = 0 THEN
               IF (ch # "H") & (ch # "X") OR (s[i+1] # 0X) THEN res := 2 END
            END
         ELSE res := 2
         END
      ELSE
         IF ch = "%" THEN
            INC(j); ch := s[j]; base := 0;
            IF ("0" <= ch) & (ch <= "9") THEN
               k := ORD(ch) - ORD("0");
               REPEAT
                  base := base * 10 + k;
                  INC(j); ch := s[j]; k := ORD(ch) - ORD("0")
               UNTIL (ch < "0") OR (ch > "9") OR (base > (MAX(INTEGER) - k) DIV 10);
               IF ("0" <= ch) & (ch <= "9") THEN base := 0 END
            END
         ELSE
            base := 10
         END;
         
         IF (base < 2) OR (base > 16) THEN
            res := 2
         ELSIF (base <= 10) & (ORD(top) < base + ORD("0"))
         OR (base > 10) & (ORD(top) < base - 10 + ORD("A")) THEN
            x := 0; ch := s[i]; neg := FALSE;
            IF ch = "-" THEN INC(i); ch := s[i]; neg := TRUE ELSIF ch = "+" THEN INC(i); ch := s[i] END;
            WHILE (ch # 0X) & (ch <= " ") DO INC(i); ch := s[i] END;
            IF ("0" <= ch) & (ch <= "9") OR ("A" <= ch) & (ch <= "F") THEN
               IF ch <= "9" THEN k := ORD(ch) - ORD("0") ELSE k := ORD(ch) - ORD("A") + 10 END;
               WHILE (("0" <= ch) & (ch <= "9") OR ("A" <= ch) & (ch <= "F")) & (res = 0) DO
                  IF x >= (MIN(INTEGER) + (base - 1) + k) DIV base THEN
                     x := x * base - k; INC(i); ch := s[i];
                     IF ch <= "9" THEN k := ORD(ch) - ORD("0") ELSE k := ORD(ch) - ORD("A") + 10 END
                  ELSE res := 1
                  END
               END
            ELSE res := 2
            END;
            IF res = 0 THEN
               IF ~neg THEN
                  IF x > MIN(INTEGER) THEN x := -x ELSE res := 1 END
               END;
               IF (ch # 0X) & (ch # "%") THEN res := 2 END
            END
         ELSE
            res := 2
         END
      END
   END StringToInt;
   
   PROCEDURE IntToStringForm (x: LONGINT; form, minWidth: INTEGER; fillCh: SHORTCHAR;
                                          showBase: BOOLEAN; OUT s: ARRAY OF SHORTCHAR);
      VAR base, i, j, k, si: INTEGER; mSign: BOOLEAN; a: ARRAY 128 OF SHORTCHAR;
            c1, c5, c10: SHORTCHAR;
   BEGIN
      ASSERT((form = charCode) OR (form = hexadecimal) OR (form = roman) OR ((form >= 2) & (form <= 16)), 20);
      ASSERT(minWidth >= 0, 22);
      IF form = charCode THEN base := 16
      ELSIF form = hexadecimal THEN base := 16
      ELSE base := form
      END;
      
      IF form = roman THEN
         ASSERT((x > 0) & (x < 3999), 21);
         base := 1000; i := 0; mSign := FALSE;
         WHILE (base > 0) & (x > 0) DO
            IF base = 1 THEN c1 := "I"; c5 := "V"; c10 := "X"
            ELSIF base = 10 THEN c1 := "X"; c5 := "L"; c10 := "C"
            ELSIF base = 100 THEN c1 := "C"; c5 := "D"; c10 := "M"
            ELSE c1 := "M"
            END;
            k := SHORT(x DIV base); x := x MOD base;
            IF k IN {4, 9} THEN a[i] := c1; INC(i) END;
            IF k IN {4 .. 8} THEN a[i] := c5; INC(i) END;
            IF k = 9 THEN a[i] := c10; INC(i)
            ELSIF k IN {1 .. 3, 6 .. 8} THEN
               j := k MOD 5;
               REPEAT a[i] := c1; INC(i); DEC(j) UNTIL j = 0
            END;
            base := base DIV 10
         END
      ELSIF (form = hexadecimal) OR (form = charCode) THEN
         i := 0; mSign := FALSE;
         IF showBase THEN DEC(minWidth) END;
         REPEAT
            a[i] := digits[x MOD base]; x := x DIV base; INC(i)
         UNTIL (x = 0) OR (x = -1) OR (i = LEN(a));
         IF x = -1 THEN fillCh := "F" END
      ELSE
         IF x < 0 THEN
            i := 0; mSign := TRUE; DEC(minWidth);
            REPEAT
               IF x MOD base = 0 THEN
                  a[i] := digits[0]; x := x DIV base
               ELSE
                  a[i] := digits[base - x MOD base]; x := x DIV base + 1
               END;
               INC(i)
            UNTIL (x = 0) OR (i = LEN(a))
         ELSE
            i := 0; mSign := FALSE;
            REPEAT
               a[i] := digits[x MOD base]; x := x DIV base; INC(i)
            UNTIL (x = 0) OR (i = LEN(a))
         END;
         IF showBase THEN DEC(minWidth);
            IF base < 10 THEN DEC(minWidth) ELSE DEC(minWidth,2) END
         END
      END;
      si := 0;
      IF mSign & (fillCh = "0") & (si < LEN(s)) THEN s[si] := "-"; INC(si); mSign := FALSE END;
      WHILE minWidth > i DO
         IF si < LEN(s) THEN s[si] := fillCh; INC(si) END;
         DEC(minWidth)
      END;
      IF mSign & (si < LEN(s)) THEN s[si] := "-"; INC(si) END;
      IF form = roman THEN
         j := 0;
         WHILE j < i DO
            IF si < LEN(s) THEN s[si] := a[j]; INC(si) END;
            INC(j)
         END
      ELSE
         REPEAT DEC(i);
            IF si < LEN(s) THEN s[si] := a[i]; INC(si) END
         UNTIL i = 0
      END;
      IF showBase & (form # roman) THEN
         IF (form = charCode) & (si < LEN(s)) THEN s[si] := "X"; INC(si)
         ELSIF (form = hexadecimal) & (si < LEN(s)) THEN s[si] := "H"; INC(si)
         ELSIF (form < 10) & (si < LEN(s)-1) THEN s[si] := "%"; s[si+1] := digits[base]; INC(si, 2)
         ELSIF (si < LEN(s) - 2) THEN
            s[si] := "%"; s[si+1] := digits[base DIV 10]; s[si+2] := digits[base MOD 10]; INC(si, 3)
         END
      END;
      IF si < LEN(s) THEN s[si] := 0X ELSE HALT(23) END
   END IntToStringForm;

   PROCEDURE String* (IN s: ARRAY OF SHORTCHAR);
   BEGIN
      res := WinApi.WriteFile(out, S.ADR(s), LEN(s$), n, NIL)
   END String;
   
   PROCEDURE Int* (x: LONGINT);
      VAR s: ARRAY 16 OF SHORTCHAR;
   BEGIN
      IntToString(x, s);
      res := WinApi.WriteFile(out, S.ADR(s), LEN(s$), n, NIL)
   END Int;

   PROCEDURE Hex* (x: LONGINT);
      VAR s: ARRAY 16 OF SHORTCHAR;
   BEGIN
      IntToStringForm(x, hexadecimal, 0, " ", TRUE, s);
      res := WinApi.WriteFile(out, S.ADR(s), LEN(s$), n, NIL)
   END Hex;
   
   PROCEDURE IntForm* (x: LONGINT; form, minWidth: INTEGER; fillCh: SHORTCHAR; showBase: BOOLEAN);
      VAR s: ARRAY 16 OF SHORTCHAR;
   BEGIN
      IntToStringForm(x, form, minWidth, fillCh, showBase, s);
      res := WinApi.WriteFile(out, S.ADR(s), LEN(s$), n, NIL)
   END IntForm;
   
   PROCEDURE Char* (c: SHORTCHAR);
   BEGIN
      res := WinApi.WriteFile(out, S.ADR(c), 1, n, NIL)
   END Char;
   
   PROCEDURE Ln* ;
   BEGIN
      res := WinApi.WriteFile(out, S.ADR(ln), LEN(ln), n, NIL)
   END Ln;
   
   PROCEDURE ReadString* (OUT s: ARRAY OF SHORTCHAR);
   BEGIN
      res := WinApi.ReadFile(in, S.ADR(buf), LEN(buf), n, NIL);
      s := buf$
   END ReadString;
   
   PROCEDURE ReadInt* (x: INTEGER);
   BEGIN
      res := WinApi.ReadFile(in, S.ADR(buf), LEN(buf), n, NIL);
      StringToInt(buf, x, res)
   END ReadInt;
   
   PROCEDURE ReadLn* ;
      VAR s: ARRAY 16 OF SHORTCHAR;
   BEGIN
      ReadString(s)
   END ReadLn;
   
   PROCEDURE AllocConsole;
      VAR res: INTEGER;
   BEGIN
      res := WinApi.AllocConsole();
      res := WinApi.SetConsoleCP(1251)
   END AllocConsole;
   
   PROCEDURE OpenStdOut;
   BEGIN
      AllocConsole;
      out := WinApi.CreateFile("CONOUT$", WinApi.GENERIC_READ + WinApi.GENERIC_WRITE, {}, NIL,
         WinApi.OPEN_EXISTING, {}, 0);
      res := WinApi.GetLastError()
   END OpenStdOut;
   
   PROCEDURE OpenStdIn;
   BEGIN
      AllocConsole;
      in := WinApi.CreateFile("CONIN$", WinApi.GENERIC_READ + WinApi.GENERIC_WRITE, {}, NIL,
         WinApi.OPEN_EXISTING, {}, 0)
   END OpenStdIn;
   
   PROCEDURE AssignOutput* (IN file: ARRAY OF CHAR);
      VAR res: INTEGER;
   BEGIN
      IF file # "" THEN
         out := WinApi.CreateFileW(file, WinApi.GENERIC_WRITE, WinApi.FILE_SHARE_READ +
            WinApi.FILE_SHARE_WRITE, NIL, WinApi.CREATE_ALWAYS, {}, 0);
(*         res := WinApi.SetFilePointer(out, 0, NIL, WinApi.FILE_END) *)
      ELSE
         OpenStdOut
      END
   END AssignOutput;

BEGIN
   WinApi.InitializeCriticalSection(cs);
   digits := "0123456789ABCDEF";
   IF out = 0 THEN
      OpenStdOut
   END;
   OpenStdIn
END Terminal.


Последний раз редактировалось Илья Ермаков Воскресенье, 26 Ноябрь, 2006 18:43, всего редактировалось 1 раз.

Вернуться к началу
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Суббота, 23 Сентябрь, 2006 23:10 
Аватара пользователя

Зарегистрирован: Вторник, 19 Сентябрь, 2006 21:54
Сообщения: 2449
Откуда: Россия, Томск
Интересно, что при закрытии окна консоли закрывается и основное приложение. Это как-то можно обойти? Не то чтобы мешает, просто неожиданно и несколько странно.


Вернуться к началу
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Воскресенье, 24 Сентябрь, 2006 02:00 
Модератор
Аватара пользователя

Зарегистрирован: Понедельник, 14 Ноябрь, 2005 18:39
Сообщения: 9459
Откуда: Россия, Орёл
К сожалению, обойти это никак нельзя - при создании консоли Винда привязывает ее к процессу как главное окно, при закрытии которого процесс завершается... Memento more :-)


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

Зарегистрирован: Понедельник, 14 Ноябрь, 2005 18:39
Сообщения: 9459
Откуда: Россия, Орёл
Вот дополнение к модулю Terminal - модуль трассировки, позволяющий в определенной контрольной точке вывести в консоль цепь активаций процедур, которая прошла через эту точку.
Пользоваться просто - в начале интересующих процедур пишем вызов - Trace.EntryPoint. Настраивать глубину просмотра активаций можно вызовом Trace.SetDepth. По умолчанию = 3.

Код:
MODULE Trace;

   IMPORT Kernel, T := Terminal, S := SYSTEM, WinApi;
   
   CONST
      FP = 5;
   
   VAR
      depth: INTEGER;

   PROCEDURE EntryPoint* ;
      VAR fp: INTEGER;
            ret: ARRAY 64 OF INTEGER;
            name: ARRAY 64 OF ARRAY 256 OF SHORTCHAR;
            mod: Kernel.Module;
            n, i: INTEGER;
            ref, end: INTEGER;
            s: Kernel.Name;
   BEGIN
      S.GETREG(FP, fp);
      FOR n := 0 TO depth-1 DO
         S.GET(fp+4, ret[n]); S.GET(fp, fp)
      END;
      mod := Kernel.modList;
      n := 0;
      WHILE (mod # NIL) & (n < depth) DO
         FOR i := 0 TO depth-1 DO
            IF( mod.code < ret[i]) & (ret[i] < mod.code + mod.csize) THEN
               name[i] := mod.name$;
               ref := mod.refs;
               REPEAT Kernel.GetRefProc(ref, end, s) UNTIL (end = 0) OR (ret[i]-mod.code < end);
               IF ret[i]-mod.code < end THEN
                  name[i] := name[i] + "." + s
               END;
               INC(n)
            END
         END;
         mod := mod.next
      END;
      T.BeginAtomic;
      T.Int(WinApi.GetCurrentThreadId()); T.String(": ");
      FOR i := 0 TO depth-1 DO
         T.String(name[i]); T.String(" << ")
      END;
      T.Ln;
      T.EndAtomic
   END EntryPoint;
   
   PROCEDURE SetDepth* (d: INTEGER);
   BEGIN
      ASSERT(d < 64, 20);
      depth := d
   END SetDepth;
   
BEGIN
   depth := 3   
END Trace.


Вернуться к началу
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Воскресенье, 26 Ноябрь, 2006 01:44 
Аватара пользователя

Зарегистрирован: Пятница, 25 Ноябрь, 2005 12:02
Сообщения: 8500
Откуда: Троицк, Москва
Илья Ермаков писал(а):
Memento more :-)


Memento mori. :wink:


Вернуться к началу
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Воскресенье, 26 Ноябрь, 2006 11:37 
Модератор
Аватара пользователя

Зарегистрирован: Понедельник, 14 Ноябрь, 2005 18:39
Сообщения: 9459
Откуда: Россия, Орёл
Зело слаб в латыни :-)


Вернуться к началу
 Профиль  
 
 Заголовок сообщения: FromOGU
СообщениеДобавлено: Вторник, 28 Ноябрь, 2006 17:09 

Зарегистрирован: Вторник, 11 Апрель, 2006 19:46
Сообщения: 12
Илья Ермаков писал(а):
К сожалению, обойти это никак нельзя - при создании консоли Винда привязывает ее к процессу как главное окно, при закрытии которого процесс завершается... Memento more :-)

Извратно, но можно.


Вернуться к началу
 Профиль  
 
Показать сообщения за:  Поле сортировки  
Начать новую тему Ответить на тему  [ Сообщений: 7 ] 

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


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

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


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

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