Привет!
Возникла необходимость сделать сборку нескольких процедур в одну.
Вроде составной перегрузки. Proc1 + Proc2 + Proc3. И так по мере надобности.
Есть такой код. Вызов процедуры происходит, но выполнять его ядро не дает. AV.
Куда копать? Неужели в DOS?

> lea rax, D
>  call rax

ну и чего в итоге в rax?

Нельзя выполнять код в указанном сегменте, DEP, видимо. Ну и полный текст надо приводить, у AV причин обычно бывает больше одной.

Оказывается в Delphi предусмотрен вариант исполнения кода.
И мой вариант работает тоже. Главное странице памяти назначить права правильные.
Собственно что мне и было нужно.

const
  size = 128;

type
  TFuncInt = function(param: Integer): Integer; // EAX -> EAX
  TByteArray = array[0..size-1] of Byte;
  PByteArray = ^TByteArray;

var
  arr: PByteArray;
  FParam: Integer;
  FResult: Integer;

procedure DoCall;
asm
 .NOFRAME

 mov rax, arr
 call qword ptr rax
end;

procedure ExecCode;
begin
 arr := VirtualAlloc(nil, size, (MEM_RESERVE or MEM_COMMIT), PAGE_EXECUTE_READWRITE);

 if (arr <> nil) then
 begin
   arr[0] := $FF;  // inc ECX
   arr[1] := $C1;
   arr[2] := $89;  // mov eax, ecx
   arr[3] := $C8;
   arr[4] := $C3;  // ret

   DoCall; //<- Мой вызов

   FParam := 77;
   FResult := TFuncInt(arr)(FParam);  // 78 <- Вызов через Delphi
 end;

 VirtualFree(arr, 0, MEM_RELEASE);
end;


Можно сразу массив вызвать, без RAX.
procedure DoCall;
asm
 .NOFRAME

 call qword ptr arr
end;


Еще бы инфу по отладчикам найти. Int 3.

Какие описываются технические проблемы с вызовом кода, записанного в данных программы - я вроде понял.
А вот исходного вопроса про "составные процедуры" - нет.

> dmk ©   (28.08.18 19:23) 

Была тут как-то похожая тема.

http://hghltd.yandex.net/yandbtm?fmode=inject&url=http%3A%2F%2Fwww.DelphiMaster.ru%2Fcgi-bin%2Fhttp://pda.delphimaster.net/%3Fid%3D1460463897%26n%3D18%26p%3D1&tld=ru&lang=ru&la=1526779392&tm=1535615176&text=%2Bdelphi%20%2Baddmodproc&l10n=ru&mime=html&sign=c61744002f40d78f7edd4427d2dded94&keyno=0

В delhimaster.net она не ищется. Почему - знает уважаемый xayam.

--
Regards, LVT.

>А вот исходного вопроса про "составные процедуры" - нет.

Вот процедура состоящая из блоков. Ее сожно модифицировать и создавать другие варианты расчетов. В общем как шейдеры в OpenGL/DirectX. Собственно я и делаю расчетные шейдеры. Просто мне надо скомпилировать шейдер перед вызовом. Сложить в зависимости от условий куски кода в одну процедуру.

function SpecularB(SpecColor, FaceNormal, LightDir: TVertex): TColorRef;
const
 K: Single = 0.333333333;

asm
 .NOFRAME

 movd xmm3, [K]
 shufps xmm3, xmm3, 01000000b

 movdqa xmm2, xmm10
 addps xmm2, xmm11
 addps xmm2, xmm12
 mulps xmm2, xmm3

 movdqa xmm5, xmm2
 movdqa xmm6, [FaceNormal]

 //№1 - Dot(I, N)
 mulps xmm5, xmm6
 haddps xmm5, xmm5
 haddps xmm5, xmm5

 //№2 - 2.0 * №1
 mulss xmm5, [SingleTwo]

 //№3 - VecMul(N, №2)
 shufps xmm5, xmm5, 01000000b
 mulps xmm5, xmm6

 //№4 - FaceCenter - №3
 subps xmm2, xmm5

 pxor xmm1, xmm1
 insertps xmm2, xmm1, 00110000b
 movdqa xmm0, xmm2

 //Len := VecLen(V);
 mulps xmm2, xmm2
 haddps xmm2, xmm2
 haddps xmm2, xmm2
 sqrtss xmm2, xmm2

 //if (Len <> 0.0)
 ptest xmm2, xmm2
 jz @Zero

 //F := (1.0 / Len);
 movd xmm1, [SingleOne]
 divss xmm1, xmm2

 //V * F
 shufps xmm1, xmm1, 01000000b
 mulps xmm0, xmm1

 movdqa xmm2, xmm0
 jmp @EndNormalize

