[Back to MEMORY SWAG index] [Back to Main SWAG index] [Original]

    { Borland Pascal Extended Function Library - EFLIB (C) Johan Larsson, 1996
      Memory engine; handles allocation of data blocks; rewritten Usenet version

      EFLIB IS PROTECTED BY THE COPYRIGHT LAW AND MAY NOT BE COPIED, SOLD OR
      MANIPULATED. FOR MORE INFORMATION, SEE PROGRAM MANUAL!

      THIS IS A SPECIAL RELEASE OF EFLIBS MEMORY ENGINE TO BE PUBLISHED
      IN USENET / SWAGS. THE SOURCE CODE MAY FREELY BE USED NON-COMMERCIALY AS
      LONG AS CREDIT IS GIVEN TO THE PROGRAMMER. THIS UNIT IS INDEPENDENT OF
      OTHER EFLIB COMPONENTS AND DO NOT CONTAIN ALL THE FEATURES INCLUDED
      IN THE REAL VERSION.

      EFLIB is a free OOP toolkit for Borland Pascal. It's free for non-
      commerical use only, and not for business or educational use. EFLIB
      is available through Internet at http://www.ts.umu.se/~jola/EFLIB/.
      Johan Larsson can be reached via E-MAIL (jola@ts.umu.se) or common
      mail (Istidsgatan 33, 2tr., S-906 55 UMEA, Sweden). }

    unit EFLIBMEM;

    INTERFACE

    type { Object that handles a dynamic DOS memory allocation }
         AllocationObjectPointerType       = ^AllocationObjectType;
         AllocationObjectType              = object
                                                 public
                                                   { Constructors and destructors }
                                                   constructor Initialize (ThisSize : word);           { Initializes object }
                                                   constructor InitializeEmpty;                        { Initializes empty object }
                                                   destructor Intercept; virtual;                      { Intercepts object }
                                                   { Miscellaneous methods }
                                                   procedure Allocate (ThisSize : word); virtual;      { Allocates memory (bytes) }
                                                   procedure Dispose; virtual;                         { Disposes memory }
                                                   { Transferration methods }
                                                   procedure MoveIn (Source : pointer; SourceSize,
                                                             Position : word); virtual;                { Moves data into object }
                                                   procedure MoveOut (Destination : pointer;
                                                             DestinationSize, Position : word);
                                                             virtual;                                  { Moves data out of object }
                                                   { Data access methods }
                                                   function DataPointer (Position : word) : pointer;   { Returns a data pointer }
                                                            virtual;
                                                   function DataSize : word; virtual;                  { Returns the data size }
                                                   { Status methods }
                                                   function IsAllocated : boolean;                     { Is memory allocated? }
                                                 private
                                                   { Fields }
                                                   Data             : pointer;                         { Data allocation pointer }
                                                   Size             : word;                            { Data size in bytes }
                                                   { Internal methods }
                                                   procedure Clear; virtual;                           { Clear memory }
                                                   procedure Error; virtual;                           { Error handler }
                                             end;

    { This unit should compile in both real mode and protected mode Borland
      Pascal, but in protected mode, the following procedures must be
      replaced; }

    procedure MoveFAST (var Source, Target; Size : word);
    procedure FillWord (var Destination; Count, Data : word);

    IMPLEMENTATION

    {$B-} {$IFNDEF DEBUG} {$I-} {$S-} {$R-} {$Q-} {$ENDIF}

    { *** AllocationObjectType *** }

    { Initializes object and allocate specified bytes of memory }
    constructor AllocationObjectType.Initialize (ThisSize : word);
    begin
         { Prepare object (reset fields) }
         InitializeEmpty;
         { Allocate ThisSize number of bytes on the heap }
         Allocate (ThisSize);
    end;

    { Initializes object without any data }
    constructor AllocationObjectType.InitializeEmpty;
    begin
         { Clear allocation variable and reset links }
         Data := NIL; Size := 0;
    end;

    { Intercepts object }
    destructor AllocationObjectType.Intercept;
    begin
         { Dispose allocated data }
         if IsAllocated then Dispose;
    end;

    { Allocate memory into AllocationObjectType }
    procedure AllocationObjectType.Allocate (ThisSize : word);
    begin
         { Allocate memory on the heap }
         GetMem (Data, ThisSize);
         Size := ThisSize; { Adjust size variable }
    end;

    { Dispose memory from AllocationObjectType }
    procedure AllocationObjectType.Dispose;
    begin
         { Dispose memory from the heap }
         if Assigned(Data) then FreeMem (Data, Size);
         { Reset fields }
         Data := NIL; Size := 0;
    end;

    { Move a data block into object data block }
    procedure AllocationObjectType.MoveIn (Source : pointer; SourceSize, Position : word);
    begin
         { Check that data pointer isn't NIL }
         if Assigned(Source) then begin
            { Allocate data if no allocation exists }
            if not IsAllocated then Allocate (SourceSize);

            { Move data from source to current object (prevent overflow) }
            if IsAllocated and (Size >= SourceSize + Position) then
               MoveFAST (Source^, DataPointer(Position)^, SourceSize)
               else Error; { Error; fatal memory allocation error }
          end else Error; { Error; couldn't access data resource }
    end;

    { Move data out of object data block }
    procedure AllocationObjectType.MoveOut (Destination : pointer; DestinationSize, Position : word);
    begin
         if Assigned(Destination) then { Check that destination is valid }
            MoveFAST (DataPointer(Position)^, Destination^, DestinationSize)
         else Error; { Error; couldn't access data resource }
    end;

    { Returns a pointer to a byte inside allocated data or NIL if no allocation
      exists. }
    function AllocationObjectType.DataPointer (Position : word) : pointer;
    begin
         if IsAllocated then DataPointer := Ptr(Seg(Data^), Ofs(Data^) + Position)
            else DataPointer := NIL; { No allocation exists! }
    end;

    { Returns the size of the allocated data }
    function AllocationObjectType.DataSize : word;
    begin
         if IsAllocated then DataSize := Size else DataSize := 0;
    end;

    { Returns TRUE if AllocationObjectType contains an allocated pointer }
    function AllocationObjectType.IsAllocated : boolean;
    begin
         IsAllocated := Assigned(Data) and (Size > 0);
    end;

    { Clear allocated memory (set all bytes to zero) }
    procedure AllocationObjectType.Clear;
    begin
         if IsAllocated then FillChar (Data, Size, 0)
            else Error; { Error; no allocation exists }
    end;

    { Method for memory allocation error handling }
    procedure AllocationObjectType.Error;
    begin
         RunError (203);
    end;

    { Fast 16-bit memory moving routine with overlap protection. Performance
      is about 36% better than Borland Pascal 7.0's internal memory moving
      routine. }
    procedure MoveFAST (var Source, Target; Size : word); assembler;
    asm
       PUSH    DS
       PUSH    ES
       LDS     SI, Source
       LES     DI, Target
       MOV     CX, Size
       CLD
       { If an overlap of source and target occurs, copy data backwards }
       CMP     SI, DI
       JAE     @2
       ADD     SI, CX
       ADD     DI, CX
       DEC     SI
       DEC     DI
       STD
       SHR     CX, 1
       JAE     @1
       MOVSB
       @1:
       DEC     SI
       DEC     DI
       JMP     @3
       @2:
       SHR     CX, 1
       JNC     @3
       MOVSB
       @3:
       REP     MOVSW
       POP     ES
       POP     DS
    end;

    { Fills a variable with word-sized data }
    procedure FillWord (var Destination; Count, Data : word); assembler;
    asm
       LES  DI, Destination
       MOV  CX, Count
       MOV  AX, Data
       CLD
       REP  STOSW
    end;

    end. { unit }

[Back to MEMORY SWAG index] [Back to Main SWAG index] [Original]