Sergey Antonov Blog

Moscow and SAP

2011-12-19T12:28:00.001-08:00

Now, working in Moscow.
SAP, ABAP, JAVA, Javascript, VBA.

P.S. at night I'm working on YAR.

Working on function inlining

2011-04-16T04:11:00.000-07:00

Working on function inlining

Parallel front-end, Units and other tasks

2011-02-24T05:16:00.000-08:00

Now working on 5 tasks

1. Support Units.
2. Forward types using without predeclaring.
3. Cross units references resolving with cycles too.
4. Parallel front-end to process units simultaneously.
5. Extend .NET back-end to support units.

Changes to POINTERMATH

2011-02-03T21:45:00.000-08:00

Now the operator[] of typed pointer returns the dereferenced pointer to type(ref to value).

Thanks to DiamondShark.

A sample

program myprogram;

procedure pf < T> (cnt:integer);
p:pointer;
ptype:^T;
valueA:T;
i:integer;
begin
GetMem(p,cnt*sizeof(T));
ptype:=p;
for i:=0 to cnt-1 do ptype[i]:=valueA;
FreeMem(p);
end;

begin
pf < boolean> (100);
pf < integer> (200);
pf < double> (300);
end

Getmem, Freemem, Pointer math

2011-02-02T05:49:00.000-08:00

YAR language is enhanced by supporting Getmem, Freemem and pointer math.
Sample

program myprogram;

procedure dosample();
p:pointer;
pinteger:^integer;
i:integer;
begin
GetMem(p,400);
pinteger:=p;
for i:=0 to 99 do pinteger[i]^:=i;
for i:=0 to 99 do write pinteger[i]^;
FreeMem(p);
end;

begin
dosample();
end

YARCC in the wild

2011-01-25T05:47:00.000-08:00

Mutable string and pinned managed objects

2011-01-24T04:22:00.000-08:00

Added String type to YAR

sample

program myprogram;

procedure abc();
a:string;
i:integer;
begin
a:='abcdefghij';
for i:=0 to a.length()-1 do a[i]:='1';
write a;
end;

begin
abc();
end

=>

.assembly extern mscorlib { auto }
.assembly project {}
.method public static void main() cil managed
{
.entrypoint
call void abc()
ret
}
.method public static void abc() cil managed
{
.locals init(int32 _autoname0,string pinned a,int32 i)
ldstr "abcdefghij"
stloc a
ldc.i4 0
stloc i
ldloc a
callvirt instance int32 [mscorlib]System.String::get_Length()
ldc.i4 1
sub
stloc _autoname0
Label0:
ldloc i
ldloc _autoname0
cgt
brtrue Label1
ldloc a
conv.i
call int32 [mscorlib]System.Runtime.CompilerServices.RuntimeHelpers::get_OffsetToStringData()
add
ldloc i
ldc.i4 2
mul
add
conv.i
ldc.i4 49
stobj char
ldloc i
ldc.i4 1
add
stloc i
br Label0
Label1:
ldloc a
call void [mscorlib]System.Console::Write(string)
ret
}

YAR: Added explicit type cast

2010-12-22T22:42:00.000-08:00

a:integer;
d:double;

begin
...
d:=a; //Implicit
d:=double(a); //Explicit

But! I am still thinking about the syntax for declaring new implicit or explicit operators: Delphi or Free Pascal like. :)

YAR: Enhance syntax of [ ] array operator

2010-12-22T00:47:00.000-08:00

Now support [.. , ..]

A sample

integerarrarr:Myrecord[6][3][5][3][3][6];

integerarrarr[1,1,2][1][1,2].c[1]:=abc().a;

YAR and static arrays

2010-12-07T12:34:00.000-08:00

Working on support static arrays in YAR.
The shortest sample

program Helloworld;

integerarr:integer[6];

begin
integerarr[2]:=1;
end

=>

.assembly extern mscorlib { auto }
.assembly project {}
.field public static int32* integerarr

.method static public void main() cil managed
{
.entrypoint
ldc.i4 28
localloc
stsfld int32* integerarr
ldsfld int32* integerarr
ldc.i4 2
ldc.i4 4
mul
add
ldc.i4 1
stind.i4
ret
}

YAR Update: Importing external function

2010-12-05T13:52:00.001-08:00

Yar supports now for

import external functions

sample

program Helloworld;

function importedfunc(var a:integer):integer;external library=mydll name=importfunc;

GField:integer;

begin
GField:=1;
write importedfunc(GField);
end

=>

.assembly extern mscorlib { auto }
.assembly project {}
.field public static int32 GField

.method static public void main() cil managed
{
.entrypoint
ldc.i4 1
stsfld int32 GField
ldsflda int32 GField
call int32 importedfunc(int32& a)
call void [mscorlib]System.Console::Write(int32)
ret
}

