mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-01 10:02:33 +02:00
+ initial revision, it runs simple Alpha Linux ELF executables
- integer operations are nearly completed (non with overflow checking)
- floating point operations aren't implemented (except loading and
storing)
- only the really necessary system calls are implemented by dummys
write syscalls are redirected to the console
This commit is contained in:
florian
parent
ec24bdb1f9
commit
d60550da2e
1278
utils/simulator/alphasim.pas
Normal file
1278
utils/simulator/alphasim.pas
Normal file
File diff suppressed because it is too large
Load Diff
211
utils/simulator/fastmm64.pas
Normal file
211
utils/simulator/fastmm64.pas
Normal file
@ -0,0 +1,211 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal simulator environment
|
||||
Copyright (c) 1999 by Florian Klaempfl
|
||||
|
||||
This unit implemements a memory manager for 64 bit processor
|
||||
simulations, it needs a 32 bit compiler to be compiled
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
|
||||
**********************************************************************}
|
||||
{$N+}
|
||||
unit fastmm64;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
simbase;
|
||||
|
||||
type
|
||||
taddr = qword;
|
||||
|
||||
tmemorymanager = object
|
||||
mem : array[0..65535] of pbyte;
|
||||
constructor init;
|
||||
{ "memory" access routines }
|
||||
function readalignedq(addr : taddr) : qword;
|
||||
function readq(addr : taddr) : qword;
|
||||
function readalignedd(addr : taddr) : dword;
|
||||
function readd(addr : taddr) : dword;
|
||||
function readb(addr : taddr) : dword;
|
||||
procedure writeb(addr : taddr;b : byte);
|
||||
procedure writealignedd(addr : taddr;d : dword);
|
||||
procedure writed(addr : taddr;d : dword);
|
||||
procedure writeq(addr : taddr;q : qword);
|
||||
procedure allocate(addr : taddr;size : qword);
|
||||
end;
|
||||
|
||||
var
|
||||
{ address of the currently executed instruction, }
|
||||
{ necessary for correct output of exception }
|
||||
instructionpc : taddr;
|
||||
|
||||
implementation
|
||||
|
||||
procedure exception(const s : string;addr : taddr);
|
||||
|
||||
begin
|
||||
writeln;
|
||||
writeln('Exception: ',s,' at $',qword2str(addr));
|
||||
stopsim;
|
||||
end;
|
||||
|
||||
constructor tmemorymanager.init;
|
||||
|
||||
begin
|
||||
fillchar(mem,sizeof(mem),0);
|
||||
end;
|
||||
|
||||
procedure tmemorymanager.allocate(addr : taddr;size : qword);
|
||||
|
||||
procedure allocateblock(addr : taddr);
|
||||
|
||||
var
|
||||
upperbits : longint;
|
||||
|
||||
begin
|
||||
if (tqwordrec(addr).high32 and $fffffff0)<>0 then
|
||||
begin
|
||||
writeln('This memory manager supports only 36 bit');
|
||||
halt(1);
|
||||
end;
|
||||
upperbits:=((tqwordrec(addr).high32 and $f) shl 12) or ((tqwordrec(addr).low32 and $fff) shr 20);
|
||||
if not(assigned(mem[upperbits])) then
|
||||
begin
|
||||
getmem(mem[upperbits],1024*1024);
|
||||
fillchar(mem[upperbits]^,1024*1024,0);
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
asize : qword;
|
||||
|
||||
begin
|
||||
while size>0 do
|
||||
begin
|
||||
if size>1024*1024 then
|
||||
asize:=1024*1024;
|
||||
size:=size-asize;
|
||||
allocateblock(addr);
|
||||
addr:=addr+asize;
|
||||
end;
|
||||
end;
|
||||
|
||||
function tmemorymanager.readq(addr : taddr) : qword;
|
||||
|
||||
var
|
||||
h : qword;
|
||||
|
||||
begin
|
||||
tqwordrec(h).low32:=readd(addr);
|
||||
tqwordrec(h).high32:=readd(addr+4);
|
||||
readq:=h;
|
||||
end;
|
||||
|
||||
function tmemorymanager.readd(addr : taddr) : dword;
|
||||
|
||||
begin
|
||||
readd:=readb(addr)+readb(addr+1) shl 8+readb(addr+2) shl 16+
|
||||
readb(addr+3) shl 24;
|
||||
end;
|
||||
|
||||
function tmemorymanager.readalignedd(addr : taddr) : dword;
|
||||
|
||||
var
|
||||
upperbits : longint;
|
||||
|
||||
begin
|
||||
if (tqwordrec(addr).low32 and $3)<>0 then
|
||||
exception('Alignment violation (dword) to $'+qword2str(addr),instructionpc);
|
||||
upperbits:=((tqwordrec(addr).high32 and $f) shl 12) or ((tqwordrec(addr).low32 and $fff) shr 20);
|
||||
if not(assigned(mem[upperbits])) then
|
||||
exception('Access violation to $'+qword2str(addr),instructionpc);
|
||||
readalignedd:=pdword(mem[upperbits])[(tqwordrec(addr).low32 and $fffff) shr 2];
|
||||
end;
|
||||
|
||||
function tmemorymanager.readalignedq(addr : taddr) : qword;
|
||||
|
||||
var
|
||||
upperbits : longint;
|
||||
|
||||
begin
|
||||
if (tqwordrec(addr).low32 and $7)<>0 then
|
||||
exception('Alignment violation (dword) to $'+qword2str(addr),instructionpc);
|
||||
upperbits:=((tqwordrec(addr).high32 and $f) shl 12) or ((tqwordrec(addr).low32 and $fff) shr 20);
|
||||
if not(assigned(mem[upperbits])) then
|
||||
exception('Access violation to $'+qword2str(addr),instructionpc);
|
||||
readalignedq:=pqword(mem[upperbits])[(tqwordrec(addr).low32 and $fffff) shr 3];
|
||||
end;
|
||||
|
||||
function tmemorymanager.readb(addr : taddr) : dword;
|
||||
|
||||
var
|
||||
upperbits : longint;
|
||||
|
||||
begin
|
||||
upperbits:=((tqwordrec(addr).high32 and $f) shl 12) or ((tqwordrec(addr).low32 and $fff) shr 20);
|
||||
if not(assigned(mem[upperbits])) then
|
||||
exception('Access violation to $'+qword2str(addr),instructionpc);
|
||||
readb:=mem[upperbits,tqwordrec(addr).low32 and $fffff];
|
||||
end;
|
||||
|
||||
procedure tmemorymanager.writeb(addr : taddr;b : byte);
|
||||
|
||||
var
|
||||
upperbits : longint;
|
||||
|
||||
begin
|
||||
upperbits:=((tqwordrec(addr).high32 and $f) shl 12) or ((tqwordrec(addr).low32 and $fff) shr 20);
|
||||
if not(assigned(mem[upperbits])) then
|
||||
exception('Access violation to $'+qword2str(addr),instructionpc);
|
||||
mem[upperbits,tqwordrec(addr).low32 and $fffff]:=b;
|
||||
end;
|
||||
|
||||
procedure tmemorymanager.writealignedd(addr : taddr;d : dword);
|
||||
|
||||
var
|
||||
upperbits : longint;
|
||||
|
||||
begin
|
||||
if (tqwordrec(addr).low32 and $3)<>0 then
|
||||
exception('Alignment violation (dword) to $'+qword2str(addr),instructionpc);
|
||||
upperbits:=((tqwordrec(addr).high32 and $f) shl 12) or ((tqwordrec(addr).low32 and $fff) shr 20);
|
||||
if not(assigned(mem[upperbits])) then
|
||||
exception('Access violation to $'+qword2str(addr),instructionpc);
|
||||
pdword(mem[upperbits])[(tqwordrec(addr).low32 and $fffff) shr 2]:=d;
|
||||
end;
|
||||
|
||||
procedure tmemorymanager.writed(addr : taddr;d : dword);
|
||||
|
||||
begin
|
||||
writeb(addr,tdword(d)[0]);
|
||||
writeb(addr+1,tdword(d)[1]);
|
||||
writeb(addr+2,tdword(d)[2]);
|
||||
writeb(addr+3,tdword(d)[3]);
|
||||
end;
|
||||
|
||||
procedure tmemorymanager.writeq(addr : taddr;q : qword);
|
||||
|
||||
begin
|
||||
writed(addr,tqwordrec(q).low32);
|
||||
writed(addr+4,tqwordrec(q).high32);
|
||||
end;
|
||||
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 1999-06-14 11:49:48 florian
|
||||
+ initial revision, it runs simple Alpha Linux ELF executables
|
||||
- integer operations are nearly completed (non with overflow checking)
|
||||
- floating point operations aren't implemented (except loading and
|
||||
storing)
|
||||
- only the really necessary system calls are implemented by dummys
|
||||
write syscalls are redirected to the console
|
||||
|
||||
}
|
||||
307
utils/simulator/mm64.pas
Normal file
307
utils/simulator/mm64.pas
Normal file
@ -0,0 +1,307 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal simulator environment
|
||||
Copyright (c) 1999 by Florian Klaempfl
|
||||
|
||||
This unit implemements a memory manager for 64 bit processor
|
||||
simulations, it works also with TP
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
|
||||
**********************************************************************}
|
||||
{ a simple 64 bit simulator memory manager, also running with TP }
|
||||
{$N+}
|
||||
unit mm64;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
simbase;
|
||||
|
||||
const
|
||||
memoryblocksize = 32768;
|
||||
|
||||
type
|
||||
taddr = qword;
|
||||
tmemoryblock = array[0..memoryblocksize-1] of byte;
|
||||
pmemoryblock = ^tmemoryblock;
|
||||
|
||||
pmemoryarea = ^tmemoryarea;
|
||||
tmemoryarea = record
|
||||
addr : qword;
|
||||
memory : pmemoryblock;
|
||||
size : dword;
|
||||
next : pmemoryarea;
|
||||
end;
|
||||
|
||||
tmemorymanager = object
|
||||
mem : pmemoryarea;
|
||||
constructor init;
|
||||
{ "memory" access routines }
|
||||
function readalignedq(addr : taddr) : qword;
|
||||
function readq(addr : taddr) : qword;
|
||||
function readalignedd(addr : taddr) : dword;
|
||||
function readd(addr : taddr) : dword;
|
||||
function readb(addr : taddr) : dword;
|
||||
procedure writeb(addr : taddr;b : byte);
|
||||
procedure writealignedd(addr : taddr;d : dword);
|
||||
procedure writed(addr : taddr;d : dword);
|
||||
procedure writeq(addr : taddr;q : qword);
|
||||
procedure allocate(addr : taddr;size : qword);
|
||||
end;
|
||||
|
||||
var
|
||||
{ address of the currently executed instruction, }
|
||||
{ necessary for correct output of exception }
|
||||
instructionpc : taddr;
|
||||
|
||||
implementation
|
||||
|
||||
procedure exception(const s : string;addr : taddr);
|
||||
|
||||
begin
|
||||
writeln;
|
||||
writeln('Exception: ',s,' at $',qword2str(addr));
|
||||
stopsim;
|
||||
end;
|
||||
|
||||
constructor tmemorymanager.init;
|
||||
|
||||
begin
|
||||
mem:=nil;
|
||||
end;
|
||||
|
||||
procedure tmemorymanager.allocate(addr : taddr;size : qword);
|
||||
|
||||
var
|
||||
ma : pmemoryarea;
|
||||
asize : qword;
|
||||
|
||||
begin
|
||||
while size>0 do
|
||||
begin
|
||||
if size>32768 then
|
||||
asize:=32768
|
||||
else
|
||||
asize:=size;
|
||||
size:=size-asize;
|
||||
new(ma);
|
||||
getmem(ma^.memory,trunc(asize));
|
||||
fillchar(ma^.memory^,trunc(asize),0);
|
||||
ma^.size:=trunc(asize);
|
||||
ma^.addr:=addr;
|
||||
addr:=addr+asize;
|
||||
|
||||
ma^.next:=mem;
|
||||
mem:=ma;
|
||||
end;
|
||||
end;
|
||||
|
||||
function tmemorymanager.readq(addr : taddr) : qword;
|
||||
|
||||
var
|
||||
h : qword;
|
||||
ma : pmemoryarea;
|
||||
qw : tqwordrec;
|
||||
|
||||
begin
|
||||
ma:=mem;
|
||||
while assigned(ma) do
|
||||
begin
|
||||
if (addr>=ma^.addr) and (addr<ma^.addr+ma^.size) then
|
||||
begin
|
||||
if addr<ma^.addr+ma^.size-7 then
|
||||
begin
|
||||
move(ma^.memory^[trunc(addr-ma^.addr)],h,8);
|
||||
readq:=h;
|
||||
exit;
|
||||
end
|
||||
else
|
||||
begin
|
||||
qw.low32:=readd(addr);
|
||||
qw.high32:=readd(addr+4);
|
||||
readq:=comp(qw);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
ma:=ma^.next;
|
||||
end;
|
||||
exception('Access violation to $'+qword2str(addr),instructionpc);
|
||||
end;
|
||||
|
||||
function tmemorymanager.readalignedq(addr : taddr) : qword;
|
||||
|
||||
var
|
||||
h : qword;
|
||||
ma : pmemoryarea;
|
||||
qw : tqwordrec;
|
||||
|
||||
begin
|
||||
if (tqwordrec(addr).low32 and $7)<>0 then
|
||||
exception('Alignment violation (dword) to $'+qword2str(addr),instructionpc);
|
||||
ma:=mem;
|
||||
while assigned(ma) do
|
||||
begin
|
||||
if (addr>=ma^.addr) and (addr<ma^.addr+ma^.size) then
|
||||
begin
|
||||
move(ma^.memory^[trunc(addr-ma^.addr)],h,8);
|
||||
readalignedq:=h;
|
||||
exit;
|
||||
end;
|
||||
ma:=ma^.next;
|
||||
end;
|
||||
exception('Access violation to $'+qword2str(addr),instructionpc);
|
||||
end;
|
||||
|
||||
function tmemorymanager.readd(addr : taddr) : dword;
|
||||
|
||||
var
|
||||
h : dword;
|
||||
ma : pmemoryarea;
|
||||
|
||||
begin
|
||||
ma:=mem;
|
||||
while assigned(ma) do
|
||||
begin
|
||||
if (addr>=ma^.addr) and (addr<ma^.addr+ma^.size) then
|
||||
begin
|
||||
if addr<ma^.addr+ma^.size-3 then
|
||||
begin
|
||||
move(ma^.memory^[trunc(addr-ma^.addr)],h,4);
|
||||
readd:=h;
|
||||
exit;
|
||||
end
|
||||
else
|
||||
begin
|
||||
readd:=readb(addr)+readb(addr+1) shl 8+readb(addr+2) shl 16+
|
||||
readb(addr+3) shl 24;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
ma:=ma^.next;
|
||||
end;
|
||||
exception('Access violation to $'+qword2str(addr),instructionpc);
|
||||
end;
|
||||
|
||||
function tmemorymanager.readalignedd(addr : taddr) : dword;
|
||||
|
||||
var
|
||||
h : dword;
|
||||
ma : pmemoryarea;
|
||||
|
||||
begin
|
||||
if (tqwordrec(addr).low32 and $3)<>0 then
|
||||
exception('Alignment violation (dword) to $'+qword2str(addr),instructionpc);
|
||||
ma:=mem;
|
||||
while assigned(ma) do
|
||||
begin
|
||||
if (addr>=ma^.addr) and (addr<ma^.addr+ma^.size) then
|
||||
begin
|
||||
move(ma^.memory^[trunc(addr-ma^.addr)],h,4);
|
||||
readalignedd:=h;
|
||||
exit;
|
||||
end;
|
||||
ma:=ma^.next;
|
||||
end;
|
||||
exception('Access violation to $'+qword2str(addr),instructionpc);
|
||||
end;
|
||||
|
||||
function tmemorymanager.readb(addr : taddr) : dword;
|
||||
|
||||
var
|
||||
ma : pmemoryarea;
|
||||
|
||||
begin
|
||||
ma:=mem;
|
||||
while assigned(ma) do
|
||||
begin
|
||||
if (addr>=ma^.addr) and (addr<ma^.addr+ma^.size) then
|
||||
begin
|
||||
readb:=ma^.memory^[trunc(addr-ma^.addr)];
|
||||
exit;
|
||||
end;
|
||||
ma:=ma^.next;
|
||||
end;
|
||||
exception('Access violation to $'+qword2str(addr),instructionpc);
|
||||
end;
|
||||
|
||||
procedure tmemorymanager.writeb(addr : taddr;b : byte);
|
||||
|
||||
var
|
||||
ma : pmemoryarea;
|
||||
|
||||
begin
|
||||
ma:=mem;
|
||||
while assigned(ma) do
|
||||
begin
|
||||
if (addr>=ma^.addr) and (addr<ma^.addr+ma^.size) then
|
||||
begin
|
||||
ma^.memory^[trunc(addr-ma^.addr)]:=b;
|
||||
exit;
|
||||
end;
|
||||
ma:=ma^.next;
|
||||
end;
|
||||
exception('Access violation to $'+qword2str(addr),instructionpc);
|
||||
end;
|
||||
|
||||
procedure tmemorymanager.writed(addr : taddr;d : dword);
|
||||
|
||||
begin
|
||||
writeb(addr,tdword(d)[0]);
|
||||
writeb(addr+1,tdword(d)[1]);
|
||||
writeb(addr+2,tdword(d)[2]);
|
||||
writeb(addr+3,tdword(d)[3]);
|
||||
end;
|
||||
|
||||
procedure tmemorymanager.writealignedd(addr : taddr;d : dword);
|
||||
|
||||
begin
|
||||
writeb(addr,tdword(d)[0]);
|
||||
writeb(addr+1,tdword(d)[1]);
|
||||
writeb(addr+2,tdword(d)[2]);
|
||||
writeb(addr+3,tdword(d)[3]);
|
||||
end;
|
||||
|
||||
procedure tmemorymanager.writeq(addr : taddr;q : qword);
|
||||
|
||||
var
|
||||
ma : pmemoryarea;
|
||||
|
||||
begin
|
||||
ma:=mem;
|
||||
while assigned(ma) do
|
||||
begin
|
||||
if (addr>=ma^.addr) and (addr<ma^.addr+ma^.size-7) then
|
||||
begin
|
||||
move(q,ma^.memory^[trunc(addr-ma^.addr)],8);
|
||||
exit;
|
||||
end
|
||||
else
|
||||
{ misaligned write! }
|
||||
if (addr>=ma^.addr) and (addr<ma^.addr+ma^.size) then
|
||||
begin
|
||||
writeln('Not implemented 1!');
|
||||
halt(1);
|
||||
end;
|
||||
ma:=ma^.next;
|
||||
end;
|
||||
exception('Access violation to $'+qword2str(addr),instructionpc);
|
||||
end;
|
||||
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 1999-06-14 11:49:48 florian
|
||||
+ initial revision, it runs simple Alpha Linux ELF executables
|
||||
- integer operations are nearly completed (non with overflow checking)
|
||||
- floating point operations aren't implemented (except loading and
|
||||
storing)
|
||||
- only the really necessary system calls are implemented by dummys
|
||||
write syscalls are redirected to the console
|
||||
|
||||
}
|
||||
122
utils/simulator/simbase.pas
Normal file
122
utils/simulator/simbase.pas
Normal file
@ -0,0 +1,122 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal simulator environment
|
||||
Copyright (c) 1999 by Florian Klaempfl
|
||||
|
||||
This unit implemements some helper routines
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
|
||||
**********************************************************************}
|
||||
{$N+}
|
||||
unit simbase;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
dos;
|
||||
|
||||
{ global types }
|
||||
type
|
||||
{ tindex must be at least of type integer }
|
||||
tindex = integer;
|
||||
|
||||
int64 = comp;
|
||||
qword = comp;
|
||||
|
||||
dword = longint;
|
||||
tdword = array[0..3] of byte;
|
||||
|
||||
pbyte = ^byte;
|
||||
pword = ^word;
|
||||
pdword = ^dword;
|
||||
pqword = ^qword;
|
||||
|
||||
tqwordrec = record
|
||||
case tindex of
|
||||
1 : (low32,high32 : dword);
|
||||
2 : (bytes : array[0..7] of byte);
|
||||
3 : (words : array[0..3] of word);
|
||||
end;
|
||||
|
||||
oword = array[0..7] of word;
|
||||
|
||||
towordrec = record
|
||||
case tindex of
|
||||
1 : (bytes : array[0..15] of byte);
|
||||
2 : (words : array[0..7] of word);
|
||||
3 : (low64,high64 : qword);
|
||||
end;
|
||||
|
||||
function hexstr(val : longint;cnt : byte) : string;
|
||||
function qword2str(q : qword) : string;
|
||||
function realtime : double;
|
||||
|
||||
var
|
||||
stopsim : procedure;
|
||||
|
||||
implementation
|
||||
|
||||
function hexstr(val : longint;cnt : byte) : string;
|
||||
|
||||
const
|
||||
HexTbl : array[0..15] of char='0123456789ABCDEF';
|
||||
|
||||
var
|
||||
i : tindex;
|
||||
|
||||
begin
|
||||
hexstr[0]:=char(cnt);
|
||||
for i:=cnt downto 1 do
|
||||
begin
|
||||
hexstr[i]:=hextbl[val and $f];
|
||||
val:=val shr 4;
|
||||
end;
|
||||
end;
|
||||
|
||||
function qword2str(q : qword) : string;
|
||||
|
||||
begin
|
||||
qword2str:=hexstr(tqwordrec(q).high32,8)+hexstr(tqwordrec(q).low32,8);
|
||||
end;
|
||||
|
||||
function realtime : double;
|
||||
|
||||
var
|
||||
h,m,s,s100 : word;
|
||||
|
||||
begin
|
||||
gettime(h,m,s,s100);
|
||||
realtime:=h*3600+m*60+s+s100/100.0;
|
||||
end;
|
||||
|
||||
procedure _stopsim;{$ifdef TP}far;{$endif TP}
|
||||
|
||||
begin
|
||||
writeln('Simulation stopped');
|
||||
halt(1);
|
||||
end;
|
||||
|
||||
begin
|
||||
{$ifdef FPC}
|
||||
stopsim:=@_stopsim;
|
||||
{$else FPC}
|
||||
stopsim:=_stopsim;
|
||||
{$endif FPC}
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 1999-06-14 11:49:48 florian
|
||||
+ initial revision, it runs simple Alpha Linux ELF executables
|
||||
- integer operations are nearly completed (non with overflow checking)
|
||||
- floating point operations aren't implemented (except loading and
|
||||
storing)
|
||||
- only the really necessary system calls are implemented by dummys
|
||||
write syscalls are redirected to the console
|
||||
|
||||
}
|
||||
237
utils/simulator/simlib.pas
Normal file
237
utils/simulator/simlib.pas
Normal file
@ -0,0 +1,237 @@
|
||||
{
|
||||
$Id$
|
||||
This file is part of the Free Pascal simulator environment
|
||||
Copyright (c) 1999 by Florian Klaempfl
|
||||
|
||||
This unit implemements routines for data types which aren't
|
||||
support by commonly used compilers
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
|
||||
**********************************************************************}
|
||||
{$N+}
|
||||
{ we do some strange things here }
|
||||
{$O-}
|
||||
{$R-}
|
||||
unit simlib;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
simbase;
|
||||
|
||||
procedure byte_zap(q : qword;b : byte;var result : qword);
|
||||
|
||||
{ shifts q b bytes left }
|
||||
procedure shift_left_q(q : qword;b : byte;var result : qword);
|
||||
|
||||
{ shifts q b bytes right }
|
||||
procedure shift_right_q(q : qword;b : byte;var result : qword);
|
||||
|
||||
{ returns true if i1<i2 assuming that c1 and c2 are unsigned !}
|
||||
function ltu(c1,c2 : comp) : boolean;
|
||||
|
||||
{ returns true if i1=<i2 assuming that c1 and c2 are unsigned !}
|
||||
function leu(c1,c2 : comp) : boolean;
|
||||
|
||||
{ adds to owords, returns true if an overflow occurs }
|
||||
function addoword(o1,o2 : oword;var result : oword) : boolean;
|
||||
|
||||
{ adds two words, returns true if an overflow occurs }
|
||||
function addword(w1,w2 : word;var result : word) : boolean;
|
||||
|
||||
{ sets an oword to zero }
|
||||
procedure zerooword(var o : oword);
|
||||
|
||||
{ multiplies two qwords into a full oword }
|
||||
procedure mulqword(q1,q2 : qword;var result : oword);
|
||||
|
||||
implementation
|
||||
|
||||
procedure byte_zap(q : qword;b : byte;var result : qword);
|
||||
|
||||
var
|
||||
i : tindex;
|
||||
|
||||
begin
|
||||
for i:=0 to 7 do
|
||||
if ((1 shl i) and b)=0 then
|
||||
tqwordrec(result).bytes[i]:=tqwordrec(q).bytes[i]
|
||||
else
|
||||
tqwordrec(result).bytes[i]:=0;
|
||||
end;
|
||||
|
||||
{ shifts q b bytes left }
|
||||
procedure shift_left_q(q : qword;b : byte;var result : qword);
|
||||
|
||||
var
|
||||
i : tindex;
|
||||
|
||||
begin
|
||||
result:=0;
|
||||
if b>63 then
|
||||
else if b>31 then
|
||||
tqwordrec(result).high32:=tqwordrec(q).low32 shl (b-32)
|
||||
else
|
||||
begin
|
||||
{ bad solution! A qword shift would be nice! }
|
||||
result:=q;
|
||||
for i:=1 to b do
|
||||
begin
|
||||
tqwordrec(result).high32:=tqwordrec(result).high32 shl 1;
|
||||
if (tqwordrec(result).low32 and $80000000)<>0 then
|
||||
tqwordrec(result).high32:=tqwordrec(result).high32 or 1;
|
||||
tqwordrec(result).low32:=tqwordrec(result).low32 shl 1;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ shifts q b bytes right }
|
||||
procedure shift_right_q(q : qword;b : byte;var result : qword);
|
||||
|
||||
var
|
||||
i : tindex;
|
||||
|
||||
begin
|
||||
result:=0;
|
||||
if b>63 then
|
||||
else if b>31 then
|
||||
tqwordrec(result).low32:=tqwordrec(q).high32 shr (b-32)
|
||||
else
|
||||
begin
|
||||
{ bad solution! A qword shift would be nice! }
|
||||
result:=q;
|
||||
for i:=1 to b do
|
||||
begin
|
||||
tqwordrec(result).low32:=tqwordrec(result).low32 shr 1;
|
||||
if (tqwordrec(result).high32 and 1)<>0 then
|
||||
tqwordrec(result).low32:=tqwordrec(result).low32 or
|
||||
$80000000;
|
||||
tqwordrec(result).high32:=tqwordrec(result).high32 shr 1;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ returns true if i1<i2 assuming that c1 and c2 are unsigned !}
|
||||
function ltu(c1,c2 : comp) : boolean;
|
||||
|
||||
begin
|
||||
if (c1>=0) and (c2>=0) then
|
||||
ltu:=c1<c2
|
||||
else if (c1<0) and (c2>=0) then
|
||||
ltu:=false
|
||||
else if (c1>=0) and (c2<0) then
|
||||
ltu:=true
|
||||
else
|
||||
ltu:=c1<c2
|
||||
end;
|
||||
|
||||
{ returns true if i1=<i2 assuming that c1 and c2 are unsigned !}
|
||||
function leu(c1,c2 : comp) : boolean;
|
||||
|
||||
begin
|
||||
if (c1>=0) and (c2>=0) then
|
||||
leu:=c1<=c2
|
||||
else if (c1<0) and (c2>=0) then
|
||||
leu:=false
|
||||
else if (c1>=0) and (c2<0) then
|
||||
leu:=true
|
||||
else
|
||||
leu:=c1<=c2
|
||||
end;
|
||||
|
||||
{ "ands" two qwords }
|
||||
procedure andqword(w1,w2 : qword;var result : qword);
|
||||
|
||||
begin
|
||||
tqwordrec(result).low32:=tqwordrec(w1).low32 and tqwordrec(w2).low32;
|
||||
tqwordrec(result).high32:=tqwordrec(w1).high32 and tqwordrec(w2).high32;
|
||||
end;
|
||||
|
||||
{ adds two words, returns true if an overflow occurs }
|
||||
function addword(w1,w2 : word;var result : word) : boolean;
|
||||
|
||||
var
|
||||
l : longint;
|
||||
|
||||
begin
|
||||
l:=w1+w2;
|
||||
addword:=(l and $10000)<>0;
|
||||
result:=l and $ffff;
|
||||
end;
|
||||
|
||||
{ adds two owords, returns true if an overflow occurs }
|
||||
function addoword(o1,o2 : oword;var result : oword) : boolean;
|
||||
|
||||
var
|
||||
i : tindex;
|
||||
carry : word;
|
||||
|
||||
begin
|
||||
carry:=0;
|
||||
for i:=0 to 7 do
|
||||
begin
|
||||
result[i]:=o1[i]+o2[i]+carry;
|
||||
{ an overflow has occured, if the result is less
|
||||
than one of the summands
|
||||
}
|
||||
if (result[i]<o1[i]) or (result[i]<o2[i]) then
|
||||
carry:=1
|
||||
else
|
||||
carry:=0;
|
||||
end;
|
||||
addoword:=carry=1;
|
||||
end;
|
||||
|
||||
{ sets an oword to zero }
|
||||
procedure zerooword(var o : oword);
|
||||
|
||||
begin
|
||||
fillchar(o,sizeof(o),0);
|
||||
end;
|
||||
|
||||
{ multiplies two qwords into a full oword }
|
||||
procedure mulqword(q1,q2 : qword;var result : oword);
|
||||
|
||||
var
|
||||
i : tindex;
|
||||
h,bitpos : qword;
|
||||
ho1 : oword;
|
||||
|
||||
begin
|
||||
{ result is zero }
|
||||
zerooword(ho1);
|
||||
result:=ho1;
|
||||
towordrec(ho1).low64:=q1;
|
||||
|
||||
bitpos:=1;
|
||||
|
||||
for i:=0 to 63 do
|
||||
begin
|
||||
andqword(q2,bitpos,h);
|
||||
if h<>0 then
|
||||
addoword(result,ho1,result);
|
||||
|
||||
{ ho1:=2*ho1 }
|
||||
addoword(ho1,ho1,ho1);
|
||||
shift_left_q(bitpos,1,bitpos);
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 1999-06-14 11:49:48 florian
|
||||
+ initial revision, it runs simple Alpha Linux ELF executables
|
||||
- integer operations are nearly completed (non with overflow checking)
|
||||
- floating point operations aren't implemented (except loading and
|
||||
storing)
|
||||
- only the really necessary system calls are implemented by dummys
|
||||
write syscalls are redirected to the console
|
||||
|
||||
}
|
||||
Loading…
Reference in New Issue
Block a user