← Back to branch summary

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

« back to all changes in this revision

Viewing changes to fpcsrc/utils/simulator/mm64.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/mm64.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 works also with TP
 
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
{ a simple 64 bit simulator memory manager, also running with TP }
 
17
{$N+}
 
18
unit mm64;
 
19
 
 
20
  interface
 
21
 
 
22
    uses
 
23
       simbase;
 
24
 
 
25
    const
 
26
       memoryblocksize = 32768;
 
27
 
 
28
    type
 
29
       taddr = qword;
 
30
       tmemoryblock = array[0..memoryblocksize-1] of byte;
 
31
       pmemoryblock = ^tmemoryblock;
 
32
 
 
33
       pmemoryarea = ^tmemoryarea;
 
34
       tmemoryarea = record
 
35
         addr : qword;
 
36
         memory : pmemoryblock;
 
37
         size : dword;
 
38
         next : pmemoryarea;
 
39
       end;
 
40
 
 
41
       tmemorymanager = object
 
42
          mem : pmemoryarea;
 
43
          constructor init;
 
44
          { "memory" access routines }
 
45
          function readalignedq(addr : taddr) : qword;
 
46
          function readq(addr : taddr) : qword;
 
47
          function readalignedd(addr : taddr) : dword;
 
48
          function readd(addr : taddr) : dword;
 
49
          function readb(addr : taddr) : dword;
 
50
          procedure writeb(addr : taddr;b : byte);
 
51
          procedure writealignedd(addr : taddr;d : dword);
 
52
          procedure writed(addr : taddr;d : dword);
 
53
          procedure writeq(addr : taddr;q : qword);
 
54
          procedure allocate(addr : taddr;size : qword);
 
55
       end;
 
56
 
 
57
    var
 
58
       { address of the currently executed instruction, }
 
59
       { necessary for correct output of exception      }
 
60
       instructionpc : taddr;
 
61
 
 
62
  implementation
 
63
 
 
64
    procedure exception(const s : string;addr : taddr);
 
65
 
 
66
      begin
 
67
         writeln;
 
68
         writeln('Exception: ',s,' at $',qword2str(addr));
 
69
         stopsim;
 
70
      end;
 
71
 
 
72
    constructor tmemorymanager.init;
 
73
 
 
74
      begin
 
75
         mem:=nil;
 
76
      end;
 
77
 
 
78
    procedure tmemorymanager.allocate(addr : taddr;size : qword);
 
79
 
 
80
      var
 
81
         ma : pmemoryarea;
 
82
         asize : qword;
 
83
 
 
84
      begin
 
85
         while size>0 do
 
86
           begin
 
87
              if size>32768 then
 
88
                asize:=32768
 
89
              else
 
90
                asize:=size;
 
91
              size:=size-asize;
 
92
              new(ma);
 
93
              getmem(ma^.memory,trunc(asize));
 
94
              fillchar(ma^.memory^,trunc(asize),0);
 
95
              ma^.size:=trunc(asize);
 
96
              ma^.addr:=addr;
 
97
              addr:=addr+asize;
 
98
 
 
99
              ma^.next:=mem;
 
100
              mem:=ma;
 
101
           end;
 
102
      end;
 
103
 
 
104
    function tmemorymanager.readq(addr : taddr) : qword;
 
105
 
 
106
      var
 
107
         h : qword;
 
108
         ma : pmemoryarea;
 
109
         qw : tqwordrec;
 
110
 
 
111
      begin
 
112
         ma:=mem;
 
113
         while assigned(ma) do
 
114
           begin
 
115
              if (addr>=ma^.addr) and (addr<ma^.addr+ma^.size) then
 
116
                begin
 
117
                   if addr<ma^.addr+ma^.size-7 then
 
118
                     begin
 
119
                        move(ma^.memory^[trunc(addr-ma^.addr)],h,8);
 
120
                        readq:=h;
 
121
                        exit;
 
122
                     end
 
123
                   else
 
124
                     begin
 
125
                        qw.low32:=readd(addr);
 
126
                        qw.high32:=readd(addr+4);
 
127
                        readq:=comp(qw);
 
128
                        exit;
 
129
                     end;
 
130
                end;
 
131
              ma:=ma^.next;
 
132
           end;
 
133
         exception('Access violation to $'+qword2str(addr),instructionpc);
 
134
      end;
 
135
 
 
136
    function tmemorymanager.readalignedq(addr : taddr) : qword;
 
137
 
 
138
      var
 
139
         h : qword;
 
140
         ma : pmemoryarea;
 
141
         qw : tqwordrec;
 
142
 
 
143
      begin
 
144
         if (tqwordrec(addr).low32 and $7)<>0 then
 
145
           exception('Alignment violation (dword) to $'+qword2str(addr),instructionpc);
 
146
         ma:=mem;
 
147
         while assigned(ma) do
 
148
           begin
 
149
              if (addr>=ma^.addr) and (addr<ma^.addr+ma^.size) then
 
150
                begin
 
151
                    move(ma^.memory^[trunc(addr-ma^.addr)],h,8);
 
152
                    readalignedq:=h;
 
153
                    exit;
 
154
                end;
 
155
              ma:=ma^.next;
 
156
           end;
 
157
         exception('Access violation to $'+qword2str(addr),instructionpc);
 
