Home > JavaScript, nodeJS, Object Pascal, OP4JS, Smart Mobile Studio > Smart Mobile Studio, update right around the corner

Smart Mobile Studio, update right around the corner

September 19, 2015 Leave a comment Go to comments

So I havent been able to write much about Smart Mobile Studio the past six months. For those of you that read my blog you will notice that I made it quite clear that at least six months would pass before I could start to allocate time for blogging again. Between then and now I have moved house, got a new job and we’ve also had a long national holiday.

Doing it properly

On the surface things may appear to be slow, but behind the scenes the team has been working like mad. Not just with fixing bugs and beta-testing the new features, but also with establishing a proper company with proper funding and real-life shares. These are things you dont just slap together because it has a 1:1 impact on every single task, from customer support to technical growth. We love our product so much and we know from experience that it has, can and will make a huge impact on modern software development. These administrative topics are being finalized right now, which can only be regarded as happy news for everyone.

As for progress we like to keep things tidy, meaning that we stick to our bug reports as reported by customers and beta-testers. I get a lot of messages on facebook, emails and even the odd text-message about a bug or missing feature — but please note that we stick to fixing bugs that come in via the proper channels. And we have taken every single bug our now extended beta program has produced and done something about it. As with all living products there are always things, but rest assured that we are not resting on our laurels. And we are not going anywhere.

Next there is support and legacy work. If you have downloaded the beta release you may have noticed that Smart Mobile now gives you methods like allocmem, freemem, move, fillchar, reallocmem, streams (proper stuff, not just slap dash string manipulation), buffer classes and all the “missing” bits and pieces which makes the product stand out.

Javascript doesnt have this out of the box. So bringing things like pointers (references) and memory management into the RTL has been quite a challenge. Not just from a programming point of view, but also with regards to legacy browsers. A lot of people are still using older phones and not all of them supports UInt8 and UInt8Clamped datatypes. This is a pickle no doubt about it.

One of the first things we noticed on releasing the new RTL sub-layer, was in fact that UInt8ClampedArray only works on modern browsers, the absolute latest stuff (which I must admit was my fault because I’m a tech junky and always have the latest to play with). Older versions of IE, and even some variations of webkit for android lack this particular extension. And while I’m tempted to say “get a proper phone”, thats not how it works in real life. Its our job to try and be as compatible as possible. Which means time and effort.

To solve this I had to backtrack and make due with UInt8Array which is just as fast as the clamped version, but with a few limitations here and there – depending on how you use it. Thankfully my initial architecture of the RTL saved my bacon, because I’ve isolated “intrinsic conversion routines” (and reverse) in it’s own class, so we dont have clamped arrays all over the place to deal with. All it took was a few adjustments and we should now support a more rich set of mobile devices.

Having said that, altering the RTL to use a new type is not without it’s challenges; you still have to test, test and test again to make sure it works as expected. I sure as hell wont submit to “gimmic” solutions deployed by our competitors – namely stuffing bin/hex bytes in strings. It may be clever and it may work – but the price is speed, memory bloating and .. well its just not what Smart Mobile Studio is about.

Whats so important about old-time allocmem anyways?

Up to this point Smart Mobile Studio has been strides beyond typescript and other competitors technically. They have more components and things like that, but they also have a language which sounds exactly like if you insert something into, or indeed, take something out – of a cat. All those stupid curley-wurley brackets, lack of structure — and working with “real” data, like raw binary files and binary file-formats requires you to use esoteric libraries with tons of code. It’s ridicules to watch how they manage to get away with it, but kids with no knowledge of object pascal lap it up like catnip. Well we want something better!

Being able to write object oriented, fully memory capable applications is what makes FreePascal and Delphi such a joy to use for the desktop, and we want the same for nodeJS and the browser. Take something simple, like generating a PDF document on your nodeJS server. Should it really takes thousands of lines of code just to produce a binary file correctly? No. It should be no different than working with Delphi or FreePascal. Things like streams, encoding and decoding intrinsic types, working with arrays of bytes (and so on) should just work. But all such features requires a standard way to deal with memory: from allocating to reading and writing bytes, longwords or even bits !

