/*
   Run IMP15 Object file
   RWT September 2002
*/

/*
This is the reverser, loader, and simulator/emulator.
First arg is name of program, second is comma-separated
list of input file names to be opened from stream 1 upwards,
third is likewise for output.  Only the first is mandatory.

It treats "n" and "t" as special names for null and terminal.
Terminal actually uses stdin/stdout.  Stream 0 is "t" for
both input and output, but you can override by sticking
"0-" in front of arg2 and arg3.  Defaults are "t" for 1 and
"n" for 2 to 7.

To run the compiler, assuming run.c has been compiled
using "gcc run.c -o run", and hdcomp.i15 has been
compiled into hdcomp.o15, use:

run hdcomp fred.i15,prim.i15 fred.o15

Omitting the second output file name means the map file
is not generated.

run hdcomp hdcomp.i15,prim.i15 h.o15
run h hdcomp.i15,prim.i15 hh.o15

should result in h.o15 and hh.o15 being identical, and
almost identical to hdcomp.o15.
*/


#include <stdio.h>
#define NL '\n'
#define CR '\r'

void fatal (char *s) {
  fprintf(stderr,"**%s\n",s); exit(1);
}

void fatal2 (char *s, char *t) {
  fprintf(stderr,"**%s %s\n",s,t); exit(1);
}

/*
   IMP stream I/O support
   There are 8 input and 8 output streams,
   both sets numbered 0 to 7.
   Streams 0 are control in and out,
   Streams 1 are normal in and out.
*/

static FILE *in[8],*out[8],*curin,*curout;
static int instream,outstream;

void selectinput (int i) {
  instream = i&7; curin = in[instream];
}

void selectoutput (int i) {
  outstream = i&7; curout = out[outstream];
}

void closeinput (void) {
  if (curin==0) return;
  if (curin!=stdin) fclose(curin);
  curin = 0; in[instream] = 0;
}

void closeoutput (void) {
  if (curout==0) return;
  if (curout!=stdout) fclose(curout);
  curout = 0; out[outstream] = 0;
}

void printch (int i) {
  if (curout) fputc(i,curout);
}

void printsymbol (int i) {
  if (curout) fputc(i,curout);
}

void newline (void) {printsymbol(NL);}
void newlines (int n) {while (n-->0) newline();}
void space (void) {printsymbol(' ');}
void spaces (int n) {while (n-->0) space();}

void iwrite (int n, int p) {
/* This isn't quite right, but it'll do for now */
  if (n<-9 || n>9) {
    iwrite(n/10,p-1);
    if (n<0) n = -n; printsymbol((n%10)+'0');
  } else {
    spaces(p-1);
    if (n<0) {n = -n; printsymbol('-');} else space();
    printsymbol(n+'0');
  }
}

int readch (void) {
  if (curin==0) return -1;
  return fgetc(curin);
}

int readsymbol (void) {
int k;
  do k = readch(); while (k==0);
  return k;
}

int nextsymbol (void) {
int k = readsymbol();
  if (k<0) return k;
  ungetc(k,curin);
  return k;
}

/*
   Printstring/openinput/openoutput are here for internal
   use only.  IMP15 had no strings, and in any case file
   opening was the preserve of the EXEC part of the
   operating system, which is no longer in memory once an
   IMP program has been loaded.

   The filename argument to openinput/output is "n" (upper
   or lower case) or "" or 0 for the null file (for input
   this generates EOF (signals fault 9) on a read attempt,
   for output the print symbol routine just returns (throws
   output away)).
   The filename argument is "t" (upper or lower case) for
   "the terminal", equivalenced here to stdin/stdout
   (output should probably be stderr instead).
*/

void printstring (char *s) {
  while (*s) printsymbol(*s++);
}

void openinput (int s, char *f) {
  selectinput(s); closeinput();
  if (f==0) return;
  s = f[0]&95;
  if (s==0) return;
  if (s=='N' && f[1]==0) return;
  if (s=='T' && f[1]==0) {curin = stdin;}
  else {
    curin = fopen(f,"r");
    if (curin==0) fatal2("Cannot open input file",f);
  }
  in[instream] = curin;
}

void openoutput (int s, char *f) {
  selectoutput(s); closeoutput();
  if (f==0) return;
  s = f[0]&95;
  if (s==0) return;
  if (s=='N' && f[1]==0) return;
  if (s=='T' && f[1]==0) {curout = stdout;}
  else {
    curout = fopen(f,"w");
    if (curout==0) fatal2("Cannot open output file",f);
  }
  out[outstream] = curout;
}

/*  Basic PDP9/15 emulation starts here  */

static int pdp15=1;  /* enables IAC/SWHA if non-zero */

enum {
 m9 =         0777,  /* for SWHA */
 m13 =      017777,  /* for direct addressing */
 m15 =      077777,  /* for indirect */
 m18 =     0777777,  /* for data values */
 m19 =    01777777,  /* for combined LINK and AC */
 bankbits = 060000,
 indbit =   020000,
 embit =   0200000,  /* extend mode bit for JMS */
 signbit = 0400000,
 linkbit =01000000,
 unassigned=-linkbit};

#define BANK (PC&bankbits)
#define LINK (L_AC&linkbit)
#define AC (L_AC&m18)

static int PC,IR,L_AC,MA,MD,*M;
static int CYCLES=0;     /* counts emulated time */
static int MSIZE=m15+1;  /* full 32k */
static int LINENO=-1;
static char* ERROR=0;

#define TRUE return 1
#define FALSE return 0
#define FAIL(s) {ERROR = s; FALSE;}

#define SAC signextend(L_AC)
#define SMD signextend(MD)

int signextend (int n) {
  if (n&signbit) return n|~m18;
  return n&m18;
}

/*
   32-bit memory words used thus:
   Sign-bit indicates "Unassigned".
   Next 12 bits used by loader to store line number.
   Next bit is a buffer zone to drop ISZ carries.
   The low-order 18 bits hold the actual PDP9/15 data.
*/

enum {dofetch=1,doread=2,dowrite=4,doinc=doread+dowrite};

int mop (int op) {   /* emulated memory operations */
  CYCLES++; MD &= m18; MA &= m18;
  if (MA>=MSIZE) FAIL("Address out of range");
  if (op&(dofetch+doread)) MD = M[MA];
  if (MD<0) FAIL("Unassigned memory");
  if (op==dofetch) LINENO = MD>>19;
  if (op==doinc) MD = (MD+1)&~linkbit;
  M[MA] = MD; MD &= m18; TRUE;
}
  
#define FETCH if (!mop(dofetch)) return
#define READ  if (!mop(doread)) return
#define WRITE if (!mop(dowrite)) return
#define INC   if (!mop(doinc)) return
#define INCPC PC = ((PC+1)&m13)+BANK

/*
   Execute the instruction in IR.
   Called recursively for XCT (within reason).
*/

int execute (int depth) {
int t;
  if (depth>8) FAIL("Nested XCT");
  t = IR>>14;                  /* base opcode */
  if (t<=12) {                 /* memref inst */
    MA = (IR&m13)+BANK;        /* get operand address */
    if (t==0) MA = 020;        /* adjust if CAL */
    if (IR&indbit) {
      if ((MA&(m13-7))==010) { /* autoindex */
        MA = MA&017; INC;
        MA = MD;               /* 18-bit address FWIW */
      } else {                 /* ordinary indirect */
        READ; MA = MD&m15;
      }
    }
  }
  switch (t) {
case 0:  /*CAL*/ return(primperm());
case 1:  /*DAC*/ MD = AC; WRITE; TRUE;
case 2:  /*JMS*/ MD = (LINK>>1)+PC+embit; WRITE;
                 PC = MA; INCPC; TRUE;
case 3:  /*DZM*/ MD = 0;  WRITE; TRUE;
case 4:  /*LAC*/ READ; L_AC = LINK+MD; TRUE;
case 5:  /*XOR*/ READ; L_AC ^= MD; TRUE;
case 6:  /*ADD*/ FAIL("ADD not allowed");
case 7:  /*TAD*/ READ; L_AC = (L_AC+MD)&m19; TRUE;
case 8:  /*XCT*/ FETCH; IR = MD; return execute(depth+1);
case 9:  /*ISZ*/ INC; if (MD==0) INCPC; TRUE;
case 10: /*AND*/ READ; L_AC = LINK+(L_AC&MD); TRUE;
case 11: /*SAD*/ READ; if (AC!=MD) INCPC; TRUE;
case 12: /*JMP*/ PC = MA; TRUE;
case 13: /*EAE*/ FAIL("EAE not allowed");
case 14: /*IOT*/ FAIL("IOT not allowed");
case 15: /*OPR*/
         /*LAW*/ if (IR&indbit) {L_AC = LINK+IR; TRUE;} 
/* Time 1: skips */
    t=0;
    if (IR&00100)  /*SMA*/ if (L_AC&signbit) t=1;
    if (IR&00200)  /*SZA*/ if (AC==0) t=1;
    if (IR&00400)  /*SNL*/ if (LINK) t=1;
    if (IR&01000)  /*SKP*/ t=1-t;
    if (t) INCPC;
/* Time 2: Clear AC/Link, double rotates */
    if (IR&010000) /*CLA*/ L_AC = LINK;
    if (IR&04000)  /*CLL*/ L_AC = AC;
    if (IR&02000)  /*RTL/RTR/SWHA*/ {
      if (IR&014000) FAIL("RTx clash");
      if (IR&030==0) FAIL("No rotation");
      if (IR&030==030) {
        L_AC = LINK+((L_AC>>9)&m9)+((L_AC&m9)<<9);
      } else if (IR&010) {
        t = LINK; L_AC = AC<<1; if (t) L_AC++;
      } else {
        t = L_AC&1; L_AC >>=1; if (t) L_AC += linkbit;
      }
    }
/* Time 3: Complement AC/Link, OAS, rotates */
    if (IR&030) {  /*RAL/RAR/IAC*/
      if (IR&5) FAIL("RAx clash");
      if (IR&030==030) {
        if (pdp15) L_AC = (L_AC+1)&m19;
      } else if (IR&010) {
        t = LINK; L_AC = AC<<1; if (t) L_AC++;
      } else {
        t  = L_AC&1; L_AC >>= 1; if (t) L_AC += linkbit;
      }
    }
    if ((IR&5)==5) FAIL("OAS CMA clash");
    if (IR&4)      /*OAS*/ FAIL("OAS not allowed");
    if (IR&2)      /*CML*/ L_AC ^= linkbit;
    if (IR&1)      /*CMA*/ L_AC ^= m18;
/* Finally: HLT */
    if (IR&040)    /*HLT*/ FAIL("HLT executed");
    TRUE;
  }
}

void cpuloop (void) {
/* Execute instructions until an error occurs */
  do {
    MA = PC; FETCH; INCPC; IR = MD;
  } while (execute(0));
}

#define W1 M[MSIZE-3]
#define W2 M[MSIZE-2]
#define W3 M[MSIZE-1]
#define NP M[010]

enum {PERMCAL=012400,valbit=0200000};
static int trapped[64];
static int NPMIN,NP0;

int primperm (void) {
int i,j,k,p,q,r;

#define FAULT(x) {i = x+0400; goto fault;}

  if ((IR&0777700)!=PERMCAL) FAIL("CAL: *CRASH*");
  W1 = AC; i = IR&077;
  switch (i) {

case 4: /* MONITOR */

    MA = PC; FETCH; i = MD; /* control word: should be 0400
                               +0200? +0100? +fnum&077 */
fault:
    MD = i;
    if (i==0400) FAIL("");  /* %endofprogram silent stop */
    if ((i&0777400)!=0400) FAIL("MONITOR: *CRASH*");
    j = i&63;
    if (trapped[j]) {    /* Is it right to cancel trap? */
      NP = trapped[j]; trapped[j] = 0; PC = M[++NP]; TRUE;
    }
    selectoutput(0);
    if (j) {
      printstring("F A U L T "); iwrite(j,1);
      if (i&0100) iwrite(signextend(W2),1);
      if (i&0200) iwrite(signextend(W1),1);
      newline();
    }
    printstring("Stopped at line"); iwrite(LINENO,1);
    newline(); FAIL("");

case 5: /* NEST */

    if (NP<2048) FAULT(4);
    MA = NP--; if (NP<NPMIN) NPMIN = NP;
    MD = L_AC; WRITE; TRUE;

case 6: /* TEST LE: Set Link iff W2<=AC */

    L_AC = AC;
    if (signextend(W2)<=SAC) L_AC |= linkbit;
    TRUE;

case 7: /* TEST GE: Set Link iff W2>=AC */

    L_AC = AC;
    if (signextend(W2)>=SAC) L_AC |= linkbit;
    TRUE;

case 8: /* AREF */

    W1 = AC; i = SAC;                /* index value */
    MA = PC; FETCH; INCPC; IR = MD;
    if (execute(0)==0) FALSE;        /* LAD instruction */
    MA = L_AC&m15;
    READ; i += SMD;             /* index-UB */
    if (i>0) FAULT(0200+32);
    MA++; READ; i += SMD;       /* index-UB+(N=UB-LB+1) */
    if (i<=0) FAULT(0200+32);
    W3 = i+MA;
    L_AC = W3; TRUE;

case 9: /* ADEC */

    i = signextend(W2);        /* LB */
    W1 = AC; j = SAC;          /* UB */
    k = j-i+1;                 /* N */
    if (k<0) FAULT(0300+28);   /* inside out */
    i = k;
    if (W3==0) i = (i+1)>>1;   /* byte array */
    if (NP-i-2<2048) FAULT(4);
    MD = unassigned;           /* (or use zero) */
    while (i--) {MA = NP--; WRITE;}
    MA = NP--; MD = k; WRITE;  /* N */
    MA = NP--; MD = -j; WRITE; /* -UB */
    if (NP<NPMIN) NPMIN = NP;
    W3 = MA; L_AC = W3; TRUE;

case 10: /* SHIFT LEFT (RIGHT if count negative) */

    i = W2; j = SAC;
    L_AC = i; if (j==0) TRUE;  /* Shift by zero => */
    L_AC = 0;
    if (j<0) {         /* shift right */
      if (j<-17) TRUE; /* by 18 or more => */
      L_AC = i>>(-j);
    } else {           /* shift left */
      if (j>17) TRUE;  /* by 18 or more => */
      L_AC = i<<j;
    }
    L_AC &= m18; TRUE;

case 11: /* OR */

    L_AC = (W2|L_AC)&m18; TRUE;

case 12: /* MULT */

#define iftoobig(x) if ((x)>(signbit-1) || (x)<-signbit)

    W1 = AC; i = signextend(W2)*SAC;
    iftoobig(i) FAULT(0301);
    L_AC = i&m18; TRUE;

case 13: /* INT DIV */

    W1 = AC; j = SAC; if (j==0) FAULT(0302);
    i = signextend(W2);
    L_AC = (i/j)&m18; TRUE;

case 14: /* DIV */

    W1 = AC; j = SAC; if (j==0) FAULT(0302);
    i = signextend(W2);
    if (i%j) FAULT(0312);
    L_AC = (i/j)&m18; TRUE;

case 15: /* EXP */

    W1 = AC; j = SAC;
    if (j<0) FAULT(0300+24);
    if (j==0) {L_AC = 1; TRUE;}
    i = signextend(W2);
    k = 1;
    while (j) {
      if (j&1) {k *= i; iftoobig(k) FAULT(0300+24);}
      i *= i; iftoobig(i) FAULT(0300+24);
      j = j>>1;
    }
    L_AC = k&m18; TRUE;

case 16: /* ENT: Enter/leave dangerous procedure */

    r = M[PC-2];             /* return address */
    if (r == PC-1) {         /* on way out (exit) */
      i = signextend(M[PC]); /* minus no of slots */
      p = i+PC-2;            /* 1st slot (link to frame) */
      q = M[p];              /* pre frame */
      if (q<NP || q>=NP0) FAIL("Corrupt 1");
      PC = M[++q]&m15;       /* stored return address */
      k = M[++q]-q+2+valbit; /* diff to next frame */
      do {
        if (M[p]&valbit) {   /* value */
          M[p] = q+k;
        } else {             /* pointer */
          M[p] = M[q];
          if (M[p]&valbit) FAIL("Corrupt 2");
        }
        p++; q++;
      } while (++i);
      NP = q-1;
    } else {                   /* on way in (entry) */
      M[PC-2] = PC-1;          /* intercept return */
      i = signextend(M[PC++]); /* -slots */
      j = signextend(M[PC++]); /* NP adjustment */
      p = PC+i-4;              /* first slot */
      M[NP] = AC;              /* nest last param if any */
      NP += j;                 /* adjust */
      q = NP+1;                /* pre frame */
      M[q++] = r;              /* store return ad */
      j += 2;
      do {
        if (M[p]&valbit) {     /* value */
          M[p] = q+valbit;
          if (j<0) M[q] = unassigned;
        } else {               /* pointer */
          k = unassigned;
          if (j>=0) k = M[q]&~valbit;
          if (q==NP+2) k = NP;
          M[q] = M[p]; M[p] = k;
        }
        p++; q++; j++;
      } while (++i);
    }
    TRUE;

case 17: /* FLT: Set fault trap */

    INCPC; i = L_AC&63; M[NP--] = PC; trapped[i] = NP;
    INCPC; TRUE;

case 20: /* BAREF */

    W1 = AC; i = SAC;
    MA = PC; FETCH; INCPC; IR = MD;
    if (execute(0)==0) FALSE;
    MA = L_AC&m15;
    READ; i += SMD;
    if (i>0) FAULT(0200+32);
    MA++; READ; i += SMD;
    if (i<=0) FAULT(0200+32);
    MA++; W3 = MA+MA+i;
    L_AC = W3; TRUE;

case 21: /* BGET */

    MA = (L_AC>>1)&m15;
    READ;
    if (L_AC&1) {L_AC = MD;} else L_AC = MD>>9;
    L_AC &= m9;  /* or 0377 */
    TRUE;

case 22: /* BPUT */

    i = L_AC&0777; MA = PC; FETCH; INCPC; IR = MD;
    if (execute(0)==0) FALSE;
    MA = (L_AC>>1)&m15;
    READ;
    if (L_AC&1) {MD = (MD&(m18^m9))+i;}
    else MD = (MD&m9)+(i<<9);
    WRITE; L_AC = i; TRUE;

case 29: /* INTEGER */ W3 = AC; TRUE;

case 30: selectinput(AC); TRUE;

case 31: selectoutput(AC); TRUE;

case 32: MD = readch();
         if (MD<0) FAULT(9);
         MA = L_AC&m15; WRITE; TRUE;

case 33: printch(AC); TRUE;

case 34: i = nextsymbol(); if (i<0) FAULT(9);
         L_AC = i; TRUE;

case 35: MD = readsymbol(); if (MD<0) FAULT(9);
         MA = L_AC&m15; WRITE; TRUE;

case 36: /* SKIPSYMBOL */

    if (readsymbol()<0) FAULT(9); TRUE;

case 37: printsymbol(AC); TRUE;

case 38: /* PRINTTEXT */

    do {
      MA = PC; FETCH; INCPC;
      i = SMD;
      j = (i>>7)&127; if (j) printsymbol(j);
      j = i&127;      if (j) printsymbol(j);
    } while (i>0);
    TRUE;

case 39: newline(); TRUE;

case 40: newlines(AC); TRUE;

case 41: space(); TRUE;

case 42: spaces(AC); TRUE;

case 43: /* READ */

    i = 0; j = 0;
    for (;;) {
      i = nextsymbol(); if (i<0) FAULT(9);
      if (i<=' ') {
        readsymbol();
      } else {
        k = i;
        if (i=='-') {
          readsymbol(); k = nextsymbol();
        } else i = 0;
        if (k<0) FAULT(9);
        if (k<'0' || k>'9') FAULT(14);
        do {
          readsymbol(); j = j*10-'0'+k; k = nextsymbol();
        } while (k>='0' && k<='9');
        if (i=='-') j = -j;
        MD = j;
        MA = L_AC&m15; WRITE; TRUE;
      }
    }

case 44: MA = ++NP; READ; iwrite(SMD,SAC); TRUE;

case 45: closeinput(); TRUE;

case 46: closeoutput(); TRUE;

case 49: L_AC = instream; TRUE;

case 50: L_AC = outstream; TRUE;

case 51: /* INDEV */

    L_AC = 0; if (curin==0) TRUE;
    L_AC = 1; if (curin==stdin) TRUE;
    L_AC = 2; TRUE;

case 52: /* OUTDEV */

    L_AC = 0; if (curout==0) TRUE;
    L_AC = 1; if (curout==stdout) TRUE;
    L_AC = 2; TRUE;

case 53: /* INPUT */

    L_AC = 0; if (curin==stdin) TRUE;
    L_AC = 1; TRUE;

case 54: /* PROMPT */

    if (curin==stdin) fputc(AC,stdout);
    TRUE;

case 55: /* FREESTORE */

    L_AC = (NP-2048)&m18; TRUE;

case 56: /* TINT */

    L_AC = 0; TRUE;

default: FAIL("Missing perm routine");
  }
}

/*  End of Emulator */

/*
   Reverser starts here

   Input consists of nested blocks of interspersed code and
   data. The reverser ex-beds blocks (so compiler does not
   need to plant jumps around nested procedures), and
   gathers the data in each block to the front.

   A single area of store is used as a pair of stacks, one
   for data and one for code.

   The original (machine-code) reverser stored data forwards
   from low addresses and code backwards from high
   addresses, then at the end of each block it copied the
   code backwards to be adjacent to the data (so it was no
   longer reversed).  Then it printed the whole lot out to a
   file backwards.

   On encountering a nested block, the current block's data
   section was copied up (making room for the inner blocks
   to sit in their entirety before (at lower addresses in
   the final core image) the current one), and copied back
   later.

   This version here stores code and data the other way
   round, which has the effect of ending up with the
   reversed file held in a single C string, which can either
   be sent to a file or, as hereinafter, fed straight to the
   loader.
*/

static int sym,lines=0,code=1;
static char *lp=0,*rp;

#define putcode(k) *lp++ = k;
#define getcode    *--lp
#define putdata(k) *--rp = k;
#define getdata    *rp++

void putnum (int n) {
/* Add N to code section in "hex", least sig digit first */
  do {putcode((n&15)+'0'); n = n>>4;} while (n);
}

void reverseblock (void) {
char *p,*lo,*hi;
  lo = lp; hi = rp; putdata('(');
  for (;;) {
    sym = readsymbol(); if (sym<0) fatal("End of file");
    if (rp-lp < 10) fatal("File too big\n");
    if (sym==NL) {
      lines++; if (nextsymbol()=='(') putnum(lines);
      putcode(NL);
    } else if (sym=='(') {
      p = lp; while (rp<hi) {putcode(getdata);}
      reverseblock();
      hi = rp; while (lp>p) putdata(getcode);
    } else if (sym==')') {
      putcode(sym);
      if (nextsymbol()==NL) {
        lines++; putnum(lines); putcode(NL); readsymbol();
      }
      if (rp-lp < lp-lo) fatal("Overlap\n");
      p = lo; while (p<lp) putdata(*p++);
      lp = lo; return;
    } else if (sym=='/') {
      code = 1-code;
    } else if (code) {
      putcode(sym);
    } else {
      putdata(sym);
    }
  }
}

char *reversefile (int bufsize) {
  if (bufsize==0) {free(lp); lp = 0; return;}
  lp = (char *) malloc(bufsize);
  if (lp==0) fatal("No room for reverser buffer");
  rp = lp+bufsize; *--rp = 0;
  reverseblock();
  return rp;
}

/*  End of Reverser  */

/*  Loader starts here  */

enum {litmax=200*2,namemax=50*4};
static int lits[litmax],names[namemax],t[257];
static int litpos=0,namepos=0,tmax,pos,bank,op,name,line=0;
static int i,j,k;
static int num,absnum;
static char *s;
enum {err=0,ign=1,mem=2,non=3,lal=4,lop=5,
      lit=6,tag=7,ent=8,ext=9,end=10,
      imem=mem+indbit};
enum {ada=0000000,dac=0040000,jms=0100000,dzm=0140000,
      lac=0200000,xor=0240000,add=0300000,tad=0340000,
      xct=0400000,isz=0440000,and=0500000,sad=0540000,
      jmp=0600000,eae=0640000,iot=0700000,opr=0740000,
      dad=eae,adr=iot,lad=opr,law=0760000,nop=opr,
      cla=opr+010000};
enum {indflag=0200000,permlim=56};
static int table [0100] = {
ada+mem,  dac+mem,  jms+mem,  dzm+mem,  /* @ABC */
lac+mem,  xor+mem,  add+mem,  tad+mem,  /* DEFG */
xct+mem,  isz+mem,  and+mem,  sad+mem,  /* HIJK */
jmp+mem,  eae+non,  iot+non,  opr+non,  /* LMNO */
adr+mem,  dac+imem, jms+imem, dzm+imem, /* PQRS */
lac+imem, xor+imem, add+imem, tad+imem, /* TUVW */
xct+imem, isz+imem, and+imem, sad+imem, /* XYZ[ */
jmp+imem, dad+mem,  ada+mem,  lad+mem,  /* \]^_ */
err,      ent,      err,      lit,      /*  !"# */
lac+lal,  xor+lop,  add+lop,  tad+lop,  /* $%&' */
ign,      end,      and+lop,  sad+lop,  /* ()*+ */
ext,      err,      tag,      err};     /* ,-./ */

void plant (int k) {
  k &=m18;
  M[pos--] = ((line&07777)<<19)+k;
}

void rpair (void) {
  absnum = 0; num = 0;
  sym = *s; if (sym==0) return;
  num = *++s; if (num==0) return;
  if (num=='-') s++;
  while ((*s&0160)=='0') absnum = (absnum<<4)-'0'+*s++;
  if (num=='-') {num = -absnum;} else num = absnum;
}

int litcode (int num, int pos) {
int p,q;
  num &= m18; pos &= m13;
  if (litpos>=litmax) fatal("Too many literals");
  lits[litpos] = num; lits[litpos+1] = 0;
  p = 0;
  while (lits[p]!=num) p += 2;
  if (p==litpos) litpos += 2;
  p++; q = lits[p]; lits[p] = pos;
  return q;
}

void tagref (void) {
  if (absnum>=256) fatal("Comtab ref");
  if (absnum>=224) return;
  while (tmax<absnum) t[++tmax] = 0;
}

int convert (int pos) {
  if (t[absnum]&indflag) {
    if (op&indbit) fatal("Double indirect");
    if (op==adr) fatal("Addr");
    if (op==lad) {op = lac;}
    else if (op==dad) {op = dac;}
    else if (op==ada) {op = tad;}
    else op ^= indbit;
  } else {
    if (op==lad) return litcode(t[absnum]&m15,pos)+lac;
    if (op==ada) return litcode(t[absnum]&m15,pos)+tad;
    if (op==adr) return t[absnum]&m15;
    if (op==dad) op = dac;
    if (absnum<=permlim) {
      if (absnum<4) return (t[absnum]&m13)+op;
      if (absnum==4) {if (op&indbit) op ^= indbit;}
      if (op!=jms) fatal("Non-JMS perm ref");
      return absnum+PERMCAL;
    }
  }
  return (t[absnum]&m13)+op;
}

void rname (void) {
  if (namepos>=namemax) fatal("Too many external names");
  rpair(); names[namepos++] = num;
  rpair(); names[namepos++] = num;
  rpair(); names[namepos++] = num;
  names[namepos++] = 0;
  name = 0;
  for (;;) {
    if (names[name]==names[namepos-4] &&
        names[name+1]==names[namepos-3] &&
        names[name+2]==names[namepos-2]) break;;
    name += 4;
  }
  if (name==namepos) namepos += 4;
}

