labradmemorytools.pas

As science advances, novel experiments are becoming more and more complex, requiring a zoo of contro

{ Copyright (C) 2007 Markus Ansmann
 
  This program is free software: you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation, either version 2 of the License, or
  (at your option) any later version.
 
  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.
 
  You should have received a copy of the GNU General Public License
  along with this program.  If not, see <http://www.gnu.org/licenses/>.  }

{
 TODO:

  - Verify
  - Document
}

unit LabRADMemoryTools;

interface

 uses
  LabRADTypeTree;

  procedure LabRADZeroData(DataPtr: PByte; Node: PLabRADTypeTreeNode);
  procedure LabRADFreeData(DataPtr: PByte; Node: PLabRADTypeTreeNode);

implementation

procedure LabRADZeroData(DataPtr: PByte; Node: PLabRADTypeTreeNode);
var NewPtr: PByte;
begin
  case Node.NodeType of
   ntCluster:
    begin
      Node:=Node.Down;
      while assigned(Node) do begin
        LabRADZeroData(DataPtr, Node);
        inc(DataPtr, Node.DataSize);
        Node:=Node.Right;
      end;
    end;
   ntString:
    begin
      GetMem  (NewPtr,  4);
      FillChar(NewPtr^, 4, 0);
      move(NewPtr, DataPtr^, 4);
    end;
   ntArray:
    begin
      GetMem  (NewPtr,  4*Node.Dimensions);
      FillChar(NewPtr^, 4*Node.Dimensions, 0);
      move(NewPtr, DataPtr^, 4);
    end;
   else
    FillChar(DataPtr^, Node.DataSize, 0);
  end;
end;

procedure LabRADFreeDataInt(DataPtr: PByte; Node: PLabRADTypeTreeNode);
var Sizes:  array of integer;
    OldPtr: PByte;
    Count:  integer;
    a:      integer;
begin
  case Node.NodeType of
   ntCluster:
    begin
      Node:=Node.Down;
      while assigned(Node) do begin
        LabRADFreeDataInt(DataPtr, Node);
        inc(DataPtr, Node.DataSize);
        Node:=Node.Right;
      end;
    end;
   ntString:
    begin
      OldPtr:=DataPtr;
      move(DataPtr^, DataPtr, 4);
      FillChar(OldPtr^, 4, 0);
      FreeMem(DataPtr);
    end;
   ntArray:
    begin
      OldPtr:=DataPtr;
      move(DataPtr^, DataPtr, 4);
      FillChar(OldPtr^, 4, 0);
      setlength(Sizes, Node.Dimensions);
      move(DataPtr^, Sizes[0], 4*Node.Dimensions);
      OldPtr:=DataPtr;
      inc(DataPtr, 4*Node.Dimensions);
      Count:=1;
      for a:=0 to Node.Dimensions-1 do Count:=Count*Sizes[a];
      Node:=Node.Down;
      for a:=1 to Count do begin
        LabRADFreeDataInt(DataPtr, Node);
        inc(DataPtr, Node.DataSize);
      end;
      FreeMem(OldPtr);
    end;
  end;
end;

procedure LabRADFreeData(DataPtr: PByte; Node: PLabRADTypeTreeNode);
begin
  LabRADFreeDataInt(DataPtr, Node);
  FreeMem(DataPtr);
end;

end.