Changes by Thomas Nitzschke to support Length/SetLength on arrays and low and high.
git-svn-id: http://code.remobjects.com/svn/pascalscript@21 5c9d2617-0215-0410-a2ee-e80e04d1c6d8
This commit is contained in:
carlokok
parent
631352c8bf
commit
e3c8f24d55
@ -10556,8 +10556,10 @@ var
|
||||
if (x.BaseType = btArray) or (x.basetype = btStaticArray) then
|
||||
begin
|
||||
WriteLong(TPSArrayType(x).ArrayTypeNo.FinalTypeNo);
|
||||
if (x.baseType = btstaticarray) then
|
||||
if (x.baseType = btstaticarray) then begin
|
||||
WriteLong(TPSStaticArrayType(x).Length);
|
||||
WriteLong(TPSStaticArrayType(x).StartOffset); //<-additional StartOffset
|
||||
end;
|
||||
end else if x.BaseType = btRecord then
|
||||
begin
|
||||
n := TPSRecordType(x).RecValCount;
|
||||
@ -12062,7 +12064,7 @@ procedure TPSPascalCompiler.DefineStandardProcedures;
|
||||
var
|
||||
p: TPSRegProc;
|
||||
begin
|
||||
AddFunction('function inttostr(i: Longint): string;');
|
||||
AddFunction('function inttostr(i: Int64): string;');
|
||||
AddFunction('function strtoint(s: string): Longint;');
|
||||
AddFunction('function strtointdef(s: string; def: Longint): Longint;');
|
||||
AddFunction('function copy(s: string; ifrom, icount: Longint): string;');
|
||||
@ -12094,8 +12096,36 @@ begin
|
||||
AddFunction('Function Uppercase(s : string) : string;');
|
||||
AddFunction('Function Lowercase(s : string) : string;');
|
||||
AddFunction('Function Trim(s : string) : string;');
|
||||
AddFunction('Function Length(s : String) : Longint;');
|
||||
AddFunction('procedure SetLength(var S: String; L: Longint);');
|
||||
AddFunction('function Length: Integer;').Decl.AddParam.OrgName:='s';
|
||||
with AddFunction('procedure SetLength;').Decl do
|
||||
begin
|
||||
with AddParam do
|
||||
begin
|
||||
OrgName:='s';
|
||||
Mode:=pmInOut;
|
||||
end;
|
||||
with AddParam do
|
||||
begin
|
||||
OrgName:='NewLength';
|
||||
aType:=FindBaseType(btS32); //Integer
|
||||
end;
|
||||
end;
|
||||
AddFunction('function Low: Int64;').Decl.AddParam.OrgName:='x';
|
||||
AddFunction('function High: Int64;').Decl.AddParam.OrgName:='x';
|
||||
with AddFunction('procedure Dec;').Decl do begin
|
||||
with AddParam do
|
||||
begin
|
||||
OrgName:='x';
|
||||
Mode:=pmInOut;
|
||||
end;
|
||||
end;
|
||||
with AddFunction('procedure Inc;').Decl do begin
|
||||
with AddParam do
|
||||
begin
|
||||
OrgName:='x';
|
||||
Mode:=pmInOut;
|
||||
end;
|
||||
end;
|
||||
AddFunction('Function Sin(e : Extended) : Extended;');
|
||||
AddFunction('Function Cos(e : Extended) : Extended;');
|
||||
AddFunction('Function Sqrt(e : Extended) : Extended;');
|
||||
|
||||
@ -191,9 +191,12 @@ type
|
||||
TPSTypeRec_StaticArray = class(TPSTypeRec_Array)
|
||||
private
|
||||
FSize: Longint;
|
||||
FStartOffset: LongInt;
|
||||
public
|
||||
|
||||
property Size: Longint read FSize write FSize;
|
||||
property StartOffset: LongInt read FStartOffset write FStartOffset;
|
||||
|
||||
procedure CalcSize; override;
|
||||
end;
|
||||
|
||||
@ -2532,6 +2535,15 @@ var
|
||||
exit;
|
||||
end;
|
||||
TPSTypeRec_StaticArray(curr).Size := d;
|
||||
if not Read(d,4) then //<-additional StartOffset
|
||||
begin
|
||||
curr.Free;
|
||||
cmd_err(erUnexpectedEof);
|
||||
LoadTypes:=false;
|
||||
Exit;
|
||||
end;
|
||||
TPSTypeRec_StaticArray(curr).StartOffset:=d;
|
||||
|
||||
Curr.BaseType := currf.BaseType;
|
||||
FTypes.Add(Curr);
|
||||
end;
|
||||
@ -8076,7 +8088,7 @@ var
|
||||
Tmp: TObject;
|
||||
begin
|
||||
case Longint(p.Ext1) of
|
||||
0: Stack.SetString(-1, IntToStr(Stack.GetInt(-2))); // inttostr
|
||||
0: Stack.SetString(-1, IntToStr(Stack.GetInt64(-2))); // inttostr
|
||||
1: Stack.SetInt(-1, SysUtils.StrToInt(Stack.GetString(-2))); // strtoint
|
||||
2: Stack.SetInt(-1, StrToIntDef(Stack.GetString(-2), Stack.GetInt(-3))); // strtointdef
|
||||
3: Stack.SetInt(-1, Pos(Stack.GetString(-2), Stack.GetString(-3)));// pos
|
||||
@ -8270,6 +8282,124 @@ begin
|
||||
Result := System.Unassigned;
|
||||
end;
|
||||
{$ENDIF}
|
||||
function Length_(Caller: TPSExec; p: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;
|
||||
var
|
||||
arr: TPSVariantIFC;
|
||||
begin
|
||||
Result:=false;
|
||||
arr:=NewTPSVariantIFC(Stack[Stack.Count-2],false);
|
||||
if arr.aType.BaseType=btArray then
|
||||
begin
|
||||
Stack.SetInt(-1,PSDynArrayGetLength(Pointer(arr.Dta^),arr.aType));
|
||||
Result:=true;
|
||||
end;
|
||||
if arr.aType.BaseType=btStaticArray then
|
||||
begin
|
||||
Stack.SetInt(-1,TPSTypeRec_StaticArray(arr.aType).Size);
|
||||
Result:=true;
|
||||
end;
|
||||
if arr.aType.BaseType=btString then
|
||||
begin
|
||||
Stack.SetInt(-1,length(tbtstring(arr.Dta^)));
|
||||
Result:=true;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function SetLength_(Caller: TPSExec; p: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;
|
||||
var
|
||||
arr: TPSVariantIFC;
|
||||
begin
|
||||
Result:=false;
|
||||
arr:=NewTPSVariantIFC(Stack[Stack.Count-1],true);
|
||||
if arr.aType.BaseType=btArray then
|
||||
begin
|
||||
PSDynArraySetLength(Pointer(arr.Dta^),arr.aType,Stack.GetInt(-2));
|
||||
Result:=true;
|
||||
end;
|
||||
if arr.aType.BaseType=btString then
|
||||
begin
|
||||
SetLength(tbtstring(arr.Dta^),STack.GetInt(-2));
|
||||
Result:=true;
|
||||
end;
|
||||
end;
|
||||
|
||||
function Low_(Caller: TPSExec; p: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;
|
||||
var
|
||||
arr: TPSVariantIFC;
|
||||
t: PIFTypeRec;
|
||||
begin
|
||||
Result:=true;
|
||||
arr:=NewTPSVariantIFC(Stack[Stack.Count-2],false);
|
||||
case arr.aType.BaseType of
|
||||
btArray : Stack.SetInt(-1,0);
|
||||
btStaticArray: Stack.SetInt(-1,TPSTypeRec_StaticArray(arr.aType).StartOffset);
|
||||
btString : Stack.SetInt64(-1,1);
|
||||
btU8 : Stack.SetInt64(-1,Low(Byte)); //Byte: 0
|
||||
btS8 : Stack.SetInt64(-1,Low(ShortInt)); //ShortInt: -128
|
||||
btU16 : Stack.SetInt64(-1,Low(Word)); //Word: 0
|
||||
btS16 : Stack.SetInt64(-1,Low(SmallInt)); //SmallInt: -32768
|
||||
btU32 : Stack.SetInt64(-1,Low(Cardinal)); //Cardinal/LongWord: 0
|
||||
btS32 : Stack.SetInt64(-1,Low(Integer)); //Integer/LongInt: -2147483648
|
||||
else Result:=false;
|
||||
end;
|
||||
end;
|
||||
|
||||
function High_(Caller: TPSExec; p: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;
|
||||
var
|
||||
arr: TPSVariantIFC;
|
||||
t: PIFTypeRec;
|
||||
begin
|
||||
Result:=true;
|
||||
arr:=NewTPSVariantIFC(Stack[Stack.Count-2],false);
|
||||
case arr.aType.BaseType of
|
||||
btArray : Stack.SetInt(-1,PSDynArrayGetLength(Pointer(arr.Dta^),arr.aType)-1);
|
||||
btStaticArray: Stack.SetInt(-1,TPSTypeRec_StaticArray(arr.aType).StartOffset+TPSTypeRec_StaticArray(arr.aType).Size-1);
|
||||
btString : Stack.SetInt(-1,Length(tbtstring(arr.Dta^)));
|
||||
btU8 : Stack.SetInt(-1,High(Byte)); //Byte: 255
|
||||
btS8 : Stack.SetInt(-1,High(ShortInt)); //ShortInt: 127
|
||||
btU16 : Stack.SetInt(-1,High(Word)); //Word: 65535
|
||||
btS16 : Stack.SetInt(-1,High(SmallInt)); //SmallInt: 32767
|
||||
btU32 : Stack.SetInt(-1,High(Cardinal)); //Cardinal/LongWord: 4294967295
|
||||
btS32 : Stack.SetInt(-1,High(Integer)); //Integer/LongInt: 2147483647
|
||||
else Result:=false;
|
||||
end;
|
||||
end;
|
||||
|
||||
function Dec_(Caller: TPSExec; p: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;
|
||||
var
|
||||
arr: TPSVariantIFC;
|
||||
begin
|
||||
Result:=true;
|
||||
arr:=NewTPSVariantIFC(Stack[Stack.Count-1],true);
|
||||
case arr.aType.BaseType of
|
||||
btU8 : Stack.SetInt(-1,Tbtu8(arr.dta^)-1); //Byte
|
||||
btS8 : Stack.SetInt(-1,Tbts8(arr.dta^)-1); //ShortInt
|
||||
btU16 : Stack.SetInt(-1,Tbtu16(arr.dta^)-1); //Word
|
||||
btS16 : Stack.SetInt(-1,Tbts16(arr.dta^)-1); //SmallInt
|
||||
btU32 : Stack.SetInt(-1,Tbtu32(arr.dta^)-1); //Cardinal/LongWord
|
||||
btS32 : Stack.SetInt(-1,Tbts32(arr.dta^)-1); //Integer/LongInt
|
||||
else Result:=false;
|
||||
end;
|
||||
end;
|
||||
|
||||
function Inc_(Caller: TPSExec; p: TPSExternalProcRec; Global, Stack: TPSStack): Boolean;
|
||||
var
|
||||
arr: TPSVariantIFC;
|
||||
begin
|
||||
Result:=true;
|
||||
arr:=NewTPSVariantIFC(Stack[Stack.Count-1],true);
|
||||
case arr.aType.BaseType of
|
||||
btU8 : Stack.SetInt(-1,Tbtu8(arr.dta^)+1); //Byte
|
||||
btS8 : Stack.SetInt(-1,Tbts8(arr.dta^)+1); //ShortInt
|
||||
btU16 : Stack.SetInt(-1,Tbtu16(arr.dta^)+1); //Word
|
||||
btS16 : Stack.SetInt(-1,Tbts16(arr.dta^)+1); //SmallInt
|
||||
btU32 : Stack.SetInt(-1,Tbtu32(arr.dta^)+1); //Cardinal/LongWord
|
||||
btS32 : Stack.SetInt(-1,Tbts32(arr.dta^)+1); //Integer/LongInt
|
||||
else Result:=false;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TPSExec.RegisterStandardProcs;
|
||||
begin
|
||||
@ -8289,8 +8419,14 @@ begin
|
||||
RegisterFunctionName('UPPERCASE', DefProc, Pointer(10), nil);
|
||||
RegisterFunctionName('LOWERCASE', DefProc, Pointer(11), nil);
|
||||
RegisterFunctionName('TRIM', DefProc, Pointer(12), nil);
|
||||
RegisterFunctionName('LENGTH', DefProc, Pointer(13), nil);
|
||||
RegisterFunctionName('SETLENGTH', DefProc, Pointer(14), nil);
|
||||
|
||||
RegisterFunctionName('LENGTH',Length_,nil,nil);
|
||||
RegisterFunctionName('SETLENGTH',SetLength_,nil,nil);
|
||||
RegisterFunctionName('LOW',Low_,nil,nil);
|
||||
RegisterFunctionName('HIGH',High_,nil,nil);
|
||||
RegisterFunctionName('DEC',Dec_,nil,nil);
|
||||
RegisterFunctionName('INC',Inc_,nil,nil);
|
||||
|
||||
RegisterFunctionName('SIN', DefProc, Pointer(15), nil);
|
||||
RegisterFunctionName('COS', DefProc, Pointer(16), nil);
|
||||
RegisterFunctionName('SQRT', DefProc, Pointer(17), nil);
|
||||
|
||||
@ -12,9 +12,9 @@ const
|
||||
|
||||
PSLowBuildSupport = 12;
|
||||
|
||||
PSCurrentBuildNo = 22;
|
||||
PSCurrentBuildNo = 23;
|
||||
|
||||
PSCurrentversion = '1.30';
|
||||
PSCurrentversion = '1.31';
|
||||
|
||||
PSValidHeader = 1397769801;
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user