From: Nick Downing Date: Sun, 31 Dec 2023 00:47:53 +0000 (+1100) Subject: Initial commit, can compile and execute hello.b X-Git-Url: https://git.ndcode.org/public/gitweb.cgi?a=commitdiff_plain;h=f466f8490e3636ae1c9083b506fd37cc7cc2de9b;p=b_18bit.git Initial commit, can compile and execute hello.b --- f466f8490e3636ae1c9083b506fd37cc7cc2de9b diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..8061a12 --- /dev/null +++ b/.gitignore @@ -0,0 +1,5 @@ +*.o +/a.out +/b +/bi +/hello.s diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..73603a0 --- /dev/null +++ b/Makefile @@ -0,0 +1,14 @@ +CFLAGS=-g -Wall + +all: b bi + +b.o: b.c +b: b.o + ${CC} -o $@ $< + +bi.o: bi.c +bi: bi.o + ${CC} -o $@ $< + +clean: + rm -f b bi *.o diff --git a/as7 b/as7 new file mode 100755 index 0000000..571ef47 --- /dev/null +++ b/as7 @@ -0,0 +1,631 @@ +#!/usr/bin/env perl +# +# Read in files of PDP-7 assembly code in Ken Thompson's as format +# and convert them into PDP-7 machine code +# +# (c) 2016 Warren Toomey, GPL3 +# Tweaked by Phil Budne (line, expression parsing, output formats) +# +use strict; +use warnings; +use Data::Dumper; +use Getopt::Long qw(GetOptions); + +Getopt::Long::Configure qw(gnu_getopt); + +### Global variables ### +my %Var; # Variables such as ., .., t +my %Glabel; # Global labels that are defined once +my %Llabel; # Local labels that are defined once +my %Islocal; # True if the label is a local label +my %Rlabel; # Relative labels, e.g. 1:, 2: + # with an array of locations for each label + +my @Mem; # Actual PDP-7 memory locations +my @Mline; # Source lines associated with mem locations +my $origline; # The original current input line of code +my $line; # line being parsed +my $stage = 1; # Pass one or pass two +my $errors = 0; # set to non-zero on error +my $line_error = ' '; +my $file; # current file name +my $lineno; # current line number +my $OUTPUT; # output file +my $RELATIVE = 01000000; # set on non-absolute symbol values +my $BASE = 0|$RELATIVE; # starting value for "." +### Main program ### + +## command line options +my $debug = 0; # Run in debug mode +my $format = 'a7out'; # output format +my $namelist = 0; # output n.out file +my $output = 'a.out'; # output file +my $no_label_warnings = 0; # suppress multiply defined label warnings + +# keep this near the GetOptions call to make it easy to add documentation! +sub usage { + die("Usage: $0 [--debug] [--format=a7out|list|ptr|rim ]\n" . + "\t[-n] [--out file] file1.s [file2.s ...]\n"); +} + +GetOptions( + 'debug|d' => \$debug, + 'format|f=s' => \$format, + 'namelist|n' => \$namelist, + 'output|o=s' => \$output, + 'no-label-warnings' => \$no_label_warnings, +) or usage(); + +usage() if ( @ARGV < 1 ); + +# http://minnie.tuhs.org/cgi-bin/utree.pl?file=V3/man/manx/as.1 +# ".." is the relocation constant and is added to each relocatable +# reference. On a PDP-11 with relocation hardware, its value is 0; on +# most systems without protection, its value is 40000(8). + +# PLB: "relocatable" values are flagged with $RELATIVE + +# start with the location counter at zero +# predefine syscall and opcodes as variables +%Var = ( + '.' => $BASE, + '..' => 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, + open => 3, + read => 4, + write => 5, + creat => 6, + seek => 7, + tell => 8, + close => 9, + link => 10, + unlink => 11, + setuid => 12, + rename => 13, + exit => 14, + time => 15, + intrp => 16, + chdir => 17, + chmod => 18, + chown => 19, + # 20 removed + sysloc => 21, # return system addresses + # 22 removed + capt => 23, # capture display? + rele => 24, # release display? + status => 25, # "stat" + smes => 27, + rmes => 28, + fork => 29, + + # List of instruction names and machine code values + # These come from https://raw.githubusercontent.com/simh/ + + sys => 0020000, # "cal i" instruction (trap indirect thru 020) + i => 0020000, # indirect bit + + # memory reference instructions + dac => 0040000, # deposit AC + jms => 0100000, # jump to subroutine + dzm => 0140000, # deposit zero in memory + lac => 0200000, # load AC + xor => 0240000, # exclusive or + add => 0300000, # one's complement add + tad => 0340000, # two's complement add + xct => 0400000, # execute + isz => 0440000, # increment and skip if zero + and => 0500000, # AND with contents of Y + sad => 0540000, # skip if AC different from content of Y + jmp => 0600000, # jump to Y + + # Type 177 Extended Arithmetic Element (EAE) + eae => 0640000, # base instruction (nop) + osc => 0640001, # OR SC into AC + omq => 0640002, # OR MQ into AC + cmq => 0640004, # Complement MQ + div => 0640323, # divide + norm => 0640444, # normalize, unsigned + lls => 0640600, # long left shift + clls => 0641600, # lls but clear AC first + als => 0640700, # AC shift + lrs => 0640500, # long right shift + ecla => 0641000, # clear AC + lacs => 0641001, # load AC with SC + lacq => 0641002, # load AC with MQ + abs => 0644000, # absolute value + divs => 0644323, # divide, signed + + clq => 0650000, # clear MQ + frdiv => 0650323, # fractional divide + lmq => 0652000, # load MQ from AC + mul => 0653122, # multiply + idiv => 0653323, # integer divide + idivs => 0657323, # integer divide, signed + frdivs => 0654323, # fractional divide, signed + muls => 0657122, # multiply, signed + + norms => 0660444, # normalize, signed + gsm => 0664000, # get sign and magnitude + lrss => 0660500, # long right shift, signed + llss => 0660600, # long left shift, signed + alss => 0660700, # AC left shift, signed + + # PLB: removed I/OT instructions: kernel uses sop.s + + # Operate Instructions + + # Group 1 (OPR 1) instructions + opr => 0740000, # base operate instruction (nop) + nop => 0740000, + cma => 0740001, # complement accumulator + cml => 0740002, # complement link + oas => 0740004, # inclusive or accumulator switches + ral => 0740010, # rotate (ac, link) left + rar => 0740020, # rotate (ac, link) right + hlt => 0740040, # HALT + xx => 0740040, + sma => 0740100, # skip on minus accumulator + sza => 0740200, # skip on zero accumulator + snl => 0740400, # skip on non-zero link + + skp => 0741000, # unconditional skip + spa => 0741100, # skip on positive accumulator + sna => 0741200, # skip on negative accumulator + szl => 0741400, # skip on zero link + + rtl => 0742010, # rotate two left (ral*2) + rtr => 0742020, # rotate two right (rar*2) + + cll => 0744000, # clear link + stl => 0744002, # set link + rcl => 0744010, # clear link, rotate left + rcr => 0744020, # clear link, rotate right + + cla => 0750000, # clear accumulator + clc => 0750001, # clear and complement acc + las => 0750004, # load acc from switches + glk => 0750010, # get link + + # Group 2 operate + law => 0760000, # load accumulator with (instruction) +# lam => 0777777, # (load accumulator minus) +); + + +# Parse all the files +print STDERR "I\n"; # like the real as +foreach my $file (@ARGV) { + parse_file($file); +} + +# Now do it all again, pass two +$Var{'.'} = $BASE; +$stage = 2; +open(my $OUT, ">$output") || die "$output"; + +print STDERR "II\n"; # like the real as +foreach my $file (@ARGV) { + print STDERR "$file\n"; # like the real as + parse_file($file); +} + +if ($format eq 'a7out') { + # print out the contents of memory + for my $i ( 0 .. $#Mem ) { + if ( defined( $Mem[$i] ) ) { + printf $OUT "%06o: %06o\t%s\n", $i, $Mem[$i], ($Mline[$i] || ""); + } + } +} +elsif ($format eq 'list') { + print $OUT "\n"; + print $OUT "Labels:\n"; + dump_labels($OUT); +} +elsif ($format eq 'ptr') { # dump absolute memory in PTR binary + for my $loc ( $Var{'..'} .. $#Mem ) { + punch($Mem[$loc] || 0); + } +} +elsif ($format eq 'rim') { # "Hardware Read In" tape + # only handles continguous memory, but no overhead + my $base = $Var{'..'}; + for my $loc ( $base .. $#Mem ) { + punch($Mem[$loc] || 0); + } + # final word: command; has 0100 lit on last frame + punch(0600000 | $base, 0100 ); +} +else { + die("unknown format $format"); +} +close($OUT); + +if ($namelist) { + # as.s writes a binary file named n.out, ours is ascii + open (my $NOUT, ">", "n.out") || die "n.out"; + dump_labels($NOUT); + close($NOUT); +} + +exit($errors); + +# report an assmebly error: +# sets error flag +# reports filename:lineno for emacs m-x compile +sub err { + $line_error = shift; + my $msg = shift; + + $errors = 1; # exit status + if ($stage == 2) { + print STDERR "$file:$lineno: $msg\n"; + print $OUT "$file:$lineno: $msg\n" if ($format eq 'list'); + } + return 0; # expression value +} + +# Set a label, either global or local +sub set_label +{ + my ($label,$loc)= @_; + + # PLB: truncate to eight: moo.s declares "standing" + # but references it as "standings" + $label = substr($label, 0, 8); + + # It is a local label if we're told it is, or if it starts with "L" + if ($Islocal{$file}{$label} || $label=~ m{^L}) { + # An error to have different values + if ( defined( $Llabel{$file}{$label} ) && $Llabel{$file}{$label} != $loc ) { + # non-fatal: as.s doesn't even warn!!!! + print STDERR "$file:$lineno: Local label $label multiply defined\n" + if ($stage == 2 && !$no_label_warnings); + } + else { + $Llabel{$file}{$label} = $loc; + printf( "Set local label %s to %#o\n", $label, $loc ) if ($debug); + } + } else { + # original as doesn't complain about multiple definitions of labels + # (Space Travel depends on this). Now a warning (on by default) + if ( defined( $Glabel{$label} ) && $Glabel{$label} != $loc ) { + print STDERR "$file:$lineno: Warning: Global label $label multiply defined\n" + if ($stage == 2 && !$no_label_warnings); + } + $Glabel{$label} = $loc; + printf( "Set global label %s to %#o\n", $label, $loc ) if ($debug); + } +} + +# Get the value of a global or local label +sub get_label +{ + my $label= shift; + # PLB: truncate to eight: moo.s declares "standing" + # but references it as "standings" + $label = substr($label, 0, 8); + return($Llabel{$file}{$label}) if (defined($Llabel{$file}{$label})); + return($Glabel{$label}); +} + +# Open and parse the given file +sub parse_file { + $file = shift; + + open( my $IN, "<", $file ) || die("Cannot open $file: $!\n"); + $lineno = 0; + while ( $line = <$IN> ) { + $lineno++; + chomp($line); # Lose the end of line + $origline = $line; + print $OUT "\t\t$line\n" + if ($stage == 2 && $line ne '' && $format eq 'list'); + parse_line(); + } + close($IN); +} + +# process a label and set its value to the location counter +# 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{'.'}; + + print "process_label $label\n" if ($debug); + + 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 + set_label($label, $loc); + } +} + +# Parse assembler directives. These were not in the original +# PDP-7 Unix source, but we need them so that we can write +# compilers that target this assembler. +sub parse_directive +{ + my $directive= shift; + print("Got directive $directive\n") if ($debug); + + # Set this as a local label + if ($directive=~ m{^\@local\s+(\S+)}) { + $Islocal{$file}{$1}=1; + } +} + +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) +# 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 + + return if (eol()); + + print "parse_line: '$line'\n" if ($debug); + + # Lose any leading whitespace + $line =~ s{^\s*}{}; + + # Assembler directives start with an @ + if ($line =~ m{^\@}) { + parse_directive($line); + return; + } + + while ($line =~ s{^([A-Za-z0-9_\.]+):\s*}{}) { # labels + process_label($1); + } + + return if (eol()); + + if ( $line =~ s{^([^;= \t]+)\s*=}{}) { # assignment + my $lhs = $1; + my $word = parse_expression(); + printf( "Setting variable %s to 0%o\n", $lhs, $word ) if ($debug); + $Var{$lhs} = $word; + printf $OUT "\t%06o %s\n", $word, $line_error + if ($stage == 2 && $format eq 'list'); + } + 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(); + if ( $stage == 2 ) { + my $location = $Var{'.'}; + if ($location & $RELATIVE) { # non-absolute location? + $location &= 0777777; + $location += $Var{'..'} & 0777777; # relocate + # XXX check for overflow? + } + if ($word & $RELATIVE) { # word created from relative addresses? + $word &= 0777777; + $word += $Var{'..'} & 0777777; # relocate + # XXX check for overflow? + } + if ($location < 0) { + err('.', 'below base'); + } + else { + $Mem[$location] = $word; + } + $Mline[$location] = $origline; + $origline = ''; + if ($format eq 'list' and defined($word)) { + # show flags?? + printf $OUT "%06o: %06o %s\n", + $location, $word, $line_error; + } + } + # Move up to the next location in both passes + $Var{'.'}++; + } # expr + + # eat trailing whitespace and ";", if any + $line =~ s{^\s*;?}{}; + } # while +} + +# Blame Phil for this bit too... +# Parse an expression off $line and return a PDP-7 word +# as a series of whitespace separated "syllables" +# ORed, added, or subtracted +sub parse_expression { + my $word = 0; + my $flags = 0; + + print "expression: '$line'\n" if ($debug); + + while (1) { + my $syllable = 0; + my $op = '|'; + + $line =~ s{^\s+}{}; # as.s accepts ",' as whitespace too! + + if ($line eq '' || $line =~ m{^[";]}) { # EOL ; and " terminate expr + $word |= $flags; + printf("\tparse_expression => %#o\n", $word) if ($debug); + return $word; + } + + 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) # absolute + } + elsif ($line =~ s{^>(.)}{}) { # >char !! + print "\tfound >x\n" if ($debug); + $syllable = ord($1) # absolute + } + elsif ($line =~ s{^([A-Za-z_\.][A-Za-z0-9_\.]*)}{}) { + my $sym = $1; + print "\tsym: $sym\n" if ($debug); + + if (defined($Var{$sym})) { + $syllable = $Var{$sym}; + printf("\tvar: %s: %#o\n", $sym, $syllable) if ($debug); + } + elsif (defined(get_label($sym))) { + $syllable = get_label($sym); + printf("\tlbl: %s: %#o\n", $sym, $syllable) if ($debug); + } + elsif ($stage == 2) { + err('U', "$sym not defined") + } # 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+)}{} ) { # constant + my $value = $1; + printf "\tfound constant: $value\n" if ($debug); + if ( $value =~ m{^0} ) { + # PLB 2020-10-05: behave like as.s + $syllable = 0; + for my $digit (split(//, $value)) { + $syllable = $syllable * 010 + ord($digit) - ord('0'); + } + } + else { + $syllable = $value + 0; + } + $syllable &= 0777777; # absolute + } + 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'"); + $line = ''; # abort processing + return undef; + } + + my $sylflags = $syllable & $RELATIVE; + $syllable &= 0777777; + + if ($op eq '+') { + $word += $syllable; + $flags |= $sylflags; + } + elsif ($op eq '-') { + $word -= $syllable; + if ($flags & $RELATIVE) { + # relative-relative => absolute! + if ($sylflags & $RELATIVE) { + $flags &= ~$RELATIVE; + } + # else: relative-abs => relative (no change) + } + else { # word is absolute + if ($sylflags & $RELATIVE) { + err('A', 'absolute value minus relative??'); + } + # else: absolute-absolute => absolute (no change) + } + } + else { + $word |= $syllable; + $flags |= $sylflags; + } + $word &= 0777777; + printf("\tsyllable: %#o word: %#o\n", $syllable, $word) if ($debug); + } +} + +# Given a relative label number and a direction, +# return the location of this relative label or +# die if we don't have one +sub find_relative_label { + my ( $label, $direction ) = @_; + my $curlocation = $Var{'.'}; + + # Error check: no labels at all + if ( !defined( $Rlabel{$label} ) ) { + return err('U', "relative label $label never defined"); + } + + # Get the list of possible locations for this label + my $locarray = $Rlabel{$label}; + + # Error check: no locations + return err('U', "No relative labels") if ( @{$locarray} == 0 ); + + if ( $direction eq 'f' ) { + # Search forward for first location larger then the current one + foreach my $reflocation ( @{$locarray} ) { + printf("forward %#o %#o\n", $reflocation, $curlocation) if ($debug); + return ($reflocation) if ( $reflocation > $curlocation ); + } + } + else { + # Search backwards for first location smaller than the current one + foreach my $reflocation ( sort( { $b <=> $a } @{$locarray} ) ) { + printf("backward %#o %#o\n", $reflocation, $curlocation) if ($debug); + return ($reflocation) if ( $reflocation < $curlocation ); + } + } + return err('U', "undefined relative reference $label$direction"); +} + +sub punch { # output a word in paper tape binary format + my $word = shift; + my $final = shift || 0; + + printf $OUT "%c%c%c", + (($word >> 12) & 077) | 0200, + (($word >> 6) & 077) | 0200, + ($word & 077) | 0200 | $final; +} + +sub dump_labels { # for 'list' and --namelist + my $file = shift; + + foreach my $key (sort keys %Glabel) { + my $addr = $Glabel{$key}; + my $flags = ($addr & $RELATIVE) ? "r" : ""; + if ($addr & $RELATIVE) { + $addr &= 0777777; + $addr += $Var{'..'}; + } + printf $file "%-8.8s %#06o %s\n", $key, $addr & 0777777, $flags; + } +} diff --git a/b.c b/b.c new file mode 100644 index 0000000..899f132 --- /dev/null +++ b/b.c @@ -0,0 +1,1028 @@ +/* b.c - B compiler for PDP-7 Unix + + Implemented in a subset of the C language compatible with B. + Coding style and organization based on lastc1120c.c + + (C) 2016 Robert Swierczek, GPL3 + + To compile hello.b: + gcc -Wno-multichar b.c -o b + ./b hello.b hello.s + perl as7 --out a.out bl.s hello.s bi.s + perl a7out a.out +*/ + +#ifdef _WIN32 +#include +#else +#include +#endif +#include +#include +#include +#include + +/* runtime */ +int fin; +int fout = 1; + +void pexpr(); +void error(int code); +void stmt(); +void blkend(); +void stmtlist(); +void getcc(); +void extdef(); + +xread() { + char buf[1]; + if (read(fin, buf, 1) <= 0) + return 4; + return buf[0]; +} + +xwrite(c) { + char buf[2]; + if (c & 0xff00) { + buf[0] = (c >> 8) & 0xff; + buf[1] = c & 0xff; + write(fout, buf, 2); + } else { + buf[0] = c & 0xff; + write(fout, buf, 1); + } +} + +xflush() { +} + +// Nick +wrstr(char *str) { + write(fout, str, strlen(str)); +} +#define eof xeof +#define read xread +#define write xwrite +#define flush xflush + +main(int argc, char **argv) { + extern symtab[], eof, *ns, nerror; + extern fin, fout; + + if (argc > 1) { + if (argc > 2) { + if ((fout = creat(argv[2], 0666))<0) { // Nick 0777 + error('fo'); + return(1); + } + } + if ((fin = open(argv[1],0))<0) { + error('fi'); + return(1); + } + } + + while (!eof) { + ns = symtab + 51; + extdef(); + blkend(); + } + return(nerror!=0); +} + +int *lookup() { + extern symtab[], symbuf[], eof, *ns; + auto *np, *sp, *rp; + + rp = symtab; + while (rp < ns) { + np = rp + 2; + sp = symbuf; + while (*np==*sp) { + if (!*np) + return(rp); + np = np+1; + sp = sp+1; + } + while (*np) + np = np+1; + rp = np+1; + } + sp = symbuf; + if (ns >= symtab + 290) { + error('sf'); + eof = 1; + return(rp); + } + *ns = 0; + ns[1] = 0; + ns = ns+2; + while (*ns = *sp) { + ns = ns+1; + sp = sp+1; + } + ns = ns+1; + return(rp); +} + +symbol() { + extern symbuf[], ctab[], peeksym, peekc, eof, line, *csym, cval; + auto b, c, ct, *sp; + + if (peeksym>=0) { + c = peeksym; + peeksym = -1; + return(c); + } + if (peekc) { + c = peekc; + peekc = 0; + } else { + if (eof) + return(0); + c = read(); + } +loop: + ct = ctab[c]; + + if (ct==0) { /* eof */ + eof = 1; + return(0); + } + + if (ct==126) { /* white space */ + if (c=='\n') + line = line+1; + c = read(); + goto loop; + } + + if (c=='=') + return(subseq('=',80,60)); + + if (c=='<') + return(subseq('=',63,62)); + + if (c=='>') + return(subseq('=',65,64)); + + if (c=='!') + return(subseq('=',34,61)); + + if (c=='$') { + if (subseq('(',0,1)) + return(2); + if (subseq(')',0,1)) + return(3); + } + if (c=='/') { + if (subseq('*',1,0)) + return(43); +com: + c = read(); +com1: + if (c==4) { + eof = 1; + error('*/'); /* eof */ + return(0); + } + if (c=='\n') + line = line+1; + if (c!='*') + goto com; + c = read(); + if (c!='/') + goto com1; + c = read(); + goto loop; + } + if (ct==124) { /* number */ + cval = 0; + if (c=='0') + b = 8; + else + b = 10; + while(c >= '0' & c <= '9') { + cval = cval*b + c -'0'; + c = read(); + } + peekc = c; + return(21); + } + if (c=='\'') { /* ' */ + getcc(); + return(21); + } + if (ct==123) { /* letter */ + sp = symbuf; + while(ct==123 | ct==124) { + if (sp= 0) + error('cc'); +} + +getstr() { + auto i, c, d; + + i = 1; +loop: + if ((c = mapch('"')) < 0) { + number(2048); + write('\n'); + return(i); + } + if ((d = mapch('"')) < 0) { + number(c*512+4); + write('\n'); + return(i); + } + number(c*512+d); + write('\n'); + i = i+1; + goto loop; +} + +mapch(c) { + extern peekc; + auto a; + + if ((a=read())==c) + return(-1); + + if (a=='\n' | a==0 | a==4) { + error('cc'); + peekc = a; + return(-1); + } + + if (a=='*') { + a=read(); + + if (a=='0') + return(0); + + if (a=='e') + return(4); + + if (a=='(') + return('{'); + + if (a==')') + return('}'); + + if (a=='t') + return('\t'); + + if (a=='r') + return('\r'); + + if (a=='n') + return('\n'); + } + return(a); +} + +void expr(lev) { + extern peeksym, *csym, cval, isn; + auto o; + + o = symbol(); + + if (o==21) { /* number */ +case21: + if ((cval & 017777)==cval) { + gen('c',cval); /* consop */ + goto loop; + } + gen('n',5); /* litrl */ + number(cval); + write('\n'); + goto loop; + } + + if (o==122) { /* string */ +#if 1 // Nick + wrstr("x .+2 \" ext\n"); + wrstr("t 2f \" tra\n"); +#else + write('x '); + write('.+'); + write('2\n'); + write('t '); + write('2f'); + write('\n'); +#endif + write('.+'); + write('1\n'); + getstr(); + write('2:'); + write('\n'); + goto loop; + } + + if (o==20) { /* name */ + if (*csym==0) { /* not seen */ + if ((peeksym=symbol())==6) { /* ( */ + *csym = 6; /* extrn */ + } else { + *csym = 2; /* internal */ + csym[1] = isn; + isn = isn+1; + } + } + if (*csym==5) /* auto */ + gen('a',csym[1]); + else { + write('x '); + if (*csym==6) { /* extrn */ + write('.'); + name(csym+2); + } else { /* internal */ + write('1f'); + write('+'); + number(csym[1]); + } +#if 1 // Nick + wrstr(" \" ext\n"); +#else + write('\n'); +#endif + } + goto loop; + } + + if (o==34) { /* ! */ + expr(1); + gen('u',4); /* unot */ + goto loop; + } + + if (o==41) { /* - */ + peeksym = symbol(); + if (peeksym==21) { /* number */ + peeksym = -1; + cval = -cval; + goto case21; + } + expr(1); + gen('u',2); /* umin */ + goto loop; + } + + if (o==47) { /* & */ + expr(1); + gen('u',1); /* uadr */ + goto loop; + } + + if (o==42) { /* * */ + expr(1); + gen('u',3); /* uind */ + goto loop; + } + + if (o==6) { /* ( */ + peeksym = o; + pexpr(); + goto loop; + } + error('ex'); + +loop: + o = symbol(); + + if (lev>=14 & o==80) { /* = */ + expr(14); + gen('b',1); /* asg */ + goto loop; + } + if (lev>=10 & o==48) { /* | ^ */ + expr(9); + gen('b',2); /* bor */ + goto loop; + } + if (lev>=8 & o==47) { /* & */ + expr(7); + gen('b',3); /* band */ + goto loop; + } + if (lev>=7 & o>=60 & o<=61) { /* == != */ + expr(6); + gen('b',o-56); /* beq bne */ + goto loop; + } + if (lev>=6 & o>=62 & o<=65) { /* <= < >= > */ + expr(5); + gen('b',o-56); /* ble blt bge bgt */ + goto loop; + } + if (lev>=4 & o>=40 & o<=41) { /* + - */ + expr(3); + gen('b',o-28); /* badd bmin */ + goto loop; + } + if (lev>=3 & o>=42 & o<=43) { /* * / */ + expr(2); + gen('b',o-27); /* bmul bdiv */ + goto loop; + } + if (lev>=3 & o==44) { /* % */ + expr(2); + gen('b',14); /* bmod */ + goto loop; + } + if (o==4) { /* [ */ + expr(15); + if (symbol() != 5) + error('[]'); + gen('n',4); /* vector */ + goto loop; + } + if (o==6) { /* ( */ + o = symbol(); + if (o==7) /* ) */ + gen('n',1); /* mcall */ + else { + gen('n',2); /* mark */ + peeksym = o; + while (o!=7) { + expr(15); + o = symbol(); + if (o!=7 & o!=9) { /* ) , */ + error('ex'); + return; + } + } + gen('n',3); /* call */ + } + goto loop; + } + + peeksym = o; +} + +void pexpr() { + if (symbol()==6) { /* ( */ + expr(15); + if (symbol()==7) /* ) */ + return; + } + error('()'); +} + +void declare(kw) { + extern *csym, cval, nauto; + auto o; + + while((o=symbol())==20) { /* name */ + if (kw==6) { /* extrn */ + *csym = 6; + o = symbol(); + } else { /* auto/param */ + *csym = 5; /* auto */ + csym[1] = nauto; + o = symbol(); + if (kw==5 & o==21) { /* auto & number */ + gen('y',nauto); /* aryop */ + nauto = nauto + cval; + o = symbol(); + } + nauto = nauto+1; + } + if (o!=9) /* , */ + goto done; + } +done: + if (o==1 & kw!=8 | o==7 & kw==8) /* auto/extrn ; param ')' */ + return; +syntax: + error('[]'); /* declaration syntax */ +} + +void extdef() { + extern peeksym, *csym, cval, nauto; + auto o, c; + + o = symbol(); + if (o==0 | o==1) /* eof ; */ + return; + + if (o!=20) /* name */ + goto syntax; + + csym[0] = 6; /* extrn */ + write('.'); + name(csym + 2); + write(':'); + o=symbol(); + + if (o==2 | o==6) { /* $( ( */ + write('.+'); + write('1\n'); + nauto = 2; + if (o==6) { /* ( */ + declare(8); /* param */ + if ((o=symbol())!=2) /* $( */ + goto syntax; + } + while((o=symbol())==19 & cval<10) /* auto extrn */ + declare(cval); + peeksym = o; + gen('s',nauto); /* setop */ + stmtlist(); + gen('n',7); /* retrn */ + return; + } + + if (o==41) { /* - */ + if (symbol()!=21) /* number */ + goto syntax; + number(-cval); + write('\n'); + return; + } + + if (o==21) { /* number */ + number(cval); + write('\n'); + return; + } + + if (o==1) { /* ; */ + write('0\n'); + return; + } + + if (o==4) { /* [ */ + c = 0; + if ((o=symbol())==21) { /* number */ + c = cval; + o = symbol(); + } + if (o!=5) /* ] */ + goto syntax; + write('.+'); + write('1\n'); + if ((o=symbol())==1) /* ; */ + goto done; + while (o==21 | o==41) { /* number - */ + if (o==41) { /* - */ + if (symbol()!=21) + goto syntax; + cval = -cval; + } + number(cval); + write('\n'); + c = c-1; + if ((o=symbol())==1) /* ; */ + goto done; + if (o!=9) /* , */ + goto syntax; + else + o = symbol(); + } + goto syntax; +done: + if (c>0) { + write('.='); + write('.+'); + number(c); + write('\n'); + } + return; + } + + if (o==0) /* eof */ + return; + +syntax: + error('xx'); + stmt(); +} + +void stmtlist() { + extern peeksym, eof; + auto o; + + while (!eof) { + if ((o = symbol())==3) /* $) */ + return; + peeksym = o; + stmt(); + } + error('$)'); /* missing $) */ +} + +void stmt() { + extern peeksym, peekc, *csym, cval, isn, nauto; + auto o, o1, o2; + +next: + o = symbol(); + + if (o==0) { /* eof */ + error('fe'); /* Unexpected eof */ + return; + } + + if (o==1 | o==3) /* ; $) */ + return; + + if (o==2) { /* $( */ + stmtlist(); + return; + } + + if (o==19) { /* keyword */ + + if (cval==10) { /* goto */ + expr(15); + gen('n',6); /* goto */ + goto semi; + } + + if (cval==11) { /* return */ + if ((peeksym=symbol())==6) /* ( */ + pexpr(); + gen('n',7); /* retrn */ + goto semi; + } + + if (cval==12) { /* if */ + pexpr(); + o1 = isn; + isn = isn+1; + jumpc(o1); + stmt(); + o = symbol(); + if (o==19 & cval==14) { /* else */ + o2 = isn; + isn = isn+1; + jump(o2); + label(o1); + stmt(); + label(o2); + return; + } + peeksym = o; + label(o1); + return; + } + + if (cval==13) { /* while */ + o1 = isn; + isn = isn+1; + label(o1); + pexpr(); + o2 = isn; + isn = isn+1; + jumpc(o2); + stmt(); + jump(o1); + label(o2); + return; + } + + error('sx'); + goto syntax; + } + + if (o==20 & peekc==':') { /* name : */ + peekc = 0; + if (!*csym) { + *csym = 2; /* param */ + csym[1] = isn; + isn = isn+1; + } else if (*csym != 2) { + error('rd'); + goto next; + } + label(csym[1]); + goto next; + } + + peeksym = o; + expr(15); + gen('s',nauto); /* setop */ + +semi: + o = symbol(); + if (o==1) /* ; */ + return; + +syntax: + error('sz'); + goto next; +} + +void blkend() { + extern isn; + auto i; + + if (!isn) + return; + write('1:'); + i = 0; + while (i < isn) { + write('l'); + number(i); + write('\n'); + i = i+1; + } + isn = 0; +} + +gen(o,n) { + write(o); + write(' '); + number(n); +#if 1 + switch (o) { + case 'a': + wrstr(" \" aut"); + break; + case 'b': + wrstr(" \" bin"); + switch (n) { + case 1: + wrstr(" asg"); + break; + case 2: + wrstr(" or"); + break; + case 3: + wrstr(" and"); + break; + case 4: + wrstr(" eq"); + break; + case 5: + wrstr(" ne"); + break; + case 6: + wrstr(" le"); + break; + case 7: + wrstr(" lt"); + break; + case 8: + wrstr(" ge"); + break; + case 9: + wrstr(" gt"); + break; + case 10: + wrstr(" rsh"); + break; + case 11: + wrstr(" lsh"); + break; + case 12: + wrstr(" add"); + break; + case 13: + wrstr(" min"); + break; + case 14: + wrstr(" mod"); + break; + case 15: + wrstr(" mul"); + break; + case 16: + wrstr(" div"); + break; + } + break; + case 'c': + wrstr(" \" cons"); + break; + case 'f': + wrstr(" \" if"); + break; + case 'n': + wrstr(" \" etc"); + switch (n) { + case 1: + wrstr(" mcall"); + break; + case 2: + wrstr(" mark"); + break; + case 3: + wrstr(" call"); + break; + case 4: + wrstr(" vector"); + break; + case 5: + wrstr(" litrl"); + break; + case 6: + wrstr(" goto"); + break; + case 7: + wrstr(" retrn"); + break; + case 8: + wrstr(" escp"); + break; + } + break; + case 's': + wrstr(" \" set"); + break; + case 't': + wrstr(" \" tra"); + break; + case 'u': + wrstr(" \" una"); + switch (n) { + case 1: + wrstr(" adr"); + break; + case 2: + wrstr(" min"); + break; + case 3: + wrstr(" ind"); + break; + case 4: + wrstr(" not"); + break; + } + break; + case 'x': + wrstr(" \" ext"); + break; + case 'y': + wrstr(" \" ary"); + break; + } +#endif + write('\n'); +} + +jumpc(n) { + write('f '); /* ifop */ + write('1f'); + write('+'); + number(n); +#if 1 // Nick + wrstr(" \" if\n"); +#else + write('\n'); +#endif +} + +jump(n) { + write('x '); + write('1f'); + write('+'); + number(n); +#if 1 // Nick + wrstr(" \" ext\n"); + gen('n',6); /* goto */ +#else + gen('\nn',6); /* goto */ +#endif +} + +label(n) { + write('l'); + number(n); + write('=.'); + write('\n'); +} + +printn(n) { + if (n > 9) { + printn(n / 10); + n = n % 10; + } + write(n + '0'); +} + +number(x) { + if (x < 0) { + write('-'); + x = -x; + } + printn(x); +} + +name(int *s) { + while (*s) { + write(*s); + s = s+1; + } +} + +void error(code) { + extern line, eof, *csym, nerror, fout; + auto f; + + if (eof | nerror==20) { + eof = 1; + return; + } + nerror = nerror+1; + flush(); + f = fout; + fout = 1; + write(code); + write(' '); + if (code=='rd' | code=='un') { + name(csym + 2); + write(' '); + } + printn(line); + write('\n'); + flush(); + fout = f; +} + +/* storage */ + +int symtab[300] = { /* class value name */ + 1, 5,'a','u','t','o', 0 , + 1, 6,'e','x','t','r','n', 0 , + 1,10,'g','o','t','o', 0 , + 1,11,'r','e','t','u','r','n', 0 , + 1,12,'i','f', 0 , + 1,13,'w','h','i','l','e', 0 , + 1,14,'e','l','s','e', 0 }; + +int ctab[] = { + 0,127,127,127, 0,127,127,127, /* NUL SOH STX ETX EOT ENQ ACK BEL */ + 127,126,126,127,127,127,127,127, /* BS TAB LF VT FF CR SO SI */ + 127,127,127,127,127,127,127,127, /* DLE DC1 DC2 DC3 DC4 NAK SYN ETB */ + 127,127,127,127,127,127,127,127, /* CAN EM SUB ESC FS GS RS US */ + 126, 34,122,127,127, 44, 47,121, /* SPC ! " # $ % & ' */ + 6, 7, 42, 40, 9, 41,127, 43, /* ( ) * + , - . / */ + 124,124,124,124,124,124,124,124, /* 0 1 2 3 4 5 6 7 */ + 124,124, 8, 1, 63, 80, 65, 90, /* 8 9 : ; < = > ? */ + 127,123,123,123,123,123,123,123, /* @ A B C D E F G */ + 123,123,123,123,123,123,123,123, /* H I J K L M N O */ + 123,123,123,123,123,123,123,123, /* P Q R S T U V W */ + 123,123,123, 4,127, 5, 48,127, /* X Y Z [ \ ] ^ _ */ + 127,123,123,123,123,123,123,123, /* ` a b c d e f g */ + 123,123,123,123,123,123,123,123, /* h i j k l m n o */ + 123,123,123,123,123,123,123,123, /* p q r s t u v w */ + 123,123,123, 2, 48, 3,127,127}; /* x y z { | } ~ DEL */ + +int symbuf[10]; +int peeksym = -1; +int peekc; +int eof; +int line = 1; +int *csym; +int *ns; +int cval; +int isn; +int nerror; +int nauto; diff --git a/bi.c b/bi.c new file mode 100644 index 0000000..e2464c9 --- /dev/null +++ b/bi.c @@ -0,0 +1,502 @@ +#include +#include +#include +#include +#include +#include "rassert.h" + +#define TRACE 0 + +enum op { + OP_AUT = 1, + OP_BIN, // asg,or,and,eq,ne,le,lt,ge,gt,rsh,lsh,add,min,mod,mul,div + OP_CONS, + OP_IF, + OP_ETC, // mcall,mark,call,vector,litrl,goto,retrn,escp + OP_SET, + OP_TRA, + OP_UNA, // adr,min,ind,not + OP_EXT, + OP_ARY, +}; + +enum op_b { + OP_BIN_ASG = 1, + OP_BIN_OR, + OP_BIN_AND, + OP_BIN_EQ, + OP_BIN_NE, + OP_BIN_LE, + OP_BIN_LT, + OP_BIN_GE, + OP_BIN_GT, + OP_BIN_RSH, + OP_BIN_LSH, + OP_BIN_ADD, + OP_BIN_MIN, + OP_BIN_MOD, + OP_BIN_MUL, + OP_BIN_DIV, +}; + +enum op_n { + OP_ETC_MCALL = 1, + OP_ETC_MARK, + OP_ETC_CALL, + OP_ETC_VECTOR, + OP_ETC_LITRL, + OP_ETC_GOTO, + OP_ETC_RETRN, + OP_ETC_ESCP, +}; + +enum op_u { + OP_UNA_ADR = 1, + OP_UNA_MIN, + OP_UNA_IND, + OP_UNA_NOT, +}; + +enum sys { + SYS_WRITE = 1, +}; + +#define MEM_SIZE 0x4000 +#define MEM_MASK 0x3fff +uint32_t mem[MEM_SIZE]; + +int main(int argc, char **argv) { + if (argc < 2) { + printf("usage: %s a.out\n", argv[0]); + exit(EXIT_FAILURE); + } + char *a_out = argv[1]; + + uint32_t addr = 0, data; + + FILE *fp = fopen(a_out, "r"); + rassert(fp); + while (true) { + char buf[0x100]; + if (fgets(buf, 0x100, fp) == NULL) + break; + + int len = strlen(buf); + if (len == 0 || buf[len - 1] != '\n') { + fprintf(stderr, "no newline: %s\n", buf); + exit(EXIT_FAILURE); + } + buf[len - 1] = 0; + + addr = 0; + for (int i = 0; i < 6; ++i) { + char c = buf[i]; + if (c < '0' || c >= '8') { + fprintf(stderr, "bad address: %s\n", buf); + exit(EXIT_FAILURE); + } + addr = (addr << 3) | (c & 7); + } + + if (buf[6] != ':' || buf[7] != ' ') { + fprintf(stderr, "bad separator: %s\n", buf); + exit(EXIT_FAILURE); + } + + data = 0; + for (int i = 0; i < 6; ++i) { + char c = buf[8 + i]; + if (c < '0' || c >= '8') { + fprintf(stderr, "bad data: %s\n", buf); + exit(EXIT_FAILURE); + } + data = (data << 3) | (c & 7); + } + +#if TRACE + fprintf(stderr, "addr=%06o data=%06o\n", addr, data); +#endif + mem[addr++ & MEM_MASK] = data & 0x3FFFF; + } + fclose(fp); + + rassert(addr >= 2); + uint32_t pc = mem[0]; + uint32_t sp = mem[1]; + uint32_t dp = sp, ap = sp; + uint32_t arg0, arg1; + + while (true) { + switch (pc) { + case SYS_WRITE * 2: + sp = (dp + 3) & 0x3ffff; // s 3 + data = mem[(dp + 2) & MEM_MASK]; + if (data & 0x3fe00) + putchar(data >> 9); + if (data & 0x1ff) + putchar(data); + break; + } + + pc = (pc + 1) & 0x3ffff; + uint32_t op = mem[pc & MEM_MASK]; + addr = op & 0x3fff; + +#if TRACE + fprintf( + stderr, + "sp=%06o sp[-2]=%06o sp[-1]=%06o pc=%06o op=%06o", + sp, + mem[(sp - 2) & MEM_MASK], + mem[(sp - 1) & MEM_MASK], + pc, + op + ); + switch (op >> 14) { + case OP_AUT: + fprintf(stderr, " aut %06o", addr); + break; + case OP_BIN: + fprintf(stderr, " bin"); + switch (addr) { + case OP_BIN_ASG: + fprintf(stderr, " asg"); + break; + case OP_BIN_OR: + fprintf(stderr, " or"); + break; + case OP_BIN_AND: + fprintf(stderr, " and"); + break; + case OP_BIN_EQ: + fprintf(stderr, " eq"); + break; + case OP_BIN_NE: + fprintf(stderr, " ne"); + break; + case OP_BIN_LE: + fprintf(stderr, " le"); + break; + case OP_BIN_LT: + fprintf(stderr, " lt"); + break; + case OP_BIN_GE: + fprintf(stderr, " ge"); + break; + case OP_BIN_GT: + fprintf(stderr, " gt"); + break; + case OP_BIN_RSH: + fprintf(stderr, " rsh"); + break; + case OP_BIN_LSH: + fprintf(stderr, " lsh"); + break; + case OP_BIN_ADD: + fprintf(stderr, " add"); + break; + case OP_BIN_MIN: + fprintf(stderr, " min"); + break; + case OP_BIN_MOD: + fprintf(stderr, " mod"); + break; + case OP_BIN_MUL: + fprintf(stderr, " mul"); + break; + case OP_BIN_DIV: + fprintf(stderr, " div"); + break; + } + break; + case OP_CONS: + fprintf(stderr, " cons %06o", addr); + break; + case OP_IF: + fprintf(stderr, " if %06o", addr); + break; + case OP_ETC: + fprintf(stderr, " etc"); + switch (addr) { + case OP_ETC_MCALL: + fprintf(stderr, " mcall"); + break; + case OP_ETC_MARK: + fprintf(stderr, " mark"); + break; + case OP_ETC_CALL: + fprintf(stderr, " call"); + break; + case OP_ETC_VECTOR: + fprintf(stderr, " vector"); + break; + case OP_ETC_LITRL: + fprintf(stderr, " litrl %06o", mem[(pc + 1) & MEM_MASK]); + break; + case OP_ETC_GOTO: + fprintf(stderr, " goto"); + break; + case OP_ETC_RETRN: + fprintf(stderr, " retrn"); + break; + case OP_ETC_ESCP: + fprintf(stderr, " escp"); + break; + } + break; + case OP_SET: + fprintf(stderr, " set %06o", addr); + break; + case OP_TRA: + fprintf(stderr, " tra %06o", addr); + break; + case OP_UNA: + fprintf(stderr, " una"); + switch (addr) { + case OP_UNA_ADR: + fprintf(stderr, " adr"); + break; + case OP_UNA_MIN: + fprintf(stderr, " min"); + break; + case OP_UNA_IND: + fprintf(stderr, " ind"); + break; + case OP_UNA_NOT: + fprintf(stderr, " not"); + break; + } + break; + case OP_EXT: + fprintf(stderr, " ext %06o", addr); + break; + case OP_ARY: + fprintf(stderr, " ary %06o", addr); + break; + } + fputc('\n', stderr); +#endif + + switch (op >> 14) { + case OP_AUT: + mem[sp & MEM_MASK] = (dp + addr) & 0x3ffff; + sp = (sp + 2) & 0x3ffff; + break; + case OP_BIN: + sp = (sp - 4) & 0x3ffff; + arg0 = mem[sp & MEM_MASK]; + arg1 = mem[(sp + 2) & MEM_MASK]; + switch (addr) { + case OP_BIN_ASG: + data = mem[arg1 & MEM_MASK]; + mem[arg0 & MEM_MASK] = data; + break; + case OP_BIN_OR: + data = mem[arg0 & MEM_MASK] | mem[arg1 & MEM_MASK]; + break; + case OP_BIN_AND: + data = mem[arg0 & MEM_MASK] & mem[arg1 & MEM_MASK]; + break; + case OP_BIN_EQ: + data = mem[arg0 & MEM_MASK] == mem[arg1 & MEM_MASK]; + break; + case OP_BIN_NE: + data = mem[arg0 & MEM_MASK] != mem[arg1 & MEM_MASK]; + break; + case OP_BIN_LE: + // the bi.s comparison does not take account of overflow, we do + data = mem[arg0 & MEM_MASK] <= mem[arg1 & MEM_MASK]; + break; + case OP_BIN_LT: + // the bi.s comparison does not take account of overflow, we do + data = mem[arg0 & MEM_MASK] < mem[arg1 & MEM_MASK]; + break; + case OP_BIN_GE: + // the bi.s comparison does not take account of overflow, we do + data = mem[arg0 & MEM_MASK] >= mem[arg1 & MEM_MASK]; + break; + case OP_BIN_GT: + // the bi.s comparison does not take account of overflow, we do + data = mem[arg0 & MEM_MASK] > mem[arg1 & MEM_MASK]; + break; + case OP_BIN_RSH: + // not implemented in bi.s + data = mem[arg0 & MEM_MASK] >> mem[arg1 & MEM_MASK]; + break; + case OP_BIN_LSH: + // not implemented in bi.s + data = (mem[arg0 & MEM_MASK] << mem[arg1 & MEM_MASK]) & 0x3ffff; + break; + case OP_BIN_ADD: + data = (mem[arg0 & MEM_MASK] + mem[arg1 & MEM_MASK]) & 0x3ffff; + break; + case OP_BIN_MIN: + data = (mem[arg0 & MEM_MASK] - mem[arg1 & MEM_MASK]) & 0x3ffff; + break; + case OP_BIN_MOD: + data = ( + (int32_t)((mem[arg0 & MEM_MASK] ^ 0x20000) - 0x20000) % + (int32_t)((mem[arg1 & MEM_MASK] ^ 0x20000) - 0x20000) + ) & 0x3ffff; + break; + case OP_BIN_MUL: + data = (mem[arg0 & MEM_MASK] * mem[arg1 & MEM_MASK]) & 0x3ffff; + break; + case OP_BIN_DIV: + data = ( + (int32_t)((mem[arg0 & MEM_MASK] ^ 0x20000) - 0x20000) / + (int32_t)((mem[arg1 & MEM_MASK] ^ 0x20000) - 0x20000) + ) & 0x3ffff; + break; + default: + fprintf(stderr, "pc=%06o op=%06o invalid binop\n", pc, op); + exit(EXIT_FAILURE); + } + mem[sp & MEM_MASK] = (sp + 1) & 0x3ffff; + mem[(sp + 1) & MEM_MASK] = data; + sp = (sp + 2) & 0x3ffff; + break; + case OP_CONS: + mem[sp & MEM_MASK] = (sp + 1) & 0x3ffff; + mem[(sp + 1) & MEM_MASK] = addr; + sp = (sp + 2) & 0x3ffff; + break; + case OP_IF: + sp = (sp - 2) & 0x3ffff; + arg0 = mem[sp & MEM_MASK]; + if (mem[arg0 & MEM_MASK] == 0) + pc = (mem[addr & MEM_MASK] - 1) & 0x3ffff; + break; + case OP_ETC: + switch (addr) { + case OP_ETC_MCALL: + // call with no arguments, stands for "mark and then call" + sp = (sp - 2) & 0x3ffff; + arg0 = mem[sp & MEM_MASK]; + arg1 = mem[arg0 & MEM_MASK]; // dereference the function address + mem[sp & MEM_MASK] = dp; // saved dp + dp = sp; + mem[(sp + 1) & MEM_MASK] = pc; // saved pc + sp = (sp + 2) & 0x3ffff; + pc = (arg1 - 1) & 0x3ffff; + break; + case OP_ETC_MARK: + // dereference the function address + // it means that there is no difference between a function and a + // function pointer, because the function begins with its pointer + sp = (sp - 2) & 0x3ffff; + arg0 = mem[sp & MEM_MASK]; + mem[(sp + 1) & MEM_MASK] = mem[arg0 & MEM_MASK]; // destination pc + mem[sp & MEM_MASK] = ap; // saved ap + ap = sp; + sp = (sp + 2) & 0x3ffff; + break; + case OP_ETC_CALL: + // dereference all arguments -- changes them from temporary values + // on the stack (lvalue, 2 words) into automatic variables (1 word) + rassert(((sp - ap) & ~0xfe) == 0); // sanity check + arg0 = (ap + 2) & 0x3ffff; + arg1 = arg0; + do { + addr = mem[arg0 & MEM_MASK]; + //fprintf(stderr, "%06o -> addr=%06o *addr=%06o -> %06o\n", arg0, addr, mem[addr & MEM_MASK], arg1); + arg0 = (arg0 + 2) & 0x3ffff; + mem[arg1 & MEM_MASK] = mem[addr & MEM_MASK]; + arg1 = (arg1 + 1) & 0x3ffff; + } while (arg0 < sp); + // at this point we could back up sp to arg1, but it is not needed + // because callee will execute a set instruction to set sp = dp + n + arg0 = mem[ap & MEM_MASK]; // saved ap + mem[ap & MEM_MASK] = dp; // saved dp + dp = ap; + arg1 = mem[(ap + 1) & MEM_MASK]; // destination pc + mem[(ap + 1) & MEM_MASK] = pc; // saved pc + ap = arg0; + pc = (arg1 - 1) & 0x3ffff; + break; + case OP_ETC_VECTOR: + sp = (sp - 4) & 0x3ffff; + arg0 = mem[sp & MEM_MASK]; + arg1 = mem[(sp + 2) & MEM_MASK]; + mem[sp & MEM_MASK] = ( + mem[arg0 & MEM_MASK] + mem[arg1 & MEM_MASK] + ) & 0x3ffff; + sp = (sp + 2) & 0x3ffff; + break; + case OP_ETC_LITRL: + mem[sp & MEM_MASK] = (sp + 1) & 0x3ffff; + pc = (pc + 1) & 0x3ffff; + mem[(sp + 1) & MEM_MASK] = mem[pc & MEM_MASK]; + sp = (sp + 2) & 0x3ffff; + break; + case OP_ETC_GOTO: + sp = (sp - 2) & 0x3ffff; + arg0 = mem[sp & MEM_MASK]; + pc = (mem[arg0 & MEM_MASK] - 1) & 0x3ffff; + break; + case OP_ETC_RETRN: + sp = (sp - 2) & 0x3ffff; + arg0 = mem[sp & MEM_MASK]; + data = mem[arg0 & MEM_MASK]; // return value + sp = dp; + dp = mem[sp & MEM_MASK]; // saved dp + if (dp == 0) + // return from main() + return 0; + mem[sp & MEM_MASK] = (sp + 1) & 0x3ffff; + pc = mem[(sp + 1) & MEM_MASK]; // saved pc + mem[(sp + 1) & MEM_MASK] = data; // return value + sp = (sp + 2) & 0x3ffff; + break; + case OP_ETC_ESCP: + fprintf(stderr, "pc=%06o escp not supported\n", pc); + exit(EXIT_FAILURE); + default: + fprintf(stderr, "pc=%06o op=%06o invalid etcop\n", pc, op); + exit(EXIT_FAILURE); + } + break; + case OP_SET: + sp = dp + addr; + break; + case OP_TRA: + pc = (addr - 1) & 0x3ffff; + break; + case OP_UNA: + sp = (sp - 2) & 0x3ffff; + arg0 = mem[sp & MEM_MASK]; + switch (addr) { + case OP_UNA_ADR: + data = arg0; + break; + case OP_UNA_MIN: + data = -mem[arg0 & MEM_MASK] & 0x3ffff; + break; + case OP_UNA_IND: + data = mem[mem[arg0 & MEM_MASK] & MEM_MASK]; + break; + case OP_UNA_NOT: + data = !mem[arg0 & MEM_MASK]; + break; + default: + fprintf(stderr, "pc=%06o op=%06o invalid unaop\n", pc, op); + exit(EXIT_FAILURE); + } + mem[sp & MEM_MASK] = (sp + 1) & 0x3ffff; + mem[(sp + 1) & MEM_MASK] = data; + sp = (sp + 2) & 0x3ffff; + break; + case OP_EXT: + mem[sp & MEM_MASK] = addr; + sp = (sp + 2) & 0x3ffff; + break; + case OP_ARY: + addr += dp; + mem[addr & MEM_MASK] = (addr + 1) & 0x3fffff; + break; + default: + fprintf(stderr, "pc=%06o op=%06o invalid op\n", pc, op); + exit(EXIT_FAILURE); + } + } +} diff --git a/doc/PDP7_Instruction_list_text.pdf b/doc/PDP7_Instruction_list_text.pdf new file mode 100644 index 0000000..8b1a8bd Binary files /dev/null and b/doc/PDP7_Instruction_list_text.pdf differ diff --git a/doc/bi.s b/doc/bi.s new file mode 100644 index 0000000..6969bed --- /dev/null +++ b/doc/bi.s @@ -0,0 +1,441 @@ +"** 06-5-12.pdf page 12 +" bi + +start: + jms initio + -1 + tad .main + dac pc + +fetch: + lac pc i + lmq + and o17777 + dac addr + cla; lls 4 " XXX replaced for now: ecla lls 4 + tad .+3 + dac .+1 + jmp .. i + jmp . i + autop; binop; consop; ifop; etcop; setop; traop + unaop; extop; aryop + + +ifop: + -2 + tad sp + dac sp + lac sp i + dac t1 + lac t1 i + sza + jmp fetch + -1 + tad addr i + dac pc + jmp fetch + +autop: + lac addr + tad dp + dac sp i + isz sp + isz sp + jmp fetch + +binop: + -2 + tad sp + dac sp + tad dm1 + dac t4 + tad dm1 + dac t3 + lac t3 i + dac t1 + lac sp i + dac t2 + lac t4 + dac t3 i + lac addr + tad .+3 + dac .+1 + jmp .. i +"** 06-5-12.pdf page 13 + jmp . i + basg; bor; band; beq; bne; ble; blt; bge; bgt; brsh; blsh + badd; bmin; bmod; bmul; bdiv + +basg: + lac t2 i + dac t1 i + dac t4 i + jmp fetch + +bor: + lac t1 i + lmq + lac t2 i + omq + dac t4 i + jmp fetch + +band: + lac t1 i + and t2 i + dac t4 i + jmp fetch + +beq: + lac t1 i + xor t2 i + sna cla + lac d1 + dac t4 i + jmp fetch + +bne: + lac t1 i + xor t2 i + sza + lac d1 + dac t4 i + jmp fetch + +ble: + lac t2 i + cma + tad t1 i + spa cla + lac d1 + dac t4 i + jmp fetch + +blt: + lac t1 i + cma + tad t2 i + sma cla + lac d1 + dac t4 i + jmp fetch + +bge: + lac t1 i + cma +"** 06-5-12.pdf page 14 + tad t2 i + spa cla + lac d1 + dac t4 i + jmp fetch + +bgt: + lac t2 i + cma + tad t1 i + sma cla + lac d1 + dac t4 i + jmp fetch + +brsh: +blsh: + hlt + +badd: + lac t1 i + tad t2 i + dac t4 i + jmp fetch + +bmin: + lac t1 i + cma + tad t2 i + cma + dac t4 i + jmp fetch + +bmod: + lac t2 i + dac .+4 + lac t1 i + cll; idiv; .. + dac t4 i + jmp fetch + +bmul: + lac t2 i + dac .+4 + lac t1 i + cll; mul; .. + lacq + dac t4 i + jmp fetch + +bdiv: + lac t2 i + dac .+4 + lac t1 i + cll; idiv; .. + lacq + dac t4 i + jmp fetch + +consop: + lac sp +"** 06-5-12.pdf page 15 + tad d1 + dac sp i + isz sp + lac addr + dac sp i + isz sp + jmp fetch + +etcop: + lac addr + tad .+3 + dac .+1 + jmp .. i + jmp . i + mcall; mark; call; vector; litrl; goto; retrn; escp + +mcall: + -2 + tad sp + dac t1 + lac t1 i + dac t2 + -1 + tad t2 i + lmq + lac dp + dac t1 i + lac t1 + dac dp + isz t1 + lac pc + dac t1 i + lacq + dac pc + jmp fetch + +mark: + -1 + tad sp + dac t2 + tad dm1 + dac t1 + lac t1 i + dac t3 + lac t3 i + dac t2 i + lac ap + dac t1 i + lac t1 + dac ap + jmp fetch + +call: + lac ap + tad d1 + dac 8 + dac 9 +1: + lac 8 i + dac t1 + lac t1 i +"** 06-5-12.pdf page 16 + dac 9 i + isz 8 + -1 + tad sp + sad 8 + skp + jmp 1b + lac ap i + lmq + lac dp + dac ap i + lac ap + dac dp + isz ap + -1 + tad ap i + dac t1 + lac pc + dac ap i + lacq + dac ap + lac t1 + dac pc + jmp fetch + +vector: + -2 + tad sp + dac sp + tad dm2 + dac t1 + lac sp i + dac t2 + lac t1 i + dac t3 + lac t3 i + tad t2 i + dac t1 i + jmp fetch + +litrl: + lac sp + tad d1 + dac sp i + isz sp + lac pc i + dac sp i + isz sp + jmp fetch + +goto: + -2 + tad sp + dac sp + lac sp i + dac t1 + -1 + tad t1 i + dac pc + jmp fetch +"** 06-5-12.pdf page 17 + +retrn: + -2 + tad sp + dac sp + lac sp i + dac t1 + lac t1 i + lmq + lac dp + dac sp + dac t1 + lac sp i + sna + jmp stop + dac dp + isz sp + lac sp + dac t1 i + lac sp i + dac pc + lacq + dac sp i + isz sp + jmp fetch + +escp: + law 2 + tad pc + dac t1 + jmp t1 i + +setop: + lac addr + tad dp + dac sp + jmp fetch + +traop: + -1 + tad addr + dac pc + jmp fetch + +unaop: + -1 + tad sp + dac t3 + tad dm1 + dac t2 + lac t2 i + dac t1 + lac t3 + dac t2 i + lac addr + tad .+3 + dac .+1 + jmp .. i + jmp . i + uadr; umin; uind; unot + +uadr: +"** 06-5-12.pdf page 18 + lac t1 + dac t3 i + jmp fetch + +umin: + -1 + tad t1 i + cma + dac t3 i + jmp fetch + +uind: + lac t1 i + dac t2 i + jmp fetch + +unot: + lac t1 i + sna cla + lac d1 + dac t3 i + jmp fetch + +extop: + lac addr + dac sp i + isz sp + isz sp + jmp fetch + +aryop: + lac addr + tad dp + dac t1 + tad d1 + dac t1 i + jmp fetch + +a = 040000 +b = a+a +c = b+a +f = c+a +n = f+a +s = n+a +t = s+a +u = t+a +x = u+a +y = x+a + +d1: 1 +dm1: -1 +dm2: -2 +o17777: 017777 + +t1: 0 +t2: 0 +t3: 0 +t4: 0 +addr: 0 + +pc = 017 + +"** 06-5-12.pdf page 19 +sp: stack +dp: stack +ap: stack +stack: 0 diff --git a/doc/bl.s b/doc/bl.s new file mode 100644 index 0000000..2706567 --- /dev/null +++ b/doc/bl.s @@ -0,0 +1,198 @@ +"** 06-5-12.pdf page 3 +" bl + +jmp start + +.array: .+1 + s 2 + n 8 + n 7 + -1 + tad sp i + cma + tad lastv + dac lastv + lmq + lac sp + tad d1 + dac sp i + isz sp + lacq + dac sp i + isz sp + jmp fetch + +.read: .+1 + s 2 + n 8 + n 7 + lac sp + tad d1 + dac sp i + isz sp + jms getc + dac sp i + isz sp + jmp fetch + +.write: .+1 + s 2 + n 8 + n 7 + lac sp i + dac t1 + lrss 9 + jms putc + lac t1 + jms putc + jmp fetch + +.flush: .+1 + n 8 + n 7 + jms flush + jmp fetch + +getc: 0 + lac iflg + dzm iflg + sza + jmp getc i + lac cibufp + sad eibufp + jmp 1f +"** 06-5-12.pdf page 4 + lac cibufp i + and o777 + dac iflg + lac cibufp i + isz cibufp + lrss 9 + jmp getc i +1: + lac .fin + sys read; ibufp: ..; 64 + sna spa + jmp 1f + tad ibufp + dac eibufp + lac ibufp + dac cibufp + jmp getc+1 +1: + lac o4 + jmp getc i + +putc: 0 + and o777 + sna + jmp putc i + lmq + lac oflg + sza + jmp 1f + lacq + alss 9 + dac cobufp i + dac oflg + jmp putc i +1: + lac cobufp i + omq + dac cobufp i + dac cobufp i + dzm oflg + isz cobufp + lac cobufp + sad eobufp + skp + jmp putc i + lac .fout + sys write; obufp: ..; 64 + lac obufp + dac cobufp + jmp putc i + +stop: + jms flush + las + sma + sys exit " XXX replaced for now: sys save + sys exit + +flush: 0 + lac oflg + sza +"** 06-5-12.pdf page 5 + isz cobufp + lac cobufp + cma + tad obufp + cma + sna + jmp flush i + dac 1f+1 + lac obufp + dac 1f + lac .fout + sys write; 1: ..; .. + lac obufp + dac cobufp + dzm oflg + jmp flush i + +initio: 0 + lac 017777 i + sad d4 + jmp 2f + sad d8 + jmp 1f + + law 9 + tad 017777 + dac .+3 + law 017 + sys creat; .. + spa + jmp stop + dac .fout +1: + law 5 + tad 017777 + dac .+2 + sys open; ..; 0 + spa + jmp stop + dac .fin +2: + lac lastv + dac eibufp + dac cibufp + -64 + tad lastv + dac lastv + dac ibufp + lac lastv + dac eobufp + -64 + tad lastv + dac lastv + dac obufp + dac cobufp + dzm oflg + jmp initio i + +.fin: 0 +.fout: 1 +eibufp: 0 +"** 06-5-12.pdf page 6 +cibufp: 0 +iflg: 0 +eobufp: 0 +cobufp: 0 +oflg: 0 +lastv: 017770 + +o777: 0777 +d4:o4: 4 +d8: 8 diff --git a/doc/op.s b/doc/op.s new file mode 100644 index 0000000..1d29305 --- /dev/null +++ b/doc/op.s @@ -0,0 +1,101 @@ +"** 09-1-35.pdf page 35 +" op + +sys = 0020000 +dac = 0040000 +jms = 0100000 +dzm = 0140000 +lac = 0200000 +xor = 0240000 +add = 0300000 +tad = 0340000 +xct = 0400000 +isz = 0440000 +and = 0500000 +sad = 0540000 +jmp = 0600000 +law = 0760000 + +nop = 0740000 +cma = 0740001 +cml = 0740002 +oas = 0740004 +ral = 0740010 +rar = 0740020 +hlt = 0740040 +sma = 0740100 +sza = 0740200 +snl = 0740400 +skp = 0741000 +spa = 0741100 +sna = 0741200 +szl = 0741400 +rtl = 0742010 +rtr = 0742020 +cll = 0744000 +stl = 0744002 +rcl = 0744010 +rcr = 0744020 +cla = 0750000 +clc = 0750001 +las = 0750004 +glk = 0750010 +lrs = 0640500 +lrss= 0660500 +lls = 0640600 +llss= 0660600 +als = 0640700 +alss= 0660700 +norm= 0640444 +norms=0660444 +mul = 0653122 +muls= 0657122 +div = 0640323 +divs= 0644323 +idiv= 0653323 +idivs=0657323 +frdiv = 0650323 +frdivs = 0654323 +lacq = 0641002 +lacs = 0641001 +clq = 0650000 +ads = 0644000 +gsm = 0664000 + +"** 10-36-55.pdf page 1 +osc = 0640001 +omq = 0640002 +otq = 0642000 +cmq = 0640004 +lmq = 0652000 +ecla = 0641000 + +i = 020000 + +save = 1 +getuid = 2 +open = 3 +read = 4 +write = 5 +creat = 6 +seek = 7 +tell = 8 +close = 9 +link = 10 +unlink = 11 +setuid = 12 +rename = 13 +exit = 14 +time = 15 +intrp = 16 +chdir = 17 +chmode = 18 +chowner = 19 +sysloc = 21 +capt = 23 +rele = 24 +status = 25 +sleep = 26 +smes = 27 +rmes = 28 +fork = 29 diff --git a/footer.s b/footer.s new file mode 100644 index 0000000..ababb2e --- /dev/null +++ b/footer.s @@ -0,0 +1,5 @@ +" linked at the end, mark the stack position +" note that dp points to the 0 word on entry, then .main does sp = dp + n, +" reserving 2 words on stack as though they were the saved dp and saved pc, +" then when .main returns, the interpreter sees the saved dp == 0 and quits +stack: 0 diff --git a/header.s b/header.s new file mode 100644 index 0000000..6fadfcd --- /dev/null +++ b/header.s @@ -0,0 +1,20 @@ +" opcodes +a = 0040000 " autop +b = 0100000 " binop: asg,or,and,eq,ne,le,lt,ge,gt,rsh,lsh,add,min,mod,mul,div +c = 0140000 " consop +f = 0200000 " ifop +n = 0240000 " etcop: mcall,mark,call,vector,litrl,goto,retrn,escp +s = 0300000 " setop +t = 0340000 " traop +u = 0400000 " unaop: adr,min,ind,not +x = 0440000 " extop +y = 0500000 " aryop + +" header +. = 0 +.main +stack + +" sys +.write: .+1 +n 7 " etc retrn diff --git a/hello.b b/hello.b new file mode 100644 index 0000000..15a86ae --- /dev/null +++ b/hello.b @@ -0,0 +1,9 @@ +main $( + write('He'); + write('ll'); + write('o,'); + write(' W'); + write('or'); + write('ld'); + write('!*n'); +$) diff --git a/n.sh b/n.sh new file mode 100755 index 0000000..8d54040 --- /dev/null +++ b/n.sh @@ -0,0 +1,9 @@ +#!/bin/sh + +./b hello.b hello.s + +# original version with opcode table, b library, hello, b interpreter +#./as7 doc/op.s doc/bl.s hello.s doc/bi.s + +# cut-down version for the VM here +./as7 header.s hello.s footer.s diff --git a/rassert.h b/rassert.h new file mode 100644 index 0000000..726565a --- /dev/null +++ b/rassert.h @@ -0,0 +1,11 @@ +#ifndef _RASSERT_H +#define _RASSERT_H + +#include + +# define rassert(expr) \ + ((expr) \ + ? __ASSERT_VOID_CAST (0) \ + : __assert_fail (#expr, __FILE__, __LINE__, __ASSERT_FUNCTION)) + +#endif