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

OR syllables by default (allows multiple OPR instructions)

Browse Source
This commit is contained in:
Phil Budne
2016-02-29 14:24:37 -05:00
parent 2def710c48
commit 249ce47e44
1 changed files with 66 additions and 59 deletions
Download Patch File Download Diff File Expand all files Collapse all files
tools/as7
+46 -39
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 (expression parsing, "list" format) # Tweaked by Phil Budne (line, expression parsing, "list" format)
# #
use strict; use strict;
use warnings; use warnings;
@@ -25,7 +25,6 @@ my $origline; # The original current input line of code
my $line; # line being parsed my $line; # line being parsed
my $stage = 1; # Pass one or pass two my $stage = 1; # Pass one or pass two
my $errors = 0; # set to non-zero on error my $errors = 0; # set to non-zero on error
my %Undef; # undefined symbols: only complain once
my $line_error = ' '; my $line_error = ' ';
my $file; # current file name my $file; # current file name
my $lineno; # current line number my $lineno; # current line number
@@ -149,7 +148,7 @@ usage() if ( @ARGV < 1 );
rsb => 0700144, # select PTR in binary mode rsb => 0700144, # select PTR in binary mode
psf => 0700201, # skip if PTP flag set psf => 0700201, # skip if PTP flag set
pcf => 0700202, # clear PTP clag pcf => 0700202, # clear PTP flag
psa => 0700204, # punch PTP in alphanumeric mode psa => 0700204, # punch PTP in alphanumeric mode
psb => 0700244, # punch PTP in binary mode psb => 0700244, # punch PTP in binary mode
@@ -157,7 +156,7 @@ usage() if ( @ARGV < 1 );
krb => 0700312, # read KBD buffer krb => 0700312, # read KBD buffer
iors => 0700314, # input/output read status iors => 0700314, # input/output read status
tsf => 0700401, # if if TTY output flag set tsf => 0700401, # skip if if TTY output flag set
tcf => 0700402, # clear TTY output flag tcf => 0700402, # clear TTY output flag
tls => 0700406, # load TTY output buffer and select tls => 0700406, # load TTY output buffer and select
@@ -272,8 +271,9 @@ sub parse_file {
close($IN); close($IN);
} }
# process a label and set its value to the location counter (only called on pass 1) # process a label and set its value to the location counter
# (if called on pass 2, should check if values are identical) # only called on pass 1;
# if called on pass 2, should check if values are identical
sub process_label { sub process_label {
my $label = shift; my $label = shift;
@@ -294,25 +294,21 @@ sub process_label {
} }
# Blame Phil for this.... # Blame Phil for this....
# parses global $line based on prefixes # parses global $line based on prefixes, nibbling of a bit at a time
# (nibbling of a bit at a time) # (: and ; can appear in char literals)
# handles multiple ';' separated words per line # handles multiple ';' separated words per line
sub parse_line { sub parse_line {
$line_error = ' ';
while (1) {
# Lose any leading whitespace # Lose any leading whitespace
$line =~ s{^\s*}{}; $line =~ s{^\s*}{};
while (1) {
$line_error = ' '; # clear listing error indicator
return if ($line eq '' || $line =~ m{^"}); # empty or comment: quit
print "parse_line: '$line'\n" if ($debug); print "parse_line: '$line'\n" if ($debug);
return if ($line eq ''); while ($line =~ s{^([a-z0-9\.]+):\s*}{}) { # labels
if ($line =~ m{^"}) { # remainder of line is comment
return;
}
if ($line =~ s{^([a-z0-9\.]+):}{}) { # label
my $label = $1; my $label = $1;
# First pass: parse the labels # First pass: parse the labels
@@ -321,13 +317,10 @@ sub parse_line {
process_label($1); process_label($1);
} }
} }
else {
my $lhs = undef;
if ( $line =~ s{^(\S+)\s*=}{}) { # assignment if ( $line =~ s{^(\S+)\s*=}{}) { # assignment
$lhs = $1; my $lhs = $1;
}
my $word = parse_expression(); my $word = parse_expression();
if ($lhs) {
printf( "Setting variable %s to 0%o\n", $lhs, $word ) if ($debug); printf( "Setting variable %s to 0%o\n", $lhs, $word ) if ($debug);
$Var{$lhs} = $word; $Var{$lhs} = $word;
printf("\t%06o %s\n", $word, $line_error) if ($stage == 2 && $format eq 'list'); printf("\t%06o %s\n", $word, $line_error) if ($stage == 2 && $format eq 'list');
@@ -335,6 +328,7 @@ sub parse_line {
else { # bare expression else { # bare expression
# Get its value on pass two and save to memory # Get its value on pass two and save to memory
# Also save the input line that altered memory # Also save the input line that altered memory
my $word = parse_expression();
if ( $stage == 2 ) { if ( $stage == 2 ) {
my $location = $Var{'.'}; my $location = $Var{'.'};
$Mem[$location] = $word; $Mem[$location] = $word;
@@ -347,18 +341,16 @@ sub parse_line {
# Move up to the next location in both passes # Move up to the next location in both passes
$Var{'.'}++; $Var{'.'}++;
} # expr } # expr
} # assignment or expression
# eat trailing whitespace and ";", if any # eat trailing whitespace and ";", if any
$line =~ s{^\s*}{}; $line =~ s{^\s*;?}{};
$line =~ s{^;}{};
} # while } # while
} }
# Blame Phil for this bit too... # Blame Phil for this bit too...
# Parse an expression off $line and return a PDP-7 word # Parse an expression off $line and return a PDP-7 word
# as a series of whitespace separated "syllables" # as a series of whitespace separated "syllables"
# and adds them together. # ORed, added, or subtracted
sub parse_expression { sub parse_expression {
my $word = 0; my $word = 0;
@@ -366,23 +358,22 @@ sub parse_expression {
while (1) { while (1) {
my $syllable = 0; my $syllable = 0;
my $sign = 1; my $op = '|';
$line =~ s{^\s+}{}; $line =~ s{^\s+}{};
print " '$line'\n" if ($debug);
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);
return $word; return $word;
} }
print " '$line'\n" if ($debug);
if ($line =~ s{^-}{}) { if ($line =~ s{^-}{}) {
# leading '-' negates upcomming syllable. $op = '-';
$sign = -$sign;
} }
else { elsif ($line =~ s{^\+}{}) {
# ignore leading '+' $op = '+';
$line =~ s{^\+}{};
} }
if ($line =~ s{^<(.)}{}) { # <char if ($line =~ s{^<(.)}{}) { # <char
@@ -406,8 +397,7 @@ sub parse_expression {
printf("\tlbl: %s: %#o\n", $sym, $syllable) if ($debug); printf("\tlbl: %s: %#o\n", $sym, $syllable) if ($debug);
} }
elsif ($stage == 2) { elsif ($stage == 2) {
err('U', "$sym not defined") unless (defined $Undef{$sym}); err('U', "$sym not defined")
$Undef{$sym} = 1; # only complain once
} # pass 2 } # pass 2
} # symbol } # symbol
elsif ( $line =~ s{^(\d+)([fb])}{} ) { # relative label elsif ( $line =~ s{^(\d+)([fb])}{} ) { # relative label
@@ -421,14 +411,31 @@ sub parse_expression {
else { else {
$syllable = $value + 0; $syllable = $value + 0;
} }
$syllable &= 0777777;
} }
else { else {
# From the BSD fortune file:
# Ken Thompson has an automobile which he helped design.
# Unlike most automobiles, it has neither speedometer,
# nor gas gauge, nor any of the numerous idiot lights
# which plague the modern driver. Rather, if the driver
# makes any mistake, a giant "?" lights up in the center
# of the dashboard. "The experienced driver",
# he says, "will usually know what's wrong.
err('?', "huh? '$line'"); err('?', "huh? '$line'");
$line = ''; $line = ''; # abort processing
return $word; return $word;
} }
$syllable = ($syllable * $sign) & 0777777; if ($op eq '+') {
$word = ($word + $syllable) & 0777777; $word += $syllable;
}
elsif ($op eq '-') {
$word -= $syllable;
}
else {
$word |= $syllable;
}
$word &= 0777777;
printf("\tsyllable: %#o word: %#o\n", $syllable, $word) if ($debug); printf("\tsyllable: %#o word: %#o\n", $syllable, $word) if ($debug);
} }
} }