mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-29 10:00:31 +02:00
* merged
This commit is contained in:
peter
parent
1730312b75
commit
02576a8279
@ -60,13 +60,13 @@ unit globals;
|
||||
|
||||
delphimodeswitches : tmodeswitches=
|
||||
[m_delphi,m_tp,m_all,m_class,m_objpas,m_result,m_string_pchar,
|
||||
m_pointer_2_procedure,m_autoderef,m_tp_procvar];
|
||||
m_pointer_2_procedure,m_autoderef,m_tp_procvar,m_initfinal];
|
||||
fpcmodeswitches : tmodeswitches=
|
||||
[m_fpc,m_all,m_string_pchar,m_nested_comment,m_repeat_forward,
|
||||
m_cvar_support];
|
||||
m_cvar_support,m_initfinal];
|
||||
objfpcmodeswitches : tmodeswitches=
|
||||
[m_fpc,m_all,m_objpas,m_class,m_result,m_string_pchar,m_nested_comment,
|
||||
m_repeat_forward,m_cvar_support];
|
||||
[m_fpc,m_all,m_class,m_objpas,m_result,m_string_pchar,m_nested_comment,
|
||||
m_repeat_forward,m_cvar_support,m_initfinal];
|
||||
tpmodeswitches : tmodeswitches=
|
||||
[m_tp,m_all,m_tp_procvar];
|
||||
gpcmodeswitches : tmodeswitches=
|
||||
@ -184,7 +184,8 @@ unit globals;
|
||||
function min(a,b : longint) : longint;
|
||||
function max(a,b : longint) : longint;
|
||||
function align(i,a:longint):longint;
|
||||
procedure Replace(var s:string;const s1,s2:string);
|
||||
procedure Replace(var s:string;s1:string;const s2:string);
|
||||
procedure ReplaceCase(var s:string;const s1,s2:string);
|
||||
function upper(const s : string) : string;
|
||||
function lower(const s : string) : string;
|
||||
function trimspace(const s:string):string;
|
||||
@ -204,6 +205,8 @@ unit globals;
|
||||
function gettimestr:string;
|
||||
function filetimestring( t : longint) : string;
|
||||
|
||||
procedure DefaultReplacements(var s:string);
|
||||
|
||||
function path_absolute(const s : string) : boolean;
|
||||
Function FileExists ( Const F : String) : Boolean;
|
||||
Function RemoveFile(const f:string):boolean;
|
||||
@ -363,21 +366,44 @@ unit globals;
|
||||
end;
|
||||
|
||||
|
||||
procedure Replace(var s:string;const s1,s2:string);
|
||||
{
|
||||
replace all s1 with s2 in string s
|
||||
}
|
||||
procedure Replace(var s:string;s1:string;const s2:string);
|
||||
var
|
||||
last,
|
||||
i : longint;
|
||||
begin
|
||||
s1:=upper(s1);
|
||||
last:=0;
|
||||
repeat
|
||||
i:=pos(s1,s);
|
||||
if i>0 then
|
||||
i:=pos(s1,upper(s));
|
||||
if i=last then
|
||||
i:=0;
|
||||
if (i>0) then
|
||||
begin
|
||||
Delete(s,i,length(s1));
|
||||
Insert(s2,s,i);
|
||||
last:=i;
|
||||
end;
|
||||
until i=0;
|
||||
until (i=0);
|
||||
end;
|
||||
|
||||
|
||||
procedure ReplaceCase(var s:string;const s1,s2:string);
|
||||
var
|
||||
last,
|
||||
i : longint;
|
||||
begin
|
||||
last:=0;
|
||||
repeat
|
||||
i:=pos(s1,s);
|
||||
if i=last then
|
||||
i:=0;
|
||||
if (i>0) then
|
||||
begin
|
||||
Delete(s,i,length(s1));
|
||||
Insert(s2,s,i);
|
||||
last:=i;
|
||||
end;
|
||||
until (i=0);
|
||||
end;
|
||||
|
||||
|
||||
@ -680,6 +706,19 @@ unit globals;
|
||||
filetimestring:=L0(Year)+'/'+L0(Month)+'/'+L0(Day)+' '+L0(Hour)+':'+L0(min)+':'+L0(sec);
|
||||
end;
|
||||
|
||||
{****************************************************************************
|
||||
Default Macro Handling
|
||||
****************************************************************************}
|
||||
|
||||
procedure DefaultReplacements(var s:string);
|
||||
begin
|
||||
{ Replace some macro's }
|
||||
Replace(s,'$FPCVER',full_version_string);
|
||||
Replace(s,'$FPCDATE',date_string);
|
||||
Replace(s,'$FPCTARGET',target_cpu_string);
|
||||
Replace(s,'$TARGET',target_path);
|
||||
end;
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
File Handling
|
||||
@ -832,14 +871,18 @@ unit globals;
|
||||
var
|
||||
i : longint;
|
||||
begin
|
||||
{ Fix separator }
|
||||
for i:=1 to length(s) do
|
||||
if s[i] in ['/','\'] then
|
||||
s[i]:=DirSep;
|
||||
{ Fix ending / }
|
||||
if (length(s)>0) and (s[length(s)]<>DirSep) and
|
||||
(s[length(s)]<>':') then
|
||||
s:=s+DirSep;
|
||||
{ Remove ./ }
|
||||
if (not allowdot) and (s='.'+DirSep) then
|
||||
s:='';
|
||||
{ return }
|
||||
FixPath:=s;
|
||||
end;
|
||||
|
||||
@ -893,7 +936,9 @@ unit globals;
|
||||
begin
|
||||
if s='' then
|
||||
exit;
|
||||
{Fix List}
|
||||
{ Support default macro's }
|
||||
DefaultReplacements(s);
|
||||
{ Fix List }
|
||||
if (length(list)>0) and (list[length(list)]<>';') then
|
||||
list:=list+';';
|
||||
GetDir(0,CurrentDir);
|
||||
@ -1162,7 +1207,17 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.10 1999-07-06 21:48:16 florian
|
||||
Revision 1.11 1999-07-10 10:26:18 peter
|
||||
* merged
|
||||
|
||||
Revision 1.8.2.2 1999/07/10 10:03:04 peter
|
||||
* fixed initialization/finalization in fpc mode
|
||||
* allow $TARGET also in search paths
|
||||
|
||||
Revision 1.8.2.1 1999/07/07 07:53:21 michael
|
||||
+ Merged patches from florian
|
||||
|
||||
Revision 1.10 1999/07/06 21:48:16 florian
|
||||
* a lot bug fixes:
|
||||
- po_external isn't any longer necessary for procedure compatibility
|
||||
- m_tp_procvar is in -Sd now available
|
||||
|
||||
@ -98,11 +98,18 @@ interface
|
||||
{ generic }
|
||||
m_fpc,m_delphi,m_tp,m_gpc,
|
||||
{ more specific }
|
||||
m_class,m_objpas,m_result,m_string_pchar,m_cvar_support,
|
||||
m_nested_comment,m_tp_procvar,m_repeat_forward,
|
||||
m_class, { delphi class model }
|
||||
m_objpas, { load objpas unit }
|
||||
m_result, { result in functions }
|
||||
m_string_pchar, { pchar 2 string conversion }
|
||||
m_cvar_support, { cvar variable directive }
|
||||
m_nested_comment, { nested comments }
|
||||
m_tp_procvar, { tp style procvars (no @ needed) }
|
||||
m_repeat_forward, { repeating forward declarations is needed }
|
||||
m_pointer_2_procedure, { allows the assignement of pointers to
|
||||
procedure variables }
|
||||
m_autoderef { does auto dereferencing of struct. vars }
|
||||
m_autoderef, { does auto dereferencing of struct. vars }
|
||||
m_initfinal { initialization/finalization for units }
|
||||
);
|
||||
tmodeswitches = set of tmodeswitch;
|
||||
|
||||
@ -142,10 +149,17 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.11 1999-07-03 00:29:49 peter
|
||||
Revision 1.12 1999-07-10 10:26:19 peter
|
||||
* merged
|
||||
|
||||
Revision 1.11 1999/07/03 00:29:49 peter
|
||||
* new link writing to the ppu, one .ppu is needed for all link types,
|
||||
static (.o) is now always created also when smartlinking is used
|
||||
|
||||
Revision 1.10.2.1 1999/07/10 10:03:06 peter
|
||||
* fixed initialization/finalization in fpc mode
|
||||
* allow $TARGET also in search paths
|
||||
|
||||
Revision 1.10 1999/05/17 14:30:39 pierre
|
||||
+ cs_checkpointer
|
||||
|
||||
|
||||
@ -234,6 +234,7 @@ unit systems;
|
||||
target_link : tlinkinfo;
|
||||
target_ar : tarinfo;
|
||||
target_res : tresinfo;
|
||||
target_path : string[12]; { for rtl/<X>/,fcl/<X>/, etc. }
|
||||
source_os : tosinfo;
|
||||
|
||||
function set_target_os(t:tos):boolean;
|
||||
@ -1217,6 +1218,26 @@ begin
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
function lower(const s : string) : string;
|
||||
var
|
||||
i : longint;
|
||||
begin
|
||||
for i:=1 to length(s) do
|
||||
if s[i] in ['A'..'Z'] then
|
||||
lower[i]:=char(byte(s[i])+32)
|
||||
else
|
||||
lower[i]:=s[i];
|
||||
{$ifndef TP}
|
||||
{$ifopt H+}
|
||||
setlength(lower,length(s));
|
||||
{$else}
|
||||
lower[0]:=s[0];
|
||||
{$endif}
|
||||
{$else}
|
||||
lower[0]:=s[0];
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
|
||||
function set_target_os(t:tos):boolean;
|
||||
var
|
||||
@ -1308,6 +1329,7 @@ begin
|
||||
set_target_link(target_info.link);
|
||||
set_target_ar(target_info.ar);
|
||||
set_target_res(target_info.res);
|
||||
target_path:=lower(target_info.short_name);
|
||||
target_cpu:=target_info.cpu;
|
||||
set_target_info:=true;
|
||||
exit;
|
||||
@ -1329,13 +1351,7 @@ begin
|
||||
for i:=1 to targetcnt do
|
||||
if target_infos[i].short_name=s then
|
||||
begin
|
||||
target_info:=target_infos[i];
|
||||
set_target_os(target_info.os);
|
||||
set_target_asm(target_info.assem);
|
||||
set_target_link(target_info.link);
|
||||
set_target_ar(target_info.ar);
|
||||
set_target_res(target_info.res);
|
||||
target_cpu:=target_info.cpu;
|
||||
set_target_info(target_infos[i].target);
|
||||
set_string_target:=true;
|
||||
exit;
|
||||
end;
|
||||
@ -1500,7 +1516,17 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.82 1999-06-08 11:50:28 peter
|
||||
Revision 1.83 1999-07-10 10:26:20 peter
|
||||
* merged
|
||||
|
||||
Revision 1.82.2.2 1999/07/10 10:03:16 peter
|
||||
* fixed initialization/finalization in fpc mode
|
||||
* allow $TARGET also in search paths
|
||||
|
||||
Revision 1.82.2.1 1999/07/02 12:52:58 pierre
|
||||
* pecoff still buggy, as_I386_asw again default
|
||||
|
||||
Revision 1.82 1999/06/08 11:50:28 peter
|
||||
* 2mb again for go32v2/v1
|
||||
|
||||
Revision 1.81 1999/06/02 20:46:39 peter
|
||||
|
||||
@ -265,7 +265,7 @@ const
|
||||
(str:'IN' ;special:false;keyword:m_all),
|
||||
(str:'IS' ;special:false;keyword:m_class),
|
||||
(str:'OF' ;special:false;keyword:m_all),
|
||||
(str:'ON' ;special:false;keyword:m_objpas),
|
||||
(str:'ON' ;special:false;keyword:m_class),
|
||||
(str:'OR' ;special:false;keyword:m_all),
|
||||
(str:'TO' ;special:false;keyword:m_all),
|
||||
(str:'AND' ;special:false;keyword:m_all),
|
||||
@ -281,7 +281,7 @@ const
|
||||
(str:'SET' ;special:false;keyword:m_all),
|
||||
(str:'SHL' ;special:false;keyword:m_all),
|
||||
(str:'SHR' ;special:false;keyword:m_all),
|
||||
(str:'TRY' ;special:false;keyword:m_objpas),
|
||||
(str:'TRY' ;special:false;keyword:m_class),
|
||||
(str:'VAR' ;special:false;keyword:m_all),
|
||||
(str:'XOR' ;special:false;keyword:m_all),
|
||||
(str:'CASE' ;special:false;keyword:m_all),
|
||||
@ -311,12 +311,12 @@ const
|
||||
(str:'FALSE' ;special:false;keyword:m_all),
|
||||
(str:'INDEX' ;special:false;keyword:m_none),
|
||||
(str:'LABEL' ;special:false;keyword:m_all),
|
||||
(str:'RAISE' ;special:false;keyword:m_objpas),
|
||||
(str:'RAISE' ;special:false;keyword:m_class),
|
||||
(str:'UNTIL' ;special:false;keyword:m_all),
|
||||
(str:'WHILE' ;special:false;keyword:m_all),
|
||||
(str:'WRITE' ;special:false;keyword:m_none),
|
||||
(str:'DOWNTO' ;special:false;keyword:m_all),
|
||||
(str:'EXCEPT' ;special:false;keyword:m_objpas),
|
||||
(str:'EXCEPT' ;special:false;keyword:m_class),
|
||||
(str:'EXPORT' ;special:false;keyword:m_none),
|
||||
(str:'INLINE' ;special:false;keyword:m_none),
|
||||
(str:'OBJECT' ;special:false;keyword:m_all),
|
||||
@ -335,7 +335,7 @@ const
|
||||
(str:'DISPOSE' ;special:false;keyword:m_all),
|
||||
(str:'DYNAMIC' ;special:false;keyword:m_none),
|
||||
(str:'EXPORTS' ;special:false;keyword:m_all),
|
||||
(str:'FINALLY' ;special:false;keyword:m_objpas),
|
||||
(str:'FINALLY' ;special:false;keyword:m_class),
|
||||
(str:'FORWARD' ;special:false;keyword:m_none),
|
||||
(str:'IOCHECK' ;special:false;keyword:m_none),
|
||||
(str:'LIBRARY' ;special:false;keyword:m_all),
|
||||
@ -366,16 +366,16 @@ const
|
||||
(str:'PROCEDURE' ;special:false;keyword:m_all),
|
||||
(str:'PROTECTED' ;special:false;keyword:m_none),
|
||||
(str:'PUBLISHED' ;special:false;keyword:m_none),
|
||||
(str:'THREADVAR' ;special:false;keyword:m_objpas),
|
||||
(str:'THREADVAR' ;special:false;keyword:m_class),
|
||||
(str:'DESTRUCTOR' ;special:false;keyword:m_all),
|
||||
(str:'INTERNPROC' ;special:false;keyword:m_none),
|
||||
(str:'OPENSTRING' ;special:false;keyword:m_none),
|
||||
(str:'CONSTRUCTOR' ;special:false;keyword:m_all),
|
||||
(str:'INTERNCONST' ;special:false;keyword:m_none),
|
||||
(str:'SHORTSTRING' ;special:false;keyword:m_none),
|
||||
(str:'FINALIZATION' ;special:false;keyword:m_class),
|
||||
(str:'FINALIZATION' ;special:false;keyword:m_initfinal),
|
||||
(str:'IMPLEMENTATION';special:false;keyword:m_all),
|
||||
(str:'INITIALIZATION';special:false;keyword:m_class)
|
||||
(str:'INITIALIZATION';special:false;keyword:m_initfinal)
|
||||
);
|
||||
|
||||
implementation
|
||||
@ -383,7 +383,14 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.7 1999-05-24 08:55:30 florian
|
||||
Revision 1.8 1999-07-10 10:26:21 peter
|
||||
* merged
|
||||
|
||||
Revision 1.7.2.1 1999/07/10 10:03:18 peter
|
||||
* fixed initialization/finalization in fpc mode
|
||||
* allow $TARGET also in search paths
|
||||
|
||||
Revision 1.7 1999/05/24 08:55:30 florian
|
||||
* non working safecall directiv implemented, I don't know if we
|
||||
need it
|
||||
|
||||
|
||||
@ -67,7 +67,6 @@ procedure SetRedirectFile(const fn:string);
|
||||
function SetVerbosity(const s:string):boolean;
|
||||
|
||||
procedure LoadMsgFile(const fn:string);
|
||||
procedure UpdateReplacement(var s:string);
|
||||
|
||||
procedure Stop;
|
||||
procedure ShowStatus;
|
||||
@ -247,14 +246,6 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure UpdateReplacement(var s:string);
|
||||
begin
|
||||
Replace(s,'$FPCVER',full_version_string);
|
||||
Replace(s,'$FPCDATE',date_string);
|
||||
Replace(s,'$FPCTARGET',target_cpu_string);
|
||||
end;
|
||||
|
||||
|
||||
var
|
||||
lastfileidx,
|
||||
lastmoduleidx : longint;
|
||||
@ -341,7 +332,7 @@ begin
|
||||
{ Create status info }
|
||||
UpdateStatus;
|
||||
{ Fix replacements }
|
||||
UpdateReplacement(s);
|
||||
DefaultReplacements(s);
|
||||
{ show comment }
|
||||
if do_comment(l,s) or dostop then
|
||||
stop;
|
||||
@ -408,7 +399,7 @@ begin
|
||||
{ fix status }
|
||||
UpdateStatus;
|
||||
{ Fix replacements }
|
||||
UpdateReplacement(s);
|
||||
DefaultReplacements(s);
|
||||
{ show comment }
|
||||
if do_comment(v,s) or dostop then
|
||||
stop;
|
||||
@ -515,9 +506,16 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.40 1999-06-18 11:03:09 peter
|
||||
Revision 1.41 1999-07-10 10:26:22 peter
|
||||
* merged
|
||||
|
||||
Revision 1.40 1999/06/18 11:03:09 peter
|
||||
* merged
|
||||
|
||||
Revision 1.39.2.2 1999/07/10 10:03:19 peter
|
||||
* fixed initialization/finalization in fpc mode
|
||||
* allow $TARGET also in search paths
|
||||
|
||||
Revision 1.39.2.1 1999/06/18 10:55:32 peter
|
||||
* version fixes
|
||||
* EXTRAUNITS to set extra units that are build and needs to be cleaned
|
||||
|
||||
Loading…
Reference in New Issue
Block a user