paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-08 02:07:53 +02:00
Code Issues Packages Projects Releases Wiki Activity

* OS/2 compilation fixes (not completely finished yet)

Browse Source 
git-svn-id: trunk@6937 -
This commit is contained in:
Tomas Hajny 2007-03-20 00:49:20 +00:00
parent 0b3ddb0b82
commit 30b78920cd
5 changed files with 110 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
compiler/aggas.pas
View File

@ -82,6 +82,11 @@ interface
end;
TAoutGNUAssembler=class(TGNUAssembler)
function sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;override;
end;
implementation
uses
@ -1141,6 +1146,51 @@ implementation
end;
{****************************************************************************}
{ a.out/GNU Assembler writer }
{****************************************************************************}
function TAoutGNUAssembler.sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;
const
(* Translation table - replace unsupported section types with basic ones. *)
SecXTable: array[TAsmSectionType] of TAsmSectionType = (
sec_none,
sec_code,
sec_data,
sec_data (* sec_rodata *),
sec_bss,
sec_data (* sec_threadvar *),
{ used for wince exception handling }
sec_code (* sec_pdata *),
{ used for darwin import stubs }
sec_code (* sec_stub *),
{ stabs }
sec_stab,sec_stabstr,
{ win32 }
sec_data (* sec_idata2 *),
sec_data (* sec_idata4 *),
sec_data (* sec_idata5 *),
sec_data (* sec_idata6 *),
sec_data (* sec_idata7 *),
sec_data (* sec_edata *),
{ C++ exception handling unwinding (uses dwarf) }
sec_eh_frame,
{ dwarf }
sec_debug_frame,
sec_debug_info,
sec_debug_line,
sec_debug_abbrev,
{ ELF resources (+ references to stabs debug information sections) }
sec_code (* sec_fpc *),
{ Table of contents section }
sec_code (* sec_toc *),
sec_code (* sec_init *)
);
begin
Result := inherited SectionName (SecXTable [AType], AName, AOrder);
end;
{****************************************************************************}
{ Abstract Instruction Writer }
{****************************************************************************}

18
compiler/pdecsub.pas
View File

@ -2113,13 +2113,25 @@ const
if assigned(pd.import_dll) then
begin
{ If we are not using direct dll linking under win32 then imports
need to use the normal name since to functions can refer to the
need to use the normal name since two functions can refer to the
same DLL function. This is also needed for compatability
with Delphi and TP7 }
(*
case target_info.system of
system_i386_emx,
system_i386_os2 :
begin
{ keep normal mangledname }
if not (Assigned (PD.Import_Name)) then
Result := PD.MangledName;
end;
else
*)
if assigned(pd.import_name) then
begin
if target_info.system in system_all_windows then
{ cprefix is not used in DLL imports under Windows }
if target_info.system in (system_all_windows +
[system_i386_emx, system_i386_os2]) then
{ cprefix is not used in DLL imports under Windows or OS/2 }
result:=pd.import_name^
else
result:=maybe_cprefix(pd.import_name^);

2
compiler/psub.pas
View File

