← Back to branch summary

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

« back to all changes in this revision

Viewing changes to fpcsrc/utils/simulator/fastmm64.pas

  • 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/utils/simulator/fastmm64.pas
 
1
{
 
2
    This file is part of the Free Pascal simulator environment
 
3
    Copyright (c) 1999-2000 by Florian Klaempfl
 
4
 
 
5
    This unit implemements a memory manager for 64 bit processor
 
6
    simulations, it needs a 32 bit compiler to be compiled
 
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
{$N+}
 
17
unit fastmm64;
 
18
 
 
19
  interface
 
20
 
 
21
    uses
 
22
       simbase;
 
23
 
 
24
    type
 
25
       taddr = qword;
 
26
 
 
27
       tmemorymanager = object
 
28
          mem : array[0..65535] of pbyte;
 
29
          constructor init;
 
30
          { "memory" access routines }
 
31
          function readalignedq(addr : taddr) : qword;
 
32
          function readq(addr : taddr) : qword;
 
33
          function readalignedd(addr : taddr) : dword;
 
34
          function readd(addr : taddr) : dword;
 
35
          function readb(addr : taddr) : dword;
 
36
          procedure writeb(addr : taddr;b : byte);
 
37
          procedure writealignedd(addr : taddr;d : dword);
 
38
          procedure writed(addr : taddr;d : dword);
 
39
          procedure writeq(addr : taddr;q : qword);
 
40
          procedure allocate(addr : taddr;size : qword);
 
41
       end;
 
42
 
 
43
    var
 
44
       { address of the currently executed instruction, }
 
45
       { necessary for correct output of exception      }
 
46
       instructionpc : taddr;
 
47
 
 
48
  implementation
 
49
 
 
50
    procedure exception(const s : string;addr : taddr);
 
51
 
 
52
      begin
 
53
         writeln;
 
54
         writeln('Exception: ',s,' at $',qword2str(addr));
 
55
         runerror(255);
 
56
         stopsim;
 
57
      end;
 
58
 
 
59
    constructor tmemorymanager.init;
 
60
 
 
61
      begin
 
62
         fillchar(mem,sizeof(mem),0);
 
63
      end;
 
64
 
 
65
    procedure tmemorymanager.allocate(addr : taddr;size : qword);
 
66
 
 
67
      procedure allocateblock(addr : taddr);
 
68
 
 
69
        var
 
70
           upperbits : longint;
 
71
 
 
72
        begin
 
73
           if (tqwordrec(addr).high32 and $fffffff0)<>0 then
 
74
             begin
 
75
                writeln('This memory manager supports only 36 bit');
 
76
                writeln('Base address was ',qword2str(addr));
 
77
                halt(1);
 
78
             end;
 
79
           upperbits:=((tqwordrec(addr).high32 and $f) shl 12) or ((tqwordrec(addr).low32 and $fff) shr 20);
 
80
           if not(assigned(mem[upperbits])) then
 
81
             begin
 
82
                getmem(mem[upperbits],1024*1024);
 
83
                fillchar(mem[upperbits]^,1024*1024,0);
 
84
             end;
 
85
        end;
 
86
 
 
87
      var
 
88
         asize : qword;
 
89
 
 
90
      begin
 
91
         while size>0 do
 
92
           begin
 
93
              if size>1024*1024 then
 
94
                asize:=1024*1024;
 
95
              allocateblock(addr);
 
96
              if asize>size then
 
97
                break;
 
98
              size:=size-asize;
 
99
              addr:=addr+asize;
 
100
           end;
 
101
      end;
 
102
 
 
103
    function tmemorymanager.readq(addr : taddr) : qword;
 
104
 
 
105
      var
 
106
         h : qword;
 
107
 
 
108
      begin
 
109
         tqwordrec(h).low32:=readd(addr);
 
110
         tqwordrec(h).high32:=readd(addr+4);
 
111
         readq:=h;
 
112
      end;
 
113
 
 
114
    function tmemorymanager.readd(addr : taddr) : dword;
 
115
 
 
116
      begin
 
117
         readd:=readb(addr)+readb(addr+1) shl 8+readb(addr+2) shl 16+
 
118
           readb(addr+3) shl 24;
 
119
      end;
 
120
 
 
121
    function tmemorymanager.readalignedd(addr : taddr) : dword;
 
122
 
 
123
      var
 
124
         upperbits : longint;
 
125
 
 
126
      begin
 
127
         if (tqwordrec(addr).low32 and $3)<>0 then
 
128
           exception('Alignment violation (dword) to $'+qword2str(addr),instructionpc);
 
129
         upperbits:=((tqwordrec(addr).high32 and $f) shl 12) or ((tqwordrec(addr).low32 and $fff) shr 20);
 
130
         if not(assigned(mem[upperbits])) then
 
131
           exception('Access violation to $'+qword2str(addr),instructionpc);
 
132
         readalignedd:=pdword(mem[upperbits])[(tqwordrec(addr).low32 and $fffff) shr 2];
 
133
      end;
 
134
 
 
135
    function tmemorymanager.readalignedq(addr : taddr) : qword;
 
136
 
 
137
      var
 
138
         upperbits : longint;
 
139
 
 
140
      begin
 
141
         if (tqwordrec(addr).low32 and $7)<>0 then
 
142
           exception('Alignment violation (dword) to $'+qword2str(addr),instructionpc);
 
143
         upperbits:=((tqwordrec(addr).high32 and $f) shl 12) or ((tqwordrec(addr).low32 and $fff) shr 20);
 
144
         if not(assigned(mem[upperbits])) then
 
145
           exception('Access violation to $'+qword2str(addr),instructionpc);
 
146
         readalignedq:=pqword(mem[upperbits])[(tqwordrec(addr).low32 and $fffff) shr 3];
 
147
      end;
 
148
 
 
149
    function tmemorymanager.readb(addr : taddr) : dword;
 
150
 
 
151
      var
 
152
         upperbits : longint;
 
153
 
 
154
      begin
 
155
         upperbits:=((tqwordrec(addr).high32 and $f) shl 12) or ((tqwordrec(addr).low32 and $fff) shr 20);
 
156
         if not(assigned(mem[upperbits])) then
 
157
           exception('Access violation to $'+qword2str(addr),instructionpc);
 
158
         readb:=mem[upperbits,tqwordrec(addr).low32 and $fffff];
 
159
      end;
 
160
 
 
161
    procedure tmemorymanager.writeb(addr : taddr;b : byte);
 
162
 
 
163
      var
 
164
         upperbits : longint;
 
165
 
 
166
      begin
 
167
         upperbits:=((tqwordrec(addr).high32 and $f) shl 12) or ((tqwordrec(addr).low32 and $fff) shr 20);
 
168
         if not(assigned(mem[upperbits])) then
 
169
           exception('Access violation to $'+qword2str(addr),instructionpc);
 
170
         mem[upperbits,tqwordrec(addr).low32 and $fffff]:=b;
 
171
      end;
 
172
 
 
173
    procedure tmemorymanager.writealignedd(addr : taddr;d : dword);
 
174
 
 
175
      var
 
176
         upperbits : longint;
 
177
 
 
178
      begin
 
179
         if (tqwordrec(addr).low32 and $3)<>0 then
 
180
           exception('Alignment violation (dword) to $'+qword2str(addr),instructionpc);
 
181
         upperbits:=((tqwordrec(addr).high32 and $f) shl 12) or ((tqwordrec(addr).low32 and $fff) shr 20);
 
182
         if not(assigned(mem[upperbits])) then
 
183
           exception('Access violation to $'+qword2str(addr),instructionpc);
 
184
         pdword(mem[upperbits])[(tqwordrec(addr).low32 and $fffff) shr 2]:=d;
 
185
      end;
 
186
 
 
187
    procedure tmemorymanager.writed(addr : taddr;d : dword);
 
188
 
 
189
      begin
 
190
         writeb(addr,tdword(d)[0]);
 
191
         writeb(addr+1,tdword(d)[1]);
 
192
         writeb(addr+2,tdword(d)[2]);
 
193
         writeb(addr+3,tdword(d)[3]);
 
194
      end;
 
195
 
 
196
    procedure tmemorymanager.writeq(addr : taddr;q : qword);
 
197
 
 
198
      begin
 
199
         writed(addr,tqwordrec(q).low32);
 
200
         writed(addr+4,tqwordrec(q).high32);
 
201
      end;
 
202
 
 
203
end.