github.com/DoctorWkt.pdp7-unix
1
0
Fork 0
mirror of https://github.com/DoctorWkt/pdp7-unix.git synced 2026-01-25 19:57:20 +00:00
Code Issues 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

200
tools/a7out
View File

@@ -37,7 +37,8 @@ while ( defined( $ARGV[0] ) && ( $ARGV[0] =~ m{^-} ) ) {
# -d: debug mode
if ( $ARGV[0] eq "-d" ) {
$debug = 1; shift(@ARGV);
$debug = 1;
shift(@ARGV);
}
# -b: set a breakpoint
@@ -144,7 +145,7 @@ sub set_arguments {
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);
#printf("Saving %06o to %06o\n", (ord($c1) << 9 ) | ord($c2), $addr);
$Mem[ $addr++ ] = ( ord($c1) << 9 ) | ord($c2);
}
}
@@ -184,15 +185,15 @@ sub simulate {
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 );
}
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 );
#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} ) ) {
@@ -248,25 +249,17 @@ sub add {
my ( $instruction, $addr, $indaddr ) = @_;
dprintf( "add AC (value %06o) with addr %06o (%06o)\n",
$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
# 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;
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
if ( ( ( ~$AC ^ $sum ) & ( $AC ^ $sum ) ) & SIGN ) { # overflow?
$LINK = LINKMASK; # set link
}
$AC= $sum;
$AC = $sum;
$PC++;
}
@@ -341,8 +334,8 @@ sub opr {
}
# law: load word into AC
my $indirect = ( $instruction >> 13 ) & 1;
if ( $indirect) {
my $indirect = ( $instruction >> 13 ) & 1;
if ($indirect) {
dprintf( "law %06o into AC\n", $instruction );
$AC = $instruction;
$PC++;
@@ -350,94 +343,104 @@ sub opr {
}
# 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');
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]);
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
$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 & 010000 ) { # cla
dprintf(" cla"); $AC = 0;
}
if ($instruction & 004000) { # cli
dprintf(" cli"); $LINK=0;
if ( $instruction & 004000 ) { # cli
dprintf(" cli"); $LINK = 0;
}
if ($instruction & 000002) { # cmi
dprintf(" cmi"); $LINK= ($LINK) ? 0 : LINKMASK;
if ( $instruction & 000002 ) { # cmi
dprintf(" cmi");
$LINK = ($LINK) ? 0 : LINKMASK;
}
if ($instruction & 000001) { # cma
dprintf(" cma"); $AC= ($AC ^ MAXINT) & MAXINT;
if ( $instruction & 000001 ) { # cma
dprintf(" cma");
$AC = ( $AC ^ MAXINT ) & MAXINT;
}
# Rotate instructions
$i= $instruction & 02030;
$i = $instruction & 02030;
# Single rotate right
if ($i == 020) {
dprintf(" rar");
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;
if ( $i == 02020 ) {
dprintf(" rtr");
my $msb = ( $AC & 1 ) << 17;
my $newlink = ( $AC & 2 ) ? LINKMASK : 0;
$AC = (( $LINK | $AC ) >> 2) | $msb;
$AC = ( ( $LINK | $AC ) >> 2 ) | $msb;
$LINK = $newlink;
}
# Single rotate left
if ($i == 010) {
dprintf(" ral");
if ( $i == 010 ) {
dprintf(" ral");
my $newlink = ( $AC & SIGN ) ? LINKMASK : 0;
my $lsb = $LINK ? 1 : 0;
$AC= (($AC << 1) | $lsb) & MAXINT;
my $lsb = $LINK ? 1 : 0;
$AC = ( ( $AC << 1 ) | $lsb ) & MAXINT;
$LINK = $newlink;
}
# Double rotate left
if ($i == 02010) {
dprintf(" rtl");
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;
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;
$PC += 1 + $skip;
dprintf("\n");
return;
}
@@ -471,22 +474,20 @@ sub eae {
$instruction &= EAEIMASK;
if ( $instruction == 0660500 ) { # lrss: long right shift, signed
# We ignore the MQ as it's not
# used by any user-mode programs
# 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;
$AC = ( ( $LINK | $AC ) >> $step ) & MAXINT;
$LINK = $newlink;
$PC++;
return;
}
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 );
$AC = ( $AC << $step ) & MAXINT;
$PC++;
return;
@@ -526,6 +527,7 @@ sub sys_close {
# 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.
@@ -538,7 +540,7 @@ sub sys_open {
my $filename = mem2arg($start);
# 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 );
# Bump up the PC
@@ -595,22 +597,12 @@ sub sys_read {
$count = 0;
foreach my $addr ( $start .. $end ) {
# It's a terminal, so convert from ASCII
if ( -t $FH ) {
my $c1 = getc($FH);
last if ( !defined($c1) ); # No character, leave the loop
my $c2 = getc($FH) || ""; # No character, make it a NUL
$Mem[$addr] =
( 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++;
}
my $c1 = getc($FH);
last if ( !defined($c1) ); # No character, leave the loop
my $c2 = getc($FH) || ""; # No character, make it a NUL
$Mem[$addr] =
( ord($c1) << 9 ) | ord($c2); # Pack both into one word
$count++;
}
# No error
@@ -647,13 +639,7 @@ sub sys_write {
my $FH = $FD[$fd];
foreach my $addr ( $start .. $end ) {
# It's a terminal, so convert to ASCII
# otherwise (for now) print in octal
if ( -t $FH ) {
print( $FH word2ascii( $Mem[$addr] ) );
} else {
printf( $FH "%06o\n", $Mem[$addr] );
}
print( $FH word2ascii( $Mem[$addr] ) );
}
# No error