mirror of
https://github.com/moparisthebest/Simba
synced 2025-02-18 00:00:23 -05:00
Fixed the FloatToStr bug. + Updated the PascalScript st00f.
git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@559 3f818213-9676-44b0-a9b4-5e4c4e03d09d
This commit is contained in:
parent
4bd62c7237
commit
6c58941bc5
@ -1401,6 +1401,7 @@ end;
|
|||||||
procedure TForm1.FormCreate(Sender: TObject);
|
procedure TForm1.FormCreate(Sender: TObject);
|
||||||
begin
|
begin
|
||||||
Randomize;
|
Randomize;
|
||||||
|
DecimalSeparator := '.';
|
||||||
MainDir:= ExtractFileDir(Application.ExeName);
|
MainDir:= ExtractFileDir(Application.ExeName);
|
||||||
SimbaSettingsFile := MainDir + DS + 'settings.xml';
|
SimbaSettingsFile := MainDir + DS + 'settings.xml';
|
||||||
if FileExists(SimbaSettingsFile) then
|
if FileExists(SimbaSettingsFile) then
|
||||||
|
@ -215,6 +215,9 @@ end;
|
|||||||
|
|
||||||
function MakeString(data : TPSVariantIFC) : string;
|
function MakeString(data : TPSVariantIFC) : string;
|
||||||
begin;
|
begin;
|
||||||
|
if data.Dta = nil then
|
||||||
|
result := 'Nil'
|
||||||
|
else
|
||||||
if data.aType.basetype in [btString,btChar] then
|
if data.aType.basetype in [btString,btChar] then
|
||||||
result := PSGetAnsiString(Data.Dta,data.aType)
|
result := PSGetAnsiString(Data.Dta,data.aType)
|
||||||
else if data.aType.ExportName = 'BOOLEAN' then
|
else if data.aType.ExportName = 'BOOLEAN' then
|
||||||
|
@ -2269,8 +2269,7 @@ begin
|
|||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
if (TPSExternalProcedure(x).RegProc.NameHash = h) and
|
if (TPSExternalProcedure(x).RegProc.NameHash = h) and
|
||||||
(TPSExternalProcedure(x).RegProc.Name = Name) {$IFDEF PS_USESSUPPORT} and
|
(TPSExternalProcedure(x).RegProc.Name = Name)then
|
||||||
(IsInLocalUnitList(TPSInternalProcedure(x).DeclareUnit)){$ENDIF} then
|
|
||||||
begin
|
begin
|
||||||
Result := l;
|
Result := l;
|
||||||
exit;
|
exit;
|
||||||
@ -6474,10 +6473,12 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean;
|
|||||||
while True do
|
while True do
|
||||||
begin
|
begin
|
||||||
if (u.BaseType = btClass) {$IFNDEF PS_NOINTERFACES}or (u.BaseType = btInterface){$ENDIF}
|
if (u.BaseType = btClass) {$IFNDEF PS_NOINTERFACES}or (u.BaseType = btInterface){$ENDIF}
|
||||||
{$IFNDEF PS_NOIDISPATCH}or ((u.BaseType = btVariant) or (u.BaseType = btNotificationVariant)){$ENDIF} or (u.BaseType = btExtClass) then exit;
|
{$IFNDEF PS_NOIDISPATCH}or ((u.BaseType = btNotificationVariant)){$ENDIF} or (u.BaseType = btExtClass) then exit;
|
||||||
if FParser.CurrTokenId = CSTI_OpenBlock then
|
if FParser.CurrTokenId = CSTI_OpenBlock then
|
||||||
begin
|
begin
|
||||||
if (u.BaseType = btString) {$IFNDEF PS_NOWIDESTRING} or (u.BaseType = btWideString) or (u.BaseType = btUnicodeString) {$ENDIF} then
|
if (u.BaseType = btString) {$IFNDEF PS_NOWIDESTRING} or
|
||||||
|
(u.BaseType = btWideString) or (u.BaseType = btUnicodeString) {$ENDIF}
|
||||||
|
{$IFDEF PS_HAVEVARIANT}or (u.BaseType = btVariant){$ENDIF} then
|
||||||
begin
|
begin
|
||||||
FParser.Next;
|
FParser.Next;
|
||||||
tmp := Calc(CSTI_CloseBlock);
|
tmp := Calc(CSTI_CloseBlock);
|
||||||
@ -6505,12 +6506,15 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean;
|
|||||||
x := nil;
|
x := nil;
|
||||||
exit;
|
exit;
|
||||||
end;
|
end;
|
||||||
|
{$IFDEF PS_HAVEVARIANT}if (u.BaseType = btVariant) then
|
||||||
|
l := FindProc('VARARRAYSET') else
|
||||||
|
{$ENDIF}
|
||||||
{$IFNDEF PS_NOWIDESTRING}
|
{$IFNDEF PS_NOWIDESTRING}
|
||||||
if (u.BaseType = btWideString) or (u.BaseType = btUnicodeString) then
|
if (u.BaseType = btWideString) or (u.BaseType = btUnicodeString) then
|
||||||
l := FindProc('WSTRSET')
|
l := FindProc('WSTRSET')
|
||||||
else
|
else
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
l := FindProc('STRSET');
|
l := FindProc('STRSET');
|
||||||
if l = -1 then
|
if l = -1 then
|
||||||
begin
|
begin
|
||||||
MakeError('', ecUnknownIdentifier, 'StrSet');
|
MakeError('', ecUnknownIdentifier, 'StrSet');
|
||||||
@ -6552,22 +6556,31 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean;
|
|||||||
x := nil;
|
x := nil;
|
||||||
exit;
|
exit;
|
||||||
end;
|
end;
|
||||||
if (GetTypeNo(BlockInfo, Tmp).BaseType <> btChar)
|
{$IFDEF PS_HAVEVARIANT}if (u.BaseType <> btVariant) then {$ENDIF}
|
||||||
{$IFNDEF PS_NOWIDESTRING} and (GetTypeno(BlockInfo, Tmp).BaseType <> btWideChar) {$ENDIF} then
|
|
||||||
begin
|
begin
|
||||||
x.Free;
|
if (GetTypeNo(BlockInfo, Tmp).BaseType <> btChar)
|
||||||
x := nil;
|
{$IFNDEF PS_NOWIDESTRING} and (GetTypeno(BlockInfo, Tmp).BaseType <> btWideChar) {$ENDIF} then
|
||||||
Tmp.Free;
|
begin
|
||||||
MakeError('', ecTypeMismatch, '');
|
x.Free;
|
||||||
exit;
|
x := nil;
|
||||||
|
Tmp.Free;
|
||||||
|
MakeError('', ecTypeMismatch, '');
|
||||||
|
exit;
|
||||||
|
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
param.Val := tmp;
|
param.Val := tmp;
|
||||||
|
{$IFDEF PS_HAVEVARIANT}
|
||||||
|
if u.BaseType = btVariant then
|
||||||
|
Param.ExpectedType := u else{$ENDIF}
|
||||||
Param.ExpectedType := GetTypeNo(BlockInfo, tmp);
|
Param.ExpectedType := GetTypeNo(BlockInfo, tmp);
|
||||||
{$IFDEF DEBUG}
|
{$IFDEF DEBUG}
|
||||||
if not Param.ExpectedType.Used then asm int 3; end;
|
if not Param.ExpectedType.Used then asm int 3; end;
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
end else begin
|
end else begin
|
||||||
|
{$IFDEF PS_HAVEVARIANT}if (u.BaseType = btVariant) then
|
||||||
|
l := FindProc('VARARRAYGET') else
|
||||||
|
{$ENDIF}
|
||||||
{$IFNDEF PS_NOWIDESTRING}
|
{$IFNDEF PS_NOWIDESTRING}
|
||||||
if (u.BaseType = btWideString) or (u.BaseType = btUnicodeString) then
|
if (u.BaseType = btWideString) or (u.BaseType = btUnicodeString) then
|
||||||
l := FindProc('WSTRGET')
|
l := FindProc('WSTRGET')
|
||||||
@ -6583,12 +6596,15 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean;
|
|||||||
exit;
|
exit;
|
||||||
end;
|
end;
|
||||||
tmp3 := TPSValueProcNo.Create;
|
tmp3 := TPSValueProcNo.Create;
|
||||||
|
{$IFDEF PS_HAVEVARIANT}if (u.BaseType = btVariant) then
|
||||||
|
tmp3.ResultType := FindBaseType(btVariant) else
|
||||||
|
{$ENDIF}
|
||||||
{$IFNDEF PS_NOWIDESTRING}
|
{$IFNDEF PS_NOWIDESTRING}
|
||||||
if (u.BaseType = btWideString) or (u.BaseType = btUnicodeString) then
|
if (u.BaseType = btWideString) or (u.BaseType = btUnicodeString) then
|
||||||
tmp3.ResultType := FindBaseType(btWideChar)
|
tmp3.ResultType := FindBaseType(btWideChar)
|
||||||
else
|
else
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
tmp3.ResultType := FindBaseType(btChar);
|
tmp3.ResultType := FindBaseType(btChar);
|
||||||
tmp3.ProcNo := L;
|
tmp3.ProcNo := L;
|
||||||
tmp3.SetParserPos(FParser);
|
tmp3.SetParserPos(FParser);
|
||||||
tmp3.Parameters := TPSParameters.Create;
|
tmp3.Parameters := TPSParameters.Create;
|
||||||
@ -6681,7 +6697,9 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean;
|
|||||||
exit;
|
exit;
|
||||||
end;
|
end;
|
||||||
end
|
end
|
||||||
else if (FParser.CurrTokenId = CSTI_Period) or (ImplicitPeriod) then
|
else if ((FParser.CurrTokenId = CSTI_Period) or (ImplicitPeriod))
|
||||||
|
{$IFDEF PS_HAVEVARIANT}and not (u.BaseType = btVariant){$ENDIF}
|
||||||
|
then
|
||||||
begin
|
begin
|
||||||
if not ImplicitPeriod then
|
if not ImplicitPeriod then
|
||||||
FParser.Next;
|
FParser.Next;
|
||||||
@ -6747,7 +6765,8 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean;
|
|||||||
u := rr.aType;
|
u := rr.aType;
|
||||||
end;
|
end;
|
||||||
end
|
end
|
||||||
else
|
{$IFDEF PS_HAVEVARIANT}else if (u.BaseType = btVariant) then break else {$ENDIF}
|
||||||
|
|
||||||
begin
|
begin
|
||||||
x.Free;
|
x.Free;
|
||||||
MakeError('', ecSemicolonExpected, '');
|
MakeError('', ecSemicolonExpected, '');
|
||||||
@ -7054,10 +7073,10 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean;
|
|||||||
if FType = nil then exit;
|
if FType = nil then exit;
|
||||||
if (FType.BaseType <> btInterface) and (Ftype.BaseType <> BtVariant) and (FType.BaseType = btNotificationVariant) then Exit;
|
if (FType.BaseType <> btInterface) and (Ftype.BaseType <> BtVariant) and (FType.BaseType = btNotificationVariant) then Exit;
|
||||||
|
|
||||||
CheckArrayProperty:=(FParser.CurrTokenID=CSTI_OpenBlock)and
|
CheckArrayProperty:=(FParser.CurrTokenID=CSTI_OpenBlock) and
|
||||||
(Ftype.BaseType = BtVariant);
|
(Ftype.BaseType = BtVariant);
|
||||||
while (FParser.CurrTokenID = CSTI_Period)
|
while (FParser.CurrTokenID = CSTI_Period)
|
||||||
or (ImplicitPeriod)or (CheckArrayProperty) do begin
|
or (ImplicitPeriod) do begin
|
||||||
|
|
||||||
HasArrayProperty:=CheckArrayProperty;
|
HasArrayProperty:=CheckArrayProperty;
|
||||||
if CheckArrayProperty then begin
|
if CheckArrayProperty then begin
|
||||||
@ -12961,6 +12980,8 @@ begin
|
|||||||
AddFunction('Function WStrGet(var S : AnyString; I : Integer) : WideChar;');
|
AddFunction('Function WStrGet(var S : AnyString; I : Integer) : WideChar;');
|
||||||
AddFunction('procedure WStrSet(c : AnyString; I : Integer; var s : AnyString);');
|
AddFunction('procedure WStrSet(c : AnyString; I : Integer; var s : AnyString);');
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
|
AddDelphiFunction('Function VarArrayGet(var S : Variant; I : Integer) : Variant;');
|
||||||
|
AddDelphiFunction('procedure VarArraySet(c : Variant; I : Integer; var s : Variant);');
|
||||||
AddFunction('Function AnsiUppercase(s : String) : String;');
|
AddFunction('Function AnsiUppercase(s : String) : String;');
|
||||||
AddFunction('Function AnsiLowercase(s : String) : String;');
|
AddFunction('Function AnsiLowercase(s : String) : String;');
|
||||||
AddFunction('Function Uppercase(s : AnyString) : AnyString;');
|
AddFunction('Function Uppercase(s : AnyString) : AnyString;');
|
||||||
|
@ -188,7 +188,7 @@ begin
|
|||||||
end else n := nil;
|
end else n := nil;
|
||||||
try
|
try
|
||||||
TMYExec(Caller).InnerfuseCall(nil, p.Ext1, cc, MyList, n);
|
TMYExec(Caller).InnerfuseCall(nil, p.Ext1, cc, MyList, n);
|
||||||
{$IFNDEF LINUX}
|
{$IFNDEF UNIX}
|
||||||
DLLSetLastError(Caller, GetLastError);
|
DLLSetLastError(Caller, GetLastError);
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
finally
|
finally
|
||||||
|
@ -1,5 +1,4 @@
|
|||||||
unit uPSRuntime;
|
unit uPSRuntime;
|
||||||
|
|
||||||
{$I PascalScript.inc}
|
{$I PascalScript.inc}
|
||||||
{
|
{
|
||||||
|
|
||||||
@ -1600,9 +1599,9 @@ begin
|
|||||||
btS16: str(tbts16(p.dta^), Result);
|
btS16: str(tbts16(p.dta^), Result);
|
||||||
btU32: str(tbtu32(p.dta^), Result);
|
btU32: str(tbtu32(p.dta^), Result);
|
||||||
btS32: str(tbts32(p.dta^), Result);
|
btS32: str(tbts32(p.dta^), Result);
|
||||||
btSingle: str(tbtsingle(p.dta^), Result);
|
btSingle: result := floattostr(tbtsingle(p.dta^));
|
||||||
btDouble: str(tbtdouble(p.dta^), Result);
|
btDouble: result := floattostr(tbtdouble(p.dta^));
|
||||||
btExtended: str(tbtextended(p.dta^), Result);
|
btExtended: result := floattostr(tbtextended(p.dta^));
|
||||||
btString: Result := makestring(tbtString(p.dta^));
|
btString: Result := makestring(tbtString(p.dta^));
|
||||||
btPChar:
|
btPChar:
|
||||||
begin
|
begin
|
||||||
@ -3725,6 +3724,7 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure PSSetAnsiString(Src: Pointer; aType: TPSTypeRec; var Ok: Boolean; const Val: tbtString);
|
procedure PSSetAnsiString(Src: Pointer; aType: TPSTypeRec; var Ok: Boolean; const Val: tbtString);
|
||||||
begin
|
begin
|
||||||
if (Src = nil) or (aType = nil) then begin Ok := false; exit; end;
|
if (Src = nil) or (aType = nil) then begin Ok := false; exit; end;
|
||||||
@ -3736,9 +3736,12 @@ begin
|
|||||||
end;
|
end;
|
||||||
case aType.BaseType of
|
case aType.BaseType of
|
||||||
btString: tbtstring(src^) := val;
|
btString: tbtstring(src^) := val;
|
||||||
|
btChar: if AnsiString(val) <> '' then tbtchar(src^) := AnsiString(val)[1];
|
||||||
{$IFNDEF PS_NOWIDESTRING}
|
{$IFNDEF PS_NOWIDESTRING}
|
||||||
btUnicodeString: tbtunicodestring(src^) := tbtUnicodeString(AnsiString(val));
|
btUnicodeString: tbtunicodestring(src^) := tbtUnicodeString(AnsiString(val));
|
||||||
btWideString: tbtwidestring(src^) := tbtwidestring(AnsiString(val));{$ENDIF}
|
btWideString: tbtwidestring(src^) := tbtwidestring(AnsiString(val));
|
||||||
|
btWideChar: if AnsiString(val) <> '' then tbtwidechar(src^) := tbtwidechar(AnsiString(val)[1]);
|
||||||
|
{$ENDIF}
|
||||||
btVariant:
|
btVariant:
|
||||||
begin
|
begin
|
||||||
try
|
try
|
||||||
@ -3761,6 +3764,8 @@ begin
|
|||||||
if (src = nil) or (aType = nil) then begin Ok := false; exit; end;
|
if (src = nil) or (aType = nil) then begin Ok := false; exit; end;
|
||||||
end;
|
end;
|
||||||
case aType.BaseType of
|
case aType.BaseType of
|
||||||
|
btChar: if val <> '' then tbtchar(src^) := tbtChar(val[1]);
|
||||||
|
btWideChar: if val <> '' then tbtwidechar(src^) := val[1];
|
||||||
btString: tbtstring(src^) := tbtString(val);
|
btString: tbtstring(src^) := tbtString(val);
|
||||||
btWideString: tbtwidestring(src^) := val;
|
btWideString: tbtwidestring(src^) := val;
|
||||||
btUnicodeString: tbtunicodestring(src^) := val;
|
btUnicodeString: tbtunicodestring(src^) := val;
|
||||||
@ -3775,6 +3780,7 @@ begin
|
|||||||
else ok := false;
|
else ok := false;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure PSSetUnicodeString(Src: Pointer; aType: TPSTypeRec; var Ok: Boolean; const Val: tbtunicodestring);
|
procedure PSSetUnicodeString(Src: Pointer; aType: TPSTypeRec; var Ok: Boolean; const Val: tbtunicodestring);
|
||||||
begin
|
begin
|
||||||
if (Src = nil) or (aType = nil) then begin Ok := false; exit; end;
|
if (Src = nil) or (aType = nil) then begin Ok := false; exit; end;
|
||||||
@ -4564,19 +4570,19 @@ begin
|
|||||||
if Tmp is EDivByZero then
|
if Tmp is EDivByZero then
|
||||||
begin
|
begin
|
||||||
Result := False;
|
Result := False;
|
||||||
CMD_Err3(erDivideByZero, '', Tmp);
|
CMD_Err3(erDivideByZero, Exception(Tmp).Message, Tmp);
|
||||||
Exit;
|
Exit;
|
||||||
end;
|
end;
|
||||||
if Tmp is EZeroDivide then
|
if Tmp is EZeroDivide then
|
||||||
begin
|
begin
|
||||||
Result := False;
|
Result := False;
|
||||||
CMD_Err3(erDivideByZero, '', Tmp);
|
CMD_Err3(erDivideByZero, Exception(Tmp).Message, Tmp);
|
||||||
Exit;
|
Exit;
|
||||||
end;
|
end;
|
||||||
if Tmp is EMathError then
|
if Tmp is EMathError then
|
||||||
begin
|
begin
|
||||||
Result := False;
|
Result := False;
|
||||||
CMD_Err3(erMathError, '', Tmp);
|
CMD_Err3(erMathError, Exception(Tmp).Message, Tmp);
|
||||||
Exit;
|
Exit;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
@ -5255,19 +5261,19 @@ begin
|
|||||||
if Tmp is EDivByZero then
|
if Tmp is EDivByZero then
|
||||||
begin
|
begin
|
||||||
Result := False;
|
Result := False;
|
||||||
CMD_Err3(erDivideByZero, '', Tmp);
|
CMD_Err3(erDivideByZero, Exception(Tmp).Message, Tmp);
|
||||||
Exit;
|
Exit;
|
||||||
end;
|
end;
|
||||||
if Tmp is EZeroDivide then
|
if Tmp is EZeroDivide then
|
||||||
begin
|
begin
|
||||||
Result := False;
|
Result := False;
|
||||||
CMD_Err3(erDivideByZero, '', Tmp);
|
CMD_Err3(erDivideByZero, Exception(Tmp).Message, Tmp);
|
||||||
Exit;
|
Exit;
|
||||||
end;
|
end;
|
||||||
if Tmp is EMathError then
|
if Tmp is EMathError then
|
||||||
begin
|
begin
|
||||||
Result := False;
|
Result := False;
|
||||||
CMD_Err3(erMathError, '', Tmp);
|
CMD_Err3(erMathError, Exception(Tmp).Message, Tmp);
|
||||||
Exit;
|
Exit;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
@ -6273,19 +6279,19 @@ begin
|
|||||||
if Tmp is EDivByZero then
|
if Tmp is EDivByZero then
|
||||||
begin
|
begin
|
||||||
Result := False;
|
Result := False;
|
||||||
CMD_Err3(erDivideByZero, '', Tmp);
|
CMD_Err3(erDivideByZero, Exception(Tmp).Message, Tmp);
|
||||||
Exit;
|
Exit;
|
||||||
end;
|
end;
|
||||||
if Tmp is EZeroDivide then
|
if Tmp is EZeroDivide then
|
||||||
begin
|
begin
|
||||||
Result := False;
|
Result := False;
|
||||||
CMD_Err3(erDivideByZero, '', Tmp);
|
CMD_Err3(erDivideByZero, Exception(Tmp).Message, Tmp);
|
||||||
Exit;
|
Exit;
|
||||||
end;
|
end;
|
||||||
if Tmp is EMathError then
|
if Tmp is EMathError then
|
||||||
begin
|
begin
|
||||||
Result := False;
|
Result := False;
|
||||||
CMD_Err3(erMathError, '', Tmp);
|
CMD_Err3(erMathError, Exception(Tmp).Message, Tmp);
|
||||||
Exit;
|
Exit;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
@ -6548,13 +6554,13 @@ begin
|
|||||||
Pointer(Dest.P^) := nil;
|
Pointer(Dest.P^) := nil;
|
||||||
SetLength(tbtstring(Dest.P^), Param);
|
SetLength(tbtstring(Dest.P^), Param);
|
||||||
if Param <> 0 then begin
|
if Param <> 0 then begin
|
||||||
if not ReadData(tbtstring(Dest.P^)[1], Param) then
|
if not ReadData(tbtstring(Dest.P^)[1], Param) then
|
||||||
begin
|
begin
|
||||||
CMD_Err(erOutOfRange);
|
CMD_Err(erOutOfRange);
|
||||||
FTempVars.Pop;
|
FTempVars.Pop;
|
||||||
Result := False;
|
Result := False;
|
||||||
exit;
|
exit;
|
||||||
end;
|
end;
|
||||||
pansichar(dest.p^)[Param] := #0;
|
pansichar(dest.p^)[Param] := #0;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
@ -7171,19 +7177,19 @@ begin
|
|||||||
if Tmp is EDivByZero then
|
if Tmp is EDivByZero then
|
||||||
begin
|
begin
|
||||||
Result := False;
|
Result := False;
|
||||||
CMD_Err3(erDivideByZero, '', Tmp);
|
CMD_Err3(erDivideByZero, Exception(Tmp).Message, Tmp);
|
||||||
Exit;
|
Exit;
|
||||||
end;
|
end;
|
||||||
if Tmp is EZeroDivide then
|
if Tmp is EZeroDivide then
|
||||||
begin
|
begin
|
||||||
Result := False;
|
Result := False;
|
||||||
CMD_Err3(erDivideByZero, '', Tmp);
|
CMD_Err3(erDivideByZero, Exception(Tmp).Message, Tmp);
|
||||||
Exit;
|
Exit;
|
||||||
end;
|
end;
|
||||||
if Tmp is EMathError then
|
if Tmp is EMathError then
|
||||||
begin
|
begin
|
||||||
Result := False;
|
Result := False;
|
||||||
CMD_Err3(erMathError, '', Tmp);
|
CMD_Err3(erMathError, Exception(Tmp).Message, Tmp);
|
||||||
Exit;
|
Exit;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
@ -7820,17 +7826,17 @@ begin
|
|||||||
end else
|
end else
|
||||||
if Tmp is EDivByZero then
|
if Tmp is EDivByZero then
|
||||||
begin
|
begin
|
||||||
CMD_Err3(erDivideByZero, '', Tmp);
|
CMD_Err3(erDivideByZero, Exception(Tmp).Message, Tmp);
|
||||||
Break;
|
Break;
|
||||||
end;
|
end;
|
||||||
if Tmp is EZeroDivide then
|
if Tmp is EZeroDivide then
|
||||||
begin
|
begin
|
||||||
CMD_Err3(erDivideByZero, '', Tmp);
|
CMD_Err3(erDivideByZero, Exception(Tmp).Message, Tmp);
|
||||||
Break;
|
Break;
|
||||||
end;
|
end;
|
||||||
if Tmp is EMathError then
|
if Tmp is EMathError then
|
||||||
begin
|
begin
|
||||||
CMD_Err3(erMathError, '', Tmp);
|
CMD_Err3(erMathError, Exception(Tmp).Message, Tmp);
|
||||||
Break;
|
Break;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
@ -8506,17 +8512,17 @@ begin
|
|||||||
end else
|
end else
|
||||||
if Tmp is EDivByZero then
|
if Tmp is EDivByZero then
|
||||||
begin
|
begin
|
||||||
CMD_Err3(erDivideByZero, '', Tmp);
|
CMD_Err3(erDivideByZero, Exception(Tmp).Message, Tmp);
|
||||||
break;
|
break;
|
||||||
end;
|
end;
|
||||||
if Tmp is EZeroDivide then
|
if Tmp is EZeroDivide then
|
||||||
begin
|
begin
|
||||||
CMD_Err3(erDivideByZero, '', Tmp);
|
CMD_Err3(erDivideByZero, Exception(Tmp).Message, Tmp);
|
||||||
break;
|
break;
|
||||||
end;
|
end;
|
||||||
if Tmp is EMathError then
|
if Tmp is EMathError then
|
||||||
begin
|
begin
|
||||||
CMD_Err3(erMathError, '', Tmp);
|
CMD_Err3(erMathError, Exception(Tmp).Message, Tmp);
|
||||||
break;
|
break;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
@ -9170,6 +9176,16 @@ begin
|
|||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function _VarArrayGet(var S : Variant; I : Integer) : Variant;
|
||||||
|
begin
|
||||||
|
result := VarArrayGet(S, [I]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure _VarArraySet(const c : Variant; I : Integer; var s : Variant);
|
||||||
|
begin
|
||||||
|
VarArrayPut(s, c, [i]);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
procedure TPSExec.RegisterStandardProcs;
|
procedure TPSExec.RegisterStandardProcs;
|
||||||
begin
|
begin
|
||||||
@ -9247,6 +9263,8 @@ begin
|
|||||||
RegisterFunctionName('WSTRGET', DefProc, Pointer(42), nil);
|
RegisterFunctionName('WSTRGET', DefProc, Pointer(42), nil);
|
||||||
RegisterFunctionName('WSTRSET', DefProc, Pointer(43), nil);
|
RegisterFunctionName('WSTRSET', DefProc, Pointer(43), nil);
|
||||||
{$ENDIF}
|
{$ENDIF}
|
||||||
|
RegisterDelphiFunction(@_VarArrayGet, 'VARARRAYGET', cdRegister);
|
||||||
|
RegisterDelphiFunction(@_VarArraySet, 'VARARRAYSET', cdRegister);
|
||||||
|
|
||||||
RegisterInterfaceLibraryRuntime(Self);
|
RegisterInterfaceLibraryRuntime(Self);
|
||||||
end;
|
end;
|
||||||
@ -11092,18 +11110,40 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
function TPSExec.LastExParam: tbtString;
|
function TPSExec.LastExParam: tbtString;
|
||||||
|
var
|
||||||
|
pp: TPSExceptionHandler;
|
||||||
begin
|
begin
|
||||||
result := ExParam;
|
if FExceptionStack.Count = 0 then begin
|
||||||
|
result := ExParam;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
pp := fExceptionStack[fExceptionStack.Count-1];
|
||||||
|
result := pp.ExceptionParam;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TPSExec.LastExPos: Integer;
|
function TPSExec.LastExPos: Integer;
|
||||||
|
var
|
||||||
|
pp: TPSExceptionHandler;
|
||||||
begin
|
begin
|
||||||
result := ExPos;
|
if FExceptionStack.Count = 0 then begin
|
||||||
|
result := ExPos;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
pp := fExceptionStack[fExceptionStack.Count-1];
|
||||||
|
result := pp.ExceptOffset;
|
||||||
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TPSExec.LastExProc: Integer;
|
function TPSExec.LastExProc: Integer;
|
||||||
|
var
|
||||||
|
pp: TPSExceptionHandler;
|
||||||
begin
|
begin
|
||||||
result := exProc;
|
if FExceptionStack.Count = 0 then begin
|
||||||
|
result := ExProc;
|
||||||
|
exit;
|
||||||
|
end;
|
||||||
|
pp := fExceptionStack[fExceptionStack.Count-1];
|
||||||
|
result := FProcs.IndexOf(pp.CurrProc);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ TPSRuntimeClass }
|
{ TPSRuntimeClass }
|
||||||
@ -12342,6 +12382,9 @@ var
|
|||||||
aName: PWideChar;
|
aName: PWideChar;
|
||||||
WSFreeList: TPSList;
|
WSFreeList: TPSList;
|
||||||
begin
|
begin
|
||||||
|
if Self = nil then begin
|
||||||
|
raise EPSException.Create('Variant is null, cannot invoke', nil, 0, 0);
|
||||||
|
end;
|
||||||
FillChar(ExceptInfo, SizeOf(ExceptInfo), 0);
|
FillChar(ExceptInfo, SizeOf(ExceptInfo), 0);
|
||||||
if Name='' then begin
|
if Name='' then begin
|
||||||
DispatchId:=0;
|
DispatchId:=0;
|
||||||
|
@ -733,12 +733,18 @@ end;
|
|||||||
//-------------------------------------------------------------------
|
//-------------------------------------------------------------------
|
||||||
|
|
||||||
function FloatToStr(E: Extended): TbtString;
|
function FloatToStr(E: Extended): TbtString;
|
||||||
|
{$ifdef FPC}
|
||||||
|
begin
|
||||||
|
result := sysutils.floattostr(e);
|
||||||
|
end;
|
||||||
|
{$else}
|
||||||
var
|
var
|
||||||
s: tbtstring;
|
s: tbtstring;
|
||||||
begin
|
begin
|
||||||
Str(e:0:12, s);
|
Str(e:0:12, s);
|
||||||
result := s;
|
result := s;
|
||||||
end;
|
end;
|
||||||
|
{$endif}
|
||||||
|
|
||||||
function StrToInt(const S: TbtString): LongInt;
|
function StrToInt(const S: TbtString): LongInt;
|
||||||
var
|
var
|
||||||
|
Loading…
Reference in New Issue
Block a user