+ 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

utils/simulator/alphasim.pas

@@ -0,0 +1,1278 @@
+{
+    $Id$
+    This file is part of the Free Pascal simulator environment
+    Copyright (c) 1999 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
+     dos,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 = 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 = 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
+     { 64kB Stacksize }
+     stacksize = 64.0*1024.0;
+     { stack start at 4 GB }
+     stackstart = 1024.0*1024.0*1024.0*4.0-stacksize;
+  { 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: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.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 : qword);
+
+    var
+       instruction : tinstruction;
+       rega,regb,regc : tindex;
+       lit : byte;
+       va : tintreg;
+
+    function getbranchdisp : qword;
+
+      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+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+
+                     (longint(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+
+                     (longint(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+
+                   (longint(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].low32:=state.r[rega].low32 xor
+                                tqwordrec(valueqb).low32;
+                              state.r[regc].high32:=state.r[rega].high32 xor
+                                tqwordrec(valueqb).high32;
+                           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].low32:=tqwordrec(valueqa).low32 xor
+                                not(tqwordrec(valueqb).low32);
+                              state.r[regc].high32:=tqwordrec(valueqa).high32 xor
+                                not(tqwordrec(valueqb).high32);
+                           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
+                           shift_right_q(valueqa,trunc(valueqb) and $3f,state.r[regc].valueq);
+                      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+
+                   (longint(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+
+                   (longint(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+
+                   (longint(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+
+                   (longint(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+
+                   (longint(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+
+                   (longint(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+
+                     (longint(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+
+                     (longint(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+
+                   (longint(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+
+                   (longint(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.
+{
+  $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
+
+}

utils/simulator/fastmm64.pas

@@ -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
+
+}

utils/simulator/mm64.pas

@@ -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
+
+}

utils/simulator/simbase.pas

@@ -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
+
+}

utils/simulator/simlib.pas

@@ -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
+
+}