Board.KolibriOS.org

Official KolibriOS board
It is currently Tue Apr 23, 2019 9:48 am

All times are UTC+03:00




Post new topic  Reply to topic  [ 51 posts ]  Go to page Previous 1 2 3 4 Next
Author Message
PostPosted: Wed Oct 05, 2016 9:29 pm 
Offline

Joined: Tue Oct 04, 2016 10:05 pm
Posts: 44
Ок, и между модулями работает. Скриншоты нннада?

Code:
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:
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:
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:
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)


Top
   
PostPosted: Wed Oct 05, 2016 10:16 pm 
Offline
User avatar

Joined: Tue May 08, 2007 12:44 am
Posts: 346
//DG wrote:
Ок, и между модулями работает. Скриншоты нннада?

Map-файла будет достаточно.

_________________
Разработчик языка программирования Кантор


Top
   
PostPosted: Wed Oct 05, 2016 10:41 pm 
Offline

Joined: Tue Oct 04, 2016 10:05 pm
Posts: 44
Freeman wrote:
//DG wrote:
Ок, и между модулями работает. Скриншоты нннада?

Map-файла будет достаточно.

Пожалуйста. (А с фига ли extension map is not allowed на форуме?)


Attachments:
hello_map.txt [9.03 KiB]
Downloaded 71 times
Top
   
PostPosted: Wed Oct 19, 2016 10:22 am 
Offline

Joined: Sun Oct 30, 2011 6:43 pm
Posts: 1499
Ну попробовал я эту вашу omf2d. После неё у меня LD чем-то недоволен.
Исходник:
Spoiler: Show
Code:
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: Show
Code:
@@Halt0
@@InitExe     
@Finalization 
@@HandleFinally
@initialization
Spoiler: Show
Quote:
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

А тем извращенским способом http://board.kolibrios.org/viewtopic.php?f=9&t=2318#p66300 приложение запускается и работает, результат — это вот:
Spoiler: Show
Image
Подобное в принципе можно собрать и FreePascal-ем, и Delphi2(только она VarArgs не понимает, и Cardinal там на самом деле 31-битный — в некоторых случаях достаточно просто заменить на Integer).
Я думаю, другую тему завести, про Delphi\FreePascal с примерами и обёртками.


Top
   
PostPosted: Wed Oct 19, 2016 1:30 pm 
Offline

Joined: Tue Oct 04, 2016 10:05 pm
Posts: 44
0CodErr wrote:
Ну попробовал я эту вашу omf2d. После неё у меня LD чем-то недоволен.
Исходник:
Spoiler: Show
Code:
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: Show
Code:
@@Halt0
@@InitExe     
@Finalization 
@@HandleFinally
@initialization
Spoiler: Show
Quote:
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

А тем извращенским способом http://board.kolibrios.org/viewtopic.php?f=9&t=2318#p66300 приложение запускается и работает, результат — это вот:
Spoiler: Show
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 настроенный.


Top
   
PostPosted: Wed Oct 19, 2016 1:37 pm 
Offline

Joined: Tue Oct 04, 2016 10:05 pm
Posts: 44
0CodErr wrote:
Я думаю, другую тему завести, про Delphi\FreePascal с примерами и обёртками.

Решают сейчас проблему с субаллокатором для FPC. Пока изучаю ваши библиотеки, как вы работаете со своими obj/dll


Top
   
PostPosted: Wed Oct 19, 2016 1:38 pm 
Offline

Joined: Tue Oct 04, 2016 10:05 pm
Posts: 44
А, еще вспомнил: при таком методе все строится на unitах, без program.


Top
   
PostPosted: Wed Oct 19, 2016 4:24 pm 
Offline

Joined: Sun Oct 30, 2011 6:43 pm
Posts: 1499
//DG wrote:
при таком методе все строится на unitах, без program.
Это похоже, что ключевой момент.

А зачем мне TinyPeInDelphi? Я ведь делаю приложение под KolibriOS.
//DG wrote:
А их надо было дефайнить иначе - инициализация и финализация referenceятся компилятором, их надо дефайнить в null.
Я в скрипте для линкера написал просто вот так:
Code:
"@@Halt0"         = 0;
"@@InitExe"       = 0;
"@@HandleFinally" = 0;
"@initialization" = 0;
А в случае с FreePascal пришлось так:
Code:
"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.


