Alternative pointers in Smart Mobile Studio

Smart Mobile Studio already enjoy a rich and powerful set of memory handling classes and methods. If you have a quick look in the memory units (see below) you will find that Smart Mobile Studio really makes JavaScript sing and dance like no other.

As of writing in version 3.0 BETA the following units are dedicated to raw memory manipulation:

• System.Memory
• System.Memory.Allocation
• System.Memory.Buffer
• System.Memory.Views

Besides these, the unit System.Types.Convert represents the missing link. It contains the class TDataType which converts data between intrinsic (language level) data types and byte arrays.

Alternative pointers

While Smart has probably one of the best frameworks (if not THE best) for memory handling out there, including the standard library that ships with Node.js, the way it works is slightly different from Delphi’s and Freepascal’s approach.

Since JavaScript is reference based rather than pointer based, a marshaling offset mechanism is more efficient in terms of performance; So we modeled this aspect of Smart on how C# in particular organized its memory stuff.

But, is it possible to implement more Delphi like pointers? To some degree yes. The best would be to do this on compiler level, but even without such deep changes to the system you can actually implement a more Delphi-ish interface.

Here is an example of just such a system. It is small and efficient, but compared to the memory units in the RTL it’s much slower. This is also why we abandoned this way of handling memory in the first place. But perhaps someone will find it interesting, or it can help you port over code from Delphi to HTML5.

unit altpointers;

interface

uses
  W3C.TypedArray,
  System.Types,
  System.Types.Convert,
  System.Memory,
  system.memory.allocation,
  System.Memory.Buffer,
  System.Memory.Views;

type

  Pointer = variant;

  TPointerData = record
    Offset: integer;
    Buffer: JArrayBuffer;
    View:   JUint8Array;
  end;

function IncPointer(Src: Pointer; AddValue: integer): Pointer;
function DecPointer(Src: Pointer; DecValue: integer): Pointer;
function EquPointer(src, dst : Pointer): boolean;

// a := a + bytes
operator + (Pointer,   integer): Pointer uses IncPointer;

// a := a - bytes
operator - (Pointer,   integer): Pointer uses DecPointer;

// if a = b then
operator = (Pointer,   Pointer): boolean uses EquPointer;

function  Allocmem(const Size: integer): Pointer;
function  Addr(const Source: Pointer; const Offset: integer): Pointer;
procedure FreeMem(const Source: Pointer);
procedure MemSet(const Target: pointer; const Value: byte); overload;
procedure MemSet(const Target: pointer; const Values: array of byte); overload;
function  MemGet(const Source: pointer): byte; overload;
function  MemGet(const Source: pointer; ReadLength: integer): TByteArray; overload;

implementation

function MemGet(const Source: pointer): byte;
begin
  if (Source) then
  begin
    var SrcData: TPointerData;
    asm @SrcData = @Source; end;
    result := SrcData.View.items[SrcData.Offset];
  end else
  raise Exception.Create('MemGet failed, invalid pointer error');
end;

function MemGet(const Source: pointer; ReadLength: integer): TByteArray;
begin
  if (Source) then
  begin
    var SrcData: TPointerData;
    asm @SrcData = @Source; end;

    var Offset := SrcData.Offset;

    while ReadLength > 0 do
    begin
      result.add( SrcData.View.items[Offset] );
      inc(Offset);
      dec(ReadLength);

      if offset >= SrcData.View.byteLength then
        raise Exception.Create('MemGet failed, offset exceeds memory');
    end;
  end else
  raise Exception.Create('MemGet failed, invalid pointer error');
end;

procedure MemSet(const Target: pointer; const Value: byte);
begin
  var DstData: TPointerData;
  asm @DstData = @Target; end;
  dstData.View.items[DstData.Offset] := value;
end;