Being able to allocate memory, scale memory, move chunks of memory around and ultimately read and write to the memory — this is the foundation on which streams and buffers rest. Without it we are left with “hacks” like we see other vendors provide. And since the browser exposes said functionality (albeit in an alien form compared to WinAPI) it’s imperative that we make use of it.

To give you some sense of what’s being written, here is one of 4 units dealing exclusively with the memory issue:

 

unit System.Memory;

interface

uses
  System.Types,
  System.TypeCon,
  W3C.TypedArray,
  SmartCL.System;

type

  TAllocation = Class;
  TAllocationOptions  = Class;

  (* TAllocation represents a single, managed memory allocation
     segment. It exposes the bare-bone information about the
     memory segment, such as length, buffer reference
     and handle. It also includes the most basic, simple low-level
     functions for scaling the memory, re-allocating the
     memory (with data persistence) and releasing the allocation *)
  EAllocation = Class(EW3Exception);
  TAllocation = Class(TObject,IDataTransport)
  private
    FHandle:    TMemoryHandle;
    FSize:      Integer;
    FOptions:   TAllocationOptions;

    (* IMPLEMENTS:: IDataTransport *)
    function    dataGetSize:Integer;
    function    dataRead(const Offset:Integer;
                const ByteCount:Integer):TByteArray;
    procedure   dataWrite(const Offset:Integer;
                const Bytes:TByteArray);
    function    dataOffset:Integer;
  protected
    Procedure   HandleAllocated;virtual;
    Procedure   HandleReleased;virtual;
    function    getTotalSize:Integer;virtual;
    function    getSize:Integer;virtual;
    function    getBufferHandle:TBufferHandle;virtual;
    function    getHandle:TMemoryHandle;virtual;
  public
    Property    Options:TAllocationOptions read FOptions;
    Property    Empty:Boolean read (not (FHandle));
    property    Allocated:Boolean read ( (FHandle) );
    property    Handle:TMemoryHandle read getHandle;
    Property    Buffer:TBufferHandle read getBufferHandle;
    Property    Size:Integer read getSize;
    Property    TotalSize:Integer read getTotalSize;

    Procedure   Transport(const Target:IDataTransport);

    procedure   Allocate(Bytes:Integer);
    procedure   Release;
    procedure   Grow(const Bytes:Integer);
    procedure   Shrink(const Bytes:Integer);
    procedure   ReAllocate(Const NewSize:Integer);
    Constructor Create;virtual;
    Destructor  Destroy;Override;
  end;

  (*  TAllocationOptions defined caching options for TAllocation.
      Caching means that TAllocation will always allocate extra data which
      it uses for faster growth. So if you allocate 45 bytes and have a
      cache-size of 1024, the number of actual bytes allocated will be 1069.
      Once allocated, growth will take memory from the cache rather than
      re-allocate memory directly, which is much faster.
      After the initial allocation, only when the cache is exhausted will
      another allocation be performed *)
  TAllocationOptions = Class(TW3OwnedObject)
  private
    FUseCache:  Boolean;
    FCacheSize: Integer;
  protected
    Procedure setUseCache(const Value:Boolean);
    procedure setCacheSize(value:Integer);
    function  getCacheUsed:Integer;
    function  getCacheFree:Integer;
  public
    property    Owner: TAllocation read ( TAllocation(Inherited Owner) );
    Property    UseCache:Boolean read FUseCache write setuseCache;
    Property    CacheSize:Integer read FCacheSize write setCacheSize;
    Property    CacheUsed:Integer read getCacheUsed;
    Property    CacheFree:Integer read getCacheFree;
    constructor Create(AOwner: TAllocation); reintroduce;
  end;

  (* TAddress is a marshaled pointer type. JavaScript does not support
     pointers out of the box, so when dealing with memory allocations
     and offsets into such a buffer, which is what a pointer in essence
     represents -- you can replace FreePascal/Delphi pointer types with
     a marshaled pointer.

     Where you under FreePascal or Delphi would write:

        Move(Source^,target^,Size);

     Smart Pascal now supports:

        TMarshal.Move(TAddressSource.Create(FSource,0),
          TAddressTarget.Create(FTarget,0),FSource.Size);

     TMarshal supports variations of typical memory operations, both
     on the level of handle (TMemoryHandle) and TAddress pointers. *)
  EAddress  = Class(EW3Exception);
  TAddress  = partial class(TObject)
  private
    FOffset:    Integer;
    FBuffer:    TMemoryHandle;
  public
    Property    Entrypoint:Integer read FOffset;
    Property    Segment:TMemoryHandle read FBuffer;
    Property    Size:Integer read ( JArrayBuffer(FBuffer).byteLength );
    function    Addr(const Index:Integer):TAddress;
    Constructor Create(const aSegment:TMemoryHandle;
                const aEntrypoint:Integer);overload;virtual;
    Destructor  Destroy;Override;
  end;

  (* TUnmanaged is a static class with a collection of un-managed
     (non marshaled pointers) functions for allocating and accessing
     memory allocations. These are best suited for advanced users *)
  TUnManaged = Class static
  public
    class function  AllocMemA(const Size:Integer):TMemoryHandle;

    class procedure FreeMemA(const Memory:TMemoryHandle);

    class function  ReAllocMemA(Memory:TMemoryHandle;
                    Size:Integer):TMemoryHandle;

    class function  ReadMemoryA(const Memory:TMemoryHandle;
                    const Offset:Integer;
                    Size:Integer):TMemoryHandle;overload;

    class function  WriteMemoryA(const Memory:TMemoryHandle;
                    const Offset:Integer;
                    const Data:TMemoryHandle):Integer;

    class procedure FillMemoryA(const Memory:TMemoryHandle;
                    const Offset:Integer;
                    Size:Integer;
                    const Data:TMemoryHandle);
  end;

  (* TMarshal is a class which contains methods for allocating
     managed (marshaled) pointers, moving data quickly between memory
     segments - and also it provides some legacy methods from native
     object pascal, such as Move(), FillChar(), AllocMem() and FreeMem() *)
  TMarshal = class static
  public
    class property  UnManaged:TUnManaged;
    class function  AllocMem(const Size:Integer):TAddress;
    class procedure FreeMem(Const Segment:TAddress);

    class procedure Move(const Source:TAddress;
                    const Target:TAddress;
                    const Size:Integer);overload;

    class procedure Move(const Source:TMemoryHandle;
                    const SourceStart:Integer;
                    const Target:TMemoryHandle;
                    const TargetStart:Integer;
                    const Size:Integer);overload;

    class Procedure FillChar(const Target:TAddress;
                    const Size:Integer;
                    const Value:String);overload;

    class procedure FillChar(const Target:TAddress;
                    const Size:Integer;
                    const Value:Byte);overload;

    class procedure ReAllocMem(var Segment:TAddress;
                    const Size:Integer);

    class function  ReadMemory(const Segment:TAddress;
                    const Size:Integer):TByteArray;overload;

    class procedure WriteMemory(const Segment:TAddress;
                    const Data:TByteArray);

    class procedure Fill(Const Buffer:TMemoryHandle;Offset:Integer;
                    ByteLen:Integer;const Value:Byte);
  end;