Top
   
PostPosted: Wed Oct 19, 2016 5:24 pm 
Offline

Joined: Sun Oct 30, 2011 6:43 pm
Posts: 1499
0CodErr wrote:
На Unit-ах попроще
Ну собственно вот:
Spoiler: Show
Code:
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: Show
Code:
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: Show
Code:
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: Show
Quote:
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:
6 _EXIT_
6 _INIT_
0 _TLS


Top
   
PostPosted: Wed Oct 19, 2016 5:26 pm 
Offline

Joined: Tue Oct 04, 2016 10:05 pm
Posts: 44
0CodErr wrote:
А зачем мне TinyPeInDelphi? Я ведь делаю приложение под KolibriOS.

А затемшта это работающий пример использования D7 + omf2d + link с усеченными system и systemini. А уж какой там формат выходной - что Колибри, что ПЕшка - дело сто десятое.

Quote:
Я в скрипте для линкера написал просто вот так

У меня просто заглушки вида
procedure _HandleAnyException;
asm
db $cc;
db $01;
end;
А для FPC это у меня все в дело пойдет, будет работать.

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

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


Top
   
PostPosted: Wed Oct 19, 2016 5:28 pm 
Offline

Joined: Tue Oct 04, 2016 10:05 pm
Posts: 44
Quote:
Вопрос, что это за секции и для чего

У меня 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


Top
   
PostPosted: Wed Oct 19, 2016 5:40 pm 
Offline

Joined: Sun Oct 30, 2011 6:43 pm
Posts: 1499
Quote:
TinyPeInDelphi
Ну я нагуглил так-то, оно? http://www.delphibasics.info/home/delphibasicsarticles/smallapplicationsindelphibyn0v4
//DG wrote:
Решают сейчас проблему с субаллокатором для FPC.
А FastMM прикрутить можно туда?


Top
   
PostPosted: Wed Oct 19, 2016 5:51 pm 
Offline

Joined: Tue Oct 04, 2016 10:05 pm
Posts: 44
0CodErr wrote:
Quote:
TinyPeInDelphi
Ну я нагуглил так-то, оно? http://www.delphibasics.info/home/delphibasicsarticles/smallapplicationsindelphibyn0v4
//DG wrote:
Решают сейчас проблему с субаллокатором для FPC.
А FastMM прикрутить можно туда?


1) да, на основе него делал
2) теоритически - можно, кто-то это делал со старыми FastMM/FPC, тема гуглится. Лично для меня это не приоритет, несмотря на то, что фастММ круче крутого. Потому что если заиметь хотя бы субаллокатор из libc или os\ это уже прогресс по сравнению с системным.
Меня пока смущает разнобой билиотек в Колибри. Насколько я понимаю, os\ - прототип стандартной библиотеки, вроде kernel32.dll'а, возможно, возьму его аллокатор или библиотеку напрямую (когда разберусь, как ее грузить).


Top
   
PostPosted: Wed Oct 19, 2016 5:54 pm 
Offline

Joined: Sun Oct 30, 2011 6:43 pm
Posts: 1499
//DG wrote:
Насколько я понимаю, os\ - прототип стандартной библиотеки, вроде kernel32.dll'а, возможно, возьму его аллокатор или библиотеку напрямую (когда разберусь, как ее грузить).
Это лучше у её автора уточнить. А я, например, не припомню, чтобы это где-то использовалось.


Top
   
PostPosted: Wed Oct 19, 2016 6:04 pm 
Offline

Joined: Tue Oct 04, 2016 10:05 pm
Posts: 44
Просто делать что-то еще с нуля, чтобы еще больше библиотек было, как-то неохота. И тратить память по странице за раз тоже :)


Top
   
Display posts from previous:  Sort by  
Post new topic  Reply to topic  [ 51 posts ]  Go to page Previous 1 2 3 4 Next

All times are UTC+03:00


Who is online

Users browsing this forum: No registered users and 1 guest


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot post attachments in this forum

Search for:
Jump to:  
Powered by phpBB® Forum Software © phpBB Limited