development/compilers/freepascal/rtl/go32v2/dxeload.pp

   1 {
   2     $Id$
   3     This file is part of the Free Pascal run time library.
   4     Copyright (c) 1999-2000 by Pierre Muller,
   5     member of the Free Pascal development team.
   6
   7     Unit to Load DXE files for Go32V2
   8
   9     See the file COPYING.FPC, included in this distribution,
  10     for details about the copyright.
  11
  12     This program is distributed in the hope that it will be useful,
  13     but WITHOUT ANY WARRANTY; without even the implied warranty of
  14     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  15
  16  **********************************************************************
  17 }
  18
  19
  20 Unit dxeload;
  21 interface
  22
  23 const
  24    DXE_MAGIC  = $31455844;
  25 type
  26   dxe_header = record
  27      magic,
  28      symbol_offset,
  29      element_size,
  30      nrelocs       : cardinal;
  31   end;
  32
  33 function dxe_load(filename : string) : pointer;
  34
  35 implementation
  36
  37 function dxe_load(filename : string) : pointer;
  38 {
  39   Copyright (C) 1995 Charles Sandmann (sandmann@clio.rice.edu)
  40   translated to Free Pascal by Pierre Muller
  41 }
  42 type
  43   { to avoid range check problems }
  44   pointer_array = array[0..maxlongint] of pointer;
  45   tpa = ^pointer_array;
  46   plongint = ^longint;
  47   pcardinal = ^cardinal;
  48   ppointer = ^pointer;
  49 var
  50   dh     : dxe_header;
  51   data   : pchar;
  52   f      : file;
  53   relocs : tpa;
  54   i      : longint;
  55   addr   : pcardinal;
  56 begin
  57    dxe_load:=nil;
  58 { open the file }
  59    assign(f,filename);
  60 {$I-}
  61    reset(f,1);
  62 {$I+}
  63    { quit if no file !! }
  64    if ioresult<>0 then
  65      exit;
  66 { load the header }
  67    blockread(f,dh,sizeof(dxe_header),i);
  68    if (i<>sizeof(dxe_header)) or (dh.magic<>DXE_MAGIC) then
  69      begin
  70         close(f);
  71         exit;
  72      end;
  73 { get memory for code }
  74    getmem(data,dh.element_size);
  75    if data=nil then
  76      exit;
  77 { get memory for relocations }
  78    getmem(relocs,dh.nrelocs*sizeof(pointer));
  79    if relocs=nil then
  80      begin
  81         freemem(data,dh.element_size);
  82         exit;
  83      end;
  84 { copy code }
  85    blockread(f,data^,dh.element_size);
  86    blockread(f,relocs^,dh.nrelocs*sizeof(pointer));
  87    close(f);
  88 { relocate internal references }
  89    for i:=0 to dh.nrelocs-1 do
  90      begin
  91         cardinal(addr):=cardinal(data)+cardinal(relocs^[i]);
  92         addr^:=addr^+cardinal(data);
  93      end;
  94    dxe_load:=pointer( dh.symbol_offset + cardinal(data));
  95 end;
  96
  97 end.
  98 {
  99   $Log$
 100   Revision 1.1  2002/02/19 08:25:08  sasu
 101   Initial revision
 102
 103   Revision 1.1.2.1  2000/12/10 23:03:31  pierre
 104    * avoid the longint + cardinal to int64 conversion
 105
 106   Revision 1.1  2000/07/13 06:30:37  michael
 107   + Initial import
 108
 109   Revision 1.5  2000/05/29 05:32:50  jonas
 110     * should compile again
 111
 112   Revision 1.4  2000/02/09 16:59:28  peter
 113     * truncated log
 114
 115   Revision 1.3  2000/01/07 16:41:31  daniel
 116     * copyright 2000
 117
 118   Revision 1.2  2000/01/07 16:32:23  daniel
 119     * copyright 2000 added
 120
 121 }