implementation

//############################################################################
// TAllocationOptions
//############################################################################

constructor TAllocationOptions.Create(AOwner: TAllocation);
begin
  inherited Create(AOwner);
  FCacheSize:=4096;
  FUseCache:=true;
end;

function TAllocationOptions.getCacheFree:Integer;
begin
  result:=FCacheSize - getCacheUsed;
end;

function TAllocationOptions.getCacheUsed:Integer;
begin
  if FUseCache then
  result:=FCacheSize - (owner.Handle.length - owner.Size) else
  result:=0;
end;

Procedure TAllocationOptions.setUseCache(const Value:Boolean);
begin
  FUseCache:=Value;
end;

procedure TAllocationOptions.setCacheSize(value:Integer);
begin
  FCacheSize:=TInteger.EnsureRange(Value,1024,1024 * 1000);
end;

//############################################################################
// TAllocation
//############################################################################

Constructor TAllocation.Create;
Begin
  inherited Create;
  FOptions:=TAllocationOptions.Create(self);
end;

Destructor TAllocation.Destroy;
begin
  if (FHandle) then
  Release;
  FOptions.free;
  inherited;
end;

Procedure TAllocation.Transport(const Target:IDataTransport);
var
  mOffset:  Integer;
begin
  if assigned(target) then
  begin
    if not Empty then
    begin
      try
        mOffset:=Target.dataOffset;
        Target.dataWrite(mOffset,
        TDataType.TypedArrayToBytes(TW3DefaultBufferType(Handle)));
      except
        on e: exception do
        Raise EAllocation.CreateFmt
        ('Data transport failed, mechanism threw exception %s with error [%s]',
        [e.classname,e.message]);
      end;
    end;
  end else
  Raise EAllocation.Create
  ('Invalid transport interface, reference was NIL error');