.method public static pinvokeimpl("mydll.dll" as "importfunc" winapi)
int32 importedfunc(int32& a) cil managed preservesig
{}

YAR: records with methods

2010-12-03T03:49:00.000-08:00

Syntax:

program Helloworld;

Myrecord=record
c:integer;
function abc(a:integer):integer;
begin
self.c:=a;
result:=self.c;
end;
end;

mr:Myrecord;

function Func(var a:Myrecord):integer;
begin
a.c:=4;
write mr.c;
a.abc(5);
write a.c;
result:=6;
end;

begin
Func(mr);
end

.NET BackEnd:

.assembly extern mscorlib { auto }
.assembly project {}
.class public sealed Myrecord extends [mscorlib]System.ValueType
{
.field public static int32 c
.method public instance int32 abc(int32 a) cil managed
{
ldarg.0
ldarg a
stfld int32 .this::c
ldarg.0
ldfld int32 .this::c
ret
}
}
.field public static valuetype Myrecord mr

.method static public void main() cil managed
{
.entrypoint
ldsflda valuetype Myrecord mr
call int32 Func( valuetype Myrecord& a)
pop
ret
}

.method static public int32 Func( valuetype Myrecord& a) cil managed
{
ldarg a
ldc.i4 4
stfld int32 Myrecord::c
ldsflda valuetype Myrecord mr
ldfld int32 Myrecord::c
call void [mscorlib]System.Console::Write(int32)
ldarg a
ldc.i4 5
call instance int32 Myrecord::abc(int32 a)
pop
ldarg a
ldfld int32 Myrecord::c
call void [mscorlib]System.Console::Write(int32)
ldc.i4 6
ret
}

Added @ and ^ operators

2010-11-08T01:44:00.000-08:00

I have just added.

begin
pinteger:=@mr.c;
a:=pinteger^;
mr.c:=@a^;
end

=>

.entrypoint
ldsflda valuetype Myrecord mr
ldflda int32 Myrecord::c
stsfld int32* pinteger
ldsfld int32* pinteger
ldobj int32
stsfld int32 a
ldsflda valuetype Myrecord mr
ldsflda int32 a
ldobj int32
stfld int32 Myrecord::c
ret

Test YAR Type inference

2010-11-03T12:11:00.000-07:00

Todays working sample

function abc < T,U > (a:T):^U;
begin
end

pinteger:^integer;
d:double;

pinteger:=abc(d);

=> T=double
=> U=integer

So generic operators like @, [], sizeof .. to come very soon.

YAR and Type inference

2010-11-02T02:40:00.000-07:00

Working on support Type Inference in YAR.
A sample:

mr:Myrecord;
a,b:integer;
d:double;

function GenericFunc < T, U , Z> (var a:T;b:U):Z;
begin
end;
..
begin
GenericFunc(a,a):=d; //I know this function result is not a lvalue.
//I relax the assign op type checking rules
//to test of infering of result type

Процесс рефакторинга

2010-10-27T23:40:00.000-07:00

Сам по себе процесс продвигался достаточно безболезненно, однако долго.
Приятно, что планируемые изменения в целом концептуально гладко уложились с текущей структурой компилятора. Однако переименование типов и небольшое изменение их зоны отвественности("утрясание" иерархий классов) отняли большую часть времени. Но в целом остался доволен, хотя и утомительное это занятие заниматься не делом.

Время для рефакторинга

2010-10-12T22:10:00.000-07:00

Достаточно сложно считать на несколько шагов вперед, хотя и очень интересно. Не всегда удается выбрать баланс между выразительностью и скоростью на ранних этапах, да и просто порой принятые решения по проектированию на ранних этапах в меньшей степени предусмотрены для задач для более поздних. Хотя технически работать можно и в рамках текущих проектных решений, однако это требует лишних движений, что отвлекает от решения текущих подзадач.

Added Procedural Types

2010-10-07T05:18:00.000-07:00

Added procedural Types to YAR Language
Extend .NET codegen by MSIL calli instruction

Sample

TMyFunc=function(a:integer):integer;
TXfunc=function(var a:double):TMyFunc;

function abc(a:integer):integer;
begin
result:=a;
end;

function abc(var a:double):TMyFunc;
begin
result:=abc;
end;

e:double;
f:integer;
g:TXfunc;

begin
g:=abc;
f:=g(e)(f);
end

=>

.method static public void main() cil managed
{
.entrypoint
ldftn native int abc(float64& a)
stsfld native int g
ldsfld int32 f
ldsflda float64 e
ldsfld native int g
calli native int (float64& a)
calli int32 (int32 a)
stsfld int32 f
ret
}

Supporting dot operator for .NET backend

2010-10-05T04:17:00.000-07:00

A sample

program Helloworld;

