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

* Remove dos,strings units, use SysUtils instead

Browse Source 
* replace split* functions with Extract* functions
  * Add Directory caching

git-svn-id: trunk@5102 -
This commit is contained in:
peter 2006-10-30 23:29:35 +00:00
parent bce905b106
commit cb246eb781
65 changed files with 1735 additions and 1792 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -78,6 +78,7 @@ compiler/bsdcompile -text
compiler/catch.pas svneol=native#text/plain
compiler/cclasses.pas svneol=native#text/plain
compiler/cfidwarf.pas svneol=native#text/plain
compiler/cfileutils.pas svneol=native#text/plain
compiler/cg64f32.pas svneol=native#text/plain
compiler/cgbase.pas svneol=native#text/plain
compiler/cgobj.pas svneol=native#text/plain

2
compiler/aasmbase.pas
View File

@ -123,7 +123,7 @@ interface
implementation
uses
strings,
SysUtils,
verbose;

20
compiler/aasmtai.pas
View File

@ -322,7 +322,7 @@ interface
end;
tai_directive = class(tailineinfo)
name : pstring;
name : pshortstring;
directive : TAsmDirective;
constructor Create(_directive:TAsmDirective;const _name:string);
destructor Destroy;override;
@ -356,7 +356,7 @@ interface
sectype : TAsmSectiontype;
secorder : TasmSectionorder;
secalign : byte;
name : pstring;
name : pshortstring;
sec : TObjSection; { used in binary writer }
constructor Create(Asectype:TAsmSectiontype;Aname:string;Aalign:byte;Asecorder:TasmSectionorder=secorder_default);
destructor Destroy;override;
@ -475,7 +475,7 @@ interface
end;
tai_function_name = class(tai)
funcname : pstring;
funcname : pshortstring;
constructor create(const s:string);
destructor destroy;override;
end;
@ -501,7 +501,7 @@ interface
tai_tempalloc = class(tai)
allocation : boolean;
{$ifdef EXTDEBUG}
problem : pstring;
problem : pshortstring;
{$endif EXTDEBUG}
temppos,
tempsize : longint;
@ -648,7 +648,7 @@ interface
implementation
uses
strings,
SysUtils,
verbose;
const
@ -1584,7 +1584,7 @@ implementation
destructor tai_comment.destroy;
begin
strdispose(str);
freemem(str);
inherited Destroy;
end;
@ -1641,7 +1641,7 @@ implementation
destructor tai_stab.destroy;
begin
strdispose(str);
freemem(str);
inherited destroy;
end;
@ -1890,13 +1890,15 @@ implementation
begin
inherited Create;
typ:=ait_file;
str:=strpnew(_str);
getmem(str,length(_str)+1);
move(_str[1],str^,length(_str));
str[length(_str)]:=#0;
end;
destructor tai_file.destroy;
begin
strdispose(str);
freemem(str);
inherited Destroy;
end;

31
compiler/aggas.pas
View File

