OberonCore

Библиотека  Wiki  Форум  BlackBox  Компоненты  Проекты
Текущее время: Среда, 22 Ноябрь, 2017 10:12

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




Начать новую тему Ответить на тему  [ Сообщений: 33 ]  На страницу Пред.  1, 2
Автор Сообщение
 Заголовок сообщения: Re: Тотальный HandleMsg и базовый Object
СообщениеДобавлено: Вторник, 18 Февраль, 2014 13:03 

Зарегистрирован: Вторник, 29 Август, 2006 12:32
Сообщения: 2422
Откуда: Россия, Ярославль
А, это я прочитал в документации к ядру.
Цитата:
TYPE Type
[untagged]
Описатель типа данных. Хранит информацию о размере и структуре данных. Указатели на связанные процедуры типа находятся по отрицательным смещениям от описателя. Указатель на n-й метод находится по смещению - 4 * (n - 1).
Мне дальше непонятно, как ядро в случае финализатора догадывается, что нужно достать процедуру именно в тип
Код:
fin: PROCEDURE(this: ANYPTR);
и есть ли возможность догадаться про любой другой метод.


Вернуться к началу
 Профиль  
 
 Заголовок сообщения: Re: Тотальный HandleMsg и базовый Object
СообщениеДобавлено: Вторник, 18 Февраль, 2014 15:33 

