mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-10 06:08:17 +02:00
fpc patch: all wished for revisions have been merged, so this is merely a dormant stub now
git-svn-id: trunk@11405 -
This commit is contained in:
vincents
parent
8476560e0f
commit
14c9c1fef0
@ -1,467 +1,3 @@
|
||||
Index: compiler/fppu.pas
|
||||
===================================================================
|
||||
--- compiler/fppu.pas (revision 7769)
|
||||
+++ compiler/fppu.pas (working copy)
|
||||
@@ -71,12 +71,14 @@
|
||||
procedure writederefmap;
|
||||
procedure writederefdata;
|
||||
procedure writeImportSymbols;
|
||||
+ procedure writeResources;
|
||||
procedure readsourcefiles;
|
||||
procedure readloadunit;
|
||||
procedure readlinkcontainer(var p:tlinkcontainer);
|
||||
procedure readderefmap;
|
||||
procedure readderefdata;
|
||||
procedure readImportSymbols;
|
||||
+ procedure readResources;
|
||||
{$IFDEF MACRO_DIFF_HINT}
|
||||
procedure writeusedmacro(p:TNamedIndexItem;arg:pointer);
|
||||
procedure writeusedmacros;
|
||||
@@ -624,6 +626,20 @@
|
||||
end;
|
||||
|
||||
|
||||
+ procedure tppumodule.writeResources;
|
||||
+ var
|
||||
+ res : TCmdStrListItem;
|
||||
+ begin
|
||||
+ res:=TCmdStrListItem(ResourceFiles.First);
|
||||
+ while res<>nil do
|
||||
+ begin
|
||||
+ ppufile.putstring(res.FPStr);
|
||||
+ res:=TCmdStrListItem(res.Next);
|
||||
+ end;
|
||||
+ ppufile.writeentry(ibresources);
|
||||
+ end;
|
||||
+
|
||||
+
|
||||
{$IFDEF MACRO_DIFF_HINT}
|
||||
|
||||
{
|
||||
@@ -877,6 +893,13 @@
|
||||
end;
|
||||
|
||||
|
||||
+ procedure tppumodule.readResources;
|
||||
+ begin
|
||||
+ while not ppufile.endofentry do
|
||||
+ resourcefiles.Insert(ppufile.getstring);
|
||||
+ end;
|
||||
+
|
||||
+
|
||||
procedure tppumodule.load_interface;
|
||||
var
|
||||
b : byte;
|
||||
@@ -923,6 +946,8 @@
|
||||
readderefmap;
|
||||
ibderefdata :
|
||||
readderefdata;
|
||||
+ ibresources:
|
||||
+ readResources;
|
||||
ibendinterface :
|
||||
break;
|
||||
else
|
||||
@@ -1006,6 +1031,7 @@
|
||||
writelinkcontainer(linkotherstaticlibs,iblinkotherstaticlibs,true);
|
||||
writelinkcontainer(linkothersharedlibs,iblinkothersharedlibs,true);
|
||||
writeImportSymbols;
|
||||
+ writeResources;
|
||||
ppufile.do_crc:=true;
|
||||
|
||||
{ generate implementation deref data, the interface deref data is
|
||||
Index: compiler/pmodules.pas
|
||||
===================================================================
|
||||
--- compiler/pmodules.pas (revision 7769)
|
||||
+++ compiler/pmodules.pas (working copy)
|
||||
@@ -1474,6 +1474,9 @@
|
||||
{ create dwarf debuginfo }
|
||||
create_dwarf;
|
||||
|
||||
+ { create global resource file by collecting all resource files }
|
||||
+ CollectResourceFiles;
|
||||
+
|
||||
{ insert own objectfile }
|
||||
insertobjectfile;
|
||||
|
||||
Index: compiler/comprsrc.pas
|
||||
===================================================================
|
||||
--- compiler/comprsrc.pas (revision 7769)
|
||||
+++ compiler/comprsrc.pas (working copy)
|
||||
@@ -26,28 +26,44 @@
|
||||
interface
|
||||
|
||||
uses
|
||||
- Systems;
|
||||
+ Systems, cstreams;
|
||||
|
||||
type
|
||||
+ tresoutput = (roRES, roOBJ);
|
||||
+
|
||||
tresourcefile = class(TAbstractResourceFile)
|
||||
private
|
||||
fname : ansistring;
|
||||
public
|
||||
constructor Create(const fn : ansistring);override;
|
||||
- procedure Compile;virtual;
|
||||
+ procedure Compile(output: tresoutput; const OutName: ansistring);virtual;
|
||||
procedure PostProcessResourcefile(const s : ansistring);virtual;
|
||||
+ function IsCompiled(const fn : ansistring) : boolean;virtual;
|
||||
+ procedure Collect(const fn : ansistring);virtual;
|
||||
end;
|
||||
+
|
||||
+ TWinLikeResourceFile = class(tresourcefile)
|
||||
+ private
|
||||
+ FOut: TCFileStream;
|
||||
+ public
|
||||
+ function IsCompiled(const fn : ansistring) : boolean;override;
|
||||
+ procedure Collect(const fn : ansistring);override;
|
||||
+ end;
|
||||
|
||||
procedure CompileResourceFiles;
|
||||
+procedure CollectResourceFiles;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
SysUtils,
|
||||
- cutils,cfileutils,
|
||||
+ cutils,cfileutils,cclasses,
|
||||
Globtype,Globals,Verbose,Fmodule,
|
||||
Script;
|
||||
+
|
||||
+const
|
||||
+ GlobalResName = 'fpc-res';
|
||||
|
||||
{****************************************************************************
|
||||
TRESOURCEFILE
|
||||
@@ -64,23 +80,42 @@
|
||||
end;
|
||||
|
||||
|
||||
-procedure tresourcefile.compile;
|
||||
+function tresourcefile.IsCompiled(const fn: ansistring): boolean;
|
||||
+begin
|
||||
+ Result:=CompareText(ExtractFileExt(fn), target_info.resobjext) = 0;
|
||||
+end;
|
||||
+
|
||||
+
|
||||
+procedure tresourcefile.Collect(const fn: ansistring);
|
||||
+begin
|
||||
+ if fn='' then
|
||||
+ exit;
|
||||
+ fname:=fn;
|
||||
+ Compile(roOBJ, ChangeFileExt(fn, target_info.resobjext));
|
||||
+end;
|
||||
+
|
||||
+
|
||||
+procedure tresourcefile.compile(output: tresoutput; const OutName: ansistring);
|
||||
var
|
||||
respath,
|
||||
srcfilepath,
|
||||
- n,
|
||||
s,
|
||||
- resobj,
|
||||
+ bin,
|
||||
resbin : TCmdStr;
|
||||
resfound,
|
||||
objused : boolean;
|
||||
begin
|
||||
- resbin:='';
|
||||
+ if output=roRES then
|
||||
+ bin:=target_res.rcbin
|
||||
+ else
|
||||
+ bin:=target_res.resbin;
|
||||
+ if bin='' then
|
||||
+ exit;
|
||||
resfound:=false;
|
||||
if utilsdirectory<>'' then
|
||||
- resfound:=FindFile(utilsprefix+target_res.resbin+source_info.exeext,utilsdirectory,false,resbin);
|
||||
+ resfound:=FindFile(utilsprefix+bin+source_info.exeext,utilsdirectory,false,resbin);
|
||||
if not resfound then
|
||||
- resfound:=FindExe(utilsprefix+target_res.resbin,false,resbin);
|
||||
+ resfound:=FindExe(utilsprefix+bin,false,resbin);
|
||||
{ get also the path to be searched for the windres.h }
|
||||
respath:=ExtractFilePath(resbin);
|
||||
if (not resfound) and not(cs_link_nolink in current_settings.globalswitches) then
|
||||
@@ -89,18 +124,25 @@
|
||||
current_settings.globalswitches:=current_settings.globalswitches+[cs_link_nolink];
|
||||
end;
|
||||
srcfilepath:=ExtractFilePath(current_module.mainsource^);
|
||||
- resobj:=current_module.outputpath^+ChangeFileExt(ExtractFileName(fname),target_info.resobjext);
|
||||
- if not path_absolute(fname) then
|
||||
- fname:=srcfilepath+fname;
|
||||
- s:=target_res.rescmd;
|
||||
- ObjUsed:=(pos('$OBJ',s)>0);
|
||||
- Replace(s,'$OBJ',maybequoted(resobj));
|
||||
- Replace(s,'$RES',maybequoted(fname));
|
||||
+ if output=roRES then
|
||||
+ begin
|
||||
+ s:=target_res.rccmd;
|
||||
+ Replace(s,'$RES',maybequoted(OutName));
|
||||
+ Replace(s,'$RC',maybequoted(fname));
|
||||
+ ObjUsed:=False;
|
||||
+ end
|
||||
+ else
|
||||
+ begin
|
||||
+ s:=target_res.rescmd;
|
||||
+ ObjUsed:=(pos('$OBJ',s)>0);
|
||||
+ Replace(s,'$OBJ',maybequoted(OutName));
|
||||
+ Replace(s,'$RES',maybequoted(fname));
|
||||
+ end;
|
||||
{ windres doesn't like empty include paths }
|
||||
if respath='' then
|
||||
respath:='.';
|
||||
Replace(s,'$INC',maybequoted(respath));
|
||||
- if (target_info.system = system_i386_win32) and
|
||||
+ if (target_res.resbin='windres') and
|
||||
(srcfilepath<>'') then
|
||||
s:=s+' --include '+maybequoted(srcfilepath);
|
||||
{ Execute the command }
|
||||
@@ -123,35 +165,197 @@
|
||||
end
|
||||
end;
|
||||
end;
|
||||
- PostProcessResourcefile(maybequoted(resobj));
|
||||
+ if output=roOBJ then
|
||||
+ PostProcessResourcefile(OutName);
|
||||
{ Update asmres when externmode is set }
|
||||
if cs_link_nolink in current_settings.globalswitches then
|
||||
AsmRes.AddLinkCommand(resbin,s,'');
|
||||
- if ObjUsed then
|
||||
- current_module.linkunitofiles.add(resobj,link_always);
|
||||
+ if (output=roOBJ) and ObjUsed then
|
||||
+ current_module.linkunitofiles.add(OutName,link_always);
|
||||
end;
|
||||
|
||||
|
||||
+function TWinLikeResourceFile.IsCompiled(const fn: ansistring): boolean;
|
||||
+const
|
||||
+ ResSignature : array [1..32] of byte =
|
||||
+ ($00,$00,$00,$00,$20,$00,$00,$00,$FF,$FF,$00,$00,$FF,$FF,$00,$00,
|
||||
+ $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00);
|
||||
+var
|
||||
+ f : file;
|
||||
+ oldfmode : byte;
|
||||
+ buf: array[1..32] of byte;
|
||||
+ i: longint;
|
||||
+begin
|
||||
+ Result:=CompareText(ExtractFileExt(fn), target_info.resext) = 0;
|
||||
+ if Result then exit;
|
||||
+ oldfmode:=Filemode;
|
||||
+ Filemode:=0;
|
||||
+ assign(f,fn);
|
||||
+ reset(f,1);
|
||||
+ BlockRead(f, buf, SizeOf(buf), i);
|
||||
+ close(f);
|
||||
+ Filemode:=oldfmode;
|
||||
+
|
||||
+ if i<>SizeOf(buf) then
|
||||
+ exit;
|
||||
+
|
||||
+ for i:=1 to 32 do
|
||||
+ if buf[i]<>ResSignature[i] then
|
||||
+ exit;
|
||||
+
|
||||
+ Result:=True;
|
||||
+end;
|
||||
+
|
||||
+
|
||||
+procedure TWinLikeResourceFile.Collect(const fn: ansistring);
|
||||
+const
|
||||
+ zeroes: array[1..3] of byte = (0,0,0);
|
||||
+var
|
||||
+ fs: TCFileStream;
|
||||
+ i: longint;
|
||||
+begin
|
||||
+ if fn='' then
|
||||
+ begin
|
||||
+ if FOut<>nil then
|
||||
+ begin
|
||||
+ FOut.Free;
|
||||
+ Compile(roOBJ,ChangeFileExt(fname,target_info.resobjext));
|
||||
+ end;
|
||||
+ end
|
||||
+ else
|
||||
+ begin
|
||||
+ fs:=TCFileStream.Create(fn,fmOpenRead or fmShareDenyNone);
|
||||
+ if CStreamError<>0 then
|
||||
+ begin
|
||||
+ fs.Free;
|
||||
+ Comment(V_Error,'Can''t open resource file: '+fn);
|
||||
+ exit;
|
||||
+ end;
|
||||
+ if FOut=nil then
|
||||
+ FOut:=TCFileStream.Create(fname,fmCreate)
|
||||
+ else
|
||||
+ fs.Seek(32, soFromBeginning);
|
||||
+ FOut.CopyFrom(fs, fs.Size-fs.Position);
|
||||
+ fs.Free;
|
||||
+ { align resource to dword }
|
||||
+ i:=4 - FOut.Position mod 4;
|
||||
+ if i<4 then
|
||||
+ FOut.WriteBuffer(zeroes, i);
|
||||
+ end;
|
||||
+end;
|
||||
+
|
||||
+
|
||||
procedure CompileResourceFiles;
|
||||
var
|
||||
resourcefile : tresourcefile;
|
||||
+ res: TCmdStrListItem;
|
||||
+ p,s : TCmdStr;
|
||||
+ src,dst : TCFileStream;
|
||||
+ outfmt : tresoutput;
|
||||
begin
|
||||
{ OS/2 (EMX) must be processed elsewhere (in the linking/binding stage).
|
||||
same with MacOS}
|
||||
- if not (target_info.system in [system_i386_os2,
|
||||
- system_i386_emx,system_powerpc_macos]) then
|
||||
- While not current_module.ResourceFiles.Empty do
|
||||
- begin
|
||||
- if target_info.res<>res_none then
|
||||
- begin
|
||||
- resourcefile:=TResourceFile(resinfos[target_info.res]^.resourcefileclass.create(current_module.ResourceFiles.getfirst));
|
||||
- resourcefile.compile;
|
||||
- resourcefile.free;
|
||||
- end
|
||||
- else
|
||||
- Message(scan_e_resourcefiles_not_supported);
|
||||
- end;
|
||||
+ if target_info.system in [system_i386_os2,system_i386_emx,system_powerpc_macos] then exit;
|
||||
+
|
||||
+ p:=ExtractFilePath(current_module.mainsource^);
|
||||
+ res:=TCmdStrListItem(current_module.ResourceFiles.First);
|
||||
+ while res<>nil do
|
||||
+ begin
|
||||
+ if target_info.res=res_none then
|
||||
+ Message(scan_e_resourcefiles_not_supported);
|
||||
+ s:=res.FPStr;
|
||||
+ if not path_absolute(s) then
|
||||
+ s:=p+s;
|
||||
+ resourcefile:=TResourceFile(resinfos[target_info.res]^.resourcefileclass.create(s));
|
||||
+ if resourcefile.IsCompiled(s) then
|
||||
+ begin
|
||||
+ resourcefile.free;
|
||||
+ if CompareText(current_module.outputpath^, p) <> 0 then
|
||||
+ begin
|
||||
+ { Copy .res file to units output dir }
|
||||
+ res.FPStr:=ExtractFileName(res.FPStr);
|
||||
+ src:=TCFileStream.Create(s,fmOpenRead or fmShareDenyNone);
|
||||
+ if CStreamError<>0 then
|
||||
+ begin
|
||||
+ Comment(V_Error,'Can''t open resource file: '+src.FileName);
|
||||
+ exit;
|
||||
+ end;
|
||||
+ dst:=TCFileStream.Create(current_module.outputpath^+res.FPStr,fmCreate);
|
||||
+ if CStreamError<>0 then
|
||||
+ begin
|
||||
+ Comment(V_Error,'Can''t create resource file: '+dst.FileName);
|
||||
+ exit;
|
||||
+ end;
|
||||
+ dst.CopyFrom(src,src.Size);
|
||||
+ dst.Free;
|
||||
+ src.Free;
|
||||
+ end;
|
||||
+ end
|
||||
+ else
|
||||
+ begin
|
||||
+ res.FPStr:=ExtractFileName(res.FPStr);
|
||||
+ if target_res.rcbin='' then
|
||||
+ begin
|
||||
+ { if target does not have .rc to .res compiler, create obj }
|
||||
+ outfmt:=roOBJ;
|
||||
+ res.FPStr:=ChangeFileExt(res.FPStr,target_info.resobjext);
|
||||
+ end
|
||||
+ else
|
||||
+ begin
|
||||
+ outfmt:=roRES;
|
||||
+ res.FPStr:=ChangeFileExt(res.FPStr,target_info.resext);
|
||||
+ end;
|
||||
+ resourcefile.compile(outfmt, current_module.outputpath^+res.FPStr);
|
||||
+ resourcefile.free;
|
||||
+ end;
|
||||
+ res:=TCmdStrListItem(res.Next);
|
||||
+ end;
|
||||
end;
|
||||
|
||||
|
||||
+procedure CollectResourceFiles;
|
||||
+var
|
||||
+ resourcefile : tresourcefile;
|
||||
+
|
||||
+ procedure ProcessModule(u : tmodule);
|
||||
+ var
|
||||
+ res : TCmdStrListItem;
|
||||
+ s : TCmdStr;
|
||||
+ begin
|
||||
+ res:=TCmdStrListItem(u.ResourceFiles.First);
|
||||
+ while assigned(res) do
|
||||
+ begin
|
||||
+ if path_absolute(res.FPStr) then
|
||||
+ s:=res.FPStr
|
||||
+ else
|
||||
+ begin
|
||||
+ s:=u.path^+res.FPStr;
|
||||
+ if not FileExists(s,True) then
|
||||
+ s:=u.outputpath^+res.FPStr;
|
||||
+ end;
|
||||
+ resourcefile.Collect(s);
|
||||
+ res:=TCmdStrListItem(res.Next);
|
||||
+ end;
|
||||
+ end;
|
||||
+
|
||||
+var
|
||||
+ hp : tused_unit;
|
||||
+ s : TCmdStr;
|
||||
+begin
|
||||
+ if (target_info.res=res_none) or (target_res.rcbin='') then
|
||||
+ exit;
|
||||
+ s:=main_module.outputpath^+GlobalResName+target_info.resext;
|
||||
+ resourcefile:=TResourceFile(resinfos[target_info.res]^.resourcefileclass.create(s));
|
||||
+ hp:=tused_unit(usedunits.first);
|
||||
+ while assigned(hp) do
|
||||
+ begin
|
||||
+ ProcessModule(hp.u);
|
||||
+ hp:=tused_unit(hp.next);
|
||||
+ end;
|
||||
+ ProcessModule(current_module);
|
||||
+ { Finish collection }
|
||||
+ resourcefile.Collect('');
|
||||
+ resourcefile.free;
|
||||
+end;
|
||||
+
|
||||
end.
|
||||
Index: compiler/ppu.pas
|
||||
===================================================================
|
||||
--- compiler/ppu.pas (revision 7769)
|
||||
+++ compiler/ppu.pas (working copy)
|
||||
@@ -124,6 +124,7 @@
|
||||
{implementation/ObjData}
|
||||
ibnodetree = 80;
|
||||
ibasmsymbols = 81;
|
||||
+ ibresources = 82;
|
||||
|
||||
{ unit flags }
|
||||
uf_init = $1;
|
||||
Index: compiler/systems.pas
|
||||
===================================================================
|
||||
--- compiler/systems.pas (revision 7769)
|
||||
+++ compiler/systems.pas (working copy)
|
||||
@@ -268,8 +268,13 @@
|
||||
presinfo = ^tresinfo;
|
||||
tresinfo = record
|
||||
id : tres;
|
||||
+ { Compiler for resource (.rc or .res) to obj }
|
||||
resbin : string[8];
|
||||
rescmd : string[50];
|
||||
+ { Optional compiler for resource script (.rc) to binary resource (.res). }
|
||||
+ { If it is not provided resbin and rescmd will be used. }
|
||||
+ rcbin : string[8];
|
||||
+ rccmd : string[50];
|
||||
resourcefileclass : TAbstractResourceFileClass;
|
||||
end;
|
||||
|
||||
Index: compiler/version.pas
|
||||
===================================================================
|
||||
--- compiler/version.pas (revision 7769)
|
||||
@ -475,76 +11,3 @@ Index: compiler/version.pas
|
||||
|
||||
{ word version for ppu file }
|
||||
wordversion = ((ord(version_nr)-ord('0')) shl 14)+
|
||||
Index: compiler/systems/i_linux.pas
|
||||
===================================================================
|
||||
--- compiler/systems/i_linux.pas (revision 7769)
|
||||
+++ compiler/systems/i_linux.pas (working copy)
|
||||
@@ -31,14 +31,20 @@
|
||||
(
|
||||
id : res_elf;
|
||||
resbin : 'fpcres';
|
||||
- rescmd : '-o $OBJ -i $RES'
|
||||
+ rescmd : '-o $OBJ -i $RES';
|
||||
+ { cross compiled windres can be used to compile .rc files on linux }
|
||||
+ rcbin : 'windres';
|
||||
+ rccmd : '--include $INC -O res -o $RES $RC';
|
||||
);
|
||||
|
||||
res_elf64_info : tresinfo =
|
||||
(
|
||||
id : res_elf;
|
||||
resbin : 'fpcres';
|
||||
- rescmd : '-o $OBJ -i $RES'
|
||||
+ rescmd : '-o $OBJ -i $RES';
|
||||
+ { cross compiled windres can be used to compile .rc files on linux }
|
||||
+ rcbin : 'windres';
|
||||
+ rccmd : '--include $INC -O res -o $RES $RC';
|
||||
);
|
||||
|
||||
system_i386_linux_info : tsysteminfo =
|
||||
Index: compiler/systems/t_win.pas
|
||||
===================================================================
|
||||
--- compiler/systems/t_win.pas (revision 7769)
|
||||
+++ compiler/systems/t_win.pas (working copy)
|
||||
@@ -91,7 +91,7 @@
|
||||
end;
|
||||
|
||||
|
||||
- TWinResourceFile = class(TResourceFile)
|
||||
+ TWinResourceFile = class(TWinLikeResourceFile)
|
||||
procedure PostProcessResourcefile(const s : ansistring);override;
|
||||
end;
|
||||
|
||||
@@ -110,14 +110,18 @@
|
||||
(
|
||||
id : res_gnu_windres;
|
||||
resbin : 'windres';
|
||||
- rescmd : '--include $INC -O coff -o $OBJ $RES'
|
||||
+ rescmd : '--include $INC -O coff -o $OBJ $RES';
|
||||
+ rcbin : 'windres';
|
||||
+ rccmd : '--include $INC -O res -o $RES $RC';
|
||||
);
|
||||
|
||||
res_gnu_wince_windres_info : tresinfo =
|
||||
(
|
||||
id : res_gnu_wince_windres;
|
||||
resbin : 'windres';
|
||||
- rescmd : '--include $INC -O coff -o $OBJ $RES'
|
||||
+ rescmd : '--include $INC -O coff -o $OBJ $RES';
|
||||
+ rcbin : 'windres';
|
||||
+ rccmd : '--include $INC -O res -o $RES $RC';
|
||||
);
|
||||
|
||||
|
||||
Index: compiler/options.pas
|
||||
===================================================================
|
||||
--- compiler/options.pas (revision 7769)
|
||||
+++ compiler/options.pas (working copy)
|
||||
@@ -1994,6 +1994,7 @@
|
||||
def_system_macro('FPC_HAS_STR_CURRENCY');
|
||||
def_system_macro('FPC_REAL2REAL_FIXED');
|
||||
def_system_macro('FPC_STRTOCHARARRAYPROC');
|
||||
+ def_system_macro('FPC_MULTIPLERESOURCES_FIXED');
|
||||
{$ifdef SUPPORT_UNALIGNED}
|
||||
def_system_macro('FPC_SUPPORTS_UNALIGNED');
|
||||
{$endif SUPPORT_UNALIGNED}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user