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

* compiler utils cannot depend on StrUtils

Browse Source 
git-svn-id: trunk@48408 -
This commit is contained in:
florian 2021-01-24 18:07:13 +00:00
parent 6975437da8
commit 5950a5f97b
2 changed files with 120 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

90
compiler/utils/mkx86inl.pp
View File

@ -4,8 +4,7 @@ program mkx86inl;
{$H+}
uses
sysutils, classes,
strutils;
sysutils, classes;
type
TOperDirection = (operIn, operVar, operOut);
@ -19,6 +18,93 @@ type
const
DirLUT: array[TOperDirection] of string = ('','var ','out ');
{ ***************************************************************************
the routines Copy2SymbDel, PosSetEx, PosSet, RemoveTrailingChars, TrimRightSet are copied and reformatted
from StrUtils and thus covered by the copyright of strutils (see below) as compiler utilities cannot
depend on packages
This file is part of the Free Pascal run time library.
Copyright (c) 1999-2005 by the Free Pascal development team
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
*************************************************************************** }
function Copy2SymbDel(var S: string; Symb: Char): string;
var
p: SizeInt;
begin
p:=Pos(Symb,S);
if p=0 then
begin
result:=s;
s:='';
end
else
begin
Result:=Copy(S,1,p-1);
delete(s,1,p);
end;
end;
function PosSetEx(const c: TSysCharSet; const s: ansistring; count: Integer): SizeInt;
var
i,j:SizeInt;
begin
if pchar(pointer(s))=nil then
j:=0
else
begin
i:=length(s);
j:=count;
if j>i then
begin
result:=0;
exit;
end;
while (j<=i) and (not (s[j] in c)) do inc(j);
if (j>i) then
j:=0; // not found.
end;
result:=j;
end;
function PosSet(const c: TSysCharSet; const s: ansistring): SizeInt;
begin
result:=possetex(c,s,1);
end;
procedure RemoveTrailingChars(VAR S: AnsiString; const CSet: TSysCharset);
var
I,J: LONGINT;
Begin
I:=Length(S);
IF (I>0) Then
Begin
J:=I;
While (j>0) and (S[J] IN CSet) DO DEC(J);
IF J<>I Then
SetLength(S,J);
End;
End;
function TrimRightSet(const S: String; const CSet: TSysCharSet): String;
begin
result:=s;
RemoveTrailingchars(result,cset);
end;
{ ***************************************************************************
end of StrUtils code
***************************************************************************}
function GetPascalType(const ATyp: string): string;
begin
case ATyp of

33
compiler/utils/mkz80ins.pp
View File

@ -18,7 +18,7 @@ program mkz80ins;
{$mode objfpc}{$H+}
uses
SysUtils,StrUtils;
SysUtils;
const
Version = '1.0.0';
@ -84,6 +84,37 @@ type
destructor Destroy;override;
end;
{ ***************************************************************************
the routines LeftStr, AnsiStartsStr are copied and reformatted
from StrUtils and thus covered by the copyright of strutils (see below) as compiler utilities cannot
depend on packages
This file is part of the Free Pascal run time library.
Copyright (c) 1999-2005 by the Free Pascal development team
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
*************************************************************************** }
function LeftStr(const AText: AnsiString; const ACount: SizeInt): AnsiString;
begin
Result:=Copy(AText,1,ACount);
end;
function AnsiStartsStr(const ASubText, AText: string): Boolean;
begin
Result := (ASubText = '') or (LeftStr(AText, Length(ASubText)) = ASubText);
end;
{ ***************************************************************************
end of StrUtils code
***************************************************************************}
function PasEncode(const S: string): string;
var
Ch: Char;