sater 40 роки тому
батько
коміт
51243ce443
5 змінених файлів з 2258 додано та 0 видалено
  1. 32 0
      doc/em/int/Makefile
  2. 5 0
      doc/em/int/READ_ME
  3. 1767 0
      doc/em/int/em.p
  4. 210 0
      doc/em/int/emdmp.c
  5. 244 0
      doc/em/int/mktables.c

+ 32 - 0
doc/em/int/Makefile

@@ -0,0 +1,32 @@
+CFLAGS=-O
+HOME=../../..
+
+install \
+all:            em emdmp tables
+
+tables:         mktables $(HOME)/util/ass/ip_spec.t
+		mktables $(HOME)/util/ass/ip_spec.t tables
+
+mktables:       mktables.c $(HOME)/h/em_spec.h $(HOME)/h/em_flag.h \
+		$(HOME)/util/data/em_data.a $(HOME)/util/ass/ip_spec.h
+		cc -O -o mktables mktables.c $(HOME)/util/data/em_data.a
+
+em.out:         em.p
+		apc -mint -O em.p >emerrs ; mv e.out em.out
+
+em:             em.p
+		apc -O -i em.p >emerrs ; mv a.out em
+
+nem.p:          em.p
+		sed -e '/maxadr  = t16/s//maxadr  =t15/' -e '/maxdata = 8191; /s//maxdata = 14335;/' -e '/ adr=.*long/s// adr=    0..maxadr/' <em.p >nem.p
+
+nem:            nem.p
+		apc -O -i nem.p >emerrs ; mv a.out nem
+
+emdmp:          emdmp.c
+		cc -o emdmp -O emdmp.c
+
+cmp:
+
+pr:		
+		@pr em.p mktables.c emdmp.c

+ 5 - 0
doc/em/int/READ_ME

@@ -0,0 +1,5 @@
+This interpreter is meant for inclusion in the EM manual.
+Although slow, it showed decent behaviour on several tests.
+The only monitor calls implemented are exit, read(untested),
+write and ioctl - just reurns the correct code for telling it's
+a terminal -

+ 1767 - 0
doc/em/int/em.p