int load (char *file) {
  if (PC==0) { /* initial entry */
    pos = m15; bank = pos&bankbits;
    t[3] = pos; plant(1);
    t[2] = pos; plant(0);
    t[1] = pos; plant(0);
    for (tmax=permlim+1; tmax<=256; tmax++) t[tmax] = 0;
    for (tmax=4; tmax<=permlim; tmax++) t[tmax] = pos;
    t[0] = 010; plant(010);
  }
  s = file;
  while (*s) {
    rpair();
    if (sym==NL) {
      line--; if (num) line = num;
      continue;
    }
    i = table[sym&077]; op = i&law;
    switch(i&15) {
case err: fatal("Object file corrupt");
case non: plant(op+num); break;
case lal: if (num==0) {plant(cla); break;}
          if ((num&law)==law) {plant(num); break;}
case lop: plant(op+litcode(num,pos)); break;
case lit: plant(num); break;
case ext: fatal("Externals not supported yet");
case ent: if (num==0) {
            if (PC) fatal("Multiple entry points");
            PC = pos+1;
          } else rname(); break;
case end: if (absnum==0) continue;
          tmax = absnum;
          if (*s==' ') rname();
          break;
case tag: tagref();
          if (*s==' ') {
            i = absnum; rpair(); MA = t[i]+num; READ;
            if (MD != nop) fatal("Switch label set twice");
            MD = (pos&m13)+jmp+1; WRITE;
            break;
          }
          j = t[absnum]; k = pos+1;
          if (num<0) k += indflag;
          t[absnum] = k;
          if (j>0) j = 0;
          j &= m13;
          while (j) {
            i = j+bank;
            j = M[i]; op = j&law;
            k = convert(i);
            M[i] = (j&~m18)+k; j = j&m13;
          }
          break;
case mem: tagref();
          if (num<0 || t[absnum]<=0) {
            if (num<0) {num = 0;} else num = t[absnum]&m13;
            t[absnum] = (pos&m13)+signextend(signbit);
            plant(op+num); break;
          }
          plant(convert(pos));
          break;
    }
  }
  while (litpos>0) {
    litpos -= 2;
    j = lits[litpos+1]&m13;
    while (j) {
      i = j+bank; j = M[i]; op = (j&law)+(pos&m13);
      M[i] = (j&~m18)+op; j &= m13;
    }
    plant(lits[litpos]);
  }
  NP = pos;
}

/*  End of Loader  */

void parsestreams (char *s, char **a) {
int p=1;
  while (*s) {
    if (*s==',') {s++; p++;}
    else {
      if (*s=='0' && s[1]=='-') {s += 2; p = 0;}
      if (p>=8) return;
      a[p] = s;
      do s++; while (*s && *s!=',');
      if (*s) *s++ = 0;
      p++;
    }
  }
}

int main (int argc, char *arg[]) {
char *iname[8],*oname[8],nam[256];
int i;

/* Acquire and initialise PDP memory */

  M = (int *) malloc(MSIZE*4);
  if (M==0) fatal ("No room for PDP memory");
  for (i=0;i<=m15;i++) M[i] = unassigned;

/* Get object file name, open file, load it */

  if (argc<=1) fatal("Args: objfile infiles outfiles");
  strcpy(nam,arg[1]); strcat(nam,".o15");
  openinput(1,nam);
  PC = 0; load(reversefile(50000));
  closeinput(); reversefile(0);

/* Assign input and output streams */

  iname[0] = "t"; iname[1] = "t";
  oname[0] = "t"; oname[1] = "t";
  for (i=2;i<8;i++) iname[i]="n";
  for (i=2;i<8;i++) oname[i]="n";
  if (argc>2) parsestreams(arg[2],iname);
  if (argc>3) parsestreams(arg[3],oname);
  for (i=7;i>=0;i--) openinput(i,iname[i]);
  for (i=7;i>=0;i--) openoutput(i,oname[i]);
  selectinput(1);
  selectoutput(1);

/* Run the program */

  NP0 = NP; NPMIN = NP0; CYCLES=0; cpuloop();

/* That's it.  Diagnostics if necessary */

  if (ERROR) if (*ERROR) {
    fprintf(stderr,
"**%s\nPC:%05o L_AC:%07o IR:%06o Line:%d MA:%05o MD:%06o\n",
            ERROR,PC,L_AC,IR,LINENO,MA,MD);
    fprintf(stderr,"NP:%06o W1:%06o W2:%06o W3:%06o\n",
            NP,W1,W2,W3);
  }
  fprintf(stderr,"code=%d data=%d cycles=%d\n",
          MSIZE-NP0,NP0-NPMIN,CYCLES);
}