From 66909ac6fdafd38f30ce2ced010d1c6ca692a669 Mon Sep 17 00:00:00 2001 From: Phil Budne Date: Tue, 1 Mar 2016 09:30:23 -0500 Subject: [PATCH 1/2] fix bugs noted by warren --- tools/as7 | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/tools/as7 b/tools/as7 index e9ecdda..e561fae 100755 --- a/tools/as7 +++ b/tools/as7 @@ -48,10 +48,12 @@ GetOptions( usage() if ( @ARGV < 1 ); -# predefine syscall and opcodes as variables # start with the location counter at zero +# predefine syscall and opcodes as variables %Var = ( '.' => 0, + '..' => 0, + save => 1, # saves core dump & user area! getuid => 2, open => 3, @@ -293,6 +295,10 @@ sub process_label { printf( "Set label %s to %#o\n", $label, $Label{$label} ) if ($debug); } +sub eol { + return $line eq '' || $line =~ m{^"}; # empty or comment +} + # Blame Phil for this.... # parses global $line based on prefixes, nibbling of a bit at a time # (: and ; can appear in char literals) @@ -301,7 +307,7 @@ sub parse_line { while (1) { $line_error = ' '; # clear listing error indicator - return if ($line eq '' || $line =~ m{^"}); # empty or comment: quit + return if (eol()); # Lose any leading whitespace $line =~ s{^\s*}{}; @@ -318,6 +324,8 @@ sub parse_line { } } + return if (eol()); + if ( $line =~ s{^(\S+)\s*=}{}) { # assignment my $lhs = $1; my $word = parse_expression(); @@ -325,7 +333,7 @@ sub parse_line { $Var{$lhs} = $word; printf("\t%06o %s\n", $word, $line_error) if ($stage == 2 && $format eq 'list'); } - else { # bare expression + else { # bare expression (not assignment) # Get its value on pass two and save to memory # Also save the input line that altered memory my $word = parse_expression(); From ff4d793ca5f7f85f6f874749fdafb82db7e236b9 Mon Sep 17 00:00:00 2001 From: Phil Budne Date: Tue, 1 Mar 2016 11:22:53 -0500 Subject: [PATCH 2/2] 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) --- tools/as7 | 133 +++++++++++++++++++++++++----------------------------- 1 file changed, 61 insertions(+), 72 deletions(-) diff --git a/tools/as7 b/tools/as7 index e561fae..537c2f1 100755 --- a/tools/as7 +++ b/tools/as7 @@ -4,7 +4,7 @@ # and convert them into PDP-7 machine code # # (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 warnings; @@ -31,12 +31,11 @@ my $lineno; # current line number ## command line options my $debug = 0; # Run in debug mode -my $symbols = 0; # dump symbols my $format = 'a7out'; # output format # keep this near the GetOptions call to make it easy to add documentation! 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 ### @@ -52,7 +51,11 @@ usage() if ( @ARGV < 1 ); # predefine syscall and opcodes as variables %Var = ( '.' => 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! getuid => 2, @@ -85,9 +88,8 @@ usage() if ( @ARGV < 1 ); # List of instruction names and machine code values # These come from https://raw.githubusercontent.com/simh/ - # simtools/master/crossassemblers/macro7/macro7.c - # PLB: replace with symbols in "sop.s"? - sys => 0000000, # cal instruction (trap thru 020) + + sys => 0020000, # "cal i" instruction (trap indirect thru 020) i => 0020000, # indirect bit # memory reference instructions @@ -134,42 +136,7 @@ usage() if ( @ARGV < 1 ); llss => 0660600, # long left shift, signed alss => 0660700, # AC left shift, signed - # I/OT instructions - 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 + # PLB: removed I/OT instructions: kernel uses sop.s # Operate Instructions @@ -207,7 +174,7 @@ usage() if ( @ARGV < 1 ); # Group 2 operate law => 0760000, # load accumulator with (instruction) - lam => 0777777, # (load accumulator minus) +# lam => 0777777, # (load accumulator minus) ); # Parse all the files @@ -238,9 +205,23 @@ elsif ($format eq 'list') { 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 { 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); # report an assmebly error: @@ -253,7 +234,7 @@ sub err { $errors = 1; # exit status if ($stage == 2) { 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 } @@ -274,25 +255,30 @@ sub parse_file { } # process a label and set its value to the location counter -# only called on pass 1; -# if called on pass 2, should check if values are identical +# OK for symbolic label to be entered twice, so long as it's the same value +# (ie; both passes) sub process_label { my $label = shift; + my $loc = $Var{'.'}; - # It's a relative label, save its current value in a list - if ( $label =~ m{^\d+$} ) { - push( @{ $Rlabel{$label} }, $Var{'.'} ); - printf( "Pushing %#o for relative label %s\n", $Var{'.'}, $label ) if ($debug); - return; - } + print "process_label $label\n" if ($debug); - # It's a textual label, check if it's been defined before - if ( defined( $Label{$label} ) ) { - err('M', "Label $label defined multiple times\n"); + if ( $label =~ m{^\d+$} ) { # numeric (relative) label? + if ($stage == 1) { + 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 { @@ -303,6 +289,7 @@ sub eol { # parses global $line based on prefixes, nibbling of a bit at a time # (: and ; can appear in char literals) # handles multiple ';' separated words per line +# allows " in character literals (tho none appear in listings) sub parse_line { while (1) { $line_error = ' '; # clear listing error indicator @@ -315,13 +302,7 @@ sub parse_line { print "parse_line: '$line'\n" if ($debug); 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()); @@ -342,7 +323,7 @@ sub parse_line { $Mem[$location] = $word; $Mline[$location] = $origline; $origline = ''; - if ($format eq 'list') { + if ($format eq 'list' and defined($word)) { printf( "%06o: %06o %s\n", $location, $word, $line_error); } } @@ -368,7 +349,7 @@ sub parse_expression { my $syllable = 0; my $op = '|'; - $line =~ s{^\s+}{}; + $line =~ s{^\s+}{}; # as.s accepts ",' as whitespace too! if ($line eq '' || $line =~ m{^[";]}) { # EOL ; and " terminate expr printf("\tparse_expression => %#o\n", $word) if ($debug); @@ -378,19 +359,24 @@ sub parse_expression { print " '$line'\n" if ($debug); if ($line =~ s{^-}{}) { + print "\tfound -\n" if ($debug); $op = '-'; } elsif ($line =~ s{^\+}{}) { + print "\tfound +\n" if ($debug); $op = '+'; } if ($line =~ s{^<(.)}{}) { # }{}) { # char> + print "\tfound x>\n" if ($debug); $syllable = ord($1) } elsif ($line =~ s{^>(.)}{}) { # >char !! + print "\tfound >x\n" if ($debug); $syllable = ord($1) } elsif ($line =~ s{^([a-z\.][a-z0-9\.]*)}{}) { @@ -409,10 +395,12 @@ sub parse_expression { } # pass 2 } # symbol elsif ( $line =~ s{^(\d+)([fb])}{} ) { # relative label + printf "\tfound relative: $1$2\n" if ($debug); $syllable = find_relative_label( $1, $2 ) if ($stage == 2); } - elsif ( $line =~ s{^(\d+)}{} ) { + elsif ( $line =~ s{^(\d+)}{} ) { # constant my $value = $1; + printf "\tfound constant: $value\n" if ($debug); if ( $value =~ m{^0} ) { $syllable = oct($value); } @@ -432,8 +420,9 @@ sub parse_expression { # he says, "will usually know what's wrong. err('?', "huh? '$line'"); $line = ''; # abort processing - return $word; + return undef; } + if ($op eq '+') { $word += $syllable; } @@ -457,7 +446,7 @@ sub find_relative_label { # Error check: no labels at all 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 @@ -480,5 +469,5 @@ sub find_relative_label { return ($reflocation) if ( $reflocation < $curlocation ); } } - return err('U', "No relative label $label"); + return err('U', "undefined relative reference $label$direction"); }