procedure MemSet(const Target: pointer; const Values: array of byte);
begin
  if Values.length > 0 then
  begin
    var DstData: TPointerData;
    asm @DstData = @Target; end;

    var offset := DstData.Offset;
    for var x := low(Values) to high(Values) do
    begin
      dstData.View.items[offset] := Values[x];
      inc(offset);
      if offset >= DstData.View.byteLength then
        raise Exception.Create('MemSet failed, offset exceeds memory');
    end;
  end;
end;

function EquPointer(src, dst : Pointer): boolean;
begin
  if (src) then
  begin
    if (dst) then
    begin
      var SrcData: TPointerData;
      var DstData: TPointerData;
      asm @SrcData = @Src; end;
      asm @DstData = @dst; end;
      result := SrcData.buffer = dstData.buffer;
    end;
  end;
end;

function IncPointer(Src: Pointer; AddValue: integer): Pointer;
begin
  if (Src) then
  begin
    // Check that there is an actual change.
    // If not, just return the same pointer
    if AddValue > 0 then
    begin
      // Map source data
      var SrcData: TPointerData;
      asm @SrcData = @Src; end;

      // Calculate new offset, using the current view
      // position as the present location.
      var NewOffset := srcData.Offset;
      inc(NewOffset, AddValue);

      // Make sure the new offset is within the range of the
      // memory buffer. Picky yes, but this is not native land
      if  (NewOffset >=0)
      and (NewOffset  0 then
    begin
      // Map source data
      var SrcData: TPointerData;
      asm @SrcData = @Src; end;

      // Calculate new offset, using the current view
      // position as the present location.
      var NewOffset := srcData.Offset;
      dec(NewOffset, DecValue);

      // Make sure the new offset is within the range of the
      // memory buffer. Picky yes, but this is not native land
      if  (NewOffset >=0)
      and (NewOffset  0 then
  begin
    var Data: TPointerData;
    Data.Offset := 0;
    Data.Buffer := JArrayBuffer.Create(Size);
    Data.View := JUint8Array.Create(Data.Buffer, 0, Size);
    asm
      @result = @data;
    end;
  end else
  raise Exception.Create('Allocmem failed, invalid size error');
end;

function Addr(const Source: Pointer; const Offset: integer): Pointer;
begin
  if (Source) then
  begin
    if offset > 0 then
    begin
      // Map source data
      var SrcData: TPointerData;
      asm @SrcData = @Source; end;

      // Check that offset is valid
      if (Offset >=0) and (offset < srcData.buffer.byteLength) then
      begin
        // Setup new Pointer data
        var Data: TPointerData;
        Data.Buffer := SrcData.Buffer;
        Data.View := SrcData.View;
        Data.Offset := Offset;
        asm
          @result = @data;
        end;
      end else
      raise Exception.Create('Addr failed, offset exceeds memory');
    end else
    raise Exception.Create('Addr failed, invalid offset error');
  end else
  raise Exception.Create('Addr failed, invalid pointer error');
end;

procedure FreeMem(const Source: Pointer);
begin
  if (source) then
  begin
    // Map source data
    var SrcData: TPointerData;
    asm @SrcData = @Source; end;

    // Flush reference and let the GC take care of it
    SrcData.Buffer := nil;
    SrcData.View := nil;
    SrcData.Offset := 0;
    asm
      srcData = {}
    end;
  end else
  raise Exception.Create('FreeMem failed, invalid pointer error');
end;

end.

Using the pointers

As you can probably see from the code there is no such thing as PByte, PWord or PLongword here. We use a clean uint8 typed array that we link to a memory buffer, so “pointer” here is fully byte based despite it’s untyped origins. In reality it just holds a TPointerData structure, but since this is done via asm sections, the compiler cant see it and treats it as a variant.

The operators add support for code like:

var buffer := allocmem(1024);
memset(buffer, $ff);
buffer := buffer + 1;
memset(buffer, $FA)

But using the overloaded memset procedure is a bit more efficient:

var buffer := allocmem(1024);
var bytes := TDataType.StringToBytes('this is awesome!');
memset(buffer, bytes);
buffer := buffer + bytes.length;
// write more data here

While fun to play with and perhaps useful in porting over older code, I highly recommend that you familiarize yourself with classes like TBinaryData that represents a fully managed buffer with a rich number of methods to use.

And ofcourse let us not forget TMemoryStream combined with TStreamWriter and TStreamReader. These will no doubt feel more at home both under HTML5 and Node.js

Note: WordPress formatting of pascal code is not the best. Click here to view the code as PDF.

Extract DLL member names in Delphi

Long before dot net and Java I was doing a huge coding system for a large Norwegian company. They wanted a custom scripting engine and they wanted a way to embed bytecodes in dll files. Easy like apple pie (I sure know how to pick’em huh?).

The solution turned out to be simple enough, but this post is not about that, but rather about a unit I wrote as part of the solution. In order to recognize one dll from another, you obviously need the ability to examine a dll file. I mean, you could just load the dll and try to map the functions you need, but that will throw an exception if it’s the wrong dll.

So after a bit of googling around and spending a few hours on MDN, I sat down and wrote a unit for this. It allows you to load a dll and extract all the method names the library exposes. If nothing else it makes it easier to recognize your dll files.

Well enjoy!

unit dllexamine;

interface

uses
  WinAPI.Windows,
  WinAPI.ImageHlp,
  System.Sysutils,
  System.Classes;

  {
    Reference material for WinAPI functions
    =======================================

    MapAndLoad::
    https://msdn.microsoft.com/en-us/library/windows/desktop/ms680353(v=vs.85).aspx

    UnMapAndLoad:
    https://social.msdn.microsoft.com/search/en-US/windows?query=UnMapAndLoad&refinement=183

    ImageDirectoryEntryToData:
    https://msdn.microsoft.com/en-us/library/windows/desktop/ms680148(v=vs.85).aspx

    ImageRvaToVa:
    https://msdn.microsoft.com/en-us/library/windows/desktop/ms680218(v=vs.85).aspx
  }

  Type

  THexDllExamine = class abstract
  public
    class function Examine(const Filename: AnsiString;
      out Members: TStringlist): boolean; static;
  end;

  implementation

  class function THexDllExamine.Examine(const Filename: AnsiString;
    out Members: TStringlist): boolean;
  type
    TDWordArray = array [0..$FFFFF] of DWORD;
  var
    libinfo:      LoadedImage;
    libDirectory: PImageExportDirectory;
    SizeOfList: Cardinal;
    pDummy: PImageSectionHeader;
    i: Cardinal;
    NameRVAs: ^TDWordArray;
    Name: string;
  begin
    result := false;
    members := nil;

    if MapAndLoad( PAnsiChar(FileName), nil, @libinfo, true, true) then
    begin
      try
        // Get the directory
        libDirectory := ImageDirectoryEntryToData(libinfo.MappedAddress,
          false, IMAGE_DIRECTORY_ENTRY_EXPORT, SizeOfList);

        // Anything to work with?
        if libDirectory  nil then
        begin

          // Get ptr to first node for the image directory
          NameRVAs := ImageRvaToVa( libinfo.FileHeader,
            libinfo.MappedAddress,
            DWORD(libDirectory^.AddressOfNames),
            pDummy
          );

          // Traverse until end
          Members := TStringList.Create;
          try
            for i := 0 to libDirectory^.NumberOfNames - 1 do
            begin
              Name := PChar(ImageRvaToVa(libinfo.FileHeader,
                libinfo.MappedAddress, NameRVAs^[i], pDummy));
              Name := Name.Trim();
              if Name.Length > 0 then
                Members.Add(Name);
            end;
          except
            on e: exception do
            begin
              FreeAndNil(Members);
              exit;
            end;
          end;

          // We never get here if an exception kicks in
          result := members  nil;

        end;
      finally
        // Yoga complete, now breathe ..
        UnMapAndLoad(@libinfo);
      end;
    end;
  end;

end.