end;

// INTERFACE: IDataTransport
function TAllocation.dataOffset:Integer;
begin
  result:=0;
end;

// INTERFACE: IDataTransport
function TAllocation.dataGetSize:Integer;
Begin
  result:=getSize;
end;

// INTERFACE: IDataTransport
function TAllocation.dataRead(const Offset:Integer;
         const ByteCount:Integer):TByteArray;
var
  mRef: TMemoryHandle;
begin
  mRef:=TUnManaged.ReadMemoryA(Handle,Offset,ByteCount);
  result:=TDatatype.TypedArrayToBytes(TW3DefaultBufferType(mRef));
end;

// INTERFACE: IDataTransport
procedure TAllocation.dataWrite(const Offset:Integer;
          const Bytes:TByteArray);
begin
  TUnManaged.WriteMemoryA(Handle,Offset,TDataType.BytesToTypedArray(Bytes));
end;

Procedure TAllocation.HandleAllocated;
begin
  // Decendants should override this method
end;

Procedure TAllocation.HandleReleased;
begin
  // Decendants should override this method
end;

procedure TAllocation.Allocate(Bytes:Integer);
var
  mSize:  Integer;
begin
  if (FHandle) then
  Release;

  if Bytes>0 then
  begin
    (* Round off to nearest factor of 16. This is required when
       working with pixel-buffers. And also faster to allocate *)
    mSize:=TInteger.ToNearest(Bytes,16);

    (* Allocate with cache? *)
    if FOptions.UseCache then
    inc(mSize,FOptions.CacheSize);

    FHandle:=TUnManaged.AllocMemA(mSize);
    FSize:=Bytes;
    HandleAllocated;
  end;
end;

procedure TAllocation.Release;
begin
  if (FHandle) then
  Begin
    FHandle.buffer:=NIL;
    FHandle:=null;
    FSize:=0;
    HandleReleased;
  end;
end;

