← Back to branch summary

~ubuntu-branches/debian/lenny/fpc/lenny

« back to all changes in this revision

Viewing changes to fpcsrc/rtl/go32v2/dxeload.pp

  • Committer: Bazaar Package Importer
  • Author(s): Mazen Neifer, Torsten Werner, Mazen Neifer
  • Date: 2008-05-17 17:12:11 UTC
  • mfrom: (3.1.9 intrepid)
  • Revision ID: james.westby@ubuntu.com-20080517171211-9qi33xhd9evfa0kg
Tags: 2.2.0-dfsg1-9
http://bugs.debian.org/477743
[ Torsten Werner ]
* Add Mazen Neifer to Uploaders field.

[ Mazen Neifer ]
* Moved FPC sources into a version dependent directory from /usr/share/fpcsrc
  to /usr/share/fpcsrc/${FPCVERSION}. This allow installing more than on FPC
  release.
* Fixed far call issue in compiler preventing building huge binearies.
  (closes: #477743)
* Updated building dependencies, recomennded and suggested packages.
* Moved fppkg to fp-utils as it is just a helper tool and is not required by
  compiler.

Show diffs side-by-side

added added

removed removed

Lines of Context:
fpcsrc/rtl/go32v2/dxeload.pp
 
1
{
 
2
    This file is part of the Free Pascal run time library.
 
3
    Copyright (c) 1999-2000 by Pierre Muller,
 
4
    member of the Free Pascal development team.
 
5
 
 
6
    Unit to Load DXE files for Go32V2
 
7
 
 
8
    See the file COPYING.FPC, included in this distribution,
 
9
    for details about the copyright.
 
10
 
 
11
    This program is distributed in the hope that it will be useful,
 
12
    but WITHOUT ANY WARRANTY; without even the implied warranty of
 
13
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
14
 
 
15
 **********************************************************************
 
16
}
 
17
 
 
18
 
 
19
Unit dxeload;
 
20
interface
 
21
 
 
22
function dxe_load(filename : string) : pointer;
 
23
 
 
24
implementation
 
25
 
 
26
uses
 
27
 dxetype;
 
28
 
 
29
function dxe_load(filename : string) : pointer;
 
30
{
 
31
  Copyright (C) 1995 Charles Sandmann (sandmann@clio.rice.edu)
 
32
  translated to Free Pascal by Pierre Muller
 
33
}
 
34
type
 
35
  { to avoid range check problems }
 
36
  pointer_array = array[0..maxlongint div sizeof(pointer)-1] of pointer;
 
37
  tpa = ^pointer_array;
 
38
var
 
39
  dh     : dxe_header;
 
40
  data   : pchar;
 
41
  f      : file;
 
42
  relocs : tpa;
 
43
  i      : longint;
 
44
  addr   : pcardinal;
 
45
begin
 
46
   dxe_load:=nil;
 
47
{ open the file }
 
48
   assign(f,filename);
 
49
{$I-}
 
50
   reset(f,1);
 
51
{$I+}
 
52
   { quit if no file !! }
 
53
   if ioresult<>0 then
 
54
     exit;
 
55
{ load the header }
 
56
   blockread(f,dh,sizeof(dxe_header),i);
 
57
   if (i<>sizeof(dxe_header)) or (dh.magic<>DXE_MAGIC) then
 
58
     begin
 
59
        close(f);
 
60
        exit;
 
61
     end;
 
62
{ get memory for code }
 
63
   getmem(data,dh.element_size);
 
64
   if data=nil then
 
65
     exit;
 
66
{ get memory for relocations }
 
67
   getmem(relocs,dh.nrelocs*sizeof(pointer));
 
68
   if relocs=nil then
 
69
     begin
 
70
        freemem(data,dh.element_size);
 
71
        exit;
 
72
     end;
 
73
{ copy code }
 
74
   blockread(f,data^,dh.element_size);
 
75
   blockread(f,relocs^,dh.nrelocs*sizeof(pointer));
 
76
   close(f);
 
77
{ relocate internal references }
 
78
   for i:=0 to dh.nrelocs-1 do
 
79
     begin
 
80
        cardinal(addr):=cardinal(data)+cardinal(relocs^[i]);
 
81
        addr^:=addr^+cardinal(data);
 
82
     end;
 
83
   FreeMem(relocs,dh.nrelocs*sizeof(pointer));
 
84
   dxe_load:=pointer( dh.symbol_offset + cardinal(data));
 
85
end;
 
86
 
 
87
end.