program interp(input,output,CodeFile);

{$BOX
  This program is an interpreter for the P-code produced by COMP.
$EBOX}

{$BOX

  The instructions used are very close to the P-code used in the pascal
  compiler.  Extensions have been made where convenient.

  The stack notation shows the stack before and after the operation.
  ( <x> <y> --- <x+y>) would mean that <x> is on top of the stack and
  <y> is immediately beneath it before the operation and the sum of
  x and y is left afterwards.  The notation [x] means the memory location 
  addressed by x.

  The type suffixes are these :
    A -- address
    B -- boolean
    C -- character
    I -- integer
    O -- cardinal (ordinal)
    R -- real
    S -- bitset
    Z -- string

                        result
  instruction           type         action
  ----------------      ---------    ----------------------------------
  LDCI        Q         integer      (  --- <int> )
  LDCO        Q         cardinal     (  --- <card> )
  LDCB        Q         boolean      (  --- <bool> )
  LDCC        Q         char         (  --- <char> )
  LDCR        Q         real         (  --- <real> )
  LDCS        Q         bitset       (  --- <bitset> )
  LDCA        Q         address      (  --- <address> )

  LODI    P   Q         integer      (  --- <int> )
  LODO    P   Q         cardinal     (  --- <card> )
  LODR    P   Q         real         (  --- <real> )
  LODB    P   Q         boolean      (  --- <bool> )
  LODC    P   Q         char         (  --- <char> )
  LODS    P   Q         bitset       (  --- <bitset> )

  STRI    P   Q         integer      ( <int> ---  )
  STRO    P   Q         cardinal     ( <card> ---  )
  STRR    P   Q         real         ( <real> ---  )
  STRB    P   Q         boolean      ( <bool> ---  )
  STRC    P   Q         char         ( <char> ---  )
  STRS    P   Q         bitset       ( <bitset> ---  )

  LDA     P   Q         pointer      (  --- <address> )

  LCA     <literal>     string       (  --- <address> )

  INDI        Q         integer     ( <address> --- <int> )
  INDO        Q         cardinal    ( <address> --- <card> )
  INDR        Q         real        ( <address> --- <real> )
  INDC        Q         char        ( <address> --- <char> )
  INDS        Q         bitset      ( <address> --- <bitset> )
  INDA        Q         pointer     ( <address> --- <pointer> )

  STOI                 integer      ( <i1> <destaddr> ---  )
  STOO                 cardinal     ( <c1> <destaddr> ---  )
  STOR                 real         ( <r1> <destaddr> ---  )
  STOB                 boolean      ( <b1> <destaddr> ---  )
  STOC                 char         ( <ch1> <destaddr> ---  )
  STOS                 bitset       ( <bs1> <destaddr> ---  )

  MOV         Q        block copy   ( <srcaddr> <destaddr> ---  )

  MPI                  integer      ( <int1> <int2> --- <int1*int2> )
  MPC                  cardinal     ( <card1> <card2> --- <card1*card2> )
  MPR                  real         ( <real1> <real2> --- <real1*real2> )

  DVI                  integer      ( <int1> <int2> --- <int2 DIV int1> )
  DVC                  cardinal     ( <card1> <card2> --- <card2 DIV card1> )
  DVR                  real         ( <real1> <real2> --- <real2 / real1> )

  ADI                  integer      ( <int1> <int2> --- <int1+int2> )
  ADC                  cardinal     ( <card1> <card2> --- <card1+card2> )
  ADR                  real         ( <real1> <real2> --- <real1+real2> )

  SBI                  integer      ( <int1> <int2> --- <int2-int1> )
  SBC                  cardinal     ( <card1> <card2> --- <card2-card1> )
  SBR                  real         ( <real1> <real2> --- <real2-real1> )

  IXA         Q        pointer      ( <int> <addr> --- <int+addr> )

  GEQx                 x            ( <x1> <x2> --- <bool> )
  EQUx                 x            ( <x1> <x2> --- <bool> )
  LEQx                 x            ( <x1> <x2> --- <bool> )
  LESx                 x            ( <x1> <x2> --- <bool> )

  MODI                 integer      ( <int1> <int2> --- <int2 mod int1> )
  MODC                 cardinal     ( <card1> <card2> --- <card2 mod card1> )

  NGI                  integer      ( <int> --- < -int > )
  NGR                  real         ( <real> --- < -real > )

  INCI        Q        integer      ( <int> --- <int+Q> )
  INCO        Q        cardinal     ( <card> --- <card+Q) )
  INCC        Q        char         ( <char> --- <char+Q> )
  INCA        Q        pointer      ( <address> --- <address+Q> )

  DECI        Q        integer      ( <int> --- <int-Q> )
  DECO        Q        cardinal     ( <card> --- <card-Q) )
  DECC        Q        char         ( <char> --- <char-Q> )
  DECA        Q        pointer      ( <address> --- <address-Q> )

  CHKI    P   Q         ----        ( <int> --- <int> ) (unchanged)
  CHKO    P   Q         ----        ( <card> --- <card> ) (unchanged)
  CHKC    P   Q         ----        ( <char> --- <char> ) (unchanged)
  CHKA    P   Q         ----        ( <addr> --- <addr> ) (unchanged)

  TSTI    P   Q <label> ----        ( <int> --- <int> )
  TSTO    P   Q <label> ----        ( <card> --- <card> )
  TSTC    P   Q <label> ----        ( <char> --- <char> )
  TSTA    P   Q <label> ----        ( <addr> --- <addr> )

  CTOI                 mixed        ( <card> --- <int> )
  CHTOI                mixed        ( <char> --- <int> )
  BTOI                 mixed        ( <bool> --- <int> )
  ITOC                 mixed        ( <int> --- <card> )
  CHTOC                mixed        ( <char> --- <card> )
  BTOC                 mixed        ( <bool> --- <card> )

  UNI                  bitset       ( <bs1> <bs2> --- <bs1+bs2> )  set union
  INT                  bitset       ( <bs1> <bs2> --- <bs1+bs2> )  set intersection
  DIF                  bitset       ( <bs1> <bs2> --- <bs1-bs2> )  set difference

  WRTI                 integer      ( <i1> ---  ) print integer
  WRTO                 cardinal     ( <c1> ---  ) print cardinal
  WRTR                 real         ( <real> ---  ) print real
  WRTB                 boolean      ( <b1> ---  ) print boolean
  WRTC                 char         ( <ch1> ---  ) print char
  WRTS                 bitset       ( <bs1> ---  ) print bitset
  WRTA                 pointer      ( <p1> ---  ) print pointer value
  WRTS                 string       print string pointed to by ( <p1> ---  )

  WRTLN                                     print a CR/LF

  STOP                                      halt operation

  ENTR    <ma1>                             program entry

  XJP         Q                     ( <card> ---  )

  JUN         Q                     (  ---  ) unconditional jump
  FJP         Q                     ( <bool> ---  ) jump if false
  TJP         Q                     ( <bool> ---  ) jump if true

$EBOX}
{$EJECT}
{ global constants }