158
      end;
 
159
 
 
160
    function tmemorymanager.readd(addr : taddr) : dword;
 
161
 
 
162
      var
 
163
         h : dword;
 
164
         ma : pmemoryarea;
 
165
 
 
166
      begin
 
167
         ma:=mem;
 
168
         while assigned(ma) do
 
169
           begin
 
170
              if (addr>=ma^.addr) and (addr<ma^.addr+ma^.size) then
 
171
                begin
 
172
                   if addr<ma^.addr+ma^.size-3 then
 
173
                     begin
 
174
                        move(ma^.memory^[trunc(addr-ma^.addr)],h,4);
 
175
                        readd:=h;
 
176
                        exit;
 
177
                     end
 
178
                   else
 
179
                     begin
 
180
                        readd:=readb(addr)+readb(addr+1) shl 8+readb(addr+2) shl 16+
 
181
                          readb(addr+3) shl 24;
 
182
                        exit;
 
183
                     end;
 
184
                end;
 
185
              ma:=ma^.next;
 
186
           end;
 
187
         exception('Access violation to $'+qword2str(addr),instructionpc);
 
188
      end;
 
189
 
 
190
    function tmemorymanager.readalignedd(addr : taddr) : dword;
 
191
 
 
192
      var
 
193
         h : dword;
 
194
         ma : pmemoryarea;
 
195
 
 
196
      begin
 
197
         if (tqwordrec(addr).low32 and $3)<>0 then
 
198
           exception('Alignment violation (dword) to $'+qword2str(addr),instructionpc);
 
199
         ma:=mem;
 
200
         while assigned(ma) do
 
201
           begin
 
202
              if (addr>=ma^.addr) and (addr<ma^.addr+ma^.size) then
 
203
                begin
 
204
                   move(ma^.memory^[trunc(addr-ma^.addr)],h,4);
 
205
                   readalignedd:=h;
 
206
                   exit;
 
207
                end;
 
208
              ma:=ma^.next;
 
209
           end;
 
210
         exception('Access violation to $'+qword2str(addr),instructionpc);
 
211
      end;
 
212
 
 
213
    function tmemorymanager.readb(addr : taddr) : dword;
 
214
 
 
215
      var
 
216
         ma : pmemoryarea;
 
217
 
 
218
      begin
 
219
         ma:=mem;
 
220
         while assigned(ma) do
 
221
           begin
 
222
              if (addr>=ma^.addr) and (addr<ma^.addr+ma^.size) then
 
223
                begin
 
224
                   readb:=ma^.memory^[trunc(addr-ma^.addr)];
 
225
                   exit;
 
226
                end;
 
227
              ma:=ma^.next;
 
228
           end;
 
229
         exception('Access violation to $'+qword2str(addr),instructionpc);
 
230
      end;
 
231
 
 
232
    procedure tmemorymanager.writeb(addr : taddr;b : byte);
 
233
 
 
234
      var
 
235
         ma : pmemoryarea;
 
236
 
 
237
      begin
 
238
         ma:=mem;
 
239
         while assigned(ma) do
 
240
           begin
 
241
              if (addr>=ma^.addr) and (addr<ma^.addr+ma^.size) then
 
242
                begin
 
243
                   ma^.memory^[trunc(addr-ma^.addr)]:=b;
 
244
                   exit;
 
245
                end;
 
246
              ma:=ma^.next;
 
247
           end;
 
248
         exception('Access violation to $'+qword2str(addr),instructionpc);
 
249
      end;
 
250
 
 
251
    procedure tmemorymanager.writed(addr : taddr;d : dword);
 
252
 
 
253
      begin
 
254
         writeb(addr,tdword(d)[0]);
 
255
         writeb(addr+1,tdword(d)[1]);
 
256
         writeb(addr+2,tdword(d)[2]);
 
257
         writeb(addr+3,tdword(d)[3]);
 
258
      end;
 
259
 
 
260
    procedure tmemorymanager.writealignedd(addr : taddr;d : dword);
 
261
 
 
262
      begin
 
263
         writeb(addr,tdword(d)[0]);
 
264
         writeb(addr+1,tdword(d)[1]);
 
265
         writeb(addr+2,tdword(d)[2]);
 
266
         writeb(addr+3,tdword(d)[3]);
 
267
      end;
 
268
 
 
269
    procedure tmemorymanager.writeq(addr : taddr;q : qword);
 
270
 
 
271
      var
 
272
         ma : pmemoryarea;
 
273
 
 
274
      begin
 
275
         ma:=mem;
 
276
         while assigned(ma) do
 
277
           begin
 
278
              if (addr>=ma^.addr) and (addr<ma^.addr+ma^.size-7) then
 
279
                begin
 
280
                   move(q,ma^.memory^[trunc(addr-ma^.addr)],8);
 
281
                   exit;
 
282
                end
 
283
              else
 
284
                { misaligned write! }
 
285
                if (addr>=ma^.addr) and (addr<ma^.addr+ma^.size) then
 
286
                  begin
 
287
                     writeln('Not implemented 1!');
 
288
                     halt(1);
 
289
                  end;
 
290
              ma:=ma^.next;
 
291
           end;
 
292
         exception('Access violation to $'+qword2str(addr),instructionpc);
 
293
      end;
 
294
 
 
295
end.