procedure TAllocation.Grow(const Bytes:Integer);
begin
  if (FHandle) then
  Begin
    if FOptions.UseCache then
    begin
      if bytes < FOptions.CacheFree then begin inc(FSize,Bytes); exit; end else begin (* Cache exhausted, re-allocate *) ReAllocate(FSize+ Bytes); end; exit; end; (* No cache is used, simply grow the buffer *) inc(FSize,bytes); ReAllocate(FSize); end else allocate(bytes); end; procedure TAllocation.ReAllocate(const NewSize:Integer); var mSize: Integer; begin if (FHandle) then begin HandleReleased; (* Size in bytes *) mSize:=newSize; (* Allocate cache? *) if FOptions.UseCache then inc(mSize,FOptions.CacheSize); (* Re-allocate memory *) FHandle:=TUnManaged.ReAllocMemA(FHandle,mSize); (* Define size MINUS cache *) FSize:=newSize; end else Allocate(newSize); HandleAllocated; end; procedure TAllocation.Shrink(const Bytes:Integer); var mSize: Integer; begin if (FHandle) then begin (* Use memory caching? *) if FOptions.UseCache then begin (* How many bytes are left after scale? *) mSize:=TInteger.EnsureRange(getSize - bytes,0,MAX_INT); (* Data left to work with? *) if mSize>0 then
      begin

        (* More than defined-size PLUS cache? *)
        if mSize>(FSize + FOptions.CacheSize) then
        Begin
          (* Scale down to defined size, this retails data
             and also include the cache size *)
          ReAllocate(mSize);
        end else
        begin
          (* The data released is within the bounds of the
             defined cache size, so we simply adjust the exposed size *)
          FSize:=mSize;
        end;
      end else
      release;
      exit;
    end;

    mSize:=TInteger.EnsureRange(getSize - bytes,0,MAX_INT);
    if mSize>0 then
    ReAllocate(mSize) else
    Release;
  end;
end;

function TAllocation.getTotalSize:Integer;
begin
  if (FHandle) then
  result:=FHandle.length;
end;

function TAllocation.getSize:Integer;
begin
  result:=FSize;
end;

function TAllocation.getHandle:TMemoryHandle;
begin
  result:=FHandle;
end;

function TAllocation.getBufferHandle:TBufferHandle;
begin
  if (FHandle) then
  result:=FHandle.buffer else
  result:=null;
end;

//############################################################################
// TAbsolute
//############################################################################

class function TUnManaged.AllocMemA(const Size:Integer):TMemoryHandle;
begin
  if Size>0 then
  Result:=new TW3DefaultBufferType(Size) else
  result:=null;
end;

class procedure TUnManaged.FreememA(const Memory:TMemoryHandle);
begin
  if (memory) then
  begin
    // decouple buffer from type
    // this does not release memory, but "hints" to the GC
    // to mark the segment for level 1 release classification
    TW3DefaultBufferType(Memory).buffer := NIL;
  end;
end;

class function TUnManaged.ReAllocMemA(Memory:TMemoryHandle;
         Size:Integer):TMemoryHandle;
begin
  if (Memory) then
  begin
    if Size>0 then
    begin
      result:=new TW3DefaultBufferType(Size);
      TMarshal.Move(Memory,0,result,0,Size);
    end;
  end else
  result:=AllocMemA(Size);
end;

class procedure TUnManaged.FillMemoryA(const Memory:TMemoryHandle;
                const Offset:Integer;
                Size:Integer;
                const Data:TMemoryHandle);
var
  x:  Integer;
  mToWrite: Integer;
  mEnd: Integer;