MyrecordStuff=record
a:integer;
b:integer;
c:boolean;
d:double;
f:double;
end;

Myrecord=record
a,b,c:integer;
private
d:integer;
f:integer;
public
pp:MyrecordStuff;
end;

function abc(var a:integer):integer;
begin
a:=1;
result:=5;
end;

function abc(var a:MyrecordStuff):integer;
begin
a.a:=7;
result:=5;
end;

a,b,c,d:Myrecord;
e:double;
f:integer;
begin
abc(a.a);
abc(a.pp.a);
e:=a.pp.d;
a.pp.a:=f;
a.pp.a:=a.pp.b;
write abc(a.pp);
write a.pp.a;
end

Generated MSIL code

.assembly extern mscorlib { auto }
.assembly project {}
.class public sealed MyrecordStuff extends [mscorlib]System.ValueType
{
.field public static int32 b
.field public static float64 f
.field public static int32 a
.field public static bool c
.field public static float64 d
}
.class public sealed Myrecord extends [mscorlib]System.ValueType
{
.field private static int32 f
.field private static int32 d
.field public static int32 b
.field public static int32 a
.field public static int32 c
.field public static valuetype MyrecordStuff pp
}
.field public static valuetype Myrecord b
.field public static float64 e
.field public static valuetype Myrecord a
.field public static int32 f
.field public static valuetype Myrecord c
.field public static valuetype Myrecord d

.method static public void main() cil managed
{
.entrypoint
ldsflda valuetype Myrecord a
ldflda int32 Myrecord::a
call int32 abc(int32& a)
pop
ldsflda valuetype Myrecord a
ldflda valuetype MyrecordStuff Myrecord::pp
ldflda int32 MyrecordStuff::a
call int32 abc(int32& a)
pop
ldsflda valuetype Myrecord a
ldflda valuetype MyrecordStuff Myrecord::pp
ldfld float64 MyrecordStuff::d
stsfld float64 e
ldsflda valuetype Myrecord a
ldflda valuetype MyrecordStuff Myrecord::pp
ldsfld int32 f
stfld int32 MyrecordStuff::a
ldsflda valuetype Myrecord a
ldflda valuetype MyrecordStuff Myrecord::pp
ldsflda valuetype Myrecord a
ldflda valuetype MyrecordStuff Myrecord::pp
ldfld int32 MyrecordStuff::b
stfld int32 MyrecordStuff::a
ldsflda valuetype Myrecord a
ldflda valuetype MyrecordStuff Myrecord::pp
call int32 abc( valuetype MyrecordStuff& a)
call void [mscorlib]System.Console::Write(int32)
ldsflda valuetype Myrecord a
ldflda valuetype MyrecordStuff Myrecord::pp
ldfld int32 MyrecordStuff::a
call void [mscorlib]System.Console::Write(int32)
ret
}

.method static public int32 abc(int32& a) cil managed
{
ldarg a
ldc.i4 1
stind.i4
ldc.i4 5
ret
}

.method static public int32 abc( valuetype MyrecordStuff& a) cil managed
{
ldarg a
ldc.i4 7
stfld int32 MyrecordStuff::a
ldc.i4 5
ret
}

Deferred assign of type constructor

2010-09-29T01:19:00.000-07:00

Working on support syntax like:

TFUNC < T > =function (a:TFUNC < Integer > ):T;

Code generation for YAR polymorphic methods

2010-09-21T04:25:00.000-07:00

Added for .NET backend.

All process consists of :

YAR => semantic tree => call codegen(Semantic tree, .NET backend) => IL ASM

Here is a sample:

YAR
function abc < T,U,Z > (a:integer;b:U):Z;
c,d:T;
e:Z;
f:U;
begin
c:=d;
f:=b;
result:=e;
end;

=>

IL ASM

.method static public !!Z abc < T,U,Z > (int32 a,!!U b) cil managed
{
.locals init(!!U f,!!Z e,!!T c,!!T d)
ldloc d
stloc c
ldarg b
stloc f
ldloc e
ret
}

Обновление синтаксического анализатора YAR и проверка типов

2010-09-13T05:01:00.000-07:00

Разбор YAR построен на восходящем синтаксическом анализаторе. И при использовании
символов < и > для указания параметров типов создаются конфликты в состояниях анализатора. После некоторых манипуляций в синтаксический анализатор YAR добавлен механизм для устранения таких конфликтов. То есть выражения вида TList < tlist < t,z,u >,TList < t,z,tlist < z > > > и A < 5 будут успешно разрешены.

Механизм проверки типов также корректно проверят unbound параметры, считая их только самосовместимыми.

function abc < t,u,z >(a:integer;b:U):Z;
c,d:T;
e:Z;
f:U;
begin
c:=d;
f:=b;
result:=e;
end;

