| 1 |
#!/opt/bin/perl |
| 2 |
|
| 3 |
# Copyright 2019 Marc Alexander Lehmann <schmorp@schmorp.de> |
| 4 |
# with fixes inspired by Péter Szabó (https://github.com/pts/pts-mips-emulator/) |
| 5 |
# This file is licensed under the General Public License (GPL) version 3 |
| 6 |
|
| 7 |
sub STRACE (){ 0 } |
| 8 |
sub PRCPU (){ 0 } |
| 9 |
sub PRIPS (){ 0 } |
| 10 |
|
| 11 |
use common::sense; |
| 12 |
no utf8; # activestate perl |
| 13 |
use Time::HiRes; |
| 14 |
use POSIX (); |
| 15 |
use Cwd (); |
| 16 |
use Fcntl (); |
| 17 |
|
| 18 |
pack "Q", 5; # make sure it's a 64 bit perl |
| 19 |
|
| 20 |
############################################################################# |
| 21 |
# system state |
| 22 |
|
| 23 |
use integer; # minor speed improvement |
| 24 |
|
| 25 |
sub ADDR_SHIFT(){ 16 } |
| 26 |
sub ADDR_MASK (){ 0x3fff } |
| 27 |
|
| 28 |
sub STACK (){ 0xf00f0000 } |
| 29 |
sub MINBRK (){ 0x10000000 } |
| 30 |
|
| 31 |
sub M32 (){ 0xffffffff } |
| 32 |
sub B31 (){ 0x80000000 } |
| 33 |
sub M16 (){ 0xffff } |
| 34 |
sub B15 (){ 0x8000 } |
| 35 |
sub M8 (){ 0xff } |
| 36 |
sub B7 (){ 0x80 } |
| 37 |
|
| 38 |
my @mem; # [16bits][14bits] = 32bits |
| 39 |
|
| 40 |
sub xxd($) { |
| 41 |
open my $fh, "| xxd" or die; |
| 42 |
print $fh $_[0]; |
| 43 |
} |
| 44 |
|
| 45 |
sub memset($$) { |
| 46 |
for (0 .. (length $_[1]) - 1) { |
| 47 |
my $i = $_[0] + $_; |
| 48 |
my $c = unpack "C", substr $_[1], $_, 1; |
| 49 |
|
| 50 |
my $s = (~$i & 3) << 3; |
| 51 |
$i = \$mem[$i >> ADDR_SHIFT][($i >> 2) & ADDR_MASK]; |
| 52 |
$$i = $$i & ~(0xff << $s) | ($c << $s); |
| 53 |
} |
| 54 |
} |
| 55 |
|
| 56 |
sub memget($$) { |
| 57 |
my $r; |
| 58 |
|
| 59 |
for my $i ($_[0] .. $_[0] + $_[1] - 1) { |
| 60 |
my $s = (~$i & 3) << 3; |
| 61 |
$r .= pack "C", (($mem[$i >> ADDR_SHIFT][($i >> 2) & ADDR_MASK] >> $s) & 0xff); |
| 62 |
} |
| 63 |
|
| 64 |
$r |
| 65 |
} |
| 66 |
|
| 67 |
sub memstr($) { |
| 68 |
my $r; |
| 69 |
|
| 70 |
for (my $i = $_[0]; ; ++$i) { |
| 71 |
my $s = (~$i & 3) << 3; |
| 72 |
$r .= pack "C", (($mem[$i >> ADDR_SHIFT][($i >> 2) & ADDR_MASK] >> $s) & 0xff) |
| 73 |
|| last; |
| 74 |
} |
| 75 |
|
| 76 |
$r |
| 77 |
} |
| 78 |
|
| 79 |
sub mem_reset() { |
| 80 |
@mem = (); |
| 81 |
} |
| 82 |
|
| 83 |
############################################ |
| 84 |
|
| 85 |
my ($pc, $hi, $lo, $delay); # cpu state |
| 86 |
|
| 87 |
my ( |
| 88 |
$r0 , $r1 , $r2 , $r3 , $r4 , $r5 , $r6 , $r7 , |
| 89 |
$r8 , $r9 , $r10, $r11, $r12, $r13, $r14, $r15, |
| 90 |
$r16, $r17, $r18, $r19, $r20, $r21, $r22, $r23, |
| 91 |
$r24, $r25, $r26, $r27, $r28, $r29, $r30, $r31, |
| 92 |
); |
| 93 |
|
| 94 |
my $insn; |
| 95 |
|
| 96 |
my %insn2src; # insn to perl source |
| 97 |
my %insn2sub; # insn to compiled perl sub |
| 98 |
my %sub2insn; # sub+0 to insn code |
| 99 |
|
| 100 |
{ |
| 101 |
our ($hint_bits, $warning_bits, %hint_hash); |
| 102 |
|
| 103 |
BEGIN { |
| 104 |
($hint_bits, $warning_bits, %hint_hash) = ($^H, ${^WARNING_BITS}, %^H); |
| 105 |
} |
| 106 |
|
| 107 |
sub deparse { |
| 108 |
require B::Deparse; |
| 109 |
my $deparser = new B::Deparse; |
| 110 |
$deparser->ambient_pragmas ( |
| 111 |
hint_bits => $hint_bits, |
| 112 |
warning_bits => $warning_bits, |
| 113 |
'$[' => $[+0, |
| 114 |
integer => 1, |
| 115 |
'%^H' => \%hint_hash, |
| 116 |
); |
| 117 |
$deparser->coderef2text ($_[0]) |
| 118 |
} |
| 119 |
} |
| 120 |
|
| 121 |
sub cpu_pr { |
| 122 |
printf " 0 %8x=zr %8x=at %8x=v0 %8x=v1 %8x=a0 %8x=a1 %8x=a2 %8x=a3\n", $r0 , $r1 , $r2 , $r3 , $r4 , $r5 , $r6 , $r7; |
| 123 |
printf " 8 %8x=t0 %8x=t1 %8x=t2 %8x=t3 %8x=t4 %8x=t5 %8x=t6 %8x=t7\n", $r8 , $r9 , $r10, $r11, $r12, $r13, $r14, $r15; |
| 124 |
printf "16 %8x=s0 %8x=s1 %8x=s2 %8x=s3 %8x=s4 %8x=s4 %8x=s6 %8x=s6\n", $r16, $r17, $r18, $r19, $r20, $r21, $r22, $r23; |
| 125 |
printf "24 %8x=t8 %8x=t9 %8x=k0 %8x=k1 %8x=gp %8x=sp %8x=fp %8x=ra\n", $r24, $r25, $r26, $r27, $r28, $r29, $r30, $r31; |
| 126 |
|
| 127 |
my $code = $sub2insn{$insn+0}; |
| 128 |
my $src = $insn2src{$code} ||= deparse $insn; |
| 129 |
$src =~ s/\s+/ /g; |
| 130 |
printf "%x: %08x (%s)\n", $pc * 4, $code, $src; |
| 131 |
} |
| 132 |
|
| 133 |
############################################ |
| 134 |
# syscalls |
| 135 |
|
| 136 |
# mips abi |
| 137 |
sub ENOENT (){ 2 } |
| 138 |
sub EBADF (){ 9 } |
| 139 |
sub ENOMEM (){ 12 } |
| 140 |
sub ENOTTY (){ 25 } |
| 141 |
sub ERANGE (){ 34 } |
| 142 |
sub EAGAIN (){ 35 } |
| 143 |
sub ENOTSOCK (){ 88 } |
| 144 |
sub ENOSYS (){ 89 } |
| 145 |
|
| 146 |
sub O_ACCMODE (){ 0003 } |
| 147 |
sub O_RDONLY (){ 00 } |
| 148 |
sub O_WRONLY (){ 01 } |
| 149 |
sub O_RDWR (){ 02 } |
| 150 |
sub O_APPEND (){ 0x0008 } |
| 151 |
sub O_SYNC (){ 0x0010 } |
| 152 |
sub O_NONBLOCK (){ 0x0080 } |
| 153 |
sub O_CREAT (){ 0x0100 } # not fcntl |
| 154 |
sub O_TRUNC (){ 0x0200 } # not fcntl |
| 155 |
sub O_EXCL (){ 0x0400 } # not fcntl |
| 156 |
sub O_NOCTTY (){ 0x0800 } # not fcntl |
| 157 |
sub O_ASYNC (){ 0x1000 } |
| 158 |
sub O_NOFOLLOW (){ 0x20000 } |
| 159 |
sub O_DIRECT (){ 0x8000 } |
| 160 |
sub O_DIRECTORY (){ 0x10000 } |
| 161 |
sub O_NOATIME (){ 0x40000 } |
| 162 |
|
| 163 |
sub errno2mips() { |
| 164 |
$!*1 # wrong, wrong, wrong |
| 165 |
} |
| 166 |
|
| 167 |
sub mips2omode($) { |
| 168 |
my $mmode = shift; |
| 169 |
|
| 170 |
my $omode = 0; |
| 171 |
|
| 172 |
$omode |= Fcntl::O_RDONLY if ($mmode & O_ACCMODE) == O_RDONLY; |
| 173 |
$omode |= Fcntl::O_WRONLY if ($mmode & O_ACCMODE) == O_WRONLY; |
| 174 |
$omode |= Fcntl::O_RDWR if ($mmode & O_ACCMODE) == O_RDWR; |
| 175 |
|
| 176 |
for my $mode (qw( |
| 177 |
APPEND SYNC NONBLOCK CREAT TRUNC EXCL NOCTTY |
| 178 |
ASYNC NOFOLLOW DIRECT DIRECTORY NOATIME |
| 179 |
)) { |
| 180 |
eval "\$omode |= Fcntl::O_$mode if \$mmode & O_$mode"; |
| 181 |
} |
| 182 |
|
| 183 |
$omode |
| 184 |
} |
| 185 |
|
| 186 |
my $enosys = sub { |
| 187 |
warn "unimplemented syscall $r2\n"; |
| 188 |
die; |
| 189 |
}; |
| 190 |
|
| 191 |
my @syscall = ($enosys) x 7000; |
| 192 |
|
| 193 |
############################################ |
| 194 |
|
| 195 |
my @fh; |
| 196 |
my @dh; # directory-handles, HACK |
| 197 |
my $strace; |
| 198 |
|
| 199 |
for my $fd (3..9) { |
| 200 |
open my $fh, "+<&=", $fd |
| 201 |
or next; |
| 202 |
|
| 203 |
$fh[$fd] = $fh; |
| 204 |
} |
| 205 |
for my $fd (0..2) { |
| 206 |
open my $fh, "+<&", $fd |
| 207 |
or next; |
| 208 |
|
| 209 |
$fh[$fd] = $fh; |
| 210 |
} |
| 211 |
|
| 212 |
sub fd_valid($) { |
| 213 |
!($_[0] & ~65535) |
| 214 |
&& $fh[$_[0]] |
| 215 |
} |
| 216 |
|
| 217 |
############################################ |
| 218 |
|
| 219 |
sub strace($;@) { |
| 220 |
$strace = $#_ |
| 221 |
? sprintf $_[0], @_[1..$#_] |
| 222 |
: shift; |
| 223 |
} |
| 224 |
|
| 225 |
sub newfd($) { |
| 226 |
my $fd; |
| 227 |
++$fd while $fh[$fd]; |
| 228 |
$fh[$fd] = $_[0]; |
| 229 |
$fd |
| 230 |
} |
| 231 |
|
| 232 |
sub reify_fds { |
| 233 |
my $top = 512; |
| 234 |
|
| 235 |
for my $fd (0..$#fh) { |
| 236 |
next unless $fh[$fd]; |
| 237 |
|
| 238 |
POSIX::dup2 fileno $fh[$fd], $top + $fd; |
| 239 |
close $fh[$fd]; |
| 240 |
} |
| 241 |
|
| 242 |
for my $fd (0..$#fh) { |
| 243 |
next unless $fh[$fd]; |
| 244 |
|
| 245 |
POSIX::dup2 $top + $fd, $fd; |
| 246 |
POSIX::close $top + $fd; |
| 247 |
|
| 248 |
open my $fh, "+<&=", $fd |
| 249 |
or die; |
| 250 |
|
| 251 |
$fh[$fd] = $fh; |
| 252 |
} |
| 253 |
} |
| 254 |
|
| 255 |
############################################ |
| 256 |
|
| 257 |
my $tls_udesc; |
| 258 |
|
| 259 |
sub newstat { |
| 260 |
my $buf = shift; |
| 261 |
|
| 262 |
if (@_) { |
| 263 |
my $stat = pack "N x12 NNNNN x8 N x4 NN NN NN N N x56", |
| 264 |
$_[ 0], # dev |
| 265 |
$_[ 1], # ino |
| 266 |
$_[ 2], # mode |
| 267 |
$_[ 3], # nlink |
| 268 |
$_[ 4], # uid |
| 269 |
$_[ 5], # gid |
| 270 |
$_[ 6], # rdev |
| 271 |
$_[ 7], # size |
| 272 |
$_[ 8], 0, # atime |
| 273 |
$_[ 9], 0, # mtime |
| 274 |
$_[10], 0, # ctime |
| 275 |
$_[11], # blksize |
| 276 |
$_[12]; # blocks |
| 277 |
|
| 278 |
memset $buf, $stat; |
| 279 |
|
| 280 |
return 0; |
| 281 |
} |
| 282 |
|
| 283 |
-errno2mips |
| 284 |
}; |
| 285 |
|
| 286 |
sub stat64 { |
| 287 |
my $buf = shift; |
| 288 |
|
| 289 |
if (@_) { |
| 290 |
my $stat = pack "N x12 NN NNNNN x12 NN NN NN NN N x4 NN", |
| 291 |
$_[ 0], # dev |
| 292 |
$_[ 1] >> 32, $_[1], # ino |
| 293 |
$_[ 2], # mode |
| 294 |
$_[ 3], # nlink |
| 295 |
$_[ 4], # uid |
| 296 |
$_[ 5], # gid |
| 297 |
$_[ 6], # rdev |
| 298 |
$_[ 7] >> 32, $_[7], # size |
| 299 |
$_[ 8], 0, # atime |
| 300 |
$_[ 9], 0, # mtime |
| 301 |
$_[10], 0, # ctime |
| 302 |
$_[11], # blksize |
| 303 |
$_[12] >> 32, $_[12]; # blocks |
| 304 |
|
| 305 |
memset $buf, $stat; |
| 306 |
|
| 307 |
return 0; |
| 308 |
} |
| 309 |
|
| 310 |
-errno2mips |
| 311 |
}; |
| 312 |
|
| 313 |
sub sys_fcntl { |
| 314 |
my ($fd, $cmd, $arg) = @_; |
| 315 |
strace "fcntl (%d, %x, %x)", $fd, $cmd, $arg; |
| 316 |
fd_valid $fd or return -EBADF; |
| 317 |
|
| 318 |
if ($cmd == 0) { # F_DUPFD |
| 319 |
++$arg while $fh[$arg]; |
| 320 |
open my $fh, "+<&", fileno $fh[$fd] |
| 321 |
or return -errno2mips; |
| 322 |
$fh[$arg] = $fh; |
| 323 |
return $arg; |
| 324 |
} elsif ($cmd == 1) { # F_GETFD |
| 325 |
return fcntl $fh[$fd], Fcntl::F_GETFD, 0; |
| 326 |
} elsif ($cmd == 2) { # F_SETFD |
| 327 |
return +(fcntl $fh[$fd], Fcntl::F_SETFD, $arg+0) |
| 328 |
? 0 : -errno2mips; |
| 329 |
} elsif ($cmd == 3) { # F_GETFL |
| 330 |
return O_RDWR; # HACK |
| 331 |
} else { |
| 332 |
# 4 F_SETFL |
| 333 |
warn sprintf"unknown fcntl %d,%x,%x\n", $fd, $cmd, $arg; |
| 334 |
} |
| 335 |
|
| 336 |
-ENOSYS |
| 337 |
}; |
| 338 |
|
| 339 |
############################################ |
| 340 |
|
| 341 |
$syscall[4001] = sub { # exit |
| 342 |
strace "exit ($_[0])"; |
| 343 |
exit $_[0]; |
| 344 |
}; |
| 345 |
$syscall[4002] = sub { # fork |
| 346 |
strace "fork"; |
| 347 |
|
| 348 |
my $pid = fork; |
| 349 |
return -errno2mips unless defined $pid; |
| 350 |
$pid |
| 351 |
}; |
| 352 |
$syscall[4003] = sub { # read |
| 353 |
my ($fd, $rbuf, $count) = @_; |
| 354 |
strace "read (%d, %x, %d)", $fd, $rbuf, $count; |
| 355 |
|
| 356 |
$count = sysread $fh[$fd], my $buf, $count; |
| 357 |
|
| 358 |
memset $rbuf, $buf; |
| 359 |
|
| 360 |
defined $count ? $count : -errno2mips |
| 361 |
}; |
| 362 |
|
| 363 |
$syscall[4004] = sub { # write |
| 364 |
my ($fd, $buf, $count) = @_; |
| 365 |
strace "write (%d, %x, %d)", $fd, $buf, $count; |
| 366 |
|
| 367 |
$count = syswrite $fh[$fd], memget $buf, $count; |
| 368 |
defined $count ? $count : -errno2mips |
| 369 |
}; |
| 370 |
$syscall[4005] = sub { # open |
| 371 |
my ($path, $flags, $mode) = @_; |
| 372 |
$path = memstr $path; |
| 373 |
strace "open (%s, %x, %o)", $path, $flags, $mode; |
| 374 |
|
| 375 |
if (opendir my $dh, $path) {#d# |
| 376 |
open my $fh, "</dev/null"or die; |
| 377 |
my $fd = newfd $fh; |
| 378 |
$dh[$fd] = $dh; |
| 379 |
return $fd; |
| 380 |
} |
| 381 |
|
| 382 |
sysopen my $fh, $path, mips2omode $flags, $mode |
| 383 |
or return -errno2mips; |
| 384 |
|
| 385 |
newfd $fh |
| 386 |
}; |
| 387 |
$syscall[4006] = sub { # close |
| 388 |
my ($fd) = @_; |
| 389 |
strace "close ($fd)"; |
| 390 |
fd_valid $fd or return -EBADF; |
| 391 |
|
| 392 |
undef $dh[$fd];#d# |
| 393 |
(close delete $fh[$fd]) |
| 394 |
? 0 : -errno2mips |
| 395 |
}; |
| 396 |
|
| 397 |
$syscall[4010] = sub { # unlink |
| 398 |
my ($path) = @_; |
| 399 |
$path = memstr $path; |
| 400 |
strace "unlink (%s)", $path; |
| 401 |
|
| 402 |
(defined unlink $path) |
| 403 |
? 0 : -errno2mips |
| 404 |
}; |
| 405 |
$syscall[4011] = sub { # execve |
| 406 |
my ($path, $argv, $envv) = @_; |
| 407 |
$path = memstr $path; |
| 408 |
|
| 409 |
for my $vec ($argv, $envv) { |
| 410 |
my $addr = $vec; |
| 411 |
$vec = []; |
| 412 |
while () { |
| 413 |
my $ptr = unpack "N", memget $addr, 4 |
| 414 |
or last; |
| 415 |
push @$vec, memstr $ptr; |
| 416 |
$addr += 4; |
| 417 |
} |
| 418 |
} |
| 419 |
|
| 420 |
local %ENV; |
| 421 |
/([^=]*)=(.*)/s, $ENV{$1} = $2 |
| 422 |
for @$envv; |
| 423 |
|
| 424 |
($path, $argv->[0]) = ($argv->[0], $path); |
| 425 |
|
| 426 |
reify_fds; |
| 427 |
|
| 428 |
exec {$path} @$argv; |
| 429 |
|
| 430 |
# not normally printed... |
| 431 |
strace "execve (%s, [%s], [%s])", $path, (join "|", @$argv), (join "|", @$envv); |
| 432 |
|
| 433 |
-errno2mips |
| 434 |
}; |
| 435 |
$syscall[4012] = sub { # chdir |
| 436 |
my $path = memstr $_[0]; |
| 437 |
strace "chdir (%s)", $path; |
| 438 |
|
| 439 |
(chdir $path) ? 0 : -errno2mips |
| 440 |
}; |
| 441 |
$syscall[4013] = sub { # time |
| 442 |
my ($rbuf) = @_; |
| 443 |
strace "time (%x)", $rbuf; |
| 444 |
|
| 445 |
my $time = time; |
| 446 |
|
| 447 |
memset $rbuf, pack "N", $time; |
| 448 |
$time |
| 449 |
}; |
| 450 |
|
| 451 |
$syscall[4019] = sub { # lseek |
| 452 |
my ($fd, $offset, $whence) = @_; |
| 453 |
strace "lseek (%d, %x, %d)", $fd, $offset, $whence; |
| 454 |
|
| 455 |
my $res = sysseek $fh[$fd], $offset, $whence; |
| 456 |
|
| 457 |
defined $res |
| 458 |
? $res : -errno2mips |
| 459 |
}; |
| 460 |
|
| 461 |
$syscall[4020] = sub { strace "getpid ()"; $$ }; |
| 462 |
|
| 463 |
$syscall[4024] = sub { strace "getuid ()"; $< }; |
| 464 |
|
| 465 |
$syscall[4033] = sub { # access |
| 466 |
my ($path, $mode) = @_; |
| 467 |
$path = memstr $path; |
| 468 |
strace "acess (%s, %o)", $path, $mode; |
| 469 |
|
| 470 |
0 |
| 471 |
|
| 472 |
}; |
| 473 |
|
| 474 |
$syscall[4037] = sub { # kill |
| 475 |
strace "kill ($_[0], $_[1])"; |
| 476 |
|
| 477 |
(kill $_[1], $_[0]) # todo signal numbers? |
| 478 |
? 0 : -errno2mips |
| 479 |
}; |
| 480 |
|
| 481 |
$syscall[4041] = sub { # dup |
| 482 |
my ($fd) = @_; |
| 483 |
strace "dup ($fd)"; |
| 484 |
fd_valid $fd or return -EBADF; |
| 485 |
|
| 486 |
open my $fh, "+<&", fileno $fh[$fd] |
| 487 |
or return -errno2mips; |
| 488 |
|
| 489 |
newfd $fh |
| 490 |
}; |
| 491 |
$syscall[4042] = sub { # sysm_pipe |
| 492 |
strace "sysm_pipe ()"; |
| 493 |
|
| 494 |
pipe my $r, my $w |
| 495 |
or return -errno2mips; |
| 496 |
|
| 497 |
$r = newfd $r; |
| 498 |
$w = newfd $w; |
| 499 |
|
| 500 |
strace "sysm_pipe ($r, $w)"; |
| 501 |
|
| 502 |
$r3 = $w; |
| 503 |
$r |
| 504 |
}; |
| 505 |
|
| 506 |
$syscall[4045] = sub { # brk |
| 507 |
strace "brk (%x)", $_[0]; |
| 508 |
my $brk = $_[0]; |
| 509 |
$brk = MINBRK if $brk < MINBRK; |
| 510 |
$brk |
| 511 |
}; # brk |
| 512 |
|
| 513 |
$syscall[4047] = sub { strace "getgid ()" ; $( }; |
| 514 |
|
| 515 |
$syscall[4049] = sub { strace "geteuid ()"; $> }; |
| 516 |
$syscall[4050] = sub { strace "getegid ()"; $) }; |
| 517 |
|
| 518 |
$syscall[4054] = sub { # ioctl |
| 519 |
my ($fd, $req, $arg) = @_; |
| 520 |
strace "ioctl (%d, %x, %x)", $fd, $req, $arg; |
| 521 |
fd_valid $fd or return -EBADF; |
| 522 |
|
| 523 |
if ($req == 0x540d) { # TCGETS |
| 524 |
if (-t $fh[$fd]) { |
| 525 |
memset $arg, pack "NNNN C C23"; |
| 526 |
return 0; |
| 527 |
} |
| 528 |
} elsif ($req == 0x540f) { # TCSETW |
| 529 |
return 0; |
| 530 |
} elsif ($req == 0x40047477) { # TIOCGPGRP # irix??? |
| 531 |
memset $arg, pack "N", getpgrp; # hacky, but does... |
| 532 |
return 0; |
| 533 |
} elsif ($req == 0x80047476) { # TIOCSPGRP # irix??? |
| 534 |
return 0; # whatever you say... |
| 535 |
} elsif ($req == 0x40087468) { # TIOCGWINSZ |
| 536 |
return -ENOSYS; |
| 537 |
} else { |
| 538 |
warn sprintf"unknown ioctl %d,%x,%x\n", $fd, $req, $arg; |
| 539 |
} |
| 540 |
|
| 541 |
-ENOTTY |
| 542 |
}; |
| 543 |
$syscall[4055] = \&sys_fcntl; # fcntl |
| 544 |
|
| 545 |
$syscall[4057] = sub { # getpgid |
| 546 |
strace "getpgid ($_[0])"; |
| 547 |
|
| 548 |
$_[0] == $$ |
| 549 |
? getpgrp : $$ # hacky, but it's a bsd'ism |
| 550 |
}; |
| 551 |
|
| 552 |
$syscall[4060] = sub { strace "umask (%o)", $_[0]; umask $_[0] }; |
| 553 |
|
| 554 |
$syscall[4063] = sub { # dup2 |
| 555 |
my ($fd1, $fd2) = @_; |
| 556 |
strace "dup2 ($fd1, $fd2)"; |
| 557 |
fd_valid $fd1 or return -EBADF; |
| 558 |
|
| 559 |
open my $fh, "+<&", fileno $fh[$fd1] |
| 560 |
or return -errno2mips; |
| 561 |
|
| 562 |
$dh[$fd2] = $dh[$fd1]; |
| 563 |
$fh[$fd2] = $fh; |
| 564 |
$fd2 |
| 565 |
}; |
| 566 |
|
| 567 |
$syscall[4064] = sub { strace "getppid ()"; getppid }; |
| 568 |
$syscall[4065] = sub { strace "getpgrp ()"; getpgrp }; |
| 569 |
|
| 570 |
$syscall[4075] = sub { # setrlimit |
| 571 |
my ($resource, $rlim) = @_; |
| 572 |
strace "setrlimit (%d, %x)", $resource, $rlim; |
| 573 |
|
| 574 |
0 |
| 575 |
}; |
| 576 |
$syscall[4076] = sub { # getrlimit |
| 577 |
my ($resource, $rlim) = @_; |
| 578 |
strace "getrlimit (%d, %x)", $resource, $rlim; |
| 579 |
|
| 580 |
-ENOSYS |
| 581 |
}; |
| 582 |
|
| 583 |
$syscall[4078] = sub { # gettimeofday |
| 584 |
my ($tv, $tz) = @_; |
| 585 |
strace "gettimeofday (%x, %x)", $tv, $tz; |
| 586 |
|
| 587 |
my ($s, $m) = Time::HiRes::gettimeofday; |
| 588 |
memset $tv, pack "NN", $s, $m if $tv; |
| 589 |
memset $tz, pack "NN", 0, 0 if $tz; # minuteswest, dsttime |
| 590 |
|
| 591 |
0 |
| 592 |
}; |
| 593 |
|
| 594 |
$syscall[4080] = sub { # getgroups |
| 595 |
0 |
| 596 |
}; |
| 597 |
|
| 598 |
my $mmap_base = 0x1000; |
| 599 |
|
| 600 |
$syscall[4090] = sub { |
| 601 |
my ($addr, $length, $prot, $flags, $fd, $offset) = @_; |
| 602 |
strace "mips_mmap (%x, %d, %x, %x, %d, %d)", @_; |
| 603 |
|
| 604 |
return -ENOSYS |
| 605 |
if $flags & 0x001; # MAP_SHARED |
| 606 |
|
| 607 |
unless ($addr) { |
| 608 |
$addr = $mmap_base; |
| 609 |
$mmap_base += ($length + 4095) & ~4096; |
| 610 |
} |
| 611 |
|
| 612 |
if ($fd >= 0) { |
| 613 |
my $old = sysseek $fh[$fd], $offset, 0; |
| 614 |
sysread $fh[$fd], my $buf, $length; |
| 615 |
memset $addr, $buf; |
| 616 |
sysseek $fh[$fd], $old, 0; |
| 617 |
} |
| 618 |
|
| 619 |
$addr |
| 620 |
}; |
| 621 |
|
| 622 |
$syscall[4097] = sub { # setpriority |
| 623 |
# ... |
| 624 |
-ENOSYS |
| 625 |
}; |
| 626 |
|
| 627 |
$syscall[4099] = sub { # statfs |
| 628 |
my ($path, $buf) = @_; |
| 629 |
$path = memstr $path; |
| 630 |
strace "statfs (%s, %x)", $path, $buf; |
| 631 |
|
| 632 |
-ENOSYS |
| 633 |
}; |
| 634 |
$syscall[4100] = sub { # fstatfs |
| 635 |
my ($fd, $buf) = @_; |
| 636 |
strace "fstatfs (%d, %x)", $fd, $buf; |
| 637 |
|
| 638 |
-ENOSYS |
| 639 |
}; |
| 640 |
|
| 641 |
$syscall[4106] = sub { # newstat |
| 642 |
my ($path, $buf) = @_; |
| 643 |
$path = memstr $path; |
| 644 |
strace "newstat (%s, %x)", $path, $buf; |
| 645 |
|
| 646 |
newstat $buf, stat $path |
| 647 |
}; |
| 648 |
$syscall[4107] = sub { # newlstat |
| 649 |
my ($path, $buf) = @_; |
| 650 |
$path = memstr $path; |
| 651 |
strace "newlstat (%s, %x)", $path, $buf; |
| 652 |
|
| 653 |
newstat $buf, lstat $path |
| 654 |
}; |
| 655 |
$syscall[4108] = sub { # newfstat |
| 656 |
my ($fd, $buf) = @_; |
| 657 |
strace "newfstat (%d, %x)", $fd, $buf; |
| 658 |
|
| 659 |
newstat $buf, stat $fh[$fd] |
| 660 |
}; |
| 661 |
|
| 662 |
$syscall[4114] = sub { # wait4 |
| 663 |
my ($pid, $statusbuf, $options, $rusage) = @_; |
| 664 |
$pid = unpack "l", pack "L", $pid; |
| 665 |
strace "wait4 (%d, %x, %x, %x)", $pid, $statusbuf, $options, $rusage; |
| 666 |
|
| 667 |
memset $rusage, "\x00" x 72 |
| 668 |
if $rusage; |
| 669 |
|
| 670 |
$pid = waitpid $pid, $options; |
| 671 |
|
| 672 |
memset $statusbuf, pack "N", $? if $statusbuf; |
| 673 |
|
| 674 |
$pid >= 0 ? $pid : -errno2mips |
| 675 |
}; |
| 676 |
|
| 677 |
$syscall[4122] = sub { # newuname |
| 678 |
my ($buf) = @_; |
| 679 |
strace "newuname (%x)", $buf; |
| 680 |
|
| 681 |
memset $buf, pack "a65 a65 a65 a65 a65 a65", #d# |
| 682 |
"Linux", # sysname |
| 683 |
"nodename", |
| 684 |
"4.4-perl", # release |
| 685 |
"#201901240000 Thu Jan 24 13:59:03 CET 2019", # version |
| 686 |
"mips", # machine |
| 687 |
"(none)"; # domainname |
| 688 |
|
| 689 |
0 |
| 690 |
}; |
| 691 |
|
| 692 |
$syscall[4146] = sub { # writev |
| 693 |
my ($fd, $iov, $iovcnt) = @_; |
| 694 |
|
| 695 |
strace "writev (%d, %x, %d)", $fd, $iov, $iovcnt; |
| 696 |
|
| 697 |
my $data; |
| 698 |
|
| 699 |
while ($iovcnt--) { |
| 700 |
my ($base, $len) = unpack "NN", memget $iov, 8; |
| 701 |
$data .= memget $base, $len; |
| 702 |
$iov += 8; |
| 703 |
} |
| 704 |
|
| 705 |
my $len = syswrite $fh[$fd], $data; |
| 706 |
defined $len ? $len : -errno2mips |
| 707 |
}; |
| 708 |
|
| 709 |
$syscall[4140] = sub { # llseek |
| 710 |
my ($fd, $high, $low, $result, $whence) = @_; |
| 711 |
strace "llseek (%d, %x, %08x, %x, %d)", $fd, $high, $low, $result, $whence; |
| 712 |
|
| 713 |
my $res = sysseek $fh[$fd], ($high << 32) | $low, $whence; |
| 714 |
|
| 715 |
memset $result, pack "NN", ($res >> 32), $res; |
| 716 |
|
| 717 |
defined $res |
| 718 |
? 0 : -errno2mips |
| 719 |
}; |
| 720 |
|
| 721 |
$syscall[4171] = sub { # getpeername |
| 722 |
-ENOTSOCK |
| 723 |
}; |
| 724 |
|
| 725 |
$syscall[4194] = sub { # sigaction |
| 726 |
my ($signum, $act, $oldact) = @_; |
| 727 |
strace "sigaction (%d, %x, %x)", $signum, $act, $oldact; |
| 728 |
-ENOSYS |
| 729 |
}; |
| 730 |
$syscall[4195] = sub { # sigprocmask |
| 731 |
my ($how, $set, $oldset) = @_; |
| 732 |
strace "sigprocmask ($how, $set, $oldset)"; |
| 733 |
|
| 734 |
-ENOSYS |
| 735 |
}; |
| 736 |
|
| 737 |
$syscall[4203] = sub { # getcwd |
| 738 |
my $cwd = Cwd::getcwd; |
| 739 |
strace "getcwd (%x, %d)", $_[0], $_[1]; |
| 740 |
|
| 741 |
if ((length $cwd) < $_[1]) { |
| 742 |
memset $_[0], "$cwd\x00"; |
| 743 |
return 1 + length $cwd; |
| 744 |
} else { |
| 745 |
return -ERANGE; |
| 746 |
} |
| 747 |
}; |
| 748 |
|
| 749 |
$syscall[4213] = sub { # stat64 |
| 750 |
my ($path, $buf) = @_; |
| 751 |
$path = memstr $path; |
| 752 |
strace "stat64 (%s, %x)", $path, $buf; |
| 753 |
|
| 754 |
stat64 $buf, stat $path |
| 755 |
}; |
| 756 |
$syscall[4214] = sub { # lstat64 |
| 757 |
my ($path, $buf) = @_; |
| 758 |
$path = memstr $path; |
| 759 |
strace "lstat64 (%s, %x)", $path, $buf; |
| 760 |
|
| 761 |
stat64 $buf, lstat $path |
| 762 |
}; |
| 763 |
$syscall[4215] = sub { # fstat64 |
| 764 |
my ($fd, $buf) = @_; |
| 765 |
strace "fstat64 (%d, %x)", $fd, $buf; |
| 766 |
|
| 767 |
stat64 $buf, stat $fh[$fd] |
| 768 |
}; |
| 769 |
|
| 770 |
$syscall[4219] = sub { # getdents64 |
| 771 |
my ($fd, $dirp, $count) = @_; |
| 772 |
strace "getdents64 (%d, %x, %d)", $fd, $dirp, $count; |
| 773 |
|
| 774 |
my $name = readdir $dh[$fd]; |
| 775 |
|
| 776 |
return 0 unless defined $name; |
| 777 |
|
| 778 |
my $ino = -1; |
| 779 |
my $type = 0; |
| 780 |
|
| 781 |
my $entry = pack "NN NN n C Z*", |
| 782 |
$ino >> 32, $ino, |
| 783 |
0, 0, # offset |
| 784 |
(length $name) + 20, |
| 785 |
$type, |
| 786 |
$name; |
| 787 |
|
| 788 |
memset $dirp, $entry; |
| 789 |
length $entry |
| 790 |
}; |
| 791 |
$syscall[4220] = \&sys_fcntl; # fcntl64 |
| 792 |
|
| 793 |
$syscall[4246] = sub { # exit_group |
| 794 |
POSIX::exit $_[0]; |
| 795 |
}; |
| 796 |
|
| 797 |
$syscall[4283] = sub { # set_thread_area |
| 798 |
my ($udesc) = @_; |
| 799 |
|
| 800 |
strace "set_thread_area (%x)", $udesc; |
| 801 |
|
| 802 |
$tls_udesc = $udesc; |
| 803 |
|
| 804 |
return 0; |
| 805 |
}; |
| 806 |
|
| 807 |
$syscall[4300] = sub { # faccessat |
| 808 |
my ($dirfd, $path, $mode, $flags) = @_; |
| 809 |
|
| 810 |
strace "faccessat (%d, %s, %o, %x)", $dirfd, $path, $mode, $flags; |
| 811 |
|
| 812 |
0 # #d# grant any access |
| 813 |
}; |
| 814 |
|
| 815 |
sub sys { |
| 816 |
my @args = map $_*1, |
| 817 |
$r4, $r5, $r6, $r7, # first four args in regs |
| 818 |
# extra arguments on stack |
| 819 |
$mem[($r29 + 16) >> ADDR_SHIFT][(($r29 + 16) >> 2) & ADDR_MASK], |
| 820 |
$mem[($r29 + 20) >> ADDR_SHIFT][(($r29 + 20) >> 2) & ADDR_MASK], |
| 821 |
$mem[($r29 + 24) >> ADDR_SHIFT][(($r29 + 24) >> 2) & ADDR_MASK], |
| 822 |
$mem[($r29 + 28) >> ADDR_SHIFT][(($r29 + 28) >> 2) & ADDR_MASK], |
| 823 |
; |
| 824 |
|
| 825 |
$strace = "$r2 (@args)"; |
| 826 |
my $retval = $syscall[$r2](@args); |
| 827 |
print STDERR "$$ SYS_$strace = $retval\n" if STRACE; |
| 828 |
|
| 829 |
if ($retval > -4096 && $retval < 0) { |
| 830 |
$r2 = -$retval; |
| 831 |
$r7 = 1; |
| 832 |
} else { |
| 833 |
$r2 = $retval; |
| 834 |
$r7 = 0; |
| 835 |
} |
| 836 |
} |
| 837 |
|
| 838 |
############################################################################# |
| 839 |
# mips i big endian cpu emulator |
| 840 |
|
| 841 |
############################################ |
| 842 |
# specials (opcode 0) |
| 843 |
|
| 844 |
my ($s, $t, $i); # temporary per-insn variables, declared globally for speed |
| 845 |
|
| 846 |
my @special = ('die sprintf "special %d in %08x \@ 0x%08x not supported\n", INSN & 63, INSN, $pc << 2') x 64; |
| 847 |
|
| 848 |
$special[ 0] = "RD = (RT << SA ) & M32"; # sll |
| 849 |
|
| 850 |
$special[ 2] = 'RD = RT >> SA '; # srl |
| 851 |
|
| 852 |
$special[ 3] = 'RD = ((RT - ((RT & B31) << 1)) >> SA ) & M32'; # sra |
| 853 |
$special[ 4] = 'RD = (RT << (RS & 31)) & M32'; # sllv |
| 854 |
|
| 855 |
$special[ 6] = 'RD = RT >> (RS & 31) '; # srlv |
| 856 |
$special[ 7] = 'RD = ((RT - ((RT & B31) << 1)) >> (RS & 31)) & M32'; # srav |
| 857 |
$special[ 8] = ' $pc = RS >> 2'; # jr |
| 858 |
$special[ 9] = 'RD = $pc << 2; $pc = RS >> 2'; # jalr |
| 859 |
|
| 860 |
$special[10] = 'RD = RS unless RT'; # movz, MIPS IV |
| 861 |
$special[11] = 'RD = RS if RT'; # movn, MIPS IV |
| 862 |
|
| 863 |
$special[12] = "sys"; |
| 864 |
$special[13] = 'die sprintf "BREAK %0x8x \@ 0x%08x\n", INSN, $pc << 2'; # break |
| 865 |
|
| 866 |
$special[15] = ''; # sync, mips2 |
| 867 |
$special[16] = 'RD = $hi'; # mfhi |
| 868 |
$special[17] = '$hi = RS'; # mthi |
| 869 |
$special[18] = 'RD = $lo'; # mflo |
| 870 |
$special[19] = '$lo = RS'; # mtlo |
| 871 |
|
| 872 |
$special[24] = '# mult |
| 873 |
$lo = (RS - ((RS & B31) << 1)) |
| 874 |
* (RT - ((RT & B31) << 1)); |
| 875 |
$hi = ($lo >> 32) & M32; |
| 876 |
$lo &= M32; |
| 877 |
'; |
| 878 |
$special[25] = ' # multu |
| 879 |
no integer; |
| 880 |
$lo = RS * RT; |
| 881 |
$hi = $lo >> 32; |
| 882 |
$lo &= M32; |
| 883 |
'; |
| 884 |
$special[26] = ' # div |
| 885 |
$s = RS - ((RS & B31) << 1); |
| 886 |
$t = RT - ((RT & B31) << 1) |
| 887 |
or return; |
| 888 |
|
| 889 |
$lo = ($s / $t) & M32; |
| 890 |
$hi = ($s % $t) & M32; |
| 891 |
'; |
| 892 |
$special[27] = ' # divu |
| 893 |
RT or return; |
| 894 |
|
| 895 |
no integer; |
| 896 |
$lo = int (RS / RT) & M32; |
| 897 |
$hi = (RS - $lo * RT) & M32; |
| 898 |
'; |
| 899 |
|
| 900 |
$special[32] = 'die "add instruction unsupported"'; |
| 901 |
$special[33] = "RD = (RS + RT) & M32"; # addu |
| 902 |
$special[34] = 'die "sub instruction unsupported"'; |
| 903 |
$special[35] = "RD = (RS - RT) & M32"; # subu |
| 904 |
#$special[32] = $special[33]; # add # buggy, does not trap #d# |
| 905 |
#$special[34] = $special[35]; # sub # buggy, does not trap #d# |
| 906 |
|
| 907 |
$special[36] = "RD = RS & RT "; # and |
| 908 |
$special[37] = "RD = RS | RT "; # or |
| 909 |
$special[38] = "RD = RS ^ RT "; # xor |
| 910 |
$special[39] = "RD = (RS ^ RT) ^ M32"; # nor |
| 911 |
|
| 912 |
$special[42] = "RD = (RS - ((RS & B31) << 1)) < (RT - ((RT & B31) << 1))"; # slt |
| 913 |
$special[43] = "RD = RS < RT "; # sltu |
| 914 |
|
| 915 |
# implement some trap insns from mips2, but not all |
| 916 |
$special[52] = 'die sprintf "TRAP %0x8x \@ 0x%08x\n", INSN, $pc << 2 unless RS'; # teq, mips2 |
| 917 |
$special[54] = 'die sprintf "TRAP %0x8x \@ 0x%08x\n", INSN, $pc << 2 if RS'; # tne, mips2 |
| 918 |
|
| 919 |
############################################ |
| 920 |
# regimm (opcode 1) |
| 921 |
|
| 922 |
my @regimm = ('die sprintf "regimm %08x \@ 0x%08x not supported\n", INSN & 63, $pc << 2') x 64; |
| 923 |
|
| 924 |
$regimm[ 0] = ' $pc += IMM - 1 if RS & 0x80000000'; # bltz |
| 925 |
$regimm[16] = '$r31 = $pc << 2; $pc += IMM - 1 if RS & 0x80000000'; # bltzal |
| 926 |
$regimm[ 1] = ' $pc += IMM - 1 unless RS & 0x80000000'; # bgez |
| 927 |
$regimm[17] = '$r31 = $pc << 2; $pc += IMM - 1 unless RS & 0x80000000'; # bgezal bal |
| 928 |
|
| 929 |
############################################ |
| 930 |
# others |
| 931 |
|
| 932 |
my @opcode = (sub { 'die sprintf "opcode %d in %08x \@ 0x%08x not supported\n", INSN >> 26, INSN, $pc << 2' }) x 64; |
| 933 |
|
| 934 |
$opcode[ 0] = sub { $special[$insn & 63] }; # special |
| 935 |
$opcode[ 1] = sub { $regimm[($insn >> 16) & 31] }; # regimm |
| 936 |
$opcode[ 2] = sub { ' $pc = ($pc & 0x3c000000) | (' . $insn . ' & 0x03ffffff)' }; # j |
| 937 |
$opcode[ 3] = sub { '$r31 = $pc << 2; $pc = ($pc & 0x3c000000) | (' . $insn . ' & 0x03ffffff)' }; # jal |
| 938 |
$opcode[ 4] = sub { '$pc += IMM - 1 if RS == RT' }; # beq beqz b |
| 939 |
$opcode[ 5] = sub { '$pc += IMM - 1 if RS != RT' }; # bne bnez |
| 940 |
$opcode[ 6] = sub { '$pc += IMM - 1 if !RS || RS >= 0x80000000' }; # blez |
| 941 |
$opcode[ 7] = sub { '$pc += IMM - 1 if RS && RS < 0x80000000' }; # bgtz |
| 942 |
$opcode[ 8] = sub { die "addi instruction unsupported" }; # addi |
| 943 |
$opcode[ 9] = sub { "RT = (RS + IMM) & M32" }; # addiu |
| 944 |
$opcode[10] = sub { 'RT = ((RS - ((RS & B31) << 1))) < IMM ' }; # slti |
| 945 |
$opcode[11] = sub { 'RT = RS < (IMM & M32)' }; # sltiu |
| 946 |
$opcode[12] = sub { 'RT = RS & IMMU' }; # andi |
| 947 |
$opcode[13] = sub { 'RT = RS | IMMU' }; # ori |
| 948 |
$opcode[14] = sub { 'RT = RS ^ IMMU' }; # xori |
| 949 |
$opcode[15] = sub { 'RT = IMMU << 16' }; # lui |
| 950 |
|
| 951 |
# opcode 28 is SPECIAL2, extended mips32 |
| 952 |
|
| 953 |
$opcode[32] = sub {' # lb |
| 954 |
$i = RS + IMM; |
| 955 |
$s = (~$i & 3) << 3; |
| 956 |
$s = $mem[$i >> ADDR_SHIFT][($i >> 2) & ADDR_MASK] >> $s; |
| 957 |
RT = (($s & M8) - (($s & B7) << 1)) & M32; |
| 958 |
'}; |
| 959 |
$opcode[33] = sub {' # lh |
| 960 |
$i = RS + IMM; |
| 961 |
$s = (~$i & 2) << 3; |
| 962 |
$s = $mem[$i >> ADDR_SHIFT][($i >> 2) & ADDR_MASK] >> $s; |
| 963 |
RT = (($s & M16) - (($s & B15) << 1)) & M32; |
| 964 |
'}; |
| 965 |
$opcode[34] = sub {' # lwl |
| 966 |
$i = RS + IMM; |
| 967 |
$s = ($i & 3) << 3; |
| 968 |
$i = $mem[$i >> ADDR_SHIFT][($i >> 2) & ADDR_MASK]; |
| 969 |
RT = (RT & (M32 >> (32 - $s))) | ($i << $s & M32); |
| 970 |
'}; |
| 971 |
$opcode[35] = sub {' # lw |
| 972 |
$i = RS + IMM; |
| 973 |
RT = $mem[$i >> ADDR_SHIFT][($i >> 2) & ADDR_MASK]; |
| 974 |
'}; |
| 975 |
$opcode[36] = sub {' # lbu |
| 976 |
$i = RS + IMM; |
| 977 |
$s = (~$i & 3) << 3; |
| 978 |
RT = ($mem[$i >> ADDR_SHIFT][($i >> 2) & ADDR_MASK] >> $s) & M8; |
| 979 |
'}; |
| 980 |
$opcode[37] = sub {' # lhu |
| 981 |
$i = RS + IMM; |
| 982 |
$s = (~$i & 2) << 3; |
| 983 |
RT = ($mem[$i >> ADDR_SHIFT][($i >> 2) & ADDR_MASK] >> $s) & M16; |
| 984 |
'}; |
| 985 |
$opcode[38] = sub {' # lwr |
| 986 |
$i = RS + IMM; |
| 987 |
$s = (($i & 3) + 1) << 3; |
| 988 |
$i = $mem[$i >> ADDR_SHIFT][($i >> 2) & ADDR_MASK]; |
| 989 |
RT = (RT >> $s << $s) | ($i >> (32 - $s)); |
| 990 |
'}; |
| 991 |
|
| 992 |
$opcode[40] = sub {' # sb |
| 993 |
$i = RS + IMM; |
| 994 |
$s = (~$i & 3) << 3; |
| 995 |
$i = \$mem[$i >> ADDR_SHIFT][($i >> 2) & ADDR_MASK]; |
| 996 |
$$i = ($$i & ~(M8 << $s)) | (RT & M8 ) << $s; |
| 997 |
'}; |
| 998 |
$opcode[41] = sub {' # sh |
| 999 |
$i = RS + IMM; |
| 1000 |
$s = (~$i & 2) << 3; |
| 1001 |
$i = \$mem[$i >> ADDR_SHIFT][($i >> 2) & ADDR_MASK]; |
| 1002 |
$$i = ($$i & ~(M16 << $s)) | (RT & M16) << $s; |
| 1003 |
'}; |
| 1004 |
$opcode[42] = sub {' # swl |
| 1005 |
$i = RS + IMM; |
| 1006 |
$s = ((~$i & 3) + 1) << 3; |
| 1007 |
$i = \$mem[$i >> ADDR_SHIFT][($i >> 2) & ADDR_MASK]; |
| 1008 |
$$i = ($$i >> $s << $s) | (RT >> (32 - $s)); |
| 1009 |
'}; |
| 1010 |
$opcode[43] = sub {' # sw |
| 1011 |
$i = RS + IMM; |
| 1012 |
$mem[$i >> ADDR_SHIFT][($i >> 2) & ADDR_MASK] = RT; |
| 1013 |
'}; |
| 1014 |
|
| 1015 |
$opcode[46] = sub {' # swr |
| 1016 |
$i = RS + IMM; |
| 1017 |
$s = (($i & 3) + 1) << 3; |
| 1018 |
$i = \$mem[$i >> ADDR_SHIFT][($i >> 2) & ADDR_MASK]; |
| 1019 |
$$i = $$i & (M32 >> $s) | ((RT << (32 - $s)) & M32); |
| 1020 |
'}; |
| 1021 |
|
| 1022 |
# HACK: ignor3e some coprocessor instructions to make |
| 1023 |
# binaries work that do not use hardware fp, but the runtime saves/restores |
| 1024 |
# the registers. |
| 1025 |
$opcode[53] = sub { '' }; |
| 1026 |
$opcode[61] = sub { '' }; |
| 1027 |
|
| 1028 |
my $NOP = sub { }; |
| 1029 |
|
| 1030 |
$insn2sub{ ""} = $NOP; # "undef" insn |
| 1031 |
$insn2sub{0x00000000} = $NOP; # official mips nop |
| 1032 |
$insn2sub{0x00200825} = $NOP; # commonly used nop (longsoon2f workaround) |
| 1033 |
$insn2sub{0x7c03e83b} = sub { '$r3 = $tls_udesc' }; # rdhwr $3, $29 ($29=ULR)- emulated by kernel normally, for thread support |
| 1034 |
|
| 1035 |
sub get_insn { |
| 1036 |
$insn2sub{$_[0]} ||= do { |
| 1037 |
my $old_insn = $insn;#d# |
| 1038 |
|
| 1039 |
$insn = $_[0]*1; |
| 1040 |
my $src = &{ $opcode[$insn >> 26] }; |
| 1041 |
|
| 1042 |
$src =~ s/\bIMM\b/($insn & M16) - (($insn & B15) << 1)/ge; # 16 bit signed immediate |
| 1043 |
$src =~ s/\bIMMU\b/$insn & M16/ge; # 16 bit unsigned immediate |
| 1044 |
|
| 1045 |
$src =~ s/\bSA\b/($insn >> 6) & 31/ge; # shift amount |
| 1046 |
|
| 1047 |
$src =~ s/\bRS\b/'$r' . (($insn >> 21) & 31)/ge; # s register |
| 1048 |
$src =~ s/\bRT\b/'$r' . (($insn >> 16) & 31)/ge; # t register |
| 1049 |
$src =~ s/\bRD\b/'$r' . (($insn >> 11) & 31)/ge; # d register |
| 1050 |
|
| 1051 |
$src =~ s/\bINSN\b/$insn/ge; # for use in error messages only |
| 1052 |
|
| 1053 |
$src =~ s/\$r0 = //g; # optimize away r0 assignments |
| 1054 |
$src =~ s/\$r0\b/0/g; # optimise away r0 access |
| 1055 |
|
| 1056 |
my $cb = eval "sub { $src }" |
| 1057 |
|| die "$insn<$src>: $@"; |
| 1058 |
|
| 1059 |
# $insn2src{$insn} = $src; |
| 1060 |
$sub2insn{$cb+0} = $insn; |
| 1061 |
|
| 1062 |
$insn = $old_insn;#d# |
| 1063 |
|
| 1064 |
$cb |
| 1065 |
} |
| 1066 |
} |
| 1067 |
|
| 1068 |
sub cpu_reset($) { |
| 1069 |
$pc = $_[0] >> 2; |
| 1070 |
|
| 1071 |
$r0 = 0; # read-only, constant |
| 1072 |
|
| 1073 |
$r1 = $r2 = $r3 = $r4 = $r5 = $r6 = $r7 = |
| 1074 |
$r8 = $r9 = $r10 = $r11 = $r12 = $r13 = $r14 = $r15 = |
| 1075 |
$r16 = $r17 = $r18 = $r19 = $r20 = $r21 = $r22 = $r23 = |
| 1076 |
$r24 = $r25 = $r26 = $r27 = $r28 = $r30 = |
| 1077 |
$hi = $lo = 0; # was 0xdeadbeef, but kernel initialises to 0 |
| 1078 |
|
| 1079 |
$r2 = 0; |
| 1080 |
$r29 = STACK; |
| 1081 |
$r31 = 0; |
| 1082 |
|
| 1083 |
$delay = $NOP; # start with a nop |
| 1084 |
} |
| 1085 |
|
| 1086 |
sub cpu_run() { |
| 1087 |
while () { |
| 1088 |
$insn = $delay; |
| 1089 |
|
| 1090 |
if (PRIPS) { |
| 1091 |
unless (++$::n & 0xfffff) { |
| 1092 |
no integer; |
| 1093 |
open my $tty, ">/dev/tty"; |
| 1094 |
printf {$tty} "%g ips\n", $::n / (Time::HiRes::time - $::t0); |
| 1095 |
$::n = 0; $::t0 = Time::HiRes::time;#d# |
| 1096 |
} |
| 1097 |
} |
| 1098 |
|
| 1099 |
if (PRCPU) { |
| 1100 |
defined $insn or die "undefined insn access\n";#d# |
| 1101 |
cpu_pr; |
| 1102 |
} |
| 1103 |
|
| 1104 |
$delay = $mem[$pc >> (ADDR_SHIFT - 2)][$pc & ADDR_MASK]; |
| 1105 |
unless (ref $delay) { |
| 1106 |
$delay = |
| 1107 |
$mem[$pc >> (ADDR_SHIFT - 2)][$pc & ADDR_MASK] = |
| 1108 |
get_insn $delay; |
| 1109 |
} |
| 1110 |
++$pc; |
| 1111 |
|
| 1112 |
&$insn; |
| 1113 |
} |
| 1114 |
} |
| 1115 |
|
| 1116 |
############################################################################# |
| 1117 |
|
| 1118 |
sub mips_exec($$;$$) { |
| 1119 |
my ($path, $argv, $envv, $auxv) = @_; |
| 1120 |
|
| 1121 |
mem_reset; |
| 1122 |
|
| 1123 |
my $file= ref $path |
| 1124 |
? $$path |
| 1125 |
: do { open my $fh, "<", $path; local $/; <$fh> }; |
| 1126 |
|
| 1127 |
# 32 bit, msb, elf version |
| 1128 |
"\x7fELF\x01\x02\x01" eq substr $file, 0, 7 |
| 1129 |
or die "not an elf file, or wrong class, encoding or version"; |
| 1130 |
|
| 1131 |
my ($e_type, $machine, undef, $entry, $phoff, undef, undef, undef, $phentsize, $phnum) = unpack "nnNNNNNnnn", substr $file, 0x10; |
| 1132 |
|
| 1133 |
# $e_type == 2 |
| 1134 |
# or die "file not a (static) executable"; |
| 1135 |
|
| 1136 |
$machine == 8 |
| 1137 |
or die "file not mips r3000 big endian"; |
| 1138 |
|
| 1139 |
for my $i (0 .. $phnum - 1) { |
| 1140 |
my ($type, $offset, $vaddr, $physaddr, $size, $memsz, $flags, $align) = |
| 1141 |
unpack "N*", substr $file, $phoff + $i * $phentsize, 32; |
| 1142 |
|
| 1143 |
$type == 3 |
| 1144 |
and die "elf interpreter loading not supported, run it manually\n"; |
| 1145 |
|
| 1146 |
next unless $type == 1; |
| 1147 |
next unless $size; |
| 1148 |
|
| 1149 |
$vaddr += 0x55550000 if $e_type == 3; # pie executable (e.g. elf interpreter) |
| 1150 |
|
| 1151 |
for my $o (0 .. $size / 4 - 1) { |
| 1152 |
my $w = unpack "N", substr $file, $offset + $o * 4, 4; |
| 1153 |
my $a = $vaddr + $o * 4; |
| 1154 |
# printf "LOAD %08x = %08x\n", $a, $w; |
| 1155 |
$mem[$a >> ADDR_SHIFT][($a >> 2) & ADDR_MASK] = $w; |
| 1156 |
} |
| 1157 |
} |
| 1158 |
|
| 1159 |
$entry += 0x55550000 if $e_type == 3; # pie executable (e.g. elf interpreter) |
| 1160 |
|
| 1161 |
cpu_reset $entry; |
| 1162 |
|
| 1163 |
{ |
| 1164 |
my $str = STACK + 65536; |
| 1165 |
my $ptr = STACK; |
| 1166 |
|
| 1167 |
my $add_int = sub { |
| 1168 |
memset $ptr, pack "N", $_[0]; |
| 1169 |
$ptr += 4; |
| 1170 |
}; |
| 1171 |
|
| 1172 |
my $add_str = sub { |
| 1173 |
$add_int->($str); |
| 1174 |
memset $str, "$_[0]\x00"; |
| 1175 |
$str += 1 + length $_[0]; |
| 1176 |
}; |
| 1177 |
|
| 1178 |
$add_int->(scalar @$argv); |
| 1179 |
$add_str->($_) for @$argv; |
| 1180 |
$add_int->(0); |
| 1181 |
|
| 1182 |
$add_str->($_) for @$envv; |
| 1183 |
$add_int->(0); |
| 1184 |
|
| 1185 |
# auxv |
| 1186 |
$add_int->($_->[0]), $add_int->($_->[1]) |
| 1187 |
for @$auxv; |
| 1188 |
|
| 1189 |
$add_int->(0); |
| 1190 |
$add_int->(0); |
| 1191 |
} |
| 1192 |
} |
| 1193 |
|
| 1194 |
if (0) { |
| 1195 |
mips_exec |
| 1196 |
"/tmp/dash-mipsel", |
| 1197 |
["./run", @ARGV], |
| 1198 |
# ["sh", "-c", "for d in 0 1 2 3 4 5 6 7 8 9; do for a in 0 1 2 3 4 5 6 7 8 9; do for b in 0 1 2 3 4 5 6 7 8 9; do for c in 0 1 2 3 4 5 6 7 8 9; do :;done;done;done;done"], |
| 1199 |
[map "$_=$ENV{$_}", keys %ENV]; |
| 1200 |
} else { |
| 1201 |
|
| 1202 |
my $file; |
| 1203 |
|
| 1204 |
if (my $data = do { local $/; binmode DATA; <DATA> }) { |
| 1205 |
$file = \$data; |
| 1206 |
unshift @ARGV, $0; |
| 1207 |
} else { |
| 1208 |
$file = $ARGV[0]; |
| 1209 |
} |
| 1210 |
|
| 1211 |
mips_exec $file, \@ARGV, [map "$_=$ENV{$_}", keys %ENV]; |
| 1212 |
} |
| 1213 |
|
| 1214 |
$::t0 = Time::HiRes::time; |
| 1215 |
$::n = 0; |
| 1216 |
cpu_run; |
| 1217 |
|
