Переглянути джерело

Update further. Next steps are
-Moving ExecIs64Bit/NativeInt/NativeUInt into ROPS.
-Use it to fix ROPS' built-in (proto)types such as HWND.
-Use that to fix CodeDll.iss
Also can now fix ScriptFunc's MESSAGE WARNs.

Martijn Laan 1 місяць тому
батько
коміт
d7f59cd9cb

+ 43 - 0
Components/PSStackHelper.pas

@@ -40,6 +40,7 @@ type
     function GetClassArray(const ItemNo: Longint; const FieldNo: Longint = -1): TArrayOfObject;
     function GetIntArray(const ItemNo: Longint; const FieldNo: Longint = -1): TArrayOfInteger;
     function GetNativeInt(const ItemNo: Longint): NativeInt;
+    function GetNativeUInt(const ItemNo: Longint): NativeUInt;
     function GetProc(const ItemNo: Longint; const Exec: TPSExec): TMethod;
     function GetStringArray(const ItemNo: Longint; const FieldNo: Longint = -1): TArrayOfString;
     function InitArrayBuilder(const ItemNo: LongInt; const FieldNo: Longint = -1): TArrayBuilder;
@@ -49,6 +50,9 @@ type
     procedure SetInt(const ItemNo: Longint; const Data: Integer; const FieldNo: Longint = -1);
     procedure SetInt64(const ItemNo: Longint; const Data: Int64; const FieldNo: Longint = -1);
     procedure SetNativeInt(const ItemNo: Longint; const Data: NativeInt; const FieldNo: Longint = -1);
+    procedure SetNativeUInt(const ItemNo: Longint; const Data: NativeUInt; const FieldNo: Longint = -1);
+    procedure SetUInt(const ItemNo: Longint; const Data: Cardinal; const FieldNo: Longint = -1);
+    procedure SetUInt64(const ItemNo: Longint; const Data: UInt64; const FieldNo: Longint = -1);
   end;
 
 implementation
@@ -109,6 +113,15 @@ begin
 {$ENDIF}
 end;
 
+function TPSStackHelper.GetNativeUInt(const ItemNo: Longint): NativeUInt;
+begin
+{$IFNDEF WIN64}
+  Result := GetUInt(ItemNo);
+{$ELSE}
+  Result := GetUInt64(ItemNo);
+{$ENDIF}
+end;
+
 function TPSStackHelper.GetProc(const ItemNo: Longint; const Exec: TPSExec): TMethod;
 begin
   var P := PPSVariantProcPtr(Items[ItemNo]);
@@ -181,6 +194,16 @@ begin
     inherited SetInt(ItemNo, Data)
 end;
 
+procedure TPSStackHelper.SetUInt(const ItemNo: Longint; const Data: Cardinal;
+  const FieldNo: Longint);
+begin
+  if FieldNo >= 0 then begin
+    var PSVariantIFC := NewTPSVariantRecordIFC(Items[ItemNo], FieldNo);
+    VNSetUInt(PSVariantIFC, Data);
+  end else
+    inherited SetUInt(ItemNo, Data)
+end;
+
 procedure TPSStackHelper.SetInt64(const ItemNo: Longint; const Data: Int64;
   const FieldNo: Longint);
 begin
@@ -191,6 +214,16 @@ begin
     inherited SetInt64(ItemNo, Data)
 end;
 
+procedure TPSStackHelper.SetUInt64(const ItemNo: Longint; const Data: UInt64;
+  const FieldNo: Longint);
+begin
+  if FieldNo >= 0 then begin
+    var PSVariantIFC := NewTPSVariantRecordIFC(Items[ItemNo], FieldNo);
+    VNSetUInt64(PSVariantIFC, Data);
+  end else
+    inherited SetUInt64(ItemNo, Data)
+end;
+
 procedure TPSStackHelper.SetNativeInt(const ItemNo: Longint; const Data: NativeInt;
   const FieldNo: Longint);
 begin
@@ -201,4 +234,14 @@ begin
 {$ENDIF}
 end;
 
+procedure TPSStackHelper.SetNativeUInt(const ItemNo: Longint; const Data: NativeUInt;
+  const FieldNo: Longint);
+begin
+{$IFNDEF WIN64}
+  SetUInt(ItemNo, Data, FieldNo);
+{$ELSE}
+  SetUInt64(ItemNo, Data, FieldNo);
+{$ENDIF}
+end;
+
 end.

+ 10 - 8
Projects/Src/Compiler.ScriptFunc.pas

@@ -83,19 +83,21 @@ begin
   RegisterType('TArrayOfInteger', 'array of Integer');
   RegisterType('TArrayOfGraphic', 'array of TGraphic');
 
-  RegisterType('DWORD', 'LongWord');
-  RegisterType('UINT', 'LongWord');
+  RegisterType('DWORD', 'Cardinal');
+  RegisterType('UINT', 'Cardinal');
   RegisterType('BOOL', 'LongBool');
-  { Note: In a native 64-bit build, these must be expanded to 64 bits }
-  RegisterType('DWORD_PTR', 'LongWord');
-  RegisterType('UINT_PTR', 'LongWord');
 
-  if ExecIs64Bit then
-    RegisterType('NativeInt', 'Int64')
-  else
+  if ExecIs64Bit then begin
+    RegisterType('NativeInt', 'Int64');
+    RegisterType('NativeUInt', 'UInt64');
+  end else begin
     RegisterType('NativeInt', 'Integer');
+    RegisterType('NativeUInt', 'Cardinal');
+  end;
 
   RegisterType('INT_PTR', 'NativeInt');
+  RegisterType('DWORD_PTR', 'NativeUInt');
+  RegisterType('UINT_PTR', 'NativeUInt');
 
   RegisterType('TFileTime',
     'record' +

+ 1 - 1
Projects/Src/IDE.ScintStylerInnoSetup.pas

@@ -456,7 +456,7 @@ const
     'WideChar', 'WideString', 'UnicodeString', 'AnsiString', 'String', 'ShortInt',
     'Word', 'SmallInt', 'LongInt', 'LongWord', 'Integer', 'Cardinal', 'Int64', 'UInt64',
     'Single', 'Double', 'Extended', 'Currency', 'PAnsiChar', 'Variant',
-    'TVariantArray', 'NativeInt',
+    'TVariantArray', 'NativeInt', 'NativeUInt',
     //undocumented: NativeString, AnyString, AnyMethod, ___Pointer, tbtString, NativeString, !NotificationVariant
     'TVarType',
     //undocumented: TIFException

+ 1 - 1
whatsnew.htm

@@ -51,7 +51,7 @@ For conditions of distribution and use, see <a href="files/is/license.txt">LICEN
 <ul>
   <li>Pascal Scripting:
   <ul>
-    <li>Added types <tt>UInt64</tt> and <tt>NativeInt</tt>.</li>
+    <li>Added types <tt>UInt64</tt>, <tt>NativeInt</tt> and <tt>NativeUInt</tt>.</li>
   </ul>
   <li>Other minor improvements.</li>
 </ul>