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

* Merge is complete for this file, cycles !

Browse Source
This commit is contained in:
mazen 2004-10-14 14:47:52 +00:00
parent 70fd9e8c81
commit 7321a78e1c
1 changed files with 60 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

71
compiler/assemble.pas
View File

@ -33,13 +33,12 @@ interface
uses uses
{$ifdef Delphi} {$IFDEF USE_SYSUTILS}
sysutils, sysutils,
dmisc, {$ELSE USE_SYSUTILS}
{$else Delphi}
strings, strings,
dos, dos,
{$endif Delphi} {$ENDIF USE_SYSUTILS}
systems,globtype,globals,aasmbase,aasmtai,ogbase; systems,globtype,globals,aasmbase,aasmtai,ogbase;
const const
@ -94,7 +93,7 @@ interface
{# Actually does the call to the assembler file. Returns false {# Actually does the call to the assembler file. Returns false
if the assembling of the file failed.} if the assembling of the file failed.}
Function CallAssembler(const command,para:string):Boolean; Function CallAssembler(const command:string; const para:TCmdStr):Boolean;
Function DoAssemble:boolean;virtual; Function DoAssemble:boolean;virtual;
Procedure RemoveAsm; Procedure RemoveAsm;
@ -284,27 +283,45 @@ Implementation
procedure TExternalAssembler.CreateSmartLinkPath(const s:string); procedure TExternalAssembler.CreateSmartLinkPath(const s:string);
var var
{$IFDEF USE_SYSUTILS}
dir : TSearchRec;
{$ELSE USE_SYSUTILS}
dir : searchrec; dir : searchrec;
{$ENDIF USE_SYSUTILS}
hs : string; hs : string;
begin begin
if PathExists(s) then if PathExists(s) then
begin begin
{ the path exists, now we clean only all the .o and .s files } { the path exists, now we clean only all the .o and .s files }
{ .o files } { .o files }
{$IFDEF USE_SYSUTILS}
if findfirst(s+source_info.dirsep+'*'+target_info.objext,faAnyFile,dir) = 0
then repeat
RemoveFile(s+source_info.dirsep+dir.name);
until findnext(dir) <> 0;
{$ELSE USE_SYSUTILS}
findfirst(s+source_info.dirsep+'*'+target_info.objext,anyfile,dir); findfirst(s+source_info.dirsep+'*'+target_info.objext,anyfile,dir);
while (doserror=0) do while (doserror=0) do
begin begin
RemoveFile(s+source_info.dirsep+dir.name); RemoveFile(s+source_info.dirsep+dir.name);
findnext(dir); findnext(dir);
end; end;
{$ENDIF USE_SYSUTILS}
findclose(dir); findclose(dir);
{ .s files } { .s files }
{$IFDEF USE_SYSUTILS}
if findfirst(s+source_info.dirsep+'*'+target_info.asmext,faAnyFile,dir) = 0
then repeat
RemoveFile(s+source_info.dirsep+dir.name);
until findnext(dir) <> 0;
{$ELSE USE_SYSUTILS}
findfirst(s+source_info.dirsep+'*'+target_info.asmext,anyfile,dir); findfirst(s+source_info.dirsep+'*'+target_info.asmext,anyfile,dir);
while (doserror=0) do while (doserror=0) do
begin begin
RemoveFile(s+source_info.dirsep+dir.name); RemoveFile(s+source_info.dirsep+dir.name);
findnext(dir); findnext(dir);
end; end;
{$ENDIF USE_SYSUTILS}
findclose(dir); findclose(dir);
end end
else else
@ -358,10 +375,30 @@ Implementation
end; end;
Function TExternalAssembler.CallAssembler(const command,para:string):Boolean; Function TExternalAssembler.CallAssembler(const command:string; const para:TCmdStr):Boolean;
{$IFDEF USE_SYSUTILS}
var
DosExitCode:Integer;
{$ENDIF USE_SYSUTILS}
begin begin
callassembler:=true; callassembler:=true;
if not(cs_asm_extern in aktglobalswitches) then if not(cs_asm_extern in aktglobalswitches) then
{$IFDEF USE_SYSUTILS}
try
DosExitCode := ExecuteProcess(command,para);
if DosExitCode <>0
then begin
Message1(exec_e_error_while_assembling,tostr(dosexitcode));
callassembler:=false;
end;
except on E:EOSError do
begin
Message1(exec_e_cant_call_assembler,tostr(E.ErrorCode));
aktglobalswitches:=aktglobalswitches+[cs_asm_extern];
callassembler:=false;
end
end
{$ELSE USE_SYSUTILS}
begin begin
swapvectors; swapvectors;
exec(command,para); exec(command,para);
@ -379,6 +416,7 @@ Implementation
callassembler:=false; callassembler:=false;
end; end;
end end
{$ENDIF USE_SYSUTILS}
else else
AsmRes.AddAsmCommand(command,para,name); AsmRes.AddAsmCommand(command,para,name);
end; end;
@ -405,7 +443,7 @@ Implementation
Function TExternalAssembler.DoAssemble:boolean; Function TExternalAssembler.DoAssemble:boolean;
var var
s : string; s : TCmdStr;
begin begin
DoAssemble:=true; DoAssemble:=true;
if DoPipe then if DoPipe then
@ -567,7 +605,7 @@ Implementation
procedure TExternalAssembler.AsmClose; procedure TExternalAssembler.AsmClose;
var var
f : file; f : file;
l : longint; FileAge : longint;
begin begin
AsmFlush; AsmFlush;
{$ifdef hasunix} {$ifdef hasunix}
@ -588,10 +626,18 @@ Implementation
{$I+} {$I+}
if ioresult=0 then if ioresult=0 then
begin begin
getftime(f,l); {$IFDEF USE_SYSUTILS}
FileAge := FileGetDate(GetFileHandle(f));
{$ELSE USE_SYSUTILS}
GetFTime(f, FileAge);
{$ENDIF USE_SYSUTILS}
close(f); close(f);
reset(outfile,1); reset(outfile,1);
setftime(outfile,l); {$IFDEF USE_SYSUTILS}
FileSetDate(GetFileHandle(outFile),FileAge);
{$ELSE USE_SYSUTILS}
SetFTime(f, FileAge);
{$ENDIF USE_SYSUTILS}
end; end;
end; end;
close(outfile); close(outfile);
@ -1638,7 +1684,10 @@ Implementation
end. end.
{ {
$Log$ $Log$
Revision 1.79 2004-10-13 17:58:54 peter Revision 1.80 2004-10-14 14:47:52 mazen
* Merge is complete for this file, cycles !
Revision 1.79 2004/10/13 17:58:54 peter
* reverted USE_SYSUTILS patch until ll patches are readyt * reverted USE_SYSUTILS patch until ll patches are readyt
Revision 1.77 2004/10/08 15:52:40 florian Revision 1.77 2004/10/08 15:52:40 florian