Зарегистрирован: Вторник, 29 Август, 2006 12:32
Сообщения: 2422
Откуда: Россия, Ярославль
Провел исследование методом тыка.
Проверил сначала виртуальные таблицы, а потом процедуры модуля, в котором реализован тип.
Нашел соответствие, правда, странное, чтобы все выглядело корректно надо из адреса, которые возвращает процедура GetRefProc вычитать 3.
Я исходил из того предположения, что в виртуальной таблице адреса процедур корректные, так как финализатор стоял на своем положенном первом месте.
Код:
MODULE PrivMethods;
   IMPORT SYSTEM, Kernel, Log;
   
   TYPE
      T = POINTER TO ABSTRACT RECORD END;
      
      T0 = POINTER TO RECORD (T) END;
   
   PROCEDURE (t: T) Do, NEW, ABSTRACT;
   
   PROCEDURE (t: T0) Do;
   BEGIN
   
   END Do;
   
   PROCEDURE (t: T) HANDLE(VAR msg: ANYREC), NEW, ABSTRACT;
   
   PROCEDURE (t: T0) HANDLE(VAR msg: ANYREC);
   BEGIN
      
   END HANDLE;
   
   PROCEDURE (t: T0) FINALIZE;
   BEGIN END FINALIZE;
   
   PROCEDURE Do*;
      VAR t: T0; a, typ, ref, adr: INTEGER; i: INTEGER; name: Kernel.Name; mod: Kernel.Module;
      
      PROCEDURE Get(idx: INTEGER; OUT adr: INTEGER);
      BEGIN
         SYSTEM.GET(typ - 4*idx, adr); Log.Int(adr);
      END Get;
      
      PROCEDURE This(a: INTEGER; OUT name: Kernel.Name);
         VAR adr, ref: INTEGER;
      BEGIN
         ref:=mod.refs; adr:=1; name:='';
         WHILE (adr#0) & (name='') DO Kernel.GetRefProc(ref, adr, name); IF (adr+mod.code - 3 # a) THEN name:='' END END;
      END This;
      
   BEGIN
      NEW(t);
      typ:=SYSTEM.TYP(t);
      mod:=Kernel.TypeOf(t).mod;
      Log.Ln;
      Log.String('процедуры модуля'); Log.Ln;
      ref:=mod.refs; adr:=1;
      WHILE adr#0 DO Kernel.GetRefProc(ref, adr, name); Log.Int(adr+mod.code - 3); Log.Tab; Log.String(name$); Log.Ln END;
      Log.Ln;
      Log.String('адреса методов'); Log.Ln;
      a:=0; i:=1;
      REPEAT
         Log.Int(i); Get(i, a);
         IF a>0 THEN
            This(a, name); Log.Tab; Log.String(name$);
         END;
         INC(i);
          Log.Ln;
      UNTIL a=-1;
   END Do;
   
END PrivMethods.

PrivMethods.Do


Вывод такой:
Код:
процедуры модуля
 1643708878   $$
 1643708881   T0.Do
 1643708884   T0.HANDLE
 1643708887   T0.FINALIZE
 1643708924   Get
 1643709030   This
 1643709427   Do
 1643708877   typ

адреса методов
 1 1643708887   T0.FINALIZE
 2 1643708881   T0.Do
 3 1643708884   T0.HANDLE
 4 -1


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


Вернуться к началу
 Профиль  
 
 Заголовок сообщения: Re: Тотальный HandleMsg и базовый Object
СообщениеДобавлено: Вторник, 18 Февраль, 2014 21:28 

Зарегистрирован: Вторник, 29 Август, 2006 12:32
Сообщения: 2422
Откуда: Россия, Ярославль
Вторая итерация, научился искать метод (по всему дереву наследования типа), проверять его имя и набор параметров. Теперь перекидываю адрес метода в локальную переменную и пытаюсь вызвать. Получаю упавший ББ без трэпов и всего такого - просто падает.
Код:
MODULE PrivMethods;
   IMPORT SYSTEM, Kernel, Log, Strings; (* PrivMethodAbstract; *)
   
   TYPE
      T = POINTER TO ABSTRACT RECORD (* PrivMethodAbstract.T *) END;
      
      T0 = POINTER TO RECORD (T) END;
      
      TDesc = RECORD END;
      
      Msg = RECORD END;
      
   PROCEDURE (t: T) Do, NEW, ABSTRACT;
   
   PROCEDURE (t: T0) Do;
   BEGIN
   
   END Do;
   
   PROCEDURE (t: T) HANDLE(VAR msg: ANYREC), NEW, ABSTRACT;
   
   PROCEDURE (t: T0) HANDLE(VAR msg: ANYREC);
   BEGIN
      WITH msg: Msg DO Log.String('success')
      ELSE HALT(100) END;
   END HANDLE;
   
   PROCEDURE (t: T0) FINALIZE;
   BEGIN END FINALIZE;
   
   PROCEDURE (VAR t: TDesc) HANDLE(VAR msg: ANYREC), NEW;
   BEGIN
   
   END HANDLE;
   
   PROCEDURE Do*;
      CONST
         recPrint = 03X+0BX+03X+11X+0X;
         ptrPrint =  03X+0BX+01X+13X+0X;
         
      VAR t: T0;  td: TDesc;
      VAR type: Kernel.Type; i, len: INTEGER; typ, adr, ref: INTEGER; name: Kernel.Name;
      VAR mode, form: SHORTCHAR; d: Kernel.Type; x: INTEGER;
      VAR fprint: ARRAY 256 OF SHORTCHAR; ptrM: PROCEDURE (m: ANYPTR; this: T0); recM: PROCEDURE (VAR t: ANYREC; VAR msg: ANYREC);
      VAR msg: Msg;
      
      PROCEDURE NofMethods(typ: INTEGER): INTEGER;
         VAR a, i: INTEGER;
      BEGIN
         a:=0; i:=0;
         REPEAT
            SYSTEM.GET(typ - 4*i, a);
            INC(i);
         UNTIL a=-1;
         DEC(i);
      RETURN i
      END NofMethods;
      
      PROCEDURE ThisMethod(typ: INTEGER; idx: INTEGER; OUT adr: INTEGER);
      BEGIN
         ASSERT(idx>0, 20); ASSERT(idx<len, 21);
         SYSTEM.GET(typ - 4*idx, adr);
      END ThisMethod;
      
      PROCEDURE ThisName(mod: Kernel.Module; madr: INTEGER; OUT name: Kernel.Name; OUT ref: INTEGER);
         VAR adr: INTEGER; n: Kernel.Name;
      BEGIN
         ref:=mod.refs; adr:=0; n:=''; name:='';
         REPEAT
            IF (madr - mod.procBase) # adr THEN
               Kernel.GetRefProc(ref, adr, n); (* каждый раз  adrна выходе содержит адрес следующего элемента *)
            ELSE Kernel.GetRefProc(ref, adr, name); END;
         UNTIL (adr=0) OR (name#'');
      END ThisName;
      
      PROCEDURE Find(t: Kernel.Type; adr: INTEGER; OUT name: Kernel.Name; OUT ref: INTEGER);
         VAR tn: Kernel.Name; vs: ARRAY 256 OF CHAR; pos: INTEGER;
      BEGIN
         ThisName(t.mod, adr, name, ref);
         IF name$#'' THEN
            Kernel.GetTypeName(t, tn);
            IF tn[LEN(tn$)-1]='^' THEN tn[LEN(tn$)-1]:='.' ELSE tn:=tn+'.'; END; (* ^ означает разыменованый указатель, у рекордов ^ не бывает *)
            Strings.Find(name$, tn$, 0, pos);
            ASSERT(pos=0, 40);
            Strings.Extract(name$, LEN(tn$), LEN(name$), vs);
            name:=SHORT(vs$);
         ELSIF Kernel.LevelOf(t)>0 THEN Find(t.base[Kernel.LevelOf(t)-1], adr, name, ref) END;
      END Find;
      
   BEGIN
      NEW(t);
      type:=Kernel.TypeOf(t);
      typ:=SYSTEM.TYP(t);
      i:=1; len:=NofMethods(typ);
      WHILE (i<len) & (name$#'HANDLE') DO
         ThisMethod(typ, i, adr);
         Find(type, adr, name, ref);
         INC(i);
      END;
      IF name$='HANDLE' THEN
         fprint:=''; i:=0;
         REPEAT
            Kernel.GetRefVar(ref, mode, form, d, x, name);
            fprint[i]:=mode; fprint[i+1]:=form; fprint[i+2]:=0X; INC(i, 2);
         UNTIL mode=0X;
         IF fprint=ptrPrint THEN
            SYSTEM.GET(adr, ptrM);
            IF (ptrM#NIL) THEN ptrM(t, t); END;
         ELSIF fprint = recPrint THEN
            SYSTEM.GET(adr, recM);
            IF (recM#NIL) THEN recM(msg, td) END;
         ELSE HALT(0) END;
      END;
   END Do;
   
END PrivMethods.

PrivMethods.Do
В документации сказано про ссылки на процедуры. Я посмотрел, как вызывают финализатор в ядре, и повторил схему. Они просто берут значение в процедурную переменную из адреса метода. А оно падает.


Вернуться к началу
 Профиль  
 
 Заголовок сообщения: Re: Тотальный HandleMsg и базовый Object
СообщениеДобавлено: Вторник, 18 Февраль, 2014 22:19 

Зарегистрирован: Вторник, 29 Август, 2006 12:32
Сообщения: 2422
Откуда: Россия, Ярославль
Что-то я все равно не до конца понял.
Сделал SYSTEM.ADR(t.HANDLE) - адрес метода лежит рядом с адресом SYSTEM.ADR(t)
А адрес метода в виртуальной таблице намного больше.
Но смещение между S.ADR(t) и S.ADR(t.HANDLE) такое же, какое между mod.procBase и адресом вычисленным для процедуры PrivMethods.T0.HANDLE.
Но это все равно не помогло никак, даже код

Код:
VAR fin: PROCEDURE (this: ANYPTR);
<...>
SYSTEM.GET(SYSTEM.ADR(t.Do), fin);
fin(t);
вызывает падение. Непонятно.


Вернуться к началу
 Профиль  
 
 Заголовок сообщения: Re: Тотальный HandleMsg и базовый Object
СообщениеДобавлено: Вторник, 18 Февраль, 2014 23:40 

Зарегистрирован: Вторник, 29 Август, 2006 12:32
Сообщения: 2422
Откуда: Россия, Ярославль
Мда, не работает никак.


Вернуться к началу
 Профиль  
 
СообщениеДобавлено: Пятница, 21 Февраль, 2014 20:17 

Зарегистрирован: Пятница, 25 Ноябрь, 2005 12:02
Сообщения: 7712
Откуда: Троицк, Москва
Кстати, Гуткнехт осторожно одобрил название Oberon message bus для известного нам тут паттерна, введённого в Оберонах.


Вернуться к началу
 Профиль  
 
 Заголовок сообщения: Re: Тотальный HandleMsg и базовый Object
СообщениеДобавлено: Вторник, 20 Май, 2014 20:35 

Зарегистрирован: Вторник, 29 Август, 2006 12:32
Сообщения: 2422
Откуда: Россия, Ярославль
Вопрос остался нерешенным, есть ли способ получить указатель на метод и выполнить его?


Вернуться к началу
 Профиль  
 
 Заголовок сообщения: Re: Тотальный HandleMsg и базовый Object
СообщениеДобавлено: Вторник, 20 Май, 2014 21:59 
Модератор
Аватара пользователя

Зарегистрирован: Понедельник, 14 Ноябрь, 2005 18:39
Сообщения: 8867
Откуда: Россия, Орёл
Я думаю, что стоит пойти путём, когда обработкой HandleMsg для объектов модуля занимается экспортированная из модуля процедура HandleMsg, которая уже через WITH анализирует тип. Потому что тип может быть и неэкспортирован, тогда как искать у него метод HandleMsg? (технически в ББ можно по отладочной ref-информации, но это неверно концептуально).

Чтобы каждый раз её не искать, нужно в Kernel.Type хранить адрес этой процедуры.

Однако изменить Kernel.Type не так просто - все эти вещи подгружаются монолитом из кодового файла. Тогда к ядру, которое хочет доп. поля к типам Kernel, нужно менять StdLoader, чтобы он корректировал всё соотв. образом.


Вернуться к началу
 Профиль  
 
 Заголовок сообщения: Re: Тотальный HandleMsg и базовый Object
СообщениеДобавлено: Пятница, 23 Май, 2014 10:09 

Зарегистрирован: Вторник, 30 Июнь, 2009 14:58
Сообщения: 1427
Петр, можешь пояснить, что именно не получается?

Вот такой код работает:
Код:
MODULE PrivTest;

IMPORT
    SYSTEM, Log, Kernel;

TYPE
    T0 = RECORD END;
    P0 = POINTER TO T0;

PROCEDURE DescOf (IN x: ANYREC): Kernel.Type;
BEGIN
    RETURN SYSTEM.VAL(Kernel.Type, SYSTEM.TYP(x))
END DescOf;

PROCEDURE TypOf (struct: Kernel.Type): INTEGER;
BEGIN
    IF SYSTEM.VAL(INTEGER, struct) DIV 256 = 0 THEN
        RETURN SYSTEM.VAL(INTEGER, struct)
    ELSE
        RETURN 16 + struct.id MOD 4
    END
END TypOf;

(** T0 **)

PROCEDURE (VAR t: T0) Foo1 (x: INTEGER), NEW;
BEGIN
    Log.String("Rec.Foo"); Log.Int(x); Log.Ln;
END Foo1;

PROCEDURE (VAR t: T0) Foo2 (x: INTEGER), NEW;
BEGIN
    Log.String("Rec.Foo"); Log.Int(x); Log.Ln;
END Foo2;

PROCEDURE Do*;
TYPE
    Prc = PROCEDURE (VAR t: T0; x: INTEGER);
   
VAR
    v0: T0;
    p0: P0;
    n, adr: INTEGER;
    tag: Kernel.Type;
    prc: Prc;

BEGIN

    (** RECORD **)

    tag := DescOf(v0);
    adr := SYSTEM.VAL(INTEGER, tag);
   
    (* Rec.Foo1 *)
    n := 1;
    SYSTEM.GET(adr - 4 * (n + 1), prc);
    (* test *)
    v0.Foo1(1);
    prc(v0, 1);
   
    (* Rec.Foo2 *)
    n := 2;
    SYSTEM.GET(adr - 4 * (n + 1), prc);
    (* test *)
    v0.Foo2(2);
    prc(v0, 2);
   
    (** POINTER **)
   
    NEW(p0);
   
    tag := DescOf(p0);
    adr := SYSTEM.VAL(INTEGER, tag);
   
    (* Ptr.Foo1 *)
    n := 1;
    SYSTEM.GET(adr - 4 * (n + 1), prc);
    (* test *)
    p0.Foo1(1);
    prc(p0, 1);
   
    (* Ptr.Foo2 *)
    n := 2;
    SYSTEM.GET(adr - 4 * (n + 1), prc);
    (* test *)
    p0.Foo2(2);
    prc(p0, 2);
   
END Do;


END PrivTest.Do


Вернуться к началу
 Профиль  
 
 Заголовок сообщения: Re: Тотальный HandleMsg и базовый Object
СообщениеДобавлено: Пятница, 23 Май, 2014 11:33 

Зарегистрирован: Вторник, 29 Август, 2006 12:32
Сообщения: 2422
Откуда: Россия, Ярославль
Пётр Кушнир писал(а):
Код:
      PROCEDURE ThisMethod(typ: INTEGER; idx: INTEGER; OUT adr: INTEGER);
      BEGIN
         ASSERT(idx>0, 20); ASSERT(idx<len, 21);
         SYSTEM.GET(typ - 4*idx, adr);
      END ThisMethod;
Посмотрев на твой код, нашел ошибку в своём. adr который получают через SYSTEM.GET нужен для получения метаинформации о методе, а для получения ссылки на метод adr должен быть равен просто typ - 4*idx.

Теперь значит можно найти нужный метод у объекта, проверить, что он подходит по сигнатуре параметров и вызвать его.
С другой стороны, можно обойтись просто хэндлером на уровне модуля.


Вернуться к началу
 Профиль  
 
 Заголовок сообщения: Re: Тотальный HandleMsg и базовый Object
СообщениеДобавлено: Пятница, 23 Май, 2014 12:14 
Аватара пользователя

Зарегистрирован: Пятница, 25 Сентябрь, 2009 13:10
Сообщения: 1157
Откуда: Tel-Aviv
Таким образом код привязываете к 32-битной архитектуре.
Средствами Meta нельзя?


Вернуться к началу
 Профиль  
 
 Заголовок сообщения: Re: Тотальный HandleMsg и базовый Object
СообщениеДобавлено: Пятница, 23 Май, 2014 12:29 

Зарегистрирован: Вторник, 30 Июнь, 2009 14:58
Сообщения: 1427
Тут не то что к 32-битной архитектуре, а вообще к конкретной реализации привязано. :)


Вернуться к началу
 Профиль  
 
 Заголовок сообщения: Re: Тотальный HandleMsg и базовый Object
СообщениеДобавлено: Четверг, 21 Апрель, 2016 10:17 

Зарегистрирован: Пятница, 25 Ноябрь, 2005 12:02
Сообщения: 7712
Откуда: Троицк, Москва
Чтобы не забыть: на Вирте-80 я делал разыскания насчёт авторства шины сообщений в Обероне.

Результат: Юрг Гуткнехт.

Типа, "шина Гуткнехта".

Интересно, было ли до него что-то похожее и насколько.


Вернуться к началу
 Профиль  
 
Показать сообщения за:  Поле сортировки  
Начать новую тему Ответить на тему  [ Сообщений: 33 ]  На страницу Пред.  1, 2

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


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

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


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

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