glm94/pdp7-unix
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

tools/a7out: I took out the code to pretend to deal with binary files,

Browse Source 
and I did a perltidy to reformat the code.
This commit is contained in:
Warren Toomey
2016-03-01 18:28:37 +10:00
parent cd60f962c0
commit a2e8a187b2
1 changed files with 93 additions and 107 deletions
Download Patch File Download Diff File Expand all files Collapse all files
tools/a7out
+93 -107
View File
@@ -37,7 +37,8 @@ while ( defined( $ARGV[0] ) && ( $ARGV[0] =~ m{^-} ) ) {
# -d: debug mode # -d: debug mode
if ( $ARGV[0] eq "-d" ) { if ( $ARGV[0] eq "-d" ) {
$debug = 1; shift(@ARGV); $debug = 1;
shift(@ARGV);
} }
# -b: set a breakpoint # -b: set a breakpoint
@@ -144,7 +145,7 @@ sub set_arguments {
my $c1 = substr( $str, $i, 1 ) || ""; my $c1 = substr( $str, $i, 1 ) || "";
my $c2 = substr( $str, $i + 1, 1 ) || ""; my $c2 = substr( $str, $i + 1, 1 ) || "";
#printf("Saving %06o to %06o\n", (ord($c1) << 9 ) | ord($c2), $addr); #printf("Saving %06o to %06o\n", (ord($c1) << 9 ) | ord($c2), $addr);
$Mem[ $addr++ ] = ( ord($c1) << 9 ) | ord($c2); $Mem[ $addr++ ] = ( ord($c1) << 9 ) | ord($c2);
} }
} }
@@ -184,15 +185,15 @@ sub simulate {
my $indaddr = ($indirect) ? $Mem[$addr] & MAXADDR : $addr; my $indaddr = ($indirect) ? $Mem[$addr] & MAXADDR : $addr;
# If this is a breakpoint, stop now and get a user command # If this is a breakpoint, stop now and get a user command
if ( defined( $Breakpoint{$PC} ) ) { if ( defined( $Breakpoint{$PC} ) ) {
$singlestep = 1; $singlestep = 1;
dprintf( "break at PC %06o\n", $PC ); dprintf( "break at PC %06o\n", $PC );
} }
get_user_command() if ($singlestep); get_user_command() if ($singlestep);
dprintf( "PC %06o: ", $PC ); dprintf( "PC %06o: ", $PC );
#dprintf("PC %06o: instr %06o, op %03o, in %o, addr %06o indaddr %06o\n", #dprintf("PC %06o: instr %06o, op %03o, in %o, addr %06o indaddr %06o\n",
# $PC, $instruction, $opcode, $indirect, $addr, $indaddr ); # $PC, $instruction, $opcode, $indirect, $addr, $indaddr );
# Simulate the instruction. Each subroutine updates the $PC # Simulate the instruction. Each subroutine updates the $PC
if ( defined( $Oplist{$opcode} ) ) { if ( defined( $Oplist{$opcode} ) ) {
@@ -248,25 +249,17 @@ sub add {
my ( $instruction, $addr, $indaddr ) = @_; my ( $instruction, $addr, $indaddr ) = @_;
dprintf( "add AC (value %06o) with addr %06o (%06o)\n", dprintf( "add AC (value %06o) with addr %06o (%06o)\n",
$AC, $indaddr, $Mem[$indaddr] ); $AC, $indaddr, $Mem[$indaddr] );
# $LINK = 0;
# $AC = $AC + $Mem[$indaddr];
# if ( $AC & LINKMASK ) {
# $AC++; # End-around carry
# $LINK = LINKMASK;
# }
# $AC = $AC & MAXINT;
#
# This logic shamelessly borrowed from SimH # This logic shamelessly borrowed from SimH
# https://github.com/simh/simh/blob/master/PDP18B/pdp18b_cpu.c # https://github.com/simh/simh/blob/master/PDP18B/pdp18b_cpu.c
my $sum= $AC + $Mem[$indaddr]; my $sum = $AC + $Mem[$indaddr];
if ($sum > MAXINT) { # end around carry if ( $sum > MAXINT ) { # end around carry
$sum = ($sum + 1) & MAXINT; $sum = ( $sum + 1 ) & MAXINT;
} }
if (((~$AC ^ $sum) & ($AC ^ $sum)) & SIGN) { # overflow? if ( ( ( ~$AC ^ $sum ) & ( $AC ^ $sum ) ) & SIGN ) { # overflow?
$LINK= LINKMASK; # set link $LINK = LINKMASK; # set link
} }
$AC= $sum; $AC = $sum;
$PC++; $PC++;
} }
@@ -341,8 +334,8 @@ sub opr {
} }
# law: load word into AC # law: load word into AC
my $indirect = ( $instruction >> 13 ) & 1; my $indirect = ( $instruction >> 13 ) & 1;
if ( $indirect) { if ($indirect) {
dprintf( "law %06o into AC\n", $instruction ); dprintf( "law %06o into AC\n", $instruction );
$AC = $instruction; $AC = $instruction;
$PC++; $PC++;
@@ -350,94 +343,104 @@ sub opr {
} }
# List of skip opcode names for the next section # List of skip opcode names for the next section
my @skipop= ( '', 'sma', 'sza', 'sza sma', my @skipop = (
'snl', 'snl sma', 'snl sza', 'snl sza sma', '', 'sma', 'sza', 'sza sma',
'skp', 'spa', 'sna', 'sna spa', 'snl', 'snl sma', 'snl sza', 'snl sza sma',
'szl', 'szl spa', 'szl sna', 'szl sna spa'); 'skp', 'spa', 'sna', 'sna spa',
'szl', 'szl spa', 'szl sna', 'szl sna spa'
);
# This logic shamelessly borrowed from SimH # This logic shamelessly borrowed from SimH
# https://github.com/simh/simh/blob/master/PDP18B/pdp18b_cpu.c # https://github.com/simh/simh/blob/master/PDP18B/pdp18b_cpu.c
my $skip=0; my $skip = 0;
my $i= ($instruction >> 6) & 017; # decode IR<8:11> my $i = ( $instruction >> 6 ) & 017; # decode IR<8:11>
dprintf("L.AC %d.%06o %s", ($LINK) ? 1 : 0, $AC, $skipop[$i]); 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 == 1 ) && ( $AC & SIGN ) != 0 ); # sma
$skip=1 if (($i == 2) && ($AC & MAXINT) == 0); # sza $skip = 1 if ( ( $i == 2 ) && ( $AC & MAXINT ) == 0 ); # sza
$skip=1 if (($i == 3) && $skip = 1 if ( ( $i == 3 )
((($AC & MAXINT) == 0) || (($AC & SIGN) != 0))); # sza | sma && ( ( ( $AC & MAXINT ) == 0 ) || ( ( $AC & SIGN ) != 0 ) ) )
$skip=1 if (($i == 4) && ($LINK)); # snl ; # sza | sma
$skip=1 if (($i == 5) && ($LINK || ($AC >= SIGN))); # snl | sma $skip = 1 if ( ( $i == 4 ) && ($LINK) ); # snl
$skip=1 if (($i == 6) && ($LINK || ($AC == 0))); # snl | sza $skip = 1 if ( ( $i == 5 ) && ( $LINK || ( $AC >= SIGN ) ) ); # snl | sma
$skip=1 if (($i == 7) && $skip = 1 if ( ( $i == 6 ) && ( $LINK || ( $AC == 0 ) ) ); # snl | sza
($LINK || ($AC >= SIGN) || ($AC == 0))); # snl | sza | sma $skip = 1 if ( ( $i == 7 )
$skip=1 if ($i == 010); # skp && ( $LINK || ( $AC >= SIGN ) || ( $AC == 0 ) ) ); # snl | sza | sma
$skip=1 if (($i == 011) && (($AC & SIGN) == 0)); # spa $skip = 1 if ( $i == 010 ); # skp
$skip=1 if (($i == 012) && (($AC & MAXINT) != 0)); # sna $skip = 1 if ( ( $i == 011 ) && ( ( $AC & SIGN ) == 0 ) ); # spa
$skip=1 if (($i == 013) && $skip = 1 if ( ( $i == 012 ) && ( ( $AC & MAXINT ) != 0 ) ); # sna
(($AC & MAXINT) != 0) && (($AC & SIGN) == 0)); # sna & spa $skip = 1 if ( ( $i == 013 )
$skip=1 if (($i == 014) && ($LINK == 0)); # szl && ( ( $AC & MAXINT ) != 0 )
$skip=1 if (($i == 015) && ($LINK == 0) && ($AC < SIGN)); # szl & spa && ( ( $AC & SIGN ) == 0 ) ); # sna & spa
$skip=1 if (($i == 016) && ($LINK == 0) && ($AC != 0)); # szl & sna $skip = 1 if ( ( $i == 014 ) && ( $LINK == 0 ) ); # szl
$skip=1 if (($i == 017) && $skip = 1
($LINK == 0) && ($AC != 0) && ($AC != 0)); # szl & sna & spa 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 # Clear operations
if ($instruction & 010000) { # cla if ( $instruction & 010000 ) { # cla
dprintf(" cla"); $AC=0; dprintf(" cla"); $AC = 0;
} }
if ($instruction & 004000) { # cli if ( $instruction & 004000 ) { # cli
dprintf(" cli"); $LINK=0; dprintf(" cli"); $LINK = 0;
} }
if ($instruction & 000002) { # cmi if ( $instruction & 000002 ) { # cmi
dprintf(" cmi"); $LINK= ($LINK) ? 0 : LINKMASK; dprintf(" cmi");
$LINK = ($LINK) ? 0 : LINKMASK;
} }
if ($instruction & 000001) { # cma if ( $instruction & 000001 ) { # cma
dprintf(" cma"); $AC= ($AC ^ MAXINT) & MAXINT; dprintf(" cma");
$AC = ( $AC ^ MAXINT ) & MAXINT;
} }
# Rotate instructions # Rotate instructions
$i= $instruction & 02030; $i = $instruction & 02030;
# Single rotate right # Single rotate right
if ($i == 020) { if ( $i == 020 ) {
dprintf(" rar"); dprintf(" rar");
my $newlink = ( $AC & 1 ) ? LINKMASK : 0; my $newlink = ( $AC & 1 ) ? LINKMASK : 0;
$AC = ( $LINK | $AC ) >> 1; $AC = ( $LINK | $AC ) >> 1;
$LINK = $newlink; $LINK = $newlink;
} }
# Double rotate right # Double rotate right
if ($i == 02020) { if ( $i == 02020 ) {
dprintf(" rtr"); dprintf(" rtr");
my $msb= ($AC & 1) << 17; my $msb = ( $AC & 1 ) << 17;
my $newlink = ( $AC & 2 ) ? LINKMASK : 0; my $newlink = ( $AC & 2 ) ? LINKMASK : 0;
$AC = (( $LINK | $AC ) >> 2) | $msb; $AC = ( ( $LINK | $AC ) >> 2 ) | $msb;
$LINK = $newlink; $LINK = $newlink;
} }
# Single rotate left # Single rotate left
if ($i == 010) { if ( $i == 010 ) {
dprintf(" ral"); dprintf(" ral");
my $newlink = ( $AC & SIGN ) ? LINKMASK : 0; my $newlink = ( $AC & SIGN ) ? LINKMASK : 0;
my $lsb = $LINK ? 1 : 0; my $lsb = $LINK ? 1 : 0;
$AC= (($AC << 1) | $lsb) & MAXINT; $AC = ( ( $AC << 1 ) | $lsb ) & MAXINT;
$LINK = $newlink; $LINK = $newlink;
} }
# Double rotate left # Double rotate left
if ($i == 02010) { if ( $i == 02010 ) {
dprintf(" rtl"); dprintf(" rtl");
my $newlink = ( $AC & 0200000 ) ? LINKMASK : 0; my $newlink = ( $AC & 0200000 ) ? LINKMASK : 0;
my $lsb = ( $AC & SIGN ) ? 1 : 0; my $lsb = ( $AC & SIGN ) ? 1 : 0;
my $twolsb = $LINK ? 2 : 0; my $twolsb = $LINK ? 2 : 0;
$AC= (($AC << 2) | $twolsb | $lsb) & MAXINT; $AC = ( ( $AC << 2 ) | $twolsb | $lsb ) & MAXINT;
$LINK = $newlink; $LINK = $newlink;
} }
# Impossible left and right rotates: 02030 or 00030. Do nothing! # Impossible left and right rotates: 02030 or 00030. Do nothing!
# Note: We didn't do the oas instruction above. # Note: We didn't do the oas instruction above.
$PC+= 1 + $skip; $PC += 1 + $skip;
dprintf("\n"); dprintf("\n");
return; return;
} }
@@ -471,22 +474,20 @@ sub eae {
$instruction &= EAEIMASK; $instruction &= EAEIMASK;
if ( $instruction == 0660500 ) { # lrss: long right shift, signed if ( $instruction == 0660500 ) { # lrss: long right shift, signed
# We ignore the MQ as it's not # We ignore the MQ as it's not
# used by any user-mode programs # used by any user-mode programs
dprintf( "lrss %06o AC step %d\n", $AC, $step ); dprintf( "lrss %06o AC step %d\n", $AC, $step );
# Save the AC's sign into LINK # Save the AC's sign into LINK
my $newlink = ( $AC << 1 ) & LINKMASK; my $newlink = ( $AC << 1 ) & LINKMASK;
$AC = ( ( $LINK | $AC ) >> $step ) & MAXINT;
$AC = (($LINK |$AC) >> $step) & MAXINT; $LINK = $newlink;
$LINK= $newlink;
$PC++; $PC++;
return; return;
} }
if ( $instruction == 0660700 ) { # alss: long left shift, signed if ( $instruction == 0660700 ) { # alss: long left shift, signed
# We don't fill the lsb with LINK yet # We don't fill the lsb with LINK yet
dprintf( "alss %06o AC step %d\n", $AC, $step ); dprintf( "alss %06o AC step %d\n", $AC, $step );
$AC = ( $AC << $step ) & MAXINT; $AC = ( $AC << $step ) & MAXINT;
$PC++; $PC++;
return; return;
@@ -526,6 +527,7 @@ sub sys_close {
# Open system call # Open system call
sub sys_open { sub sys_open {
# Open seems to have 2 arguments: PC+1 is a pointer to the filename. # 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. # PC+2 seems to be 1 for write, 0 for read.
# Some programs seem to have a third argument always set to 0. # Some programs seem to have a third argument always set to 0.
@@ -538,7 +540,7 @@ sub sys_open {
my $filename = mem2arg($start); my $filename = mem2arg($start);
# Choose to open read-only or write-only # Choose to open read-only or write-only
my $readorwrite= ($Mem[ $PC + 2 ]) ? ">" : "<"; my $readorwrite = ( $Mem[ $PC + 2 ] ) ? ">" : "<";
dprintf( "open: base %06o, %s file %s\n", $start, $readorwrite, $filename ); dprintf( "open: base %06o, %s file %s\n", $start, $readorwrite, $filename );
# Bump up the PC # Bump up the PC
@@ -595,22 +597,12 @@ sub sys_read {
$count = 0; $count = 0;
foreach my $addr ( $start .. $end ) { foreach my $addr ( $start .. $end ) {
# It's a terminal, so convert from ASCII my $c1 = getc($FH);
if ( -t $FH ) { last if ( !defined($c1) ); # No character, leave the loop
my $c1 = getc($FH); my $c2 = getc($FH) || ""; # No character, make it a NUL
last if ( !defined($c1) ); # No character, leave the loop $Mem[$addr] =
my $c2 = getc($FH) || ""; # No character, make it a NUL ( ord($c1) << 9 ) | ord($c2); # Pack both into one word
$Mem[$addr] = $count++;
( ord($c1) << 9 ) | ord($c2); # Pack both into one word
$count++;
} else {
# otherwise (for now) read in one line and convert to octal
my $line = <$FH>;
last if ( !defined($line) ); # No line, leave the loop
chomp($line);
$Mem[$addr] = oct($line) & MAXINT;
$count++;
}
} }
# No error # No error
@@ -647,13 +639,7 @@ sub sys_write {
my $FH = $FD[$fd]; my $FH = $FD[$fd];
foreach my $addr ( $start .. $end ) { foreach my $addr ( $start .. $end ) {
# It's a terminal, so convert to ASCII print( $FH word2ascii( $Mem[$addr] ) );
# otherwise (for now) print in octal
if ( -t $FH ) {
print( $FH word2ascii( $Mem[$addr] ) );
} else {
printf( $FH "%06o\n", $Mem[$addr] );
}
} }
# No error # No error