Board.KolibriOS.org

Official KolibriOS board
http://board.kolibrios.org/

Delphi SDK для Колибри

http://board.kolibrios.org/viewtopic.php?t=735

Page 3 of 4

Re: Delphi SDK для Колибри

Posted: Wed Oct 05, 2016 9:29 pm
by //DG
Ок, и между модулями работает. Скриншоты нннада?

Code: Select all

unit abc;
interface
const
  user32 = 'user32.dll';
  kernel32 = 'kernel32.dll';

procedure Test123(var a: integer);
function MessageBox(hWnd: Cardinal; lpText, lpCaption: Pchar; uType: Cardinal): Integer; stdcall;
function Func1(AParam: integer): boolean; overload;
function Func1(AParam: boolean): boolean; overload;
function Func1(AParam: byte): boolean; overload;

implementation

function Func1(AParam: integer): boolean; overload;
begin
  MessageBox(0,'Header','TinyPE in Delphi',0);
end;

function Func1(AParam: boolean): boolean; overload;
begin
  MessageBox(0,'Header','TinyPE in Delphi',0);
end;

function Func1(AParam: byte): boolean; overload;
begin
  MessageBox(0,'Header','TinyPE in Delphi',0);
end;

procedure test123(var a: integer);
begin
  a:= a + 1;
end;

function MessageBox; stdcall; external user32 name '_MessageBoxA@16';

end.

Code: Select all

unit Hello;

interface
uses
  abc;
function Start(hModule, hReason, hReserved: DWORD): LongBool; stdcall;


implementation


function Start(hModule, hReason, hReserved: DWORD): LongBool;
begin
  Func1(3);
  Func1(True);
  Result:= TRUE;
end;

end.

Code: Select all

Borland Delphi Version 15.0
Copyright (c) 1983,2002 Borland Software Corporation

hello.pas(1) 
hello.pas(1) 
hello.pas(1) 
abc.pas(1)   
abc.pas(18) Warning: Return value of function 'Func1' might be undefined

abc.pas(23) Warning: Return value of function 'Func1' might be undefined

abc.pas(28) Warning: Return value of function 'Func1' might be undefined

abc.pas(39) 

hello.pas(6) 
hello.pas(19) 
60 lines, 0.00 seconds, 78 bytes code, 4 bytes data.

Code: Select all

Microsoft (R) Incremental Linker Version 7.00.9210
Copyright (C) Microsoft Corporation.  All rights reserved.

Hello.obj : warning LNK4033: converting object format from OMF to COFF
abc.obj : warning LNK4033: converting object format from OMF to COFF
system.obj : warning LNK4033: converting object format from OMF to COFF
LINK : warning LNK4078: multiple '.text' sections found with different attributes (C0000040)
LINK : warning LNK4078: multiple '.text' sections found with different attributes (C0000040)

Re: Delphi SDK для Колибри

Posted: Wed Oct 05, 2016 10:16 pm
by Freeman
//DG wrote:Ок, и между модулями работает. Скриншоты нннада?
Map-файла будет достаточно.

Re: Delphi SDK для Колибри

Posted: Wed Oct 05, 2016 10:41 pm
by //DG
Freeman wrote:
//DG wrote:Ок, и между модулями работает. Скриншоты нннада?
Map-файла будет достаточно.
Пожалуйста. (А с фига ли extension map is not allowed на форуме?)

Re: Delphi SDK для Колибри

Posted: Wed Oct 19, 2016 10:22 am
by 0CodErr
Ну попробовал я эту вашу omf2d. После неё у меня LD чем-то недоволен.
Исходник:
Spoiler:

Code: Select all

Program Project1;

Type

  Dword = Cardinal;

Var
  hConsole: Pointer;
  ConsoleInit:       Procedure(WndWidth, WndHeight, ScrWidth, ScrHeight: Dword; Caption: PChar); StdCall;
  ConsoleExit:       Procedure(bCloseWindow: Cardinal); StdCall;
  Write:             Procedure(Str: PChar); StdCall;
  ConsoleSetCaption: Procedure(Const Caption: PChar); StdCall;
  GetCh:             Function: Char; StdCall;
  GetS:              Function(Buffer: PChar; Count: Cardinal): PChar; StdCall;
  printf:            Function(Const Format: PChar): Integer; CDecl VarArgs;
