Skip to content

Commit

Permalink
More string handling speed optimizations
Browse files Browse the repository at this point in the history
  • Loading branch information
@jval1972
jval1972 committed Apr 24, 2022
1 parent d1d0c00 commit 7ed1792
Show file tree
Hide file tree
Showing 11 changed files with 77 additions and 64 deletions.
4 changes: 2 additions & 2 deletions Base/c_con.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -375,7 +375,7 @@ procedure C_ExecCommandFile(const filename: string);
readln(t, cmd);
trimproc(cmd);
if cmd <> '' then
if Pos('//', cmd) <> 1 then
if not Pos1('//', cmd) then
C_ExecuteCmd(cmd);
end;
close(t);
Expand Down Expand Up @@ -763,7 +763,7 @@ procedure C_ExecCommands(const commands: string);
begin
cmd := strtrim(l.Strings[i]);
if cmd <> '' then
if Pos('//', cmd) <> 1 then
if not Pos1('//', cmd) then
C_ExecuteCmd(cmd);
end;
l.Free;
Expand Down
2 changes: 1 addition & 1 deletion Base/info_common.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -286,7 +286,7 @@ function Info_GetMobjNumForAlias(const name: string): integer;
check := strupper(strremovespaces(name)) + '=';
for i := mobjinfo_aliases.Count - 1 downto 0 do
begin
if Pos(check, mobjinfo_aliases.Strings[i]) = 1 then
if Pos1(check, mobjinfo_aliases.Strings[i]) then
begin
splitstring_ch(mobjinfo_aliases.Strings[i], check, snum, '=');
result := atoi(snum);
Expand Down
14 changes: 7 additions & 7 deletions Common/d_delphi.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1623,9 +1623,9 @@ function atoi(const s: string): integer;
if code <> 0 then
begin
ret2 := 0;
if Pos('0x', s) = 1 then
if Pos1('0x', s) then
val('$' + Copy(s, 3, Length(s) - 2), ret2, code)
else if Pos('-0x', s) = 1 then
else if Pos1('-0x', s) then
begin
val('$' + Copy(s, 4, Length(s) - 3), ret2, code);
ret2 := -ret2;
Expand Down Expand Up @@ -1653,9 +1653,9 @@ function atoi(const s: string; const default: integer): integer; overload;
if code <> 0 then
begin
ret2 := default;
if Pos('0x', s) = 1 then
if Pos1('0x', s) then
val('$' + Copy(s, 3, Length(s) - 2), ret2, code)
else if Pos('-0x', s) = 1 then
else if Pos1('-0x', s) then
begin
val('$' + Copy(s, 4, Length(s) - 3), ret2, code);
ret2 := -ret2;
Expand Down Expand Up @@ -1683,7 +1683,7 @@ function atoui(const s: string): LongWord; overload;
if code <> 0 then
begin
ret2 := 0;
if Pos('0x', s) = 1 then
if Pos1('0x', s) then
val('$' + Copy(s, 3, Length(s) - 2), ret2, code)
else if CharPos('#', s) = 1 then
val(Copy(s, 2, Length(s) - 1), ret2, code);
Expand All @@ -1708,7 +1708,7 @@ function atoui(const s: string; const default: LongWord): LongWord; overload;
if code <> 0 then
begin
ret2 := default;
if Pos('0x', s) = 1 then
if Pos1('0x', s) then
val('$' + Copy(s, 3, Length(s) - 2), ret2, code)
else if CharPos('#', s) = 1 then
val(Copy(s, 2, Length(s) - 1), ret2, code);
Expand Down Expand Up @@ -6870,7 +6870,7 @@ function readablestring(const s: string): string;
h := '0123456789ABCDEF';
for i := 1 to Length(s) do
begin
if Pos(toupper(s[i]), 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789') > 0 then
if CharPos(toupper(s[i]), 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789') > 0 then
result := result + toupper(s[i])
else
result := result + h[Ord(s[i]) div 16 + 1] + h[Ord(s[i]) mod 16 + 1];
Expand Down
50 changes: 26 additions & 24 deletions SCRIPT/ps_compiler.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1363,13 +1363,15 @@ procedure DisposeVariant(p: PIfRVariant);
implementation

uses
d_delphi,
{$IFDEF DELPHI5}
ComObj,
{$ENDIF}
{$IFDEF PS_FPC_HAS_COM}
ComObj,
{$ENDIF}
Classes, TypInfo;
Classes,
TypInfo;

{$IFDEF DELPHI3UP}
resourceString
Expand Down Expand Up @@ -1929,7 +1931,7 @@ function ParseMethodEx(Owner: TPSPascalCompiler; const FClassName: TbtString; De
Exit;
end;
end;
while Pos(TbtChar('|'), VNames) > 0 do
while CharPos(TbtChar('|'), VNames) > 0 do
begin
with DestDecl.AddParam do
begin
Expand All @@ -1940,10 +1942,10 @@ function ParseMethodEx(Owner: TPSPascalCompiler; const FClassName: TbtString; De
DeclareRow := ERow;
DeclareCol := ECol;
Mode := modifier;
OrgName := Copy(VNames, 1, Pos(TbtChar('|'), VNames) - 1);
OrgName := Copy(VNames, 1, CharPos(TbtChar('|'), VNames) - 1);
aType := VCType;
end;
Delete(VNames, 1, Pos(TbtChar('|'), VNames));
Delete(VNames, 1, CharPos(TbtChar('|'), VNames));
end;
Parser.Next;
if Parser.CurrTokenId = CSTI_CloseRound then
Expand Down Expand Up @@ -2312,15 +2314,15 @@ function TPSPascalCompiler.AddFunction(const Header: TbtString): TPSRegProc;
VCType := FindType(Parser.GetToken);
if VCType = nil then
raise EPSCompilerException.CreateFmt(RPS_UnableToRegisterFunction, [Name]);
while Pos(TbtChar('|'), VNames) > 0 do
while CharPos(TbtChar('|'), VNames) > 0 do
begin
with Decl.AddParam do
begin
Mode := modifier;
OrgName := Copy(VNames, 1, Pos(TbtChar('|'), VNames) - 1);
OrgName := Copy(VNames, 1, CharPos(TbtChar('|'), VNames) - 1);
aType := VCType;
end;
Delete(VNames, 1, Pos(TbtChar('|'), VNames));
Delete(VNames, 1, CharPos(TbtChar('|'), VNames));
end;
Parser.Next;
if Parser.CurrTokenId = CSTI_CloseRound then
Expand Down Expand Up @@ -4189,15 +4191,15 @@ function TPSPascalCompiler.ReadTypeAddProcedure(const Name: TbtString; FParser:
Result := nil;
Exit;
end;
while Pos(TbtChar('|'), VNames) > 0 do
while CharPos(TbtChar('|'), VNames) > 0 do
begin
with Decl.AddParam do
begin
Mode := modifier;
OrgName := Copy(VNames, 1, Pos(TbtChar('|'), VNames) - 1);
OrgName := Copy(VNames, 1, CharPos(TbtChar('|'), VNames) - 1);
FType := VCType;
end;
Delete(VNames, 1, Pos(TbtChar('|'), VNames));
Delete(VNames, 1, CharPos(TbtChar('|'), VNames));
end;
FParser.Next;
if FParser.CurrTokenId = CSTI_CloseRound then
Expand Down Expand Up @@ -4609,9 +4611,9 @@ function TPSPascalCompiler.ReadType(const Name: TbtString; FParser: TPSPascalPar
Exit;
end; {if}
FParser.Next;
while Pos(TbtChar('|'), s) > 0 do
while CharPos(TbtChar('|'), s) > 0 do
begin
fieldorgname := Copy(s, 1, Pos(TbtChar('|'), s) - 1);
fieldorgname := Copy(s, 1, CharPos(TbtChar('|'), s) - 1);
Delete(s, 1, Length(FieldOrgName) + 1);
rvv := TPSRecordFieldTypeDef.Create;
rvv.FieldOrgName := fieldorgname;
Expand Down Expand Up @@ -4857,14 +4859,14 @@ function TPSPascalCompiler.VarIsDuplicate(Proc: TPSInternalProcedure; const Varn
end;
end;
v := VarNames;
while Pos(TbtChar('|'), v) > 0 do
while CharPos(TbtChar('|'), v) > 0 do
begin
if FastUpperCase(Copy(v, 1, Pos(TbtChar('|'), v) - 1)) = s then
if FastUpperCase(Copy(v, 1, CharPos(TbtChar('|'), v) - 1)) = s then
begin
Result := True;
Exit;
end;
Delete(v, 1, Pos(TbtChar('|'), v));
Delete(v, 1, CharPos(TbtChar('|'), v));
end;
for l := FConstants.Count - 1 downto 0 do
begin
Expand Down Expand Up @@ -4953,10 +4955,10 @@ function TPSPascalCompiler.DoVarBlock(proc: TPSInternalProcedure): Boolean;
begin
Exit;
end;
while Pos(TbtChar('|'), VarName) > 0 do
while CharPos(TbtChar('|'), VarName) > 0 do
begin
s := Copy(VarName, 1, Pos(TbtChar('|'), VarName) - 1);
Delete(VarName, 1, Pos(TbtChar('|'), VarName));
s := Copy(VarName, 1, CharPos(TbtChar('|'), VarName) - 1);
Delete(VarName, 1, CharPos(TbtChar('|'), VarName));
if proc = nil then
begin
v := TPSVar.Create;
Expand Down Expand Up @@ -5232,14 +5234,14 @@ function TPSPascalCompiler.ProcIsDuplic(Decl: TPSParametersDecl; const FunctionN
GRFW(u);
end;
u := FunctionParamNames;
while Pos(TbtChar('|'), u) > 0 do
while CharPos(TbtChar('|'), u) > 0 do
begin
if Copy(u, 1, Pos(TbtChar('|'), u) - 1) = s then
if Copy(u, 1, CharPos(TbtChar('|'), u) - 1) = s then
begin
Result := True;
Exit;
end;
Delete(u, 1, Pos(TbtChar('|'), u));
Delete(u, 1, CharPos(TbtChar('|'), u));
end;
if Func = nil then
begin
Expand Down Expand Up @@ -5497,11 +5499,11 @@ function TPSPascalCompiler.ProcessFunction(AlwaysForward: Boolean; Att: TPSAttri
begin
Exit;
end;
while Pos(TbtChar('|'), FunctionParamNames) > 0 do
while CharPos(TbtChar('|'), FunctionParamNames) > 0 do
begin
with FunctionDecl.AddParam do
begin
OrgName := Copy(FunctionParamNames, 1, Pos(TbtChar('|'), FunctionParamNames) - 1);
OrgName := Copy(FunctionParamNames, 1, CharPos(TbtChar('|'), FunctionParamNames) - 1);
Mode := modifier;
aType := FunctionTempType;
{$IFDEF PS_USESSUPPORT}
Expand All @@ -5511,7 +5513,7 @@ function TPSPascalCompiler.ProcessFunction(AlwaysForward: Boolean; Att: TPSAttri
DeclareRow := E2Row;
DeclareCol := E2Col;
end;
Delete(FunctionParamNames, 1, Pos(TbtChar('|'), FunctionParamNames));
Delete(FunctionParamNames, 1, CharPos(TbtChar('|'), FunctionParamNames));
end;
if FParser.CurrTokenId = CSTI_CloseRound then
Break;
Expand Down
9 changes: 5 additions & 4 deletions SCRIPT/ps_runtime.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1412,6 +1412,7 @@ function IDispatchInvoke(Self: IDispatch; PropertySet: Boolean; const Name: TbtS
implementation

uses
d_delphi,
TypInfo {$IFDEF DELPHI3UP}{$IFNDEF FPC}{$IFNDEF KYLIX} , ComObj {$ENDIF}{$ENDIF}{$ENDIF}{$IFDEF PS_FPC_HAS_COM}, ComObj{$ENDIF};

{$IFDEF DELPHI3UP }
Expand Down Expand Up @@ -2092,7 +2093,7 @@ function PropertyToString(Instance: TObject; PName: TbtString): TbtString;
end;
while Length(PName) > 0 do
begin
i := Pos(TbtChar('.'), PName);
i := CharPos(TbtChar('.'), PName);
if i = 0 then
begin
s := Trim(PName);
Expand Down Expand Up @@ -3162,7 +3163,7 @@ function TPSExec.ImportProc(const Name: ShortString; proc: TPSExternalProcRec):
if name = '' then
begin
fname := proc.Decl;
fname := Copy(fname, 1, Pos(TbtChar(':'), fname) - 1);
fname := Copy(fname, 1, CharPos(TbtChar(':'), fname) - 1);
fnh := MakeHash(fname);
for I := FSpecialProcList.Count - 1 downto 0 do
begin
Expand Down Expand Up @@ -14510,7 +14511,7 @@ function SpecImport(Sender: TPSExec; p: TPSExternalProcRec; Tag: Pointer): Boole
Result := True;
Exit;
end;
s2 := Copy(S, 1, Pos(TbtChar('|'), s) - 1);
s2 := Copy(S, 1, CharPos(TbtChar('|'), s) - 1);
Delete(s, 1, Length(s2) + 1);
H := MakeHash(s2);
ISRead := False;
Expand All @@ -14529,7 +14530,7 @@ function SpecImport(Sender: TPSExec; p: TPSExternalProcRec; Tag: Pointer): Boole
Result := False;
Exit;
end;
s2 := Copy(S, 1, Pos(TbtChar('|'), s) - 1);
s2 := Copy(S, 1, CharPos(TbtChar('|'), s) - 1);
Delete(s, 1, Length(s2) + 1);
if (s2 <> '') and (s2[Length(s2)] = '@') then
begin
Expand Down
5 changes: 4 additions & 1 deletion SCRIPT/ps_utils.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -497,6 +497,9 @@ function WideLowerCase(const S: WideString): WideString;

implementation

uses
d_delphi;

{$IFDEF DELPHI3UP }
resourceString
{$ELSE }
Expand Down Expand Up @@ -1062,7 +1065,7 @@ function Fw(const S: TbtString): TbtString; // First word
var
x: integer;
begin
x := Pos(TbtString(' '), s);
x := CharPos(TbtChar(' '), s);
if x > 0 then
Result := Copy(S, 1, x - 1)
else
Expand Down
27 changes: 15 additions & 12 deletions SCRIPT/uPSC_dll.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -46,6 +46,9 @@ procedure RegisterDll_Compiletime(cs: TPSPascalCompiler);

implementation

uses
d_delphi;

//==============================================================================
//
// rpos
Expand Down Expand Up @@ -106,30 +109,30 @@ function DllExternalProc(Sender: TPSPascalCompiler; Decl: TPSParametersDecl; con
end;
FuncName := Copy(FuncCC, 1, rpos('@', FuncCC) - 1) + #0;
Delete(FuncCc, 1, Length(FuncName));
if Pos(TbtChar(' '), Funccc) <> 0 then
if CharPos(TbtChar(' '), Funccc) <> 0 then
begin
if FuncCC[1] = '"' then
begin
Delete(FuncCC, 1, 1);
FuncName := RemoveQuotes(Copy(FuncCC, 1, Pos(TbtChar('"'), FuncCC) - 1)) + #0 + FuncName;
Delete(FuncCC,1, Pos(TbtChar('"'), FuncCC));
FuncName := RemoveQuotes(Copy(FuncCC, 1, CharPos(TbtChar('"'), FuncCC) - 1)) + #0 + FuncName;
Delete(FuncCC,1, CharPos(TbtChar('"'), FuncCC));
if (FuncCC <> '') and( FuncCC[1] = ' ') then Delete(FuncCC, 1, 1);
end
else
begin
FuncName := Copy(FuncCc, 1, Pos(TbtChar(' '), FuncCC) - 1) + #0 + FuncName;
Delete(FuncCC, 1, Pos(TbtChar(' '), FuncCC));
FuncName := Copy(FuncCc, 1, CharPos(TbtChar(' '), FuncCC) - 1) + #0 + FuncName;
Delete(FuncCC, 1, CharPos(TbtChar(' '), FuncCC));
end;
if Pos(TbtChar(' '), FuncCC) > 0 then
if CharPos(TbtChar(' '), FuncCC) > 0 then
begin
s := Copy(FuncCC, Pos(TbtChar(' '), Funccc) + 1, MaxInt);
FuncCC := FastUpperCase(Copy(FuncCC, 1, Pos(TbtChar(' '), FuncCC) - 1));
Delete(FuncCC, Pos(TbtChar(' '), Funccc), MaxInt);
s := Copy(FuncCC, CharPos(TbtChar(' '), Funccc) + 1, MaxInt);
FuncCC := FastUpperCase(Copy(FuncCC, 1, CharPos(TbtChar(' '), FuncCC) - 1));
Delete(FuncCC, CharPos(TbtChar(' '), Funccc), MaxInt);
repeat
if Pos(TbtChar(' '), s) > 0 then
if CharPos(TbtChar(' '), s) > 0 then
begin
s2 := Copy(s, 1, Pos(TbtChar(' '), s) - 1);
Delete(s, 1, Pos(TbtChar(' '), s));
s2 := Copy(s, 1, CharPos(TbtChar(' '), s) - 1);
Delete(s, 1, CharPos(TbtChar(' '), s));
end
else
begin
Expand Down
2 changes: 1 addition & 1 deletion SCRIPT/uPSPreProcessor.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -671,7 +671,7 @@ procedure TPSPreProcessor.IntPreProcess(Level: Integer; const OrgFileName: TbtSt
end;
//-- end_jgv

if Pos(tbtChar(' '), s) = 0 then
if CharPos(TbtChar(' '), s) = 0 then
begin
name := uppercase(s);
s := '';
Expand Down
Loading

0 comments on commit 7ed1792

Please sign in to comment.