@Zero:
 movdqa xmm2, xmm1

@EndNormalize:

 //№5 - Dot(LightDir, №4)
 movdqa xmm0, [LightDir]
 mulps xmm0, xmm2
 haddps xmm0, xmm0
 haddps xmm0, xmm0

 //№6 - Max(№5, minLightK)
 maxss xmm0, [minLightK]

 //№7 - Pow32(№6)
 call Pow

 //№8 VecMul(SpecColor, №7)
 shufps xmm0, xmm0, 01000000b
 mulps xmm0, [SpecColor]

 //№9 * 255.0
 movd xmm1, [M255]
 shufps xmm1, xmm1, 01000000b
 mulps xmm0, xmm1
 cvtps2dq xmm0, xmm0

 //№14 - VecToColor(№13)
 movd xmm2, [GatherColors]
 pshufb xmm0, xmm2
 movd eax, xmm0
end;


Короче это что-то типа интерсинков получится. Просто комбинаций сложения процедур огромное кол-во, поэтому и занялся таким вопросом.

> dmk ©   (30.08.18 13:59) [9]

> сложения процедур огромное кол-во, поэтому и занялся таким
> вопросом.

Позволю себе привести мой пример из [7] для компиляции "на лету".
Оно работает в D6/win32 в коде, который вписывается в память,
распределенную простым New (т.е., там уже есть r|w|e).

type
 TProc = procedure;
 TEProc = procedure(E: Exception);

procedure Agregate(p1: TProc; p2: TEProc);
begin
 try
   p1;
 except
   on E: Exception do
     p2(E);
 end;
end;

type
 TModProcs = packed record
   proc1: TProc;
   proc2: TEProc;
   code: PByte;
 end;
 PModProcs=^TModProcs;

const
 vagr: procedure(p1: TProc; p2: TEProc)= Agregate;

procedure Template(m: PModProcs); register;
begin
 with m^ do
   vagr(proc1, proc2);
end;

type
 TPrecode = packed record
   b8: Byte;
   m: Pointer;
 end;

procedure AddModProc(const p1: TProc; p2: TEProc; var p3: TProc);
var
 procsize: Longint;
 p0, pt: PByte;
 pc: TPrecode;
 pmp: PModProcs;
begin
 New(pmp);
 procsize := Dword(@AddModProc)-Dword(@template)+1;
 pc.b8 := $B8;
 pc.m := pmp;   // mov eax, pmp = B8 00 00 00 00
 with pmp^ do
   begin
     proc1 := p1;
     proc2 := p2;
     GetMem(code, SizeOf(pc)+ procsize);
     pt := code;
     Move(pc.b8, pt^, SizeOf(pc));
     inc(pt, SizeOf(pc));
     p0 := @template;
     Move(p0^, pt^, procsize);
     p3 := @code^;
   end;
end;

procedure a;
begin
 ShowMessage('a: '+IntToStr(GetTickCount));
 abort;
end;

procedure b(E: Exception);
begin
 Application.ShowException(E);
end;

procedure d;
begin
 ShowMessage('d: '+IntToStr(GetTickCount));
 raise Exception.Create('MyException');
end;

procedure TForm1.Button2Click(Sender: TObject);
var
 c, e: TProc;
begin
 AddModProc(a, b, c);
 AddModProc(d, b, e);
 c;
 e;
end;

--
Regards, LVT.

>Leonid Troyanovsky ©   (30.08.18 14:58) [10]
Пытался под 64 бита адаптировать - не вышло :)
Переделал на mov rax, XXXXXXXXX с префиксом $48B8.
Размеры естественно все на UInt64 перевел.
Не помогло.

Массив указателей на функции?
Набил ячейки массива адресами в нужном порядке - и вызываем подряд поочерёдно.
Будут, правда, накладные расходы на call / ret, но вроде это не так и страшно

А понял. Да не, я опкоды складываю или блоки опкодов.
Типа компилятора нормального.

> dmk ©   (31.08.18 02:01) [11]

> Пытался под 64 бита адаптировать - не вышло :)

Ну, дык, ошибка у тебя, в 17 строке.

Если б код был, кто-нибудь мог бы и подсказать.
Не я, конечно, бо нет у мну 64 бит.

--
Regards, LVT.

>Ну, дык, ошибка у тебя, в 17 строке.
Вот модификация. Под 64 бита не пашет.

unit CompileProcs;

interface

uses
 Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
 Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
 TForm1 = class(TForm)
   Button1: TButton;
   procedure Button1Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure GetMem64(var Buf: Pointer; Size: Integer);
begin
 buf := VirtualAlloc(nil, size, (MEM_RESERVE or MEM_COMMIT), PAGE_EXECUTE_READWRITE);
end;

procedure FreeMem64(var Buf: Pointer; Size: Integer);
begin
 if VirtualFree(buf, 0, MEM_RELEASE) then buf := nil;
end;

type
 TProc = procedure;
 TEProc = procedure(E: Exception);
 QWord = UInt64;

procedure Agregate(p1: TProc; p2: TEProc);
begin
 try
   p1;
 except
   on E: Exception do
     p2(E);
 end;
end;

type
 TModProcs = packed record
   proc1: TProc;
   proc2: TEProc;
   code: PByte;
 end;
 PModProcs=^TModProcs;

const
 vagr: procedure(p1: TProc; p2: TEProc)= Agregate;

procedure Template(m: PModProcs); register;
begin
 with m^ do vagr(proc1, proc2);
end;

{$IFDEF WIN32}
type
 TPrecode = packed record
   b8: Byte;
   m: Pointer;
 end;
{$ENDIF WIN32}
{$IFDEF WIN64}
type
 TPrecode = packed record
   w8: Word;
   m: Pointer;
 end;
{$ENDIF WIN64}

procedure AddModProc(const p1: TProc; p2: TEProc; var p3: TProc);
var
 p0, pt: PByte;
 {$IFDEF WIN32}
 procsize: Longint;
 pc: TPrecode;
 {$ENDIF WIN32}
 {$IFDEF WIN64}
 procsize: QWord;
 pc: TPrecode;
 {$ENDIF WIN64}
 pmp: PModProcs;

begin
 New(pmp);
 {$IFDEF WIN32}
 procsize := DWord(@AddModProc) - DWord(@template) + 1;
 pc.b8 := $B8; //$B8
 pc.m := pmp;  //mov eax, pmp = B8 00 00 00 00
 {$ENDIF WIN32}
 {$IFDEF WIN64}
 procsize := QWord(@AddModProc) - QWord(@template) + 1;
 pc.w8 := $48B8; //$48B8
 pc.m := pmp;   // mov rax, pmp = 48 B8 00 00 00 00 00 00
 {$ENDIF WIN64}

 with pmp^ do
 begin
   proc1 := p1;
   proc2 := p2;
   {$IFDEF WIN32}
   GetMem64(Pointer(code), SizeOf(pc) + procsize);
   pt := code;
   Move(pc.b8, pt^, SizeOf(pc));
   {$ENDIF WIN32}
   {$IFDEF WIN64}
   GetMem64(Pointer(code), SizeOf(pc) + procsize);
   pt := code;
   Move(pc.w8, pt^, SizeOf(pc));
   {$ENDIF WIN64}
   inc(pt, SizeOf(pc));
   p0 := @template;
   Move(p0^, pt^, procsize);
   p3 := @code^;
 end;
end;

procedure a;
begin
 ShowMessage('a: '+IntToStr(GetTickCount));
 abort;
end;

procedure b(E: Exception);
begin
 Application.ShowException(E);
end;

procedure d;
begin
 ShowMessage('d: ' + IntToStr(GetTickCount));
 raise Exception.Create('MyException');
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 c, e: TProc;

begin
 AddModProc(a, b, c);
 AddModProc(d, b, e);
 c;
 e;
end;

end.

>Не я, конечно, бо нет у мну 64 бит.
64 бита качается с сайта Embarcadero. Называется Delphi 10.2 Community edition.
Абсолютно бесплатна на год. Уровень prof.

Вот коммунити:
https://www.embarcadero.com/ru/products/delphi/starter/free-download

Удалено модератором

Удалено модератором