@@ -0,0 +1,1767 @@
+#
+{ This  is an interpreter for EM.  It serves as a specification for the
+  EM machine.  This interpreter must run on a machine which supports
+  arithmetic with words and memory offsets.
+
+  Certain aspects are over specified.  In particular:
+
+    1. The representation of  an  address on the stack  need not be the
+       numerical value of the memory location.
+
+    2. The state of  the stack is not defined  after a trap has aborted
+       an instruction in the middle.  For example, it is officially un-
+       defined  whether the second  operand of an  ADD  instruction has
+       been popped  or  not  if the  first one is undefined ( -32768 or
+       unsigned 32768).
+
+    3. The memory layout is implementation dependent. Only the most
+       basic checks are performed whenever memory is accessed.
+
+    4. The representation of an integer or set on the stack is not fixed
+       in bit order.
+
+    5. The format and existence of the procedure descriptors depends on
+       the implementation.
+
+    6. The result of the compare operators  CMI etc.  are -1, 0  and  1
+       here, but other negative  and  positive values will do  and they
+       need not be the same each time.
+
+    7. The shift count for SHL, SHR, ROL and ROR must be in the range 0
+       to object size in bits - 1.  The effect of a  count  not in this
+       range is undefined.
+
+    8. This interpreter does not work for double word integers, although
+       any decent EM implementation will include double word arithmetic.
+									}
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+{$i256}
+{$d+}
+#ifndef DOC
+program em(tables,prog,core,input,output);
+#else
+program em(tables,prog,input,output);
+#endif
+
+
+label 8888,9999;
+
+const
+  t15   = 32768;        { 2**15    }
+  t15m1 = 32767;        { 2**15 -1 }
+  t16   = 65536;        { 2**16    }
+  t16m1 = 65535;        { 2**16 -1 }
+  t31m1 = 2147483647;   { 2**31 -1 }
+
+  { constants indicating the size of words and addresses }
+  wsize = 2;            { number of bytes in a word }
+  asize = 2;            { number of bytes in an address }
+  fsize = 4;            { number of bytes in a floating point number }
+  maxret =4;            { number of words in the return value area }
+
+  signbit = t15;        { the power of two indicating the sign bit }
+  negoff  = t16;        { the next power of two }
+  maxsint = t15m1;      { the maximum signed integer }
+  maxuint = t16m1;      { the maximum unsigned integer }
+  maxdbl  = t31m1;      { the maximum double signed integer }
+  maxadr  = t16m1;      { the maximum address }
+  maxoffs = t15m1;      { the maximum offset from an address }
+  maxbitnr= 15;         { the number of the highest bit }
+
+  lineadr = 0;          { address of the line number }
+  fileadr = 4;          { address of the file name }
+  maxcode = 8191;       { highest byte in code address space }
+  maxdata = 8191;       { highest byte in data address space }
+
+  { format of status save area }
+  statd   = 4;          { how far is static link from lb }
+  dynd    = 2;          { how far is dynamic link from lb }
+  reta    = 0;          { how far is the return address from lb }
+  savsize = 4;          { size of save area in bytes }
+
+  { procedure descriptor format }
+  pdlocs  = 0;          { offset for size of local variables in bytes }
+  pdbase  = asize;      { offset for the procedure base }
+  pdsize  = 4;          { size of procedure descriptor in bytes = 2*asize }
+
+  { header words }
+  NTEXT   = 1;
+  NDATA   = 2;
+  NPROC   = 3;
+  ENTRY   = 4;
+  NLINE   = 5;
+  SZDATA  = 6;
+
+  escape1 = 254;        { escape to secondary opcodes }
+  escape2 = 255;        { escape to tertiary opcodes }
+  undef   = signbit;    { the range of integers is -32767 to +32767 }
+
+  { error codes }
+  EARRAY   =  0; ERANGE   =  1; ESET     =  2; EIOVFL   =  3;
+  EFOVFL   =  4; EFUNFL   =  5; EIDIVZ   =  6; EFDIVZ   =  7;
+  EIUND    =  8; EFUND    =  9; ECONV    = 10; ESTACK   = 16;
+  EHEAP    = 17; EILLINS  = 18; EODDZ    = 19; ECASE    = 20;
+  EMEMFLT  = 21; EBADPTR  = 22; EBADPC   = 23; EBADLAE  = 24;
+  EBADMON  = 25; EBADLIN  = 26; EBADGTO  = 27;
+{
+.ne 20
+.bp
+----------------------------------------------------------------------------}
+{                             Declarations                                  }
+{---------------------------------------------------------------------------}
+
+type
+  bitval= 0..1;             { one bit }
+  bitnr=  0..maxbitnr;      { bits in machine words are numbered 0 to 15 }
+  byte=   0..255;           { memory is an array of bytes }
+  adr=    {0..maxadr} long; { the range of addresses }
+  word=   {0..maxuint} long;{ the range of unsigned integers }
+  offs=  -maxoffs..maxoffs; { the range of signed offsets from addresses }
+  size=   0..maxoffs;       { the range of sizes is the positive offsets }
+  sword= {-signbit..maxsint} long; { the range of signed integers }
+  full=  {-maxuint..maxuint} long; { intermediate results need this range }
+  double={-maxdbl..maxdbl} long;   { double precision range }
+  bftype= (andf,iorf,xorf); { tells which boolean operator needed }
+  insclass=(prim,second,tert); { tells which opcode table is in use }
+  instype=(implic,explic);  { does opcode have implicit or explicit operand }
+  iflags= (mini,short,sbit,wbit,zbit,ibit);
+  ifset=  set of iflags;
+
+  mnem = ( NON,
+	   AAR, ADF, ADI, ADP, ADS, ADU,XAND, ASP, ASS, BEQ,
+	   BGE, BGT, BLE, BLM, BLS, BLT, BNE, BRA, CAI, CAL,
+	   CFF, CFI, CFU, CIF, CII, CIU, CMF, CMI, CMP, CMS,
+	   CMU, COM, CSA, CSB, CUF, CUI, CUU, DCH, DEC, DEE,
+	   DEL, DUP, DUS, DVF, DVI, DVU, EXG, FEF, FIF, FIL,
+	   GTO, INC, INE, INL, INN, IOR, LAE, LAL, LAR, LDC,
+	   LDE, LDF, LDL, LFR, LIL, LIM, LIN, LNI, LOC, LOE,
+	   LOF, LOI, LOL, LOR, LOS, LPB, LPI, LXA, LXL, MLF,
+	   MLI, MLU, MON, NGF, NGI, NOP, RCK, RET, RMI, RMU,
+	   ROL, ROR, RTT, SAR, SBF, SBI, SBS, SBU, SDE, SDF,
+	   SDL,XSET, SIG, SIL, SIM, SLI, SLU, SRI, SRU, STE,
+	   STF, STI, STL, STR, STS, TEQ, TGE, TGT, TLE, TLT,
+	   TNE, TRP, XOR, ZEQ, ZER, ZGE, ZGT, ZLE, ZLT, ZNE,
+	   ZRE, ZRF, ZRL);
+
+  dispatch = record
+		iflag: ifset;
+		instr: mnem;
+		case instype of
+		implic: (implicit:sword);
+		explic: (ilength:byte);
+	     end;
+
+
+var
+  code: packed array[0..maxcode] of byte;      { code space }
+  data: packed array[0..maxdata] of byte;      { data space }
+  retarea: array[1..maxret ] of word;          { return area }
+  pc,lb,sp,hp,pd: adr;  { internal machine registers }
+  i: integer;           { integer scratch variable }
+  s,t :word;            { scratch variables }
+  sz:size;              { scratch variables }
+  ss,st: sword;         { scratch variables }
+  k :double;            { scratch variables }
+  j:size;               { scratch variable used as index }
+  a,b:adr;              { scratch variable used for addresses }
+  dt,ds:double;         { scratch variables for double precision }
+  rt,rs,x,y:real;       { scratch variables for real }
+  found:boolean;        { scratch }
+  opcode: byte;         { holds the opcode during execution }
+  iclass: insclass;     { true for escaped opcodes }
+  dispat: array[insclass,byte] of dispatch;
+  retsize:size;         { holds size of last LFR }
+  insr: mnem;           { holds the instructionnumber }
+  halted: boolean;      { normally false }
+  exitstatus:word;      { parameter of MON 1 }
+  ignmask:word;         { ignore mask for traps }
+  uerrorproc:adr;       { number of user defined error procedure }
+  intrap:boolean;       { Set when executing trap(), to catch recursive calls}
+  trapval:byte;         { Set to number of last trap }
+  header: array[1..8] of adr;
+
+  tables: text;         { description of EM instructions }
+  prog: file of byte;   { program and initialized data }
+#ifndef DOC
+  core: file of byte;   { post mortem dump }
+#endif
+{
+.ne 20
+.sp 5
+{---------------------------------------------------------------------------}
+{                        Various check routines                             }
+{---------------------------------------------------------------------------}
+
+{ Only the most basic checks are performed. These routines are inherently
+  implementation dependent. }
+
+procedure trap(n:byte); forward;
+#ifndef DOC
+procedure writecore(n:byte); forward;
+#endif
+
+procedure memadr(a:adr);
+begin if (a>maxdata) or ((a<sp) and (a>=hp)) then trap(EMEMFLT) end;
+
+procedure wordadr(a:adr);
+begin memadr(a); if (a mod wsize<>0) then trap(EBADPTR) end;
+
+procedure chkadr(a:adr; s:size);
+begin memadr(a); memadr(a+s-1); { assumption: size is ok }
+      if s<wsize
+      then begin if a mod s<>0  then trap(EBADPTR) end
+      else       if a mod wsize<>0 then trap(EBADPTR)
+end;
+
+procedure newpc(a:double);
+begin if (a<0) or (a>maxcode) then trap(EBADPC); pc:=a end;
+
+procedure newsp(a:adr);
+begin if (a>lb) or (a<hp) or (a mod wsize<>0) then trap(ESTACK); sp:=a end;
+
+procedure newlb(a:adr);
+begin if (a<sp) or (a mod wsize<>0) then trap(ESTACK); lb:=a end;
+
+procedure newhp(a:adr);
+begin if (a>sp) or (a>maxdata+1) or (a mod wsize<>0)
+      then trap(EHEAP); hp:=a
+end;
+
+function argc(a:double):sword;
+begin if (a<-signbit) or (a>maxsint) then trap(EILLINS); argc:=a end;
+
+function argd(a:double):double;
+begin if (a<-maxdbl) or (a>maxdbl) then trap(EILLINS); argd:=a end;
+
+function argl(a:double):offs;
+begin if (a<-maxoffs) or (a>maxoffs) then trap(EILLINS); argl:=a end;
+
+function argg(k:double):adr;
+begin if (k<0) or (k>maxadr) then trap(EILLINS); argg:=k end;
+
+function argf(a:double):offs;
+begin if (a<-maxoffs) or (a>maxoffs) then trap(EILLINS); argf:=a end;
+
+function argn(a:double):word;
+begin if (a<0) or (a>maxuint) then trap(EILLINS); argn:=a end;
+
+function args(a:double):size;
+begin if (a<=0) or (a>maxoffs)
+	then trap(EODDZ)
+	else if (a mod wsize)<>0 then trap(EODDZ);
+      args:=a ;
+end;
+
+function argz(a:double):size;
+begin if (a<0) or (a>maxoffs)
+	then trap(EODDZ)
+	else if (a mod wsize)<>0 then trap(EODDZ);
+      argz:=a ;
+end;
+
+function argo(a:double):size;
+begin if (a<0) or (a>maxoffs)
+	then trap(EODDZ)
+	else if (a mod wsize<>0) and (wsize mod a<>0) then trap(EODDZ);
+      argo:=a ;
+end;
+
+function argw(a:double):size;
+begin if (a<=0) or (a>maxoffs) or (a>maxuint)
+	then trap(EODDZ)
+	else if (a mod wsize)<>0 then trap(EODDZ);
+      argw:=a ;
+end;
+
+function argp(a:double):size;
+begin if (a<0) or (a>=header[NPROC]) then trap(EILLINS); argp:=a end;
+
+function argr(a:double):word;
+begin if (a<0) or (a>2) then trap(EILLINS); argr:=a end;
+
+procedure argwf(s:double);
+begin if argw(s)<>fsize then trap(EILLINS) end;
+
+function szindex(s:double):integer;
+begin s:=argw(s); if (s mod wsize <> 0) or (s>2*wsize) then trap(EILLINS);
+      szindex:=s div wsize
+end;
+
+function locadr(l:double):adr;
+begin l:=argl(l); if l<0 then locadr:=lb+l else locadr:=lb+l+savsize end;
+
+function signwd(w:word):sword;
+begin if w = undef then trap(EIUND);
+      if w >= signbit then signwd:=w-negoff else signwd:=w
+end;
+
+function dosign(w:word):sword;
+begin if w >= signbit then dosign:=w-negoff else dosign:=w end;
+
+function unsign(w:sword):word;
+begin if w<0 then unsign:=w+negoff else unsign:=w end;
+
+function chopw(dw:double):word;
+begin chopw:=dw mod negoff end;
+
+function fitsw(w:full;trapno:byte):word;
+{ checks whether value fits in signed word, returns unsigned representation}
+begin
+  if (w>maxsint) or (w<-signbit) then
+    begin trap(trapno);
+      if w<0 then fitsw:=negoff- (-w)mod negoff
+	     else fitsw:=w mod negoff;
+    end
+  else fitsw:=unsign(w)
+end;
+
+function fitd(w:full):double;
+begin
+  if abs(w) > maxdbl then trap(ECONV);
+  fitd:=w
+end;
+
+{
+.ne 20
+.sp 5
+{---------------------------------------------------------------------------}
+{                        Memory access routines                             }
+{---------------------------------------------------------------------------}
+
+{ memw returns a machine word as an unsigned integer
+  memb returns a single byte as a positive integer: 0 <= memb <= 255
+  mems(a,s) fetches an object smaller than a word and returns a word
+  store(a,v) stores the word v at machine address a
+  storea(a,v) stores the address v at machine address a
+  storeb(a,b) stores the byte b at machine address a
+  stores(a,s,v) stores the s least significant bytes of a word at address a
+  memi returns an offset from the instruction space
+       Note that the procedure descriptors are part of instruction space.
+  nextpc returns the next byte addressed by pc, incrementing pc
+
+  lino changes the line number word.
+  filna changes the pointer to the file name.
+
+  All routines check to make sure the address is within range and valid for
+  the size of the object. If an addressing error is found, a trap occurs.
+}
+
+
+function memw(a:adr):word;
+var b:word; i:integer;
+begin wordadr(a); b:=0;
+      for i:=wsize-1 downto 0 do b:=256*b + data[a+i] ;
+      memw:=b
+end;
+
+function memd(a:adr):double; { Always signed }
+var b:double; i:integer;
+begin wordadr(a); b:=data[a+2*wsize-1];
+      if b>=128 then b:=b-256;
+      for i:=2*wsize-2 downto 0 do b:=256*b + data[a+i] ;
+      memd:=b
+end;
+
+function mema(a:adr):adr;
+var b:adr; i:integer;
+begin wordadr(a); b:=0;
+      for i:=asize-1 downto 0 do b:=256*b + data[a+i] ;
+      mema:=b
+end;
+
+function mems(a:adr;s:size):word;
+var i:integer; b:word;
+begin chkadr(a,s); b:=0; for i:=1 to s do b:=b*256+data[a+s-i]; mems:=b end;
+
+function memb(a:adr):byte;
+begin memadr(a); memb:=data[a] end;
+
+procedure store(a:adr; x:word);
+var i:integer;
+begin wordadr(a);
+  for i:=0 to wsize-1 do
+     begin data[a+i]:=x mod 256; x:=x div 256 end
+end;
+
+procedure storea(a:adr; x:adr);
+var i:integer;
+begin wordadr(a);
+  for i:=0 to asize-1 do
+     begin data[a+i]:=x mod 256; x:=x div 256 end
+end;
+
+procedure stores(a:adr;s:size;v:word);
+var i:integer;
+begin chkadr(a,s);
+  for i:=0 to s-1 do begin data[a+i]:=v mod 256; v:=v div 256 end;
+end;
+
+procedure storeb(a:adr; b:byte);
+begin memadr(a); data[a]:=b end;
+
+function memi(a:adr):adr;
+var b:adr; i:integer;
+begin if (a mod wsize<>0) or (a+asize-1>maxcode) then trap(EBADPTR); b:=0;
+      for i:=asize-1 downto 0 do b:=256*b + code[a+i] ;
+      memi:=b
+end;
+
+function nextpc:byte;
+begin if pc>=pd then trap(EBADPC); nextpc:=code[pc]; newpc(pc+1) end;
+
+procedure lino(w:word);
+begin store(lineadr,w) end;
+
+procedure filna(a:adr);
+begin storea(fileadr,a) end;
+{
+.ne 20
+.sp 5
+{---------------------------------------------------------------------------}
+{                    Stack Manipulation Routines                            }
+{---------------------------------------------------------------------------}
+
+{ push puts a word on the stack
+  pushsw takes a signed one word integer and pushes it on the stack
+  pop removes a machine word from the stack and delivers it as a word
+  popsw removes a machine word from the stack and delivers a signed integer
+  pusha pushes an address on the stack
+  popa removes a machine word from the stack and delivers it as an address
+  pushd pushes a double precision number on the stack
+  popd removes two machine words and returns a double precision integer
+  pushr pushes a float (floating point) number on the stack
+  popr removes several machine words and returns a float number
+  pushx puts an object of arbitrary size on the stack
+  popx removes an object of arbitrary size
+									  }
+
+procedure push(x:word);
+begin newsp(sp-wsize); store(sp,x) end;
+
+procedure pushsw(x:sword);
+begin newsp(sp-wsize); store(sp,unsign(x)) end;
+
+function pop:word;
+begin pop:=memw(sp); newsp(sp+wsize) end;
+
+function popsw:sword;
+begin popsw:=signwd(pop) end;
+
+procedure pusha(x:adr);
+begin newsp(sp-asize); storea(sp,x) end;
+
+function popa:adr;
+begin popa:=mema(sp); newsp(sp+asize) end;
+
+procedure pushd(y:double);
+begin { push double integer onto the stack } newsp(sp-2*wsize) end;
+
+function popd:double;
+begin { pop double integer from the stack } newsp(sp+2*wsize); popd:=0 end;
+
+procedure pushr(z:real);
+begin { Push a float onto the stack } newsp(sp-fsize) end;
+
+function popr:real;
+begin { pop float from the stack } newsp(sp+fsize); popr:=0.0 end;
+
+procedure pushx(objsize:size; a:adr);
+var i:integer;
+begin
+  if objsize<wsize
+     then push(mems(a,objsize))
+     else for i:=1 to objsize div wsize do push(memw(a+objsize-wsize*i))
+end;
+
+procedure popx(objsize:size; a:adr);
+var i:integer;
+begin
+  if objsize<wsize
+     then stores(a,objsize,pop)
+     else for i:=1 to objsize div wsize do store(a-wsize+wsize*i,pop)
+end;
+{
+.ne 20
+.sp 5
+{---------------------------------------------------------------------------}
+{              Bit manipulation routines (extract, shift, rotate)           }
+{---------------------------------------------------------------------------}
+
+procedure sleft(var w:sword);  { 1 bit left shift   }
+begin w:= dosign(fitsw(2*w,EIOVFL)) end;
+
+procedure suleft(var w:word);  { 1 bit left shift   }
+begin w := chopw(2*w) end;
+
+procedure sdleft(var d:double);  { 1 bit left shift   }
+begin { shift two word signed integer } end;
+
+procedure sright(var w:sword);  { 1 bit right shift with sign extension }
+begin if w >= 0 then w := w div 2 else w := (w-1) div 2 end;
+
+procedure suright(var w:word);    { 1 bit right shift without sign extension }
+begin w := w div 2 end;
+
+procedure sdright(var d:double);  { 1 bit right shift   }
+begin { shift two word signed integer } end;
+
+procedure rleft(var w:word);  { 1 bit left rotate }
+begin if w >= t15
+	then w:=(w-t15)*2 + 1
+	else w:=w*2
+end;
+
+procedure rright(var w:word);  { 1 bit right rotate }
+begin if w mod 2 = 1
+	then w:=w div 2 + t15
+	else w:=w div 2
+end;
+
+function sextend(w:word;s:size):word;
+var i:size;
+begin
+  for i:=1 to (wsize-s)*8 do rleft(w);
+  for i:=1 to (wsize-s)*8 do sright(w);
+  sextend:=w;
+end;
+
+function bit(b:bitnr; w:word):bitval; { return bit b of the word w }
+var i:bitnr;
+begin for i:= 1 to b do rright(w); bit:= w mod 2 end;
+
+function bf(ty:bftype; w1,w2:word):word;  { return boolean fcn of 2 words }
+var i:bitnr; j:word;
+begin j:=0;
+      for i:= maxbitnr downto 0 do
+	begin j := 2*j;
+	      case ty of
+		andf: if bit(i,w1)+bit(i,w2) = 2 then j:=j+1;
+		iorf: if bit(i,w1)+bit(i,w2) > 0 then j:=j+1;
+		xorf: if bit(i,w1)+bit(i,w2) = 1 then j:=j+1
+	      end
+	end;
+      bf:=j
+end;
+
+{---------------------------------------------------------------------------}
+{                           Array indexing
+{---------------------------------------------------------------------------}
+
+function arraycalc(c:adr):adr; { subscript calculation }
+var j:full; objsize:size; a:adr;
+begin j:= popsw - signwd(memw(c));
+  if (j<0) or (j>memw(c+wsize)) then trap(EARRAY);
+  objsize := argo(memw(c+wsize+wsize));
+  a := j*objsize+popa; chkadr(a,objsize);
+  arraycalc:=a
+end;
+{
+.ne 20
+.sp 5
+{---------------------------------------------------------------------------}
+{                       Double and Real Arithmetic                          }
+{---------------------------------------------------------------------------}
+
+{ All routines for doubles and floats are dummy routines, since the format of
+  doubles and floats is not defined in EM.
+}
+
+function doadi(ds,dt:double):double;
+begin { add two doubles } doadi:=0 end;
+
+function dosbi(ds,dt:double):double;
+begin { subtract two doubles } dosbi:=0 end;
+
+function domli(ds,dt:double):double;
+begin { multiply two doubles } domli:=0 end;
+
+function dodvi(ds,dt:double):double;
+begin { divide two doubles } dodvi:=0 end;
+
+function dormi(ds,dt:double):double;
+begin { modulo of two doubles } dormi:=0 end;
+
+function dongi(ds:double):double;
+begin { negative of a double } dongi:=0 end;
+
+function doadf(x,y:real):real;
+begin { add two floats } doadf:=0.0 end;
+
+function dosbf(x,y:real):real;
+begin { subtract two floats } dosbf:=0.0 end;
+
+function domlf(x,y:real):real;
+begin { multiply two floats } domlf:=0.0 end;
+
+function dodvf(x,y:real):real;
+begin { divide two floats } dodvf:=0.0 end;
+
+function dongf(x:real):real;
+begin { negate a float } dongf:=0.0 end;
+
+procedure dofif(x,y:real;var intpart,fraction:real);
+begin { dismember x*y into integer and fractional parts }
+  intpart:=0.0;  { integer part of x*y, same sign as x*y }
+  fraction:=0.0;
+	{ fractional part of x*y, 0<=abs(fraction)<1 and same sign as x*y }
+end;
+
+procedure dofef(x:real;var mantissa:real;var exponent:sword);
+begin { dismember x into mantissa and exponent parts }
+  mantissa:=0.0;  { mantissa of x , >= 1/2 and <1 }
+  exponent:=0;    { base 2 exponent of x }
+end;
+
+{
+.ne 20
+.sp 5
+.bp
+{---------------------------------------------------------------------------}
+{                            Trap and Call                                  }
+{---------------------------------------------------------------------------}
+
+procedure call(p:adr); { Perform the call }
+begin
+  pusha(lb);pusha(pc);
+  newlb(sp);newsp(sp - memi(pd + pdsize*p + pdlocs));
+  newpc(memi(pd + pdsize*p+ pdbase))
+end;
+
+procedure dotrap(n:byte);
+var i:size;
+begin
+  if (uerrorproc=0) or intrap then
+    begin
+      if intrap then
+	writeln('Recursive trap, first trap number was ', trapval:1);
+      writeln('Error ', n:1);
+      writeln('With',ord(insr):4,' arg ',k:1);
+#ifndef DOC
+      writecore(n);
+#endif
+      goto 9999
+    end;
+  { Deposit all interpreter variables that need to be saved on
+    the stack. This includes all scratch variables that can
+    be in use at the moment and ( not possible in this interpreter )
+    the internal address of the interpreter where the error occurred.
+    This would make it possible to execute an RTT instruction totally
+    transparent to the user program.
+    It can, for example, occur within an ADD instruction that both
+    operands are undefined and that the result overflows.
+    Although this will generate 3 error traps it must be possible
+    to ignore them all.
+
+    }
+  intrap:=true; trapval:=n;
+  for i:=retsize div wsize downto 1 do push(retarea[i]);
+  push(retsize);              { saved return area }
+  pusha(mema(fileadr));       { saved current file name pointer }
+  push(memw(lineadr));        { saved line number }
+  push(n);                    { push error number }
+  a:=argp(uerrorproc);
+  uerrorproc:=0;              { reset signal }
+  call(a);                    { call the routine }
+  intrap:=false;              { Don't catch recursive traps anymore }
+  goto 8888;                  { reenter main loop }
+end;
+
+procedure trap;
+{ This routine is invoked for overflow, and other run time errors.
+  For non-fatal errors, trap returns to the calling routine
+}
+begin
+  if n>=16 then dotrap(n) else if bit(n,ignmask)=0 then dotrap(n);
+end;
+
+procedure dortt;
+{ The restoration of file address and line number is not essential.
+  The restoration of the return save area is.
+}
+var i:size;
+    n:word;
+begin
+  newsp(lb); lb:=maxdata+1 ; { to circumvent ESTACK for the popa + pop }
+  newpc(popa); newlb(popa); { So far a plain RET 0 }
+  n:=pop; if (n>=16) and (n<64) then
+  begin
+#ifndef DOC
+	writecore(n);
+#endif
+	goto 9999
+  end;
+  lino(pop); filna(popa); retsize:=pop;
+  for i:=1 to retsize div wsize do retarea[i]:=pop ;
+end;
+{
+.sp 5
+{---------------------------------------------------------------------------}
+{                              monitor calls                                }
+{---------------------------------------------------------------------------}
+
+
+procedure domon(entry:word);
+var     index:  1..63;
+	dummy:  double;
+	count,rwptr:    adr;
+	token:  byte;
+	i:      integer;
+begin
+  if (entry<=0) or (entry>63) then entry:=63 ;
+  index:=entry;
+  case index of
+   1: begin { exit } exitstatus:=pop; halted:=true end;
+   3: begin { read }  dummy:=pop; { All input is from stdin }
+	rwptr:=popa; count:=popa;
+	i:=0 ;
+	while (not eof(input)) and (i<count) do
+	begin
+	  if eoln(input) then begin storeb(rwptr,10) ; count:=i end
+			 else storeb(rwptr,ord(input^)) ;
+	  get(input); rwptr:=rwptr+1 ; i:=i+1 ;
+	end;
+	pusha(i); push(0)
+      end;
+   4: begin { write } dummy:=pop; { All output is to stdout }
+	rwptr:=popa; count:=popa;
+	for i:=1 to count do
+	  begin token:=memb(rwptr); rwptr:=rwptr+1 ;
+	    if token=10 then writeln else write(chr(token))
+	  end ;
+	pusha(count);
+	push(0)
+      end;
+  54: begin { ioctl, faked } dummy:=popa;dummy:=popa;dummy:=pop;push(0) end ;
+       2,          5,  6,  7,  8,  9, 10,
+  11, 12, 13, 14, 15, 16, 17, 18, 19, 20,
+  21, 22, 23, 24, 25, 26, 27, 28, 29, 30,
+  31, 32, 33, 34, 35, 36, 37, 38, 39, 40,
+  41, 42, 43, 44, 45, 46, 47, 48, 49, 50,
+  51, 52, 53,     55, 56, 57, 58, 59, 60,
+  61, 62:
+      begin push(22); push(22) end;
+  63: { exists only for the trap }
+      trap(EBADMON)
+  end
+end;
+{
+.bp
+{---------------------------------------------------------------------------}
+{                       Initialization and debugging                        }
+{---------------------------------------------------------------------------}
+
+procedure doident; { print line number and file name }
+var a:adr; i,c:integer; found:boolean;
+begin
+  write('at line ',memw(lineadr):1,' ');
+  a:=mema(fileadr); if a<>0 then
+  begin i:=20; found:=false;
+    while (i<>0) and not found do
+    begin c:=memb(a); a:=a+1; found:=true; i:=i-1;
+      if (c>=48) and (c<=57) then
+	begin found:=false; write(chr(ord('0')+c-48)) end;
+      if (c>=65) and (c<=90) then
+	begin found:=false; write(chr(ord('A')+c-65)) end;
+      if (c>=97) and (c<=122) then
+	begin found:=false; write(chr(ord('a')+c-97)) end;
+    end;
+  end;
+  writeln;
+end;
+
+#ifndef DOC
+{---------------------------------------------------------------------------}
+{                              Post Mortem Dump                             }
+{                                                                           }
+{This a not a part of the machine definition, but an ad hoc debugging method}
+{---------------------------------------------------------------------------}
+
+procedure writecore;
+var ncoreb,i:integer;
+
+procedure wrbyte(b:byte);
+begin write(core,b); ncoreb:=ncoreb+1 end;
+
+procedure wradr(a:adr);
+var i:integer;
+begin for i:=1 to asize do begin wrbyte(a mod 256); a:=a div 256 end end;
+
+begin
+  rewrite(core); ncoreb:=0;
+  wrbyte(173); wrbyte(16);      { Magic }
+  wrbyte(3);wrbyte(0);          { Version }
+  wrbyte(wsize);wrbyte(0);      { Wordsize }
+  wrbyte(asize);wrbyte(0);      { Address size }
+  wradr(0);                     { Text size in dump }
+  wradr(maxdata+1);             { Data size in dump }
+  wradr(ignmask);
+  wradr(uerrorproc);
+  wradr(n);                     { Cause }
+  wradr(pc); wradr(sp); wradr(lb); wradr(hp); wradr(pd); wradr(0){pb} ;
+  while ncoreb<>512 do wradr(0); { Fill }
+  for i:=0 to maxdata do wrbyte(data[i])
+end;
+
+#endif
+
+procedure initialize;  { start the ball rolling }
+{ This is not part of the machine definition }
+var cset:set of char;
+    f:ifset;
+    iclass:insclass;
+    insno:byte;
+    nops:integer;
+    opcode:byte;
+    i,j,n:integer;
+    wtemp:sword;
+    count:integer;
+    repc:adr;
+    nexta,firsta:adr;
+    elem:byte;
+    amount,ofst:size;
+    c:char;
+
+    function readb(n:integer):double;
+    var b:byte;
+    begin read(prog,b); if n>1 then readb:=readb(n-1)*256+b else readb:=b end;
+
+    function readbyte:byte;
+    begin readbyte:=readb(1) end;
+
+    function readword:word;
+    begin readword:=readb(wsize) end;
+
+    function readadr:adr;
+    begin readadr:=readb(asize) end;
+
+    function ifind(ordinal:byte):mnem;
+    var loopvar:mnem;
+	found:boolean;
+    begin ifind:=NON;
+      loopvar:=insr; found:=false;
+      repeat
+	if ordinal=ord(loopvar) then
+	  begin found:=true; ifind:=loopvar end;
+	if loopvar<>ZRL then loopvar:=succ(loopvar) else loopvar:=NON;
+      until found or (loopvar=insr) ;
+   end;
+
+    procedure readhdr;
+    type hdrw=0..32767 ; { 16 bit header words }
+    var  hdr: hdrw;
+	 i: integer;
+    begin
+      for i:=0 to 7 do
+      begin hdr:=readb(2);
+	case i of
+	0: if hdr<>3757 then { 07255 }
+	   begin writeln('Not an em load file'); halt end;
+	2: if hdr<>0 then
+	   begin writeln('Unsolved references'); halt end;
+	3: if hdr<>3 then
+	   begin writeln('Incorrect load file version'); halt end;
+	4: if hdr<>wsize then
+	   begin writeln('Incorrect word size'); halt end;
+	5: if hdr<>asize then
+	   begin writeln('Incorrect pointer size'); halt end;
+	1,6,7:;
+	end
+      end
+    end;
+
+    procedure noinit;
+    begin writeln('Illegal initialization'); halt end;
+
+    procedure readint(a:adr;s:size);
+    var i:size;
+    begin { construct integer out of byte sequence }
+      for i:=1 to s do { construct the value and initialize at a }
+	begin storeb(a,readbyte); a:=a+1 end
+    end;
+
+    procedure readuns(a:adr;s:size);
+    begin { construct unsigned out of byte sequence }
+      readint(a,s) { identical to readint }
+    end;
+
+    procedure readfloat(a:adr;s:size);
+    var i:size; b:byte;
+    begin { construct float out of string}
+      if (s<>4) and (s<>8) then noinit; i:=0;
+      repeat { eat the bytes, construct the value and intialize at a }
+	b:=readbyte; i:=i+1;
+      until b=0 ;
+    end;
+
+begin
+  halted:=false;
+  exitstatus:=undef;
+  uerrorproc:=0; intrap:=false;
+
+  { initialize tables }
+  for i:=0 to maxcode do code[i]:=0;
+  for i:=0 to maxdata do data[i]:=0;
+  for iclass:=prim to tert do
+    for i:=0 to 255 do
+      with dispat[iclass][i] do
+	begin instr:=NON; iflag:=[zbit] end;
+
+  { read instruction table file. see appendix B }
+  { The table read here is a simple transformation of the table on page xx }
+  { - instruction names were transformed to numbers }
+  { - the '-' flag was transformed to an 'i' flag for 'w' type instructions }
+  { - the 'S' flag was added for instructions having signed operands }
+  reset(tables);
+  insr:=NON;
+  repeat
+    read(tables,insno) ; cset:=[]; f:=[];
+    insr:=ifind(insno);
+    if insr=NON then begin writeln('Incorrect table'); halt end;
+    repeat read(tables,c) until c<>' ' ;
+    repeat
+      cset:=cset+[c];
+      read(tables,c)
+    until c=' ' ;
+    if 'm' in cset then f:=f+[mini];
+    if 's' in cset then f:=f+[short];
+    if '-' in cset then f:=f+[zbit];
+    if 'i' in cset then f:=f+[ibit];
+    if 'S' in cset then f:=f+[sbit];
+    if 'w' in cset then f:=f+[wbit];
+    if (mini in f) or (short in f) then read(tables,nops) else nops:=1 ;
+    readln(tables,opcode);
+    if ('4' in cset) or ('8' in cset) then
+      begin iclass:=tert end
+    else if 'e' in cset then
+      begin iclass:=second end
+    else iclass:=prim;
+    for i:=0 to nops-1 do
+    begin
+      with dispat[iclass,opcode+i] do
+      begin
+	iflag:=f; instr:=insr;
+	if '2' in cset      then ilength:=2
+	else if '4' in cset then ilength:=4
+	else if '8' in cset then ilength:=8
+	else if (mini in f) or (short in f) then
+	  begin
+	    if 'N' in cset then wtemp:=-1-i else wtemp:=i ;
+	    if 'o' in cset then wtemp:=wtemp+1 ;
+	    if short in f then wtemp:=wtemp*256 ;
+	    implicit:=wtemp
+	  end
+      end
+    end
+  until eof(tables);
+
+  { read in program text, data and procedure descriptors }
+  reset(prog);
+  readhdr;                               { verify first header }
+  for i:=1 to 8 do header[i]:=readadr;  { read second header }
+  hp:=maxdata+1; sp:=maxdata+1; lino(0);
+  { read program text }
+  if header[NTEXT]+header[NPROC]*pdsize>maxcode then
+    begin writeln('Text size too large'); halt end;
+  if header[SZDATA]>maxdata then
+    begin writeln('Data size too large'); halt end;
+  for i:=0 to header[NTEXT]-1 do code[i]:=readbyte;
+  { read data blocks }
+  nexta:=0;
+  for i:=1 to header[NDATA] do
+    begin
+      n:=readbyte;
+      if n<>0 then
+	begin
+	  elem:=readbyte; firsta:=nexta;
+	  case n of
+	  1: { uninitialized words }
+	     for j:=1 to elem do
+	     begin store(nexta,undef); nexta:=nexta+wsize end;
+	  2: { initialized bytes }
+	     for j:=1 to elem do
+	     begin storeb(nexta,readbyte); nexta:=nexta+1 end;
+	  3: { initialized words }
+	     for j:=1 to elem do
+	     begin store(nexta,readword); nexta:=nexta+wsize end;
+	  4,5: { instruction and data pointers }
+	     for j:=1 to elem do
+	     begin storea(nexta,readadr); nexta:=nexta+asize end;
+	  6: { signed integers }
+	     begin readint(nexta,elem); nexta:=nexta+elem end;
+	  7: { unsigned integers }
+	     begin readuns(nexta,elem); nexta:=nexta+elem end;
+	  8: { floating point numbers }
+	     begin readfloat(nexta,elem); nexta:=nexta+elem end;
+	  end
+	end
+      else
+	begin
+	  repc:=readadr;
+	  amount:=nexta-firsta;
+	  for count:=1 to repc do
+	  begin
+	    for ofst:=0 to amount-1 do data[nexta+ofst]:=data[firsta+ofst];
+	    nexta:=nexta+amount;
+	  end
+	end
+    end;
+  if header[SZDATA]<>nexta then writeln('Data initialization error');
+  hp:=nexta;
+  { read descriptor table }
+  pd:=header[NTEXT];
+  for i:=1 to header[NPROC]*pdsize do code[pd+i-1]:=readbyte;
+  { call the entry point routine }
+  ignmask:=0;	   { catch all traps, higher numbered traps cannot be ignored}
+  retsize:=0;
+  lb:=maxdata;     { illegal dynamic link }
+  pc:=maxcode;     { illegal return address }
+  push(0); a:=sp;  { No environment }
+  push(0); b:=sp;  { No args }
+  pusha(a);        { envp }
+  pusha(b);        { argv }
+  push(0);         { argc }
+  call(argp(header[ENTRY]));
+end;
+{
+.bp
+{---------------------------------------------------------------------------}
+{                       MAIN LOOP OF THE INTERPRETER                        }
+{---------------------------------------------------------------------------}
+{ It should be noted that the interpreter (microprogram) for  an  EM
+  machine  can be written in two fundamentally different ways: (1) the
+  instruction operands are fetched in the main loop, or  (2)  the  in-
+  struction operands are fetched after the 256 way branch, by the exe-
+  cution routines themselves.  In this interpreter, method (1) is used
+  to  simplify  the  description  of execution  routines. The dispatch
+  table dispat is used to determine how the operand is  encoded. There
+  are 4 possibilities:
+
+     0. There is no operand
+     1. The operand and  instruction are  together in 1  byte (mini)
+     2. The operand is  one byte long and follows the opcode byte(s)
+     3. The operand is two bytes long and follows the opcode byte(s)
+     4. The operand is four bytes long and follows the opcode byte(s)
+
+  In  this  interpreter,  the  main  loop determines the operand type,
+  fetches it, and leaves it in the global variable k for the execution
+  routines  to use.  Consequently, instructions such as LOL, which use
+  three different formats, need only be described once in the body  of
+  the interpreter.
+      However, for  a  production  interpreter,  or  a  hardware  EM
+  machine,  it  is  probably better to use method (2), i.e. to let the
+  execution routines themselves fetch their own operands.  The  reason
+  for this is that each opcode uniquely determines the operand format,
+  so no table lookup in the dispatch table is needed.  The whole table
+  is not needed. Method (2) therefore executes much faster.
+      However, separate execution routines will be needed for LOL with
+  a one byte offset,  and  LOL with a two byte offset.  It is to avoid
+  this additional clutter that method (1) is used here.  In a  produc-
+  tion interpreter, it is envisioned that the main loop will fetch the
+  next instruction byte, and use it as an index into a 256 word  table
+  to  find  the  address  of  the interpreter routine to jump to.  The
+  routine jumped to will  begin  by  fetching  its  operand,  if  any,
+  without  any  table  lookup,  since it knows which format to expect.
+  After doing the work, it returns to the main  loop  by  jumping  in-
+  directly  to  a register that contains the address of the main loop.
+      A slight variation on this idea is to have the  register contain
+  the address of the branch table, rather than the address of the main
+  loop.
+      Another  issue  is whether the execution routines for LOL 0, LOL
+  2, LOL 4, etc. should all be have distinct execution routines. Doing
+  so  provides for the maximum speed, since the operand is implicit in
+  the routine itself.  The disadvantage is that many nearly  identical
+  execution  routines will then be needed.  Another way of doing it is
+  to keep the instruction byte fetched from memory (LOL 0, LOL 2,  LOL
+  4, etc.) in some register, and have all the LOL mini format instruc-
+  tions branch to a common routine.  This routine can  then  determine
+  the  operand  by  subtracting  the code for LOL 0 from the register,
+  leaving the true operand in the register  (as  a  word  quantity  of
+  course).   This  method  makes the interpreter smaller, but is a bit
+  slower.
+.bp
+       To make this important point a little clearer, consider how a
+  production interpreter for the PDP-11 might appear.  Let us assume the
+  following opcodes have been assigned:
+
+       31: LOL -2     (2 bytes, i.e. next word)
+       32: LOL -4
+       33: LOL -6
+       34: LOL b      (format with a one byte offset)
+       35: LOL w      (format with a one word, i.e. two byte offset)
+
+  Further assume that each of the 5 opcodes will have its own execution
+  routine, i.e. we are making a tradeoff in favor of fast execution and
+  a slightly larger interpreter.
+       Register r5 is the em program counter.
+       Register r4 is the em LB register
+       Register r3 is the em SP register (the stack grows toward low core)
+       Register r2 contains the interpreter address of the main loop
+
+  The main loop looks like this:
+
+       movb (r5)+,r0           /fetch the opcode into r0 and increment r5
+       asl r0                  /shift r0 left 1 bit. Now: -256<=r0<=+254
+       jmp *table(r0)          /jump to execution routine
+
+  Notice that no operand fetching has been done. The execution routines for
+  the 5 sample instructions given above might be as follows:
+
+  lol2: mov -2(r4),-(sp)       /push local -2 onto stack
+	jmp (r2)               /go back to main loop
+  lol4: mov -4(r4),-(sp)       /push local -4 onto stack
+	jmp (r2)               /go back to main loop
+  lol6: mov -6(r4),-(sp)       /push local -6 onto stack
+	jmp (r2)               /go back to main loop
+  lolb: mov $177400,r0         /prepare to fetch the 1 byte operand
+	bisb (r5)+,r0          /operand is now in r0
+	asl r0                 /r0 is now offset from LB in bytes, not words
+	add r4,r0              /r0 is now address of the needed local
+	mov (r0),-(sp)         /push the local onto the stack
+	jmp (r2)
+  lolw: clr r0                 /prepare to fetch the 2 byte operand
+	bisb (r5)+,r0          /fetch high order byte first !!!
+	swab r0                /insert high order byte in place
+	bisb (r5)+,r0          /insert low order byte in place
+	asl r0                 /convert offset to bytes, from words
+	add r4,r0              /r0 is now address of needed local
+	mov (r0),-(sp)         /stack the local
+	jmp (r2)               /done
+
+  The important thing to notice is where and how the operand fetch occurred:
+       lol2, lol4, and lol6, (the mini's) have implicit operands
+       lolb knew it had to fetch one byte, and did so without any table lookup
+       lolw knew it had to fetch a word, and did so, high order byte first }
+{
+.bp
+.sp 4
+{---------------------------------------------------------------------------}
+{           Routines for the individual instructions                        }
+{---------------------------------------------------------------------------}
+procedure loadops;
+var j:integer;
+begin
+  case insr of
+    { LOAD GROUP }
+    LDC: pushd(argd(k));
+    LOC: pushsw(argc(k));
+    LOL: push(memw(locadr(k)));
+    LOE: push(memw(argg(k)));
+    LIL: push(memw(mema(locadr(k))));
+    LOF: push(memw(popa+argf(k)));
+    LAL: pusha(locadr(k));
+    LAE: pusha(argg(k));
+    LXL: begin a:=lb; for j:=1 to argn(k) do a:=mema(a+savsize); pusha(a) end;
+    LXA: begin a:=lb;
+	   for j:=1 to argn(k) do a:= mema(a+savsize);
+	   pusha(a+savsize)
+	 end;
+    LOI: pushx(argo(k),popa);
+    LOS: begin k:=argw(k); if k<>wsize then trap(EILLINS);
+	   k:=pop; pushx(argo(k),popa)
+	 end;
+    LDL: begin a:=locadr(k); push(memw(a+wsize)); push(memw(a)) end;
+    LDE: begin k:=argg(k); push(memw(k+wsize)); push(memw(k)) end;
+    LDF: begin k:=argf(k);
+	   a:=popa; push(memw(a+k+wsize)); push(memw(a+k))
+	 end;
+    LPI: push(argp(k))
+  end
+end;
+
+procedure storeops;
+begin
+  case insr of
+    { STORE GROUP }
+    STL: store(locadr(k),pop);
+    STE: store(argg(k),pop);
+    SIL: store(mema(locadr(k)),pop);
+    STF: begin a:=popa; store(a+argf(k),pop) end;
+    STI: popx(argo(k),popa);
+    STS: begin k:=argw(k); if k<>wsize then trap(EILLINS);
+	   k:=popa; popx(argo(k),popa)
+	 end;
+    SDL: begin a:=locadr(k); store(a,pop); store(a+wsize,pop) end;
+    SDE: begin k:=argg(k); store(k,pop); store(k+wsize,pop) end;
+    SDF: begin k:=argf(k); a:=popa; store(a+k,pop); store(a+k+wsize,pop) end
+  end
+end;
+
+procedure intarith;
+var i:integer;
+begin
+  case insr of
+    { SIGNED INTEGER ARITHMETIC }
+    ADI: case szindex(argw(k)) of
+	 1: begin st:=popsw; ss:=popsw; push(fitsw(ss+st,EIOVFL)) end;
+	 2: begin dt:=popd; ds:=popd; pushd(doadi(ds,dt)) end;
+	 end ;
+    SBI: case szindex(argw(k)) of
+	 1: begin st:=popsw; ss:= popsw; push(fitsw(ss-st,EIOVFL)) end;
+	 2: begin dt:=popd; ds:=popd; pushd(dosbi(ds,dt)) end;
+	 end ;
+    MLI: case szindex(argw(k)) of
+	 1: begin st:=popsw; ss:= popsw; push(fitsw(ss*st,EIOVFL)) end;
+	 2: begin dt:=popd; ds:=popd; pushd(domli(ds,dt)) end;
+	 end ;
+    DVI: case szindex(argw(k)) of
+	 1: begin st:= popsw; ss:= popsw;
+	       if st=0 then trap(EIDIVZ) else pushsw(ss div st)
+	    end;
+	 2: begin dt:=popd; ds:=popd; pushd(dodvi(ds,dt)) end;
+	 end;
+    RMI: case szindex(argw(k)) of
+	 1: begin st:= popsw; ss:=popsw;
+	       if st=0 then trap(EIDIVZ) else pushsw(ss - (ss div st)*st)
+	    end;
+	 2: begin dt:=popd; ds:=popd; pushd(dormi(ds,dt)) end
+	 end;
+    NGI: case szindex(argw(k)) of
+	 1: begin st:=popsw; pushsw(-st) end;
+	 2: begin ds:=popd; pushd(dongi(ds)) end
+	 end;
+    SLI: begin t:=pop;
+	   case szindex(argw(k)) of
+	   1: begin ss:=popsw;
+		 for i:= 1 to t do sleft(ss); pushsw(ss)
+	      end
+	   end
+	 end;
+    SRI: begin t:=pop;
+	   case szindex(argw(k)) of
+	   1: begin ss:=popsw;
+		 for i:= 1 to t do sright(ss); pushsw(ss)
+	      end;
+	   2: begin ds:=popd;
+		 for i:= 1 to t do sdright(ss); pushd(ss)
+	      end
+	   end
+	 end
+  end
+end;
+
+procedure unsarith;
+var i:integer;
+begin
+  case insr of
+    { UNSIGNED INTEGER ARITHMETIC }
+    ADU: case szindex(argw(k)) of
+	 1: begin t:=pop; s:= pop; push(chopw(s+t)) end;
+	 2: trap(EILLINS);
+	 end ;
+    SBU: case szindex(argw(k)) of
+	 1: begin t:=pop; s:= pop; push(chopw(s-t)) end;
+	 2: trap(EILLINS);
+	 end ;
+    MLU: case szindex(argw(k)) of
+	 1: begin t:=pop; s:= pop; push(chopw(s*t)) end;
+	 2: trap(EILLINS);
+	 end ;
+    DVU: case szindex(argw(k)) of
+	 1: begin t:= pop; s:= pop;
+	       if t=0 then trap(EIDIVZ) else push(s div t)
+	    end;
+	 2: trap(EILLINS);
+	 end;
+    RMU: case szindex(argw(k)) of
+	 1: begin t:= pop; s:=pop;
+	       if t=0 then trap(EIDIVZ) else push(s - (s div t)*t)
+	    end;
+	 2: trap(EILLINS);
+	 end;
+    SLU: case szindex(argw(k)) of
+	 1: begin t:=pop; s:=pop;
+	       for i:= 1 to t do suleft(s); push(s)
+	    end;
+	 2: trap(EILLINS);
+	 end;
+    SRU: case szindex(argw(k)) of
+	 1: begin t:=pop; s:=pop;
+	       for i:= 1 to t do suright(s); push(s)
+	    end;
+	 2: trap(EILLINS);
+	 end
+  end
+end;
+
+procedure fltarith;
+begin
+  case insr of
+    { FLOATING POINT ARITHMETIC }
+    ADF: begin argwf(k); rt:=popr; rs:=popr; pushr(doadf(rs,rt)) end;
+    SBF: begin argwf(k); rt:=popr; rs:=popr; pushr(dosbf(rs,rt)) end;
+    MLF: begin argwf(k); rt:=popr; rs:=popr; pushr(domlf(rs,rt)) end;
+    DVF: begin argwf(k); rt:=popr; rs:=popr; pushr(dodvf(rs,rt)) end;
+    NGF: begin argwf(k); rt:=popr; pushr(dongf(rt)) end;
+    FIF: begin argwf(k); rt:=popr; rs:=popr;
+	       dofif(rt,rs,x,y); pushr(y); pushr(x)
+	 end;
+    FEF: begin argwf(k); rt:=popr; dofef(rt,x,ss); pushr(x); pushsw(ss) end
+  end
+end;
+
+procedure ptrarith;
+begin
+  case insr of
+    { POINTER ARITHMETIC }
+    ADP: pusha(popa+argf(k));
+    ADS: case szindex(argw(k)) of
+	 1: begin st:=popsw; pusha(popa+st) end;
+	 2: begin dt:=popd; pusha(popa+dt) end;
+	 end;
+    SBS: begin
+	   a:=popa; b:=popa;
+	   case szindex(argw(k)) of
+	     1: push(fitsw(b-a,EIOVFL));
+	     2: pushd(b-a)
+	   end
+	 end
+  end
+end;
+
+procedure incops;
+var j:integer;
+begin
+  case insr of
+    { INCREMENT/DECREMENT/ZERO }
+    INC: push(fitsw(popsw+1,EIOVFL));
+    INL: begin a:=locadr(k); store(a,fitsw(signwd(memw(a))+1,EIOVFL)) end;
+    INE: begin a:=argg(k); store(a,fitsw(signwd(memw(a))+1,EIOVFL)) end;
+    DEC: push(fitsw(popsw-1,EIOVFL));
+    DEL: begin a:=locadr(k); store(a,fitsw(signwd(memw(a))-1,EIOVFL)) end;
+    DEE: begin a:=argg(k); store(a,fitsw(signwd(memw(a))-1,EIOVFL)) end;
+    ZRL: store(locadr(k),0);
+    ZRE: store(argg(k),0);
+    ZER: for j:=1 to argw(k) div wsize do push(0);
+    ZRF: pushr(0);
+  end
+end;
+
+procedure convops;
+begin
+  case insr of
+    { CONVERT GROUP }
+    CII: begin s:=pop; t:=pop;
+	   if t<wsize then begin push(sextend(pop,t)); t:=wsize end;
+	   case szindex(argw(t)) of
+	   1: if szindex(argw(s))=2 then pushd(popsw);
+	   2: if szindex(argw(s))=1 then push(fitsw(popd,ECONV))
+	   end
+	 end;
+    CIU: case szindex(argw(pop)) of
+	 1: if szindex(argw(pop))=2 then push(unsign(popd mod negoff));
+	 2: trap(EILLINS);
+	 end;
+    CIF: begin argwf(pop);
+	   case szindex(argw(pop)) of 1:pushr(popsw); 2:pushr(popd) end
+	 end;
+    CUI: case szindex(argw(pop)) of
+	 1: case szindex(argw(pop)) of
+	    1: begin s:=pop; if s>maxsint then trap(ECONV); push(s) end;
+	    2: trap(EILLINS);
+	    end;
+	 2: case szindex(argw(pop)) of
+	    1: pushd(pop);
+	    2: trap(EILLINS);
+	    end;
+	 end;
+    CUU: case szindex(argw(pop)) of
+	 1: if szindex(argw(pop))=2 then trap(EILLINS);
+	 2: trap(EILLINS);
+	 end;
+    CUF: begin argwf(pop);
+	   if szindex(argw(pop))=1 then pushr(pop) else trap(EILLINS)
+	 end;
+    CFI: begin sz:=argw(pop); argwf(pop); rt:=popr;
+	   case szindex(sz) of
+	   1: push(fitsw(trunc(rt),ECONV));
+	   2: pushd(fitd(trunc(rt)));
+	   end
+	 end;
+    CFU: begin sz:=argw(pop); argwf(pop); rt:=popr;
+	   case szindex(sz) of
+	   1: push( chopw(trunc(abs(rt)-0.5)) );
+	   2: trap(EILLINS);
+	   end
+	 end;
+    CFF: begin argwf(pop); argwf(pop) end
+  end
+end;
+
+procedure logops;
+var i,j:integer;
+begin
+  case insr of
+    { LOGICAL GROUP }
+    XAND:
+	 begin k:=argw(k);
+	   for j:= 1 to k div wsize do
+	     begin a:=sp+k; t:=pop; store(a,bf(andf,memw(a),t)) end;
+	 end;
+    IOR:
+	 begin k:=argw(k);
+	   for j:= 1 to k div wsize do
+	     begin a:=sp+k; t:=pop; store(a,bf(iorf,memw(a),t)) end;
+	 end;
+    XOR:
+	 begin k:=argw(k);
+	   for j:= 1 to k div wsize do
+	     begin a:=sp+k; t:=pop; store(a,bf(xorf,memw(a),t)) end;
+	 end;
+    COM:
+	 begin k:=argw(k);
+	   for j:= 1 to k div wsize do
+	     begin
+	       store(sp+k-wsize*j, bf(xorf,memw(sp+k-wsize*j), negoff-1))
+	     end
+	 end;
+    ROL: begin k:=argw(k); if k<>wsize then trap(EILLINS);
+	   t:=pop; s:=pop; for i:= 1 to t do rleft(s); push(s)
+	 end;
+    ROR: begin k:=argw(k); if k<>wsize then trap(EILLINS);
+	   t:=pop; s:=pop; for i:= 1 to t do rright(s); push(s)
+	 end
+  end
+end;
+
+procedure setops;
+var i,j:integer;
+begin
+  case insr of
+    { SET GROUP }
+    INN:
+	 begin k:=argw(k);
+	   t:=pop;
+	   i:= t mod 8; t:= t div 8;
+	   if t>=k then
+	     begin trap(ESET); s:=0 end
+	   else
+	     begin s:=memb(sp+t) end;
+	   newsp(sp+k); push(bit(i,s));
+	 end;
+    XSET:
+	 begin k:=argw(k);
+	   t:=pop;
+	   i:= t mod 8; t:= t div 8;
+	   for j:= 1 to k div wsize do push(0);
+	   if t>=k then
+	     trap(ESET)
+	   else
+	     begin s:=1; for j:= 1 to i do rleft(s); storeb(sp+t,s) end
+	 end
+  end
+end;
+
+procedure arrops;
+begin
+  case insr of
+    { ARRAY GROUP }
+    LAR:
+	 begin k:=argw(k); if k<>wsize then trap(EILLINS); a:=popa;
+	   pushx(argo(memw(a+2*k)),arraycalc(a))
+	 end;
+    SAR:
+	 begin k:=argw(k); if k<>wsize then trap(EILLINS); a:=popa;
+	   popx(argo(memw(a+2*k)),arraycalc(a))
+	 end;
+    AAR:
+	 begin k:=argw(k); if k<>wsize then trap(EILLINS); a:=popa;
+	   push(arraycalc(a))
+	 end
+  end
+end;
+
+procedure cmpops;
+begin
+  case insr of
+    { COMPARE GROUP }
+    CMI: case szindex(argw(k)) of
+	 1: begin st:=popsw; ss:=popsw;
+	      if ss<st then pushsw(-1) else if ss=st then push(0) else push(1)
+	    end;
+	 2: begin dt:=popd; ds:=popd;
+	      if ds<dt then pushsw(-1) else if ds=dt then push(0) else push(1)
+	    end;
+	 end;
+    CMU: case szindex(argw(k)) of
+	 1: begin t:=pop; s:=pop;
+	      if s<t then pushsw(-1) else if s=t then push(0) else push(1)
+	    end;
+	 2: trap(EILLINS);
+	 end;
+    CMP: begin a:=popa; b:=popa;
+	  if b<a then pushsw(-1) else if b=a then push(0) else push(1)
+	 end;
+    CMF: begin argwf(k); rt:=popr; rs:=popr;
+	   if rs<rt then pushsw(-1) else if rs=rt then push(0) else push(1)
+	 end;
+    CMS: begin k:=argw(k);
+	   t:= 0; j:= 0;
+	   while (j < k) and (t=0) do
+	     begin if memw(sp+j) <> memw(sp+k+j) then t:=1;
+	       j:=j+wsize
+	     end;
+	   newsp(sp+wsize*k); push(t);
+	 end;
+
+    TLT: if popsw <  0 then push(1) else push(0);
+    TLE: if popsw <= 0 then push(1) else push(0);
+    TEQ: if pop   =  0 then push(1) else push(0);
+    TNE: if pop   <> 0 then push(1) else push(0);
+    TGE: if popsw >= 0 then push(1) else push(0);
+    TGT: if popsw >  0 then push(1) else push(0);
+  end
+end;
+
+procedure branchops;
+begin
+  case insr of
+    { BRANCH GROUP }
+    BRA: newpc(pc+k);
+
+    BLT: begin st:=popsw; if popsw <  st then newpc(pc+k) end;
+    BLE: begin st:=popsw; if popsw <= st then newpc(pc+k) end;
+    BEQ: begin t :=pop  ; if pop   =   t then newpc(pc+k) end;
+    BNE: begin t :=pop  ; if pop   <>  t then newpc(pc+k) end;
+    BGE: begin st:=popsw; if popsw >= st then newpc(pc+k) end;
+    BGT: begin st:=popsw; if popsw >  st then newpc(pc+k) end;
+
+    ZLT: if popsw <  0 then newpc(pc+k);
+    ZLE: if popsw <= 0 then newpc(pc+k);
+    ZEQ: if pop   =  0 then newpc(pc+k);
+    ZNE: if pop   <> 0 then newpc(pc+k);
+    ZGE: if popsw >= 0 then newpc(pc+k);
+    ZGT: if popsw >  0 then newpc(pc+k)
+  end
+end;
+
+procedure callops;
+var j:integer;
+begin
+  case insr of
+    { PROCEDURE CALL GROUP }
+    CAL: call(argp(k));
+    CAI: begin call(argp(popa)) end;
+    RET: begin k:=argz(k); if k div wsize>maxret  then trap(EILLINS);
+	   for j:= 1 to k div wsize do retarea[j]:=pop; retsize:=k;
+	   newsp(lb); lb:=maxdata+1; { To circumvent stack overflow error }
+	   newpc(popa);
+	   if pc=maxcode then
+	   begin
+	     halted:=true;
+	     if retsize=wsize then exitstatus:=retarea[1]
+	       else exitstatus:=undef
+	  end
+	  else
+	     newlb(popa);
+	 end;
+    LFR: begin k:=args(k); if k<>retsize then trap(EILLINS);
+	   for j:=k div wsize downto 1 do push(retarea[j]);
+	 end
+  end
+end;
+
+procedure miscops;
+var i,j:integer;
+begin
+  case insr of
+    { MISCELLANEOUS GROUP }
+    ASP,ASS:
+	 begin if insr=ASS then
+	   begin k:=argw(k); if k<>wsize then trap(EILLINS); k:=popsw end;
+	   k:=argf(k);
+	   if k<0
+	     then for j:= 1 to -k div wsize do push(undef)
+	     else newsp(sp+k);
+	 end;
+    BLM,BLS:
+	 begin if insr=BLS then
+	   begin k:=argw(k); if k<>wsize then trap(EILLINS); k:=pop end;
+	   k:=argz(k);
+	   b:=popa; a:=popa;
+	   for j := 1 to k div wsize do
+	     store(b-wsize+wsize*j,memw(a-wsize+wsize*j))
+	 end;
+    CSA: begin k:=argw(k); if k<>wsize then trap(EILLINS);
+	   a:=popa;
+	   st:= popsw - signwd(memw(a+asize)); b:=0;
+	   if (st>=0) and (st<=memw(a+wsize+asize)) then
+	      b:=mema(a+2*wsize+asize+asize*st);
+	   if b=0 then b:=mema(a);
+	   if b=0 then trap(ECASE) else newpc(b)
+	 end;
+    CSB: begin k:=argw(k); if k<>wsize then trap(EILLINS); a:=popa;
+	   t:=pop; i:=1; found:=false;
+	   while (i<=memw(a+asize)) and not found do
+	     if t=memw(a+(asize+wsize)*i) then found:=true else i:=i+1;
+	   if found then b:=memw(a+(asize+wsize)*i+wsize) else b:=memw(a);
+	   if b=0 then trap(ECASE) else newpc(b);
+	 end;
+    DCH: begin pusha(mema(popa+dynd)) end;
+    DUP,DUS:
+	 begin if insr=DUS then
+	      begin k:=argw(k); if k<>wsize then trap(EILLINS); k:=pop end;
+	   k:=args(k);
+	   for i:=1 to k div wsize do push(memw(sp+k-wsize));
+	 end;
+    EXG: begin
+	   k:=argw(k);
+	   for i:=1 to k div wsize do push(memw(sp+k-wsize));
+	   for i:=0 to k div wsize - 1 do
+	     store(sp+k+i*wsize,memw(sp+k+k+i*wsize));
+	   for i:=1 to k div wsize do
+	   begin t:=pop ; store(sp+k+k-wsize,t) end;
+	 end;
+    FIL: filna(argg(k));
+    GTO: begin k:=argg(k);
+	   newlb(mema(k+2*asize)); newsp(mema(k+asize)); newpc(mema(k))
+	 end;
+    LIM: push(ignmask);
+    LIN: lino(argn(k));
+    LNI: lino(memw(0)+1);
+    LOR: begin i:=argr(k);
+	   case i of 0:pusha(lb); 1:pusha(sp); 2:pusha(hp) end;
+	 end;
+    LPB: pusha(popa+statd);
+    MON: domon(pop);
+    NOP: writeln('NOP at line ',memw(0):5) ;
+    RCK: begin a:=popa;
+	   case szindex(argw(k)) of
+	   1: if (signwd(memw(sp))<signwd(memw(a))) or
+		(signwd(memw(sp))>signwd(memw(a+wsize))) then trap(ERANGE);
+	   2: if (memd(sp)<memd(a)) or
+		(memd(sp)>memd(a+2*wsize)) then trap(ERANGE);
+	   end
+	 end;
+    RTT: dortt;
+    SIG: begin a:=popa; pusha(uerrorproc); uerrorproc:=a end;
+    SIM: ignmask:=pop;
+    STR: begin i:=argr(k);
+	   case i of 0: newlb(popa); 1: newsp(popa); 2: newhp(popa) end;
+	 end;
+    TRP: trap(pop)
+  end
+end;
+{
+.bp
+{---------------------------------------------------------------------------}
+{                               Main Loop                                   }
+{---------------------------------------------------------------------------}
+
+begin initialize;
+8888:
+  repeat
+    opcode := nextpc;       { fetch the first byte of the instruction }
+    if opcode=escape1 then iclass:=second
+    else if opcode=escape2 then iclass:=tert
+    else iclass:=prim;
+    if iclass<>prim then opcode := nextpc;
+    with dispat[iclass][opcode] do
+      begin insr:=instr;
+	if not (zbit in iflag) then
+	  if ibit in iflag then k:=pop else
+	    begin
+	      if mini in iflag then k:=implicit else
+		begin
+		  if short in iflag then k:=implicit+nextpc else
+		    begin k:=nextpc;
+		      if (sbit in iflag) and (k>=128) then k:=k-256;
+		      for i:=2 to ilength do k:=256*k + nextpc
+		    end
+		end;
+	      if wbit in iflag then k:=k*wsize;
+	    end
+      end;
+case insr of
+
+  NON: trap(EILLINS);
+
+  { LOAD GROUP }
+  LDC,LOC,LOL,LOE,LIL,LOF,LAL,LAE,LXL,LXA,LOI,LOS,LDL,LDE,LDF,LPI:
+      loadops;
+
+  { STORE GROUP }
+  STL,STE,SIL,STF,STI,STS,SDL,SDE,SDF:
+      storeops;
+
+  { SIGNED INTEGER ARITHMETIC }
+  ADI,SBI,MLI,DVI,RMI,NGI,SLI,SRI:
+      intarith;
+
+  { UNSIGNED INTEGER ARITHMETIC }
+  ADU,SBU,MLU,DVU,RMU,SLU,SRU:
+      unsarith;
+
+  { FLOATING POINT ARITHMETIC }
+  ADF,SBF,MLF,DVF,NGF,FIF,FEF:
+      fltarith;
+
+  { POINTER ARITHMETIC }
+  ADP,ADS,SBS:
+      ptrarith;
+
+  { INCREMENT/DECREMENT/ZERO }
+  INC,INL,INE,DEC,DEL,DEE,ZRL,ZRE,ZER,ZRF:
+      incops;
+
+  { CONVERT GROUP }
+  CII,CIU,CIF,CUI,CUU,CUF,CFI,CFU,CFF:
+      convops;
+
+  { LOGICAL GROUP }
+ XAND,IOR,XOR,COM,ROL,ROR:
+      logops;
+
+  { SET GROUP }
+  INN,XSET:
+      setops;
+
+  { ARRAY GROUP }
+  LAR,SAR,AAR:
+      arrops;
+
+  { COMPARE GROUP }
+  CMI,CMU,CMP,CMF,CMS,  TLT,TLE,TEQ,TNE,TGE,TGT:
+      cmpops;
+
+  { BRANCH GROUP }
+  BRA,  BLT,BLE,BEQ,BNE,BGE,BGT,  ZLT,ZLE,ZEQ,ZNE,ZGE,ZGT:
+      branchops;
+
+  { PROCEDURE CALL GROUP }
+  CAL,CAI,RET,LFR:
+      callops;
+
+  { MISCELLANEOUS GROUP }
+  ASP,ASS,BLM,BLS,CSA,CSB,DCH,DUP,DUS,EXG,FIL,GTO,LIM,
+  LIN,LNI,LOR,LPB,MON,NOP,RCK,RTT,SIG,SIM,STR,TRP:
+      miscops;
+
+    end;        { end of case statement }
+    if not ( (insr=RET) or (insr=ASP) or (insr=BRA) or (insr=GTO) ) then
+	retsize:=0 ;
+  until halted;
+9999:
+  writeln('halt with exit status: ',exitstatus:1);
+  doident;
+end.

+ 210 - 0
doc/em/int/emdmp.c

@@ -0,0 +1,210 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/* Author: E.G. Keizer */
+
+/* Print a readable version of the data in the post mortem dump */
+/* dmpc [-s] [-dn,m] [file] */
+
+#include "/usr/em/h/local.h"
+#include <stdio.h>
+#include <ctype.h>
+
+int dflag = 0 ;
+long l_low,l_high;
+
+int sflag;
+
+int wsize,asize;
+long tsize,dsize;
+long ignmask,uerrorproc,cause;
+long pc,sp,lb,hp,pd,pb;
+
+char *cstr[] = {
+	"Array bound error",
+	"Range bound error",
+	"Set error",
+	"Integer overflow",
+	"Float overflow",
+	"Float underflow",
+	"Divide by 0",
+	"Divide by 0.0",
+	"Integer undefined",
+	"Float undefined",
+	"Conversion error",
+	"User error 11",
+	"User error 12",
+	"User error 13",
+	"User error 14",
+	"User error 15",
+	"Stack overflow",
+	"Heap overflow",
+	"Illegal instruction",
+	"Illegal size parameter",
+	"Case error",
+	"Memory fault",
+	"Illegal pointer",
+	"Illegal pc",
+	"Bad argument of LAE",
+	"Bad monitor call",
+	"Bad line number",
+	"GTO descriptor error"
+};
+
+FILE *fcore;
+char *core = "core" ;
+int nbyte=0;
+
+char *pname;
+
+int readbyte();
+int read2();
+long readaddr();
+long readword();
+unsigned getbyte();
+long getword();
+long getaddr();
+
+main(argc,argv) char **argv;
+{
+	register i ;
+	long line,fileaddr;
+	char tok ;
+
+	scanargs(argc,argv); fcore=fopen(core,"r") ;
+	if ( fcore==NULL ) fatal("Can't open %s",core) ;
+
+	if ( read2()!=010255 ) fatal("not a post mortem dump");
+	if ( read2()!=VERSION ) fatal("wrong version dump file");
+	wsize=read2(); asize=read2();
+	if ( wsize>4 ) fatal("cannot handle word size %d",wsize) ;
+	if ( asize>4 ) fatal("cannot handle pointer size %d",asize) ;
+	tsize=readaddr(); dsize=readaddr();
+	ignmask=readaddr(); uerrorproc=readaddr(); cause=readaddr();
+	pc=readaddr(); sp=readaddr(); lb=readaddr(); hp=readaddr();
+	pd=readaddr(); pb=readaddr();
+	if ( sflag==0 ) {
+		line=getword(0L);
+		fileaddr=getaddr(4L);
+		if ( fileaddr ) {
+			for ( i=0 ; i<40 ; i++ ) {
+				tok=getbyte(fileaddr++) ;
+				if ( !isprint(tok) ) break ;
+				putc(tok,stdout);
+			}
+			printf(" ");
+		}
+		if ( line ) {
+			printf("line %D",line) ;
+		}
+		if ( fileaddr || line ) printf(", ");
+		fseek(fcore,512L,0);
+
+		if ( cause>27 ) {
+			printn("cause",cause) ;
+		} else {
+			prints("cause",cstr[(int)cause]);
+		}
+		printn("pc",pc);printn("sp",sp);printn("lb",lb);
+		printn("hp",hp);
+		if ( pd ) printn("pd",pd) ;
+		if ( pb ) printn("pb",pb) ;
+		printn("errproc",uerrorproc) ;
+		printn("ignmask",ignmask) ;
+		if ( tsize ) printn("Text size",tsize) ;
+		if ( dsize ) printn("Data size",dsize) ;
+	}
+	if ( dflag==0 ) return 0;
+	fatal("d-flag not implemeted (yet)");
+	return 1 ;
+}
+
+scanargs(argc,argv) char **argv ; {
+	pname=argv[0];
+	while ( argv++, argc-- > 1 ) {
+		switch( argv[0][0] ) {
+		case '-':    switch( argv[0][1] ) {
+				case 's':    sflag++ ; break ;
+				case 'l':    dflag++ ; break ;
+				default : fatal(": [-s] [-ln.m] [file]") ;
+			} ;
+			break ;
+		default :core=argv[0] ;
+		}
+	}
+}
+
+prints(s1,s2) char *s1,*s2; {
+	printf("%-15s %s\n",s1,s2);
+}
+
+printn(s1,d) char *s1; long d; {
+	printf("%-15s %15ld\n",s1,d);
+}
+
+/* VARARGS1 */
+fatal(s1,p1,p2,p3,p4,p5) char *s1 ; {
+	fprintf(stderr,"%s: ",pname);
+	fprintf(stderr,s1,p1,p2,p3,p4,p5) ;
+	fprintf(stderr,"\n") ;
+	exit(1) ;
+}
+
+int getb() {
+	int i ;
+	i=getc(fcore) ;
+	if ( i==EOF ) fatal("Premature EOF");
+	return i&0377 ;
+}
+
+int read2() {
+	int i ;
+	i=getb() ; return getb()*256 + i ;
+}
+
+long readaddr() {
+	long res ;
+	register int i ;
+
+	res=0 ;
+	for (i=0 ; i<asize ; i++ ) res |= getb()<<(8*i) ;
+	return res ;
+}
+
+long readword() {
+	long res ;
+	register int i ;
+
+	res=0 ;
+	for (i=0 ; i<wsize ; i++ ) res |= getb()<<(8*i) ;
+	return res ;
+}
+
+unsigned getbyte(a) long a ; {
+	fseek(fcore,a+512,0) ;
+	return getb() ;
+}
+
+long getword(a) long a ; {
+	fseek(fcore,a+512,0) ;
+	return readword() ;
+}
+
+long getaddr(a) long a ; {
+	fseek(fcore,a+512,0) ;
+	return readaddr() ;
+}

+ 244 - 0
doc/em/int/mktables.c

@@ -0,0 +1,244 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+/* Author: E.G. Keizer */
+
+#include <stdio.h>
+#include "/usr/em/util/ass/ip_spec.h"
+#include "/usr/em/h/em_spec.h"
+#include "/usr/em/h/em_flag.h"
+
+/* This program reads the human readable interpreter specification
+   and produces a efficient machine representation that can be
+   translated by a C-compiler.
+*/
+
+#define ESCAP   256
+
+int nerror = 0 ;
+int atend  = 0 ;
+int line   = 1 ;
+int maxinsl= 0 ;
+
+extern char em_mnem[][4] ;
+char esca[] = "escape" ;
+#define ename(no)       ((no)==ESCAP?esca:em_mnem[(no)])
+
+extern char em_flag[] ;
+
+main(argc,argv) char **argv ; {
+	if ( argc>1 ) {
+		if ( freopen(argv[1],"r",stdin)==NULL) {
+			fatal("Cannot open %s",argv[1]) ;
+		}
+	}
+	if ( argc>2 ) {
+		if ( freopen(argv[2],"w",stdout)==NULL) {
+			fatal("Cannot create %s",argv[2]) ;
+		}
+	}
+	if ( argc>3 ) {
+		fatal("%s [ file [ file ] ]",argv[0]) ;
+	}
+	atend=0 ;
+	readin();
+	atend=1 ;
+	return nerror ;
+}
+
+readin() {
+	char *ident();
+	char *firstid ;
+	int opcode,flags;
+	int c;
+
+	while ( !feof(stdin) ) {
+		firstid=ident() ;
+		if ( *firstid=='\n' || feof(stdin) ) continue ;
+		opcode = getmnem(firstid) ;
+		printf("%d ",opcode+1) ;
+		flags  = decflag(ident(),opcode) ;
+		switch(em_flag[opcode]&EM_PAR) {
+		case PAR_D: case PAR_F: case PAR_B: case PAR_L: case PAR_C:
+			putchar('S') ;
+		}
+		putchar(' ');
+		while ( (c=readchar())!='\n' && c!=EOF ) putchar(c) ;
+		putchar('\n') ;
+	}
+}
+
+char *ident() {
+	/* skip spaces and tabs, anything up to space,tab or eof is
+	   a identifier.
+	   Anything from # to end-of-line is an end-of-line.
+	   End-of-line is an identifier all by itself.
+	*/
+
+	static char array[200] ;
+	register int c ;
+	register char *cc ;
+
+	do {
+		c=readchar() ;
+	} while ( c==' ' || c=='\t' ) ;
+	for ( cc=array ; cc<&array[(sizeof array) - 1] ; cc++ ) {
+		if ( c=='#' ) {
+			do {
+				c=readchar();
+			} while ( c!='\n' && c!=EOF ) ;
+		}
+		*cc = c ;
+		if ( c=='\n' && cc==array ) break ;
+		c=readchar() ;
+		if ( c=='\n' ) {
+			pushback(c) ;
+			break ;
+		}
+		if ( c==' ' || c=='\t' || c==EOF ) break ;
+	}
+	*++cc=0 ;
+	return array ;
+}
+
+int getmnem(str) char *str ; {
+	char (*ptr)[4] ;
+
+	for ( ptr = em_mnem ; *ptr<= &em_mnem[sp_lmnem][0] ; ptr++ ) {
+		if ( strcmp(*ptr,str)==0 ) return (ptr-em_mnem) ;
+	}
+	error("Illegal mnemonic") ;
+	return 0 ;
+}
+
+error(str,a1,a2,a3,a4,a5,a6) /* VARARGS1 */ char *str ; {
+	if ( !atend ) fprintf(stderr,"line %d: ",line) ;
+	fprintf(stderr,str,a1,a2,a3,a4,a5,a6) ;
+	fprintf(stderr,"\n");
+	nerror++ ;
+}
+
+mess(str,a1,a2,a3,a4,a5,a6) /* VARARGS1 */ char *str ; {
+	if ( !atend ) fprintf(stderr,"line %d: ",line) ;
+	fprintf(stderr,str,a1,a2,a3,a4,a5,a6) ;
+	fprintf(stderr,"\n");
+}
+
+fatal(str,a1,a2,a3,a4,a5,a6) /* VARARGS1 */ char *str ; {
+	error(str,a1,a2,a3,a4,a5,a6) ;
+	exit(1) ;
+}
+
+#define ILLGL   -1
+
+check(val) int val ; {
+	if ( val!=ILLGL ) error("Illegal flag combination") ;
+}
+
+int decflag(str,opc) char *str ; {
+	int type ;
+	int escape ;
+	int range ;
+	int wordm ;
+	int notzero ;
+	char c;
+
+	type=escape=range=wordm=notzero= ILLGL ;
+	while ( c= *str++ ) {
+		switch ( c ) {
+		case 'm' :
+			check(type) ; type=OPMINI ; break ;
+		case 's' :
+			check(type) ; type=OPSHORT ; break ;
+		case '-' :
+			check(type) ; type=OPNO ;
+			if ( (em_flag[opc]&EM_PAR)==PAR_W ) c='i' ;
+			break ;
+		case '1' :
+			check(type) ; type=OP8 ; break ;
+		case '2' :
+			check(type) ; type=OP16 ; break ;
+		case '4' :
+			check(type) ; type=OP32 ; break ;
+		case '8' :
+			check(type) ; type=OP64 ; break ;
+		case 'e' :
+			check(escape) ; escape=0 ; break ;
+		case 'N' :
+			check(range) ; range= 2 ; break ;
+		case 'P' :
+			check(range) ; range= 1 ; break ;
+		case 'w' :
+			check(wordm) ; wordm=0 ; break ;
+		case 'o' :
+			check(notzero) ; notzero=0 ; break ;
+		default :
+			error("Unknown flag") ;
+		}
+		putchar(c);
+	}
+	if ( type==ILLGL ) error("Type must be specified") ;
+	switch ( type ) {
+	case OP64 :
+	case OP32 :
+		if ( escape!=ILLGL ) error("Conflicting escapes") ;
+		escape=ILLGL ;
+	case OP16 :
+	case OP8 :
+	case OPSHORT :
+	case OPNO :
+		if ( notzero!=ILLGL ) mess("Improbable OPNZ") ;
+		if ( type==OPNO && range!=ILLGL ) {
+			mess("No operand in range") ;
+		}
+	}
+	if ( escape!=ILLGL ) type|=OPESC ;
+	if ( wordm!=ILLGL ) type|=OPWORD ;
+	switch ( range) {
+	case ILLGL : type|=OP_BOTH ; break ;
+	case 1     : type|=OP_POS  ; break ;
+	case 2     : type|=OP_NEG  ; break ;
+	}
+	if ( notzero!=ILLGL ) type|=OPNZ ;
+	return type ;
+}
+
+static int pushchar ;
+static int pushf ;
+
+int readchar() {
+	int c ;
+
+	if ( pushf ) {
+		pushf=0 ;
+		c = pushchar ;
+	} else {
+		if ( feof(stdin) ) return EOF ;
+		c=getc(stdin) ;
+	}
+	if ( c=='\n' ) line++ ;
+	return c ;
+}
+
+pushback(c) {
+	if ( pushf ) {
+		fatal("Double pushback") ;
+	}
+	pushf++ ;
+	pushchar=c ;
+	if ( c=='\n' ) line-- ;
+}