const MEMSIZE = 20000; { how many bytes do we have ? }
      MAXLABEL = 2000; { # of labels kept in label table }

{ some target machine constants }
      BITSETSIZE        = 31; { number of elements - 1 in BITSET type }

      INTEGER_SIZE      = 4;  { take up four bytes }
      CHAR_SIZE         = 1;  { take up one byte }
      REAL_SIZE         = 8;  { take up eight bytes }
      BOOLEAN_SIZE      = 1;
      CARDINAL_SIZE     = 4;
      BITSET_SIZE       = 4;
      POINTER_SIZE      = 4;

      BOOLTRUEVAL  = 1;       { constants which represent the boolean }
      BOOLFALSEVAL = 0;       { values in the target machine.         }

{ global types }
type
     string5 = string[5];
     string80 = string[80];

     bitsettype = packed array[0..BITSETSIZE] of boolean;

     byte = 0..255;

     addrtype = 0..MEMSIZE;
     labeltype = 0..MAXLABEL;

     BasicTypes = (int,card,bool,reel,chr,bs,pntr,strng,undef);
     TypeSet = set of BasicTypes;

     ISet = (iLDC,      { load constant }
             iLOD,      { load from level P }
             iSTR,      { store at level P }
             iLDA,      { load address of level P }
             iLCA,      { load address of string }
             iIND,      { load indexed }
             iSTO,      { store indirect }
             iMOV,      { block copy }
             iMP,       { multiply }
             iDV,       { divide }
             iAD,       { add }
             iSB,       { subtract }
             iIXA,      { compute indexed address }
             iGEQ,      { greater or equal compare }
             iEQU,      { compare equal to }
             iLEQ,      { compare less than or equal to }
             iLES,      { compare less than }
             iMOD,      { modulus operation }
             iNG,       { negate }
             iINC,      { increment value }
             iDEC,      { decrement value }
             iCHK,      { check range }
             iTST,      { check range }
             iCTOI,     { convert card to int }
             iCHTOI,    { convert char to int }
             iBTOI,     { convert boolean to int }
             iITOC,     { convert card to card }
             iCHTOC,    { convert char to card }
             iBTOC,     { convert boolean to card }
             iUNI,      { form set union }
             iINT,      { form set inersection }
             iDIF,      { form set difference }
             iWRT,      { write value }
             iWRTLN,    { writeln }
             iSTOP,     { halt operation }
             iENTR,     { mark procedure entry }
             iXJP,      { indexed jump }
             iJUN,      { unconditional jump }
             iFJP,      { jump on false value }
             iTJP,      { jump on true value }
             iERR       { bad instruction }           );


     { this record represents the parts common to all instructions.
       Some instructions will have to fetch other parameters in the
       bytes immediately following the instruction. }

     instruct = packed record
                   operation : ISet;
                   optype    : BasicTypes;
                   destaddr  : addrtype;
                end;


    { this type is used to communicate the type of number converted }
    numclass = (bad, intnum, realnum);
    eithernum = record
                   case numkind : numclass of
                        bad : ();
                     intnum : (Ival : integer);
                    realnum : (Rval : real);
                end;
{ global vars }

var
    CodeFile : text;  { source of our I-code }

    { the following structure is the representation of all memory }
    { it is based on the byte as the fundamental unit of memory   }
    M : packed array [0..MEMSIZE] of byte;

    { a list of the ascii mnemonic of the various instructions }
    Mnem : array [iLDC..iERR] of string5;
    TypeMnem : array [int..undef] of char;

    { a list of the valid operand type suffixes for the various instructions }
    OpTypes : array [iLDC..iERR] of TypeSet;

    { This is the label table.  It contains the starting byte corresponding
      to a given label (1 .. MAXLABEL).  This is a very simplistic method.
      However, labels a generated contiguously from 1 up to ???.  A linked
      list of some sort would apparently allow "infinite" growth of label
      values.  This is not only more difficult but much less efficient.
      The value 0 is reserved to denote undefined labels. }

    LabelTable : packed array [0..MAXLABEL] of addrtype;

    { this is the global line counter representing the line of Icode we're at }
    iline : integer;

    { current program counter value }
    PCntr : integer;

    { current stack pointer value }
    SPntr : integer;

    { this variable is the location where we should start execution }
    entrypoint : addrtype;

    { program breakpoint variable.  set to -1 to turn it off }
    PCBP : integer;
{ initialize everything }

procedure Init;

var i : integer;

begin
Mnem[iLDC]  := 'LDC';   OpTypes[iLDC]  := [int,card,bool,reel,chr,bs,pntr];
Mnem[iLOD]  := 'LOD';   OpTypes[iLOD]  := [int,card,bool,reel,chr,bs,pntr];
Mnem[iSTR]  := 'STR';   OpTypes[iSTR]  := [int,card,bool,reel,chr,bs,pntr];
Mnem[iLDA]  := 'LDA';   OpTypes[iLDA]  := [];
Mnem[iLCA]  := 'LCA';   OpTypes[iLCA]  := [];
Mnem[iIND]  := 'IND';   OpTypes[iIND]  := [int,card,bool,reel,chr,bs,pntr];
Mnem[iSTO]  := 'STO';   OpTypes[iSTO]  := [int,card,bool,reel,chr,bs,pntr];
Mnem[iMOV]  := 'MOV';   OpTypes[iMOV]  := [];
Mnem[iMP]   := 'MP';    OpTypes[iMP]   := [int,card,reel];
Mnem[iDV]   := 'DV';    OpTypes[iDV]   := [int,card,reel];
Mnem[iDV]   := 'DV';    OpTypes[iDV]   := [int,card,reel];
Mnem[iAD]   := 'AD';    OpTypes[iAD]   := [int,card,reel];
Mnem[iSB]   := 'SB';    OpTypes[iSB]   := [int,card,reel];
Mnem[iIXA]  := 'IXA';   OpTypes[iIXA]  := [];
Mnem[iGEQ]  := 'GEQ';   OpTypes[iGEQ]  := [int,card,bool,reel,chr,bs,pntr];
Mnem[iEQU]  := 'EQU';   OpTypes[iEQU]  := [int,card,bool,reel,chr,bs,pntr];
Mnem[iLEQ]  := 'LEQ';   OpTypes[iLEQ]  := [int,card,bool,reel,chr,bs,pntr];
Mnem[iLES]  := 'LES';   OpTypes[iLES]  := [int,card,bool,reel,chr,bs,pntr];
Mnem[iMOD]  := 'MOD';   OpTypes[iMOD]  := [int,card];
Mnem[iNG]   := 'NG';    OpTypes[iNG]   := [int,reel];
Mnem[iINC]  := 'INC';   OpTypes[iINC]  := [int,card,chr,pntr];
Mnem[iDEC]  := 'DEC';   OpTypes[iDEC]  := [int,card,chr,pntr];
Mnem[iCHK]  := 'CHK';   OpTypes[iCHK]  := [int,card,chr,pntr];
Mnem[iTST]  := 'TST';   OpTypes[iTST]  := [int,card,chr,pntr];
Mnem[iCTOI] := 'CTOI';  OpTypes[iCTOI] := [];
Mnem[iCHTOI]:= 'CHTOI'; OpTypes[iCHTOI]:= [];
Mnem[iBTOI] := 'BTOI';  OpTypes[iBTOI] := [];
Mnem[iITOC] := 'ITOC';  OpTypes[iITOC] := [];
Mnem[iCHTOC]:= 'CHTOC'; OpTypes[iCHTOC]:= [];
Mnem[iBTOC] := 'BTOC';  OpTypes[iBTOC] := [];
Mnem[iUNI]  := 'UNI';   OpTypes[iUNI]  := [];
Mnem[iINT]  := 'INT';   OpTypes[iINT]  := [];
Mnem[iDIF]  := 'DIF';   OpTypes[iDIF]  := [];
Mnem[iWRT]  := 'WRT';   OpTypes[iWRT]  := [int,card,bool,chr,reel,bs,
                                                                 strng,pntr];
Mnem[iWRTLN]:= 'WRTLN'; OpTypes[iWRTLN]:= [];
Mnem[iXJP]  := 'XJP';   OpTypes[iXJP]  := [];
Mnem[iJUN]  := 'JUN';   OpTypes[iJUN]  := [];
Mnem[iFJP]  := 'FJP';   OpTypes[iFJP]  := [];
Mnem[iTJP]  := 'TJP';   OpTypes[iTJP]  := [];
Mnem[iSTOP] := 'STOP';  OpTypes[iSTOP] := [];
Mnem[iENTR] := 'ENTR';  OpTypes[iENTR] := [];
Mnem[iERR]  := 'ERR';   OpTypes[iERR]  := [];


TypeMnem[pntr]  := 'A';
TypeMnem[bool]  := 'B';
TypeMnem[chr]   := 'C';
TypeMnem[int]   := 'I';
TypeMnem[card]  := 'O';
TypeMnem[reel]  := 'R';
TypeMnem[bs]    := 'S';
TypeMnem[strng] := 'Z';
TypeMnem[undef] := '?';

{ now initialize label table to all "undefined" values }
for i := 0 to MAXLABEL do LabelTable[i] := 0;

{ icode line number starts at 1 }
iline := 0;

end; { procedure InitMnem }
{ memory <---> operand translators }

procedure FetchInt(addr : addrtype; var Iv : integer);
type t = packed array[1..INTEGER_SIZE] of byte;
var temp : t; i : integer;
begin
   for i := 1 to INTEGER_SIZE do temp[i] := M[addr+i-1];
   Iv := INTEGER(temp);
end; { procedure FetchInt }


procedure FetchCard(addr : addrtype; var Cv : integer);
type t = packed array[1..CARDINAL_SIZE] of byte;
var temp : t; i : integer;
begin
   for i := 1 to CARDINAL_SIZE do temp[i] := M[addr+i-1];
   Cv := INTEGER(temp);
end; { procedure FetchCard }


procedure FetchPntr(addr : addrtype; var Pv : integer);
type t = packed array[1..POINTER_SIZE] of byte;
var temp : t; i : integer;
begin
   for i := 1 to POINTER_SIZE do temp[i] := M[addr+i-1];
   Pv := INTEGER(temp);
end; { procedure FetchPntr }


procedure FetchReal(addr : addrtype; var Rv : real);
type t = packed array[1..REAL_SIZE] of byte;
var temp : t; i : integer;
begin
   for i := 1 to REAL_SIZE do temp[i] := M[addr+i-1];
   Rv := REAL(temp);
end; { procedure FetchReal }


procedure FetchChar(addr : addrtype; var CHv : integer);
begin
   CHv := M[addr];
end; { procedure FetchChar }


procedure FetchBool(addr : addrtype; var Bv : integer);
begin
   Bv := M[addr];
end; { procedure FetchBool }


procedure FetchBS(addr : addrtype; var val : bitsettype);
type t = packed array[1..BITSET_SIZE] of byte;
var temp : t; i : integer;
begin
   for i := 1 to BITSET_SIZE do temp[i] := M[addr+i-1];
   val := bitsettype(temp);
end; { procedure FetchBS }


procedure FetchLabel(addr : addrtype; var Lv : labeltype);
var i : integer;
begin
   i := M[addr] * 256 + M[addr+1];
   if (i > MAXLABEL) then Lv := MAXLABEL
                     else Lv := i;
end; { procedure FetchLabel }

{=======================================================================}

procedure StoreInt(addr : addrtype; val : integer);
type t = packed array[1..INTEGER_SIZE] of byte;
var temp : t; i : integer;
begin
   temp := t(val);
   for i := 1 to INTEGER_SIZE do M[addr+i-1] := temp[i];
end; { procedure StoreInt }


procedure StoreCard(addr : addrtype; val : integer);
type t = packed array[1..CARDINAL_SIZE] of byte;
var temp : t; i : integer;
begin
   temp := t(val);
   for i := 1 to CARDINAL_SIZE do M[addr+i-1] := temp[i];
end; { procedure StoreCard }


procedure StorePntr(addr : addrtype; val : integer);
type t = packed array[1..POINTER_SIZE] of byte;
var temp : t; i : integer;
begin
   temp := t(val);
   for i := 1 to POINTER_SIZE do M[addr+i-1] := temp[i];
end; { procedure StorePntr }


procedure StoreChar(addr : addrtype; val : integer);
begin
   M[addr] := val;
end; { procedure StoreChar }


procedure StoreBool(addr : addrtype; val : integer);
begin
   M[addr] := val;
end; { procedure StoreBool }


procedure StoreBS(addr : addrtype; val : bitsettype);
type t = packed array[1..BITSET_SIZE] of byte;
var temp : t; i : integer;
begin
   temp := t(val);
   for i := 1 to BITSET_SIZE do M[addr+i-1] := temp[i];
end; { procedure StoreBS }


procedure StoreReal(addr : addrtype; val : real);
type t = packed array[1..REAL_SIZE] of byte;
var temp : t; i : integer;
begin
   temp := t(val);
   for i := 1 to REAL_SIZE do M[addr+i-1] := temp[i];
end; { procedure StoreReal }

{=======================================================================}

procedure PackInt(var addr : addrtype; val : integer);
begin
   StoreInt(addr,val);
   addr := addr + INTEGER_SIZE;
end; { procedure PackInt }


procedure PackCard(var addr : addrtype; val : integer);
begin
   StoreCard(addr,val);
   addr := addr + CARDINAL_SIZE;
end; { procedure PackCard }


procedure PackAddr(var addr : addrtype; val : addrtype);
begin
   M[addr] := val div 256;
   M[addr+1] := val mod 256;
   addr := addr + 2; { size of addr }
end; { procedure PackAddr }


procedure PackPntr(var addr : addrtype; val : integer);
begin
   StorePntr(addr,val);
   addr := addr + POINTER_SIZE;
end; { procedure PackPntr }


procedure PackLabel(var addr : addrtype; val : labeltype);
begin
   M[addr] := val div 256;
   M[addr+1] := val mod 256;
   addr := addr + 2; { size of label }
end; { procedure PackLabel }


procedure PackChar(var addr : addrtype; val : integer);
begin
   StoreChar(addr,val);
   addr := addr + CHAR_SIZE;
end; { procedure PackChar }


procedure PackBool(var addr : addrtype; val : integer);
begin
   StoreChar(addr,val);
   addr := addr + BOOLEAN_SIZE;
end; { procedure PackBool }


procedure PackReal(var addr : addrtype; val : real);
begin
   StoreReal(addr,val);
   addr := addr + REAL_SIZE;
end; { procedure PackReal }


procedure PackBS(var addr : addrtype; val : bitsettype);
begin
   StoreBS(addr,val);
   addr := addr + BITSET_SIZE;
end; { procedure PackBS }


procedure PackInstruction(var addr  : addrtype;
                          operation : ISet;
                          opertype  : BasicTypes);
begin
   M[addr] := ORD(operation);
   M[addr+1] := ORD(opertype);
   addr := addr + 2;
end; { procedure PackInstruction }

{=======================================================================}

procedure UnPackInt(var addr : addrtype; var Iv : integer);
begin
   FetchInt(addr,Iv);
   addr := addr + INTEGER_SIZE;
end; { procedure UnPackInt }


procedure UnPackCard(var addr : addrtype; var Cv : integer);
begin
   FetchCard(addr,Cv);
   addr := addr + CARDINAL_SIZE;
end; { procedure UnPackCard }


procedure UnPackAddr(var addr : addrtype; var val : addrtype);
var i : integer;
begin
   i := M[addr] * 256 + M[addr+1];
   if (i > MEMSIZE) then val := 0
                    else val := i;
   addr := addr + 2; { size of addr }
end; { procedure UnPackAddr }


procedure UnPackPntr(var addr : addrtype; var val : integer);
begin
   FetchPntr(addr,val);
   addr := addr + POINTER_SIZE;
end; { procedure UnPackPntr }


procedure UnPackReal(var addr : addrtype; var Rv : real);
begin
   FetchReal(addr,Rv);
   addr := addr + REAL_SIZE;
end; { procedure UnPackReal }


procedure UnPackChar(var addr : addrtype; var CHv : integer);
begin
   FetchChar(addr,CHv);
   addr := addr + 1;
end; { procedure UnPackChar }


procedure UnPackBool(var addr : addrtype; var Bv : integer);
begin
   FetchBool(addr,Bv);
   addr := addr + 1;
end; { procedure UnPackBool }


procedure UnPackBS(var addr : addrtype; var BSv : bitsettype);
begin
   FetchBS(addr,BSv);
   addr := addr + BITSET_SIZE;
end; { procedure UnPackBS }

procedure UnPackLabel(var addr : addrtype; var Lv : labeltype);
begin
   FetchLabel(addr,Lv);
   addr := addr + 2;
end; { procedure UnPackLabel }


procedure UnPackInstruction(var addr      : addrtype;
                            var operation : ISet;
                            var opertype  : BasicTypes);
var i : integer;
begin
   i := M[addr];
   if (i > ORD(iERR)) then begin
      operation := iERR; opertype := undef; end
   else begin
      operation := ISet(i);
      i := M[addr+1];
      if (i > ORD(undef)) then opertype := undef
      else opertype := BasicTypes(M[addr+1]);
      end;
   addr := addr + 2;
end; { procedure UnPackInstruction }

{=======================================================================}

procedure StackInt(var addr : addrtype; val : integer);
begin
   addr := addr - INTEGER_SIZE;
   StoreInt(addr,val);
end; { procedure StackInt }


procedure StackCard(var addr : addrtype; val : integer);
begin
   addr := addr - CARDINAL_SIZE;
   StoreCard(addr,val);
end; { procedure StackCard }


procedure StackAddr(var addr : addrtype; val : addrtype);
begin
   addr := addr - 2; { size of addr }
   M[addr] := val div 256;
   M[addr+1] := val mod 256;
end; { procedure StackAddr }


procedure StackPntr(var addr : addrtype; val : integer);
begin
   addr := addr - POINTER_SIZE;
   StorePntr(addr,val);
end; { procedure StackPntr }


procedure StackLabel(var addr : addrtype; val : labeltype);
begin
   addr := addr - 2; { size of label }
   M[addr] := val div 256;
   M[addr+1] := val mod 256;
end; { procedure StackLabel }


procedure StackChar(var addr : addrtype; val : integer);
begin
   addr := addr - CHAR_SIZE;
   StoreChar(addr,val);
end; { procedure StackChar }


procedure StackBool(var addr : addrtype; val : integer);
begin
   addr := addr - BOOLEAN_SIZE;
   StoreChar(addr,val);
end; { procedure StackBool }


procedure StackReal(var addr : addrtype; val : real);
begin
   addr := addr - REAL_SIZE;
   StoreReal(addr,val);
end; { procedure StackReal }


procedure StackBS(var addr : addrtype; val : bitsettype);
begin
   addr := addr - BITSET_SIZE;
   StoreBS(addr,val);
end; { procedure StackBS }

{=======================================================================}

procedure UnStackInt(var addr : addrtype; var Iv : integer);
begin
   FetchInt(addr,Iv);
   addr := addr + INTEGER_SIZE;
end; { procedure UnStackInt }


procedure UnStackCard(var addr : addrtype; var Cv : integer);
begin
   FetchCard(addr,Cv);
   addr := addr + CARDINAL_SIZE;
end; { procedure UnStackCard }


procedure UnStackAddr(var addr : addrtype; var val : addrtype);
var i : integer;
begin
   i := M[addr] * 256 + M[addr+1];
   if (i > MEMSIZE) then val := 0
                    else val := i;
   addr := addr + 2; { size of addr }
end; { procedure UnStackAddr }


procedure UnStackPntr(var addr : addrtype; var val : integer);
begin
   FetchPntr(addr,val);
   addr := addr + POINTER_SIZE;
end; { procedure UnStackPntr }


procedure UnStackReal(var addr : addrtype; var Rv : real);
begin
   FetchReal(addr,Rv);
   addr := addr + REAL_SIZE;
end; { procedure UnStackReal }


procedure UnStackChar(var addr : addrtype; var CHv : integer);
begin
   FetchChar(addr,CHv);
   addr := addr + 1;
end; { procedure UnStackChar }


procedure UnStackBool(var addr : addrtype; var Bv : integer);
begin
   FetchBool(addr,Bv);
   addr := addr + 1;
end; { procedure UnStackBool }


procedure UnStackBS(var addr : addrtype; var BSv : bitsettype);
begin
   FetchBS(addr,BSv);
   addr := addr + BITSET_SIZE;
end; { procedure UnStackBS }

procedure UnStackLabel(var addr : addrtype; var Lv : labeltype);
begin
   FetchLabel(addr,Lv);
   addr := addr + 2;
end; { procedure UnStackLabel }
{ file handlers }

procedure OpenFile(var CodeFile : text; name : string80);

var dummy : boolean;
    Errcode : integer;
    NameLength : 0..20;

begin

   { add manditory extension }
   NameLength := length(name);
   name[NameLength+1..NameLength+7] := '.ICODE';

   { open the code file}
   Open(CodeFile,name,ReadOnlyAccess,FALSE,TRUE,saf,dummy);
   GetErrorCode(CodeFile,ErrCode);
   If ErrCode <> 0 then begin
      writeln('Could not open the code file');
   end;

end; { procedure OpenFile }

{$EJECT}
{$BOX

  This procedure will attempt to close the file passed to it.
  If the file does not close properly then an error message is printed
  and the program aborts.

$EBOX}

procedure CloseFile(var FileToClose : text);

var Errcode : integer;

begin

   Close(FileToClose,FALSE); { close it, don't destroy it }
   GetErrorCode(FileToClose,Errcode);
   If (Errcode <> 0) then begin
      writeln('Error in closing a file');
      STOPPROGRAM(1); { indicate abnormal termination }
   end;

end; { procedure CloseFile }
{ assemble program }

procedure Assemble(var PCntr : addrtype);

{$BOX
  This assembles that one line and sticks it into memory starting at
  addr.  After assembling that one line addr points to the first
  byte after the instruction.
$EBOX}

var op, operation : ISet; 
    optype, opertype : BasicTypes;
    opstr : string5;
    labval : addrtype;
    i : integer;
    textline : string[132];
    ch : char;

   {=======================================================================}

   procedure ReadLabel(var labval : labeltype);
   var i : integer;
   begin
      read(CodeFile,i);
      if (i > MAXLABEL) then begin
         writeln(output,'***ERROR -- label too large at line #',iline+1:1);
         labval := 0;
         end
      else labval := i;
   end; { procedure ReadLabel }

   {=======================================================================}

   procedure AssembleRestOfLine;
   { this is a seperate procedure only to keep the Assemble procedure from
     nesting too deeply and looking ugly }

   var labval : labeltype;
       addrkind : addrtype;
       Iv,Iv2, Cv, CHv, Bv, Pv, i : integer;
       Rv : real;
       BSv : bitsettype;
       num : integer;
       ch : char;
       litstr : string80;

   begin
      case operation of

         iLDC : begin { load constant }
            case opertype of
               int : begin read(CodeFile,Iv); PackInt(PCntr,Iv); end;
              card : begin read(CodeFile,Cv); PackCard(PCntr,Cv); end;
              bool : begin read(CodeFile,Bv); PackBool(PCntr,Bv); end;
               chr : begin read(CodeFile,CHv); PackChar(PCntr,CHv); end;
              reel : begin read(CodeFile,Rv); PackReal(PCntr,Rv); end;
              pntr : begin read(CodeFile,Pv); PackPntr(PCntr,Pv); end;
                bs : begin
                        for i := 0 to BITSETSIZE do BSv[i] := FALSE;
                        repeat read(CodeFile,ch) until (ch = '(');
                        repeat
                           read(CodeFile,ch);
                           if (ch = ',') then begin
                             read(CodeFile,num);
                             if (num > BITSETSIZE) then begin
                               write(output,'***ERROR -- bitset value too');
                               writeln(output,' large at line ',iline+1:1);
                               end
                              else BSv[num] := TRUE;
                           end; { if ',' }
                        until (ch = ')');
                        PackBS(PCntr,BSv);
                     end; { bs }
              otherwise writeln('ASSEMBLY ERROR');
                end; { case }
             end; { iLDC }

         { form: op'<literal>' }
         iLCA : begin
                   litstr := '';
                   read(CodeFile,ch);
                   while not eoln(CodeFile) do begin
                      litstr[length(litstr)+1] := ch;
                      read(CodeFile,ch);
                      end;
                   PackChar(PCntr,length(litstr));
                   for i := 1 to length(litstr) do
                      PackChar(PCntr,ORD(litstr[i]));
                end;

         { form: op P Q }
         iLOD, iSTR, iLDA : begin
                   read(CodeFile,Pv,Iv);
                   PackAddr(PCntr,Pv);
                   PackAddr(PCntr,Iv);
                end;

         { form: op P Q }
         iCHK : begin
                   read(CodeFile,Pv,Iv);
                   PackInt(PCntr,Pv);
                   PackInt(PCntr,Iv);
                end;

         { form: op P Q <label> }
         iTST : begin
                   read(CodeFile,Pv,Iv);
                   PackInt(PCntr,Pv);
                   PackInt(PCntr,Iv);
                   ReadLabel(labval);
                   PackLabel(PCntr,labval);
                end;

         { form: op  Q }
         iIND, iMOV, iIXA : begin
                   read(CodeFile,Pv);
                   PackAddr(PCntr,Pv);
                end;

         { form: op Q }
         iINC, iDEC : begin
                         read(CodeFile,Iv);
                         PackInt(PCntr,Iv);
                      end;

         { form: op }
         iSTO, iMP, iDV, iAD, iSB, iNG, iMOD, iUNI, iINT, iDIF, iWRT, iSTOP,
         iWRTLN, iCTOI, iCHTOI, iBTOI, iITOC, iCHTOC, iBTOC,
         iGEQ, iEQU, iLEQ, iLES, iXJP :
            { nothing to do } ;

         { form: op <label> }
         iJUN, iFJP, iTJP : begin
               ReadLabel(labval);
               PackLabel(PCntr, labval);
            end;

         iENTR : begin
              read(CodeFile,entrypoint);
              PCntr := entrypoint;
           end;

      end; { case operation }

      readln(CodeFile); iline := iline + 1;

   end; { procedure AssembleRestOfLine }

   {=======================================================================}

begin { procedure Assemble }

   { first check for a comment line }
   read(CodeFile,ch);
   if (ch = '*') then begin
      readln(CodeFile); iline := iline + 1; end

   else if (ch = '"') then begin
      readln(CodeFile,textline); iline := iline + 1;
      PackChar(PCntr,length(textline));
      for i := 1 to length(textline) do
         PackChar(PCntr,ORD(textline[i]));
      end

   else begin
      { read in the operation mnemonic }
      i := 0; opstr := '';
      loop
         i := i+1; opstr[i] := ch;
         when eoln(CodeFile) do exit;
         read(CodeFile,ch); 
         when (ch < 'A') or (ch > 'Z') do exit;
      end; { loop }

      if (opstr = 'L') then begin { insert a label }
         ReadLabel(labval);
         readln(CodeFile); iline := iline + 1;
         if (LabelTable[labval] <> 0) then begin
            write(output,'***ERROR -- label ',labval:1);
            writeln(output,' redefined at line #',iline);
            end
         else LabelTable[labval] := PCntr;
         end

      else begin { not a label }
         { try to find the longest mnemonic which matches the start }
         operation := iERR;
         for op := iLDC to iERR do
            if (length(Mnem[op]) <= length(opstr)) then
               if (opstr[1..length(Mnem[op])] = Mnem[op]) then
                  if (length(Mnem[op]) > length(Mnem[operation])) 
                  or (operation = iERR) then
                     operation := op;

         if (operation = iERR) then begin
            readln(CodeFile); iline := iline + 1;
            writeln(output,'***ERROR -- bad opcode at line #',iline);
            end

         else begin { good Mnemonic }
            opertype := undef;
            if (Mnem[operation] <> opstr) then { find type }
               if (length(opstr) - length(Mnem[operation]) <> 1) then
                  writeln(output,'***ERROR -- bad opcode at line #',iline)
               else begin
                  for optype := int to strng do
                     if (opstr[length(opstr)] = TypeMnem[optype]) then
                        opertype := optype;
                  if (opertype = undef) then begin
                     readln(CodeFile); iline := iline + 1;
                     write(output,'***ERROR -- unrecognized instruction ');
                     writeln(output,opstr,' at line ',iline:1);
                     end
                  else if not (opertype in OpTypes[operation]) then begin
                     readln(CodeFile); iline := iline + 1;
                     write(output,'***ERROR -- illegal type mode ',opstr);
                     writeln(output,' at line ',iline:1);
                     end;
                  end;

            if (operation <> iENTR) then
               PackInstruction(PCntr,operation,opertype);
            AssembleRestOfLine;
         end; { good Mnemonic }

      end; { not a label }

   end; { not a comment }
end; { procedure assemble }


{$BOX
  This procedure reads in the entirety of the code file and assembles
  each line until the end of file is reached.
$EBOX}

procedure AssembleFile;
var addr : addrtype;
begin
   addr := 0;
   while not eof(CodeFile) do
      Assemble(PCntr);
   writeln(output,'program is ',(PCntr-entrypoint):1,' bytes long.');
end; { procedure AssembleFile }
{ disassemble instruction }

procedure Disassemble(var PCntr : integer);

var operation : ISet;
    opertype  : BasicTypes;
    addrkind : addrtype;
    Iv,Iv2, Cv, CHv, Bv, Pv : integer;
    Rv : real;
    BSv : bitsettype;
    labval : labeltype;
    num : integer;
    i : integer;

begin
   write(output,PCntr:5,' : ');
   UnPackInstruction(PCntr,operation,opertype);
   write(output,Mnem[operation]);

   case operation of

      iJUN, iFJP, iTJP : begin
         UnPackLabel(PCntr,labval);
         writeln(output,'  ',LabelTable[labval]:1);
         end;

      iCTOI,iCHTOI,iBTOI,iITOC,iCHTOC,iBTOC,iWRTLN,iSTOP,iINT,iDIF,iUNI,
      iXJP :
         writeln(output);

      iSTO, iMP, iDV, iAD, iSB, iNG, iMOD, iWRT, iGEQ, iEQU, iLEQ, iLES :
         writeln(output,TypeMnem[opertype]);

      iLDC : begin { immediate value load }
         write(output,TypeMnem[opertype],'  ');
         case opertype of
            int : begin UnPackInt(PCntr,Iv); writeln(output,Iv:1); end;
           card : begin UnPackCard(PCntr,Cv); writeln(output,Cv:1); end;
           reel : begin UnPackReal(PCntr,Rv); writeln(output,Rv:1); end;
            chr : begin UnPackChar(PCntr,CHv); writeln(output,CHv:1); end;
           bool : begin UnPackBool(PCntr,Bv); writeln(output,Bv:1); end;
           pntr : begin UnPackPntr(PCntr,Pv); writeln(output,Pv:1); end;
             bs : begin
                     UnPackBS(PCntr,BSv);
                     write(output,'{');
                     for i := 0 to BITSETSIZE do
                        if BSv[i] then write(output,i:1,',');
                     writeln('}');
                  end; { bs }
       otherwise ;
         end; { case }
      end;

      iLCA : begin
                UnPackChar(PCntr,num);
                write(output,'''');
                for i := 1 to num do begin
                   UnPackChar(PCntr, CHv);
                   write(output,CHAR(CHv));
                   end;
                writeln(output,'''');
             end;

      iMOV, iIXA : begin
               UnPackAddr(PCntr,addrkind);
               writeln(output,'  ',addrkind:1);
            end;

      iIND : begin
               write(output,TypeMnem[opertype],'  ');
               UnPackAddr(PCntr,addrkind);
               writeln(output,addrkind:1);
            end;

      iLOD, iSTR : begin
         write(output,TypeMnem[opertype],'  ');
         UnPackAddr(PCntr,addrkind);
         UnPackAddr(PCntr,num);
         writeln(output,addrkind:1,'  ',num:1);
         end;

      iCHK : begin
         write(output,TypeMnem[opertype],'  ');
         UnPackInt(PCntr,Iv);
         UnPackInt(PCntr,Iv2);
         writeln(output,Iv:1,'  ',Iv2:1);
         end;

      iTST : begin
         write(output,TypeMnem[opertype],'  ');
         UnPackInt(PCntr,Iv);
         UnPackInt(PCntr,Iv2);
         UnPackLabel(PCntr,labval);
         writeln(output,Iv:1,'  ',Iv2:1,'  ',LabelTable[labval]);
         end;

      iLDA : begin
         UnPackAddr(PCntr,addrkind);
         UnPackAddr(PCntr,num);
         writeln(output,'  ',addrkind:1,'  ',num:1);
         end;

      iINC, iDEC : begin
                      UnPackInt(PCntr,Iv);
                      writeln(output,TypeMnem[opertype],'  ',Iv:1);
                   end;

      otherwise writeln(output,'???');

   end; { case operation }

end; { procedure Disassemble }
{ interpret program }

procedure InterpOne(var PCntr, SPntr : addrtype; var Halted : boolean);

var operation : ISet;
    opertype  : BasicTypes;
    destaddr, srcaddr, PCbefore : addrtype;
    Iv, Cv, CHv, Bv, Pv, P, offset : integer;
    Iv2, Iv3, Cv2, CHv2, Bv2, Pv2 : integer;
    Rv, Rv2 : real;
    BSv, BSv2 : bitsettype;
    labval : labeltype;
    num : integer;
    i : integer;
    test : boolean;

begin
   PCbefore := PCntr; { in case of error condition or STOP }
   Halted := false;
   UnPackInstruction(PCntr,operation,opertype);
   case operation of
      iLDC : begin
               case opertype of
                    int : begin
                             UnPackInt(PCntr,Iv);
                             StackInt(SPntr,Iv);
                          end;
                   card : begin
                             UnPackCard(PCntr,Cv);
                             StackCard(SPntr,Cv);
                          end;
                   bool : begin
                             UnPackBool(PCntr,Bv);
                             StackBool(SPntr,Bv);
                          end;
                   reel : begin
                             UnPackReal(PCntr,Rv);
                             StackReal(SPntr,Rv);
                          end;
                    chr : begin
                             UnPackChar(PCntr,CHv);
                             StackChar(SPntr,CHv);
                          end;
                     bs : begin
                             UnPackBS(PCntr,BSv);
                             StackBS(SPntr,BSv);
                          end;
                   pntr : begin
                             UnPackPntr(PCntr,Pv);
                             StackPntr(SPntr,Pv);
                          end;
                  otherwise ;
               end; { case }
            end; { iLDC }

         iLCA : begin
               StackPntr(SPntr, PCntr);
               UnPackChar(PCntr, Iv);
               PCntr := PCntr + Iv;
            end; { iLCA }

         iLOD : begin
                  UnPackAddr(PCntr,P);
                  UnPackAddr(PCntr,srcaddr);
                  case opertype of
                       int : begin
                                FetchInt(srcaddr,Iv);
                                StackInt(SPntr,Iv);
                             end;
                      card : begin
                                FetchCard(srcaddr,Cv);
                                StackCard(SPntr,Cv);
                             end;
                      bool : begin
                                FetchBool(srcaddr,Bv);
                                StackBool(SPntr,Bv);
                             end;
                      reel : begin
                                FetchReal(srcaddr,Rv);
                                StackReal(SPntr,Rv);
                             end;
                       chr : begin
                                FetchChar(srcaddr,CHv);
                                StackChar(SPntr,CHv);
                             end;
                        bs : begin
                                FetchBS(srcaddr,BSv);
                                StackBS(SPntr,BSv);
                             end;
                      pntr : begin
                                FetchPntr(srcaddr,Pv);
                                StackPntr(SPntr,Pv);
                             end;
                     otherwise ;
                  end; { case }
               end; { iLOD }

         iCHK : begin
                  UnPackInt(PCntr,Iv2);
                  UnPackInt(PCntr,Iv3);
                  case opertype of
                       int : begin
                                UnStackInt(SPntr,Iv);
                                StackInt(SPntr,Iv);
                             end;
                      card : begin
                                UnStackCard(SPntr,Iv);
                                StackCard(SPntr,Iv);
                             end;
                       chr : begin
                                UnStackChar(SPntr,Iv);
                                StackChar(SPntr,Iv);
                             end;
                      pntr : begin
                                UnStackPntr(SPntr,Iv);
                                StackPntr(SPntr,Iv);
                             end;
                     otherwise ;
                  end; { case }
                  If (Iv < Iv2) or (Iv > Iv3) then begin
                     writeln(output,'***ERROR -- range check failure');
                     writeln(output,'val=',Iv:1,' range=[',Iv2:1,',',Iv3:1,']');
                     PCntr := PCbefore;
                     Halted := TRUE;
                     end;
               end; { iCHK }

         iTST : begin
                  UnPackInt(PCntr,Iv2);
                  UnPackInt(PCntr,Iv3);
                  UnPackLabel(PCntr,labval);
                  test := false;
                  case opertype of
                       int : begin
                                UnStackInt(SPntr,Iv);
                                If (Iv >= Iv2) and (Iv <= Iv3) then
                                   StackInt(SPntr,Iv)
                                else test := TRUE;
                             end;
                      card : begin
                                UnStackCard(SPntr,Iv);
                                If (Iv >= Iv2) and (Iv <= Iv3) then
                                   StackCard(SPntr,Iv)
                                else test := TRUE;
                             end;
                       chr : begin
                                UnStackChar(SPntr,Iv);
                                If (Iv >= Iv2) and (Iv <= Iv3) then
                                   StackChar(SPntr,Iv)
                                else test := TRUE;
                             end;
                      pntr : begin
                                UnStackPntr(SPntr,Iv);
                                If (Iv >= Iv2) and (Iv <= Iv3) then
                                   StackPntr(SPntr,Iv)
                                else test := TRUE;
                             end;
                     otherwise ;
                  end; { case }
                  if test then
                     if (LabelTable[labval] = 0) then begin
                        write(output,'***ERROR -- undefined label ');
                        writeln(output,labval:1);
                        PCntr := PCbefore;
                        Halted := true;
                        end
                     else PCntr := LabelTable[labval];
               end; { iTST }

         iSTR : begin
                  UnPackAddr(PCntr,P);
                  UnPackAddr(PCntr,destaddr);
                  case opertype of
                       int : begin
                                UnStackInt(SPntr,Iv);
                                StoreInt(destaddr,Iv);
                             end;
                      card : begin
                                UnStackCard(SPntr,Cv);
                                StoreCard(destaddr,Cv);
                             end;
                      bool : begin
                                UnStackBool(SPntr,Bv);
                                StoreBool(destaddr,Bv);
                             end;
                      reel : begin
                                UnStackReal(SPntr,Rv);
                                StoreReal(destaddr,Rv);
                             end;
                       chr : begin
                                UnStackChar(SPntr,CHv);
                                StoreChar(destaddr,CHv);
                             end;
                        bs : begin
                                UnStackBS(SPntr,BSv);
                                StoreBS(destaddr,BSv);
                             end;
                      pntr : begin
                                UnStackBS(SPntr,BSv);
                                StoreBS(destaddr,BSv);
                             end;
                     otherwise ;
                  end; { case }
               end; { iSTR }

         iLDA : begin
                  UnPackAddr(PCntr,P);
                  UnPackAddr(PCntr,destaddr);
                  StackPntr(SPntr,destaddr);
                end; { iLDA }

         iIND : begin
                  UnPackAddr(PCntr,offset);
                  UnStackPntr(SPntr,Pv);
                  Pv := Pv + offset;
                  case opertype of
                     int : begin
                              FetchInt(Pv,Iv);
                              StackInt(SPntr,Iv);
                           end;
                    card : begin
                              FetchCard(Pv,Cv);
                              StackCard(SPntr,Cv);
                           end;
                    reel : begin
                              FetchReal(Pv,Rv);
                              StackReal(SPntr,Rv);
                           end;
                    bool : begin
                              FetchBool(Pv,Bv);
                              StackBool(SPntr,Bv);
                           end;
                     chr : begin
                              FetchChar(Pv,CHv);
                              StackChar(SPntr,CHv);
                           end;
                    pntr : begin
                              FetchPntr(Pv,Pv2);
                              StackPntr(SPntr,Pv2);
                           end;
                      bs : begin
                              FetchBS(Pv,BSv);
                              StackBS(SPntr,BSv);
                           end;
                   end; { case }
                end; { iIND }

         iSTO : begin
                  case opertype of
                     int : begin
                              UnStackInt(SPntr,Iv);
                              UnStackPntr(SPntr,Pv);
                              StoreInt(Pv,Iv);
                           end;
                    card : begin
                              UnStackCard(SPntr,Cv);
                              UnStackPntr(SPntr,Pv);
                              StoreCard(Pv,Cv);
                           end;
                    reel : begin
                              UnStackReal(SPntr,Rv);
                              UnStackPntr(SPntr,Pv);
                              StoreReal(Pv,Rv);
                           end;
                    bool : begin
                              UnStackBool(SPntr,Bv);
                              UnStackPntr(SPntr,Pv);
                              StoreBool(Pv,Bv);
                           end;
                     chr : begin
                              UnStackChar(SPntr,CHv);
                              UnStackPntr(SPntr,Pv);
                              StoreChar(Pv,CHv);
                           end;
                    pntr : begin
                              UnStackPntr(SPntr,Pv2);
                              UnStackPntr(SPntr,Pv);
                              StorePntr(Pv,Pv2);
                           end;
                      bs : begin
                              UnStackBS(SPntr,BSv);
                              UnStackPntr(SPntr,Pv);
                              StoreBS(Pv,BSv);
                           end;
                  end; { case }
                end; { iSTO }

        iMOV : begin
                  UnPackCard(PCntr,Cv);
                  UnStackPntr(SPntr,Pv);
                  UnStackPntr(SPntr,Pv2);
                  for i := 0 to Cv-1 do M[Pv2+i] := M[Pv+i];
               end; { iMOV }

         iMP : begin
                  case opertype of
                       int : begin
                                UnStackInt(SPntr,Iv);
                                UnStackInt(SPntr,Iv2);
                                StackInt(SPntr,Iv*Iv2);
                             end;
                      card : begin
                                UnStackCard(SPntr,Cv);
                                UnStackCard(SPntr,Cv2);
                                StackCard(SPntr,Cv*Cv2);
                             end;
                      reel : begin
                                UnStackReal(SPntr,Rv);
                                UnStackReal(SPntr,Rv2);
                                StackReal(SPntr,Rv*Rv2);
                             end;
                     otherwise ;
                  end; { case }
               end; { iMP }

         iDV : begin
                  case opertype of
                       int : begin
                                UnStackInt(SPntr,Iv2);
                                UnStackInt(SPntr,Iv);
                                StackInt(SPntr,Iv DIV Iv2);
                             end;
                      card : begin
                                UnStackCard(SPntr,Cv2);
                                UnStackCard(SPntr,Cv);
                                StackCard(SPntr,Cv DIV Cv2);
                             end;
                      reel : begin
                                UnStackReal(SPntr,Rv2);
                                UnStackReal(SPntr,Rv);
                                StackReal(SPntr,Rv / Rv2);
                             end;
                        bs : begin { symmetric set difference }
                                UnStackBS(SPntr,BSv2);
                                UnStackBS(SPntr,BSv);
                                { form set difference }
                                for i := 0 to BITSETSIZE do
                                   BSv[i] := (not BSv[i] AND BSv2[i]) OR
                                             (BSv[i] AND not BSv2[i]);
                                StackBS(SPntr,BSv);
                             end;
                     otherwise ;
                  end; { case }
               end; { iDV }

         iAD : begin
                  case opertype of
                       int : begin
                                UnStackInt(SPntr,Iv);
                                UnStackInt(SPntr,Iv2);
                                StackInt(SPntr,Iv+Iv2);
                             end;
                      card : begin
                                UnStackCard(SPntr,Cv);
                                UnStackCard(SPntr,Cv2);
                                StackCard(SPntr,Cv+Cv2);
                             end;
                      reel : begin
                                UnStackReal(SPntr,Rv);
                                UnStackReal(SPntr,Rv2);
                                StackReal(SPntr,Rv+Rv2);
                             end;
                     otherwise ;
                  end; { case }
               end; { iAD }

         iSB : begin
                  case opertype of
                       int : begin
                                UnStackInt(SPntr,Iv2);
                                UnStackInt(SPntr,Iv);
                                StackInt(SPntr,Iv-Iv2);
                             end;
                      card : begin
                                UnStackCard(SPntr,Cv2);
                                UnStackCard(SPntr,Cv);
                                StackCard(SPntr,Cv-Cv2);
                             end;
                      reel : begin
                                UnStackReal(SPntr,Rv2);
                                UnStackReal(SPntr,Rv);
                                StackReal(SPntr,Rv-Rv2);
                             end;
                     otherwise ;
                  end; { case }
               end; { iSB }

        iINT : begin
                  UnStackBS(SPntr,BSv);
                  UnStackBS(SPntr,BSv2);
                  { form set intersection }
                  for i := 0 to BITSETSIZE do
                     BSv[i] := BSv[i] AND BSv2[i];
                  StackBS(SPntr,BSv);
               end;

        iUNI : begin
                  UnStackBS(SPntr,BSv);
                  UnStackBS(SPntr,BSv2);
                  { form set union }
                  for i := 0 to BITSETSIZE do
                     BSv[i] := BSv[i] OR BSv2[i];
                  StackBS(SPntr,BSv);
               end;

        iIXA : begin
                  UnPackAddr(PCntr,Iv);
                  UnStackPntr(SPntr,Cv);
                  UnStackPntr(SPntr,Pv);
                  StackPntr(SPntr,Pv+Iv*Cv);
               end; { iIXA }

        iMOD : begin
                  case opertype of
                       int : begin
                                UnStackInt(SPntr,Iv2);
                                UnStackInt(SPntr,Iv);
                                StackInt(SPntr,Iv MOD Iv2);
                             end;
                      card : begin
                                UnStackCard(SPntr,Cv2);
                                UnStackCard(SPntr,Cv);
                                StackCard(SPntr,Cv MOD Cv2);
                             end;
                     otherwise ;
                  end; { case }
               end; { iMOD }

         iNG : begin
                  case opertype of
                       int : begin
                                UnStackInt(SPntr,Iv);
                                StackInt(SPntr,- Iv);
                             end;
                      reel : begin
                                UnStackReal(SPntr,Rv);
                                StackReal(SPntr,- Rv);
                             end;
                        bs : begin { complement set }
                                UnStackBS(SPntr,BSv);
                                { form set intersection }
                                for i := 0 to BITSETSIZE do
                                   BSv[i] := not BSv[i];
                                StackBS(SPntr,BSv);
                             end;
                     otherwise ;
                  end; { case }
               end; { iNG }

        iINC : begin
                  UnPackInt(PCntr,num);
                  case opertype of
                       int : begin
                                UnStackInt(SPntr,Iv);
                                StackInt(SPntr,Iv + num);
                             end;
                      card : begin
                                UnStackCard(SPntr,Cv);
                                StackCard(SPntr,Cv + num);
                             end;
                       chr : begin
                                UnStackChar(SPntr,CHv);
                                StackChar(SPntr,CHv + num);
                             end;
                      pntr : begin
                                UnStackPntr(SPntr,Pv);
                                StackPntr(SPntr,Pv + num);
                             end;
                     otherwise ;
                  end; { case }
               end; { iINC }

        iDEC : begin
                  UnPackInt(PCntr,num);
                  case opertype of
                       int : begin
                                UnStackInt(SPntr,Iv);
                                StackInt(SPntr,Iv - num);
                             end;
                      card : begin
                                UnStackCard(SPntr,Cv);
                                StackCard(SPntr,Cv - num);
                             end;
                       chr : begin
                                UnStackChar(SPntr,CHv);
                                StackChar(SPntr,CHv - num);
                             end;
                      pntr : begin
                                UnStackPntr(SPntr,Pv);
                                StackPntr(SPntr,Pv - num);
                             end;
                     otherwise ;
                  end; { case }
               end; { iDEC }

        iGEQ : begin
                  test := false;
                  case opertype of
                       int : begin
                                UnStackInt(SPntr,Iv);
                                UnStackInt(SPntr,Iv2);
                                if (Iv2 >= Iv) then test := true;
                             end;
                      card : begin
                                UnStackCard(SPntr,Cv);
                                UnStackCard(SPntr,Cv2);
                                if (Cv2 >= Cv) then test := true;
                             end;
                      bool : begin
                                UnStackBool(SPntr,Bv);
                                UnStackBool(SPntr,Bv2);
                                if (Bv2 >= Bv) then test := true;
                             end;
                      reel : begin
                                UnStackReal(SPntr,Rv);
                                UnStackReal(SPntr,Rv2);
                                if (Rv2 >= Rv) then test := true;
                             end;
                       chr : begin
                                UnStackChar(SPntr,CHv);
                                UnStackChar(SPntr,CHv2);
                                if (CHv2 >= CHv) then test := true;
                             end;
                        bs : begin  { incomplete }
                                UnStackBS(SPntr,BSv);
                                UnStackBS(SPntr,BSv2);
                                if (CHv2 = CHv) then test := true;
                             end;
                     otherwise ;
                  end; { case }
                  if test then StackBool(SPntr,BOOLTRUEVAL)
                          else StackBool(SPntr,BOOLFALSEVAL);
               end; { iGEQ }


        iEQU : begin
                  test := false;
                  case opertype of
                       int : begin
                                UnStackInt(SPntr,Iv);
                                UnStackInt(SPntr,Iv2);
                                if (Iv2 = Iv) then test := true;
                             end;
                      card : begin
                                UnStackCard(SPntr,Cv);
                                UnStackCard(SPntr,Cv2);
                                if (Cv2 = Cv) then test := true;
                             end;
                      bool : begin
                                UnStackBool(SPntr,Bv);
                                UnStackBool(SPntr,Bv2);
                                if (Bv2 = Bv) then test := true;
                             end;
                      reel : begin
                                UnStackReal(SPntr,Rv);
                                UnStackReal(SPntr,Rv2);
                                if (Rv2 = Rv) then test := true;
                             end;
                       chr : begin
                                UnStackChar(SPntr,CHv);
                                UnStackChar(SPntr,CHv2);
                                if (CHv2 = CHv) then test := true;
                             end;
                        bs : begin
                                UnStackBS(SPntr,BSv);
                                UnStackBS(SPntr,BSv2);
                                if (CHv2 = CHv) then test := true;
                             end;
                     otherwise ;
                  end; { case }
                  if test then StackBool(SPntr,BOOLTRUEVAL)
                          else StackBool(SPntr,BOOLFALSEVAL);
               end; { iEQU }

        iLEQ : begin
                  test := false;
                  case opertype of
                       int : begin
                                UnStackInt(SPntr,Iv);
                                UnStackInt(SPntr,Iv2);
                                if (Iv2 <= Iv) then test := true;
                             end;
                      card : begin
                                UnStackCard(SPntr,Cv);
                                UnStackCard(SPntr,Cv2);
                                if (Cv2 <= Cv) then test := true;
                             end;
                      bool : begin
                                UnStackBool(SPntr,Bv);
                                UnStackBool(SPntr,Bv2);
                                if (Bv2 <= Bv) then test := true;
                             end;
                      reel : begin
                                UnStackReal(SPntr,Rv);
                                UnStackReal(SPntr,Rv2);
                                if (Rv2 <= Rv) then test := true;
                             end;
                       chr : begin
                                UnStackChar(SPntr,CHv);
                                UnStackChar(SPntr,CHv2);
                                if (CHv2 <= CHv) then test := true;
                             end;
                        bs : begin  { incomplete }
                                UnStackBS(SPntr,BSv);
                                UnStackBS(SPntr,BSv2);
                                if (CHv2 <= CHv) then test := true;
                             end;
                     otherwise ;
                  end; { case }
                  if test then StackBool(SPntr,BOOLTRUEVAL)
                          else StackBool(SPntr,BOOLFALSEVAL);
               end; { iLEQ }

        iLES : begin
                  test := false;
                  case opertype of
                       int : begin
                                UnStackInt(SPntr,Iv);
                                UnStackInt(SPntr,Iv2);
                                if (Iv2 < Iv) then test := true;
                             end;
                      card : begin
                                UnStackCard(SPntr,Cv);
                                UnStackCard(SPntr,Cv2);
                                if (Cv2 < Cv) then test := true;
                             end;
                      bool : begin
                                UnStackBool(SPntr,Bv);
                                UnStackBool(SPntr,Bv2);
                                if (Bv2 < Bv) then test := true;
                             end;
                      reel : begin
                                UnStackReal(SPntr,Rv);
                                UnStackReal(SPntr,Rv2);
                                if (Rv2 < Rv) then test := true;
                             end;
                       chr : begin
                                UnStackChar(SPntr,CHv);
                                UnStackChar(SPntr,CHv2);
                                if (CHv2 < CHv) then test := true;
                             end;
                        bs : begin  { incomplete }
                                UnStackBS(SPntr,BSv);
                                UnStackBS(SPntr,BSv2);
                                if (CHv2 < CHv) then test := true;
                             end;
                     otherwise ;
                  end; { case }
                  if test then StackBool(SPntr,BOOLTRUEVAL)
                          else StackBool(SPntr,BOOLFALSEVAL);
               end; { iLES }

       iCTOI : begin
                  UnStackCard(SPntr,Cv);
                  StackInt(SPntr,Cv);
               end; { CTOI }

      iCHTOI : begin
                  UnStackChar(SPntr,CHv);
                  StackInt(SPntr,CHv);
               end; { CHTOI }

       iBTOI : begin
                  UnStackBool(SPntr,Bv);
                  StackInt(SPntr,Bv);
               end; { BTOI }

       iITOC : begin
                  UnStackInt(SPntr,Iv);
                  StackCard(SPntr,Iv);
               end; { ITOC }

      iCHTOC : begin
                  UnStackChar(SPntr,CHv);
                  StackCard(SPntr,CHv);
               end; { CHTOC }

       iBTOC : begin
                  UnStackBool(SPntr,Bv);
                  StackCard(SPntr,Bv);
               end; { BTOC }

        iWRT : begin
                  case opertype of
                       int : begin
                                UnStackInt(SPntr,Iv);
                                write(output,Iv);
                             end;
                      card : begin
                                UnStackCard(SPntr,Cv);
                                write(output,Cv);
                             end;
                      bool : begin
                                UnStackBool(SPntr,Bv);
                                if (Bv = BoolFalseVal) then
                                   write(output,' FALSE')
                                else
                                   write(output,' TRUE')
                             end;
                      reel : begin
                                UnStackReal(SPntr,Rv);
                                write(output,Rv);
                             end;
                       chr : begin
                                UnStackChar(SPntr,CHv);
                                write(output,CHAR(CHv));
                             end;
                        bs : begin
                                UnStackBS(SPntr,BSv);
                                write(output,'{');
                                for i := 0 to BITSETSIZE do
                                   if BSv[i] then write(output,i:1,',');
                                write('}');
                             end;
                      pntr : begin
                                UnStackPntr(SPntr,Pv);
                                write(output,Pv);
                             end;
                     strng : begin
                                UnStackPntr(SPntr,Pv);
                                FetchChar(Pv,Cv);
                                for i := 1 to Cv do begin
                                   FetchChar(Pv+i,CHv);
                                   write(output,CHAR(CHv));
                                   end;
                             end;
                     otherwise ;
                  end; { case }
               end; { WRT }

       iWRTLN : writeln(output);

       iSTOP : begin
                  PCntr := PCbefore; { make PC freeze on a STOP }
                  writeln(output,'STOPPED AT ',PCntr:1);
                  Halted := true;
               end; { STOP }

        iXJP : begin
                  UnStackCard(SPntr,Cv);
                  PCntr := PCntr + Cv * 4; { 4 bytes per jump entry }
               end;

        iJUN : begin
                  UnPackLabel(PCntr,labval);
                  if (LabelTable[labval] = 0) then begin
                     write(output,'***ERROR -- undefined label ');
                     writeln(output,labval:1);
                     PCntr := PCbefore;
                     Halted := true;
                     end
                  else PCntr := LabelTable[labval];
               end;

        iFJP : begin
                  UnPackLabel(PCntr,labval);
                  UnStackBool(SPntr,Bv);
                  if (Bv = BOOLFALSEVAL) then
                     if (LabelTable[labval] = 0) then begin
                        write(output,'***ERROR -- undefined label ');
                        writeln(output,labval:1);
                        PCntr := PCbefore;
                        Halted := true;
                        end
                     else PCntr := LabelTable[labval];
               end;

        iTJP : begin
                  UnPackLabel(PCntr,labval);
                  UnStackBool(SPntr,Bv);
                  if (Bv = BOOLTRUEVAL) then
                     if (LabelTable[labval] = 0) then begin
                        write(output,'***ERROR -- undefined label ');
                        writeln(output,labval:1);
                        PCntr := PCbefore;
                        Halted := true;
                        end
                     else PCntr := LabelTable[labval];
               end;

        iERR : begin
                  writeln(output,'iERR encountered at ',PCntr:1);
                  PCntr := PCbefore;
                  Halted := true;
               end;

    otherwise ;
   end; { case operation of }
      
end; { procedure InterpOne }
{ handy subroutines }

{ this function takes a string and removes the first word and returns
  that word as the second parameter.  A word is anything that doesn't
  start with a space and ends with either a space or end of string. }

procedure FirstWord(var str, result : string80);
var pos : integer;
begin
   loop when (length(str)=0) do exit;
        when (str[1] <> ' ') do exit;
        str := str[2..length(str)];
   end; { loop }
   result := '';
   loop when (length(str)=0) do exit;
        when (str[1] = ' ') do exit;
        result[length(result)+1] := str[1];
        str := str[2..length(str)];
   end; { loop }
end; { procedure FirstWord }

{======================================================================}

{ this function returns true if the character passed is an ascii decimal }

function Adigit(ch : char) : boolean;
begin
   if (ch >= '0') and (ch <= '9') then
      Adigit := true
   else
      Adigit := false;
end; { procedure Adigit }

{======================================================================}

function Num(ch : char) : integer;
begin
   Num := ORD(ch) - ORD('0');
end; { function Num }

{======================================================================}

{ this procedure is entered with a string representing some type of number }

procedure ScanNum(str : string80; var Converted : eithernum);

var intval : integer;     { used for accumulating numbers }
    Rval : real;          { used for forming a real constant }
    Power : integer;      { used for scaling real number }
    pos : integer;
    sign : integer;

begin
   pos := 1;
   if (length(str) < 80) then str[length(str)+1] := ' ';
   sign := 1;
   if (str[1] = '+') then pos := 2;
   if (str[1] = '-') then begin pos := 2; sign := -1; end;

   intval := 0;

   if not Adigit(str[pos]) then
      Converted.numkind := bad

   else begin { it starts with a digit }
      while Adigit(str[pos]) do begin
         if (intval > (MAXINT div 10) - Num(str[pos])) then begin
            writeln(output,'ERROR -- number too large');
            intval := 0;
            end
         else intval := intval * 10 + Num(str[pos]);
         pos := pos + 1;
         end; { while }

      if (str[pos] <> '.') then begin { it is an integer }
         Converted.numkind := intnum;
         Converted.Ival := intval * sign;
         end
      else begin { it is a real number }
         pos := pos + 1;
         Rval := intval;
         Power := 1;
         while Adigit(str[pos]) do begin
            Rval := 10.0 * Rval + Num(str[pos]);
            Power := Power * 10;
            pos := pos + 1;
            end; { while }
         Rval := Rval / Power; { normalize the fractional part }
         Converted.numkind := realnum;
         Converted.Rval := sign * Rval;
      end; { it is a real number }
   end; { it starts with a digit }
end; { procedure ScanNum }

{======================================================================}

procedure Upper(var str : string80);
var i : integer;
begin
   for i := 1 to length(str) do
      if (str[i] >= 'a') and (str[i] <= 'z') then
         str[i] := char(ord(str[i])-ord('a') + ord('A'));
end; { procedure Upper }
{ command handler }

procedure commandGO(var PCntr, SPntr : addrtype);
var Halted : boolean;
    breakcount : integer;
begin
   ENABLEBREAK; { don't allow program to be interrupted }
   repeat
      if (PCntr = PCBP) then Halted := TRUE
      else InterpOne(PCntr,SPntr,Halted);
      TESTBREAK(breakcount);
      if (breakcount > 0) then Halted := TRUE;
   until Halted;
   DISABLEBREAK; { allow program to be interrupted }
end; { procedure commandGO }


procedure commandLOAD(var PCntr : addrtype; command : string80);
var word : string80;
begin
   FirstWord(command,word);
   OpenFile(CodeFile,word);
   Init;
   AssembleFile;
   CloseFile(CodeFile);
   PCntr := entrypoint;
end; { procedure commandLOAD }


procedure commandPC(var PCntr : addrtype; command : string80);
var pcstr : string80;
    newpc : eithernum;
begin
   FirstWord(command,pcstr);
   ScanNum(pcstr,newpc);
   if (newpc.numkind <> intnum) then
      writeln(output,'ERROR -- integer expected')
   else PCntr := newpc.Ival;
end; { procedure commandPC }


procedure commandSP(var SPntr : addrtype; command : string80);
var spstr : string80;
    newsp : eithernum;
begin
   FirstWord(command,spstr);
   ScanNum(spstr,newsp);
   if (newsp.numkind <> intnum) then
      writeln(output,'ERROR -- integer expected')
   else SPntr := newsp.Ival;
end; { procedure commandSP }


procedure commandBP(command : string80);
var bpstr : string80;
    newbp : eithernum;
    temp : addrtype;
begin
   FirstWord(command,bpstr);
   if (bpstr = '') then
      if (PCBP < 0) then writeln(output,'No breakpoint set')
                    else begin
                       temp := PCBP;
                       write(output,'Breakpoint at ');
                       Disassemble(temp); end
   else begin
      ScanNum(bpstr,newbp);
      if (newbp.numkind <> intnum) then
         writeln(output,'ERROR -- integer expected')
      else PCBP := newbp.Ival;
   end;
end; { procedure commandBP }


procedure commandDIS(command : string80);
var PC2, number, i : integer;
    nextword : string80;
    converted : eithernum;
begin
   FirstWord(command,nextword);
   ScanNum(nextword,converted);
   if (converted.numkind <> intnum) then
      writeln(output,'ERROR -- integer expected')
   else begin
      PC2 := converted.Ival;
      FirstWord(command,nextword);
      ScanNum(nextword,converted);
      if (converted.numkind = realnum) then
         writeln(output,'ERROR -- integer expected')
      else begin
         number := 1;
         if (converted.numkind = intnum) then number := converted.Ival;
         for i := 1 to number do
            Disassemble(PC2);
         end;
      end;
end; { procedure commandDIS }


procedure commandD(command : string80);

var addr, Iv, CHv, Pv, i : integer;
    ch : char;
    mode : BasicTypes;
    Rv : real;
    BSv : bitsettype;
    num : eithernum;
    word : string80;

begin
   mode := int;
   FirstWord(command,word);
   ScanNum(word,num);
   if (num.numkind <> intnum) then
      writeln(output,'ERROR -- integer expected')
   else begin
      addr := num.Ival;
      while (addr > -1) and (addr < MEMSIZE) do begin
         format(output,'*');
         case mode of
             int : begin
                      FetchInt(addr,Iv);
                      writeln(output,addr:5,' : ',Iv);
                   end;
             chr : begin
                      FetchChar(addr,CHv);
                      writeln(output,addr:5,' : ',CHAR(CHv));
                   end;
            reel : begin
                      FetchReal(addr,Rv);
                      writeln(output,addr:5,' : ',Rv);
                   end;
              bs : begin
                      FetchBS(PCntr,BSv);
                      write(output,addr:5,' : {');
                      for i := 0 to BITSETSIZE do
                         if BSv[i] then write(output,i:1,',');
                      writeln('}');
                   end;
         end; { case }

         format(output,'*'); writeln(output,' ');
         readln(input,command); Upper(command);
         FirstWord(command,word);
         if (word = '+') then case mode of
               int : addr := addr + INTEGER_SIZE;
               chr : addr := addr + CHAR_SIZE;
              reel : addr := addr + REAL_SIZE;
                bs : addr := addr + BITSET_SIZE;
              end { case }
         else if (word = '-') then case mode of
               int : addr := addr - INTEGER_SIZE;
               chr : addr := addr - CHAR_SIZE;
              reel : addr := addr - REAL_SIZE;
                bs : addr := addr - BITSET_SIZE;
              end { case }
         else if (word = ':') then case mode of
               int : begin
                        FirstWord(command,word);
                        ScanNum(word,num);
                        if (num.numkind <> intnum) then
                           writeln(output,'ERROR -- integer expected')
                        else
                           StoreInt(addr,num.Ival);
                     end;
               chr : begin
                        FirstWord(command,word);
                        ScanNum(word,num);
                        if (num.numkind <> intnum) then
                           writeln(output,'ERROR -- integer expected')
                        else
                           StoreChar(addr,num.Ival);
                     end;
              reel : begin
                        FirstWord(command,word);
                        ScanNum(word,num);
                        if (num.numkind <> realnum) then
                           writeln(output,'ERROR -- real expected')
                        else
                           StoreReal(addr,num.Rval);
                     end;
                bs : { can't do it } ;
            end { case }
         else if (word = 'I') then mode := int
         else if (word = 'R') then mode := reel
         else if (word = 'C') then mode := chr
         else if (word = 'B') then mode := bs 
         else if (word = '@') then begin FetchPntr(addr,Pv); addr := Pv; end
         else addr := -1; { exit }
      end; { while }
   end; { good address }

end; { procedure commandD }


procedure commandHELP;
begin
   writeln('This is a list of the commands:');
   writeln('D        -- to display a location');
   writeln('GO       -- start program running');
   writeln('BP       -- to view/set a break point (-1 turns it off)');
   writeln('PC       -- to view/set the program counter');
   writeln('SP       -- to view/set the stack pointer');
   writeln('DIS      -- to disassemble a range of intructions');
   writeln('LOAD     -- to load in a new program');
   writeln('HELP     -- to get this message');
   writeln('EXIT     -- to quit program');
   writeln('<cr>     -- to single-step the program');
end; { procedure commandHELP }


procedure Run(PCntr, SPntr : addrtype);

var Halted, dummy : boolean;
    PC2 : addrtype;
    command, word : string80;
    single : boolean;

begin
   Halted := FALSE;
   PCBP := -1; { effectively turns off breakpoint }
   single := FALSE;
   repeat

      PC2 := PCntr;
      if not single then writeln(output);
      Disassemble(PC2);
      single := FALSE;
      format(output,'*'); writeln('>>');
      readln(input,command);
      Upper(command);
      FirstWord(command,word);
      if (word = '') then begin
         InterpOne(PCntr,SPntr,dummy); single := TRUE; end
      else if (word = 'EXIT') then Halted := TRUE
      else if (word = 'GO') then commandGO(PCntr,SPntr)
      else if (word = 'HELP') or (word = '?') or 
              (word = 'COMMANDS') then commandHELP
      else if (word = 'BP') then commandBP(command)
      else if (word = 'PC') then commandPC(PCntr,command)
      else if (word = 'SP') then commandSP(SPntr,command)
      else if (word = 'LOAD') then commandLOAD(PCntr,command)
      else if (word = 'DIS') then commandDIS(command)
      else if (word = 'D') then commandD(command)
      else writeln(output,'ERROR -- command not understood');

   until Halted;

end; { run }
{ main program }

var param, name : string80;
    initSP : addrtype;

begin
   GetProgramParms(param);
   Firstword(param,name);
   OpenFile(CodeFile,name);
   Init;
   AssembleFile;
   CloseFile(CodeFile);

   initSP := MEMSIZE;
   Run(entrypoint,initSP);

end. { program interp }