Кодогенератор и BackEnd для .NET будет расширен, как только будет закончена работа в front-end части.

Обновление YAR

2010-08-24T05:31:00.000-07:00

+Переиспользование совместимых и свободных временных переменных

Обновление YAR

2010-08-23T22:25:00.000-07:00

+Неявное приведение типов
+Конструкция if
+Цикл for
+Цикл while
+Цикл repeat

Обновление YAR

2010-08-14T10:03:00.000-07:00

-Добавлена оптимизация в работе операторов +, *, -, <, <=, =, <>, >=, > при операндах константах.
Код вычислений не генерируется.
-Оптимизировано вычисление предиката конструкции if и генерация кода аналогично.
Автоматически распространится на все Backend'ы.

YAR.NET in the wild

2010-08-04T04:57:00.001-07:00

Working with .NET unmanaged API.

2010-07-09T00:20:00.000-07:00

I started translating cor.h corhdr.h to pas analogues yesterday.
Today I'm testing the results. 5 min a normal fly. :)

Fabio(Fitzroy Heslop) and Liquid funk

2010-05-31T23:52:00.000-07:00

Thank you, Fabio.

Working on Virtual Machine

2010-05-27T22:52:00.001-07:00

So just few steps:

1. Read some stuff
2. JVM or CLR Like?
I prefer MSIL for its universal untype load and store operations.
3. Implement it.

Gathering and mixing

2010-04-25T22:29:00.000-07:00

Enhancing systax for support: Structs, objects and parametrized types

Refine YAR Type System

2010-04-06T23:32:00.000-07:00

Working.

Just Any type Delphi Case statement

2010-04-02T04:39:00.000-07:00

Just Any type Delphi Case statement

Here is the implementation.

TPAIRTYPE[T]=record
Value:T;
Proc:TProc;
end;

CaseAnyTypeClassSupport[T]=class
private
class function GetCaseOption(Value:T;Action:TProc):TPAIRTYPE[T];static;
public
class procedure MyCase(const Value:T;const Pairs:array of TPAIRTYPE[T];ElseProc:TProc=nil);static;
class property CaseOption[Value:T;Action:TProc]:TPAIRTYPE[T] read GetCaseOption;default;
end;

uses generics.defaults;

class procedure CaseAnyTypeClassSupport[T].MyCase(const Value:T;const Pairs:array of TPAIRTYPE[T];ElseProc:TProc=nil);
var Pair:TPAIRTYPE[T];
Comparer:IComparer[T];
begin
Comparer:=TComparer[T].Default;
for Pair in Pairs do
if Comparer.Compare(Value,Pair.Value)=0 then
begin
Pair.Proc();
exit;
end;
if Assigned(ElseProc) then ElseProc();
end;
class function CaseAnyTypeClassSupport.GetCaseOption(Value:T;Action:TProc):TPAIRTYPE[T];
begin
Result.Value:=Value;
Result.Proc:=action;
end;

and a usage

procedure TForm2.FormCreate(Sender: TObject);
var Stuff:CaseAnyTypeClassSupport[string];
begin
Stuff.MyCase('2',
[
Stuff['4',procedure
begin
showmessage('Option 1');
end],
Stuff['2',procedure
begin
showmessage('Option 2');
end]
],procedure
begin
showmessage('Else option');
end);
end;

Because of restriction of Delphi compiler you could not write usage like this

with stuff do
MyCase('2',
[
['4',procedure
begin
showmessage('Option 1');
end],
['2',procedure
begin
showmessage('Option 2');
end]
],procedure
begin
showmessage('Else option');
end);
end;

You can enhance MyCase for supports variance types(type with subtypes) the same way.

The proof of the soundness of type system

2010-02-05T11:23:00.000-08:00

Reading.

Fixed point combinators and Existential type

2010-02-03T04:01:00.000-08:00

After adapting mind to functional programming style I have comprehended that stuff.

The Polymorphic Lambda Calculus

2010-01-21T01:43:00.000-08:00

Reading.

Type lambda calculus

2010-01-19T22:17:00.000-08:00

Reading.

Subtype, Variance, Mutable Types

2010-01-15T04:18:00.000-08:00

Reading.

Polymorphism.

2010-01-12T13:40:00.000-08:00

There was my last day of annual leave yesterday.

bounded polymorphism,
F-bounded polymorphism,
match-bounded polymorphism

It is bedtime.

About syntax analizer in YAR Language

2009-11-21T13:35:00.001-08:00

The YAR language syntax analizer supports for parsing methods:

-LL(1)
-CYK
-SLR,
-CLR(1)
-LARL(1)
-Simple precedence
-Operator precedence
-My extension for CLR method. I call it ECLR(1) method.

But YAR language now is being parsed by LARL(1) method.

Here is the semantic action sample

