Программирование и анализ электрических цепей
Главная » Статьи » FreePascal
Внутри FreePascal Generics.Collections library (часть 3)

3. Доработка модуля Generics.Defaults

Как видно из таблице INITFINAL,приведенной в части 2, при инициализации программы вызываются конструкторы классов следующих типов: THashService<T: THashFactory>, TExtendedHashService<T: TExtendedHashFactory> и TOrdinalComparer<T, THashFactory>.

Рассмотрим в начале зависимости для классов THashService<T: THashFactory> и TExtendedHashService<T: TExtendedHashFactory>. Родительскими классами для них являются следующие два абстрактных класса:

  THashService = class(TComparerService)
  public
    class function LookupEqualityComparer(ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer; virtual; abstract;
  end;

  TExtendedHashService = class(THashService)
  public
    class function LookupEqualityComparer(ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer; override;
    class function LookupExtendedEqualityComparer(ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer; virtual; abstract;
  end;

Ограничивая видимость различных разделов спецификаторами видимости strict private и strict protected, были выявлены те методы классов THashService<T: THashFactory> и TExtendedHashService<T: TExtendedHashFactory>, которые вызываются вне этих классов:

  THashService<T: THashFactory> = class(THashService)
   ...  
  private
    class constructor Create;
  public
    class function LookupEqualityComparer(ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer; override;
  end;
   
  TExtendedHashService<T: TExtendedHashFactory> = class(TExtendedHashService)
   ...
  private
    class constructor Create;
  public
    class function LookupExtendedEqualityComparer(ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer; override;
  end;

В модуле Generics.Defaults настройка классов для реализации интерфейсов IEqualityComparer<T> и IExtendedEqualityComparer<T>, которые предосталяют функции хеширования, осуществляется только в следующих публичных методах классов THashService<T: THashFactory> и TExtendedHashService<T: TExtendedHashFactory>:

class function THashService<T>.LookupEqualityComparer(ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer;
class function TExtendedHashService<T>.LookupExtendedEqualityComparer( ATypeInfo: PTypeInfo; ASize: SizeInt): Pointer;

Такой механизм позволяет достаточно легко заменить инициализацию класса через конструктор класса на инициализацию в методе класса. Для этого выполним следующие модификации:

1. В базовом классе THashService добавляем следующую секцию

strict protected class var
   FInitiated: boolean;

2. В классах THashService<T: THashFactory> и TExtendedHashService<T: TExtendedHashFactory> заменяем конструктор
class constructor Create;
на метод
class procedure Init;

Код метода Init полностью совпадает с кодом конструктора Create, в конце добавляется строчка
FInitiated := true;

3. В самое функций LookupEqualityComparer и LookupExtendedEqualityComparer добавляем следующий фрагмент:

if not FInitiated then
   Init;

Компилируем и запускаем тестовую программу с использование класса TAnsiStringComparer — все работает, получаем следующие результаты:

"абвгде" hash code = 0xD16487C4

"абвгде" hash params = -1; 2
 -> list[1] = 0xD16487C4
 -> list[2] = 0x00000000
 -> list[3] = 0x00000000
 -> list[4] = 0x00000000
 -> list[5] = 0x00000000
 -> list[6] = 0x00000000

Equals "ABCDEF" "ABCDEF" == TRUE
Equals "ABCDEF" "abcdef" == FALSE

Результаты полностью совпадают с полученными при использовании класса TExtendedEqualityComparer<T> — см. часть 1.

Запуск программы с выводом отладочной информации дает следующий листинг:

<<<<<< TOrdinalComparer<T, THashFactory>.Create
    ClassName = TOrdinalComparer<System.AnsiString,Generics.Defaults.TDelphiQuadrupleHashFactory>
    T type -> AnsiString
    THashFactory type -> TDelphiQuadrupleHashFactory

    <<<<<< TExtendedEqualityComparer<T>.Default
        ClassName = TExtendedEqualityComparer<System.AnsiString>
        T type -> AnsiString
        AExtenedHashFactoryClass type -> TExtendedHashFactoryClass

        <<<<<< TExtendedHashService<T>.LookupExtendedEqualityComparer
            ClassName = TExtendedHashService<Generics.Defaults.TDelphiQuadrupleHashFactory>
            T type -> TDelphiQuadrupleHashFactory
            Self type name: TExtendedHashService<Generics.Defaults.TDelphiQuadrupleHashFactory>

            <<<<<< TExtendedHashService<T>.Init
                ClassName = TExtendedHashService<Generics.Defaults.TDelphiQuadrupleHashFactory>
                T type -> TDelphiQuadrupleHashFactory
            TExtendedHashService<T>.Init >>>>>>

            Result = 0x00461C9C
        TExtendedHashService<T>.LookupExtendedEqualityComparer >>>>>>

        Result = 0x00461C9C
        Result type -> IExtendedEqualityComparer$1$crcB76584A7
    TExtendedEqualityComparer<T>.Default >>>>>>

    FEqualityComparer         = 0x00461C9C
    FExtendedEqualityComparer = 0x00461C9C
TOrdinalComparer<T, THashFactory>.Create >>>>>>

<<<<<< TOrdinalComparer<T, THashFactory>.Create
    ClassName = TOrdinalComparer<System.UnicodeString,Generics.Defaults.TDelphiQuadrupleHashFactory>
    T type -> UnicodeString
    THashFactory type -> TDelphiQuadrupleHashFactory

    <<<<<< TExtendedEqualityComparer<T>.Default
        ClassName = TExtendedEqualityComparer<System.UnicodeString>
        T type -> UnicodeString
        AExtenedHashFactoryClass type -> TExtendedHashFactoryClass

        <<<<<< TExtendedHashService<T>.LookupExtendedEqualityComparer
            ClassName = TExtendedHashService<Generics.Defaults.TDelphiQuadrupleHashFactory>
            T type -> TDelphiQuadrupleHashFactory
            Self type name: TExtendedHashService<Generics.Defaults.TDelphiQuadrupleHashFactory>
            Result = 0x00461CA4
        TExtendedHashService<T>.LookupExtendedEqualityComparer >>>>>>

        Result = 0x00461CA4
        Result type -> IExtendedEqualityComparer$1$crcFF9B7487
    TExtendedEqualityComparer<T>.Default >>>>>>

    FEqualityComparer         = 0x00461CA4
    FExtendedEqualityComparer = 0x00461CA4
TOrdinalComparer<T, THashFactory>.Create >>>>>>

-------------- PASCAL MAIN --------------

<<<<<< TGStringComparer<T, THashFactory>.Ordinal
    ClassName = TAnsiStringComparer
    T type -> AnsiString
    THashFactory type -> TDelphiQuadrupleHashFactory
    FEqualityComparer         = 0x00461C9C
    FExtendedEqualityComparer = 0x00461C9C

    FOrdinal = 0x001F2AD8
    FOrdinal type -> TCustomComparer$1$crcB76584A7
    FOrdinal ClassName -> TGOrdinalStringComparer<System.AnsiString,Generics.Defaults.TDelphiQuadrupleHashFactory>
TGStringComparer<T, THashFactory>.Ordinal >>>>>>

<<<<<< TGOrdinalStringComparer<T, THashFactory>.GetHashCode
    ClassName = TGOrdinalStringComparer<System.AnsiString,Generics.Defaults.TDelphiQuadrupleHashFactory>
    T type -> AnsiString
    THashFactory type -> TDelphiQuadrupleHashFactory
    FEqualityComparer         = 0x00461C9C
    FExtendedEqualityComparer = 0x00461C9C
TGOrdinalStringComparer<T, THashFactory>.GetHashCode >>>>>>

"абвгде" hash code = 0xD16487C4

<<<<<< TGOrdinalStringComparer<T, THashFactory>.GetHashList
    ClassName = TGOrdinalStringComparer<System.AnsiString,Generics.Defaults.TDelphiQuadrupleHashFactory>
    T type -> AnsiString
    THashFactory type -> TDelphiQuadrupleHashFactory
    FEqualityComparer         = 0x00461C9C
    FExtendedEqualityComparer = 0x00461C9C
TGOrdinalStringComparer<T, THashFactory>.GetHashList >>>>>>

"абвгде" hash params = -1; 2
 -> list[1] = 0xD16487C4
 -> list[2] = 0x00000000
 -> list[3] = 0x00000000
 -> list[4] = 0x00000000
 -> list[5] = 0x00000000
 -> list[6] = 0x00000000

Equals "ABCDEF" "ABCDEF" == TRUE
Equals "ABCDEF" "abcdef" == FALSE

Видно, что на этапе инициализации программы выполняется вызов двух конструкторов класса TOrdinalComparer<T, THashFactory>, в которых выполняется специализация для типов AnsiString и UnicodeString и хешера TDelphiQuadrupleHashFactory. На этом этапе не выполняется ни одного вызова конструкторов классов THashService<T: THashFactory> и TExtendedHashService<T: TExtendedHashFactory>, которые выполнялись при инициализации программы до внесения наших изменений (см листинг в части 2). Виден лишь один вызов class procedure TExtendedHashService<T>.Init при первом обращении к методу class function TExtendedHashService<T>.LookupExtendedEqualityComparer.

В таблица INITFINAL остается лишь два вызова конструкторов класса для generic'ов модуля Generics.Defaults (выделены красным цветом), то есть внесенные изменения убрали вызовы 10-ти конструкторов по сравнению с исходной таблицей INITFINAL.

.section .data.n_INITFINAL,"d"
    .balign 4
.globl    INITFINAL
INITFINAL:
    .long    24,0
    .long    INIT$_$SYSTEM
    .long    0,0
    .long    FINALIZE$_$OBJPAS
    .long    INIT$_$LINEINFO
    .long    FINALIZE$_$LINEINFO
    .long    INIT$_$FPINTRES
    .long    0,0
    .long    FINALIZE$_$WINDIRS
    .long    SYSUTILS$_$TENCODING_$__$$_create
    .long    SYSUTILS$_$TENCODING_$__$$_destroy
    .long    INIT$_$SYSUTILS
    .long    FINALIZE$_$SYSUTILS
    .long    INIT$_$TYPINFO
    .long    FINALIZE$_$TYPINFO
    .long    INIT$_$CLASSES
    .long    FINALIZE$_$CLASSES
    .long    INIT$_$FPCADDS
    .long    0,0
    .long    FINALIZE$_$GETTEXT
    .long    INIT$_$LAZUTF8
    .long    FINALIZE$_$LAZUTF8
    .long    INIT$_$GENERICS.HASHES
    .long    0
    .long    INIT$_$VARIANTS
    .long    FINALIZE$_$VARIANTS
    .long    INIT$_$MYDEBUG
    .long    FINALIZE$_$MYDEBUG
    .long    GENERICS.DEFAULTS$_$TORDINALCOMPARER$2$CRC09680922_$__$$_create
    .long    0,0
    .long    GENERICS.DEFAULTS$_$TGSTRINGCOMPARER$2$CRC09680922_$__$$_destroy
    .long    GENERICS.DEFAULTS$_$TORDINALCOMPARER$2$CRC603AE4FA_$__$$_create
    .long    0,0
    .long    GENERICS.DEFAULTS$_$TGSTRINGCOMPARER$2$CRC603AE4FA_$__$$_destroy
    .long    0
    .long    GENERICS.DEFAULTS$_$TGISTRINGCOMPARER$2$CRC09680922_$__$$_destroy
    .long    0
    .long    GENERICS.DEFAULTS$_$TGISTRINGCOMPARER$2$CRC603AE4FA_$__$$_destroy
    .long    0
    .long    GENERICS.DEFAULTS$_$TGORDINALIUTF8STRINGCOMPARER$2$CRC09680922_$__$$_destroy
    .long    INIT$_$GENERICS.DEFAULTS
    .long    FINALIZE$_$GENERICS.DEFAULTS
    .long    INIT$_$P$TESTGCM
    .long    FINALIZE$_$P$TESTGCM

Для удаления вызовов конструкторов класса TOrdinalComparer<T, THashFactory> поступим аналогично описанному для классов THashService<T: THashFactory> и TExtendedHashService<T: TExtendedHashFactory>:

1. В базовом классе TOrdinalComparer<T, THashFactory> добавляем следующую секцию

strict protected class var
   FInitiated: boolean;

2. Также заменяем конструктор
class constructor Create;
на метод
class procedure Init;

Код метода Init полностью совпадает с кодом конструктора Create, в конце добавляется строчка
FInitiated := true;

3. Во всех классах–наследниках в функциях class function Ordinal: TCustomComparer<T> добавляем следующий фрагмент:

if not FInitiated then
   Init;

Листинг запуска тестовой программы с включенным выводом отладочной информации имеет следующий вид:

-------------- PASCAL MAIN --------------
<<<<<< TGStringComparer<T, THashFactory>.Ordinal
    ClassName = TAnsiStringComparer
    T type -> AnsiString
    THashFactory type -> TDelphiQuadrupleHashFactory
    FEqualityComparer         = 0x00000000
    FExtendedEqualityComparer = 0x00000000

    <<<<<< TOrdinalComparer<T, THashFactory>.Init
        ClassName = TAnsiStringComparer
        T type -> AnsiString
        THashFactory type -> TDelphiQuadrupleHashFactory

        <<<<<< TExtendedEqualityComparer<T>.Default
            ClassName = TExtendedEqualityComparer<System.AnsiString>
            T type -> AnsiString
            AExtenedHashFactoryClass type -> TExtendedHashFactoryClass

            <<<<<< TExtendedHashService<T>.LookupExtendedEqualityComparer
                ClassName = TExtendedHashService<Generics.Defaults.TDelphiQuadrupleHashFactory>
                T type -> TDelphiQuadrupleHashFactory
                Self type name: TExtendedHashService<Generics.Defaults.TDelphiQuadrupleHashFactory>

                <<<<<< TExtendedHashService<T>.Init
                    ClassName = TExtendedHashService<Generics.Defaults.TDelphiQuadrupleHashFactory>
                    T type -> TDelphiQuadrupleHashFactory
                TExtendedHashService<T>.Init >>>>>>

                Result = 0x00461CA0
            TExtendedHashService<T>.LookupExtendedEqualityComparer >>>>>>

            Result = 0x00461CA0
            Result type -> IExtendedEqualityComparer$1$crcB76584A7
        TExtendedEqualityComparer<T>.Default >>>>>>

        FEqualityComparer         = 0x00461CA0
        FExtendedEqualityComparer = 0x00461CA0
    TOrdinalComparer<T, THashFactory>.Init >>>>>>

    FOrdinal = 0x00082C78
    FOrdinal type -> TCustomComparer$1$crcB76584A7
    FOrdinal ClassName -> TGOrdinalStringComparer<System.AnsiString,Generics.Defaults.TDelphiQuadrupleHashFactory>
TGStringComparer<T, THashFactory>.Ordinal >>>>>>

<<<<<< TGOrdinalStringComparer<T, THashFactory>.GetHashCode
    ClassName = TGOrdinalStringComparer<System.AnsiString,Generics.Defaults.TDelphiQuadrupleHashFactory>
    T type -> AnsiString
    THashFactory type -> TDelphiQuadrupleHashFactory
    FEqualityComparer         = 0x00461CA0
    FExtendedEqualityComparer = 0x00461CA0
TGOrdinalStringComparer<T, THashFactory>.GetHashCode >>>>>>

"абвгде" hash code = 0xD16487C4

<<<<<< TGOrdinalStringComparer<T, THashFactory>.GetHashList
    ClassName = TGOrdinalStringComparer<System.AnsiString,Generics.Defaults.TDelphiQuadrupleHashFactory>
    T type -> AnsiString
    THashFactory type -> TDelphiQuadrupleHashFactory
    FEqualityComparer         = 0x00461CA0
    FExtendedEqualityComparer = 0x00461CA0
TGOrdinalStringComparer<T, THashFactory>.GetHashList >>>>>>

"абвгде" hash params = -1; 2
 -> list[1] = 0xD16487C4
 -> list[2] = 0x00000000
 -> list[3] = 0x00000000
 -> list[4] = 0x00000000
 -> list[5] = 0x00000000
 -> list[6] = 0x00000000

Equals "ABCDEF" "ABCDEF" == TRUE
Equals "ABCDEF" "abcdef" == FALSE

Таким образом удалось:

  1. 1. Удалить все вызовы конструкторов класса из этапа инициализации программы, где порядок их вызова был фактически неконтролируемым. Инициализацию необходимых классов перенесена на этап исполнения программы.
  2. 2. Удаление вызова конструкторов для неиспользуемых классов уменьшает размер программы примерно на 29 кбайт :).

К началу

Категория: FreePascal | Добавил: zoleg5763 (07.04.2019)
Просмотров: 259 | Рейтинг: 0.0/0
Всего комментариев: 0
Войдите:
avatar