mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-26 23:43:41 +02:00
1276 lines
43 KiB
ObjectPascal
1276 lines
43 KiB
ObjectPascal
{
|
|
This file is part of the Free Pascal simulator environment
|
|
Copyright (c) 1999-2000 by Florian Klaempfl
|
|
|
|
This file is the main file of the DEC Alpha simulation
|
|
|
|
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+}
|
|
{ $define DEBUG}
|
|
program alphaemu;
|
|
|
|
uses
|
|
{$ifdef delphi}
|
|
dmisc,
|
|
{$else}
|
|
dos,
|
|
{$endif}
|
|
simbase,simlib,
|
|
{$ifdef FPC}
|
|
{$ifdef go32v2}
|
|
dpmiexcp,
|
|
{$endif go32v2}
|
|
{$endif FPC}
|
|
{$ifdef TP}
|
|
mm64
|
|
{$else TP}
|
|
{$define fastmem}
|
|
fastmm64
|
|
{$endif TP}
|
|
;
|
|
|
|
{ elf file types }
|
|
type
|
|
telf64_hdr = packed record
|
|
e_ident : array[0..15] of char;
|
|
e_type : integer;
|
|
e_machine : word;
|
|
version : longint;
|
|
e_entry : qword;
|
|
e_phoff : qword;
|
|
e_shoff : qword;
|
|
e_flags : longint;
|
|
e_ehsize : integer;
|
|
e_phentsize : integer;
|
|
e_phnum : integer;
|
|
e_shentsize : integer;
|
|
e_shnum : integer;
|
|
e_shstrndx : integer;
|
|
end;
|
|
|
|
telf64_phdr = packed record
|
|
p_type : longint;
|
|
p_flags : longint;
|
|
{ Segment file offset }
|
|
p_offset : qword;
|
|
{ Segment virtual address }
|
|
p_vaddr : qword;
|
|
{ Segment physical address }
|
|
p_paddr : qword;
|
|
{ Segment size in file }
|
|
p_filesz : qword;
|
|
{ Segment size in memory }
|
|
p_memsz : qword;
|
|
{ Segment alignment, file & memory }
|
|
p_align : qword;
|
|
end;
|
|
|
|
telf64_phdr_array = array[0..0] of telf64_phdr;
|
|
pelf64_phdr_array = ^telf64_phdr_array;
|
|
|
|
const
|
|
{$ifdef fpc}
|
|
{ 64kB Stacksize }
|
|
stacksize = 64*1024;
|
|
{ stack start at 4 GB }
|
|
stackstart : dword = 1024*1024*1024*4-stacksize;
|
|
{$else fpc}
|
|
{ 64kB Stacksize }
|
|
stacksize = 64*1024.0;
|
|
{ stack start at 4 GB }
|
|
stackstart = 1024.0*1024.0*1024.0*4-stacksize;
|
|
{$endif fpc}
|
|
{ alpha specific types }
|
|
type
|
|
tintreg = record
|
|
case tindex of
|
|
1 : (all64 : qword);
|
|
2 : (valueq : int64);
|
|
3 : (low32 : dword;high32 : dword);
|
|
4 : (bytes : array[0..7] of byte)
|
|
end;
|
|
|
|
tfloatreg = record
|
|
case tindex of
|
|
1 : (valued : double);
|
|
2 : (valueq : qword);
|
|
end;
|
|
|
|
tinstruction = dword;
|
|
|
|
tintregs = array[0..31] of tintreg;
|
|
tfloatregs = array[0..31] of tfloatreg;
|
|
|
|
tstate = object
|
|
r : tintregs;
|
|
f : tfloatregs;
|
|
pc : taddr;
|
|
fpcr : qword;
|
|
end;
|
|
|
|
const
|
|
r_v0 = 0;
|
|
r_t0 = 1;
|
|
|
|
r_fp = 15;
|
|
r_a0 = 16;
|
|
r_a1 = 17;
|
|
r_a2 = 18;
|
|
r_a3 = 19;
|
|
r_a4 = 20;
|
|
r_a5 = 11;
|
|
|
|
r_ra = 26;
|
|
r_at = 28;
|
|
r_gp = 29;
|
|
r_sp = 30;
|
|
r_zero = 31;
|
|
|
|
f_zero = 31;
|
|
|
|
type
|
|
talphasim = object
|
|
state : tstate;
|
|
memory : tmemorymanager;
|
|
{ number of executed instructions }
|
|
instrcount : qword;
|
|
{ time when the emulation was started }
|
|
starttime : double;
|
|
{ starts the execution at address pc }
|
|
procedure run(pc : taddr);
|
|
{ gives a message about an illegal opcode }
|
|
{ at the given address }
|
|
procedure illegalopcode(addr : taddr);
|
|
{ dumps the contens of the register a0 to a[count] }
|
|
procedure dumparguments(count : tindex);
|
|
{ dumps the contents of the function result register }
|
|
procedure dumpv0;
|
|
constructor init;
|
|
destructor done;
|
|
end;
|
|
|
|
var
|
|
sim : talphasim;
|
|
|
|
procedure dump_phdr(const h : telf64_phdr);
|
|
|
|
begin
|
|
{$ifdef DEBUG}
|
|
writeln(' Type: $',hexstr(h.p_type,8));
|
|
writeln(' Flags: $',hexstr(h.p_flags,8));
|
|
writeln(' Segment file offset: $',qword2str(h.p_offset));
|
|
writeln(' Segment virtual address: $',qword2str(h.p_vaddr));
|
|
writeln(' Segment physical address: $',qword2str(h.p_paddr));
|
|
writeln(' Segment size in file: $',qword2str(h.p_filesz));
|
|
writeln(' Segment size in memory: $',qword2str(h.p_memsz));
|
|
writeln(' Segment alignment, file & memory: $',qword2str(h.p_align));
|
|
{$endif DEBUG}
|
|
end;
|
|
|
|
procedure _stopsim;{$ifdef TP}far;{$endif TP}
|
|
|
|
var
|
|
elapsedtime : double;
|
|
|
|
begin
|
|
{$ifdef DEBUG}
|
|
elapsedtime:=realtime-sim.starttime;
|
|
|
|
write('Executed ',sim.instrcount:0,' instructions in ',
|
|
elapsedtime:0:2,' sec');
|
|
if elapsedtime<>0.0 then
|
|
begin
|
|
writeln(',');
|
|
writeln('equals to ',sim.instrcount/(elapsedtime*1000000.0):0:4,' MIPS');
|
|
end
|
|
else
|
|
writeln;
|
|
{$endif DEBUG}
|
|
halt(1);
|
|
end;
|
|
|
|
constructor talphasim.init;
|
|
|
|
begin
|
|
memory.init;
|
|
{ setup dummy registers }
|
|
state.r[31].valueq:=0;
|
|
state.f[31].valued:=0;
|
|
memory.allocate(stackstart,stacksize);
|
|
end;
|
|
|
|
procedure talphasim.illegalopcode(addr : taddr);
|
|
|
|
var
|
|
instruction : tinstruction;
|
|
|
|
begin
|
|
instruction:=memory.readd(addr);
|
|
writeln('Illegal instruction $',hexstr(instruction,8),' at $',qword2str(addr));
|
|
writeln('Opcode is: $',hexstr((instruction and $fc000000) shr 26,2));
|
|
writeln(' Function would be: $',hexstr((instruction and $1fe0) shr 5,3));
|
|
writeln;
|
|
stopsim;
|
|
end;
|
|
|
|
procedure talphasim.dumparguments(count : tindex);
|
|
|
|
var
|
|
i : tindex;
|
|
|
|
begin
|
|
if count>6 then
|
|
begin
|
|
writeln('Illegal number of arguments to print');
|
|
halt(1);
|
|
end;
|
|
{$ifdef DEBUG}
|
|
for i:=0 to count-1 do
|
|
writeln(' Register a',i,' = $',qword2str(state.r[r_a0+i].valueq));
|
|
{$endif DEBUG}
|
|
end;
|
|
|
|
procedure talphasim.dumpv0;
|
|
|
|
var
|
|
i : tindex;
|
|
|
|
begin
|
|
{$ifdef DEBUG}
|
|
writeln(' Register v0 = $',qword2str(state.r[r_v0].valueq));
|
|
{$endif DEBUG}
|
|
end;
|
|
|
|
procedure talphasim.run(pc : taddr);
|
|
|
|
var
|
|
instruction : tinstruction;
|
|
rega,regb,regc : tindex;
|
|
lit : byte;
|
|
va : tintreg;
|
|
|
|
function getbranchdisp : int64;
|
|
|
|
var
|
|
l : longint;
|
|
|
|
begin
|
|
l:=longint(instruction and $1fffff)*4;
|
|
{ sign extend }
|
|
if (l and $100000)<>0 then
|
|
l:=l or $fff00000;
|
|
getbranchdisp:=l;
|
|
end;
|
|
|
|
procedure instructionignored(const s : string);
|
|
|
|
begin
|
|
{$ifdef DEBUG}
|
|
writeln('Instruction "',s,'" at $',qword2str(instructionpc),' ignored');
|
|
{$endif DEBUG}
|
|
end;
|
|
|
|
procedure syscallignored(const s : string);
|
|
|
|
begin
|
|
{$ifdef DEBUG}
|
|
writeln('SYSCALL "',s,'" at $',qword2str(instructionpc),' ignored');
|
|
{$endif DEBUG}
|
|
end;
|
|
|
|
procedure syscalldefault(const s : string);
|
|
|
|
begin
|
|
{$ifdef DEBUG}
|
|
writeln('SYSCALL "',s,'" at $',qword2str(instructionpc),', default value returned');
|
|
{$endif DEBUG}
|
|
end;
|
|
|
|
var
|
|
i : tindex;
|
|
fs : single;
|
|
ib : byte;
|
|
il : longint;
|
|
fc : comp;
|
|
ic : char;
|
|
valueqa,valueqb : qword;
|
|
oi : oword;
|
|
count : qword;
|
|
{$ifdef FASTMEM}
|
|
block : pdword;
|
|
fastpc : longint;
|
|
updatepc : boolean;
|
|
{$endif FASTMEM}
|
|
|
|
begin
|
|
instrcount:=0;
|
|
state.pc:=pc;
|
|
{ setting up the stack pointer }
|
|
state.r[r_sp].valueq:=stackstart+stacksize-24;
|
|
{ setting up command line parameters ... }
|
|
state.r[r_a0].valueq:=0;
|
|
state.r[r_a1].valueq:=0;
|
|
{ ... and environment }
|
|
state.r[r_a2].valueq:=0;
|
|
|
|
starttime:=realtime;
|
|
{$ifdef FASTMEM}
|
|
updatepc:=true;
|
|
{$endif FASTMEM}
|
|
repeat
|
|
{ read the next instruction }
|
|
{$ifdef FASTMEM}
|
|
if updatepc then
|
|
begin
|
|
block:=pdword(memory.mem[((tqwordrec(state.pc).high32 and $f) shl 12) or
|
|
((tqwordrec(state.pc).low32 and $fff) shr 20)]);
|
|
fastpc:=(tqwordrec(state.pc).low32 and $fffff) shr 2;
|
|
end;
|
|
instruction:=block[fastpc];
|
|
inc(fastpc);
|
|
updatepc:=fastpc>1024*256-1;
|
|
{$else FASTMEM}
|
|
instruction:=memory.readalignedd(state.pc);
|
|
{$endif FASTMEM}
|
|
instructionpc:=state.pc;
|
|
state.pc:=state.pc+4;
|
|
|
|
{ decode the instruction }
|
|
case (instruction and $fc000000) shr 26 of
|
|
{ CALL_PAL }
|
|
$0:
|
|
begin
|
|
case instruction and $3ffffff of
|
|
{ halt }
|
|
0:
|
|
exit;
|
|
131:
|
|
begin
|
|
if state.r[r_v0].high32=0 then
|
|
case state.r[r_v0].low32 of
|
|
{ Setup }
|
|
0:
|
|
begin
|
|
syscallignored('setup');
|
|
{ mimic proper execution }
|
|
state.r[r_v0].valueq:=0;
|
|
end;
|
|
1:
|
|
begin
|
|
exit;
|
|
end;
|
|
4:
|
|
begin
|
|
syscallignored('write');
|
|
state.r[r_v0].valueq:=0;
|
|
count:=0;
|
|
while count<state.r[r_a2].valueq do
|
|
begin
|
|
byte(ic):=memory.readb(state.r[r_a1].valueq+count);
|
|
{ all output goes currently to stdout }
|
|
if ic=#10 then
|
|
writeln(output)
|
|
else
|
|
write(output,ic);
|
|
|
|
count:=count+1;
|
|
state.r[r_v0].valueq:=state.r[r_v0].valueq+1;
|
|
end;
|
|
end;
|
|
20:
|
|
begin
|
|
syscalldefault('getpid');
|
|
{ return a default value }
|
|
state.r[r_v0].valueq:=501;
|
|
end;
|
|
24:
|
|
begin
|
|
syscalldefault('getuid');
|
|
{ return a default value }
|
|
state.r[r_v0].valueq:=501;
|
|
end;
|
|
45:
|
|
begin
|
|
syscallignored('brk');
|
|
{ mimic proper execution }
|
|
state.r[r_v0].valueq:=0;
|
|
end;
|
|
{ alpha specific }
|
|
$100:
|
|
begin
|
|
syscallignored('osf_getsysinfo');
|
|
{ mimic proper execution }
|
|
state.r[r_v0].valueq:=0;
|
|
end;
|
|
$101:
|
|
begin
|
|
syscallignored('osf_setsysinfo');
|
|
{ mimic proper execution }
|
|
state.r[r_v0].valueq:=0;
|
|
end;
|
|
$144:
|
|
begin
|
|
syscallignored('personality');
|
|
{ mimic proper execution }
|
|
state.r[r_v0].valueq:=0;
|
|
end;
|
|
else
|
|
begin
|
|
syscallignored('<Unknown>');
|
|
dumpv0;
|
|
dumparguments(4);
|
|
end;
|
|
|
|
end
|
|
else
|
|
begin
|
|
syscallignored('<Unknown>');
|
|
dumpv0;
|
|
dumparguments(4);
|
|
end;
|
|
end;
|
|
else
|
|
writeln('PAL code $',hexstr(instruction and $3ffffff,8),' at $',
|
|
qword2str(instructionpc),' ignored');
|
|
end;
|
|
end;
|
|
{ LDA }
|
|
$8:
|
|
begin
|
|
rega:=(instruction and $3e00000) shr 21;
|
|
regb:=(instruction and $1f0000) shr 16;
|
|
if rega<>r_zero then
|
|
state.r[rega].valueq:=state.r[regb].valueq+int64(integer(instruction and $ffff));
|
|
end;
|
|
{ LDAH }
|
|
$9:
|
|
begin
|
|
rega:=(instruction and $3e00000) shr 21;
|
|
regb:=(instruction and $1f0000) shr 16;
|
|
if rega<>r_zero then
|
|
state.r[rega].valueq:=state.r[regb].valueq+
|
|
(int64(integer(instruction and $ffff))*65536);
|
|
end;
|
|
{ LDQ_U }
|
|
$B:
|
|
begin
|
|
{ !!!!! no MSB support yet! }
|
|
rega:=(instruction and $3e00000) shr 21;
|
|
regb:=(instruction and $1f0000) shr 16;
|
|
valueqb:=state.r[regb].valueq+
|
|
(int64(integer(instruction and $ffff)));
|
|
tqwordrec(valueqb).low32:=tqwordrec(valueqb).low32 and $fffffff8;
|
|
if rega<>r_zero then
|
|
state.r[rega].valueq:=memory.readq(valueqb);
|
|
end;
|
|
{ STQ_U }
|
|
$f:
|
|
begin
|
|
{ !!!!! no MSB support yet! }
|
|
rega:=(instruction and $3e00000) shr 21;
|
|
regb:=(instruction and $1f0000) shr 16;
|
|
va.valueq:=state.r[regb].valueq+
|
|
(int64(integer(instruction and $ffff)));
|
|
memory.writeq(va.valueq,state.r[rega].valueq);
|
|
end;
|
|
|
|
{ ************* opcode $10 ************** }
|
|
$10:
|
|
begin
|
|
rega:=(instruction and $3e00000) shr 21;
|
|
regb:=(instruction and $1f0000) shr 16;
|
|
regc:=instruction and $1f;
|
|
valueqa:=state.r[rega].valueq;
|
|
if (instruction and $1000)<>0 then
|
|
valueqb:=(instruction and $1fe000) shr 13
|
|
else
|
|
valueqb:=state.r[regb].valueq;
|
|
case (instruction and $fe0) shr 5 of
|
|
{ ADDL }
|
|
$0:
|
|
begin
|
|
if regc<>r_zero then
|
|
state.r[regc].low32:=tqwordrec(valueqa).low32+tqwordrec(valueqb).low32;
|
|
end;
|
|
{ CMPULT }
|
|
$1D:
|
|
begin
|
|
if (regc<>r_zero) then
|
|
state.r[regc].valueq:=byte(ltu(valueqa,valueqb));
|
|
end;
|
|
{ ADDQ }
|
|
$20:
|
|
begin
|
|
if regc<>r_zero then
|
|
state.r[regc].valueq:=valueqa+valueqb;
|
|
end;
|
|
{ S4ADDQ }
|
|
$22:
|
|
begin
|
|
if regc<>r_zero then
|
|
state.r[regc].valueq:=valueqa*4+valueqb;
|
|
end;
|
|
{ SUBQ }
|
|
$29:
|
|
begin
|
|
if regc<>r_zero then
|
|
state.r[regc].valueq:=valueqa-valueqb;
|
|
end;
|
|
{ S4SUBQ }
|
|
$2B:
|
|
begin
|
|
if regc<>r_zero then
|
|
state.r[regc].valueq:=valueqa*4-valueqb;
|
|
end;
|
|
{ CMPEQ }
|
|
$2D:
|
|
begin
|
|
if (regc<>r_zero) then
|
|
state.r[regc].valueq:=byte(valueqa=valueqb);
|
|
end;
|
|
{ S8ADDQ }
|
|
$32:
|
|
begin
|
|
if regc<>r_zero then
|
|
state.r[regc].valueq:=valueqa*8+valueqb;
|
|
end;
|
|
{ S8SUBQ }
|
|
$3B:
|
|
begin
|
|
if regc<>r_zero then
|
|
state.r[regc].valueq:=valueqa*8-valueqb;
|
|
end;
|
|
{ CMPULE }
|
|
$3D:
|
|
begin
|
|
if (regc<>r_zero) then
|
|
state.r[regc].valueq:=byte(leu(valueqa,valueqb));
|
|
end;
|
|
{ CMPLT }
|
|
$4D:
|
|
begin
|
|
if (regc<>r_zero) then
|
|
state.r[regc].valueq:=byte(valueqa<valueqb);
|
|
end;
|
|
{ CMPLE }
|
|
$6D:
|
|
begin
|
|
if (regc<>r_zero) then
|
|
state.r[regc].valueq:=byte(valueqa<=valueqb);
|
|
end;
|
|
else
|
|
illegalopcode(instructionpc);
|
|
end;
|
|
end;
|
|
|
|
{ ************* opcode $11 ************** }
|
|
$11:
|
|
begin
|
|
rega:=(instruction and $3e00000) shr 21;
|
|
regb:=(instruction and $1f0000) shr 16;
|
|
regc:=instruction and $1f;
|
|
valueqa:=state.r[rega].valueq;
|
|
if (instruction and $1000)<>0 then
|
|
valueqb:=(instruction and $1fe000) shr 13
|
|
else
|
|
valueqb:=state.r[regb].valueq;
|
|
case (instruction and $fe0) shr 5 of
|
|
{ AND }
|
|
$00:
|
|
begin
|
|
if regc<>r_zero then
|
|
begin
|
|
state.r[regc].low32:=tqwordrec(valueqa).low32 and
|
|
tqwordrec(valueqb).low32;
|
|
state.r[regc].high32:=tqwordrec(valueqa).high32 and
|
|
tqwordrec(valueqb).high32;
|
|
end;
|
|
end;
|
|
{ BIC }
|
|
$08:
|
|
begin
|
|
if regc<>r_zero then
|
|
begin
|
|
state.r[regc].low32:=tqwordrec(valueqa).low32 and
|
|
not(tqwordrec(valueqb).low32);
|
|
state.r[regc].high32:=tqwordrec(valueqa).high32 and
|
|
not(tqwordrec(valueqb).high32);
|
|
end;
|
|
end;
|
|
{ CMOVLBS }
|
|
$14:
|
|
begin
|
|
if (regc<>r_zero) and ((tqwordrec(valueqa).low32 and 1)<>0) then
|
|
state.r[regc].valueq:=valueqb;
|
|
end;
|
|
{ CMOVLBC }
|
|
$16:
|
|
begin
|
|
if (regc<>r_zero) and ((tqwordrec(valueqa).low32 and 1)=0) then
|
|
state.r[regc].valueq:=valueqb;
|
|
end;
|
|
{ BIS }
|
|
$20:
|
|
begin
|
|
if regc<>r_zero then
|
|
begin
|
|
state.r[regc].low32:=tqwordrec(valueqa).low32 or
|
|
tqwordrec(valueqb).low32;
|
|
state.r[regc].high32:=tqwordrec(valueqa).high32 or
|
|
tqwordrec(valueqb).high32;
|
|
end;
|
|
end;
|
|
{ CMOVEQ }
|
|
$24:
|
|
begin
|
|
if (regc<>r_zero) and (valueqa=0) then
|
|
state.r[regc].valueq:=valueqb;
|
|
end;
|
|
{ CMOVNE }
|
|
$26:
|
|
begin
|
|
if (regc<>r_zero) and (valueqa<>0) then
|
|
state.r[regc].valueq:=valueqb;
|
|
end;
|
|
{ ORNOT }
|
|
$28:
|
|
begin
|
|
if regc<>r_zero then
|
|
begin
|
|
state.r[regc].low32:=tqwordrec(valueqa).low32 or
|
|
not(tqwordrec(valueqb).low32);
|
|
state.r[regc].high32:=tqwordrec(valueqa).high32 or
|
|
not(tqwordrec(valueqb).high32);
|
|
end;
|
|
end;
|
|
{ XOR }
|
|
$40:
|
|
begin
|
|
if regc<>r_zero then
|
|
begin
|
|
state.r[regc].valueq:=state.r[rega].valueq xor
|
|
valueqb;
|
|
end;
|
|
end;
|
|
{ CMOVLT }
|
|
$44:
|
|
begin
|
|
if (regc<>r_zero) and (valueqa<0) then
|
|
state.r[regc].valueq:=valueqb;
|
|
end;
|
|
{ CMOVGE }
|
|
$46:
|
|
begin
|
|
if (regc<>r_zero) and (valueqa>=0) then
|
|
state.r[regc].valueq:=valueqb;
|
|
end;
|
|
{ EQV }
|
|
$48:
|
|
begin
|
|
if regc<>r_zero then
|
|
begin
|
|
state.r[regc].valueq:=valueqa xor
|
|
not(valueqb);
|
|
end;
|
|
end;
|
|
{ CMOVLE }
|
|
$64:
|
|
begin
|
|
if (regc<>r_zero) and (valueqa<=0) then
|
|
state.r[regc].valueq:=valueqb;
|
|
end;
|
|
{ CMOVGT }
|
|
$66:
|
|
begin
|
|
if (regc<>r_zero) and (valueqa<=0) then
|
|
state.r[regc].valueq:=valueqb;
|
|
end;
|
|
else
|
|
illegalopcode(instructionpc);
|
|
end;
|
|
end;
|
|
|
|
{ ************* opcode $12 ************** }
|
|
$12:
|
|
begin
|
|
rega:=(instruction and $3e00000) shr 21;
|
|
regb:=(instruction and $1f0000) shr 16;
|
|
regc:=instruction and $1f;
|
|
valueqa:=state.r[rega].valueq;
|
|
if (instruction and $1000)<>0 then
|
|
valueqb:=(instruction and $1fe000) shr 13
|
|
else
|
|
valueqb:=state.r[regb].valueq;
|
|
case (instruction and $fe0) shr 5 of
|
|
{ MSKBL }
|
|
$02:
|
|
begin
|
|
{ !!!!! no MSB support yet! }
|
|
il:=1 shl (tqwordrec(valueqb).low32 and $7);
|
|
if (regc<>r_zero) then
|
|
byte_zap(valueqa,il and $ff,state.r[regc].valueq);
|
|
end;
|
|
{ EXTBL }
|
|
$06:
|
|
begin
|
|
{ !!!!! no MSB support yet! }
|
|
shift_right_q(valueqa,(tqwordrec(valueqb).low32 and $7)*8,valueqa);
|
|
if (regc<>r_zero) then
|
|
byte_zap(valueqa,$fe,state.r[regc].valueq);
|
|
end;
|
|
{ INSBL }
|
|
$0B:
|
|
begin
|
|
{ !!!!! no MSB support yet! }
|
|
il:=1 shl (tqwordrec(valueqb).low32 and $7);
|
|
shift_left_q(valueqa,(tqwordrec(valueqb).low32 and $7)*8,valueqa);
|
|
if (regc<>r_zero) then
|
|
byte_zap(valueqa,not(il and $ff),state.r[regc].valueq);
|
|
end;
|
|
{ MSKWL }
|
|
$12:
|
|
begin
|
|
{ !!!!! no MSB support yet! }
|
|
il:=3 shl (tqwordrec(valueqb).low32 and $7);
|
|
if (regc<>r_zero) then
|
|
byte_zap(valueqa,il and $ff,state.r[regc].valueq);
|
|
end;
|
|
{ EXTWL }
|
|
$16:
|
|
begin
|
|
{ !!!!! no MSB support yet! }
|
|
shift_right_q(valueqa,(tqwordrec(valueqb).low32 and $7)*8,valueqa);
|
|
if (regc<>r_zero) then
|
|
byte_zap(valueqa,$fc,state.r[regc].valueq);
|
|
end;
|
|
{ MSKLL }
|
|
$22:
|
|
begin
|
|
{ !!!!! no MSB support yet! }
|
|
il:=$f shl (tqwordrec(valueqb).low32 and $7);
|
|
if (regc<>r_zero) then
|
|
byte_zap(valueqa,il and $ff,state.r[regc].valueq);
|
|
end;
|
|
{ EXTLL }
|
|
$26:
|
|
begin
|
|
{ !!!!! no MSB support yet! }
|
|
shift_right_q(valueqa,(tqwordrec(valueqb).low32 and $7)*8,valueqa);
|
|
if (regc<>r_zero) then
|
|
byte_zap(valueqa,$f0,state.r[regc].valueq);
|
|
end;
|
|
{ ZAP }
|
|
$30:
|
|
begin
|
|
if regc<>r_zero then
|
|
byte_zap(valueqa,trunc(valueqb),state.r[regc].valueq);
|
|
end;
|
|
{ ZAPNOT }
|
|
$31:
|
|
begin
|
|
if regc<>r_zero then
|
|
byte_zap(valueqa,not(trunc(valueqb)),state.r[regc].valueq);
|
|
end;
|
|
{ MSKQL }
|
|
$32:
|
|
begin
|
|
{ !!!!! no MSB support yet! }
|
|
il:=$ff shl (tqwordrec(valueqb).low32 and $7);
|
|
if (regc<>r_zero) then
|
|
byte_zap(valueqa,il and $ff,state.r[regc].valueq);
|
|
end;
|
|
{ SRL }
|
|
$34:
|
|
begin
|
|
if regc<>r_zero then
|
|
state.r[regc].valueq:=state.r[regc].valueq shr (valueqb and $3f);
|
|
end;
|
|
{ EXTQL }
|
|
$36:
|
|
begin
|
|
{ !!!!! no MSB support yet! }
|
|
shift_right_q(valueqa,(tqwordrec(valueqb).low32 and $7)*8,valueqa);
|
|
if (regc<>r_zero) then
|
|
state.r[regc].valueq:=valueqa;
|
|
end;
|
|
{ SLL }
|
|
$39:
|
|
begin
|
|
if regc<>r_zero then
|
|
shift_left_q(valueqa,trunc(valueqb) and $3f,state.r[regc].valueq);
|
|
end
|
|
else
|
|
illegalopcode(instructionpc);
|
|
end;
|
|
end;
|
|
|
|
{ ************* opcode $13 ************** }
|
|
$13:
|
|
begin
|
|
rega:=(instruction and $3e00000) shr 21;
|
|
regb:=(instruction and $1f0000) shr 16;
|
|
regc:=instruction and $1f;
|
|
valueqa:=state.r[rega].valueq;
|
|
if (instruction and $1000)<>0 then
|
|
valueqb:=(instruction and $1fe000) shr 13
|
|
else
|
|
valueqb:=state.r[regb].valueq;
|
|
case (instruction and $fe0) shr 5 of
|
|
{ UMULH }
|
|
$30:
|
|
if regc<>31 then
|
|
begin
|
|
mulqword(valueqa,valueqb,oi);
|
|
state.r[regc].valueq:=towordrec(oi).high64;
|
|
end;
|
|
else
|
|
illegalopcode(instructionpc);
|
|
end;
|
|
end;
|
|
|
|
{ ************* opcode $17 ************** }
|
|
$17:
|
|
case (instruction and $ffe0) shr 5 of
|
|
{ MT_FPCR }
|
|
$24:
|
|
begin
|
|
rega:=(instruction and $3e00000) shr 21;
|
|
state.fpcr:=state.f[rega].valueq;
|
|
end;
|
|
{ MF_FPCR }
|
|
$25:
|
|
begin
|
|
rega:=(instruction and $3e00000) shr 21;
|
|
if rega<>f_zero then
|
|
state.f[rega].valueq:=state.fpcr;
|
|
end;
|
|
else
|
|
illegalopcode(instructionpc);
|
|
end;
|
|
|
|
{ ************* opcode $18 ************** }
|
|
$18:
|
|
case instruction and $ffff of
|
|
{ EXCB }
|
|
$400:
|
|
instructionignored('EXCN');
|
|
else
|
|
illegalopcode(instructionpc);
|
|
end;
|
|
|
|
{ JMP,JSR,RET JSR_COROUTINE }
|
|
$1a:
|
|
begin
|
|
rega:=(instruction and $3e00000) shr 21;
|
|
regb:=(instruction and $1f0000) shr 16;
|
|
va:=state.r[regb];
|
|
va.low32:=va.low32 and $fffffffe;
|
|
if rega<>31 then
|
|
state.r[rega].valueq:=state.pc;
|
|
state.pc:=va.valueq;
|
|
{$ifdef FASTMEM}
|
|
updatepc:=true;
|
|
{$endif FASTMEM}
|
|
end;
|
|
{ LDS }
|
|
$22:
|
|
begin
|
|
{ !!!!! no MSB support yet! }
|
|
rega:=(instruction and $3e00000) shr 21;
|
|
regb:=(instruction and $1f0000) shr 16;
|
|
va.valueq:=state.r[regb].valueq+
|
|
(int64(integer(instruction and $ffff)));
|
|
if rega<>f_zero then
|
|
begin
|
|
{ we need to copy the bit pattern! }
|
|
dword(fs):=memory.readd(va.valueq);
|
|
state.f[rega].valued:=fs;
|
|
end;
|
|
{ !!!!!! no translation exceptions! }
|
|
end;
|
|
{ LDT }
|
|
$23:
|
|
begin
|
|
{ !!!!! no MSB support yet! }
|
|
rega:=(instruction and $3e00000) shr 21;
|
|
regb:=(instruction and $1f0000) shr 16;
|
|
va.valueq:=state.r[regb].valueq+
|
|
(int64(integer(instruction and $ffff)));
|
|
if rega<>f_zero then
|
|
state.f[rega].valueq:=memory.readq(va.valueq);
|
|
{ !!!!!! no translation exceptions! }
|
|
end;
|
|
{$ifdef dummy}
|
|
{ !!!!!!!! STF }
|
|
$24:
|
|
begin
|
|
{ !!!!! no MSB support yet! }
|
|
rega:=(instruction and $3e00000) shr 21;
|
|
regb:=(instruction and $1f0000) shr 16;
|
|
va.valueq:=state.r[regb].valueq+
|
|
(int64(integer(instruction and $ffff)));
|
|
fs:=state.f[rega].valued;
|
|
memory.writed(va.valueq,longint(fs));
|
|
{ !!!!!! no tranlation exceptions! }
|
|
end;
|
|
{ !!!!!!!!!!!! STG }
|
|
$25:
|
|
begin
|
|
{ !!!!! no MSB support yet! }
|
|
rega:=(instruction and $3e00000) shr 21;
|
|
regb:=(instruction and $1f0000) shr 16;
|
|
va.valueq:=state.r[regb].valueq+
|
|
(int64(integer(instruction and $ffff)));
|
|
memory.writeq(va.valueq,state.f[rega].valueq);
|
|
{ !!!!!! no translation exceptions! }
|
|
end;
|
|
{$endif dummy}
|
|
{ !!!!!!!!!!!!! STS }
|
|
$26:
|
|
begin
|
|
{ !!!!! no MSB support yet! }
|
|
rega:=(instruction and $3e00000) shr 21;
|
|
regb:=(instruction and $1f0000) shr 16;
|
|
va.valueq:=state.r[regb].valueq+
|
|
(int64(integer(instruction and $ffff)));
|
|
fs:=state.f[rega].valued;
|
|
memory.writed(va.valueq,longint(fs));
|
|
{ !!!!!! no tranlation exceptions! }
|
|
end;
|
|
{ STT }
|
|
$27:
|
|
begin
|
|
{ !!!!! no MSB support yet! }
|
|
rega:=(instruction and $3e00000) shr 21;
|
|
regb:=(instruction and $1f0000) shr 16;
|
|
va.valueq:=state.r[regb].valueq+
|
|
(int64(integer(instruction and $ffff)));
|
|
memory.writeq(va.valueq,state.f[rega].valueq);
|
|
{ !!!!!! no translation exceptions! }
|
|
end;
|
|
{ LDL }
|
|
$28:
|
|
begin
|
|
{ !!!!! no MSB support yet! }
|
|
rega:=(instruction and $3e00000) shr 21;
|
|
regb:=(instruction and $1f0000) shr 16;
|
|
if rega<>r_zero then
|
|
state.r[rega].low32:=memory.readalignedd(state.r[regb].valueq+
|
|
(int64(integer(instruction and $ffff))));
|
|
{ sign extend }
|
|
if state.r[rega].low32<0 then
|
|
state.r[rega].high32:=$ffffffff
|
|
else
|
|
state.r[rega].high32:=0;
|
|
end;
|
|
{ LDQ }
|
|
$29:
|
|
begin
|
|
{ !!!!! no MSB support yet! }
|
|
rega:=(instruction and $3e00000) shr 21;
|
|
regb:=(instruction and $1f0000) shr 16;
|
|
if rega<>r_zero then
|
|
state.r[rega].valueq:=memory.readalignedq(state.r[regb].valueq+
|
|
(int64(integer(instruction and $ffff))));
|
|
end;
|
|
{ STL }
|
|
$2C:
|
|
begin
|
|
{ !!!!! no MSB support yet! }
|
|
rega:=(instruction and $3e00000) shr 21;
|
|
regb:=(instruction and $1f0000) shr 16;
|
|
va.valueq:=state.r[regb].valueq+
|
|
(int64(integer(instruction and $ffff)));
|
|
memory.writealignedd(va.valueq,state.r[rega].low32);
|
|
end;
|
|
{ STQ }
|
|
$2D:
|
|
begin
|
|
{ !!!!! no MSB support yet! }
|
|
rega:=(instruction and $3e00000) shr 21;
|
|
regb:=(instruction and $1f0000) shr 16;
|
|
va.valueq:=state.r[regb].valueq+
|
|
(int64(integer(instruction and $ffff)));
|
|
memory.writeq(va.valueq,state.r[rega].valueq);
|
|
end;
|
|
{ BR,BSR }
|
|
$30,$34:
|
|
begin
|
|
rega:=(instruction and $3e00000) shr 21;
|
|
if rega<>31 then
|
|
state.r[rega].valueq:=state.pc;
|
|
state.pc:=state.pc+getbranchdisp;
|
|
{$ifdef FASTMEM}
|
|
updatepc:=true;
|
|
{$endif FASTMEM}
|
|
end;
|
|
{ BLSC }
|
|
$38:
|
|
begin
|
|
rega:=(instruction and $3e00000) shr 21;
|
|
va.valueq:=state.pc+getbranchdisp;
|
|
if (state.r[rega].low32 and 1)=0 then
|
|
begin
|
|
state.pc:=va.valueq;
|
|
{$ifdef FASTMEM}
|
|
updatepc:=true;
|
|
{$endif FASTMEM}
|
|
end;
|
|
end;
|
|
{ BEQ }
|
|
$39:
|
|
begin
|
|
rega:=(instruction and $3e00000) shr 21;
|
|
va.valueq:=state.pc+getbranchdisp;
|
|
if state.r[rega].valueq=0 then
|
|
begin
|
|
state.pc:=va.valueq;
|
|
{$ifdef FASTMEM}
|
|
updatepc:=true;
|
|
{$endif FASTMEM}
|
|
end;
|
|
end;
|
|
{ BLT }
|
|
$3A:
|
|
begin
|
|
rega:=(instruction and $3e00000) shr 21;
|
|
va.valueq:=state.pc+getbranchdisp;
|
|
if state.r[rega].valueq<0 then
|
|
begin
|
|
state.pc:=va.valueq;
|
|
{$ifdef FASTMEM}
|
|
updatepc:=true;
|
|
{$endif FASTMEM}
|
|
end;
|
|
end;
|
|
{ BLE }
|
|
$3B:
|
|
begin
|
|
rega:=(instruction and $3e00000) shr 21;
|
|
va.valueq:=state.pc+getbranchdisp;
|
|
if state.r[rega].valueq<=0 then
|
|
begin
|
|
state.pc:=va.valueq;
|
|
{$ifdef FASTMEM}
|
|
updatepc:=true;
|
|
{$endif FASTMEM}
|
|
end;
|
|
end;
|
|
{ BLBS }
|
|
$3C:
|
|
begin
|
|
rega:=(instruction and $3e00000) shr 21;
|
|
va.valueq:=state.pc+getbranchdisp;
|
|
if (state.r[rega].low32 and 1)<>0 then
|
|
begin
|
|
state.pc:=va.valueq;
|
|
{$ifdef FASTMEM}
|
|
updatepc:=true;
|
|
{$endif FASTMEM}
|
|
end;
|
|
end;
|
|
{ BNE }
|
|
$3D:
|
|
begin
|
|
rega:=(instruction and $3e00000) shr 21;
|
|
va.valueq:=state.pc+getbranchdisp;
|
|
if state.r[rega].valueq<>0 then
|
|
begin
|
|
state.pc:=va.valueq;
|
|
{$ifdef FASTMEM}
|
|
updatepc:=true;
|
|
{$endif FASTMEM}
|
|
end;
|
|
end;
|
|
{ BGE }
|
|
$3E:
|
|
begin
|
|
rega:=(instruction and $3e00000) shr 21;
|
|
va.valueq:=state.pc+getbranchdisp;
|
|
if state.r[rega].valueq>=0 then
|
|
begin
|
|
state.pc:=va.valueq;
|
|
{$ifdef FASTMEM}
|
|
updatepc:=true;
|
|
{$endif FASTMEM}
|
|
end;
|
|
end;
|
|
{ BGT }
|
|
$3F:
|
|
begin
|
|
rega:=(instruction and $3e00000) shr 21;
|
|
va.valueq:=state.pc+getbranchdisp;
|
|
if state.r[rega].valueq>0 then
|
|
begin
|
|
state.pc:=va.valueq;
|
|
{$ifdef FASTMEM}
|
|
updatepc:=true;
|
|
{$endif FASTMEM}
|
|
end;
|
|
end;
|
|
else
|
|
illegalopcode(instructionpc);
|
|
end;
|
|
instrcount:=instrcount+1;
|
|
until false;
|
|
end;
|
|
|
|
destructor talphasim.done;
|
|
|
|
begin
|
|
{ deallocate memory }
|
|
{ memory.done; }
|
|
end;
|
|
|
|
procedure illelfformat;
|
|
|
|
begin
|
|
writeln('Illegal format of ELF');
|
|
halt(1);
|
|
end;
|
|
|
|
var
|
|
f : file;
|
|
elf64_hdr : telf64_hdr;
|
|
i : tindex;
|
|
j,q : qword;
|
|
b : byte;
|
|
elf64_phdr : pelf64_phdr_array;
|
|
|
|
const
|
|
et2str : array[0..6] of string[10] = ('ET_NONE','ET_REL','ET_EXEC',
|
|
'ET_DYN','ET_CORE','ET_LOPROC',
|
|
'ET_HIPROC');
|
|
em2str : array[0..11] of string[10] = ('EM_NONE','EM_M32','EM_SPARC',
|
|
'EM_386','EM_68K','EM_88K',
|
|
'EM_486','EM_860','EM_MIPS','',
|
|
'EM_MIPS_RS4_BE','EM_SPARC64');
|
|
|
|
begin
|
|
if paramcount<>1 then
|
|
begin
|
|
writeln('Usage ALPHAEMU <elf-executable>');
|
|
halt(1);
|
|
end;
|
|
{$ifdef DEBUG}
|
|
write('Init... ');
|
|
{$endif DEBUG}
|
|
assign(f,paramstr(1));
|
|
{$I-}
|
|
reset(f,1);
|
|
{$I+}
|
|
if ioresult<>0 then
|
|
begin
|
|
writeln;
|
|
writeln('Can''t open input file ',paramstr(1));
|
|
halt(1);
|
|
end;
|
|
blockread(f,elf64_hdr,sizeof(elf64_hdr));
|
|
{$ifdef DEBUG}
|
|
writeln('Signature:');
|
|
for i:=0 to 15 do
|
|
write(elf64_hdr.e_ident[i],'(',ord(elf64_hdr.e_ident[i]),') ');
|
|
writeln;
|
|
writeln('ELF type: ',et2str[elf64_hdr.e_type]);
|
|
case elf64_hdr.e_machine of
|
|
0..11:
|
|
writeln('ELF machine: ',em2str[elf64_hdr.e_machine]);
|
|
15:
|
|
writeln('ELF machine: EM_PARISC');
|
|
18:
|
|
writeln('ELF machine: EM_SPARC32PLUS');
|
|
20:
|
|
writeln('ELF machine: EM_PPC');
|
|
$9026:
|
|
writeln('ELF machine: EM_ALPHA');
|
|
else
|
|
illelfformat;
|
|
end;
|
|
|
|
writeln('ELF header size: $',hexstr(elf64_hdr.e_ehsize,8));
|
|
writeln('Entry point: $',qword2str(elf64_hdr.e_entry));
|
|
|
|
writeln('Program header table file offset: $',qword2str(elf64_hdr.e_phoff));
|
|
writeln('Number of program headers : $',hexstr(elf64_hdr.e_phnum,8));
|
|
writeln('Size of one program header: $',hexstr(elf64_hdr.e_phentsize,8));
|
|
|
|
writeln('Section header table file offset: $',qword2str(elf64_hdr.e_shoff));
|
|
{ writeln('Section name index: $',hexstr(elf64_hdr.e_shstrndx,8)); }
|
|
{$endif}
|
|
if (elf64_hdr.e_ident[0]<>chr(127)) or
|
|
(elf64_hdr.e_ident[1]<>'E') or
|
|
(elf64_hdr.e_ident[2]<>'L') or
|
|
(elf64_hdr.e_ident[3]<>'F') or
|
|
(elf64_hdr.e_type<>2) or
|
|
(elf64_hdr.e_machine<>$9026) then
|
|
illelfformat;
|
|
|
|
{ load programm headers }
|
|
getmem(elf64_phdr,elf64_hdr.e_phentsize*elf64_hdr.e_phnum);
|
|
seek(f,trunc(elf64_hdr.e_phoff));
|
|
blockread(f,elf64_phdr^,elf64_hdr.e_phentsize*elf64_hdr.e_phnum);
|
|
for i:=0 to elf64_hdr.e_phnum-1 do
|
|
begin
|
|
{$ifdef DEBUG}
|
|
writeln('Programm header ',i);
|
|
dump_phdr(elf64_phdr^[i]);
|
|
{$endif DEBUG}
|
|
end;
|
|
{ ok, now init the emulator }
|
|
sim.init;
|
|
{$ifdef FPC}
|
|
stopsim:=@_stopsim;
|
|
{$else FPC}
|
|
stopsim:=_stopsim;
|
|
{$endif FPC}
|
|
{$ifdef DEBUG}
|
|
writeln('OK');
|
|
write('Loading memory... ');
|
|
{$endif DEBUG}
|
|
{ load memory }
|
|
for i:=0 to elf64_hdr.e_phnum-1 do
|
|
begin
|
|
{$ifdef DEBUG}
|
|
write(i+1,' ');
|
|
{$endif DEBUG}
|
|
sim.memory.allocate(elf64_phdr^[i].p_vaddr,elf64_phdr^[i].p_memsz);
|
|
seek(f,trunc(elf64_phdr^[i].p_offset));
|
|
j:=0;
|
|
{ can we speedup the loading? }
|
|
if (tqwordrec(elf64_phdr^[i].p_filesz).low32 and $7)=0 then
|
|
while j<elf64_phdr^[i].p_filesz do
|
|
begin
|
|
blockread(f,q,8);
|
|
sim.memory.writeq(j+elf64_phdr^[i].p_vaddr,q);
|
|
j:=j+8;
|
|
end
|
|
else
|
|
while j<elf64_phdr^[i].p_filesz do
|
|
begin
|
|
blockread(f,b,1);
|
|
sim.memory.writeb(j+elf64_phdr^[i].p_vaddr,b);
|
|
j:=j+1;
|
|
end;
|
|
end;
|
|
{ clean up from the file loading }
|
|
freemem(elf64_phdr,elf64_hdr.e_phentsize*elf64_hdr.e_phnum);
|
|
close(f);
|
|
{$ifdef DEBUG}
|
|
writeln('OK');
|
|
writeln('Running program ...');
|
|
{$endif DEBUG}
|
|
sim.run(elf64_hdr.e_entry);
|
|
{$ifdef DEBUG}
|
|
writeln('Ready');
|
|
{$endif DEBUG}
|
|
stopsim;
|
|
sim.done;
|
|
end.
|