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:
@@ -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,13 +302,7 @@ 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;
|
process_label($1);
|
||||||
|
|
||||||
# First pass: parse the labels
|
|
||||||
# (could check for same value on pass 2)
|
|
||||||
if ( $stage == 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");
|
||||||
}
|
}
|
||||||
|
|||||||
Reference in New Issue
Block a user