another round of (hopeful) improvements

add indirect bit to "sys" definition
set initial ".." (output base) to 4096 (not yet honored)
add "ptr" output format (binary in paper tape reader format: 3 frames of 6 bits)
remove IOT instrictions (system source uses sop.s)
always write labels to "n.out"
add debug output
fix multiply defined error handling (process symbolic labels on both passes)
This commit is contained in:
Phil Budne
2016-03-01 11:22:53 -05:00
parent 66909ac6fd
commit ff4d793ca5
+60 -71
View File
@@ -4,7 +4,7 @@
# and convert them into PDP-7 machine code # and convert them into PDP-7 machine code
# #
# (c) 2016 Warren Toomey, GPL3 # (c) 2016 Warren Toomey, GPL3
# Tweaked by Phil Budne (line, expression parsing, "list" format) # Tweaked by Phil Budne (line, expression parsing, "list", "ptr" formats)
# #
use strict; use strict;
use warnings; use warnings;
@@ -31,12 +31,11 @@ my $lineno; # current line number
## command line options ## command line options
my $debug = 0; # Run in debug mode my $debug = 0; # Run in debug mode
my $symbols = 0; # dump symbols
my $format = 'a7out'; # output format my $format = 'a7out'; # output format
# keep this near the GetOptions call to make it easy to add documentation! # keep this near the GetOptions call to make it easy to add documentation!
sub usage { sub usage {
die("Usage: $0 [--debug] [--format=a7out|list ] file1.s [file2.s ...]\n") die("Usage: $0 [--debug] [--format=a7out|list|ptr ] file1.s [file2.s ...]\n")
} }
### Main program ### ### Main program ###
@@ -52,7 +51,11 @@ usage() if ( @ARGV < 1 );
# predefine syscall and opcodes as variables # predefine syscall and opcodes as variables
%Var = ( %Var = (
'.' => 0, '.' => 0,
'..' => 0, '..' => 4096, # output base addr?
# as.s does not have an initial symbol table
# (except for the above), so there must have been a
# user "ops" file
save => 1, # saves core dump & user area! save => 1, # saves core dump & user area!
getuid => 2, getuid => 2,
@@ -85,9 +88,8 @@ usage() if ( @ARGV < 1 );
# List of instruction names and machine code values # List of instruction names and machine code values
# These come from https://raw.githubusercontent.com/simh/ # These come from https://raw.githubusercontent.com/simh/
# simtools/master/crossassemblers/macro7/macro7.c
# PLB: replace with symbols in "sop.s"? sys => 0020000, # "cal i" instruction (trap indirect thru 020)
sys => 0000000, # cal instruction (trap thru 020)
i => 0020000, # indirect bit i => 0020000, # indirect bit
# memory reference instructions # memory reference instructions
@@ -134,42 +136,7 @@ usage() if ( @ARGV < 1 );
llss => 0660600, # long left shift, signed llss => 0660600, # long left shift, signed
alss => 0660700, # AC left shift, signed alss => 0660700, # AC left shift, signed
# I/OT instructions # PLB: removed I/OT instructions: kernel uses sop.s
iot => 0700000, # base i/o transfer instruction
clsf => 0700001, # skip if RT clock overflow
iof => 0700002, # interrupts off (disable PIC)
ion => 0700042, # interrupts on (enable PIC)
iton => 0700062, # interrupt and trap on
clof => 0700004, # clear clock flag, disable clock
clon => 0700044, # clear clock flag, enable clock
rsf => 0700101, # skip if PTR flag set
rrb => 0700112, # clear PTR flag, OR buffer with AC
rcf => 0700102, # clear PTR flag
rsa => 0700104, # select PTR in alphanumeric mode
rsb => 0700144, # select PTR in binary mode
psf => 0700201, # skip if PTP flag set
pcf => 0700202, # clear PTP flag
psa => 0700204, # punch PTP in alphanumeric mode
psb => 0700244, # punch PTP in binary mode
ksf => 0700301, # skip if KBD flag set
krb => 0700312, # read KBD buffer
iors => 0700314, # input/output read status
tsf => 0700401, # skip if if TTY output flag set
tcf => 0700402, # clear TTY output flag
tls => 0700406, # load TTY output buffer and select
tts => 0703301, # Test Teleprinter and Skip
skp7 => 0703341, # skip if processor is PDP-7!
caf => 0703302, # Clear All Flags
crsf => 0706701, # skip if CDR is ready
crrb => 0706712, # read CDR buffer
crsa => 0706704, # select CDR alphanumeric mode
crsb => 0706744, # select CDR binary mode
# Operate Instructions # Operate Instructions
@@ -207,7 +174,7 @@ usage() if ( @ARGV < 1 );
# Group 2 operate # Group 2 operate
law => 0760000, # load accumulator with (instruction) law => 0760000, # load accumulator with (instruction)
lam => 0777777, # (load accumulator minus) # lam => 0777777, # (load accumulator minus)
); );
# Parse all the files # Parse all the files
@@ -238,9 +205,23 @@ elsif ($format eq 'list') {
printf("%-8.8s %#06o\n", $key, $Label{$key}); printf("%-8.8s %#06o\n", $key, $Label{$key});
} }
} }
elsif ($format eq 'ptr') { # dump absolute memory in PTR binary
for my $loc ( 0 .. $#Mem ) {
my $m = $Mem[$loc] || 0;
printf("%c%c%c", ($m >> 12) & 077, ($m >> 6) & 077, $m & 077);
}
}
else { else {
die("unknown format $format"); die("unknown format $format");
} }
# as.s writes a binary file named n.out, ours is ascii
open (my $NOUT, ">n.out") || die "n.out";
foreach my $key (sort keys %Label) {
printf $NOUT "%-8.8s %#06o\n", $key, $Label{$key};
}
close($NOUT);
exit($errors); exit($errors);
# report an assmebly error: # report an assmebly error:
@@ -253,7 +234,7 @@ sub err {
$errors = 1; # exit status $errors = 1; # exit status
if ($stage == 2) { if ($stage == 2) {
print STDERR "$file:$lineno: $msg\n"; print STDERR "$file:$lineno: $msg\n";
print "$file:$lineno: $msg\n" if (! -t STDOUT); print "$file:$lineno: $msg\n" if (! -t STDOUT && $format ne 'ptr');
} }
return 0; # expression value return 0; # expression value
} }
@@ -274,25 +255,30 @@ sub parse_file {
} }
# process a label and set its value to the location counter # process a label and set its value to the location counter
# only called on pass 1; # OK for symbolic label to be entered twice, so long as it's the same value
# if called on pass 2, should check if values are identical # (ie; both passes)
sub process_label { sub process_label {
my $label = shift; my $label = shift;
my $loc = $Var{'.'};
# It's a relative label, save its current value in a list print "process_label $label\n" if ($debug);
if ( $label =~ m{^\d+$} ) {
push( @{ $Rlabel{$label} }, $Var{'.'} );
printf( "Pushing %#o for relative label %s\n", $Var{'.'}, $label ) if ($debug);
return;
}
# It's a textual label, check if it's been defined before if ( $label =~ m{^\d+$} ) { # numeric (relative) label?
if ( defined( $Label{$label} ) ) { if ($stage == 1) {
err('M', "Label $label defined multiple times\n"); push( @{ $Rlabel{$label} }, $loc );
printf( "Pushing %#o for label %s\n", $loc, $label ) if ($debug);
}
} # numeric label
else { # symbolic label
# error to have different values
if ( defined( $Label{$label} ) && $Label{$label} != $loc ) {
err('M', "Label $label multiply defined");
}
else {
$Label{$label} = $loc;
printf( "Set label %s to %#o\n", $label, $loc ) if ($debug);
}
} }
# Otherwise, save its value
$Label{$label} = $Var{'.'};
printf( "Set label %s to %#o\n", $label, $Label{$label} ) if ($debug);
} }
sub eol { sub eol {
@@ -303,6 +289,7 @@ sub eol {
# parses global $line based on prefixes, nibbling of a bit at a time # parses global $line based on prefixes, nibbling of a bit at a time
# (: and ; can appear in char literals) # (: and ; can appear in char literals)
# handles multiple ';' separated words per line # handles multiple ';' separated words per line
# allows " in character literals (tho none appear in listings)
sub parse_line { sub parse_line {
while (1) { while (1) {
$line_error = ' '; # clear listing error indicator $line_error = ' '; # clear listing error indicator
@@ -315,14 +302,8 @@ sub parse_line {
print "parse_line: '$line'\n" if ($debug); print "parse_line: '$line'\n" if ($debug);
while ($line =~ s{^([a-z0-9\.]+):\s*}{}) { # labels while ($line =~ s{^([a-z0-9\.]+):\s*}{}) { # labels
my $label = $1;
# First pass: parse the labels
# (could check for same value on pass 2)
if ( $stage == 1 ) {
process_label($1); process_label($1);
} }
}
return if (eol()); return if (eol());
@@ -342,7 +323,7 @@ sub parse_line {
$Mem[$location] = $word; $Mem[$location] = $word;
$Mline[$location] = $origline; $Mline[$location] = $origline;
$origline = ''; $origline = '';
if ($format eq 'list') { if ($format eq 'list' and defined($word)) {
printf( "%06o: %06o %s\n", $location, $word, $line_error); printf( "%06o: %06o %s\n", $location, $word, $line_error);
} }
} }
@@ -368,7 +349,7 @@ sub parse_expression {
my $syllable = 0; my $syllable = 0;
my $op = '|'; my $op = '|';
$line =~ s{^\s+}{}; $line =~ s{^\s+}{}; # as.s accepts ",' as whitespace too!
if ($line eq '' || $line =~ m{^[";]}) { # EOL ; and " terminate expr if ($line eq '' || $line =~ m{^[";]}) { # EOL ; and " terminate expr
printf("\tparse_expression => %#o\n", $word) if ($debug); printf("\tparse_expression => %#o\n", $word) if ($debug);
@@ -378,19 +359,24 @@ sub parse_expression {
print " '$line'\n" if ($debug); print " '$line'\n" if ($debug);
if ($line =~ s{^-}{}) { if ($line =~ s{^-}{}) {
print "\tfound -\n" if ($debug);
$op = '-'; $op = '-';
} }
elsif ($line =~ s{^\+}{}) { elsif ($line =~ s{^\+}{}) {
print "\tfound +\n" if ($debug);
$op = '+'; $op = '+';
} }
if ($line =~ s{^<(.)}{}) { # <char if ($line =~ s{^<(.)}{}) { # <char
print "\tfound <x\n" if ($debug);
$syllable = ord($1) << 9; $syllable = ord($1) << 9;
} }
elsif ($line =~ s{^(.)>}{}) { # char> elsif ($line =~ s{^(.)>}{}) { # char>
print "\tfound x>\n" if ($debug);
$syllable = ord($1) $syllable = ord($1)
} }
elsif ($line =~ s{^>(.)}{}) { # >char !! elsif ($line =~ s{^>(.)}{}) { # >char !!
print "\tfound >x\n" if ($debug);
$syllable = ord($1) $syllable = ord($1)
} }
elsif ($line =~ s{^([a-z\.][a-z0-9\.]*)}{}) { elsif ($line =~ s{^([a-z\.][a-z0-9\.]*)}{}) {
@@ -409,10 +395,12 @@ sub parse_expression {
} # pass 2 } # pass 2
} # symbol } # symbol
elsif ( $line =~ s{^(\d+)([fb])}{} ) { # relative label elsif ( $line =~ s{^(\d+)([fb])}{} ) { # relative label
printf "\tfound relative: $1$2\n" if ($debug);
$syllable = find_relative_label( $1, $2 ) if ($stage == 2); $syllable = find_relative_label( $1, $2 ) if ($stage == 2);
} }
elsif ( $line =~ s{^(\d+)}{} ) { elsif ( $line =~ s{^(\d+)}{} ) { # constant
my $value = $1; my $value = $1;
printf "\tfound constant: $value\n" if ($debug);
if ( $value =~ m{^0} ) { if ( $value =~ m{^0} ) {
$syllable = oct($value); $syllable = oct($value);
} }
@@ -432,8 +420,9 @@ sub parse_expression {
# he says, "will usually know what's wrong. # he says, "will usually know what's wrong.
err('?', "huh? '$line'"); err('?', "huh? '$line'");
$line = ''; # abort processing $line = ''; # abort processing
return $word; return undef;
} }
if ($op eq '+') { if ($op eq '+') {
$word += $syllable; $word += $syllable;
} }
@@ -457,7 +446,7 @@ sub find_relative_label {
# Error check: no labels at all # Error check: no labels at all
if ( !defined( $Rlabel{$label} ) ) { if ( !defined( $Rlabel{$label} ) ) {
return err('U', "relative label $label not defined\n"); return err('U', "relative label $label never defined");
} }
# Get the list of possible locations for this label # Get the list of possible locations for this label
@@ -480,5 +469,5 @@ sub find_relative_label {
return ($reflocation) if ( $reflocation < $curlocation ); return ($reflocation) if ( $reflocation < $curlocation );
} }
} }
return err('U', "No relative label $label"); return err('U', "undefined relative reference $label$direction");
} }