(* -------------------------------------------------------- *)
  Procedure Main; Forward;
  Function  CreateFile(Path: PChar): Integer; StdCall; Forward;
  Function  RunFile(Path, Params: PChar): Integer; StdCall; Forward;
  Procedure ThreadTerminate; Forward;
  Function  LoadLibrary(Path: PChar): Pointer; StdCall; Forward;
  Function  GetProcAddress(hLib: Pointer; ProcName: PChar): Pointer; StdCall; Forward;
(* -------------------------------------------------------- *)
Procedure Main();
Var
   i: Cardinal;
   S: array[1..100] of char;
Begin

   hConsole          := LoadLibrary('/sys/lib/console.obj');
   ConsoleInit       := GetProcAddress(hConsole, 'con_init');
   ConsoleExit       := GetProcAddress(hConsole, 'con_exit');
   Write             := GetProcAddress(hConsole, 'con_write_asciiz');
   ConsoleSetCaption := GetProcAddress(hConsole, 'con_set_title');
   GetCh             := GetProcAddress(hConsole, 'con_getch');
   GetS              := GetProcAddress(hConsole, 'con_gets');
   printf            := GetProcAddress(hConsole, 'con_printf');


   ConsoleInit($FFFFFFFF, $FFFFFFFF, $FFFFFFFF, $FFFFFFFF, 'Test');
   Write('Hello,'#10'Console!'#10#10);
   Write('Enter something:');
   GetS(@S, 30);
   Write('You entered:');
   Write(@S);
   Write(#10);

   Write('Press key to see printf output'#10#10);
   GetCh();

   printf('Characters: %c %c '#10, 'a', 65);
   printf('Decimals: %d %ld'#10, 1977, 650000);
   printf('Preceding with blanks: %10d'#10, 1977);
   printf('Preceding with zeros: %010d'#10, 1977);
   printf('Some different radices: %d %x %o %#x %#o '#10, 100, 100, 100, 100, 100);
   printf('Width trick: %*d'#10, 5, 10);
   printf('%s'#10, 'A string');

   printf(#10);

   printf('Do you want to create new file?(enter "y" if yes)'#10);
   If GetCh() = 'y' Then
   Begin
     printf('Enter file path then:');
     GetS(@S, 100);
     i := 0; While s[i] <> #10 Do Inc(i); s[i] := #0;
     If CreateFile(@S) = 0 Then
       printf('File created.'#10)
     Else
       printf('CreateFile Error!'#10);
   End
   Else
     printf('You do not want to create new file.'#10);

   printf(#10);

   printf('Maybe you need a calc?(enter "y" if yes)'#10);
   If GetCh() = 'y' Then
     RunFile('/sys/calc', '')
   Else
     printf('You do not need a calc.'#10);

   printf(#10);

   printf('Do you want to set a new caption?(enter "y" if yes)'#10);
   If GetCh() = 'y' Then
   Begin
     printf('Enter new caption then:');
     GetS(@S, 100);
     i := 0; While s[i] <> #10 Do Inc(i); s[i] := #0;
     ConsoleSetCaption(@S);
   End
   Else
     printf('You do not want to set a new caption.');

   ConsoleExit(0);
   ThreadTerminate;
End;
(* -------------------------------------------------------- *)
Procedure ThreadTerminate();
Asm
        mov    eax, $FFFFFFFF;
        int    64
End;
(* -------------------------------------------------------- *)
Function CreateFile(Path: PChar): Integer;
Asm
        push   ebx
        push   Path
        dec    esp
        mov    byte[esp], 0
        push   0
        push   0
        push   0
        push   0
        push   2
        mov    ebx, esp
        mov    eax, 70
        int    64
        add    esp, 25
        pop    ebx
End;
(* -------------------------------------------------------- *)
Function RunFile(Path, Params: PChar): Integer;
Asm
        push   ebx
        push   Path
        dec    esp
        mov    byte [esp], 0
        push   0
        push   0
        push   Params
        push   0
        push   7
        mov    ebx, esp
        mov    eax, 70
        int    64
        add    esp, 25
        pop    ebx
End;
(* -------------------------------------------------------- *)
Function GetProcAddress(hLib: Pointer; ProcName: PChar): Pointer;
Asm
        push   esi
        push   edi
        push   ebx
        mov    edx, hLib
        xor    eax, eax
        test   edx, edx
        jz     @end
        mov    edi, ProcName
        mov    ecx, $FFFFFFFF
        repne scasb
        mov    ebx, ecx
        not    ebx
@next:
        mov    esi, [edx]
        test   esi, esi
        jz     @end
        mov    ecx, ebx
        mov    edi, ProcName
        add    edx, 8
        repe cmpsb
        jne    @next
        mov    eax, [edx - 4]
@end:
        pop    ebx
        pop    edi
        pop    esi
End;
(* -------------------------------------------------------- *)
Function LoadLibrary(Path: PChar): Pointer;
Asm
        push   ebx
        mov    eax, 68
        mov    ebx, 19
        mov    ecx, Path
        int    64
        pop    ebx
End;
(* -------------------------------------------------------- *)
Begin Main; End.
Я вот это просто задефайнил, чтобы линкер не ругался на их отсутствие:
Spoiler:

Code: Select all

@@Halt0
@@InitExe      
@Finalization  
@@HandleFinally
@initialization
Spoiler:
dcc32 -J project1.dpr

Borland Delphi Version 15.0
Copyright (c) 1983,2002 Borland Software Corporation
Project1.dpr(182)
183 lines, 0.01 seconds, 1638 bytes code, 32 bytes data.

omf2d project1.obj

OMF2D 1.01 converts 32bit OMF to Delphi linkable OMF
Copyright (C) 2003 Radim Picha, http://www.anticracking.sk/EliCZ
Converting "project1.obj" to "project1.obj"

link -edit project1.obj

Microsoft (R) COFF Binary File Editor Version 5.12.8078
Copyright (C) Microsoft Corp 1992-1998. All rights reserved.

project1.obj : warning LNK4033: converting object format from OMF to COFF

LINK : warning LNK4041: no edit options specified

ld -T LScript.x project1.obj -o project1.kex

Project1.obj:project1.dpr:(.text+0x0): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x62c): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x0): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x5ec): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x0): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x5b3): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x0): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x58b): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x0): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x564): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x0): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x55c): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x0): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x0): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x0): multiple definition of `@Finalization'
Project1.obj:project1.dpr:(.text+0x0): first defined here
Project1.obj:project1.dpr:(.text+0x604): multiple definition of `@Finalization'
Project1.obj:project1.dpr:(.text+0x0): first defined here
А тем извращенским способом viewtopic.php?f=9&t=2318#p66300 приложение запускается и работает, результат — это вот:
Spoiler:Image
Подобное в принципе можно собрать и FreePascal-ем, и Delphi2(только она VarArgs не понимает, и Cardinal там на самом деле 31-битный — в некоторых случаях достаточно просто заменить на Integer).
Я думаю, другую тему завести, про Delphi\FreePascal с примерами и обёртками.

Re: Delphi SDK для Колибри

Posted: Wed Oct 19, 2016 1:30 pm
by //DG
0CodErr wrote:Ну попробовал я эту вашу omf2d. После неё у меня LD чем-то недоволен.
Исходник:
Spoiler:

Code: Select all

Program Project1;

Type

  Dword = Cardinal;

Var
  hConsole: Pointer;
  ConsoleInit:       Procedure(WndWidth, WndHeight, ScrWidth, ScrHeight: Dword; Caption: PChar); StdCall;
  ConsoleExit:       Procedure(bCloseWindow: Cardinal); StdCall;
  Write:             Procedure(Str: PChar); StdCall;
  ConsoleSetCaption: Procedure(Const Caption: PChar); StdCall;
  GetCh:             Function: Char; StdCall;
  GetS:              Function(Buffer: PChar; Count: Cardinal): PChar; StdCall;
  printf:            Function(Const Format: PChar): Integer; CDecl VarArgs;
(* -------------------------------------------------------- *)
  Procedure Main; Forward;
  Function  CreateFile(Path: PChar): Integer; StdCall; Forward;
  Function  RunFile(Path, Params: PChar): Integer; StdCall; Forward;
  Procedure ThreadTerminate; Forward;
  Function  LoadLibrary(Path: PChar): Pointer; StdCall; Forward;
  Function  GetProcAddress(hLib: Pointer; ProcName: PChar): Pointer; StdCall; Forward;
(* -------------------------------------------------------- *)
Procedure Main();
Var
   i: Cardinal;
   S: array[1..100] of char;
Begin

   hConsole          := LoadLibrary('/sys/lib/console.obj');
   ConsoleInit       := GetProcAddress(hConsole, 'con_init');
   ConsoleExit       := GetProcAddress(hConsole, 'con_exit');
   Write             := GetProcAddress(hConsole, 'con_write_asciiz');
   ConsoleSetCaption := GetProcAddress(hConsole, 'con_set_title');
   GetCh             := GetProcAddress(hConsole, 'con_getch');
   GetS              := GetProcAddress(hConsole, 'con_gets');
   printf            := GetProcAddress(hConsole, 'con_printf');


   ConsoleInit($FFFFFFFF, $FFFFFFFF, $FFFFFFFF, $FFFFFFFF, 'Test');
   Write('Hello,'#10'Console!'#10#10);
   Write('Enter something:');
   GetS(@S, 30);
   Write('You entered:');
   Write(@S);
   Write(#10);

   Write('Press key to see printf output'#10#10);
   GetCh();

   printf('Characters: %c %c '#10, 'a', 65);
   printf('Decimals: %d %ld'#10, 1977, 650000);
   printf('Preceding with blanks: %10d'#10, 1977);
   printf('Preceding with zeros: %010d'#10, 1977);
   printf('Some different radices: %d %x %o %#x %#o '#10, 100, 100, 100, 100, 100);
   printf('Width trick: %*d'#10, 5, 10);
   printf('%s'#10, 'A string');

   printf(#10);

   printf('Do you want to create new file?(enter "y" if yes)'#10);
   If GetCh() = 'y' Then
   Begin
     printf('Enter file path then:');
     GetS(@S, 100);
     i := 0; While s[i] <> #10 Do Inc(i); s[i] := #0;
     If CreateFile(@S) = 0 Then
       printf('File created.'#10)
     Else
       printf('CreateFile Error!'#10);
   End
   Else
     printf('You do not want to create new file.'#10);

   printf(#10);

   printf('Maybe you need a calc?(enter "y" if yes)'#10);
   If GetCh() = 'y' Then
     RunFile('/sys/calc', '')
   Else
     printf('You do not need a calc.'#10);

   printf(#10);

   printf('Do you want to set a new caption?(enter "y" if yes)'#10);
   If GetCh() = 'y' Then
   Begin
     printf('Enter new caption then:');
     GetS(@S, 100);
     i := 0; While s[i] <> #10 Do Inc(i); s[i] := #0;
     ConsoleSetCaption(@S);
   End
   Else
     printf('You do not want to set a new caption.');

   ConsoleExit(0);
   ThreadTerminate;
End;
(* -------------------------------------------------------- *)
Procedure ThreadTerminate();
Asm
        mov    eax, $FFFFFFFF;
        int    64
End;
(* -------------------------------------------------------- *)
Function CreateFile(Path: PChar): Integer;
Asm
        push   ebx
        push   Path
        dec    esp
        mov    byte[esp], 0
        push   0
        push   0
        push   0
        push   0
        push   2
        mov    ebx, esp
        mov    eax, 70
        int    64
        add    esp, 25
        pop    ebx
End;
(* -------------------------------------------------------- *)
Function RunFile(Path, Params: PChar): Integer;
Asm
        push   ebx
        push   Path
        dec    esp
        mov    byte [esp], 0
        push   0
        push   0
        push   Params
        push   0
        push   7
        mov    ebx, esp
        mov    eax, 70
        int    64
        add    esp, 25
        pop    ebx
End;
(* -------------------------------------------------------- *)
Function GetProcAddress(hLib: Pointer; ProcName: PChar): Pointer;
Asm
        push   esi
        push   edi
        push   ebx
        mov    edx, hLib
        xor    eax, eax
        test   edx, edx
        jz     @end
        mov    edi, ProcName
        mov    ecx, $FFFFFFFF
        repne scasb
        mov    ebx, ecx
        not    ebx
@next:
        mov    esi, [edx]
        test   esi, esi
        jz     @end
        mov    ecx, ebx
        mov    edi, ProcName
        add    edx, 8
        repe cmpsb
        jne    @next
        mov    eax, [edx - 4]
@end:
        pop    ebx
        pop    edi
        pop    esi
End;
(* -------------------------------------------------------- *)
Function LoadLibrary(Path: PChar): Pointer;
Asm
        push   ebx
        mov    eax, 68
        mov    ebx, 19
        mov    ecx, Path
        int    64
        pop    ebx
End;
(* -------------------------------------------------------- *)
Begin Main; End.
Я вот это просто задефайнил, чтобы линкер не ругался на их отсутствие:
Spoiler:

Code: Select all

@@Halt0
@@InitExe      
@Finalization  
@@HandleFinally
@initialization
Spoiler:
dcc32 -J project1.dpr

Borland Delphi Version 15.0
Copyright (c) 1983,2002 Borland Software Corporation
Project1.dpr(182)
183 lines, 0.01 seconds, 1638 bytes code, 32 bytes data.

omf2d project1.obj

OMF2D 1.01 converts 32bit OMF to Delphi linkable OMF
Copyright (C) 2003 Radim Picha, http://www.anticracking.sk/EliCZ
Converting "project1.obj" to "project1.obj"

link -edit project1.obj

Microsoft (R) COFF Binary File Editor Version 5.12.8078
Copyright (C) Microsoft Corp 1992-1998. All rights reserved.

project1.obj : warning LNK4033: converting object format from OMF to COFF

LINK : warning LNK4041: no edit options specified

ld -T LScript.x project1.obj -o project1.kex

Project1.obj:project1.dpr:(.text+0x0): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x62c): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x0): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x5ec): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x0): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x5b3): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x0): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x58b): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x0): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x564): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x0): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x55c): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x0): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x0): multiple definition of `Project1'
Project1.obj:project1.dpr:(.text+0x64c): first defined here
Project1.obj:project1.dpr:(.text+0x0): multiple definition of `@Finalization'
Project1.obj:project1.dpr:(.text+0x0): first defined here
Project1.obj:project1.dpr:(.text+0x604): multiple definition of `@Finalization'
Project1.obj:project1.dpr:(.text+0x0): first defined here
А тем извращенским способом viewtopic.php?f=9&t=2318#p66300 приложение запускается и работает, результат — это вот:
Spoiler:Image
Подобное в принципе можно собрать и FreePascal-ем, и Delphi2(только она VarArgs не понимает, и Cardinal там на самом деле 31-битный — в некоторых случаях достаточно просто заменить на Integer).
Я думаю, другую тему завести, про Delphi\FreePascal с примерами и обёртками.
А их надо было дефайнить иначе - инициализация и финализация referenceятся компилятором, их надо дефайнить в null. Можно было посмотреть мой пример:

omf2d abc.obj abc2.obj /U- /U_* /CP@initialization$qqrv=@2junk /CP@Finalization$qqrv=@2junk2

Если хочешь, я пришлю тебе пакет TinyPeInDelphi настроенный.

Re: Delphi SDK для Колибри

Posted: Wed Oct 19, 2016 1:37 pm
by //DG
0CodErr wrote: Я думаю, другую тему завести, про Delphi\FreePascal с примерами и обёртками.
Решают сейчас проблему с субаллокатором для FPC. Пока изучаю ваши библиотеки, как вы работаете со своими obj/dll

Re: Delphi SDK для Колибри

Posted: Wed Oct 19, 2016 1:38 pm
by //DG
А, еще вспомнил: при таком методе все строится на unitах, без program.

Re: Delphi SDK для Колибри

Posted: Wed Oct 19, 2016 4:24 pm
by 0CodErr
//DG wrote:при таком методе все строится на unitах, без program.
Это похоже, что ключевой момент.

А зачем мне TinyPeInDelphi? Я ведь делаю приложение под KolibriOS.
//DG wrote:А их надо было дефайнить иначе - инициализация и финализация referenceятся компилятором, их надо дефайнить в null.
Я в скрипте для линкера написал просто вот так:

Code: Select all

"@@Halt0"         = 0;
"@@InitExe"       = 0;
"@@HandleFinally" = 0;
"@initialization" = 0;
А в случае с FreePascal пришлось так:

Code: Select all

"RTTI_SYSTEM_WORD"=0;
"FPC_INITIALIZEUNITS"=0;
"FPC_DO_EXIT"=0;
"INIT$_SYSTEM"=0;
"INIT$_FPINTRES"=0;
"INIT$_OBJPAS"=0;
"FINALIZE$_OBJPAS"=0;
"THREADVARLIST_SYSTEM"=0;
"THREADVARLIST_FPINTRES"=0;
"THREADVARLIST_OBJPAS"=0;
"THREADVARLIST_SYSINITPAS"=0;
На Unit-ах попроще, конечно. Значит, буду делать Unit-ы с Main.

Re: Delphi SDK для Колибри

Posted: Wed Oct 19, 2016 5:24 pm
by 0CodErr
0CodErr wrote:На Unit-ах попроще
Ну собственно вот:
Spoiler:

Code: Select all

Unit Unit1;
(* -------------------------------------------------------- *)
Interface
(* -------------------------------------------------------- *)
Type

  Dword = Cardinal;

Var
  hConsole: Pointer;
  ConsoleInit:       Procedure(WndWidth, WndHeight, ScrWidth, ScrHeight: Dword; Caption: PChar); StdCall;
  ConsoleExit:       Procedure(bCloseWindow: Cardinal); StdCall;
  Write:             Procedure(Str: PChar); StdCall;
  ConsoleSetCaption: Procedure(Const Caption: PChar); StdCall;
  GetCh:             Function: Char; StdCall;
  GetS:              Function(Buffer: PChar; Count: Cardinal): PChar; StdCall;
  printf:            Function(Const Format: PChar): Integer; CDecl VarArgs;
(* -------------------------------------------------------- *)
  Procedure Main; Forward;
  Function  CreateFile(Path: PChar): Integer; StdCall; Forward;
  Function  RunFile(Path, Params: PChar): Integer; StdCall; Forward;
  Procedure ThreadTerminate; Forward;
  Function  LoadLibrary(Path: PChar): Pointer; StdCall; Forward;
  Function  GetProcAddress(hLib: Pointer; ProcName: PChar): Pointer; StdCall; Forward;
(* -------------------------------------------------------- *)
Implementation
(* -------------------------------------------------------- *)
Procedure Main();
Var
   i: Cardinal;
   S: array[1..100] of char;
Begin

   hConsole          := LoadLibrary('/sys/lib/console.obj');
   ConsoleInit       := GetProcAddress(hConsole, 'con_init');
   ConsoleExit       := GetProcAddress(hConsole, 'con_exit');
   Write             := GetProcAddress(hConsole, 'con_write_asciiz');
   ConsoleSetCaption := GetProcAddress(hConsole, 'con_set_title');
   GetCh             := GetProcAddress(hConsole, 'con_getch');
   GetS              := GetProcAddress(hConsole, 'con_gets');
   printf            := GetProcAddress(hConsole, 'con_printf');


   ConsoleInit($FFFFFFFF, $FFFFFFFF, $FFFFFFFF, $FFFFFFFF, 'Test');
   Write('Hello,'#10'Console!'#10#10);
   Write('Enter something:');
   GetS(@S, 30);
   Write('You entered:');
   Write(@S);
   Write(#10);

   Write('Press key to see printf output'#10#10);
   GetCh();

   printf('Characters: %c %c '#10, 'a', 65);
   printf('Decimals: %d %ld'#10, 1977, 650000);
   printf('Preceding with blanks: %10d'#10, 1977);
   printf('Preceding with zeros: %010d'#10, 1977);
   printf('Some different radices: %d %x %o %#x %#o '#10, 100, 100, 100, 100, 100);
   printf('Width trick: %*d'#10, 5, 10);
   printf('%s'#10, 'A string');

   printf(#10);

   printf('Do you want to create new file?(enter "y" if yes)'#10);
   If GetCh() = 'y' Then
   Begin
     printf('Enter file path then:');
     GetS(@S, 100);
     i := 0; While s[i] <> #10 Do Inc(i); s[i] := #0;
     If CreateFile(@S) = 0 Then
       printf('File created.'#10)
     Else
       printf('CreateFile Error!'#10);
   End
   Else
     printf('You do not want to create new file.'#10);

   printf(#10);

   printf('Maybe you need a calc?(enter "y" if yes)'#10);
   If GetCh() = 'y' Then
     RunFile('/sys/calc', '')
   Else
     printf('You do not need a calc.'#10);

   printf(#10);

   printf('Do you want to set a new caption?(enter "y" if yes)'#10);
   If GetCh() = 'y' Then
   Begin
     printf('Enter new caption then:');
     GetS(@S, 100);
     i := 0; While s[i] <> #10 Do Inc(i); s[i] := #0;
     ConsoleSetCaption(@S);
   End
   Else
     printf('You do not want to set a new caption.');

   ConsoleExit(0);
   ThreadTerminate;
End;
(* -------------------------------------------------------- *)
Procedure ThreadTerminate();
Asm
        mov    eax, $FFFFFFFF;
        int    64
End;
(* -------------------------------------------------------- *)
Function CreateFile(Path: PChar): Integer;
Asm
        push   ebx
        push   Path
        dec    esp
        mov    byte[esp], 0
        push   0
        push   0
        push   0
        push   0
        push   2
        mov    ebx, esp
        mov    eax, 70
        int    64
        add    esp, 25
        pop    ebx
End;
(* -------------------------------------------------------- *)
Function RunFile(Path, Params: PChar): Integer;
Asm
        push   ebx
        push   Path
        dec    esp
        mov    byte [esp], 0
        push   0
        push   0
        push   Params
        push   0
        push   7
        mov    ebx, esp
        mov    eax, 70
        int    64
        add    esp, 25
        pop    ebx
End;
(* -------------------------------------------------------- *)
Function GetProcAddress(hLib: Pointer; ProcName: PChar): Pointer;
Asm
        push   esi
        push   edi
        push   ebx
        mov    edx, hLib
        xor    eax, eax
        test   edx, edx
        jz     @end
        mov    edi, ProcName
        mov    ecx, $FFFFFFFF
        repne scasb
        mov    ebx, ecx
        not    ebx
@next:
        mov    esi, [edx]
        test   esi, esi
        jz     @end
        mov    ecx, ebx
        mov    edi, ProcName
        add    edx, 8
        repe cmpsb
        jne    @next
        mov    eax, [edx - 4]
@end:
        pop    ebx
        pop    edi
        pop    esi
End;
(* -------------------------------------------------------- *)
Function LoadLibrary(Path: PChar): Pointer;
Asm
        push   ebx
        mov    eax, 68
        mov    ebx, 19
        mov    ecx, Path
        int    64
        pop    ebx
End;
(* -------------------------------------------------------- *)
End.
make.bat:
Spoiler:

Code: Select all

Set Name=Unit1

dcc32 -J %Name%.pas
omf2d %Name%.obj
link -edit %Name%.obj
ld -T LScript.x %Name%.obj -o %Name%.kex
objcopy -O binary -j .all %Name%.kex

pause
В линкер-скрипте осталось только "@@HandleFinally" = 0;:
Spoiler:

Code: Select all

PATH_SIZE   = 1024;
PARAMS_SIZE =  256;
STACK_SIZE  =  256;

"@@HandleFinally" = 0;

SECTIONS
{
  .all : {
    LONG(0x554e454D);
    LONG(0x31305445);
    LONG(1);
    LONG("@Main");
    LONG(END);
    LONG($END + PATH_SIZE + PARAMS_SIZE + STACK_SIZE);
    LONG($END + PATH_SIZE + PARAMS_SIZE + STACK_SIZE);
    LONG($END + PATH_SIZE);
    LONG($END);
    . = ALIGN(16);
    *(.text)
    . = ALIGN(16);
    *(.data)
END = .;
    . = ALIGN(16);
    *(.bss)
    . = ALIGN(16);
$END = .;
  }
}
Spoiler:
dcc32 -J Unit1.pas

Borland Delphi Version 15.0
Copyright (c) 1983,2002 Borland Software Corporation
Unit1.pas(186)
187 lines, 0.02 seconds, 1594 bytes code, 36 bytes data.

omf2d Unit1.obj

OMF2D 1.01 converts 32bit OMF to Delphi linkable OMF
Copyright (C) 2003 Radim Picha, http://www.anticracking.sk/EliCZ
Converting "Unit1.obj" to "Unit1.obj"

link -edit Unit1.obj

Microsoft (R) COFF Binary File Editor Version 5.12.8078
Copyright (C) Microsoft Corp 1992-1998. All rights reserved.

Unit1.obj : warning LNK4033: converting object format from OMF to COFF

LINK : warning LNK4041: no edit options specified

ld -T LScript.x Unit1.obj -o Unit1.kex

objcopy -O binary -j .all Unit1.kex
Всё скомпилировалось, конечно, и работает. Вопрос, что это за секции и для чего в Unit1.obj?

Code: Select all

6 _EXIT_
6 _INIT_
0 _TLS

Re: Delphi SDK для Колибри

Posted: Wed Oct 19, 2016 5:26 pm
by //DG
0CodErr wrote:А зачем мне TinyPeInDelphi? Я ведь делаю приложение под KolibriOS.
А затемшта это работающий пример использования D7 + omf2d + link с усеченными system и systemini. А уж какой там формат выходной - что Колибри, что ПЕшка - дело сто десятое.
Я в скрипте для линкера написал просто вот так
У меня просто заглушки вида
procedure _HandleAnyException;
asm
db $cc;
db $01;
end;
А для FPC это у меня все в дело пойдет, будет работать.

Для initialization и finalization я помню там clash был, поэтому для каждого модуля пришлось свой junkname прописывать в omf2d.

Не суть, короче. Главное - семерка работает только так, чтд.

Re: Delphi SDK для Колибри

Posted: Wed Oct 19, 2016 5:28 pm
by //DG
Вопрос, что это за секции и для чего
У меня TLS не создается.

link.exe /FORCE:UNRESOLVED /SUBSYSTEM:WINDOWS /SECTION:.text,ERW /MERGE:.rdata=.text /MERGE:_INIT_=.text /MERGE:_EXIT_=.text /ENTRY:Start$qqsuiuiui Hello.obj abc.obj system.obj kernel32.lib user32.lib /out:Hello.exe /MAP:hello.map > link.log

Re: Delphi SDK для Колибри

Posted: Wed Oct 19, 2016 5:40 pm
by 0CodErr
TinyPeInDelphi
Ну я нагуглил так-то, оно? http://www.delphibasics.info/home/delph ... lphibyn0v4
//DG wrote:Решают сейчас проблему с субаллокатором для FPC.
А FastMM прикрутить можно туда?

Re: Delphi SDK для Колибри

Posted: Wed Oct 19, 2016 5:51 pm
by //DG
0CodErr wrote:
TinyPeInDelphi
Ну я нагуглил так-то, оно? http://www.delphibasics.info/home/delph ... lphibyn0v4
//DG wrote:Решают сейчас проблему с субаллокатором для FPC.
А FastMM прикрутить можно туда?
1) да, на основе него делал
2) теоритически - можно, кто-то это делал со старыми FastMM/FPC, тема гуглится. Лично для меня это не приоритет, несмотря на то, что фастММ круче крутого. Потому что если заиметь хотя бы субаллокатор из libc или os\ это уже прогресс по сравнению с системным.
Меня пока смущает разнобой билиотек в Колибри. Насколько я понимаю, os\ - прототип стандартной библиотеки, вроде kernel32.dll'а, возможно, возьму его аллокатор или библиотеку напрямую (когда разберусь, как ее грузить).

Re: Delphi SDK для Колибри

Posted: Wed Oct 19, 2016 5:54 pm
by 0CodErr
//DG wrote:Насколько я понимаю, os\ - прототип стандартной библиотеки, вроде kernel32.dll'а, возможно, возьму его аллокатор или библиотеку напрямую (когда разберусь, как ее грузить).
Это лучше у её автора уточнить. А я, например, не припомню, чтобы это где-то использовалось.

Re: Delphi SDK для Колибри

Posted: Wed Oct 19, 2016 6:04 pm
by //DG
Просто делать что-то еще с нуля, чтобы еще больше библиотек было, как-то неохота. И тратить память по странице за раз тоже :)
All times are UTC+03:00
Page 3 of 4

Powered by phpBB® Forum Software © phpBB Limited