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 { # mips_mmap |
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 |
$syscall[4091] = sub { # munmap |
622 |
my ($addr, $length) = @_; |
623 |
strace "munmap (%x, %d)", @_; |
624 |
|
625 |
0 |
626 |
}; |
627 |
|
628 |
$syscall[4097] = sub { # setpriority |
629 |
# ... |
630 |
-ENOSYS |
631 |
}; |
632 |
|
633 |
$syscall[4099] = sub { # statfs |
634 |
my ($path, $buf) = @_; |
635 |
$path = memstr $path; |
636 |
strace "statfs (%s, %x)", $path, $buf; |
637 |
|
638 |
-ENOSYS |
639 |
}; |
640 |
$syscall[4100] = sub { # fstatfs |
641 |
my ($fd, $buf) = @_; |
642 |
strace "fstatfs (%d, %x)", $fd, $buf; |
643 |
|
644 |
-ENOSYS |
645 |
}; |
646 |
|
647 |
$syscall[4106] = sub { # newstat |
648 |
my ($path, $buf) = @_; |
649 |
$path = memstr $path; |
650 |
strace "newstat (%s, %x)", $path, $buf; |
651 |
|
652 |
newstat $buf, stat $path |
653 |
}; |
654 |
$syscall[4107] = sub { # newlstat |
655 |
my ($path, $buf) = @_; |
656 |
$path = memstr $path; |
657 |
strace "newlstat (%s, %x)", $path, $buf; |
658 |
|
659 |
newstat $buf, lstat $path |
660 |
}; |
661 |
$syscall[4108] = sub { # newfstat |
662 |
my ($fd, $buf) = @_; |
663 |
strace "newfstat (%d, %x)", $fd, $buf; |
664 |
|
665 |
newstat $buf, stat $fh[$fd] |
666 |
}; |
667 |
|
668 |
$syscall[4114] = sub { # wait4 |
669 |
my ($pid, $statusbuf, $options, $rusage) = @_; |
670 |
$pid = unpack "l", pack "L", $pid; |
671 |
strace "wait4 (%d, %x, %x, %x)", $pid, $statusbuf, $options, $rusage; |
672 |
|
673 |
memset $rusage, "\x00" x 72 |
674 |
if $rusage; |
675 |
|
676 |
$pid = waitpid $pid, $options; |
677 |
|
678 |
memset $statusbuf, pack "N", $? if $statusbuf; |
679 |
|
680 |
$pid >= 0 ? $pid : -errno2mips |
681 |
}; |
682 |
|
683 |
$syscall[4122] = sub { # newuname |
684 |
my ($buf) = @_; |
685 |
strace "newuname (%x)", $buf; |
686 |
|
687 |
memset $buf, pack "a65 a65 a65 a65 a65 a65", #d# |
688 |
"Linux", # sysname |
689 |
"nodename", |
690 |
"4.4-perl", # release |
691 |
"#201901240000 Thu Jan 24 13:59:03 CET 2019", # version |
692 |
"mips", # machine |
693 |
"(none)"; # domainname |
694 |
|
695 |
0 |
696 |
}; |
697 |
|
698 |
$syscall[4146] = sub { # writev |
699 |
my ($fd, $iov, $iovcnt) = @_; |
700 |
|
701 |
strace "writev (%d, %x, %d)", $fd, $iov, $iovcnt; |
702 |
|
703 |
my $data; |
704 |
|
705 |
while ($iovcnt--) { |
706 |
my ($base, $len) = unpack "NN", memget $iov, 8; |
707 |
$data .= memget $base, $len; |
708 |
$iov += 8; |
709 |
} |
710 |
|
711 |
my $len = syswrite $fh[$fd], $data; |
712 |
defined $len ? $len : -errno2mips |
713 |
}; |
714 |
|
715 |
$syscall[4140] = sub { # llseek |
716 |
my ($fd, $high, $low, $result, $whence) = @_; |
717 |
strace "llseek (%d, %x, %08x, %x, %d)", $fd, $high, $low, $result, $whence; |
718 |
|
719 |
my $res = sysseek $fh[$fd], ($high << 32) | $low, $whence; |
720 |
|
721 |
memset $result, pack "NN", ($res >> 32), $res; |
722 |
|
723 |
defined $res |
724 |
? 0 : -errno2mips |
725 |
}; |
726 |
|
727 |
$syscall[4171] = sub { # getpeername |
728 |
-ENOTSOCK |
729 |
}; |
730 |
|
731 |
$syscall[4194] = sub { # sigaction |
732 |
my ($signum, $act, $oldact) = @_; |
733 |
strace "sigaction (%d, %x, %x)", $signum, $act, $oldact; |
734 |
-ENOSYS |
735 |
}; |
736 |
$syscall[4195] = sub { # sigprocmask |
737 |
my ($how, $set, $oldset) = @_; |
738 |
strace "sigprocmask ($how, $set, $oldset)"; |
739 |
|
740 |
-ENOSYS |
741 |
}; |
742 |
|
743 |
$syscall[4203] = sub { # getcwd |
744 |
my $cwd = Cwd::getcwd; |
745 |
strace "getcwd (%x, %d)", $_[0], $_[1]; |
746 |
|
747 |
if ((length $cwd) < $_[1]) { |
748 |
memset $_[0], "$cwd\x00"; |
749 |
return 1 + length $cwd; |
750 |
} else { |
751 |
return -ERANGE; |
752 |
} |
753 |
}; |
754 |
|
755 |
$syscall[4213] = sub { # stat64 |
756 |
my ($path, $buf) = @_; |
757 |
$path = memstr $path; |
758 |
strace "stat64 (%s, %x)", $path, $buf; |
759 |
|
760 |
stat64 $buf, stat $path |
761 |
}; |
762 |
$syscall[4214] = sub { # lstat64 |
763 |
my ($path, $buf) = @_; |
764 |
$path = memstr $path; |
765 |
strace "lstat64 (%s, %x)", $path, $buf; |
766 |
|
767 |
stat64 $buf, lstat $path |
768 |
}; |
769 |
$syscall[4215] = sub { # fstat64 |
770 |
my ($fd, $buf) = @_; |
771 |
strace "fstat64 (%d, %x)", $fd, $buf; |
772 |
|
773 |
stat64 $buf, stat $fh[$fd] |
774 |
}; |
775 |
|
776 |
$syscall[4219] = sub { # getdents64 |
777 |
my ($fd, $dirp, $count) = @_; |
778 |
strace "getdents64 (%d, %x, %d)", $fd, $dirp, $count; |
779 |
|
780 |
my $name = readdir $dh[$fd]; |
781 |
|
782 |
return 0 unless defined $name; |
783 |
|
784 |
my $ino = -1; |
785 |
my $type = 0; |
786 |
|
787 |
my $entry = pack "NN NN n C Z*", |
788 |
$ino >> 32, $ino, |
789 |
0, 0, # offset |
790 |
(length $name) + 20, |
791 |
$type, |
792 |
$name; |
793 |
|
794 |
memset $dirp, $entry; |
795 |
length $entry |
796 |
}; |
797 |
$syscall[4220] = \&sys_fcntl; # fcntl64 |
798 |
|
799 |
$syscall[4246] = sub { # exit_group |
800 |
POSIX::exit $_[0]; |
801 |
}; |
802 |
|
803 |
$syscall[4283] = sub { # set_thread_area |
804 |
my ($udesc) = @_; |
805 |
|
806 |
strace "set_thread_area (%x)", $udesc; |
807 |
|
808 |
$tls_udesc = $udesc; |
809 |
|
810 |
return 0; |
811 |
}; |
812 |
|
813 |
$syscall[4300] = sub { # faccessat |
814 |
my ($dirfd, $path, $mode, $flags) = @_; |
815 |
|
816 |
strace "faccessat (%d, %s, %o, %x)", $dirfd, $path, $mode, $flags; |
817 |
|
818 |
0 # #d# grant any access |
819 |
}; |
820 |
|
821 |
sub sys { |
822 |
my @args = map $_*1, |
823 |
$r4, $r5, $r6, $r7, # first four args in regs |
824 |
# extra arguments on stack |
825 |
$mem[($r29 + 16) >> ADDR_SHIFT][(($r29 + 16) >> 2) & ADDR_MASK], |
826 |
$mem[($r29 + 20) >> ADDR_SHIFT][(($r29 + 20) >> 2) & ADDR_MASK], |
827 |
$mem[($r29 + 24) >> ADDR_SHIFT][(($r29 + 24) >> 2) & ADDR_MASK], |
828 |
$mem[($r29 + 28) >> ADDR_SHIFT][(($r29 + 28) >> 2) & ADDR_MASK], |
829 |
; |
830 |
|
831 |
$strace = "$r2 (@args)"; |
832 |
my $retval = $syscall[$r2](@args); |
833 |
print STDERR "$$ SYS_$strace = $retval\n" if STRACE; |
834 |
|
835 |
if ($retval > -4096 && $retval < 0) { |
836 |
$r2 = -$retval; |
837 |
$r7 = 1; |
838 |
} else { |
839 |
$r2 = $retval; |
840 |
$r7 = 0; |
841 |
} |
842 |
} |
843 |
|
844 |
############################################################################# |
845 |
# mips i big endian cpu emulator |
846 |
|
847 |
############################################ |
848 |
# specials (opcode 0) |
849 |
|
850 |
my ($s, $t, $i); # temporary per-insn variables, declared globally for speed |
851 |
|
852 |
my @special = ('die sprintf "special %d in %08x \@ 0x%08x not supported\n", INSN & 63, INSN, $pc << 2') x 64; |
853 |
|
854 |
$special[ 0] = "RD = (RT << SA ) & M32"; # sll |
855 |
|
856 |
$special[ 2] = 'RD = RT >> SA '; # srl |
857 |
|
858 |
$special[ 3] = 'RD = ((RT - ((RT & B31) << 1)) >> SA ) & M32'; # sra |
859 |
$special[ 4] = 'RD = (RT << (RS & 31)) & M32'; # sllv |
860 |
|
861 |
$special[ 6] = 'RD = RT >> (RS & 31) '; # srlv |
862 |
$special[ 7] = 'RD = ((RT - ((RT & B31) << 1)) >> (RS & 31)) & M32'; # srav |
863 |
$special[ 8] = ' $pc = RS >> 2'; # jr |
864 |
$special[ 9] = 'RD = $pc << 2; $pc = RS >> 2'; # jalr |
865 |
|
866 |
$special[10] = 'RD = RS unless RT'; # movz, MIPS IV |
867 |
$special[11] = 'RD = RS if RT'; # movn, MIPS IV |
868 |
|
869 |
$special[12] = "sys"; |
870 |
$special[13] = 'die sprintf "BREAK %0x8x \@ 0x%08x\n", INSN, $pc << 2'; # break |
871 |
|
872 |
$special[15] = ''; # sync, mips2 |
873 |
$special[16] = 'RD = $hi'; # mfhi |
874 |
$special[17] = '$hi = RS'; # mthi |
875 |
$special[18] = 'RD = $lo'; # mflo |
876 |
$special[19] = '$lo = RS'; # mtlo |
877 |
|
878 |
$special[24] = '# mult |
879 |
$lo = (RS - ((RS & B31) << 1)) |
880 |
* (RT - ((RT & B31) << 1)); |
881 |
$hi = ($lo >> 32) & M32; |
882 |
$lo &= M32; |
883 |
'; |
884 |
$special[25] = ' # multu |
885 |
no integer; |
886 |
$lo = RS * RT; |
887 |
$hi = $lo >> 32; |
888 |
$lo &= M32; |
889 |
'; |
890 |
$special[26] = ' # div |
891 |
$s = RS - ((RS & B31) << 1); |
892 |
$t = RT - ((RT & B31) << 1) |
893 |
or return; |
894 |
|
895 |
$lo = ($s / $t) & M32; |
896 |
$hi = ($s % $t) & M32; |
897 |
'; |
898 |
$special[27] = ' # divu |
899 |
RT or return; |
900 |
|
901 |
no integer; |
902 |
$lo = int (RS / RT) & M32; |
903 |
$hi = (RS - $lo * RT) & M32; |
904 |
'; |
905 |
|
906 |
$special[32] = 'die "add instruction unsupported"'; |
907 |
$special[33] = "RD = (RS + RT) & M32"; # addu |
908 |
$special[34] = 'die "sub instruction unsupported"'; |
909 |
$special[35] = "RD = (RS - RT) & M32"; # subu |
910 |
#$special[32] = $special[33]; # add # buggy, does not trap #d# |
911 |
#$special[34] = $special[35]; # sub # buggy, does not trap #d# |
912 |
|
913 |
$special[36] = "RD = RS & RT "; # and |
914 |
$special[37] = "RD = RS | RT "; # or |
915 |
$special[38] = "RD = RS ^ RT "; # xor |
916 |
$special[39] = "RD = (RS | RT) ^ M32"; # nor |
917 |
|
918 |
$special[42] = "RD = (RS - ((RS & B31) << 1)) < (RT - ((RT & B31) << 1))"; # slt |
919 |
$special[43] = "RD = RS < RT "; # sltu |
920 |
|
921 |
# implement some trap insns from mips2, but not all |
922 |
$special[52] = 'die sprintf "TRAP %0x8x \@ 0x%08x\n", INSN, $pc << 2 unless RS'; # teq, mips2 |
923 |
$special[54] = 'die sprintf "TRAP %0x8x \@ 0x%08x\n", INSN, $pc << 2 if RS'; # tne, mips2 |
924 |
|
925 |
############################################ |
926 |
# regimm (opcode 1) |
927 |
|
928 |
my @regimm = ('die sprintf "regimm %08x \@ 0x%08x not supported\n", INSN & 63, $pc << 2') x 64; |
929 |
|
930 |
$regimm[ 0] = ' $pc += IMM - 1 if RS & 0x80000000'; # bltz |
931 |
$regimm[16] = '$r31 = $pc << 2; $pc += IMM - 1 if RS & 0x80000000'; # bltzal |
932 |
$regimm[ 1] = ' $pc += IMM - 1 unless RS & 0x80000000'; # bgez |
933 |
$regimm[17] = '$r31 = $pc << 2; $pc += IMM - 1 unless RS & 0x80000000'; # bgezal bal |
934 |
|
935 |
############################################ |
936 |
# others |
937 |
|
938 |
my @opcode = (sub { 'die sprintf "opcode %d in %08x \@ 0x%08x not supported\n", INSN >> 26, INSN, $pc << 2' }) x 64; |
939 |
|
940 |
$opcode[ 0] = sub { $special[$insn & 63] }; # special |
941 |
$opcode[ 1] = sub { $regimm[($insn >> 16) & 31] }; # regimm |
942 |
$opcode[ 2] = sub { ' $pc = ($pc & 0x3c000000) | (' . $insn . ' & 0x03ffffff)' }; # j |
943 |
$opcode[ 3] = sub { '$r31 = $pc << 2; $pc = ($pc & 0x3c000000) | (' . $insn . ' & 0x03ffffff)' }; # jal |
944 |
$opcode[ 4] = sub { '$pc += IMM - 1 if RS == RT' }; # beq beqz b |
945 |
$opcode[ 5] = sub { '$pc += IMM - 1 if RS != RT' }; # bne bnez |
946 |
$opcode[ 6] = sub { '$pc += IMM - 1 if !RS || RS >= 0x80000000' }; # blez |
947 |
$opcode[ 7] = sub { '$pc += IMM - 1 if RS && RS < 0x80000000' }; # bgtz |
948 |
$opcode[ 8] = sub { die "addi instruction unsupported" }; # addi |
949 |
$opcode[ 9] = sub { "RT = (RS + IMM) & M32" }; # addiu |
950 |
$opcode[10] = sub { 'RT = ((RS - ((RS & B31) << 1))) < IMM ' }; # slti |
951 |
$opcode[11] = sub { 'RT = RS < (IMM & M32)' }; # sltiu |
952 |
$opcode[12] = sub { 'RT = RS & IMMU' }; # andi |
953 |
$opcode[13] = sub { 'RT = RS | IMMU' }; # ori |
954 |
$opcode[14] = sub { 'RT = RS ^ IMMU' }; # xori |
955 |
$opcode[15] = sub { 'RT = IMMU << 16' }; # lui |
956 |
|
957 |
# opcode 28 is SPECIAL2, extended mips32 |
958 |
|
959 |
$opcode[32] = sub {' # lb |
960 |
$i = RS + IMM; |
961 |
$s = (~$i & 3) << 3; |
962 |
$s = $mem[$i >> ADDR_SHIFT][($i >> 2) & ADDR_MASK] >> $s; |
963 |
RT = (($s & M8) - (($s & B7) << 1)) & M32; |
964 |
'}; |
965 |
$opcode[33] = sub {' # lh |
966 |
$i = RS + IMM; |
967 |
$s = (~$i & 2) << 3; |
968 |
$s = $mem[$i >> ADDR_SHIFT][($i >> 2) & ADDR_MASK] >> $s; |
969 |
RT = (($s & M16) - (($s & B15) << 1)) & M32; |
970 |
'}; |
971 |
$opcode[34] = sub {' # lwl |
972 |
$i = RS + IMM; |
973 |
$s = ($i & 3) << 3; |
974 |
$i = $mem[$i >> ADDR_SHIFT][($i >> 2) & ADDR_MASK]; |
975 |
RT = (RT & (M32 >> (32 - $s))) | ($i << $s & M32); |
976 |
'}; |
977 |
$opcode[35] = sub {' # lw |
978 |
$i = RS + IMM; |
979 |
RT = $mem[$i >> ADDR_SHIFT][($i >> 2) & ADDR_MASK]; |
980 |
'}; |
981 |
$opcode[36] = sub {' # lbu |
982 |
$i = RS + IMM; |
983 |
$s = (~$i & 3) << 3; |
984 |
RT = ($mem[$i >> ADDR_SHIFT][($i >> 2) & ADDR_MASK] >> $s) & M8; |
985 |
'}; |
986 |
$opcode[37] = sub {' # lhu |
987 |
$i = RS + IMM; |
988 |
$s = (~$i & 2) << 3; |
989 |
RT = ($mem[$i >> ADDR_SHIFT][($i >> 2) & ADDR_MASK] >> $s) & M16; |
990 |
'}; |
991 |
$opcode[38] = sub {' # lwr |
992 |
$i = RS + IMM; |
993 |
$s = (($i & 3) + 1) << 3; |
994 |
$i = $mem[$i >> ADDR_SHIFT][($i >> 2) & ADDR_MASK]; |
995 |
RT = (RT >> $s << $s) | ($i >> (32 - $s)); |
996 |
'}; |
997 |
|
998 |
$opcode[40] = sub {' # sb |
999 |
$i = RS + IMM; |
1000 |
$s = (~$i & 3) << 3; |
1001 |
$i = \$mem[$i >> ADDR_SHIFT][($i >> 2) & ADDR_MASK]; |
1002 |
$$i = ($$i & ~(M8 << $s)) | (RT & M8 ) << $s; |
1003 |
'}; |
1004 |
$opcode[41] = sub {' # sh |
1005 |
$i = RS + IMM; |
1006 |
$s = (~$i & 2) << 3; |
1007 |
$i = \$mem[$i >> ADDR_SHIFT][($i >> 2) & ADDR_MASK]; |
1008 |
$$i = ($$i & ~(M16 << $s)) | (RT & M16) << $s; |
1009 |
'}; |
1010 |
$opcode[42] = sub {' # swl |
1011 |
$i = RS + IMM; |
1012 |
$s = ((~$i & 3) + 1) << 3; |
1013 |
$i = \$mem[$i >> ADDR_SHIFT][($i >> 2) & ADDR_MASK]; |
1014 |
$$i = ($$i >> $s << $s) | (RT >> (32 - $s)); |
1015 |
'}; |
1016 |
$opcode[43] = sub {' # sw |
1017 |
$i = RS + IMM; |
1018 |
$mem[$i >> ADDR_SHIFT][($i >> 2) & ADDR_MASK] = RT; |
1019 |
'}; |
1020 |
|
1021 |
$opcode[46] = sub {' # swr |
1022 |
$i = RS + IMM; |
1023 |
$s = (($i & 3) + 1) << 3; |
1024 |
$i = \$mem[$i >> ADDR_SHIFT][($i >> 2) & ADDR_MASK]; |
1025 |
$$i = $$i & (M32 >> $s) | ((RT << (32 - $s)) & M32); |
1026 |
'}; |
1027 |
|
1028 |
# HACK: ignore some coprocessor instructions to make |
1029 |
# binaries work that do not use hardware fp, but the runtime saves/restores |
1030 |
# the registers. |
1031 |
$opcode[53] = sub { '' }; |
1032 |
$opcode[61] = sub { '' }; |
1033 |
|
1034 |
my $NOP = sub { }; |
1035 |
|
1036 |
$insn2sub{ ""} = $NOP; # "undef" insn |
1037 |
$insn2sub{0x00000000} = $NOP; # official mips nop |
1038 |
$insn2sub{0x00200825} = $NOP; # commonly used nop (longsoon2f workaround) |
1039 |
$insn2sub{0x7c03e83b} = sub { '$r3 = $tls_udesc' }; # rdhwr $3, $29 ($29=ULR)- emulated by kernel normally, for thread support |
1040 |
|
1041 |
sub get_insn { |
1042 |
$insn2sub{$_[0]} ||= do { |
1043 |
my $old_insn = $insn;#d# |
1044 |
|
1045 |
$insn = $_[0]*1; |
1046 |
my $src = &{ $opcode[$insn >> 26] }; |
1047 |
|
1048 |
$src =~ s/\bIMM\b/($insn & M16) - (($insn & B15) << 1)/ge; # 16 bit signed immediate |
1049 |
$src =~ s/\bIMMU\b/$insn & M16/ge; # 16 bit unsigned immediate |
1050 |
|
1051 |
$src =~ s/\bSA\b/($insn >> 6) & 31/ge; # shift amount |
1052 |
|
1053 |
$src =~ s/\bRS\b/'$r' . (($insn >> 21) & 31)/ge; # s register |
1054 |
$src =~ s/\bRT\b/'$r' . (($insn >> 16) & 31)/ge; # t register |
1055 |
$src =~ s/\bRD\b/'$r' . (($insn >> 11) & 31)/ge; # d register |
1056 |
|
1057 |
$src =~ s/\bINSN\b/$insn/ge; # for use in error messages only |
1058 |
|
1059 |
$src =~ s/\$r0 = //g; # optimize away r0 assignments |
1060 |
$src =~ s/\$r0\b/0/g; # optimise away r0 access |
1061 |
|
1062 |
my $cb = eval "sub { $src }" |
1063 |
|| die "$insn<$src>: $@"; |
1064 |
|
1065 |
# $insn2src{$insn} = $src; |
1066 |
$sub2insn{$cb+0} = $insn; |
1067 |
|
1068 |
$insn = $old_insn;#d# |
1069 |
|
1070 |
$cb |
1071 |
} |
1072 |
} |
1073 |
|
1074 |
sub cpu_reset($) { |
1075 |
$pc = $_[0] >> 2; |
1076 |
|
1077 |
$r0 = 0; # read-only, constant |
1078 |
|
1079 |
$r1 = $r2 = $r3 = $r4 = $r5 = $r6 = $r7 = |
1080 |
$r8 = $r9 = $r10 = $r11 = $r12 = $r13 = $r14 = $r15 = |
1081 |
$r16 = $r17 = $r18 = $r19 = $r20 = $r21 = $r22 = $r23 = |
1082 |
$r24 = $r25 = $r26 = $r27 = $r28 = $r30 = |
1083 |
$hi = $lo = 0; # was 0xdeadbeef, but kernel initialises to 0 |
1084 |
|
1085 |
$r2 = 0; |
1086 |
$r29 = STACK; |
1087 |
$r31 = 0; |
1088 |
|
1089 |
$delay = $NOP; # start with a nop |
1090 |
} |
1091 |
|
1092 |
sub cpu_run() { |
1093 |
while () { |
1094 |
$insn = $delay; |
1095 |
|
1096 |
if (PRIPS) { |
1097 |
unless (++$::n & 0xfffff) { |
1098 |
no integer; |
1099 |
open my $tty, ">/dev/tty"; |
1100 |
printf {$tty} "%g ips\n", $::n / (Time::HiRes::time - $::t0); |
1101 |
$::n = 0; $::t0 = Time::HiRes::time;#d# |
1102 |
} |
1103 |
} |
1104 |
|
1105 |
if (PRCPU) { |
1106 |
defined $insn or die "undefined insn access\n";#d# |
1107 |
cpu_pr; |
1108 |
} |
1109 |
|
1110 |
$delay = $mem[$pc >> (ADDR_SHIFT - 2)][$pc & ADDR_MASK]; |
1111 |
unless (ref $delay) { |
1112 |
$delay = |
1113 |
$mem[$pc >> (ADDR_SHIFT - 2)][$pc & ADDR_MASK] = |
1114 |
get_insn $delay; |
1115 |
} |
1116 |
++$pc; |
1117 |
|
1118 |
&$insn; |
1119 |
} |
1120 |
} |
1121 |
|
1122 |
############################################################################# |
1123 |
|
1124 |
sub mips_exec($$;$$) { |
1125 |
my ($path, $argv, $envv, $auxv) = @_; |
1126 |
|
1127 |
mem_reset; |
1128 |
|
1129 |
my $file= ref $path |
1130 |
? $$path |
1131 |
: do { open my $fh, "<", $path; local $/; <$fh> }; |
1132 |
|
1133 |
# 32 bit, msb, elf version |
1134 |
"\x7fELF\x01\x02\x01" eq substr $file, 0, 7 |
1135 |
or die "not an elf file, or wrong class, encoding or version"; |
1136 |
|
1137 |
my ($e_type, $machine, undef, $entry, $phoff, undef, undef, undef, $phentsize, $phnum) = unpack "nnNNNNNnnn", substr $file, 0x10; |
1138 |
|
1139 |
# $e_type == 2 |
1140 |
# or die "file not a (static) executable"; |
1141 |
|
1142 |
$machine == 8 |
1143 |
or die "file not mips r3000 big endian"; |
1144 |
|
1145 |
for my $i (0 .. $phnum - 1) { |
1146 |
my ($type, $offset, $vaddr, $physaddr, $size, $memsz, $flags, $align) = |
1147 |
unpack "N*", substr $file, $phoff + $i * $phentsize, 32; |
1148 |
|
1149 |
$type == 3 |
1150 |
and die "elf interpreter loading not supported, run it manually\n"; |
1151 |
|
1152 |
next unless $type == 1; |
1153 |
next unless $size; |
1154 |
|
1155 |
$vaddr += 0x55550000 if $e_type == 3; # pie executable (e.g. elf interpreter) |
1156 |
|
1157 |
for my $o (0 .. $size / 4 - 1) { |
1158 |
my $w = unpack "N", substr $file, $offset + $o * 4, 4; |
1159 |
my $a = $vaddr + $o * 4; |
1160 |
# printf "LOAD %08x = %08x\n", $a, $w; |
1161 |
$mem[$a >> ADDR_SHIFT][($a >> 2) & ADDR_MASK] = $w; |
1162 |
} |
1163 |
} |
1164 |
|
1165 |
$entry += 0x55550000 if $e_type == 3; # pie executable (e.g. elf interpreter) |
1166 |
|
1167 |
cpu_reset $entry; |
1168 |
|
1169 |
{ |
1170 |
my $str = STACK + 65536; |
1171 |
my $ptr = STACK; |
1172 |
|
1173 |
my $add_int = sub { |
1174 |
memset $ptr, pack "N", $_[0]; |
1175 |
$ptr += 4; |
1176 |
}; |
1177 |
|
1178 |
my $add_str = sub { |
1179 |
$add_int->($str); |
1180 |
memset $str, "$_[0]\x00"; |
1181 |
$str += 1 + length $_[0]; |
1182 |
}; |
1183 |
|
1184 |
$add_int->(scalar @$argv); |
1185 |
$add_str->($_) for @$argv; |
1186 |
$add_int->(0); |
1187 |
|
1188 |
$add_str->($_) for @$envv; |
1189 |
$add_int->(0); |
1190 |
|
1191 |
# auxv |
1192 |
$add_int->($_->[0]), $add_int->($_->[1]) |
1193 |
for @$auxv; |
1194 |
|
1195 |
$add_int->(0); |
1196 |
$add_int->(0); |
1197 |
} |
1198 |
} |
1199 |
|
1200 |
if (0) { |
1201 |
mips_exec |
1202 |
"/tmp/dash-mipsel", |
1203 |
["./run", @ARGV], |
1204 |
# ["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"], |
1205 |
[map "$_=$ENV{$_}", keys %ENV]; |
1206 |
} else { |
1207 |
|
1208 |
my $file; |
1209 |
|
1210 |
if (my $data = do { local $/; binmode DATA; <DATA> }) { |
1211 |
$file = \$data; |
1212 |
unshift @ARGV, $0; |
1213 |
} else { |
1214 |
$file = $ARGV[0]; |
1215 |
} |
1216 |
|
1217 |
mips_exec $file, \@ARGV, [map "$_=$ENV{$_}", keys %ENV]; |
1218 |
} |
1219 |
|
1220 |
$::t0 = Time::HiRes::time; |
1221 |
$::n = 0; |
1222 |
cpu_run; |
1223 |
|