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

Source/uPSCompiler.pas

@@ -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('function Length: Integer;').Decl.AddParam.OrgName:='s';
-  AddFunction('procedure SetLength(var S: String; L: Longint);');
+  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;');

Source/uPSRuntime.pas

@@ -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);

Source/uPSUtils.pas

@@ -12,9 +12,9 @@ const
 
   PSLowBuildSupport = 12;
 
-  PSCurrentBuildNo = 22;
+  PSCurrentBuildNo = 23;
 
-  PSCurrentversion = '1.30';
+  PSCurrentversion = '1.31';
 
   PSValidHeader = 1397769801;