@ -1541,7 +1541,7 @@ implementation
(pd.hasforward) and
not(
assigned(pd.import_dll) and
(target_info.system in [system_i386_wdosx,system_i386_emx,system_i386_os2,
(target_info.system in [system_i386_wdosx,
system_arm_wince,system_i386_wince])
) then
begin

38
compiler/systems/t_os2.pas
View File

@ -284,21 +284,29 @@ procedure AddImport(const module:string;index:longint;const name:string);
module = Name of DLL to import from.
index = Index of function in DLL. Use 0 to import by name.
name = Name of function in DLL. Ignored when index=0;}
(*
var tmp1,tmp2,tmp3:string;
*)
var tmp1,tmp3:string;
sym_mcount,sym_import:longint;
fixup_mcount,fixup_import:longint;
func : string;
begin
aout_init;
(*
tmp2:=func;
if profile_flag and not (copy(func,1,4)='_16_') then
*)
if profile_flag and not (copy(Name,1,4)='_16_') then
begin
{sym_entry:=aout_sym(func,n_text+n_ext,0,0,aout_text_size);}
sym_mcount:=aout_sym('__mcount',n_ext,0,0,0);
{Use, say, "_$U_DosRead" for "DosRead" to import the
non-profiled function.}
(*
tmp2:='__$U_'+func;
sym_import:=aout_sym(tmp2,n_ext,0,0,0);
*)
sym_import:=aout_sym(name,n_ext,0,0,0);
aout_text_byte($55); {push ebp}
aout_text_byte($89); {mov ebp, esp}
aout_text_byte($e5);
@ -315,14 +323,24 @@ begin
end;
str(seq_no,tmp1);
tmp1:='IMPORT#'+tmp1;
(*
if name='' then
*)
if index<>0 then
begin
str(index,tmp3);
(*
tmp3:=func+'='+module+'.'+tmp3;
*)
tmp3:=Name+'='+module+'.'+tmp3;
end
else
tmp3:=Name+'='+module+'.'+name;
(*
tmp3:=func+'='+module+'.'+name;
aout_sym(tmp2,n_imp1+n_ext,0,0,0);
*)
aout_sym(Name,n_imp1+n_ext,0,0,0);
aout_sym(tmp3,n_imp2+n_ext,0,0,0);
aout_finish;
write_ar(tmp1,aout_size);
@ -340,22 +358,24 @@ end;
ImportLibrary : TImportLibrary;
ImportSymbol : TImportSymbol;
begin
LibName:=FixFileName(Current_Module.RealModuleName^ + Target_Info.StaticCLibExt);
seq_no:=1;
current_module.linkotherstaticlibs.add(libname,link_always);
assign(out_file,current_module.outputpath^+libname);
rewrite(out_file,1);
blockwrite(out_file,ar_magic,sizeof(ar_magic));
for i:=0 to current_module.ImportLibraryList.Count-1 do
begin
ImportLibrary:=TImportLibrary(current_module.ImportLibraryList[i]);
LibName:=FixFileName(ImportLibrary.Name + Target_Info.StaticCLibExt);
seq_no:=1;
current_module.linkotherstaticlibs.add(libname,link_always);
assign(out_file,current_module.outputpath^+libname);
rewrite(out_file,1);
blockwrite(out_file,ar_magic,sizeof(ar_magic));
{ LibName:=FixFileName(ImportLibrary.Name + Target_Info.StaticCLibExt);}
for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do
begin
ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]);
AddImport(ImportLibrary.Name,ImportSymbol.OrdNr,ImportSymbol.Name);
AddImport(ChangeFileExt(ExtractFileName(ImportLibrary.Name),''),ImportSymbol.OrdNr,ImportSymbol.Name);
end;
close(out_file);
end;
close(out_file);
end;

16
compiler/x86/agx86att.pas
View File

@ -41,6 +41,10 @@ interface
constructor create(smart: boolean); override;
end;
Tx86AoutGNUAssembler=class(TAoutGNUassembler)
constructor create(smart: boolean); override;
end;
Tx86InstrWriter=class(TCPUInstrWriter)
private
@ -83,6 +87,16 @@ interface
InstrWriter := Tx86InstrWriter.create(self);
end;
{****************************************************************************
Tx86AoutGNUAssembler
****************************************************************************}
constructor Tx86AoutGNUAssembler.create(smart: boolean);
begin
inherited create(smart);
InstrWriter := Tx86InstrWriter.create(self);
end;
{****************************************************************************
Tx86InstrWriter
****************************************************************************}
@ -339,6 +353,6 @@ initialization
RegisterAssembler(as_i386_as_info,Tx86ATTAssembler);
RegisterAssembler(as_i386_gas_info,Tx86ATTAssembler);
RegisterAssembler(as_i386_gas_darwin_info,Tx86AppleGNUAssembler);
RegisterAssembler(as_i386_as_aout_info,Tx86ATTAssembler);
RegisterAssembler(as_i386_as_aout_info,Tx86AoutGNUAssembler);
{$endif x86_64}
end.