mirror of
https://github.com/livingcomputermuseum/pdp7-unix.git
synced 2026-02-12 02:57:54 +00:00
218e060a55
to detect if file output is "binary" or ASCII and to write the file correctly. Mind you, the heuristic can fail :-( The original cp can now copy ASCII and binary files.
1315 lines
37 KiB
Perl
Executable File
1315 lines
37 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
#
|
|
# a7out: user-mode simulator for PDP-7 Unix applications
|
|
#
|
|
# (c) 2016 Warren Toomey, GPL3
|
|
#
|
|
use strict;
|
|
use warnings;
|
|
use Fcntl qw(:seek);
|
|
use DateTime;
|
|
use Data::Dumper;
|
|
|
|
### Global variables ###
|
|
my $debug = 0; # Debug flag
|
|
my $singlestep = 0; # Are we running in single-step mode?
|
|
my %Breakpoint; # Hash of defined breakpoints
|
|
my @Mem; # 8K 18-bit words of main memory
|
|
my @FD; # Array of open filehandles
|
|
my @ISBINARY; # Array of filehandle flags: ASCII or binary files?
|
|
|
|
# Registers
|
|
my $PC = 010000; # Program counter
|
|
my $AC = 0; # Accumulator
|
|
my $LINK = 0; # Link register, either 0 or LINKMASK
|
|
my $MQ = 0; # MQ register
|
|
|
|
# Constants
|
|
use constant MAXINT => 0777777; # Biggest unsigned integer
|
|
use constant MAXPOSINT => 0377777; # Biggest signed integer
|
|
use constant MAXADDR => 017777; # Largest memory address
|
|
use constant LINKMASK => 01000000; # Mask for LINK register
|
|
use constant EAESTEP => 077; # EAE step count mask
|
|
use constant EAEIMASK => 0777700; # EAE instruction mask
|
|
use constant SIGN => 0400000; # Sign bit
|
|
|
|
### Main program ###
|
|
|
|
# Get any optional arguments
|
|
while ( defined( $ARGV[0] ) && ( $ARGV[0] =~ m{^-} ) ) {
|
|
|
|
# -d: debug mode
|
|
if ( $ARGV[0] eq "-d" ) {
|
|
$debug = 1;
|
|
shift(@ARGV);
|
|
}
|
|
|
|
# -b: set a breakpoint
|
|
if ( $ARGV[0] eq "-b" ) {
|
|
shift(@ARGV);
|
|
$Breakpoint{ oct( shift(@ARGV) ) } = 1;
|
|
}
|
|
}
|
|
|
|
# Check the arguments
|
|
die("Usage: $0 [-d] [-b breakpoint] a.outfile [arg1 arg2 ...]\n")
|
|
if ( @ARGV < 1 );
|
|
|
|
# Load the a.out file into memory
|
|
# and simulate it
|
|
load_code( $ARGV[0] );
|
|
set_arguments();
|
|
|
|
#dump_memory(0, MAXADDR, 0);
|
|
#exit(0);
|
|
simulate();
|
|
exit(0);
|
|
|
|
### Load the a.out file into memory
|
|
sub load_code {
|
|
my $filename = shift;
|
|
|
|
# Fill all the 8K words in memory with zeroes
|
|
foreach my $i ( 0 .. MAXADDR ) {
|
|
$Mem[$i] = 0;
|
|
}
|
|
|
|
# Set up some open filehandles
|
|
$FD[0] = \*STDIN;
|
|
$FD[1] = \*STDOUT;
|
|
$FD[8] = \*STDERR; # According to cat.s (uses d8 == 8)
|
|
|
|
# Open up the PDP-7 executable file
|
|
open( my $IN, "<", $filename ) || die("Unable to open $filename: $!\n");
|
|
while (<$IN>) {
|
|
chomp;
|
|
|
|
# Lose any textual stuff after a tab character
|
|
$_ =~ s{\t.*}{};
|
|
|
|
# Split into location and value, both in octal
|
|
my ( $loc, $val ) = split( /:\s+/, $_ );
|
|
|
|
# Convert from octal and save
|
|
$loc = oct($loc);
|
|
$val = oct($val);
|
|
$Mem[$loc] = $val;
|
|
}
|
|
close($IN);
|
|
}
|
|
|
|
### Copy the arguments into the PDP-7 memory space, and build
|
|
### an array of pointers to these arguments. Build a pointer
|
|
### at MAXADDR that points at the array.
|
|
###
|
|
### Each argument string is four words long and space padded if the
|
|
### string is not eight characters long. These are stored below
|
|
### address MAXADDR. Below this is the count of words in the strings.
|
|
### Address MAXADDR points at the word count. Graphically (for two arguments):
|
|
###
|
|
### +------------+
|
|
### +--| | Location 017777 (MAXADDR)
|
|
### | +------------+
|
|
### | |............|
|
|
### | |............| argv[2]
|
|
### | |............|
|
|
### | +------------+
|
|
### | |............|
|
|
### | |............| argv[1]
|
|
### | |............|
|
|
### | +------------+
|
|
### | |............|
|
|
### | |............| argv[0]
|
|
### | |............|
|
|
### | +------------+
|
|
### +->| argc=12 |
|
|
### +------------+
|
|
###
|
|
sub set_arguments {
|
|
|
|
# Get the number of arguments including the command name
|
|
my $argc = scalar(@ARGV);
|
|
|
|
# We now know that argc will appear in memory
|
|
# 4*argc +1 below location MAXADDR
|
|
# Set argc to the number of words
|
|
my $addr = MAXADDR - ( 4 * $argc + 1 );
|
|
$Mem[MAXADDR] = $addr;
|
|
$Mem[ $addr++ ] = $argc * 4;
|
|
|
|
# Now start saving the arguments
|
|
foreach (@ARGV) {
|
|
|
|
# Truncate and/or space pad the argument
|
|
my $str = sprintf( "%-8s", substr( $_, 0, 8 ) );
|
|
|
|
# XXX: use ascii2words
|
|
# Store pairs of characters into memory
|
|
for ( my $i = 0 ; $i < length($str) ; $i += 2 ) {
|
|
my $c1 = substr( $str, $i, 1 ) || "";
|
|
my $c2 = substr( $str, $i + 1, 1 ) || "";
|
|
|
|
#printf("Saving %06o to %06o\n", (ord($c1) << 9 ) | ord($c2), $addr);
|
|
$Mem[ $addr++ ] = ( ord($c1) << 9 ) | ord($c2);
|
|
}
|
|
}
|
|
}
|
|
|
|
### Simulate the machine code loaded into memory
|
|
sub simulate {
|
|
|
|
# List of opcodes that we can simulate
|
|
my %Oplist = (
|
|
oct("000") => \&cal,
|
|
oct("004") => \&dac,
|
|
oct("010") => \&jms,
|
|
oct("014") => \&dzm,
|
|
oct("020") => \&lac,
|
|
oct("030") => \&add,
|
|
oct("024") => \&xor,
|
|
oct("034") => \&tad,
|
|
oct("044") => \&isz,
|
|
oct("050") => \&and,
|
|
oct("054") => \&sad,
|
|
oct("060") => \&jmp,
|
|
oct("064") => \&eae,
|
|
oct("074") => \&opr,
|
|
);
|
|
|
|
# List of opcodes that DON'T auto-increment
|
|
# locations 10-17 when we have the indirect bit
|
|
my %NoIncr = (
|
|
oct("000") => 1, # cal
|
|
oct("064") => 1, # eae
|
|
oct("074") => 1 # opr
|
|
);
|
|
|
|
# Loop indefinitely
|
|
while (1) {
|
|
|
|
# Get the instruction pointed to by PC and decode it
|
|
my $instruction = $Mem[$PC];
|
|
my $opcode = ( $instruction >> 12 ) & 074;
|
|
my $indirect = ( $instruction >> 13 ) & 1;
|
|
my $addr = $instruction & MAXADDR;
|
|
|
|
# Auto-increment locations 010 to 017 if $indirect
|
|
# and this is an instruction that does increment
|
|
if ( $indirect
|
|
&& ( $addr >= 010 )
|
|
&& ( $addr <= 017 )
|
|
&& !defined( $NoIncr{$opcode} ) )
|
|
{
|
|
$Mem[$addr]++;
|
|
$Mem[$addr] &= MAXINT;
|
|
}
|
|
|
|
# Work out what any indirect address would be
|
|
my $indaddr = ($indirect) ? $Mem[$addr] & MAXADDR : $addr;
|
|
|
|
# If this is a breakpoint, stop now and get a user command
|
|
if ( defined( $Breakpoint{$PC} ) ) {
|
|
$singlestep = 1;
|
|
dprintf( "break at PC %06o\n", $PC );
|
|
}
|
|
get_user_command() if ($singlestep);
|
|
dprintf( "PC %06o: ", $PC );
|
|
|
|
#dprintf("PC %06o: instr %06o, op %03o, in %o, addr %06o indaddr %06o\n",
|
|
# $PC, $instruction, $opcode, $indirect, $addr, $indaddr );
|
|
|
|
# Simulate the instruction. Each subroutine updates the $PC
|
|
if ( defined( $Oplist{$opcode} ) ) {
|
|
$Oplist{$opcode}->( $instruction, $addr, $indaddr );
|
|
}
|
|
else {
|
|
printf( STDERR "Unknown instruction 0%06o at location 0%06o\n",
|
|
$instruction, $PC );
|
|
exit(1);
|
|
}
|
|
}
|
|
}
|
|
|
|
# Debug code: dump memory contents
|
|
# Print from $start to $end.
|
|
# Print empty locations if $yeszero
|
|
sub dump_memory {
|
|
my ( $start, $end, $yeszero ) = @_;
|
|
foreach my $i ( $start .. $end ) {
|
|
|
|
# Convert the word into possibly two ASCII characters
|
|
my $c1 = ( $Mem[$i] >> 9 ) & 0777;
|
|
$c1 = ( $c1 < 0200 ) ? chr($c1) : " ";
|
|
my $c2 = $Mem[$i] & 0777;
|
|
$c2 = ( $c2 < 0200 ) ? chr($c2) : " ";
|
|
printf( STDERR "%06o: %06o %s%s\n", $i, $Mem[$i], $c1, $c2 )
|
|
if ( $yeszero || $Mem[$i] != 0 );
|
|
}
|
|
}
|
|
|
|
# Load AC
|
|
sub lac {
|
|
my ( $instruction, $addr, $indaddr ) = @_;
|
|
dprintf( "lac %06o (value %06o) into AC\n", $indaddr, $Mem[$indaddr] );
|
|
$AC = $Mem[$indaddr];
|
|
$PC++;
|
|
}
|
|
|
|
# Deposit AC
|
|
sub dac {
|
|
my ( $instruction, $addr, $indaddr ) = @_;
|
|
dprintf( "dac AC (value %06o) into %06o\n", $AC, $indaddr );
|
|
$Mem[$indaddr] = $AC;
|
|
$PC++;
|
|
}
|
|
|
|
# Add to AC, twos complement
|
|
sub tad {
|
|
my ( $instruction, $addr, $indaddr ) = @_;
|
|
dprintf( "tad AC (value %06o) with addr %06o (%06o)\n",
|
|
$AC, $indaddr, $Mem[$indaddr] );
|
|
$AC = $AC + $Mem[$indaddr];
|
|
$LINK = ( $LINK ^ $AC ) & LINKMASK;
|
|
$AC = $AC & MAXINT;
|
|
$PC++;
|
|
}
|
|
|
|
# Add to AC, ones complement
|
|
sub add {
|
|
my ( $instruction, $addr, $indaddr ) = @_;
|
|
dprintf( "add AC (value %06o) with addr %06o (%06o)\n",
|
|
$AC, $indaddr, $Mem[$indaddr] );
|
|
|
|
# This logic shamelessly borrowed from SimH
|
|
# https://github.com/simh/simh/blob/master/PDP18B/pdp18b_cpu.c
|
|
my $sum = $AC + $Mem[$indaddr];
|
|
if ( $sum > MAXINT ) { # end around carry
|
|
$sum = ( $sum + 1 ) & MAXINT;
|
|
}
|
|
if ( ( ( ~$AC ^ $sum ) & ( $AC ^ $sum ) ) & SIGN ) { # overflow?
|
|
$LINK = LINKMASK; # set link
|
|
}
|
|
$AC = $sum;
|
|
$PC++;
|
|
}
|
|
|
|
# And AC and Y
|
|
sub and {
|
|
my ( $instruction, $addr, $indaddr ) = @_;
|
|
dprintf( "and AC (value %06o) with addr %06o (%06o)\n",
|
|
$AC, $indaddr, $Mem[$indaddr] );
|
|
$AC &= $Mem[$indaddr];
|
|
$PC++;
|
|
}
|
|
|
|
# Xor AC and Y
|
|
sub xor {
|
|
my ( $instruction, $addr, $indaddr ) = @_;
|
|
dprintf( "xor AC (value %06o) with addr %06o (%06o)\n",
|
|
$AC, $indaddr, $Mem[$indaddr] );
|
|
$AC ^= $Mem[$indaddr];
|
|
$PC++;
|
|
}
|
|
|
|
# Skip if AC different to Y
|
|
sub sad {
|
|
my ( $instruction, $addr, $indaddr ) = @_;
|
|
dprintf( "sad AC %06o cf. %06o\n", $AC, $Mem[$indaddr] );
|
|
$PC += ( $AC != $Mem[$indaddr] ) ? 2 : 1;
|
|
}
|
|
|
|
# Deposit zero in memory
|
|
sub dzm {
|
|
my ( $instruction, $addr, $indaddr ) = @_;
|
|
dprintf( "dzm into %06o\n", $indaddr );
|
|
$Mem[$indaddr] = 0;
|
|
$PC++;
|
|
}
|
|
|
|
# Index and skip if zero
|
|
sub isz {
|
|
my ( $instruction, $addr, $indaddr ) = @_;
|
|
dprintf( "isz %06o (value %06o)\n", $indaddr, $Mem[$indaddr] );
|
|
$Mem[$indaddr]++;
|
|
$Mem[$indaddr] &= MAXINT;
|
|
$PC += ( $Mem[$indaddr] == 0 ) ? 2 : 1;
|
|
}
|
|
|
|
# Jump
|
|
sub jmp {
|
|
my ( $instruction, $addr, $indaddr ) = @_;
|
|
dprintf( "jmp %06o\n", $indaddr );
|
|
$PC = $indaddr;
|
|
}
|
|
|
|
# Jump to subroutine
|
|
sub jms {
|
|
my ( $instruction, $addr, $indaddr ) = @_;
|
|
dprintf( "jms %06o\n", $indaddr );
|
|
|
|
# Save the LINK and current PC into the $indaddr location
|
|
$Mem[ $indaddr++ ] = $PC + 1 | ( ($LINK) ? 0400000 : 0 );
|
|
$PC = $indaddr;
|
|
}
|
|
|
|
# OPR instructions
|
|
sub opr {
|
|
my ( $instruction, $addr, $indaddr ) = @_;
|
|
|
|
# hlt: halt simulation
|
|
if ( $instruction == 0740040 ) {
|
|
printf( STDERR "PC %06o: program halted\n", $PC );
|
|
dump_memory( 0, MAXADDR, 0 ) if ($debug);
|
|
exit(1);
|
|
}
|
|
|
|
# law: load word into AC
|
|
my $indirect = ( $instruction >> 13 ) & 1;
|
|
if ($indirect) {
|
|
dprintf( "law %06o into AC\n", $instruction );
|
|
$AC = $instruction;
|
|
$PC++;
|
|
return;
|
|
}
|
|
|
|
# List of skip opcode names for the next section
|
|
my @skipop = (
|
|
'', 'sma', 'sza', 'sza sma',
|
|
'snl', 'snl sma', 'snl sza', 'snl sza sma',
|
|
'skp', 'spa', 'sna', 'sna spa',
|
|
'szl', 'szl spa', 'szl sna', 'szl sna spa'
|
|
);
|
|
|
|
# This logic shamelessly borrowed from SimH
|
|
# https://github.com/simh/simh/blob/master/PDP18B/pdp18b_cpu.c
|
|
my $skip = 0;
|
|
my $i = ( $instruction >> 6 ) & 017; # decode IR<8:11>
|
|
dprintf( "L.AC %d.%06o %s", ($LINK) ? 1 : 0, $AC, $skipop[$i] );
|
|
|
|
$skip = 1 if ( ( $i == 1 ) && ( $AC & SIGN ) != 0 ); # sma
|
|
$skip = 1 if ( ( $i == 2 ) && ( $AC & MAXINT ) == 0 ); # sza
|
|
$skip = 1
|
|
if ( ( $i == 3 )
|
|
&& ( ( ( $AC & MAXINT ) == 0 ) || ( ( $AC & SIGN ) != 0 ) ) )
|
|
; # sza | sma
|
|
$skip = 1 if ( ( $i == 4 ) && ($LINK) ); # snl
|
|
$skip = 1 if ( ( $i == 5 ) && ( $LINK || ( $AC >= SIGN ) ) ); # snl | sma
|
|
$skip = 1 if ( ( $i == 6 ) && ( $LINK || ( $AC == 0 ) ) ); # snl | sza
|
|
$skip = 1
|
|
if ( ( $i == 7 )
|
|
&& ( $LINK || ( $AC >= SIGN ) || ( $AC == 0 ) ) ); # snl | sza | sma
|
|
$skip = 1 if ( $i == 010 ); # skp
|
|
$skip = 1 if ( ( $i == 011 ) && ( ( $AC & SIGN ) == 0 ) ); # spa
|
|
$skip = 1 if ( ( $i == 012 ) && ( ( $AC & MAXINT ) != 0 ) ); # sna
|
|
$skip = 1
|
|
if ( ( $i == 013 )
|
|
&& ( ( $AC & MAXINT ) != 0 )
|
|
&& ( ( $AC & SIGN ) == 0 ) ); # sna & spa
|
|
$skip = 1 if ( ( $i == 014 ) && ( $LINK == 0 ) ); # szl
|
|
$skip = 1
|
|
if ( ( $i == 015 ) && ( $LINK == 0 ) && ( $AC < SIGN ) ); # szl & spa
|
|
$skip = 1
|
|
if ( ( $i == 016 ) && ( $LINK == 0 ) && ( $AC != 0 ) ); # szl & sna
|
|
$skip = 1
|
|
if ( ( $i == 017 )
|
|
&& ( $LINK == 0 )
|
|
&& ( $AC != 0 )
|
|
&& ( $AC != 0 ) ); # szl & sna & spa
|
|
|
|
# Clear operations
|
|
if ( $instruction & 010000 ) { # cla
|
|
dprintf(" cla");
|
|
$AC = 0;
|
|
}
|
|
if ( $instruction & 004000 ) { # cli
|
|
dprintf(" cli");
|
|
$LINK = 0;
|
|
}
|
|
if ( $instruction & 000002 ) { # cmi
|
|
dprintf(" cmi");
|
|
$LINK = ($LINK) ? 0 : LINKMASK;
|
|
}
|
|
if ( $instruction & 000001 ) { # cma
|
|
dprintf(" cma");
|
|
$AC = ( $AC ^ MAXINT ) & MAXINT;
|
|
}
|
|
|
|
# Rotate instructions
|
|
$i = $instruction & 02030;
|
|
|
|
# Single rotate right
|
|
if ( $i == 020 ) {
|
|
dprintf(" rar");
|
|
my $newlink = ( $AC & 1 ) ? LINKMASK : 0;
|
|
$AC = ( $LINK | $AC ) >> 1;
|
|
$LINK = $newlink;
|
|
}
|
|
|
|
# Double rotate right
|
|
if ( $i == 02020 ) {
|
|
dprintf(" rtr");
|
|
my $msb = ( $AC & 1 ) << 17;
|
|
my $newlink = ( $AC & 2 ) ? LINKMASK : 0;
|
|
$AC = ( ( $LINK | $AC ) >> 2 ) | $msb;
|
|
$LINK = $newlink;
|
|
}
|
|
|
|
# Single rotate left
|
|
if ( $i == 010 ) {
|
|
dprintf(" ral");
|
|
my $newlink = ( $AC & SIGN ) ? LINKMASK : 0;
|
|
my $lsb = $LINK ? 1 : 0;
|
|
$AC = ( ( $AC << 1 ) | $lsb ) & MAXINT;
|
|
$LINK = $newlink;
|
|
}
|
|
|
|
# Double rotate left
|
|
if ( $i == 02010 ) {
|
|
dprintf(" rtl");
|
|
my $newlink = ( $AC & 0200000 ) ? LINKMASK : 0;
|
|
my $lsb = ( $AC & SIGN ) ? 1 : 0;
|
|
my $twolsb = $LINK ? 2 : 0;
|
|
$AC = ( ( $AC << 2 ) | $twolsb | $lsb ) & MAXINT;
|
|
$LINK = $newlink;
|
|
}
|
|
|
|
# Impossible left and right rotates: 02030 or 00030. Do nothing!
|
|
|
|
# Note: We didn't do the oas instruction above.
|
|
$PC += 1 + $skip;
|
|
dprintf("\n");
|
|
return;
|
|
}
|
|
|
|
# Extended arithmetic element instructions
|
|
sub eae {
|
|
my ( $instruction, $addr, $indaddr ) = @_;
|
|
my $step = $instruction & EAESTEP;
|
|
my $maskedinstr = $instruction & EAEIMASK;
|
|
|
|
if ( $maskedinstr == 0660500 ) { # lrss: long right shift, signed
|
|
# We ignore the MQ as it's not
|
|
# used by any user-mode programs
|
|
dprintf( "lrss %06o AC step %d\n", $AC, $step );
|
|
|
|
# Save the AC's sign into LINK
|
|
my $newlink = ( $AC << 1 ) & LINKMASK;
|
|
$AC = ( ( $LINK | $AC ) >> $step ) & MAXINT;
|
|
$LINK = $newlink;
|
|
$PC++;
|
|
return;
|
|
}
|
|
if ( $maskedinstr == 0660700 ) { # alss: AC left shift, signed
|
|
dprintf( "alss AC %06o step %d\n", $AC, $step );
|
|
$AC = ( $AC << $step ) & MAXINT;
|
|
$LINK = ( $AC << 1 ) & LINKMASK;
|
|
$PC++;
|
|
return;
|
|
}
|
|
if ( $maskedinstr == 0660600 ) { # llss: long left shift, signed
|
|
dprintf( "llss AC %06o step %d\n", $AC, $step );
|
|
foreach my $i ( 1 .. $step ) {
|
|
my $MQmsb = ( $MQ & SIGN ) ? 1 : 0;
|
|
$AC = ( ( $AC << 1 ) | $MQmsb ) & MAXINT;
|
|
$MQ = ( ( $MQ << 1 ) | ( ($LINK) ? 1 : 0 ) ) & MAXINT;
|
|
}
|
|
$PC++;
|
|
return;
|
|
}
|
|
if ( $maskedinstr == 0640700 ) { # als: AC left shift
|
|
dprintf( "als AC %06o step %d\n", $AC, $step );
|
|
$AC = ( $AC << $step ) & MAXINT;
|
|
$PC++;
|
|
return;
|
|
}
|
|
if ( $instruction == 0652000 ) { # lmq: load MC from AC
|
|
dprintf( "lmq AC %06o into MQ\n", $AC );
|
|
$MQ = $AC;
|
|
$PC++;
|
|
return;
|
|
}
|
|
if ( $instruction == 0641002 ) { # lacq: load AC from MQ
|
|
dprintf( "lacq MQ %06o into AC\n", $MQ );
|
|
$AC = $MQ;
|
|
$PC++;
|
|
return;
|
|
}
|
|
if ( $instruction == 0640002 ) { # lacq: OR AC with MQ
|
|
dprintf( "omq MQ %06o and AC %06o\n", $MQ, $AC );
|
|
$AC |= $MQ;
|
|
$PC++;
|
|
return;
|
|
}
|
|
printf( STDERR "PC %06o: Unknown eae instruction %06o\n",
|
|
$PC, $instruction );
|
|
exit(1);
|
|
}
|
|
|
|
# cal: used for system calls
|
|
sub cal {
|
|
my ( $instruction, $addr, $indaddr ) = @_;
|
|
|
|
# Syscalls that we can simulate
|
|
my %Syscallist = (
|
|
|
|
# 1: save
|
|
2 => \&sys_getuid,
|
|
3 => \&sys_open,
|
|
4 => \&sys_read,
|
|
5 => \&sys_write,
|
|
6 => \&sys_creat,
|
|
7 => \&sys_seek,
|
|
# 8 tell
|
|
9 => \&sys_close,
|
|
# 10 link
|
|
11 => \&sys_unlink,
|
|
12 => \&sys_setuid,
|
|
# 13 rename
|
|
14 => \&sys_exit,
|
|
15 => \&sys_time,
|
|
16 => \&sys_intrp,
|
|
17 => \&sys_chdir,
|
|
18 => \&sys_chmod,
|
|
19 => \&sys_chown,
|
|
# 20 badcal
|
|
# 21 syslog
|
|
# 22 badcal
|
|
# 23 capt
|
|
# 24 rele
|
|
25 => \&sys_status,
|
|
# 26 badcal
|
|
27 => \&sys_smes,
|
|
28 => \&sys_rmes,
|
|
29 => \&sys_fork,
|
|
);
|
|
|
|
# Simulate the syscall. Each syscall updates the $PC
|
|
if ( defined( $Syscallist{$addr} ) ) {
|
|
$Syscallist{$addr}->();
|
|
}
|
|
else {
|
|
printf( STDERR "PC %06o: Unknown syscall %d\n", $PC, $addr );
|
|
exit(1);
|
|
}
|
|
}
|
|
|
|
# Exit system call
|
|
sub sys_exit {
|
|
dprintf( "exit system call, pid %06o\n", $$ );
|
|
exit(0);
|
|
}
|
|
|
|
# Getuid system call
|
|
sub sys_getuid {
|
|
$AC = $< & MAXINT;
|
|
dprintf( "getuid system call, uid %06o\n", $AC );
|
|
$PC += 1;
|
|
return;
|
|
}
|
|
|
|
# Setuid system call
|
|
sub sys_setuid {
|
|
|
|
# For now, do nothing
|
|
dprint("setuid system call\n");
|
|
$PC += 1;
|
|
return;
|
|
}
|
|
|
|
# Intrp system call
|
|
sub sys_intrp {
|
|
|
|
# For now, do nothing
|
|
dprint("intrp system call\n");
|
|
$PC += 1;
|
|
return;
|
|
}
|
|
|
|
# Fork system call
|
|
sub sys_fork {
|
|
|
|
# Fork and get the child's process-id back, or zero if we are the child
|
|
my $pid = fork();
|
|
$AC = $pid & MAXINT;
|
|
dprintf( "fork, got id %06o\n", $AC );
|
|
|
|
# The parent returns back to PC+1, the child returns to PC+2
|
|
$PC += ($pid) ? 1 : 2;
|
|
return;
|
|
}
|
|
|
|
# Smes system call. Because we fake rmes with wait(),
|
|
# there is no need for sms. When the child does
|
|
# sys exit, that's going to wake wait() up and do the
|
|
# rmes anyway.
|
|
sub sys_smes {
|
|
|
|
# For now, do nothing
|
|
dprintf("smes system call\n");
|
|
$PC += 1;
|
|
return;
|
|
}
|
|
|
|
# Rmes system call. We simply call wait and
|
|
# return the process-id in AC
|
|
sub sys_rmes {
|
|
my $pid = wait();
|
|
dprintf("rmes system call, got pid $pid\n");
|
|
$AC = $pid & MAXINT;
|
|
$PC += 1;
|
|
return;
|
|
}
|
|
|
|
# Close system call
|
|
sub sys_close {
|
|
|
|
# AC is the file descriptor
|
|
my $fd = $AC;
|
|
dprintf( "close: closing fd %d\n", $fd );
|
|
|
|
# Bump up the PC
|
|
$PC += 1;
|
|
|
|
# That filehandle is not open, set an error -1 in octal
|
|
if ( !defined( $FD[$fd] ) ) {
|
|
dprint("close: fd $fd is not open\n");
|
|
$AC = MAXINT;
|
|
return;
|
|
}
|
|
close( $FD[$fd] );
|
|
$FD[$fd] = undef;
|
|
$ISBINARY[$fd] = 0; # For next time
|
|
$AC = 0;
|
|
return;
|
|
}
|
|
|
|
# Open something which could be a file or a directory
|
|
# Convert directories into files. Return the file handle and
|
|
# if the file is ASCII or binary.
|
|
sub opensomething {
|
|
my ( $readorwrite, $filename ) = @_;
|
|
my $tempfile = "/tmp/a7out.$$";
|
|
my $FH;
|
|
|
|
# If this is not a directory, open it and return the FH
|
|
if ( !-d $filename ) {
|
|
open( $FH, $readorwrite, $filename ) || return (undef);
|
|
|
|
# Opened for writing, so for now this is not binary
|
|
return ( $FH, 0) if ($readorwrite eq ">");
|
|
|
|
# Determine if the file is pure ASCII or contains 18-bit
|
|
# words encoded in 24-bit groups. We test the msb of the
|
|
# first character in the file. If it's on then it's a
|
|
# binary file and not ASCII.
|
|
# XXX: This means that we have to seek back to the beginning,
|
|
# which may be a problem on things like stdin.
|
|
my $ch = getc($FH);
|
|
my $isbinary = ( defined($ch) && ( ord($ch) & 0x80 ) ) ? 1 : 0;
|
|
binmode($FH) if ($isbinary);
|
|
seek( $FH, 0, SEEK_SET );
|
|
return ( $FH, $isbinary );
|
|
}
|
|
|
|
# It's a directory. The on-disk format for this was:
|
|
# d.i: .=.+1 " inode number
|
|
# d.name: .=.+4 " name (space padded)
|
|
# d.uniq: .=.+1 " unique number from directory inode
|
|
# followed by two unused words
|
|
# The code creates a temporary file and fills in the i-node numbers
|
|
# and space padded filenames from the directory. The file is closed
|
|
# opened read-only and unlinked, and the open filehandle is returned.
|
|
opendir( my $dh, $filename ) || return (undef);
|
|
open( $FH, ">", $tempfile ) || return (undef);
|
|
dprintf("Converting directory $filename\n");
|
|
|
|
my @list = sort( readdir($dh) );
|
|
foreach my $name (@list) {
|
|
|
|
# Get the file's i-node number and write it
|
|
my ( undef, $inode ) = stat($name);
|
|
print( $FH word2three($inode) );
|
|
|
|
# Convert the name into 8 characters, space padded
|
|
my $spaceword = sprintf( "%-8s", substr( $name, 0, 8 ) );
|
|
|
|
# Convert to four words and write each as three bytes
|
|
foreach my $word ( ascii2words($spaceword) ) {
|
|
print( $FH word2three($word) );
|
|
}
|
|
|
|
# Now write three zero words to pad to eight in total
|
|
print( $FH word2three(0) );
|
|
print( $FH word2three(0) );
|
|
print( $FH word2three(0) );
|
|
}
|
|
closedir($dh);
|
|
close($FH);
|
|
open( $FH, "<", $tempfile ) || return (undef);
|
|
binmode($FH);
|
|
#exit(0);
|
|
unlink($tempfile);
|
|
return ( $FH, 1 );
|
|
}
|
|
|
|
# Common code for creat and open
|
|
sub creatopen {
|
|
my ( $filename, $readorwrite ) = @_;
|
|
|
|
# Open the file
|
|
my ( $FH, $isbinary ) = opensomething( $readorwrite, $filename );
|
|
if ($FH) {
|
|
|
|
# Find a place in the @FD array to store this filehandle.
|
|
# 99 is arbitrary
|
|
foreach my $fd ( 0 .. 99 ) {
|
|
if ( !defined( $FD[$fd] ) ) {
|
|
$FD[$fd] = $FH;
|
|
$ISBINARY[$fd] = $isbinary;
|
|
$AC = $fd;
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
else {
|
|
# No filehandle, so it's an error
|
|
dprintf("open failed: $!\n");
|
|
$AC = MAXINT;
|
|
}
|
|
}
|
|
|
|
# Open system call
|
|
sub sys_open {
|
|
|
|
# Open seems to have 2 arguments: PC+1 is a pointer to the filename.
|
|
# PC+2 seems to be 1 for write, 0 for read.
|
|
# Some programs seem to have a third argument always set to 0.
|
|
# AC is the opened fd on success, or -1 on error
|
|
|
|
# Get the start address of the string
|
|
# Convert this to a sensible ASCII filename
|
|
my $start = $Mem[ $PC + 1 ];
|
|
my $filename = mem2arg($start);
|
|
|
|
# Choose to open read-only or write-only
|
|
my $readorwrite = ( $Mem[ $PC + 2 ] ) ? ">" : "<";
|
|
dprintf( "open: base %06o, %s file %s\n", $start, $readorwrite, $filename );
|
|
|
|
# Bump up the PC
|
|
$PC += 3;
|
|
|
|
# Now open the file and return
|
|
creatopen( $filename, $readorwrite );
|
|
}
|
|
|
|
# Creat system call
|
|
sub sys_creat {
|
|
|
|
# Creat seems to have 1 argument: PC+1 is a pointer to the filename.
|
|
# Some programs seem to have a second argument always set to 0.
|
|
# AC is the opened fd on success, or -1 on error
|
|
|
|
# Get the start address of the string
|
|
my $start = $Mem[ $PC + 1 ];
|
|
|
|
# Convert this to a sensible ASCII filename
|
|
my $filename = mem2arg($start);
|
|
|
|
# Choose to open write-only
|
|
my $readorwrite = ">";
|
|
dprintf( "creat: base %06o, file %s\n", $start, $filename );
|
|
|
|
# Bump up the PC
|
|
$PC += 2;
|
|
|
|
# Now open the file and return
|
|
creatopen( $filename, $readorwrite );
|
|
}
|
|
|
|
# Read system call
|
|
sub sys_read {
|
|
|
|
# Read seems to have arguments: AC is the file descriptor, PC+1 is
|
|
# the pointer to the buffer and PC+2 is the number of words to read.
|
|
# Return the number of words read in AC on success, or -1 on error.
|
|
|
|
# Get the file descriptor, start address and end address
|
|
my $fd = $AC;
|
|
my $start = $Mem[ $PC + 1 ];
|
|
my $count = $Mem[ $PC + 2 ];
|
|
my $end = ( $start + $count - 1 ) & MAXADDR;
|
|
die("sys_read: bad start/end addresses $start $end\n") if ( $end < $start );
|
|
dprintf( "read: %d words into %06o from fd %d\n", $count, $start, $fd );
|
|
|
|
# Bump up the PC
|
|
$PC += 3;
|
|
|
|
# That filehandle is not open, set an error -1 in octal
|
|
if ( !defined( $FD[$fd] ) ) {
|
|
dprint("read: fd $fd is not open\n");
|
|
$AC = MAXINT;
|
|
return;
|
|
}
|
|
|
|
# Read each word in
|
|
my $FH = $FD[$fd];
|
|
$count = 0;
|
|
foreach my $addr ( $start .. $end ) {
|
|
|
|
if ( $ISBINARY[$fd] ) {
|
|
|
|
# Convert three bytes into one 18-bit word
|
|
my $result = read( $FH, my $three, 3 );
|
|
last if ( $result != 3 ); # Not enough bytes read
|
|
my ( $b1, $b2, $b3 ) = unpack( "CCC", $three );
|
|
$Mem[$addr] = ( ( $b1 & 077 ) << 12 ) | ( $b2 << 6 ) | $b3;
|
|
}
|
|
else {
|
|
# Convert two ASCII characters into one 18-bit word
|
|
my $c1 = getc($FH);
|
|
last if ( !defined($c1) ); # No character, leave the loop
|
|
my $c2 = getc($FH); # No character, make it a NUL
|
|
$c2 = "" if ( !defined($c2) );
|
|
$Mem[$addr] =
|
|
( ord($c1) << 9 ) | ord($c2); # Pack both into one word
|
|
}
|
|
$count++;
|
|
}
|
|
|
|
# No error
|
|
$AC = $count;
|
|
return;
|
|
}
|
|
|
|
# Write system call
|
|
sub sys_write {
|
|
|
|
# Write seems to have arguments: AC is the file descriptor, PC+1 is
|
|
# the pointer to the buffer and PC+2 is the number of words to write
|
|
|
|
# Get the file descriptor, start address and end address
|
|
my $fd = $AC;
|
|
my $start = $Mem[ $PC + 1 ];
|
|
my $count = $Mem[ $PC + 2 ];
|
|
my $end = ( $start + $count - 1 ) & MAXADDR;
|
|
die("sys_write: bad start/end addresses $start $end\n")
|
|
if ( $end < $start );
|
|
dprintf( "write: %d words from %06o to fd %d\n", $count, $start, $fd );
|
|
|
|
# Bump up the PC
|
|
$PC += 3;
|
|
|
|
# That filehandle is not open, set an error -1 in octal
|
|
if ( !defined( $FD[$fd] ) ) {
|
|
dprint("write: fd $fd is not open\n");
|
|
$AC = MAXINT;
|
|
return;
|
|
}
|
|
|
|
# Write each word out either in binary or in ASCII
|
|
my $FH = $FD[$fd];
|
|
foreach my $addr ( $start .. $end ) {
|
|
# First see if any "non-ASCII" bits are set in the word.
|
|
# If so, then this is a binary file
|
|
my $word= $Mem[$addr];
|
|
$ISBINARY[$fd]=1 if ($word & 0600600);
|
|
|
|
if ($ISBINARY[$fd]) {
|
|
print( $FH word2three($word) );
|
|
} else {
|
|
print( $FH word2ascii($word) );
|
|
}
|
|
}
|
|
|
|
# No error
|
|
$AC = 0;
|
|
return;
|
|
}
|
|
|
|
# Chmod system call
|
|
sub sys_chmod {
|
|
|
|
# Chmod gets the permission bits in AC and a pointer
|
|
# to the file's name in PC+1. s2.s has these instruction for chmod:
|
|
# lac u.ac; and o17 so only the lowest 4
|
|
# bits are the permission bits that can be set.
|
|
# I'm going to guess these (from v1 chmod manual):
|
|
# 01 write for non-owner
|
|
# 02 read for non-owner
|
|
# 04 write for owner
|
|
# 10 read for owner
|
|
my $mode = 0;
|
|
$mode |= 0002 if ( $AC & 01 );
|
|
$mode |= 0004 if ( $AC & 02 );
|
|
$mode |= 0220 if ( $AC & 04 );
|
|
$mode |= 0440 if ( $AC & 010 );
|
|
|
|
my $start = $Mem[ $PC + 1 ];
|
|
my $filename = mem2arg($start);
|
|
dprintf( "chmod %06o file %s\n", $mode, $filename );
|
|
|
|
# Do the chmod on the file
|
|
my $result = chmod( $mode, $filename );
|
|
|
|
# Set AC to -1 if no files were changed, else 0
|
|
$AC = ( $result == 0 ) ? MAXINT : 0;
|
|
$PC += 2;
|
|
return;
|
|
}
|
|
|
|
# Chown system call
|
|
sub sys_chown {
|
|
|
|
# Chown gets the numeric user-id in AC and a pointer
|
|
# to the file's name in PC+1.
|
|
# Get the start address of the string
|
|
# Convert this to a sensible ASCII filename
|
|
my $start = $Mem[ $PC + 1 ];
|
|
my $filename = mem2arg($start);
|
|
dprintf( "chown file %s to uid %06o\n", $filename, $AC );
|
|
|
|
# Do the chown, leave group-id untouched. Get number of files changed
|
|
my $result = chown( $AC, -1, $filename );
|
|
|
|
# Set AC to -1 if no files were changed, else 0
|
|
$AC = ( $result == 0 ) ? MAXINT : 0;
|
|
$PC += 2;
|
|
return;
|
|
}
|
|
|
|
# Chdir system call
|
|
sub sys_chdir {
|
|
|
|
# Chdir gets the directory name in PC+1
|
|
# Return 0 on success, -1 on error
|
|
# Convert this to a sensible ASCII filename
|
|
my $start = $Mem[ $PC + 1 ];
|
|
my $filename = mem2arg($start);
|
|
dprintf( "chdir %s\n", $filename );
|
|
|
|
# Bump up the PC
|
|
$PC += 2;
|
|
|
|
# Do nothing on chdir to "dd"
|
|
return (0) if ( $filename eq "dd" );
|
|
|
|
# Do the chdir
|
|
return ( chdir($filename) ? 0 : MAXINT );
|
|
}
|
|
|
|
# Unlink system call
|
|
sub sys_unlink {
|
|
|
|
# Unlink gets the file name in PC+1
|
|
# Return 0 on success, -1 on error
|
|
# Convert this to a sensible ASCII filename
|
|
my $start = $Mem[ $PC + 1 ];
|
|
my $filename = mem2arg($start);
|
|
dprintf( "unlink %s\n", $filename );
|
|
|
|
# Bump up the PC and do the unlink
|
|
$PC += 2;
|
|
return ( unlink($filename) ? 0 : MAXINT );
|
|
}
|
|
|
|
# Time system call
|
|
sub sys_time {
|
|
|
|
# Dennis' draft says: The call sys time returns in
|
|
# the AC and MQ registers the number of sixtieths of
|
|
# a second since the start of the current year.
|
|
|
|
# Get two Datetime objects set to now
|
|
my $dt = DateTime->now;
|
|
my $yearstart = DateTime->now;
|
|
|
|
# Set one object back to the beginning of the year
|
|
$yearstart->set( month => 1 );
|
|
$yearstart->set( day => 1 );
|
|
$yearstart->set( hour => 0 );
|
|
$yearstart->set( minute => 0 );
|
|
$yearstart->set( second => 0 );
|
|
|
|
# Get the duration in sixtieths of a second
|
|
my $duration = $dt->subtract_datetime_absolute($yearstart);
|
|
my $sixtieths = $duration->seconds() * 60;
|
|
|
|
# Set MQ to the high 18 bits and AC to the low 18 bits
|
|
$MQ = $sixtieths >> 18;
|
|
$AC = $sixtieths & 0777777;
|
|
dprintf( "time %06o %06o\n", $MQ, $AC );
|
|
$PC += 1;
|
|
return;
|
|
}
|
|
|
|
# Status system call
|
|
sub sys_status {
|
|
|
|
# This seems to called as follows:
|
|
# law statbuf
|
|
# sys status; scrname; dd
|
|
# but I can't tell if PC+1 or PC+2 holds the filename pointer.
|
|
# For now, I'll use PC+1. $AC seems to hold the pointer to the statbuf
|
|
# which, as far as we can tell is:
|
|
# word 0: permission bits
|
|
# words 1-7: disk block pointers
|
|
# word 8: user-id
|
|
# word 9: number of links
|
|
# word 10: size in words
|
|
# word 11: uniq, I have no idea what this is.
|
|
# The permission bits are:
|
|
# 200000 large file, bigger than 4096 words
|
|
# 000020 directory
|
|
# 000010 owner read
|
|
# 000004 owner write
|
|
# 000002 user write
|
|
# 000001 user write
|
|
|
|
# Get the start address of the string
|
|
# Convert this to a sensible ASCII filename
|
|
my $start = $Mem[ $PC + 1 ];
|
|
my $filename = mem2arg($start);
|
|
dprintf( "status file %s statbuf %06o\n", $filename, $AC );
|
|
|
|
# Get the file's details
|
|
my ( undef, undef, $mode, $nlink, $uid, undef, undef, $size ) =
|
|
stat($filename);
|
|
|
|
# Set up the statbuf if we got a result
|
|
if ($nlink) {
|
|
$Mem[ $AC + 8 ] = $uid & MAXINT;
|
|
$Mem[ $AC + 9 ] = $nlink & MAXINT;
|
|
$Mem[ $AC + 10 ] = $size & MAXINT; # Yes, I know, not words
|
|
|
|
my $perms = 0;
|
|
$perms = 01 if ( $mode & 02 ); # World writable
|
|
$perms |= 02 if ( $mode & 04 ); # World readable
|
|
$perms |= 04 if ( $mode & 0200 ); # Owner writable
|
|
$perms |= 010 if ( $mode & 0400 ); # Owner readable
|
|
$perms |= 020 if ( -d $filename ); # Directory
|
|
$perms |= 0200000 if ( $size > 4096 ); # Large file
|
|
$Mem[$AC] = $perms;
|
|
|
|
# Set AC to zero as we got something, else return -1
|
|
$AC = 0;
|
|
}
|
|
else {
|
|
$AC = MAXINT;
|
|
}
|
|
|
|
$PC += 3;
|
|
return;
|
|
}
|
|
|
|
# Seek syscall
|
|
sub sys_seek {
|
|
# Seek takes three arguments: AC is the fd, PC+1 is a signed count
|
|
# and PC+1 is how to seek: 0=from start, 1=from curptr, 2=from end
|
|
# of file. Return AC=0 if OK, -1 on error.
|
|
my $fd= $AC;
|
|
my $FH= $FD[$fd];
|
|
my $offset= $Mem[ $PC + 1 ];
|
|
# XXX For now, we always do SEEK_SET.
|
|
|
|
# If it's a binary file, we have to seek 3 bytes for every word,
|
|
# but for an ASCII file that's 2 bytes per word.
|
|
$offset *= ($ISBINARY[$fd]) ? 3 : 2;
|
|
my $result= seek($FH, $offset, SEEK_SET);
|
|
|
|
# Set the AC result
|
|
$AC= ($result)? 0: MAXINT;
|
|
$PC += 3;
|
|
return;
|
|
}
|
|
|
|
# Convert an 18-bit word into a scalar which has three sixbit
|
|
# values in three bytes. Set the msb in the first byte
|
|
sub word2three {
|
|
my $val = shift;
|
|
|
|
my $b1 = ( ( $val >> 12 ) & 077 ) | 0x80;
|
|
my $b2 = ( $val >> 6 ) & 077;
|
|
my $b3 = $val & 077;
|
|
return ( pack( "CCC", $b1, $b2, $b3 ) );
|
|
}
|
|
|
|
# Convert an ASCII string into an array of 18-bit word values
|
|
# where two characters are packed into each word. Put NUL in
|
|
# if the string has an odd number of characters. Return the array
|
|
sub ascii2words {
|
|
my $str = shift;
|
|
my @words;
|
|
for ( my $i = 0 ; $i < length($str) ; $i += 2 ) {
|
|
my $c1 = substr( $str, $i, 1 ) || "\0";
|
|
my $c2 = substr( $str, $i + 1, 1 ) || "\0";
|
|
|
|
push( @words, ( ord($c1) << 9 ) | ord($c2) );
|
|
}
|
|
return (@words);
|
|
}
|
|
|
|
# Convert an 18-bit word into two ASCII characters and return them.
|
|
# Don't return NUL characters
|
|
sub word2ascii {
|
|
my $word = shift;
|
|
my $c1 = ( $word >> 9 ) & 0177;
|
|
my $c2 = $word & 0177;
|
|
my $result = "";
|
|
$result .= chr($c1) if ($c1);
|
|
$result .= chr($c2) if ($c2);
|
|
return ($result);
|
|
}
|
|
|
|
# Given the address of a four word argument string in
|
|
# memory, return a copy of the string in ASCII format.
|
|
# Lose any trailing spaces as well.
|
|
sub mem2arg {
|
|
my $addr = shift;
|
|
my $result = "";
|
|
|
|
foreach ( 1 .. 4 ) {
|
|
|
|
# Stop if the address leave the 8K word address space
|
|
last if ( $addr > MAXADDR );
|
|
my $word = $Mem[ $addr++ ];
|
|
my $c1 = ( $word >> 9 ) & 0177;
|
|
my $c2 = $word & 0177;
|
|
$result .= chr($c1) . chr($c2);
|
|
}
|
|
$result =~ s{ *$}{};
|
|
return ($result);
|
|
}
|
|
|
|
# Print out debug messages
|
|
sub dprintf {
|
|
printf( STDERR @_ ) if ( ($debug) || ($singlestep) );
|
|
}
|
|
|
|
# Get one or more commands from the user and execute them
|
|
sub get_user_command {
|
|
my %Cmdlist = (
|
|
'b' => \&cmd_setbreak,
|
|
'break' => \&cmd_setbreak,
|
|
'd' => \&cmd_dump,
|
|
'dump' => \&cmd_dump,
|
|
'db' => \&cmd_delbreak,
|
|
'del' => \&cmd_delbreak,
|
|
'delete' => \&cmd_delbreak,
|
|
'?' => \&cmd_help,
|
|
'h' => \&cmd_help,
|
|
'help' => \&cmd_help,
|
|
's' => \&cmd_step,
|
|
'l' => \&cmd_listbreak,
|
|
'list' => \&cmd_listbreak,
|
|
'step' => \&cmd_step,
|
|
'q' => \&cmd_exit,
|
|
'x' => \&cmd_exit,
|
|
'quit' => \&cmd_exit,
|
|
'exit' => \&cmd_exit,
|
|
'c' => \&cmd_continue,
|
|
'continue' => \&cmd_continue,
|
|
'r' => \&cmd_showregs,
|
|
'regs' => \&cmd_showregs,
|
|
);
|
|
|
|
# Loop until we get a leave result
|
|
while (1) {
|
|
|
|
# Get a command from the user
|
|
# and split into command, start and end addresses.
|
|
# Convert addresses from octal
|
|
print("a7out> ");
|
|
chomp( my $line = <STDIN> );
|
|
my ( $cmd, $addr, $endaddr ) = split( /\s+/, $line );
|
|
$addr = oct($addr) if ( defined($addr) );
|
|
$endaddr = oct($endaddr) if ( defined($endaddr) );
|
|
|
|
# Run the command
|
|
my $leave;
|
|
if ( defined($cmd) && defined( $Cmdlist{$cmd} ) ) {
|
|
$leave = $Cmdlist{$cmd}->( $addr, $endaddr );
|
|
}
|
|
else {
|
|
printf( "%s: unknown command\n", $cmd || "" );
|
|
cmd_help();
|
|
}
|
|
return if ($leave);
|
|
}
|
|
}
|
|
|
|
# Exit the program
|
|
sub cmd_exit {
|
|
exit(0);
|
|
}
|
|
|
|
# Continue by disabling single-step
|
|
# and break out of the command loop
|
|
sub cmd_continue {
|
|
$singlestep = 0;
|
|
return (1);
|
|
}
|
|
|
|
# Step by staying in single-step
|
|
# but break out of the command loop
|
|
sub cmd_step {
|
|
return (1);
|
|
}
|
|
|
|
# Set a breakpoint
|
|
sub cmd_setbreak {
|
|
my $addr = shift;
|
|
$Breakpoint{$addr} = 1;
|
|
return (0);
|
|
}
|
|
|
|
# Delete a breakpoint
|
|
sub cmd_delbreak {
|
|
my $addr = shift;
|
|
delete( $Breakpoint{$addr} );
|
|
printf( "Delete breakpoint %06o\n", $addr );
|
|
return (0);
|
|
}
|
|
|
|
sub cmd_help {
|
|
print(" [b]reak <octal> set a breakpoint\n");
|
|
print(" [c]ontinue leave single-step and continue\n");
|
|
print(" [d]ump [<octal>] [<octal>] dump addresses in range\n");
|
|
print(" db <octal> delete a breakpoint\n");
|
|
print(" [del]ete <octal> delete a breakpoint\n");
|
|
print(" [l]ist list breakpoints\n");
|
|
print(" [r]egs print PC, LINK, AC and MQ regs\n");
|
|
print(" [s]tep single-step next instruction\n");
|
|
print(" ?, h, help print this help list\n");
|
|
print(" e[x]it, [q]uit exit the program\n");
|
|
return (0);
|
|
}
|
|
|
|
sub cmd_showregs {
|
|
my $link = ($LINK) ? 1 : 0;
|
|
printf( "PC: %06o, L.AC %d.%06o, MQ: %06o\n", $PC, $link, $AC, $MQ );
|
|
return (0);
|
|
}
|
|
|
|
sub cmd_dump {
|
|
my ( $start, $end ) = @_;
|
|
|
|
# No arguments, so dump everything but not empty locations
|
|
if ( !defined($start) ) {
|
|
dump_memory( 0, MAXADDR, 0 );
|
|
return (0);
|
|
}
|
|
|
|
# Dump a limited range
|
|
$end = $start if ( !defined($end) );
|
|
dump_memory( $start, $end, 1 );
|
|
return (0);
|
|
}
|
|
|
|
sub cmd_listbreak {
|
|
print("Breakpoints:\n");
|
|
foreach my $addr ( sort( keys(%Breakpoint) ) ) {
|
|
printf( " %06o\n", $addr );
|
|
}
|
|
return (0);
|
|
}
|