@ -29,11 +29,6 @@ unit aggas;
interface
uses
{$IFDEF USE_SYSUTILS}
SysUtils,
{$ELSE USE_SYSUTILS}
dos,
{$ENDIF USE_SYSUTILS}
cclasses,
globtype,globals,
aasmbase,aasmtai,aasmdata,aasmcpu,
@ -90,7 +85,8 @@ interface
implementation
uses
cutils,systems,
SysUtils,
cutils,cfileutils,systems,
fmodule,finput,verbose,
itcpugas,cpubase
;
@ -1031,9 +1027,7 @@ implementation
procedure TGNUAssembler.WriteAsmList;
var
p:dirstr;
n:namestr;
e:extstr;
n : string;
hal : tasmlisttype;
begin
{$ifdef EXTDEBUG}
@ -1046,23 +1040,10 @@ implementation
LastInfile:=nil;
if assigned(current_module.mainsource) then
{$IFDEF USE_SYSUTILS}
begin
p := SplitPath(current_module.mainsource^);
n := SplitName(current_module.mainsource^);
e := SplitExtension(current_module.mainsource^);
end
{$ELSE USE_SYSUTILS}
fsplit(current_module.mainsource^,p,n,e)
{$ENDIF USE_SYSUTILS}
n:=ExtractFileName(current_module.mainsource^)
else
begin
p:=inputdir;
n:=inputfile;
e:=inputextension;
end;
{ to get symify to work }
AsmWriteLn(#9'.file "'+FixFileName(n+e)+'"');
n:=InputFileName;
AsmWriteLn(#9'.file "'+FixFileName(n)+'"');
WriteExtraHeader;
AsmStartSize:=AsmSize;
symendcount:=0;

131
compiler/assemble.pas
View File

@ -32,12 +32,7 @@ interface
uses
{$IFDEF USE_SYSUTILS}
sysutils,
{$ELSE USE_SYSUTILS}
strings,
dos,
{$ENDIF USE_SYSUTILS}
SysUtils,
systems,globtype,globals,aasmbase,aasmtai,aasmdata,ogbase;
const
@ -50,9 +45,8 @@ interface
TAssembler=class(TAbstractAssembler)
public
{filenames}
path : pathstr;
fname, name: namestr; (* name for modulename given in source, fname
for base file name w/o path and extension *)
path : string;
name : string;
AsmFileName, { current .s and .o file }
ObjFileName,
ppufilename : string;
@ -171,16 +165,13 @@ Implementation
uses
{$ifdef hasunix}
{$ifdef havelinuxrtl10}
linux,
{$else}
unix,
{$endif}
{$endif}
cutils,script,fmodule,verbose,
cutils,cfileutils,
{$ifdef memdebug}
cclasses,
{$endif memdebug}
script,fmodule,verbose,
{$ifdef m68k}
cpuinfo,
{$endif m68k}
@ -199,10 +190,9 @@ Implementation
Constructor TAssembler.Create(smart:boolean);
begin
{ load start values }
AsmFileName:=current_module.get_AsmFilename;
AsmFileName:=current_module.AsmFilename^;
ObjFileName:=current_module.ObjFileName^;
name:=Lower(current_module.modulename^);
fname:=current_module.newfilename^;
path:=current_module.outputpath^;
asmprefix := current_module.asmprefix^;
if not assigned(current_module.outputpath) then
@ -263,7 +253,7 @@ Implementation
inherited Create(smart);
if SmartAsm then
begin
path:=FixPath(path+FixFileName(fname)+target_info.smartext,false);
path:=FixPath(path+ChangeFileExt(AsmFileName,target_info.smartext),false);
CreateSmartLinkPath(path);
end;
Outcnt:=0;
@ -271,47 +261,29 @@ Implementation
procedure TExternalAssembler.CreateSmartLinkPath(const s:string);
procedure DeleteFilesWithExt(const AExt:string);
var
dir : TSearchRec;
begin
if findfirst(s+source_info.dirsep+'*'+AExt,faAnyFile,dir) = 0 then
begin
repeat
DeleteFile(s+source_info.dirsep+dir.name);
until findnext(dir) <> 0;
end;
findclose(dir);
end;
var
{$IFDEF USE_SYSUTILS}
dir : TSearchRec;
{$ELSE USE_SYSUTILS}
dir : searchrec;
{$ENDIF USE_SYSUTILS}
hs : string;
begin
if PathExists(s) then
begin
{ the path exists, now we clean only all the .o and .s 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);
while (doserror=0) do
begin
RemoveFile(s+source_info.dirsep+dir.name);
findnext(dir);
end;
{$ENDIF USE_SYSUTILS}
findclose(dir);
{ .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);
while (doserror=0) do
begin
RemoveFile(s+source_info.dirsep+dir.name);
findnext(dir);
end;
{$ENDIF USE_SYSUTILS}
findclose(dir);
DeleteFilesWithExt(target_info.objext);
DeleteFilesWithExt(target_info.asmext);
end
else
begin
@ -329,7 +301,7 @@ Implementation
const
lastas : byte=255;
var
LastASBin : pathstr;
LastASBin : string;
Function TExternalAssembler.FindAssembler:string;
var
asfound : boolean;
@ -339,11 +311,11 @@ Implementation
if cs_link_on_target in current_settings.globalswitches then
begin
{ If linking on target, don't add any path PM }
FindAssembler:=utilsprefix+AddExtension(target_asm.asmbin,target_info.exeext);
FindAssembler:=utilsprefix+ChangeFileExt(target_asm.asmbin,target_info.exeext);
exit;
end
else
UtilExe:=utilsprefix+AddExtension(target_asm.asmbin,source_info.exeext);
UtilExe:=utilsprefix+ChangeFileExt(target_asm.asmbin,source_info.exeext);
if lastas<>ord(target_asm.id) then
begin
lastas:=ord(target_asm.id);
@ -365,51 +337,30 @@ Implementation
Function TExternalAssembler.CallAssembler(const command:string; const para:TCmdStr):Boolean;
{$IFDEF USE_SYSUTILS}
var
DosExitCode:Integer;
{$ENDIF USE_SYSUTILS}
DosExitCode : Integer;
begin
callassembler:=true;
if not(cs_asm_extern in current_settings.globalswitches) then
{$IFDEF USE_SYSUTILS}
result:=true;
if (cs_asm_extern in current_settings.globalswitches) then
begin
AsmRes.AddAsmCommand(command,para,name);
exit;
end;
try
FlushOutput;
DosExitCode := ExecuteProcess(command,para);
if DosExitCode <>0
then begin
Message1(exec_e_error_while_assembling,tostr(dosexitcode));
callassembler:=false;
result:=false;
end;
except on E:EOSError do
begin
Message1(exec_e_cant_call_assembler,tostr(E.ErrorCode));
current_settings.globalswitches:=current_settings.globalswitches+[cs_asm_extern];
callassembler:=false;
end
end
{$ELSE USE_SYSUTILS}
begin
FlushOutput;
swapvectors;
exec(maybequoted(command),para);
swapvectors;
if (doserror<>0) then
begin
Message1(exec_e_cant_call_assembler,tostr(doserror));
current_settings.globalswitches:=current_settings.globalswitches+[cs_asm_extern];
callassembler:=false;
end
else
if (dosexitcode<>0) then
begin
Message1(exec_e_error_while_assembling,tostr(dosexitcode));
callassembler:=false;
end;
end
{$ENDIF USE_SYSUTILS}
else
AsmRes.AddAsmCommand(command,para,name);
result:=false;
end;
end;
end;
@ -632,18 +583,10 @@ Implementation
{$I+}
if ioresult=0 then
begin
{$IFDEF USE_SYSUTILS}
FileAge := FileGetDate(GetFileHandle(f));
{$ELSE USE_SYSUTILS}
GetFTime(f, FileAge);
{$ENDIF USE_SYSUTILS}
close(f);
reset(outfile,1);
{$IFDEF USE_SYSUTILS}
FileSetDate(GetFileHandle(outFile),FileAge);
{$ELSE USE_SYSUTILS}
SetFTime(f, FileAge);
{$ENDIF USE_SYSUTILS}
end;
end;
close(outfile);

27
compiler/browcol.pas
View File

@ -24,8 +24,15 @@
{$N+,E+}
{$endif}
unit browcol;
{$i fpcdefs.inc}
{$H-}
interface
uses
SysUtils,
CUtils,
objects,
cclasses,
symconst,symtable;
@ -218,7 +225,7 @@ type
UsedUnits : PSymbolCollection;
DependentUnits: PSymbolCollection;
MainSource: PString;
SourceFiles: PStringCollection;
SourceFiles: pstringCollection;
constructor Init(const AName, AMainSource: string);
procedure SetLoadedFrom(const AModuleName: string);
procedure AddUsedUnit(P: PSymbol);
@ -254,16 +261,10 @@ procedure RegisterSymbols;
implementation
uses
{$IFDEF USE_SYSUTILS}
SysUtils,
{$ELSE USE_SYSUTILS}
Dos,
{$ENDIF USE_SYSUTILS}
globtype,globals,comphook,
{$ifdef DEBUG}
verbose,
{$endif DEBUG}
CUtils,
globtype,globals,comphook,
finput,fmodule,
cpuinfo,cgbase,aasmbase,aasmtai,aasmdata,paramgr,
symsym,symdef,symtype,symbase,defutil;
@ -1841,7 +1842,7 @@ end;
procedure BuildSourceList;
var m: tmodule;
s: tinputfile;
p: cutils.pstring;
p: pstring;
ppu,obj: string;
source: string;
begin
@ -1856,12 +1857,12 @@ begin
m:=tmodule(loaded_units.first);
while assigned(m) do
begin
obj:=fexpand(m.objfilename^);
obj:=ExpandFileName(m.objfilename^);
ppu:=''; source:='';
if m.is_unit then
ppu:=fexpand(m.ppufilename^);
ppu:=ExpandFileName(m.ppufilename^);
if (m.is_unit=false) and (m.islibrary=false) then
ppu:=fexpand(m.exefilename^);
ppu:=ExpandFileName(m.exefilename^);
if assigned(m.sourcefiles) then
begin
s:=m.sourcefiles.files;
@ -1874,7 +1875,7 @@ begin
p:=s.name;
if assigned(p) then
source:=source+p^;
source:=fexpand(source);
source:=ExpandFileName(source);
sourcefiles^.Insert(New(PSourceFile, Init(source,obj,ppu)));
s:=s.ref_next;

2
compiler/browlog.pas
View File

@ -71,7 +71,7 @@ var
implementation
uses
cutils,comphook,
cutils,cfileutils,comphook,
globals,systems,
ppu;

128
compiler/cclasses.pas
View File

@ -235,7 +235,7 @@ type
TFPHashObject = class
private
FOwner : TFPHashObjectList;
FCachedStr : pstring;
FCachedStr : pshortstring;
FStrIndex : Integer;
protected
function GetName:string;
@ -348,7 +348,7 @@ type
{ string containerItem }
TStringListItem = class(TLinkedListItem)
FPStr : PString;
FPStr : pshortstring;
public
constructor Create(const s:string);
destructor Destroy;override;
@ -406,7 +406,7 @@ type
FLeft,
FRight : TNamedIndexItem;
FSpeedValue : cardinal;
FName : Pstring;
FName : pshortstring;
protected
function GetName:string;virtual;
procedure SetName(const n:string);virtual;
@ -3487,5 +3487,127 @@ begin
end;
end;
{****************************************************************************
TDirectoryCache
****************************************************************************}
type
TCachedDirectory = class(TFPHashObject)
private
FDirectoryEntries : TFPHashList;
public
constructor Create(AList:TFPHashObjectList;const AName:string);
destructor destroy;override;
procedure Reload;
function FileExists(const AName:string):boolean;
function DirectoryExists(const AName:string):boolean;
property DirectoryEntries:TFPHashList read FDirectoryEntries;
end;
TDirectoryCache = class
private
FDirectories : TFPHashObjectList;
function GetDirectory(const ADir:string):TCachedDirectory;
public
constructor Create;
destructor destroy;override;
function FileExists(const AName:string):boolean;
function DirectoryExists(const AName:string):boolean;
end;
constructor TCachedDirectory.create(AList:TFPHashObjectList;const AName:string);
begin
inherited create(AList,AName);
FDirectoryEntries:=TFPHashList.Create;
end;
destructor TCachedDirectory.destroy;
begin
FDirectoryEntries.Free;
inherited destroy;
end;
procedure TCachedDirectory.Reload;
var
dir : TSearchRec;
Attr : PtrInt;
begin
DirectoryEntries.Clear;
if findfirst(IncludeTrailingPathDelimiter(Name)+'*',faAnyFile or faDirectory,dir) = 0 then
begin
repeat
if ((dir.attr and faDirectory)<>0) then
Attr:=2
else
Attr:=1;
DirectoryEntries.Add(Dir.Name,Pointer(Attr));
until findnext(dir) <> 0;
end;
end;
function TCachedDirectory.FileExists(const AName:string):boolean;
begin
Result:=(PtrInt(DirectoryEntries.Find(AName))=1);
end;
function TCachedDirectory.DirectoryExists(const AName:string):boolean;
begin
Result:=(PtrInt(DirectoryEntries.Find(AName))=2);
end;
constructor TDirectoryCache.create;
begin
inherited create;
FDirectories:=TFPHashObjectList.Create(false);
end;
destructor TDirectoryCache.destroy;
begin
FDirectories.Free;
inherited destroy;
end;
function TDirectoryCache.GetDirectory(const ADir:string):TCachedDirectory;
var
CachedDir : TCachedDirectory;
begin
CachedDir:=TCachedDirectory(FDirectories.Find(ADir));
if not assigned(CachedDir) then
begin
CachedDir:=TCachedDirectory.Create(FDirectories,ADir);
CachedDir.Reload;
end;
Result:=CachedDir;
end;
function TDirectoryCache.FileExists(const AName:string):boolean;
var
CachedDir : TCachedDirectory;
begin
Result:=false;
CachedDir:=GetDirectory(ExtractFileDir(AName));
if assigned(CachedDir) then
Result:=CachedDir.FileExists(ExtractFileName(AName));
end;
function TDirectoryCache.DirectoryExists(const AName:string):boolean;
var
CachedDir : TCachedDirectory;
begin
Result:=false;
CachedDir:=GetDirectory(ExtractFilePath(AName));
if assigned(CachedDir) then
Result:=CachedDir.DirectoryExists(ExtractFileName(AName));
end;
end.

1086
compiler/cfileutils.pas Normal file
View File

File diff suppressed because it is too large Load Diff

4
compiler/cmsgs.pas
View File

@ -62,8 +62,8 @@ function GetMsgLine(var p:pchar):string;
implementation
uses
cutils,
strings;
SysUtils,
cutils;
function MsgReplace(const s:string;const args:array of string):string;

14
compiler/comphook.pas
View File

@ -155,9 +155,6 @@ const
implementation
uses
{$IFNDEF USE_SYSUTILS}
dos,
{$ENDIF USE_SYSUTILS}
cutils, systems
;
@ -383,23 +380,12 @@ end;
Function def_GetNamedFileTime (Const F : String) : Longint;
var
{$IFDEF USE_SYSUTILS}
fh : THandle;
{$ELSE USE_SYSUTILS}
info : SearchRec;
{$ENDIF USE_SYSUTILS}
begin
Result := -1;
{$IFDEF USE_SYSUTILS}
fh := FileOpen(f, faArchive+faReadOnly+faHidden);
Result := FileGetDate(fh);
FileClose(fh);
{$ELSE USE_SYSUTILS}
FindFirst (F,archive+readonly+hidden,info);
if DosError=0 then
Result := info.time;
FindClose(info);
{$ENDIF USE_SYSUTILS}
end;
end.

24
compiler/compiler.pas
View File

@ -36,17 +36,13 @@ uses
{$ifdef BrowserLog}
browlog,
{$endif BrowserLog}
{$IFDEF USE_SYSUTILS}
{$ELSE USE_SYSUTILS}
dos,
{$ENDIF USE_SYSUTILS}
{$IFNDEF USE_FAKE_SYSUTILS}
sysutils,
{$ELSE}
fksysutl,
{$ENDIF}
verbose,comphook,systems,
cutils,cclasses,globals,options,fmodule,parser,symtable,
cutils,cfileutils,cclasses,globals,options,fmodule,parser,symtable,
assemble,link,dbgbase,import,export,tokens,pass_1
{ cpu parameter handling }
,cpupara
@ -163,6 +159,7 @@ begin
CompilerInited:=false;
DoneSymtable;
DoneGlobals;
DoneFileUtils;
donetokens;
end;
@ -173,6 +170,8 @@ begin
DoneCompiler;
{ inits which need to be done before the arguments are parsed }
InitSystems;
{ fileutils depends on source_info so it must be after systems }
InitFileUtils;
{ globals depends on source_info so it must be after systems }
InitGlobals;
{ verbose depends on exe_path and must be after globals }
@ -222,19 +221,10 @@ function Compile(const cmd:string):longint;
function getrealtime : real;
var
{$IFDEF USE_SYSUTILS}
h,m,s,s1000 : word;
{$ELSE USE_SYSUTILS}
h,m,s,s100 : word;
{$ENDIF USE_SYSUTILS}
begin
{$IFDEF USE_SYSUTILS}
DecodeTime(Time,h,m,s,s1000);
getrealtime:=h*3600.0+m*60.0+s+s1000/1000.0;
{$ELSE USE_SYSUTILS}
gettime(h,m,s,s100);
getrealtime:=h*3600.0+m*60.0+s+s100/100.0;
{$ENDIF USE_SYSUTILS}
result:=h*3600.0+m*60.0+s+s1000/1000.0;
end;
var
@ -265,10 +255,10 @@ begin
{ Compile the program }
{$ifdef PREPROCWRITE}
if parapreprocess then
parser.preprocess(inputdir+inputfile+inputextension)
parser.preprocess(inputfilepath+inputfilename)
else
{$endif PREPROCWRITE}
parser.compile(inputdir+inputfile+inputextension);
parser.compile(inputfilepath+inputfilename);
{ Show statistics }
if status.errorcount=0 then

46
compiler/comprsrc.pas
View File

@ -42,12 +42,9 @@ procedure CompileResourceFiles;
implementation
uses
{$IFDEF USE_SYSUTILS}
SysUtils,
{$ELSE USE_SYSUTILS}
dos,
{$ENDIF USE_SYSUTILS}
Systems,cutils,Globtype,Globals,Verbose,Fmodule,
Systems,cutils,cfileutils,
Globtype,Globals,Verbose,Fmodule,
Script;
{****************************************************************************
@ -68,12 +65,8 @@ end;
procedure tresourcefile.compile;
var
respath,
srcfilepath : dirstr;
n : namestr;
{$IFDEF USE_SYSUTILS}
{$ELSE USE_SYSUTILS}
e : extstr;
{$ENDIF USE_SYSUTILS}
srcfilepath,
n,
s,
resobj,
resbin : string;
@ -87,24 +80,16 @@ begin
if not resfound then
resfound:=FindExe(utilsprefix+target_res.resbin,resbin);
{ get also the path to be searched for the windres.h }
{$IFDEF USE_SYSUTILS}
respath := SplitPath(resbin);
{$ELSE USE_SYSUTILS}
fsplit(resbin,respath,n,e);
{$ENDIF USE_SYSUTILS}
respath:=ExtractFilePath(resbin);
if (not resfound) and not(cs_link_nolink in current_settings.globalswitches) then
begin
Message(exec_e_res_not_found);
current_settings.globalswitches:=current_settings.globalswitches+[cs_link_nolink];
end;
{$IFDEF USE_SYSUTILS}
srcfilepath := SplitPath(current_module.mainsource^);
{$ELSE USE_SYSUTILS}
fsplit(current_module.mainsource^,srcfilepath,n,e);
{$ENDIF USE_SYSUTILS}
srcfilepath:=ExtractFilePath(current_module.mainsource^);
if not path_absolute(fname) then
fname:=srcfilepath+fname;
resobj:=ForceExtension(fname,target_info.resobjext);
resobj:=ChangeFileExt(fname,target_info.resobjext);
s:=target_res.rescmd;
ObjUsed:=(pos('$OBJ',s)>0);
Replace(s,'$OBJ',maybequoted(resobj));
@ -122,7 +107,6 @@ begin
Message1(exec_i_compilingresource,fname);
Message2(exec_d_resbin_params,resbin,s);
FlushOutput;
{$IFDEF USE_SYSUTILS}
try
if ExecuteProcess(resbin,s) <> 0 then
begin
@ -136,22 +120,6 @@ begin
current_settings.globalswitches:=current_settings.globalswitches+[cs_link_nolink];
end
end;
{$ELSE USE_SYSUTILS}
swapvectors;
exec(resbin,s);
swapvectors;
if (doserror<>0) then
begin
Message(exec_e_cant_call_linker);
current_settings.globalswitches:=current_settings.globalswitches+[cs_link_nolink];
end
else
if (dosexitcode<>0) then
begin
Message(exec_e_error_while_linking);
current_settings.globalswitches:=current_settings.globalswitches+[cs_link_nolink];
end;
{$ENDIF USE_SYSUTILS}
end;
{ Update asmres when externmode is set }
if cs_link_nolink in current_settings.globalswitches then

5
compiler/cresstr.pas
View File

@ -31,6 +31,7 @@ interface
implementation
uses
SysUtils,
cclasses,
cutils,globtype,globals,systems,
symconst,symtype,symdef,symsym,
@ -235,8 +236,8 @@ uses
end;
begin
ResFileName:=ForceExtension(current_module.ppufilename^,'.rst');
message1 (general_i_writingresourcefile,SplitFileName(ResFileName));
ResFileName:=ChangeFileExt(current_module.ppufilename^,'.rst');
message1 (general_i_writingresourcefile,ExtractFileName(ResFileName));
Assign(F,ResFileName);
{$i-}
Rewrite(f);

48
compiler/cutils.pas
View File

@ -31,7 +31,7 @@ interface
type
pstring = ^string;
pshortstring = ^string;
Tcharset=set of char;
var
@ -99,19 +99,18 @@ interface
{ releases the string p and assignes nil to p }
{ if p=nil then freemem isn't called }
procedure stringdispose(var p : pstring);{$ifdef USEINLINE}inline;{$endif}
procedure stringdispose(var p : pshortstring);{$ifdef USEINLINE}inline;{$endif}
{ allocates mem for a copy of s, copies s to this mem and returns }
{ a pointer to this mem }
function stringdup(const s : string) : pstring;{$ifdef USEINLINE}inline;{$endif}
function stringdup(const s : string) : pshortstring;{$ifdef USEINLINE}inline;{$endif}
{# Allocates memory for the string @var(s) and copies s as zero
terminated string to that allocated memory and returns a pointer
to that mem
}
function strpnew(const s : string) : pchar;
procedure strdispose(var p : pchar);
{# makes the character @var(c) lowercase, with spanish, french and german
character set
@ -120,10 +119,10 @@ interface
{ makes zero terminated string to a pascal string }
{ the data in p is modified and p is returned }
function pchar2pstring(p : pchar) : pstring;
function pchar2pshortstring(p : pchar) : pshortstring;
{ ambivalent to pchar2pstring }
function pstring2pchar(p : pstring) : pchar;
{ ambivalent to pchar2pshortstring }
function pshortstring2pchar(p : pshortstring) : pchar;
{ Speed/Hash value }
Function GetSpeedValue(Const s:String):cardinal;
@ -140,10 +139,8 @@ interface
implementation
uses
strings
;
uses
SysUtils;
var
uppertbl,
@ -721,7 +718,7 @@ uses
function nextpowerof2(value : int64; out power: longint) : int64;
{
{
returns the power of 2 >= value
}
var
@ -866,7 +863,7 @@ uses
end;
function pchar2pstring(p : pchar) : pstring;
function pchar2pshortstring(p : pchar) : pshortstring;
var
w,i : longint;
begin
@ -874,11 +871,11 @@ uses
for i:=w-1 downto 0 do
p[i+1]:=p[i];
p[0]:=chr(w);
pchar2pstring:=pstring(p);
pchar2pshortstring:=pshortstring(p);
end;
function pstring2pchar(p : pstring) : pchar;
function pshortstring2pchar(p : pshortstring) : pchar;
var
w,i : longint;
begin
@ -886,7 +883,7 @@ uses
for i:=1 to w do
p^[i-1]:=p^[i];
p^[w]:=#0;
pstring2pchar:=pchar(p);
pshortstring2pchar:=pchar(p);
end;
@ -914,22 +911,13 @@ uses
p : pchar;
begin
getmem(p,length(s)+1);
strpcopy(p,s);
strpnew:=p;
move(s[1],p^,length(s));
p[length(s)]:=#0;
result:=p;
end;
procedure strdispose(var p : pchar);
begin
if assigned(p) then
begin
freemem(p);
p:=nil;
end;
end;
procedure stringdispose(var p : pstring);{$ifdef USEINLINE}inline;{$endif}
procedure stringdispose(var p : pshortstring);{$ifdef USEINLINE}inline;{$endif}
begin
if assigned(p) then
begin
@ -939,7 +927,7 @@ uses
end;
function stringdup(const s : string) : pstring;{$ifdef USEINLINE}inline;{$endif}
function stringdup(const s : string) : pshortstring;{$ifdef USEINLINE}inline;{$endif}
begin
getmem(result,length(s)+1);
result^:=s;

16
compiler/dbgdwarf.pas
View File

@ -315,17 +315,11 @@ interface
implementation
uses
version,
cutils,
globtype,
globals,
verbose,
systems,
cpubase,
cgbase,
cutils,cfileutils,
version,globtype,globals,verbose,systems,
cpubase,cgbase,
fmodule,
defutil,
symconst,symtable
defutil,symconst,symtable
;
const
@ -2281,7 +2275,7 @@ end;
var
currfileinfo,
lastfileinfo : tfileposinfo;
currfuncname : pstring;
currfuncname : pshortstring;
currsectype : TAsmSectiontype;
hlabel : tasmlabel;
hp : tai;

37
compiler/dbgstabs.pas
View File

@ -65,7 +65,7 @@ interface
implementation
uses
strings,cutils,
SysUtils,cutils,cfileutils,
systems,globals,globtype,verbose,
symconst,defutil,
cpuinfo,cpubase,cgbase,paramgr,
@ -132,7 +132,7 @@ implementation
var i,j:byte;
varname:string[63];
varno,varcounter:byte;
varvalues:array[0..9] of Pstring;
varvalues:array[0..9] of pshortstring;
{1 kb of parameters is the limit. 256 extra bytes are allocated to
ensure buffer integrity.}
varvaluedata:array[0..maxdata+256] of char;
@ -166,12 +166,12 @@ implementation
s[i]:=char(varcounter);
inc(i);
until s[i]='}';
varvalues[varcounter]:=Pstring(varptr);
varvalues[varcounter]:=pshortstring(varptr);
if varptr>@varvaluedata[maxdata] then
internalerrorproc(200411152);
Pstring(varptr)^:=get_var_value(varname,get_var_value_arg);
inc(len,length(Pstring(varptr)^));
inc(varptr,length(Pstring(varptr)^)+1);
pshortstring(varptr)^:=get_var_value(varname,get_var_value_arg);
inc(len,length(pshortstring(varptr)^));
inc(varptr,length(pshortstring(varptr)^)+1);
inc(varcounter);
end
else if s[i+1] in ['1'..'9'] then
@ -341,7 +341,7 @@ implementation
end;
strcopy(state^.stabstring+state^.stabsize,newrec);
inc(state^.stabsize,strlen(newrec));
strdispose(newrec);
freemem(newrec);
{This should be used for case !!}
inc(state^.recoffset,Tfieldvarsym(p).vardef.size);
end;
@ -431,7 +431,7 @@ implementation
reallocmem(state^.stabstring,state^.staballoc);
end;
strcopy(state^.stabstring+olds,newrec);
strdispose(newrec);
freemem(newrec);
{This should be used for case !!
RecOffset := RecOffset + pd.size;}
end;
@ -629,8 +629,9 @@ implementation
tostr(def.fileinfo.line)
+',');
strpcopy(strend(p),stabsstr);
result:=strnew(p);
freemem(p,length(stabsstr)+255);
getmem(result,strlen(p)+1);
move(p^,result^,strlen(p)+1);
freemem(p);
end;
function recorddef_stabstr(def:trecorddef):pchar;
@ -783,8 +784,8 @@ implementation
su:=def_stabstr_evaluate(def,'",${N_LSYM},0,0,0',[]);
strcopy(strecopy(strend(st),ss),su);
reallocmem(st,strlen(st)+1);
strdispose(ss);
strdispose(su);
freemem(ss);
freemem(su);
{ add to list }
list.concat(Tai_stab.create(stab_stabs,st));
end;
@ -942,7 +943,7 @@ implementation
templist : TAsmList;
stabsendlabel : tasmlabel;
mangled_length : longint;
p : pchar;
p,p1 : pchar;
hs : string;
begin
if assigned(pd.procstarttai) then
@ -984,7 +985,9 @@ implementation
{$IFDEF POWERPC64}strpcopy(strend(p), '.');{$ENDIF POWERPC64}
strpcopy(strend(p),pd.mangledname);
end;
templist.concat(Tai_stab.Create(stab_stabn,strnew(p)));
getmem(p1,strlen(p)+1);
move(p^,p1^,strlen(p)+1);
templist.concat(Tai_stab.Create(stab_stabn,p1));
strpcopy(p,tostr(N_RBRAC)+',0,0,'+stabsendlabel.name);
if (tf_use_function_relative_addresses in target_info.flags) then
begin
@ -992,7 +995,9 @@ implementation
{$IFDEF POWERPC64}strpcopy(strend(p), '.');{$ENDIF POWERPC64}
strpcopy(strend(p),pd.mangledname);
end;
templist.concat(Tai_stab.Create(stab_stabn,strnew(p)));
getmem(p1,strlen(p)+1);
move(p^,p1^,strlen(p)+1);
templist.concat(Tai_stab.Create(stab_stabn,p1));
freemem(p,2*mangled_length+50);
current_asmdata.asmlists[al_procedures].insertlistafter(pd.procendtai,templist);
@ -1421,7 +1426,7 @@ implementation
var
currfileinfo,
lastfileinfo : tfileposinfo;
currfuncname : pstring;
currfuncname : pshortstring;
currsectype : TAsmSectiontype;
hlabel : tasmlabel;
hp : tai;

2
compiler/export.pas
View File

@ -41,7 +41,7 @@ type
texported_item = class(TLinkedListItem)
sym : tsym;
index : longint;
name : pstring;
name : pshortstring;
options : word;
is_var : boolean;
constructor create;

120
compiler/finput.pas
View File

@ -37,7 +37,7 @@ interface
plongintarr = ^tlongintarr;
tinputfile = class
path,name : pstring; { path and filename }
path,name : pshortstring; { path and filename }
next : tinputfile; { next file for reading }
is_macro,
@ -144,58 +144,55 @@ interface
modulename, { name of the module in uppercase }
realmodulename, { name of the module in the orignal case }
objfilename, { fullname of the objectfile }
newfilename, { fullname of the assemblerfile }
asmfilename, { fullname of the assemblerfile }
ppufilename, { fullname of the ppufile }
importlibfilename, { fullname of the import libraryfile }
staticlibfilename, { fullname of the static libraryfile }
sharedlibfilename, { fullname of the shared libraryfile }
mapfilename, { fullname of the mapfile }
exefilename, { fullname of the exefile }
mainsource : pstring; { name of the main sourcefile }
mainsource : pshortstring; { name of the main sourcefile }
constructor create(const s:string);
destructor destroy;override;
procedure setfilename(const fn:string;allowoutput:boolean);
function get_asmfilename : string;
end;
Function GetNamedFileTime (Const F : String) : Longint;
implementation
uses
{$IFDEF USE_SYSUTILS}
SysUtils,
GlobType,
{$ELSE USE_SYSUTILS}
dos,
{$ENDIF USE_SYSUTILS}
GlobType,Comphook,
{$ifdef heaptrc}
fmodule,
ppheap,
{$endif heaptrc}
globals,systems
CFileUtils,
Globals,Systems
;
{****************************************************************************
Utils
****************************************************************************}
Function GetNamedFileTime (Const F : String) : Longint;
begin
GetNamedFileTime:=do_getnamedfiletime(F);
end;
{****************************************************************************
TINPUTFILE
****************************************************************************}
constructor tinputfile.create(const fn:string);
{$IFDEF USE_SYSUTILS}
{$ELSE USE_SYSUTILS}
var
p:dirstr;
n:namestr;
e:extstr;
{$ENDIF USE_SYSUTILS}
begin
{$IFDEF USE_SYSUTILS}
name:=stringdup(SplitFileName(fn));
path:=stringdup(SplitPath(fn));
{$ELSE USE_SYSUTILS}
FSplit(fn,p,n,e);
name:=stringdup(n+e);
path:=stringdup(p);
{$ENDIF USE_SYSUTILS}
name:=stringdup(ExtractFileName(fn));
path:=stringdup(ExtractFilePath(fn));
next:=nil;
filetime:=-1;
{ file info }
@ -621,15 +618,13 @@ uses
procedure tmodulebase.setfilename(const fn:string;allowoutput:boolean);
var
p : dirstr;
n : NameStr;
e : ExtStr;
p,n,e,
extension,
prefix,
suffix,
extension : NameStr;
suffix : string;
begin
stringdispose(objfilename);
stringdispose(newfilename);
stringdispose(asmfilename);
stringdispose(ppufilename);
stringdispose(importlibfilename);
stringdispose(staticlibfilename);
@ -642,28 +637,22 @@ uses
{ Create names }
paramfn := stringdup(fn);
paramallowoutput := allowoutput;
{$IFDEF USE_SYSUTILS}
p := SplitPath(fn);
n := SplitName(fn);
e := SplitExtension(fn);
{$ELSE USE_SYSUTILS}
fsplit(fn,p,n,e);
{$ENDIF USE_SYSUTILS}
n:=FixFileName(n);
p := FixPath(ExtractFilePath(fn),false);
n := FixFileName(ChangeFileExt(ExtractFileName(fn),''));
e := ExtractFileExt(fn);
{ set path }
path:=stringdup(FixPath(p,false));
path:=stringdup(p);
{ obj,asm,ppu names }
p:=path^;
if AllowOutput then
begin
if (OutputUnitDir<>'') then
p:=OutputUnitDir
else
if (OutputExeDir<>'') then
p:=OutputExeDir;
end;
begin
if (OutputUnitDir<>'') then
p:=OutputUnitDir
else
if (OutputExeDir<>'') then
p:=OutputExeDir;
end;
outputpath:=stringdup(p);
newfilename := stringdup(n);
asmfilename:=stringdup(p+n+target_info.asmext);
objfilename:=stringdup(p+n+target_info.objext);
ppufilename:=stringdup(p+n+target_info.unitext);
{ lib and exe could be loaded with a file specified with -o }
@ -672,26 +661,30 @@ uses
extension := target_info.sharedlibext;
if AllowOutput and (compile_level=1) then
begin
if OutputFile <> '' then n:=OutputFile;
if Assigned(OutputPrefix) then prefix := OutputPrefix^;
if Assigned(OutputSuffix) then suffix := OutputSuffix^;
if OutputExtension <> '' then extension := OutputExtension;
end;
begin
if OutputFileName <> '' then
n:=OutputFileName;
if Assigned(OutputPrefix) then
prefix := OutputPrefix^;
if Assigned(OutputSuffix) then
suffix := OutputSuffix^;
if ExtractFileExt(OutputFileName) <> '' then
extension := ExtractFileExt(OutputFileName);
end;
importlibfilename:=stringdup(p+target_info.staticClibprefix+'imp'+n+target_info.staticlibext);
staticlibfilename:=stringdup(p+target_info.staticlibprefix+n+target_info.staticlibext);
{ output dir of exe can be specified separatly }
if AllowOutput and (OutputExeDir<>'') then
p:=OutputExeDir
p:=OutputExeDir
else
p:=path^;
p:=path^;
sharedlibfilename:=stringdup(p+prefix+n+suffix+extension);
{ don't use extension alone to check, it can be empty !! }
if (OutputFile<>'') or (OutputExtension<>'') then
exefilename:=stringdup(p+n+OutputExtension)
if (OutputFileName<>'')then
exefilename:=stringdup(p+OutputFileName)
else
exefilename:=stringdup(p+n+target_info.exeext);
mapfilename:=stringdup(p+n+'.map');
@ -705,7 +698,7 @@ uses
mainsource:=nil;
ppufilename:=nil;
objfilename:=nil;
newfilename:=nil;
asmfilename:=nil;
importlibfilename:=nil;
staticlibfilename:=nil;
sharedlibfilename:=nil;
@ -724,18 +717,13 @@ uses
end;
function tmodulebase.get_asmfilename : string;
begin
get_asmfilename:=outputpath^+newfilename^+target_info.asmext;
end;
destructor tmodulebase.destroy;
begin
if assigned(sourcefiles) then
sourcefiles.free;
sourcefiles:=nil;
stringdispose(objfilename);
stringdispose(newfilename);
stringdispose(asmfilename);
stringdispose(ppufilename);
stringdispose(importlibfilename);
stringdispose(staticlibfilename);

29
compiler/fmodule.pas
View File

@ -42,7 +42,7 @@ unit fmodule;
interface
uses
cutils,cclasses,
cutils,cclasses,cfileutils,
globals,finput,ogbase,
symbase,symsym,aasmbase,aasmtai,aasmdata;
@ -57,7 +57,7 @@ interface
tlinkcontaineritem=class(tlinkedlistitem)
public
data : pstring;
data : pshortstring;
needlink : cardinal;
constructor Create(const s:string;m:cardinal);
destructor Destroy;override;
@ -85,7 +85,7 @@ interface
tderefmaprec = record
u : tmodule;
{ modulename, used during ppu load }
modulename : pstring;
modulename : pshortstring;
end;
pderefmap = ^tderefmaprec;
@ -132,7 +132,7 @@ interface
scanner : TObject; { scanner object used }
procinfo : TObject; { current procedure being compiled }
asmdata : TObject; { Assembler data }
asmprefix : pstring; { prefix for the smartlink asmfiles }
asmprefix : pshortstring; { prefix for the smartlink asmfiles }
loaded_from : tmodule;
_exports : tlinkedlist;
dllscannerinputlist : TFPHashList;
@ -203,12 +203,8 @@ interface
implementation
uses
{$IFDEF USE_SYSUTILS}
SysUtils,
GlobType,
{$ELSE USE_SYSUTILS}
dos,
{$ENDIF USE_SYSUTILS}
verbose,systems,
scanner,ppu,
procinfo;
@ -378,17 +374,10 @@ implementation
constructor tmodule.create(LoadedFrom:TModule;const s:string;_is_unit:boolean);
var
p : dirstr;
n : namestr;
e : extstr;
p,n : string;
begin
{$IFDEF USE_SYSUTILS}
p := SplitPath(s);
n := SplitName(s);
e := SplitExtension(s);
{$ELSE USE_SYSUTILS}
FSplit(s,p,n,e);
{$ENDIF USE_SYSUTILS}
p:=ExtractFilePath(s);
n:=ChangeFileExt(ExtractFileName(s),'');
{ Programs have the name 'Program' to don't conflict with dup id's }
if _is_unit then
inherited create(n)
@ -401,7 +390,7 @@ implementation
{$else}
asmprefix:=stringdup(FixFileName(n));
{$endif}
setfilename(p+n,true);
setfilename(s,true);
localunitsearchpath:=TSearchPathList.Create;
localobjectsearchpath:=TSearchPathList.Create;
localincludesearchpath:=TSearchPathList.Create;
@ -511,7 +500,7 @@ implementation
linkothersharedlibs.Free;
FImportLibraryList.Free;
stringdispose(objfilename);
stringdispose(newfilename);
stringdispose(asmfilename);
stringdispose(ppufilename);
stringdispose(importlibfilename);
stringdispose(staticlibfilename);

20
compiler/fppu.pas
View File

@ -42,7 +42,7 @@ interface
type
tppumodule = class(tmodule)
ppufile : tcompilerppufile; { the PPU file }
sourcefn : pstring; { Source specified with "uses .. in '..'" }
sourcefn : pshortstring; { Source specified with "uses .. in '..'" }
comments : tstringlist;
{$ifdef Test_Double_checksum}
crc_array : pointer;
@ -92,6 +92,8 @@ interface
implementation
uses
SysUtils,
cfileutils,
verbose,systems,version,
symtable, symsym,
scanner,
@ -377,17 +379,17 @@ uses
begin
{ the full filename is specified so we can't use here the
searchpath (PFV) }
Message1(unit_t_unitsearch,AddExtension(sourcefn^,sourceext));
fnd:=FindFile(AddExtension(sourcefn^,sourceext),'',hs);
Message1(unit_t_unitsearch,ChangeFileExt(sourcefn^,sourceext));
fnd:=FindFile(ChangeFileExt(sourcefn^,sourceext),'',hs);
if not fnd then
begin
Message1(unit_t_unitsearch,AddExtension(sourcefn^,pasext));
fnd:=FindFile(AddExtension(sourcefn^,pasext),'',hs);
Message1(unit_t_unitsearch,ChangeFileExt(sourcefn^,pasext));
fnd:=FindFile(ChangeFileExt(sourcefn^,pasext),'',hs);
end;
if not fnd and ((m_mac in current_settings.modeswitches) or (tf_p_ext_support in target_info.flags)) then
begin
Message1(unit_t_unitsearch,AddExtension(sourcefn^,pext));
fnd:=FindFile(AddExtension(sourcefn^,pext),'',hs);
Message1(unit_t_unitsearch,ChangeFileExt(sourcefn^,pext));
fnd:=FindFile(ChangeFileExt(sourcefn^,pext),'',hs);
end;
if fnd then
begin
@ -525,7 +527,7 @@ uses
begin
s:=p.get(mask);
if strippath then
ppufile.putstring(SplitFileName(s))
ppufile.putstring(ExtractFileName(s))
else
ppufile.putstring(s);
ppufile.putlongint(mask);
@ -743,7 +745,7 @@ uses
if Source_Time<>-1 then
begin
if is_main then
main_dir:=splitpath(hs);
main_dir:=ExtractFilePath(hs);
temp:=' time '+filetimestring(source_time);
if (orgfiletime<>-1) and
(source_time<>orgfiletime) then

5
compiler/gendef.pas
View File

@ -50,6 +50,7 @@ var
implementation
uses
SysUtils,
systems,cutils,globtype,globals;
{******************************************************************************
@ -70,7 +71,7 @@ destructor tdeffile.destroy;
begin
if WrittenOnDisk and
not(cs_link_nolink in current_settings.globalswitches) then
RemoveFile(FName);
DeleteFile(FName);
importlist.Free;
exportlist.Free;
end;
@ -114,7 +115,7 @@ begin
case target_info.system of
system_i386_Os2, system_i386_emx:
begin
write(t,'NAME '+inputfile);
write(t,'NAME '+ChangeFileExt(inputfilename,''));
if usewindowapi then
write(t,' WINDOWAPI');
writeln(t,'');

1115
compiler/globals.pas
View File

File diff suppressed because it is too large Load Diff

15
compiler/globtype.pas
View File

@ -28,18 +28,11 @@ interface
maxidlen = 127;
type
{TCmdStr is used to pass command line parameters to an external program to be
executed from the FPC application. In some circomstances, this can be more
than 255 characters. That's why using Ansi Strings}
{$IFDEF USE_SYSUTILS}
{ TCmdStr is used to pass command line parameters to an external program to be
executed from the FPC application. In some circomstances, this can be more
than 255 characters. That's why using Ansi Strings}
TCmdStr = AnsiString;
PathStr = String;
DirStr = String;
NameStr = String;
ExtStr = String;
{$ELSE USE_SYSUTILS}
TCmdStr = String;
{$ENDIF USE_SYSUTILS}
TPathStr = ShortString;
{ Natural integer register type and size for the target machine }
{$ifdef cpu64bit}

14
compiler/impdef.pas
View File

@ -31,11 +31,7 @@ unit impdef;
interface
uses
{$IFDEF USE_SYSUTILS}
SysUtils,
{$ELSE USE_SYSUTILS}
Dos;
{$ENDIF USE_SYSUTILS}
SysUtils;
var
as_name,
@ -174,11 +170,7 @@ procedure CreateTempDir(const s:string);
procedure call_as(const name:string);
begin
FlushOutput;
{$IFDEF USE_SYSUTILS}
ExecuteProcess(as_name,'-o '+name+'o '+name);
{$ELSE USE_SYSUTILS}
exec(as_name,'-o '+name+'o '+name);
{$ENDIF USE_SYSUTILS}
end;
procedure call_ar;
var
@ -194,11 +186,7 @@ procedure call_ar;
If DOSError=0 then
erase(f);
FlushOutput;
{$IFDEF USE_SYSUTILS}
ExecuteProcess(ar_name,'rs '+impname+' '+path+dirsep+'*.swo');
{$ELSE USE_SYSUTILS}
exec(ar_name,'rs '+impname+' '+path+dirsep+'*.swo');
{$ENDIF USE_SYSUTILS}
cleardir(path,'*.sw');
cleardir(path,'*.swo');
{$i-}

54
compiler/link.pas
View File

@ -122,15 +122,10 @@ interface
Implementation
uses
{$IFDEF USE_SYSUTILS}
SysUtils,
{$ELSE USE_SYSUTILS}
dos,
{$ENDIF USE_SYSUTILS}
cutils,
cutils,cfileutils,
script,globals,verbose,comphook,ppu,
aasmbase,aasmtai,aasmdata,aasmcpu,
// symbase,symdef,symtype,symconst,
owbase,owar,ogmap;
type
@ -155,7 +150,7 @@ Implementation
the host. Look for the corresponding assembler file instead,
because it will be assembled to object file on the target.}
if isunit and (cs_link_on_target in current_settings.globalswitches) then
s:= ForceExtension(s,target_info.asmext);
s:=ChangeFileExt(s,target_info.asmext);
{ when it does not belong to the unit then check if
the specified file exists without searching any paths }
@ -201,7 +196,7 @@ Implementation
{Restore file extension}
if isunit and (cs_link_on_target in current_settings.globalswitches) then
foundfile:= ForceExtension(foundfile,target_info.objext);
foundfile:= ChangeFileExt(foundfile,target_info.objext);
findobjectfile:=ScriptFixFileName(foundfile);
end;
@ -223,11 +218,7 @@ Implementation
Found:=librarysearchpath.FindFile(s,founddll);
if (not found) then
begin
{$IFDEF USE_SYSUTILS}
sysdir:=FixPath(GetEnvironmentVariable('windir'),false);
{$ELSE USE_SYSUTILS}
sysdir:=FixPath(GetEnv('windir'),false);
{$ENDIF USE_SYSUTILS}
Found:=FindFile(s,sysdir+';'+sysdir+'system'+source_info.DirSep+';'+sysdir+'system32'+source_info.DirSep,founddll);
end;
if (not found) then
@ -250,8 +241,8 @@ Implementation
if s='' then
exit;
{ split path from filename }
paths:=SplitPath(s);
s:=SplitFileName(s);
paths:=ExtractFilePath(s);
s:=ExtractFileName(s);
{ add prefix 'lib' }
if (prefix<>'') and (Copy(s,1,length(prefix))<>prefix) then
s:=prefix+s;
@ -550,8 +541,8 @@ Implementation
FillChar(Info,sizeof(Info),0);
if cs_link_on_target in current_settings.globalswitches then
begin
Info.ResName:=outputexedir+inputfile+'_link.res';
Info.ScriptName:=outputexedir+inputfile+'_script.res';
Info.ResName:=outputexedir+ChangeFileExt(inputfilename,'_link.res');
Info.ScriptName:=outputexedir+ChangeFileExt(inputfilename,'_script.res');
end
else
begin
@ -591,10 +582,10 @@ Implementation
if cs_link_on_target in current_settings.globalswitches then
begin
{ If linking on target, don't add any path PM }
FindUtil:=AddExtension(s,target_info.exeext);
FindUtil:=ChangeFileExt(s,target_info.exeext);
exit;
end;
UtilExe:=AddExtension(s,source_info.exeext);
UtilExe:=ChangeFileExt(s,source_info.exeext);
FoundBin:='';
Found:=false;
if utilsdirectory<>'' then
@ -623,7 +614,6 @@ Implementation
if useshell then
exitcode := shell(maybequoted(command)+' '+para)
else
{$IFDEF USE_SYSUTILS}
try
if ExecuteProcess(command,para) <> 0
then begin
@ -639,28 +629,6 @@ Implementation
end;
end
end;
{$ELSE USE_SYSUTILS}
begin
swapvectors;
exec(command,para);
swapvectors;
exitcode := dosexitcode;
end;
if (doserror<>0) then
begin
Message(exec_e_cant_call_linker);
current_settings.globalswitches:=current_settings.globalswitches+[cs_link_nolink];
DoExec:=false;
end
else
if (exitcode<>0) then
begin
Message(exec_e_error_while_linking);
current_settings.globalswitches:=current_settings.globalswitches+[cs_link_nolink];
DoExec:=false;
end;
end;
{$ENDIF USE_SYSUTILS}
{ Update asmres when externmode is set }
if cs_link_nolink in current_settings.globalswitches then
begin
@ -700,7 +668,7 @@ Implementation
{ remove the library, to be sure that it is rewritten }
RemoveFile(current_module.staticlibfilename^);
{ Call AR }
smartpath:=current_module.outputpath^+FixPath(current_module.newfilename^+target_info.smartext,false);
smartpath:=current_module.outputpath^+FixPath(ChangeFileExt(current_module.asmfilename^,target_info.smartext),false);
SplitBinCmd(target_ar.arcmd,binstr,cmdstr);
binstr := FindUtil(utilsprefix + binstr);
@ -848,7 +816,7 @@ Implementation
begin
{$warning TODO Cleanup ignoring of FPC generated libimp*.a files}
{ Don't load import libraries }
if copy(splitfilename(para),1,6)='libimp' then
if copy(ExtractFileName(para),1,6)='libimp' then
exit;
Comment(V_Tried,'Opening library '+para);
objreader:=TArObjectreader.create(para);

4
compiler/m68k/ra68kmot.pas
View File

@ -79,7 +79,7 @@ unit ra68kmot;
procedure GetToken;
function consume(t : tasmtoken):boolean;
function findopcode(s: string; var opsize: topsize): tasmop;
Function BuildExpression(allow_symbol : boolean; asmsym : pstring) : longint;
Function BuildExpression(allow_symbol : boolean; asmsym : pshortstring) : longint;
Procedure BuildConstant(maxvalue: longint);
Procedure BuildRealConstant(typ : tfloattype);
Procedure BuildScaling(const oper:tm68koperand);
@ -577,7 +577,7 @@ const
Function tm68kmotreader.BuildExpression(allow_symbol : boolean; asmsym : pstring) : longint;
Function tm68kmotreader.BuildExpression(allow_symbol : boolean; asmsym : pshortstring) : longint;
{*********************************************************************}
{ FUNCTION BuildExpression: longint }
{ Description: This routine calculates a constant expression to }

4
compiler/ncnv.pas
View File

@ -488,8 +488,8 @@ implementation
not(is_char(hdef)) then
CGMessage(type_e_typeconflict_in_set)
else
for l:=1 to length(pstring(tstringconstnode(p2).value_str)^) do
do_set(ord(pstring(tstringconstnode(p2).value_str)^[l]));
for l:=1 to length(pshortstring(tstringconstnode(p2).value_str)^) do
do_set(ord(pshortstring(tstringconstnode(p2).value_str)^[l]));
if hdef=nil then
hdef:=cchartype;
p2.free;

4
compiler/nobj.pas
View File

@ -52,7 +52,7 @@ interface
pvmtentry = ^tvmtentry;
tvmtentry = record
speedvalue : cardinal;
name : pstring;
name : pshortstring;
firstprocdef : pprocdefcoll;
next : pvmtentry;
end;
@ -127,7 +127,7 @@ interface
implementation
uses
strings,
SysUtils,
globals,verbose,systems,
symtable,symconst,symtype,defcmp,defutil,
dbgbase

5
compiler/ogbase.pas
View File

@ -148,7 +148,7 @@ interface
private
FData : TDynamicArray;
FSecOptions : TObjSectionOptions;
FCachedFullName : pstring;
FCachedFullName : pshortstring;
procedure SetSecOptions(Aoptions:TObjSectionOptions);
public
ObjData : TObjData;
@ -452,6 +452,7 @@ interface
implementation
uses
SysUtils,
globals,verbose,fmodule,ogmap;
const
@ -726,7 +727,7 @@ implementation
constructor TObjData.create(const n:string);
begin
inherited create;
FName:=SplitFileName(n);
FName:=ExtractFileName(n);
FObjSectionList:=TFPHashObjectList.Create(true);
FStabsObjSec:=nil;
FStabStrObjSec:=nil;

7
compiler/ogcoff.pas
View File

@ -277,8 +277,9 @@ implementation
uses
{$ifdef win32}
windows,
Windows,
{$endif win32}
SysUtils,
cutils,verbose,globals,
fmodule,aasmtai,aasmdata,
ogmap,
@ -1224,7 +1225,7 @@ const pemagic : array[0..3] of byte = (
{ The `.file' record, and the file name auxiliary record }
write_symbol('.file', 0, -2, COFF_SYM_FILE, 1);
fillchar(filename,sizeof(filename),0);
filename:=SplitFileName(current_module.mainsource^);
filename:=ExtractFileName(current_module.mainsource^);
inc(symidx);
FCoffSyms.write(filename[1],sizeof(filename)-1);
{ Sections }
@ -2239,7 +2240,7 @@ const pemagic : array[0..3] of byte = (
exemap.Add('Importing from DLL '+dllname);
end;
emptyint:=0;
basedllname:=splitfilename(dllname);
basedllname:=ExtractFileName(dllname);
idata2objsection:=internalobjdata.createsection(sec_idata2,basedllname);
idata2label:=internalobjdata.SymbolDefine('__imp_dir_'+basedllname,AB_LOCAL,AT_DATA);
idata4objsection:=internalobjdata.createsection(sec_idata4,basedllname);

4
compiler/ogelf.pas
View File

@ -101,7 +101,7 @@ interface
implementation
uses
strings,
SysUtils,
verbose,
cutils,globals,fmodule;
@ -989,7 +989,7 @@ implementation
shstrtabsect:=TElfObjSection.create_ext(ObjSectionList,'.shstrtab',SHT_STRTAB,0,0,0,1,0);
{ insert the empty and filename as first in strtab }
strtabsect.writestr(#0);
strtabsect.writestr(SplitFileName(current_module.mainsource^)+#0);
strtabsect.writestr(ExtractFileName(current_module.mainsource^)+#0);
{ calc amount of sections we have }
nsections:=1;
{ also create the index in the section header table }

3
compiler/ogmap.pas
View File

@ -57,7 +57,8 @@ interface
implementation
uses
cutils,globals,verbose;
cutils,cfileutils,
globals,verbose;
{****************************************************************************

131
compiler/options.pas
View File

@ -26,7 +26,8 @@ unit options;
interface
uses
CClasses,globtype,globals,verbose,systems,cpuinfo;
CClasses,CFileUtils,
globtype,globals,verbose,systems,cpuinfo;
Type
TOption=class
@ -69,11 +70,7 @@ implementation
uses
widestr,
{$IFDEF USE_SYSUTILS}
SysUtils,
{$ELSE USE_SYSUTILS}
dos,
{$ENDIF USE_SYSUTILS}
version,
cutils,cmsgs,
comphook,
@ -376,9 +373,8 @@ var
more : string;
major,minor : longint;
error : integer;
j,l : longint;
d : DirStr;
s : string;
j,l : longint;
d,s : string;
begin
if opt='' then
exit;
@ -873,15 +869,10 @@ begin
if More<>'' then
begin
DefaultReplacements(More);
{$IFDEF USE_SYSUTILS}
D:=SplitPath(More);
OutputFile:=SplitFileName(More);
OutputExtension:=SplitExtension(More);
{$ELSE USE_SYSUTILS}
FSplit(More,D,OutputFile,OutputExtension);
{$ENDIF USE_SYSUTILS}
D:=ExtractFilePath(More);
if (D<>'') then
OutputExeDir:=FixPath(D,True);
OutputFileName:=ExtractFileName(More);
end
else
IllegalPara(opt);
@ -1422,20 +1413,16 @@ begin
If FileLevel>MaxLevel then
Message(option_too_many_cfg_files);
{ Maybe It's Directory ?} //Jaro Change:
if DirectoryExists(filename) then
if PathExists(filename) then
begin
Message1(option_config_is_dir,filename);
exit;
end;
{ open file }
Message1(option_using_file,filename);
{$ifdef USE_SYSUTILS}
assign(f,ExpandFileName(filename));
{$else USE_SYSUTILS}
assign(f,FExpand(filename));
{$endif USE_SYsUTILS}
{$I-}
reset(f);
reset(f);
{$I+}
if ioresult<>0 then
begin
@ -1815,19 +1802,16 @@ function check_configfile(const fn:string;var foundfn:string):boolean;
end;
var
configpath : pathstr;
hs,
configpath : string;
begin
foundfn:=fn;
check_configfile:=true;
{ retrieve configpath }
{$IFDEF USE_SYSUTILS}
configpath:=FixPath(GetEnvironmentVariable('PPC_CONFIG_PATH'),false);
{$ELSE USE_SYSUTILS}
configpath:=FixPath(dos.getenv('PPC_CONFIG_PATH'),false);
{$ENDIF USE_SYSUTILS}
{$ifdef Unix}
if configpath='' then
configpath:=CleanPath(FixPath(exepath+'../etc/',false));
configpath:=ExpandFileName(FixPath(exepath+'../etc/',false));
{$endif}
{
Order to read configuration file :
@ -1839,13 +1823,9 @@ begin
if not FileExists(fn) then
begin
{$ifdef Unix}
{$IFDEF USE_SYSUTILS}
if (GetEnvironmentVariable('HOME')<>'') and CfgFileExists(FixPath(GetEnvironmentVariable('HOME'),false)+'.'+fn) then
foundfn:=FixPath(GetEnvironmentVariable('HOME'),false)+'.'+fn
{$ELSE USE_SYSUTILS}
if (dos.getenv('HOME')<>'') and CfgFileExists(FixPath(dos.getenv('HOME'),false)+'.'+fn) then
foundfn:=FixPath(dos.getenv('HOME'),false)+'.'+fn
{$ENDIF USE_SYSUTILS}
hs:=GetEnvironmentVariable('HOME');
if (hs<>'') and CfgFileExists(FixPath(hs,false)+'.'+fn) then
foundfn:=FixPath(hs,false)+'.'+fn
else
{$endif}
if CfgFileExists(configpath+fn) then
@ -1871,11 +1851,7 @@ begin
disable_configfile:=false;
{ get default messagefile }
{$IFDEF USE_SYSUTILS}
msgfilename:=GetEnvironmentVariable('PPC_ERROR_FILE');
{$ELSE USE_SYSUTILS}
msgfilename:=dos.getenv('PPC_ERROR_FILE');
{$ENDIF USE_SYSUTILS}
{ default configfile can be specified on the commandline,
remove it first }
@ -2119,25 +2095,20 @@ begin
end;
{$ifndef Unix}
param_file:=FixFileName(param_file);
{$endif}
{$IFDEF USE_SYSUTILS}
inputdir := SplitPath(param_file);
inputfile := SplitName(param_file);
inputextension := SplitExtension(param_file);
{$ELSE USE_SYSUTILS}
fsplit(param_file,inputdir,inputfile,inputextension);
{$ENDIF USE_SYSUTILS}
if inputextension='' then
begin
if FileExists(inputdir+inputfile+sourceext) then
inputextension:=sourceext
else if FileExists(inputdir+inputfile+pasext) then
inputextension:=pasext
else if ((m_mac in current_settings.modeswitches) or
{$endif not unix}
inputfilepath:=ExtractFilePath(param_file);
inputfilename:=ExtractFileName(param_file);
if ExtractFileExt(inputfilename)='' then
begin
if FileExists(inputfilepath+ChangeFileExt(inputfilename,sourceext)) then
inputfilename:=ChangeFileExt(inputfilename,sourceext)
else if FileExists(inputfilepath+ChangeFileExt(inputfilename,pasext)) then
inputfilename:=ChangeFileExt(inputfilename,pasext)
else if ((m_mac in current_settings.modeswitches) or
(tf_p_ext_support in target_info.flags))
and FileExists(inputdir+inputfile+pext) then
inputextension:=pext;
end;
and FileExists(inputfilepath+ChangeFileExt(inputfilename,pext)) then
inputfilename:=ChangeFileExt(inputfilename,pext);
end;
{ Check output dir }
if (OutputExeDir<>'') and
@ -2154,44 +2125,30 @@ begin
LibrarySearchPath.AddList(option.ParaLibraryPath,true);
{ add unit environment and exepath to the unit search path }
if inputdir<>'' then
Unitsearchpath.AddPath(inputdir,true);
if inputfilepath<>'' then
Unitsearchpath.AddPath(inputfilepath,true);
if not disable_configfile then
begin
{$IFDEF USE_SYSUTILS}
UnitSearchPath.AddPath(GetEnvironmentVariable(target_info.unit_env),false);
{$ELSE USE_SYSUTILS}
UnitSearchPath.AddPath(dos.getenv(target_info.unit_env),false);
{$ENDIF USE_SYSUTILS}
end;
UnitSearchPath.AddPath(GetEnvironmentVariable(target_info.unit_env),false);
{$ifdef Unix}
{$IFDEF USE_SYSUTILS}
fpcdir:=FixPath(GetEnvironmentVariable('FPCDIR'),false);
{$ELSE USE_SYSUTILS}
fpcdir:=FixPath(getenv('FPCDIR'),false);
{$ENDIF USE_SYSUTILS}
if fpcdir='' then
begin
if PathExists('/usr/local/lib/fpc/'+version_string) then
fpcdir:='/usr/local/lib/fpc/'+version_string+'/'
else
fpcdir:='/usr/lib/fpc/'+version_string+'/';
end;
{$else}
{$IFDEF USE_SYSUTILS}
begin
if PathExists('/usr/local/lib/fpc/'+version_string) then
fpcdir:='/usr/local/lib/fpc/'+version_string+'/'
else
fpcdir:='/usr/lib/fpc/'+version_string+'/';
end;
{$else unix}
fpcdir:=FixPath(GetEnvironmentVariable('FPCDIR'),false);
{$ELSE USE_SYSUTILS}
fpcdir:=FixPath(getenv('FPCDIR'),false);
{$ENDIF USE_SYSUTILS}
if fpcdir='' then
begin
fpcdir:=ExePath+'../';
if not(PathExists(fpcdir+'/units')) and
not(PathExists(fpcdir+'/rtl')) then
fpcdir:=fpcdir+'../';
end;
{$endif}
begin
fpcdir:=ExePath+'../';
if not(PathExists(fpcdir+'/units')) and
not(PathExists(fpcdir+'/rtl')) then
fpcdir:=fpcdir+'../';
end;
{$endif unix}
{ first try development RTL, else use the default installation path }
if not disable_configfile then
begin

18
compiler/owar.pas
View File

@ -86,11 +86,11 @@ type
implementation
uses
SysUtils,
cstreams,
systems,
globals,
verbose,
dos;
verbose;
const
symrelocbufsize = 4096;
@ -115,7 +115,7 @@ implementation
D0=1461;
D1=146097;
D2=1721119;
Function Gregorian2Julian(DT:DateTime):LongInt;
Function Gregorian2Julian(DT:TSystemTime):LongInt;
Var
Century,XYear,Month : LongInt;
Begin
@ -132,9 +132,9 @@ implementation
End;
function DT2Unix(DT:DateTime):LongInt;
function DT2Unix(DT:TSystemTime):LongInt;
Begin
DT2Unix:=(Gregorian2Julian(DT)-C1970)*86400+(LongInt(DT.Hour)*3600)+(DT.Min*60)+DT.Sec;
DT2Unix:=(Gregorian2Julian(DT)-C1970)*86400+(LongInt(DT.Hour)*3600)+(DT.Minute*60)+DT.Second;
end;
@ -159,8 +159,7 @@ implementation
constructor tarobjectwriter.create(const Aarfn:string);
var
time : datetime;
dummy : word;
time : TSystemTime;
begin
arfn:=Aarfn;
ardata:=TDynamicArray.Create(arbufsize);
@ -168,8 +167,7 @@ implementation
symstr:=TDynamicArray.Create(symstrbufsize);
lfnstr:=TDynamicArray.Create(lfnstrbufsize);
{ create timestamp }
getdate(time.year,time.month,time.day,dummy);
gettime(time.hour,time.min,time.sec,dummy);
GetLocalTime(time);
Str(DT2Unix(time),timestamp);
end;
@ -195,7 +193,7 @@ implementation
{ win32 will change names starting with .\ to ./ when using lfn, corrupting
the sort order required for the idata sections. To prevent this strip
always the path from the filename. (PFV) }
hfn:=SplitFileName(fn);
hfn:=ExtractFileName(fn);
if hfn='' then
hfn:=fn;
fn:=hfn+'/';

3
compiler/owbase.pas
View File

@ -76,6 +76,7 @@ type
implementation
uses
SysUtils,
verbose, globals;
const
@ -130,7 +131,7 @@ begin
f.free;
{ Remove if size is 0 }
if size=0 then
RemoveFile(fn);
DeleteFile(fn);
opened:=false;
fsize:=0;
fobjsize:=0;

4
compiler/parser.pas
View File

@ -105,12 +105,12 @@ implementation
{ open assembler response }
if cs_link_on_target in current_settings.globalswitches then
GenerateAsmRes(outputexedir+inputfile+'_ppas')
GenerateAsmRes(outputexedir+ChangeFileExt(inputfilename,'_ppas'))
else
GenerateAsmRes(outputexedir+'ppas');
{ open deffile }
DefFile:=TDefFile.Create(outputexedir+inputfile+target_info.defext);
DefFile:=TDefFile.Create(outputexedir+ChangeFileExt(inputfilename,target_info.defext));
{ list of generated .o files, so the linker can remove them }
SmartLinkOFiles:=TStringList.Create;

6
compiler/pdecsub.pas
View File

@ -62,7 +62,7 @@ interface
implementation
uses
strings,
SysUtils,
{ common }
cutils,cclasses,
{ global }
@ -1508,7 +1508,7 @@ begin
if not(token=_SEMICOLON) and not(idtoken=_NAME) then
begin
{ Always add library prefix and suffix to create an uniform name }
hs:=AddExtension(get_stringconst,target_info.sharedlibext);
hs:=ChangeFileExt(get_stringconst,target_info.sharedlibext);
if Copy(hs,1,length(target_info.sharedlibprefix))<>target_info.sharedlibprefix then
hs:=target_info.sharedlibprefix+hs;
import_dll:=stringdup(hs);
@ -2129,7 +2129,7 @@ const
result:=maybe_cprefix(pd.import_name^);
end
else
result:=splitfilename(pd.import_dll^)+'_index_'+tostr(pd.import_nr);
result:=ExtractFileName(pd.import_dll^)+'_index_'+tostr(pd.import_nr);
end;
end
else

3
compiler/pdecvar.pas
View File

@ -43,6 +43,7 @@ interface
implementation
uses
SysUtils,
{ common }
cutils,cclasses,
{ global }
@ -1015,7 +1016,7 @@ implementation
if (extern_var) and (idtoken<>_NAME) then
begin
is_dll:=true;
dll_name:=AddExtension(get_stringconst,target_info.sharedlibext);
dll_name:=ChangeFileExt(get_stringconst,target_info.sharedlibext);
end;
if try_to_consume(_NAME) then
C_name:=get_stringconst

5
compiler/pmodules.pas
View File

@ -32,8 +32,9 @@ interface
implementation
uses
SysUtils,
globtype,version,systems,tokens,
cutils,cclasses,comphook,
cutils,cfileutils,cclasses,comphook,
globals,verbose,fmodule,finput,fppu,
symconst,symbase,symtype,symdef,symsym,symtable,
aasmtai,aasmdata,aasmcpu,aasmbase,
@ -850,7 +851,7 @@ implementation
{ check for system unit }
new(s2);
s2^:=upper(SplitName(main_file.name^));
s2^:=upper(ChangeFileExt(ExtractFileName(main_file.name^),''));
unitname8:=copy(current_module.modulename^,1,8);
if (cs_check_unit_name in current_settings.globalswitches) and
(

2
compiler/ptconst.pas
View File

@ -35,7 +35,7 @@ interface
implementation
uses
strings,
SysUtils,
globtype,systems,tokens,verbose,
cutils,globals,widestr,scanner,
symconst,symbase,symdef,symtable,

2
compiler/rautils.pas
View File

@ -211,7 +211,7 @@ Function SearchIConstant(const s:string; var l:aint): boolean;
Implementation
uses
strings,
SysUtils,
defutil,systems,verbose,globals,
symtable,paramgr,
aasmcpu,

11
compiler/scandir.pas
View File

@ -31,7 +31,8 @@ interface
implementation
uses
cutils,
SysUtils,
cutils,cfileutils,
globtype,globals,systems,widestr,cpuinfo,
verbose,comphook,ppu,
scanner,switches,
@ -483,7 +484,7 @@ implementation
end
else
s:= trimspace(current_scanner.readcomment);
s:=AddExtension(FixFileName(s),target_info.objext);
s:=ChangeFileExt(FixFileName(s),target_info.objext);
current_module.linkotherofiles.add(s,link_always);
end;
@ -539,7 +540,7 @@ implementation
linkmode:=lm_shared;
if linkModeStr='' then
begin
libext:=SplitExtension(libname);
libext:=ExtractFileExt(libname);
if libext=target_info.staticClibext then
linkMode:=lm_static;
end
@ -915,9 +916,9 @@ implementation
if Assigned(Current_Module) then
begin
delete(S,1,1);
insert(SplitName(current_module.mainsource^),S,1);
insert(ExtractFileName(current_module.mainsource^),S,1);
end;
s:=AddExtension(FixFileName(s),target_info.resext);
s:=ChangeFileExt(FixFileName(s),target_info.resext);
if target_info.res<>res_none then
begin
current_module.flags:=current_module.flags or uf_has_resourcefiles;

46
compiler/scanner.pas
View File

@ -205,8 +205,8 @@ interface
implementation
uses
dos,
cutils,
SysUtils,
cutils,cfileutils,
systems,
switches,
symbase,symtable,symtype,symsym,symconst,symdef,defutil,
@ -517,7 +517,9 @@ implementation
if c <> '''' then
Message2(scan_f_syn_expected, '''', c);
s := current_scanner.readquotedstring;
outputextension := '.'+s;
if OutputFileName='' then
OutputFileName:=InputFileName;
OutputFileName:=ChangeFileExt(OutputFileName,'.'+s);
with current_module do
setfilename(paramfn^, paramallowoutput);
end;
@ -1454,13 +1456,12 @@ In case not, the value returned can be arbitrary.
procedure dir_include;
function findincludefile(const path,name,ext:string;var foundfile:string):boolean;
function findincludefile(const path,name:string;var foundfile:string):boolean;
var
found : boolean;
hpath : string;
begin
(* look for the include file
(* look for the include file
If path was specified as part of {$I } then
1. specified path (expanded with path of inputfile if relative)
else
@ -1476,28 +1477,26 @@ In case not, the value returned can be arbitrary.
hpath:=current_scanner.inputfile.path^+path
else
hpath:=path;
found:=FindFile(name+ext, hpath,foundfile);
found:=FindFile(name, hpath,foundfile);
end
else
begin
hpath:=current_scanner.inputfile.path^+';'+CurDirRelPath(source_info);
found:=FindFile(name+ext, hpath,foundfile);
found:=FindFile(name, hpath,foundfile);
if not found then
found:=current_module.localincludesearchpath.FindFile(name+ext,foundfile);
found:=current_module.localincludesearchpath.FindFile(name,foundfile);
if not found then
found:=includesearchpath.FindFile(name+ext,foundfile);
found:=includesearchpath.FindFile(name,foundfile);
end;
findincludefile:=found;
result:=found;
end;
var
path,
name,
args,
foundfile,
hs : string;
path : dirstr;
name : namestr;
ext : extstr;
hs : tpathstr;
hp : tinputfile;
found : boolean;
begin
@ -1544,7 +1543,7 @@ In case not, the value returned can be arbitrary.
if hs='FPCTARGETOS' then
hs:=target_info.shortname
else
hs:=getenv(hs);
hs:=GetEnvironmentVariable(hs);
if hs='' then
Message1(scan_w_include_env_not_found,path);
{ make it a stringconst }
@ -1555,18 +1554,19 @@ In case not, the value returned can be arbitrary.
else
begin
hs:=FixFileName(hs);
fsplit(hs,path,name,ext);
path:=ExtractFilePath(hs);
name:=ExtractFileName(hs);
{ try to find the file }
found:=findincludefile(path,name,ext,foundfile);
if (ext='') then
found:=findincludefile(path,name,foundfile);
if (ExtractFileExt(name)='') then
begin
{ try default extensions .inc , .pp and .pas }
if (not found) then
found:=findincludefile(path,name,'.inc',foundfile);
found:=findincludefile(path,ChangeFileExt(name,'.inc'),foundfile);
if (not found) then
found:=findincludefile(path,name,sourceext,foundfile);
found:=findincludefile(path,ChangeFileExt(name,sourceext),foundfile);
if (not found) then
found:=findincludefile(path,name,pasext,foundfile);
found:=findincludefile(path,ChangeFileExt(name,pasext),foundfile);
end;
if current_scanner.inputfilecount<max_include_nesting then
begin

7
compiler/script.pas
View File

@ -104,7 +104,8 @@ uses
{$ifdef hasUnix}
BaseUnix,
{$endif}
cutils,
SysUtils,
cutils,cfileutils,
globtype,globals,systems,verbose;
@ -136,9 +137,9 @@ constructor TScript.CreateExec(const s:string);
begin
fn:=FixFileName(s);
if cs_link_on_target in current_settings.globalswitches then
fn:=AddExtension(fn,target_info.scriptext)
fn:=ChangeFileExt(fn,target_info.scriptext)
else
fn:=AddExtension(fn,source_info.scriptext);
fn:=ChangeFileExt(fn,source_info.scriptext);
executable:=true;
data:=TStringList.Create;
end;

4
compiler/symbase.pas
View File

@ -92,8 +92,8 @@ interface
procedure dumpsym(p : TNamedIndexItem;arg:pointer);
{$endif EXTDEBUG}
public
name : pstring;
realname : pstring;
name : pshortstring;
realname : pshortstring;
symindex,
defindex : TIndexArray;
symsearch : Tdictionary;

19
compiler/symdef.pas
View File

@ -26,7 +26,7 @@ interface
uses
{ common }
cutils,cclasses,
cclasses,
{ global }
globtype,globals,tokens,
{ symtable }
@ -135,7 +135,7 @@ interface
end;
tforwarddef = class(tstoreddef)
tosymname : pstring;
tosymname : pshortstring;
forwardpos : tfileposinfo;
constructor create(const s:string;const pos : tfileposinfo);
destructor destroy;override;
@ -239,7 +239,7 @@ interface
childof : tobjectdef;
childofderef : tderef;
objname,
objrealname : pstring;
objrealname : pshortstring;
objectoptions : tobjectoptions;
{ to be able to have a variable vmt position }
{ and no vmt field for objects without virtuals }
@ -247,7 +247,7 @@ interface
writing_class_record_dbginfo : boolean;
objecttype : tobjectdeftype;
iidguid: pguid;
iidstr: pstring;
iidstr: pshortstring;
iitype: tinterfaceentrytype;
iioffset: longint;
lastvtableindex: longint;
@ -448,7 +448,7 @@ interface
tmessageinf = record
case integer of
0 : (str : pstring);
0 : (str : pshortstring);
1 : (i : longint);
end;
@ -476,7 +476,7 @@ interface
tprocdef = class(tabstractprocdef)
private
_mangledname : pstring;
_mangledname : pshortstring;
public
extnumber : word;
messageinf : tmessageinf;
@ -520,7 +520,7 @@ interface
hasforward : boolean;
{ import info }
import_dll,
import_name : pstring;
import_name : pshortstring;
import_nr : word;
{ info for inlining the subroutine, if this pointer is nil,
the procedure can't be inlined }
@ -760,7 +760,8 @@ interface
implementation
uses
strings,
SysUtils,
cutils,
{ global }
verbose,
{ target }
@ -5203,7 +5204,7 @@ implementation
type
tnamemap = class(TNamedIndexItem)
listnext : TNamedIndexItem;
newname: pstring;
newname: pshortstring;
constructor create(const aname, anewname: string);
destructor destroy; override;
end;

8
compiler/symsym.pas
View File

@ -200,7 +200,7 @@ interface
tglobalvarsym = class(tabstractnormalvarsym)
private
_mangledname : pstring;
_mangledname : pshortstring;
public
constructor create(const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
constructor create_dll(const n : string;vsp:tvarspez;def:tdef);
@ -218,7 +218,7 @@ interface
{$ifdef i386}
absseg : boolean;
{$endif i386}
asmname : pstring;
asmname : pshortstring;
addroffset : aint;
ref : tpropaccesslist;
constructor create(const n : string;def:tdef);
@ -256,7 +256,7 @@ interface
ttypedconstsym = class(tstoredsym)
private
_mangledname : pstring;
_mangledname : pshortstring;
public
typedconstdef : tdef;
typedconstdefderef : tderef;
@ -347,7 +347,7 @@ interface
{ compiler generated symbol to point to rtti and init/finalize tables }
trttisym = class(tstoredsym)
private
_mangledname : pstring;
_mangledname : pshortstring;
public
lab : tasmsymbol;
rttityp : trttitype;

2
compiler/symtable.pas
View File

@ -252,7 +252,7 @@ interface
type
punit_alias = ^tunit_alias;
tunit_alias = object(TNamedIndexItem)
newname : pstring;
newname : pshortstring;
constructor init(const n:string);
destructor done;virtual;
end;

2
compiler/symtype.pas
View File

@ -104,7 +104,7 @@ interface
tsym = class(tsymentry)
protected
public
_realname : pstring;
_realname : pshortstring;
fileinfo : tfileposinfo;
symoptions : tsymoptions;
refs : longint;

6
compiler/systems/t_beos.pas
View File

@ -56,8 +56,8 @@ interface
implementation
uses
dos,
cutils,cclasses,
SysUtils,
cutils,cfileutils,cclasses,
verbose,systems,globtype,globals,
symconst,script,
fmodule,aasmbase,aasmtai,aasmdata,aasmcpu,cpubase,i_beos,ogbase;
@ -172,7 +172,7 @@ var
i : integer;
begin
Inherited Create;
s:=GetEnv('BELIBRARIES');
s:=GetEnvironmentVariable('BELIBRARIES');
{ convert to correct format in case under unix system }
for i:=1 to length(s) do
if s[i] = ':' then

34
compiler/systems/t_bsd.pas
View File

@ -31,12 +31,8 @@ interface
implementation
uses
cutils,cclasses,
{$ifdef USE_SYSUTILS}
sysutils,
{$else USE_SYSUTILS}
dos,
{$endif USE_SYSUTILS}
cutils,cfileutils,cclasses,
verbose,systems,globtype,globals,
symconst,script,
fmodule,aasmbase,aasmtai,aasmdata,aasmcpu,cpubase,symsym,symdef,
@ -253,19 +249,19 @@ begin
end;
procedure TLinkerBSD.LoadPredefinedLibraryOrder;
// put your linkorder/linkalias overrides here.
// put your linkorder/linkalias overrides here.
// Note: assumes only called when reordering/aliasing is used.
Begin
if not(target_info.system in [system_powerpc_darwin,system_i386_darwin]) then
begin
if (target_info.system =system_i386_freebsd) and
not (cs_link_no_default_lib_order in current_settings.globalswitches) Then
if (target_info.system =system_i386_freebsd) and
not (cs_link_no_default_lib_order in current_settings.globalswitches) Then
Begin
LinkLibraryOrder.add('gcc','',15);
LinkLibraryOrder.add('c','',50); // c and c_p mutual. excl?
LinkLibraryOrder.add('c_p','',55);
LinkLibraryOrder.add('gcc','',15);
LinkLibraryOrder.add('c','',50); // c and c_p mutual. excl?
LinkLibraryOrder.add('c_p','',55);
LinkLibraryOrder.add('pthread','',75); // pthread and c_r should be mutually exclusive
LinkLibraryOrder.add('c_r','',76);
LinkLibraryOrder.add('c_r','',76);
LinkLibraryOrder.add('kvm','',80); // must be before ncurses
if (cs_link_pthread in current_settings.globalswitches) Then // convert libpthread to libc_r.
LinkLibraryAliases.add('pthread','c_r');
@ -273,7 +269,7 @@ Begin
end
else
begin
LinkLibraryOrder.add('gcc','',15);
LinkLibraryOrder.add('gcc','',15);
LinkLibraryOrder.add('c','',50);
end;
End;
@ -292,7 +288,7 @@ Var
Fl1,Fl2 : Boolean;
IsDarwin : Boolean;
ReOrder : Boolean;
begin
WriteResponseFile:=False;
ReOrder:=False;
@ -309,7 +305,7 @@ begin
// Only reorder for now if -XL or -XO params are given
// or when -Xf.
reorder:= linklibc and
(
(
ReorderEntries
or
(cs_link_pthread in current_settings.globalswitches));
@ -325,7 +321,7 @@ begin
if linklibc then
prtobj:=cprtobj;
end;
// after this point addition of shared libs not allowed.
// after this point addition of shared libs not allowed.
end
else
begin
@ -576,18 +572,14 @@ begin
InitStr:='-init FPC_LIB_START';
FiniStr:='-fini FPC_LIB_EXIT';
SoNameStr:='-soname '+SplitFileName(current_module.sharedlibfilename^);
SoNameStr:='-soname '+ExtractFileName(current_module.sharedlibfilename^);
{ Call linker }
SplitBinCmd(Info.DllCmd[1],binstr,cmdstr);
{$ifndef darwin}
Replace(cmdstr,'$EXE',maybequoted(current_module.sharedlibfilename^));
{$else darwin}
{$ifdef USE_SYSUTILS}
Replace(cmdstr,'$EXE',maybequoted(ExpandFileName(current_module.sharedlibfilename^)));
{$else USE_SYSUTILS}
Replace(cmdstr,'$EXE',maybequoted(FExpand(current_module.sharedlibfilename^)));
{$endif USE_SYSUTILS}
{$endif darwin}
Replace(cmdstr,'$OPT',Info.ExtraOptions);
Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName));

45
compiler/systems/t_emx.pas
View File

@ -37,9 +37,8 @@ interface
implementation
uses
strings,
dos,
cutils,cclasses,
sysutils,
cutils,cfileutils,cclasses,
globtype,comphook,systems,symconst,symsym,symdef,
globals,verbose,fmodule,script,ogbase,
import,link,i_emx,ppu;
@ -131,21 +130,40 @@ var aout_str_size:longint;
out_file:file;
procedure PackTime (var T: TSystemTime; var P: longint);
var zs:longint;
begin
p:=-1980;
p:=p+t.year and 127;
p:=p shl 4;
p:=p+t.month;
p:=p shl 5;
p:=p+t.day;
p:=p shl 16;
zs:=t.hour;
zs:=zs shl 6;
zs:=zs+t.minute;
zs:=zs shl 5;
zs:=zs+t.second div 2;
p:=p+(zs and $ffff);
end;
procedure write_ar(const name:string;size:longint);
var ar:ar_hdr;
time:datetime;
var ar:ar_hdr; {PackTime is platform independent}
time:TSystemTime;
dummy:word;
numtime:longint;
tmp:string[19];
begin
ar_member_size:=size;
fillchar(ar.ar_name,sizeof(ar.ar_name),' ');
move(name[1],ar.ar_name,length(name));
getdate(time.year,time.month,time.day,dummy);
gettime(time.hour,time.min,time.sec,dummy);
GetLocalTime(time);
packtime(time,numtime);
str(numtime,tmp);
fillchar(ar.ar_date,sizeof(ar.ar_date),' ');
@ -438,17 +456,14 @@ var
AppTypeStr,
StripStr: string[40];
RsrcStr : string;
DS: DirStr;
NS: NameStr;
ES: ExtStr;
OutName: PathStr;
DS,NS,ES : string;
OutName: string;
begin
if not(cs_link_nolink in current_settings.globalswitches) then
Message1(exec_i_linking,current_module.exefilename^);
{ Create some replacements }
FSplit (current_module.exefilename^, DS, NS, ES);
OutName := DS + NS + '.out';
OutName := ChangeFileExt(current_module.exefilename^,'.out');
if (cs_link_strip in current_settings.globalswitches) then
StripStr := '-s'
else

8
compiler/systems/t_go32v2.pas
View File

@ -30,9 +30,11 @@ interface
implementation
uses
link,
cutils,cclasses,
globtype,globals,systems,verbose,script,fmodule,i_go32v2,ogcoff;
SysUtils,
cutils,cfileutils,cclasses,
globtype,globals,systems,verbose,script,
fmodule,i_go32v2,
link,ogcoff;
type
TInternalLinkerGo32v2=class(TInternallinker)

21
compiler/systems/t_linux.pas
View File

@ -59,10 +59,11 @@ interface
implementation
uses
cutils,cclasses,
SysUtils,
cutils,cfileutils,cclasses,
verbose,systems,globtype,globals,
symconst,script,
fmodule,dos,
fmodule,
aasmbase,aasmtai,aasmdata,aasmcpu,cpubase,
cgbase,cgobj,cgutils,ogbase,
i_linux
@ -303,10 +304,10 @@ Begin
if not (cs_link_no_default_lib_order in current_settings.globalswitches) Then
Begin
LinkLibraryOrder.add('gcc','',15);
LinkLibraryOrder.add('c','',100);
LinkLibraryOrder.add('c','',100);
LinkLibraryOrder.add('gmon','',120);
LinkLibraryOrder.add('dl','',140);
LinkLibraryOrder.add('pthread','',160);
LinkLibraryOrder.add('dl','',140);
LinkLibraryOrder.add('pthread','',160);
end;
End;
@ -422,13 +423,13 @@ begin
if reorder Then
ExpandAndApplyOrder(SharedLibFiles);
// after this point addition of shared libs not allowed.
{ Write sharedlibraries like -l<lib>, also add the needed dynamic linker
here to be sure that it gets linked this is needed for glibc2 systems (PFV) }
if not SharedLibFiles.Empty then
begin
Add('INPUT(');
While not SharedLibFiles.Empty do
begin
@ -605,7 +606,7 @@ begin
if (cs_link_strip in current_settings.globalswitches) then
StripStr:='-s';
if (cs_link_map in current_settings.globalswitches) then
StripStr:='-Map '+maybequoted(ForceExtension(current_module.exefilename^,'.map'));
StripStr:='-Map '+maybequoted(ChangeFileExt(current_module.exefilename^,'.map'));
if use_smartlink_section then
GCSectionsStr:='--gc-sections';
If (cs_profile in current_settings.moduleswitches) or
@ -668,7 +669,7 @@ begin
{ Create some replacements }
InitStr:='-init FPC_LIB_START';
FiniStr:='-fini FPC_LIB_EXIT';
SoNameStr:='-soname '+SplitFileName(current_module.sharedlibfilename^);
SoNameStr:='-soname '+ExtractFileName(current_module.sharedlibfilename^);
{ Call linker }
SplitBinCmd(Info.DllCmd[1],binstr,cmdstr);

5
compiler/systems/t_nwl.pas
View File

@ -98,7 +98,8 @@ implementation
{$endif}
uses
cutils,
SysUtils,
cutils,cfileutils,
verbose,systems,globtype,globals,
symconst,script,
fmodule,aasmbase,aasmtai,aasmdata,aasmcpu,cpubase,symsym,symdef,
@ -549,7 +550,7 @@ begin
{ if we have a xdc file, dont touch it, otherwise create a new
one and remove it after nlmconv }
xdcname := ForceExtension(current_module.exefilename^,'.xdc');
xdcname := ChangeFileExt(current_module.exefilename^,'.xdc');
xdcpresent := FileExists (xdcname);
if not xdcpresent then
begin

2
compiler/systems/t_nwm.pas
View File

@ -92,7 +92,7 @@ interface
implementation
uses
cutils,
cutils,cfileutils,
verbose,systems,globtype,globals,
symconst,script,
fmodule,aasmbase,aasmtai,aasmdata,aasmcpu,cpubase,symsym,symdef,

40
compiler/systems/t_os2.pas
View File

@ -37,9 +37,8 @@ interface
implementation
uses
strings,
dos,
cutils,cclasses,
SysUtils,
cutils,cfileutils,cclasses,
globtype,systems,symconst,symdef,
globals,verbose,fmodule,script,
import,link,i_os2,ogbase;
@ -130,11 +129,31 @@ var aout_str_size:longint;
out_file:file;
procedure PackTime (var T: TSystemTime; var P: longint);
var zs:longint;
begin
p:=-1980;
p:=p+t.year and 127;
p:=p shl 4;
p:=p+t.month;
p:=p shl 5;
p:=p+t.day;
p:=p shl 16;
zs:=t.hour;
zs:=zs shl 6;
zs:=zs+t.minute;
zs:=zs shl 5;
zs:=zs+t.second div 2;
p:=p+(zs and $ffff);
end;
procedure write_ar(const name:string;size:longint);
var ar:ar_hdr;
time:datetime;
dummy:word;
time:TSystemTime;
numtime:longint;
tmp:string[19];
@ -143,8 +162,7 @@ begin
ar_member_size:=size;
fillchar(ar.ar_name,sizeof(ar.ar_name),' ');
move(name[1],ar.ar_name,length(name));
getdate(time.year,time.month,time.day,dummy);
gettime(time.hour,time.min,time.sec,dummy);
GetLocalTime(time);
packtime(time,numtime);
str(numtime,tmp);
fillchar(ar.ar_date,sizeof(ar.ar_date),' ');
@ -437,17 +455,13 @@ var
AppTypeStr,
StripStr: string[40];
RsrcStr : string;
DS: DirStr;
NS: NameStr;
ES: ExtStr;
OutName: PathStr;
OutName: TPathStr;
begin
if not(cs_link_nolink in current_settings.globalswitches) then
Message1(exec_i_linking,current_module.exefilename^);
{ Create some replacements }
FSplit (current_module.exefilename^, DS, NS, ES);
OutName := DS + NS + '.out';
OutName := ChangeFileExt(current_module.exefilename^,'.out');
if (cs_link_strip in current_settings.globalswitches) then
StripStr := '-s'
else

3
compiler/systems/t_sunos.pas
View File

@ -34,7 +34,8 @@ interface
implementation
uses
cutils,cclasses,
sysutils,
cutils,cfileutils,cclasses,
verbose,systems,globtype,globals,
symconst,script,
fmodule,aasmbase,aasmtai,aasmdata,aasmcpu,cpubase,symsym,symdef,

3
compiler/systems/t_watcom.pas
View File

@ -31,7 +31,8 @@ implementation
uses
link,
cclasses,cutils,strings,globtype,globals,
SysUtils,
cclasses,cutils,cfileutils,globtype,globals,
systems,verbose,script,fmodule,i_watcom;

14
compiler/systems/t_win.pas
View File

@ -24,8 +24,8 @@ unit t_win;
{$i fpcdefs.inc}
interface
uses
dos,
cutils,cclasses,
aasmbase,aasmtai,aasmdata,aasmcpu,fmodule,globtype,globals,systems,verbose,
symconst,symdef,symsym,
@ -89,6 +89,8 @@ interface
implementation
uses
SysUtils,
cfileutils,
cpuinfo,cgutils,dbgbase,
owar,ogbase,ogcoff;
@ -165,7 +167,7 @@ implementation
idata4objsection:=objdata.createsection(sec_idata4,'');
idata5objsection:=objdata.createsection(sec_idata5,'');
emptyint:=0;
basedllname:=splitfilename(dllname);
basedllname:=ExtractFileName(dllname);
{ idata4 }
objdata.SetSection(idata4objsection);
idata4label:=objdata.SymbolDefine(asmprefix+'_names_'+basedllname,AB_GLOBAL,AT_DATA);
@ -456,7 +458,7 @@ implementation
if ImportSymbol.Name <> '' then
current_asmdata.asmlists[al_imports].concat(Tai_symbol.Createname_global(ImportSymbol.Name,AT_FUNCTION,0))
else
current_asmdata.asmlists[al_imports].concat(Tai_symbol.Createname_global(splitfilename(ImportLibrary.Name)+'_index_'+tostr(ImportSymbol.ordnr),AT_FUNCTION,0));
current_asmdata.asmlists[al_imports].concat(Tai_symbol.Createname_global(ExtractFileName(ImportLibrary.Name)+'_index_'+tostr(ImportSymbol.ordnr),AT_FUNCTION,0));
current_asmdata.asmlists[al_imports].concat(tai_function_name.create(''));
{$ifdef ARM}
reference_reset_symbol(href,l5,0);
@ -1281,7 +1283,7 @@ implementation
if (cs_link_strip in current_settings.globalswitches) then
StripStr:='-s';
if (cs_link_map in current_settings.globalswitches) then
MapStr:='-Map '+maybequoted(ForceExtension(current_module.exefilename^,'.map'));
MapStr:='-Map '+maybequoted(ChangeFileExt(current_module.exefilename^,'.map'));
{ Write used files and libraries }
WriteResponseFile(false);
@ -1383,7 +1385,7 @@ implementation
if (cs_link_strip in current_settings.globalswitches) then
StripStr:='-s';
if (cs_link_map in current_settings.globalswitches) then
MapStr:='-Map '+maybequoted(ForceExtension(current_module.exefilename^,'.map'));
MapStr:='-Map '+maybequoted(ChangeFileExt(current_module.exefilename^,'.map'));
{ Write used files and libraries }
WriteResponseFile(true);
@ -1650,7 +1652,7 @@ implementation
if FindLibraryFile(binname,target_info.staticClibprefix,target_info.staticClibext,hs) then
exit;
{ check if we can find the dll }
hs:=AddExtension(binname,target_info.sharedlibext);
hs:=ChangeFileExt(binname,target_info.sharedlibext);
if not FindDll(hs,dllname) then
exit;
importfound:=false;

16
compiler/utils/fixtab.pp
View File

@ -87,12 +87,12 @@ end;
Function AddExtension(Const HStr,ext:String):String;
Function ChangeFileExt(Const HStr,ext:String):String;
begin
if (Ext<>'') and (SplitExtension(HStr)='') then
AddExtension:=Hstr+'.'+Ext
ChangeFileExt:=Hstr+'.'+Ext
else
AddExtension:=Hstr;
ChangeFileExt:=Hstr;
end;
@ -185,13 +185,13 @@ var
begin
{Create New FileName}
if SplitExtension(nfn)='*' then
nfn:=AddExtension(SplitPath(nfn)+SplitName(nfn),SplitExtension(fn));
nfn:=ChangeFileExt(SplitPath(nfn)+SplitName(nfn),SplitExtension(fn));
if SplitName(nfn)='*' then
begin
if SplitPath(nfn)='' then
nfn:=AddExtension(SplitPath(fn)+SplitName(fn),SplitExtension(nfn))
nfn:=ChangeFileExt(SplitPath(fn)+SplitName(fn),SplitExtension(nfn))
else
nfn:=AddExtension(SplitPath(nfn)+SplitName(fn),SplitExtension(nfn));
nfn:=ChangeFileExt(SplitPath(nfn)+SplitName(fn),SplitExtension(nfn));
end;
{Done?}
if FileDone(nfn) then
@ -320,7 +320,7 @@ begin
ch:=para[2];
delete(para,1,2);
case ch of
'O' : OutFile:=AddExtension(Para,OutputExt);
'O' : OutFile:=ChangeFileExt(Para,OutputExt);
'D' : DosEol:=true;
'T' : Val(Para,TabSize,j);
'V' : verbose:=true;
@ -356,7 +356,7 @@ begin
end;
for i:=ParaFile to ParamCount do
begin
InFile:=AddExtension(ParamStr(i),InputExt);
InFile:=ChangeFileExt(ParamStr(i),InputExt);
FindFirst(InFile,$20,Dir);
while (DosError=0) do
begin

8
compiler/utils/ppufiles.pp
View File

@ -62,7 +62,7 @@ begin
end;
Function AddExtension(Const HStr,ext:String):String;
Function ChangeFileExt(Const HStr,ext:String):String;
{
Return a filename which will have extension ext added if no
extension is found
@ -74,9 +74,9 @@ begin
while (j>0) and (Hstr[j]<>'.') do
dec(j);
if j=0 then
AddExtension:=Hstr+'.'+Ext
ChangeFileExt:=Hstr+'.'+Ext
else
AddExtension:=HStr;
ChangeFileExt:=HStr;
end;
@ -224,7 +224,7 @@ begin
parafile:=i;
for i:=parafile to ParamCount do
begin
InFile:=AddExtension(ParamStr(i),PPUExt);
InFile:=ChangeFileExt(ParamStr(i),PPUExt);
FindFirst(InFile,$20,Dir);
while (DosError=0) do
begin

8
compiler/utils/ppumove.pp
View File

@ -147,7 +147,7 @@ begin
end;
Function AddExtension(Const HStr,ext:String):String;
Function ChangeFileExt(Const HStr,ext:String):String;
{
Return a filename which will have extension ext added if no
extension is found
@ -159,9 +159,9 @@ begin
while (j>0) and (Hstr[j]<>'.') do
dec(j);
if j=0 then
AddExtension:=Hstr+'.'+Ext
ChangeFileExt:=Hstr+'.'+Ext
else
AddExtension:=HStr;
ChangeFileExt:=HStr;
end;
@ -635,7 +635,7 @@ begin
end;
{ Process Files }
i:=OptInd;
While (i<=ParamCount) and Dofile(AddExtension(Paramstr(i),PPUExt)) do
While (i<=ParamCount) and Dofile(ChangeFileExt(Paramstr(i),PPUExt)) do
Inc(i);
{ Do Linking stage }
DoLink;

14
compiler/x86/agx86int.pas
View File

@ -49,6 +49,7 @@ interface
implementation
uses
SysUtils,
cutils,globtype,globals,systems,cclasses,
verbose,finput,fmodule,script,cpuinfo,
itx86int,
@ -845,23 +846,22 @@ implementation
function tx86intelassembler.DoAssemble : boolean;
var f : file;
var
masmobjfn : string;
begin
DoAssemble:=Inherited DoAssemble;
{ masm does not seem to recognize specific extensions and uses .obj allways PM }
if (target_asm.id in [as_i386_masm,as_i386_wasm]) then
begin
masmobjfn:=ChangeFileExt(objfilename,'.obj');
if not(cs_asm_extern in current_settings.globalswitches) then
begin
if Not FileExists(objfilename) and
FileExists(ForceExtension(objfilename,'.obj')) then
begin
Assign(F,ForceExtension(objfilename,'.obj'));
Rename(F,objfilename);
end;
FileExists(masmobjfn) then
RenameFile(masmobjfn,objfilename);
end
else
AsmRes.AddAsmCommand('mv',ForceExtension(objfilename,'.obj')+' '+objfilename,objfilename);
AsmRes.AddAsmCommand('mv',masmobjfn+' '+objfilename,objfilename);
end;
end;