begin
  if (memory) then
  Begin
    if offset>=0 then
    begin
      if offset<memory.length then
      begin
        if (data) then
        begin

          x:=offset;
          mEnd:=offset + Size-1;

          while x<mEnd do begin mToWrite:=Data.length; if (x + mToWrite-1) > mEnd then
            mToWrite:=(x + mToWrite-1) - mEnd;
            if mToWrite<1 then break; TMarshal.Move(Data,0,Memory,x,mToWrite); inc(x,mToWrite); end; end; end; end; end; end; class function TUnManaged.WriteMemoryA(const Memory:TMemoryHandle; const Offset:Integer; const Data:TMemoryHandle):Integer; var mTotal: Integer; begin if (Memory) then begin if (Data) then begin mTotal:=offset + data.length; if mTotal > memory.length then
      result:=memory.length-mTotal else
      result:=data.length;

      if result>0 then
      begin
        if offset + data.length <=memory.length then TW3DefaultBufferType(Memory).Set(JTypedArray(data),offset) else begin (* Copy range from source, this results in a new buffer *) var mChunk:=TW3DefaultBufferType(data).buffer.Slice(0,result-1); (* Create a typed array pointing to buffer *) var mTemp := new TW3DefaultBufferType( JTypedArray(mChunk) ); (* write memory from source to target *) TW3DefaultBufferType(Memory).Set(mTemp,offset); end; end; end; end; end; class function TUnManaged.ReadMemoryA(const Memory:TMemoryHandle; const Offset:Integer; Size:Integer):TMemoryHandle; var mTotal: Integer; begin if (Memory) then begin if Offset>=0 then
    begin
      mTotal:=offset + Size;
      if mTotal > memory.length then
      Size:=memory.length-mTotal;

      if Size>0 then
      result:=new TW3DefaultBufferType(JTypedArray(
      TW3DefaultBufferType(Memory).buffer.Slice(Offset,Size)));
    end;
  end;
end;

//############################################################################
// TMarshal
//############################################################################

class function TMarshal.ReadMemory(const Segment:TAddress;
               const Size:Integer):TByteArray;
var
  x:  Integer;
  mOffset:  Integer;
  mLongs: Integer;
  mHandle:  TW3DefaultBufferType;
Begin
  if  (segment<>NIL)
  and (size>0) then
  begin
    mHandle:=TW3DefaultBufferType( Segment.Segment );
    mOffset:=Segment.Entrypoint;

    mLongs:=Size shr 3;
    x:=0;
    while mLongs>0 do
    begin
      result.add ( mHandle[mOffset + x] ); inc(x);
      result.add ( mHandle[mOffset + x] ); inc(x);
      result.add ( mHandle[mOffset + x] ); inc(x);
      result.add ( mHandle[mOffset + x] ); inc(x);
      result.add ( mHandle[mOffset + x] ); inc(x);
      result.add ( mHandle[mOffset + x] ); inc(x);
      result.add ( mHandle[mOffset + x] ); inc(x);
      result.add ( mHandle[mOffset + x] ); inc(x);
      dec(mLongs);
    end;

    case Size mod 8 of
    1:  result.add ( mHandle[mOffset + x] );
    2:  begin
        result.add ( mHandle[mOffset + x] ); inc(x);
        result.add ( mHandle[mOffset + x] );
        end;
    3:  begin
        result.add ( mHandle[mOffset + x] ); inc(x);
        result.add ( mHandle[mOffset + x] ); inc(x);
        result.add ( mHandle[mOffset + x] );
        end;
    4:  begin
        result.add ( mHandle[mOffset + x] ); inc(x);
        result.add ( mHandle[mOffset + x] ); inc(x);
        result.add ( mHandle[mOffset + x] ); inc(x);
        result.add ( mHandle[mOffset + x] );
        end;
    5:  begin
        result.add ( mHandle[mOffset + x] ); inc(x);
        result.add ( mHandle[mOffset + x] ); inc(x);
        result.add ( mHandle[mOffset + x] ); inc(x);
        result.add ( mHandle[mOffset + x] ); inc(x);
        result.add ( mHandle[mOffset + x] );
        end;
    6:  begin
        result.add ( mHandle[mOffset + x] ); inc(x);
        result.add ( mHandle[mOffset + x] ); inc(x);
        result.add ( mHandle[mOffset + x] ); inc(x);
        result.add ( mHandle[mOffset + x] ); inc(x);
        result.add ( mHandle[mOffset + x] ); inc(x);
        result.add ( mHandle[mOffset + x] );
        end;
    7:  begin
        result.add ( mHandle[mOffset + x] ); inc(x);
        result.add ( mHandle[mOffset + x] ); inc(x);
        result.add ( mHandle[mOffset + x] ); inc(x);
        result.add ( mHandle[mOffset + x] ); inc(x);
        result.add ( mHandle[mOffset + x] ); inc(x);
        result.add ( mHandle[mOffset + x] ); inc(x);
        result.add ( mHandle[mOffset + x] );
        end;
    end;
  end;