TTokenSequence.create(PNS_EXPR,[PTS_CONST_EXP_STRING],'',
function(LRAnalizer:TLRAnalizer):pointer
var value:TExprState;
begin
value.value:=LRAnalizer.StackValue[0].Lexeme;
value.ExprStateItem.TypeDesc:=StringTypeDesc;
PNS_EXPR.AttribitesList.Add(value);
result:=nil;
end
);

YAR Language enhancement

2009-11-13T03:33:00.000-08:00

Now Supports for
-Integer,Float,String,Char,Boolean types
-Type inference
-Operator and functions overloads

Type system, Type Theory.

2009-11-03T12:48:00.000-08:00

Deep in Type system, Type Theory.

Program language name

2009-10-26T11:58:00.001-07:00

I choose the language name. So I call it YAR.

Here is the code sample that was succesfully executed today.
program Helloworld;
var a,b,c:integer;
d,ec,fg:float;
j,z,i:integer;
begin
a:=123;
b:=a;
write b;
write a+2*b;
c:=a+2*(b+2);
write c;
b:=321;
a:=c+100*2-a/(b-100)*200/300-400;
write a;
end

Still hard working on compiler

2009-07-20T04:56:00.000-07:00

I am still hard working on compiler in my free time.
And more more with my son Yaroslav.

For russian fellow Maaacheba or getting method name dynamically

2009-02-16T23:46:00.000-08:00

It is still a draft implementation,
but it can be extended for other x86 opcodes.
So it is a base idea.
And it can be extended to support dynamic methods invocation.

TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
Published
procedure StaticMethod;
procedure VirtualMethod(a,b,c,d:integer);virtual;
end;

THelper= class helper for Tobject
function GetMethodAddress:pointer;
end;

implementation

type
PPDWORD=^PDWORD;

function AnalizeCallMethod(Self:PPDWORD;ReturnAddress:pbyte;SomePlaceInTheMethodCode:pointer):DWORD;
var Operation:DWORD;
VMT:PDWORD;
Offset:Integer;
begin
{$POINTERMATH ON}
//Virtual Call
Operation:=DWORD((@ReturnAddress[-6])^) AND $FF;
case Operation of
$FF:
begin
VMT:=Self[0];
Offset:=DWORD((@ReturnAddress[-4])^);
result:=DWORD((@(Pbyte(VMT)[Offset]))^);
exit;
end;
end;
Operation:=DWORD((@ReturnAddress[-5])^) AND $E8;
//Static Call
case Operation of
$E8:
begin
result:=DWORD(ReturnAddress)+DWORD((@ReturnAddress[-4])^);
exit;
end;
end;
{$POINTERMATH OFF}
end;

{ THelper }

function THelper.GetMethodAddress: pointer;
asm
mov edx,[ebp+04];
mov ecx,[esp];
Call AnalizeCallMethod;
end;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
StaticMethod;
VirtualMethod(1,2,3,4);
end;

procedure TForm1.StaticMethod;
begin
showmessage(MethodName(GetMethodAddress));
end;

procedure TForm1.VirtualMethod(a,b,c,d:integer);
begin
showmessage(MethodName(GetMethodAddress));
end;

How to get Entry Point of Method Address Dynamically? No problem

2007-11-15T08:16:00.000-08:00

In some cases (may be some sort of code injecting for constructive needs) there is a necessity for getting Method Entry Point Dynamically.

Here is my method

TMethodAddres=class
public
//Compile time binding method
procedure Method;
end;

procedure TMethodAddres.Method;
begin
//Compile time binding method
asm
mov eax,[ebp+04];
add eax,[eax-4]; //Now in eax the Entry point of this method
end;
end;

But there is some restrictions to work this code properly. This trick is based on Method stack frame existence.
To archive this, set the optimization flag of the project to unchecked state, and the stack frames flag to checked state.
And what about virtual methods address?

May be in the next time.

SEH Dynamic Unwinding with auto correction

2007-10-27T11:20:00.000-07:00

To achieve this objective, I have made some modifications.

I have added next fields to the TYieldObject class

InnerSEHCount:DWORD;
InnerSEHOffsets:array[0..$F] of DWORD;

And of course the code has been changed a little.

function TYieldObject.MoveNext: boolean;
asm
push ebp;
push ebx;
push edi;
push esi;
push eax;
xor edx,edx;
mov eax.TYieldObject.IsYield,dl;
push offset @a1
{
Is it first call
}
mov ecx,eax.TYieldObject.BESP;
cmp ecx,edx;
jnz @NotFirstCall;
mov eax.TYieldObject.BESP,esp;
jmp @JustBeforeTheJump;
@NotFirstCall:
cmp eax.TYieldObject.StackFrameSize,edx;
jz @RestoreRegisters;
{
is need any correction
}
mov edx,esp;
sub edx,ecx;
jz @RestoreStackFrame;
{
Correction
}
{
Correct ebp
}
add [eax.TYieldObject.REBP],edx;
{
Is any SEH frames
}
mov ecx,eax.TYieldObject.InnerSEHCount;
jecxz @ChangeBESP;
{
correct SEH frames
}
mov ebx,eax.TYieldObject.REBP;
lea esi,eax.TYieldObject.StackFrame;
add esi,eax.TYieldObject.StackFrameSize;
dec ecx;
mov edi,esi;
sub edi,DWORD PTR eax.TYieldObject.InnerSEHOffsets+4*ecx;
mov [edi+$08],ebx;
@SEHCorrection:
dec ecx;
jl @ChangeBESP
mov edi,esi;
sub edi,DWORD PTR eax.TYieldObject.InnerSEHOffsets+4*ecx;
mov [edi+$08],ebx;
add [edi],edx;
jmp @SEHCorrection;
{
Change BESP
}
@ChangeBESP:
mov eax.TYieldObject.BESP,esp;
{
Restore stack frame
}
@RestoreStackFrame:
mov ecx,eax.TYieldObject.StackFrameSize;
sub esp,ecx;
mov edi,esp;
lea esi,eax.TYieldObject.StackFrame;
rep movsb;
{
Connect Inner SEH frame. Are any inner SEH?
}
mov ecx,eax.TYieldObject.InnerSEHCount;
jecxz @RestoreRegisters;
{
Connect Inner SEH frame
}
xor ecx,ecx;
mov edi,eax.TYieldObject.BESP;
sub edi,DWORD PTR eax.TYieldObject.InnerSEHOffsets+4*ecx;
mov fs:[ecx],edi;
{
Restore Registers
}
@RestoreRegisters:
mov ebx,eax.TYieldObject.REBX;
mov ecx,eax.TYieldObject.RECX;
mov edx,eax.TYieldObject.REDX;
mov esi,eax.TYieldObject.RESI;
mov edi,eax.TYieldObject.REDI;
mov ebp,eax.TYieldObject.REBP;

@JustBeforeTheJump:
push [eax.TYieldObject.NextItemEntryPoint];
mov eax,eax.TYieldObject.REAX;
ret;
@a1:;
pop eax;
pop esi;
pop edi;
pop ebx;
pop ebp;
mov al,eax.TYieldObject.IsYield;
end;

procedure TYieldObject.Yield(const Value);
asm
mov eax.TYieldObject.REBP,ebp;
mov eax.TYieldObject.REAX,eax;
mov eax.TYieldObject.REBX,ebx;
mov eax.TYieldObject.RECX,ecx;
mov eax.TYieldObject.REDX,edx; // This is the Ref to const param
mov eax.TYieldObject.RESI,ESI;
mov eax.TYieldObject.REDI,EDI;
pop ecx;
mov eax.TYieldObject.NextItemEntryPoint,ecx;
//We must do it first for valid const reference
push eax;
mov ecx,[eax];
CALL DWORD PTR [ecx+VMTOFFSET TYieldObject.SaveYieldedValue];
pop eax;
{
Unwind SEH
// There is no need ebx,esi,edi to retain
}
xor ebx,ebx;
mov ecx,fs:[ebx];
@SEHUnwind:
jecxz @JustAfterSEHUnwind;
cmp ecx,eax.TYieldObject.BESP;
jnl @JustAfterSEHUnwind
mov esi,eax.TYieldObject.BESP;
sub esi,ecx;
mov DWORD PTR eax.TYieldObject.InnerSEHOffsets+4*ebx,esi;
inc ebx;
mov ecx,[ecx];
jmp @SEHUnwind;
@JustAfterSEHUnwind:
mov eax.TYieldObject.InnerSEHCount,ebx;
{
Connect Outer SEH frame.
If no local SEH frames next two commands are redundant
}
xor ebx,ebx;
mov fs:[ebx],ecx;
{
Save local stack frame
}
mov ecx,eax.TYieldObject.BESP;
sub ecx,esp;
mov eax.TYieldObject.StackFrameSize,ecx;
jz @AfterSaveStack;
lea esi,[esp];
lea edi,[eax.TYieldObject.StackFrame];
rep movsb;
mov esp,eax.TYieldObject.BESP;
@AfterSaveStack:
mov eax.TYieldObject.IsYield,1;
end;

So for now you may use try/finally and try/except construction in procedure that uses yielding.
Next article will be about additional improvements.
Now I am thinking about separate stack.

Just before improving implementation for dynamic SEH unwinding support

2007-10-22T09:57:00.000-07:00

All times we declare local variables of finalized types the Delphi compiler inserts hidden try finally block that forces local variables of finalized types to be finalized under any circumstances.

Look at the next sample.

Delphi code

procedure TForm1.Button1Click(Sender: TObject);
var a:string;
begin
a:='abcdef';
end;

is mapped to appropriate x86 assembler code.
Something like this

push ebp
mov ebp,esp
push $00
xor eax,eax

{
This is the hidden try
}
push ebp
push $XXXXXXXX
push dword ptr fs:[eax]
mov fs:[eax],esp

Unit1.pas. XX: a:='abcdef';
lea eax,[ebp-$04]
mov edx,$XXXXXXXX
call @LStrLAsg
Unit1.pas.XX: end;
xor eax,eax
pop edx
pop ecx
pop ecx
mov fs:[eax],edx
push $XXXXXXXX
{
Local variable Finalization code
}
lea eax,[ebp-$04]
call @LStrClr

ret

{
And this is the hidden finally block
}
jmp @HandleFinally
jmp $XXXXXXXX

{Normal procedure Exit }
pop ecx
pop ebp
ret

Little explanation about SEH.

FS is protected mode selector that indexes descriptor of segment in descriptor tables (descriptors map logical address space to linear) .
Segment that is indexed by FS has special meaning for Windows Operation System.
This segment contains structure known as Thread Environment Block, TEB. But TEB structure includes at start of it a Win32 Thread Information Block (TIB). Win32 Thread Information Block (TIB) is a data structure in Win32 on x86 that stores info about the currently running thread.
First field of TIB (i.e. fs:[0]) is current Structured Exception Handling frame.
This field is used by system to provide your code the ability to react on raised exception.
Because your procedures and functions may consist of not only hidden try/finally blocks, but yours try/finally try/except blocks, I have to implement some special SEH unwinding code and if there is any displacement I need to correct this dynamically.

And because Yield has a very specific behaviour I have to dynamically attach/detach/correct local SEH frames.

Read about this in my next article.

C# Yield implementation in Delphi.

2007-10-19T05:28:00.000-07:00

The C# yield keyword is used to provide a value to the enumerator object or to signal the end of iteration. The main idea of yield construction is to generate a collection item on request and return it to the enumerator consumer immediately. You may find it useful in some cases.

As you know the Enumerator has two methods MoveNext and GetCurrent.
But how does yield works?

Technical details of the implementation

When I saw this construction I asked myself where is MoveNext and GetCurrent?
The function returns the enumerator object or interface, but the enumerator is not explicitly constructed anywhere. So there must be some secret mechanism that makes it possible.
How does it really work? After spending some time in the debugger and the answer appeared.

In short the compiler generates a special type of object that of course
has some magic MoveNext and GetCurrent functions.

And because this construction may be useful to our Delphi community, I asked myself, what can I do to get yield support in Delphi with saving the form of using like in С#.

But of course I have to generalize implementation for all types.

I started from the programmer’s viewpoint. Something like this:

var
number, exponent, counter, Res:integer;
begin
…..
Res:=1;
while counter begin
Res:=Res*number;
Yield(Res);
inc(counter);
end;
end;

I had to implement some class that implemented the magic MoveNext and GetCurrent functions.
And if you use local vars (that is placed on stack) I had to implement some mechanism that guarantees no memory leaks for finalized types and some mechanism that guarantees that I use
the valid local vars when the actual address of local vars has changed after last yield calling due to external reasons (e.g. enumerator passed as parameter to other procedure, so the location in stack becomes different).

So after each yield call I have to preserve the state of local vars and processor registers,
clean up the stack and return a value to the enumerator consumer.
And after next call to MoveNext I must allocate stack space, restore the state of local vars and processor registers, i.e. emulate that nothing has happened.
And of course I must provide a normal procedure for exiting at the end.

So let’s begin
First of all we declare some types:

type
TYieldObject = class;
TYieldProc = procedure (YieldObject: TYieldObject);

TYieldObject = class
protected
IsYield:boolean;
NextItemEntryPoint:pointer;
BESP:pointer;
REAX,REBX,RECX,REDX,RESI,REDI,REBP:pointer;
StackFrameSize:DWORD;
StackFrame: array[1..128] of DWORD;
procedure SaveYieldedValue(const Value); virtual; abstract;
public
constructor Create(YieldProc: TYieldProc);
function MoveNext:boolean;
procedure Yield(const Value);
end;

And the implementation

constructor TYieldObject.Create(YieldProc:TYieldProc);
asm
mov eax.TYieldObject.NextItemEntryPoint,ecx;
mov eax.TYieldObject.REAX,EAX;
end;

function TYieldObject.MoveNext: boolean;
asm
{ Save the value of following registers.
We must preserve EBP, EBX, EDI, ESI, EAX for some circumstances.
Because there is no guarantee that the state of registers will
be the same after an iteration }
push ebp;
push ebx;
push edi;
push esi;
push eax;

mov eax.TYieldObject.IsYield,0
push offset @a1
xor edx,edx;
cmp eax.TYieldObject.BESP,edx;
jz @AfterEBPAdjust;

{ Here is the correction of EBP. Some need of optimization still exists. }
mov edx,esp;
sub edx,eax.TYieldObject.BESP;
add [eax.TYieldObject.REBP],edx
@AfterEBPAdjust:
mov eax.TYieldObject.BESP,esp;

{ Is there any local frame? }
cmp eax.TYieldObject.StackFrameSize,0
jz @JumpIn;

{ Restore the local stack frame }
mov ecx,eax.TYieldObject.StackFrameSize;
sub esp,ecx;
mov edi,esp;
lea esi,eax.TYieldObject.StackFrame;

{ Some need of optimization still exists. Like movsd}
rep movsb;
@JumpIn:

{ Restore the content of processor registers }
mov ebx,eax.TYieldObject.REBX;
mov ecx,eax.TYieldObject.RECX;
mov edx,eax.TYieldObject.REDX;
mov esi,eax.TYieldObject.RESI;
mov edi,eax.TYieldObject.REDI;
mov ebp,eax.TYieldObject.REBP;
push [eax.TYieldObject.NextItemEntryPoint];
mov eax,eax.TYieldObject.REAX;

{ Here is the jump to next iteration }
ret;

{ And we return here after next iteration in all cases, except exception of course. }
@a1:;

{ Restore the preserved EBP, EBX, EDI, ESI, EAX registers }
pop eax;
pop esi;
pop edi;
pop ebx;
pop ebp;
{ This Flag indicates the occurrence or no occurrence of Yield }
mov al,eax.TYieldObject.IsYield;
end;

procedure TYieldObject.Yield(const Value);
asm
{ Preserve EBP, EAX,EBX,ECX,EDX,ESI,EDI }
mov eax.TYieldObject.REBP,ebp;
mov eax.TYieldObject.REAX,eax;
mov eax.TYieldObject.REBX,ebx;
mov eax.TYieldObject.RECX,ecx;
mov eax.TYieldObject.REDX,edx; // This is the Ref to const param
mov eax.TYieldObject.RESI,ESI;
mov eax.TYieldObject.REDI,EDI;
pop ecx;
mov eax.TYieldObject.NextItemEntryPoint,ecx;

//We must do it first for valid const reference
push eax;
mov ecx,[eax];
CALL DWORD PTR [ecx+VMTOFFSET TYieldObject.SaveYieldedValue];
pop eax;

{ Calculate the current local stack frame size }
mov ecx,eax.TYieldObject.BESP;
sub ecx,esp;
mov eax.TYieldObject.StackFrameSize,ecx;
jz @AfterSaveStack;

{ Preserve the local stack frame }
lea esi,[esp];
lea edi,[eax.TYieldObject.StackFrame];

{ Some need of optimization still exists. Like movsd }
rep movsb;
mov esp,eax.TYieldObject.BESP;
@AfterSaveStack:

{Set flag of Yield occurance }
mov eax.TYieldObject.IsYield,1;
end;

And what about my improvements

As for improvements I am still thinking about unwinding the local SEH (Structured Exception Handling) frames on yielding and restore it with any needed correction after return.

And how do you use it?

type
TYieldInteger = class(TYieldObject)
protected
Value:integer;
function GetCurrent:integer;
procedure SaveYieldedValue(const Value); override;
public
property Current:integer read GetCurrent;
end;

{ TYieldInteger }

function TYieldInteger.GetCurrent: integer;
begin
Result:=Value;
end;

procedure TYieldInteger.SaveYieldedValue(const Value);
begin
Self.Value:=integer(Value);
end;

So now there is full support for integer.

TYieldString = class(TYieldObject)
protected
Value:string;
function GetCurrent:string;
procedure SaveYieldedValue(const Value); override;
public
property Current:string read GetCurrent;
end;

{ TYieldString }

function TYieldString.GetCurrent: string;
begin
Result:=Value;
end;

procedure TYieldString.SaveYieldedValue(const Value);
begin
Self.Value := string(Value);
end;

And now there is full support for string.

Sample of using a string Enumerator

procedure StringYieldProc(YieldObj: TYieldObject);
var
YieldValue: string;
i: integer;
begin
YieldValue:='None';
YieldObj.Yield(YieldValue);
for i := 1 to 10 do
begin
YieldValue := YieldValue + IntToStr(i);
YieldObj.Yield(YieldValue);
end;
end;

function TForm1.GetEnumerator: TYieldString;
begin
Result:=TYieldString.Create(StringYieldProc);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
a:string;
begin
for a in self do
Memo1.Lines.Add(a);
end;

From Russia with love Sergey Antonov aka oxffff.

References

ECMA 334
ECMA 335
MSDN