--- /dev/null
+*.o
+/a.out
+/b
+/bi
+/hello.s
--- /dev/null
+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
--- /dev/null
+#!/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) << 9; # absolute
+ }
+ elsif ($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;
+ }
+}
--- /dev/null
+/* 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 <io.h>
+#else
+#include <unistd.h>
+#endif
+#include <stdio.h>
+#include <stdlib.h>
+#include <memory.h>
+#include <fcntl.h>
+
+/* 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<symbuf+9) {
+ *sp = c;
+ sp = sp+1;
+ }
+ ct = ctab[c = read()];
+ }
+ *sp = 0;
+ peekc = c;
+ csym = lookup();
+ if (csym[0]==1) {
+ cval = csym[1];
+ return(19); /* keyword */
+ }
+ return(20); /* name */
+ }
+ if (ct==127) { /* unknown */
+ error('sy');
+ c = read();
+ goto loop;
+ }
+ return(ctab[c]);
+}
+
+subseq(c,a,b) {
+ extern peekc;
+
+ if (!peekc)
+ peekc = read();
+ if (peekc != c)
+ return(a);
+ peekc = 0;
+ return(b);
+}
+
+void getcc() {
+ extern cval;
+ auto c;
+
+ cval = 0;
+ if ((c = mapch('\'')) < 0)
+ return;
+ cval = c;
+ if ((c = mapch('\'')) < 0)
+ return;
+ cval = cval * 512 + c;
+ if (mapch('\'') >= 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;
--- /dev/null
+#include <stdbool.h>
+#include <stdint.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#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);
+ }
+ }
+}
--- /dev/null
+"** 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
--- /dev/null
+"** 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
--- /dev/null
+"** 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
--- /dev/null
+" 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
--- /dev/null
+" 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
--- /dev/null
+main $(
+ write('He');
+ write('ll');
+ write('o,');
+ write(' W');
+ write('or');
+ write('ld');
+ write('!*n');
+$)
--- /dev/null
+#!/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
--- /dev/null
+#ifndef _RASSERT_H
+#define _RASSERT_H
+
+#include <assert.h>
+
+# define rassert(expr) \
+ ((expr) \
+ ? __ASSERT_VOID_CAST (0) \
+ : __assert_fail (#expr, __FILE__, __LINE__, __ASSERT_FUNCTION))
+
+#endif
public / b_18bit.git / commitdiff