end;

class procedure TMarshal.WriteMemory(const Segment:TAddress;
                const Data:TByteArray);
begin
  if  (Segment<>NIL)
  and (data.length>0) then
  JIntegerTypedArray(segment.Segment).Set(Data,segment.Entrypoint);
end;

class procedure TMarshal.FillChar(const Target:TAddress;
      const Size:Integer;
      const Value:Byte);
var
  mSegment: TW3DefaultBufferType;
  mIndex:   Integer;
Begin
  if Target<>NIl then
  begin
    mSegment:=TW3DefaultBufferType( Target.Segment );
    if VarIsValidRef(mSegment) then
    Begin
      mIndex:=Target.Entrypoint;
      TMarshal.Fill(Target.Segment,mIndex,Size,Value);
    end;
  end;
end;

class procedure TMarshal.Fill(Const Buffer:TMemoryHandle;Offset:Integer;
      ByteLen:Integer;const Value:Byte);
var
  mTotalSize: Integer;
  mTarget:    JDataView;
  mTemp:      TMemoryHandle;
  mLongs:     Integer;
  x:          Integer;
  mLongword:  Integer;
Begin
  if (buffer) then
  begin

    mTotalSize:=TW3DefaultBufferType(Buffer).byteLength;

    if  ( offset >=0 )
    and ( offset < mTotalSize) then begin (* clip the offset so we dont overload the buffer *) if offset + ByteLen > TW3DefaultBufferType(Buffer).byteLength then
      ByteLen:=mTotalSize - Offset;

      mTemp:=TUnManaged.AllocMemA(4);
      try
        (* Populate a longword with 4 bytes, so we can fill a longword
           for each write rather than a single byte *)
        mTemp[0]:=Value;
        mTemp[1]:=Value;
        mTemp[2]:=Value;
        mTemp[3]:=Value;


        (* Cache our 4-byte longword *)
        mLongword:=TDatatype.TypedArrayToUInt32(TW3DefaultBufferType(mTemp));

        (* setup a dataview for the target *)
        asm
          @mTarget = new DataView((@Buffer).buffer);
        end;

        (* We will be setting 4 bytes per write, 32 bytes per loop *)
        x:=Offset;
        mLongs:=ByteLen shr 5;

        while mLongs>0 do
        begin
          mTarget.setUint32(x,mLongword,CNT_LittleEndian);inc(x,4);
          mTarget.setUint32(x,mLongword,CNT_LittleEndian);inc(x,4);
          mTarget.setUint32(x,mLongword,CNT_LittleEndian);inc(x,4);
          mTarget.setUint32(x,mLongword,CNT_LittleEndian);inc(x,4);
          mTarget.setUint32(x,mLongword,CNT_LittleEndian);inc(x,4);
          mTarget.setUint32(x,mLongword,CNT_LittleEndian);inc(x,4);
          mTarget.setUint32(x,mLongword,CNT_LittleEndian);inc(x,4);
          mTarget.setUint32(x,mLongword,CNT_LittleEndian);inc(x,4);
          dec(mLongs);
        end;

        mLongs:=ByteLen mod 32;
        while mLongs>0 do
        begin
          mTarget.setUint8(x,Value);inc(x);
          dec(mLongs);
        end;

      finally
        mTemp.free;
      end;
    end;
  end;
end;

class Procedure TMarshal.FillChar(const Target:TAddress;
      const Size:Integer;
      const Value:String);
var
  mSegment: TW3DefaultBufferType;
  mByte:    Byte;
Begin
  if Target<>NIl then
  begin
    if Value.length>0 then
    begin
      mByte:=TDataType.CharToByte(Value);
      mSegment:=TW3DefaultBufferType( Target.Segment );
      if VarIsValidRef(mSegment) then
      Fill(Target.Segment,Target.Entrypoint,Size, mByte);
    end;
  end;
end;

class procedure TMarshal.Move( const Source:TMemoryHandle;
                          const SourceStart:Integer;
                          const Target:TMemoryHandle;
                          const TargetStart:Integer;
                          const Size:Integer);
var
  mRef:TW3DefaultBufferType;
Begin
  if  Source.valid
  and (SourceStart>=0)
  and Target.valid
  and (TargetStart>=0)
  and (Size>0) then
  begin
    (* Copy memory to move into sub-array *)
    mRef:=TW3DefaultBufferType(Source).SubArray(SourceStart,SourceStart+Size);

    (* Write memory to buffer *)
    TW3DefaultBufferType(Target).Set(mRef,TargetStart);
  end;
end;

class procedure TMarshal.Move(const Source:TAddress;
          const Target:TAddress;const Size:Integer);
Begin
  if Source<>NIL then
  Begin
    if Target<>NIl then
    begin
      if Size>0 then
      Move(Source.segment,Source.Entrypoint,
      target.segment,target.entrypoint,Size);
    end;
  end;
end;

class procedure TMarshal.ReAllocmem(var Segment:TAddress;
                const Size:Integer);
var
  mTemp:  TAddress;
  mSize:  Integer;
begin
  if segment<>NIL then
  begin
    mSize:=TW3DefaultBufferType(segment.Segment).length;

    mTemp:=AllocMem(Size);

    case (Size>mSize) of
    true:   move(segment,mtemp,mSize);
    false:  move(segment,mTemp,Size);
    end;

    SegMent.free;
    Segment:=NIL;

    Segment:=mTemp;
  end else
  SegMent:=AllocMem(Size);
end;

class function TMarshal.AllocMem(Const Size:Integer):TAddress;
var
  mBuffer:  JArrayBuffer;
  mArray:   TW3DefaultBufferType;
begin
  result:=NIL;
  if Size>0 then
  Begin
    mBuffer :=  new JArrayBuffer(Size);
    mArray  :=  new TW3DefaultBufferType(mBuffer,0,Size);
    result  :=  TAddress.Create(mArray,0);
  end;
end;

class procedure TMarshal.FreeMem(Const Segment:TAddress);
begin
  if Segment<>NIL then
  Segment.free;
end;

//############################################################################
// TAddress
//############################################################################

Constructor TAddress.Create(const aSegment:TMemoryHandle;
            const aEntrypoint:Integer);
begin
  inherited Create;
  if aSegment.defined
  and aSegment.valid then
  FBuffer:=aSegment else
  Raise EAddress.Create('Failed to derive address, invalid segment error');

  if aEntryPoint>=0 then
  FOffset:=aEntryPoint else
  Raise EAddress.Create('Failed to derive address, invalid entrypoint error');
end;

Destructor TAddress.Destroy;
begin
  FBuffer:=NIL;
  FOffset:=0;
  inherited;
end;

function TAddress.Addr(const Index:Integer):TAddress;
var
  mTarget:  Integer;
begin
  if Index >= 0 then
  Begin
    mTarget:=FOffset + Index;
    if (mTarget>=0) and (mTarget < TW3DefaultBufferType(FBuffer).byteLength) then
    result:=TAddress.Create(FBuffer,mTarget) else
    raise EAddress.Create
    ('Failed to derive address, entrypoint exceeds segment bounds error');
  end else
  Raise EAddress.Create
  ('Failed to derive address, invalid entrypoint error');
end;


end.

Advertisements
  1. No comments yet.
  1. No trackbacks yet.

Leave a Reply

Please log in using one of these methods to post your comment:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

%d bloggers like this: