{

	This program is RISC CPU Simulator and its compiler.
	Caracteristics are: stacked registers, variable length instructions and minimal
	instructions set.
	Unfortunately the final version of this program is lost, this version
	(which I just retouched) works with Turbo Pascal 5.5. and is able to compile
	and execute the "bigsmall.asm" program (separate file) ...
	Turbo Pascal 5.5 is now free, see http://community.borland.com/museum/
	DM'03 

}

program moricpu;

Uses
  Crt,dos;

const
  MemBck=LightGray;
  MemCol=Black;
  Always=True;
  Relative=True;
  Saving=True;
  Signed=True;
  Unsigned=False;
  Conditional=True;
  UnConditional=False;

  SofOffset1=10;{Used by Jr jrz jrnz jrp jrn}
  SofOffset2=8; {Used by callr call }
  SofOffset3=5; {Used by peek rpeek poke rpoke}
  SofLiteral=10; {Used by # }
  SofReg=2; {used by   Bring Rx   and   Store Rx}

{  SofSofWord=6; }{used by   Peek xx   and   poke xx????  DM'03}

  BoolS:Array[False..True] of String[6] =('FALSE ','TRUE  ');
  TitleBar= '  PC   INSTRUCTION                    R0                  R1                  R2';
  TitleBar2='------ ------------- ------------------- ------------------- -------------------';
  TotalMemory=2048;
  LowestAddress=-1024;
  HighestAddress=1023;
  SizeOfWord=64;
  SpaceForDecimal=21;
  NumOfRegs=8;
  NumOfVisRegs=4;
  NumOfSubs=5;

type
  WinRec = Record
    X1,Y1,X2,Y2:Byte;
    X,Y,ATT:Byte;
    end;
  WPtr=^WinRec;
  Bit=0..1;
  MyWord=array[0..SizeOfWord-1] of Bit;
  MyAddress=Integer;
  MarkRec = Record
    Active:Boolean;
    Address:MyAddress;
    Bits:Integer;
    Bck,Col:Word;
    end;

var
  Mark:MarkRec;
  MEM:array [LowestAddress..HighestAddress] of Bit;
  DisplayedMem,PC:MyAddress;
  Sub:Array[0..NumOfSubs-1] of MyAddress; {the Subroutine Stack}
  Reg:Array[0..NumOfRegs-1] of MyWord;    {the Register Stack}
  RegS:Array[0..NumOfRegs-1] of String;
  StepModeIsWalking,CpuIsActive:Boolean;
  TraceHandle:Text;
  FileName,Trace:String;
  ScreenTraceW,InterfaceW,ConstantsW,ioW,cpuW,MemW:WinRec;
  CurrW:WPtr;
  MyLabel: Array[0..100] of Record
    Name:String;
    Address:MyAddress;
    end;
  UnsolvedInst: Array[0..100] of Record
    InstS:String;
    Address:MyAddress;
    end;
  NumOfLabels,NumOfUnsolvedInsts:Integer;









function AL(S:String;N:Integer):String;
begin
  AL:=S+copy('                    ',1,N-Length(S));
  end;

function AR(S:String;N:Integer):String;
begin
  AR:=copy('                    ',1,N-Length(S))+S;
  end;

function I2S(I:Integer):String;
var
  S:String;
begin
  Str(I,S);
  I2S:=S;
  end;


function Mad(Address:Integer):Integer;
begin
  Mad:= Address;
  if Address<LowestAddress then Mad:=Address+TotalMemory;
  if Address>HighestAddress then Mad:=Address-TotalMemory;
  end;








procedure UsingW(Var ToW:WinRec);
begin
  with CurrW^ do begin
    X:=WhereX;
    Y:=WhereY;
    ATT:=TextAttr;
    end;
  with ToW do begin
    window(X1,Y1,X2,Y2);
    gotoXY(X,Y);
    TextAttr:=ATT;
    end;
  CurrW:=@ToW;
  end;


procedure RefreshConstW;
var
  tmpW:WPtr;
begin
  tmpW:=CurrW;
  UsingW(ConstantsW);
    TextBackground(Black);
    ClrScr;
    WriteLn;
    TextBackGround(Black);
    TextColor(DarkGray);
    if CpuIsActive then TextBackground(Green);
    if CpuIsActive then TextColor(White);
    WriteLn('Step mode:');
    if StepModeIsWalking then WriteLn('Walking')
    else WriteLn('Running');
    WriteLn;
    TextBackGround(Black);
    TextColor(DarkGray);
    if CpuIsActive and (Trace<>'*Nowhere*') then begin
      TextBackground(Green);
      TextColor(White);
      end;
    WriteLn('Tracing to:');
    WriteLn(Trace);
    WriteLn;
    TextBackGround(Black);
    TextColor(DarkGray);
    if FileName<>'*None*' then TextBackground(Green);
    if FileName<>'*None*' then TextColor(White);
    WriteLn('Current program:');
    WriteLn(FileName);
    UsingW(tmpW^);
  end;


procedure DisplayMark(Address:MyAddress;Bits:Integer;Bck,Col:Word);
var
  t,X,Y:integer;
  tmpW:Wptr;
begin
  tmpW:=CurrW;
  UsingW(MemW);
    TextBackGround(Bck);
    TextColor(Col);
    for t:=Address to Address+Bits-1 do begin
      Y:=Mad(t-DisplayedMem);
      if Y<0 then Y:=Y-64;
      Y:=Y div 64;
      if Y<0 then Y:=Y+(TotalMemory div 64); {the total lines in the virtual screen}
      if Y<15 then begin
        X:=t mod 64;
        if t<0 then X:=X+64;
        gotoXY(8+X,Y+1);
        write(MEM[Mad(t)]);
        end;
      end;
    TextBackGround(MemBck);
    TextColor(MemCol);
    UsingW(tmpW^);
  end;

procedure ActivateMark(Address:MyAddress;Bits:Integer;Bck,Col:Word);
begin
  Mark.Active:=True;
  Mark.Address:=Address;
  Mark.Bits:=Bits;
  Mark.Bck:=Bck;
  Mark.Col:=Col;
  DisplayMark(Address,Bits,Bck,Col);
  end;

procedure DeactivateMark;
begin
  DisplayMark(Mark.Address,Mark.Bits,MemBck,MemCol);
  Mark.Active:=False;
  end;

procedure RefreshMemW(First:MyAddress);
var
  t,t2:MyAddress;
  tmpW:Wptr;
begin
  DisplayedMem:=Mad(First);
  tmpW:=CurrW;
  UsingW(MemW);
  gotoXY(1,1);
  for t:=0 to 14 do begin
    Write(AR(I2S(Mad(First+64*t)),6),':');
    for t2:=Mad(First+64*t) to Mad(First+64*t+63) do
      if MEM[t2]=0 then
      	Write(0)
      else
      	Write(1);
      {Write(MEM[t2]); <-- outputs bytes in TP5.5!! DM'03 }
    end;
  UsingW(tmpW^);
  With Mark do if Active then DisplayMark(Address,Bits,Bck,Col);
  end;

function GetKey:integer;
var
  Key:Integer;
begin
  if KeyPressed then begin
    Key:=ord(ReadKey);
    if Key=0 then Key:=-Ord(ReadKey);

    if Key=-59 {F1 key} then begin
      StepModeIsWalking:=not StepModeIsWalking;
      RefreshConstW;
      end
    else if Key=-72 {up key} then begin
      RefreshMemW(DisplayedMem-64);
      end
    else if Key=-80 {down key} then begin
      RefreshMemW(DisplayedMem+64);
      end;
    end
  else
    Key:=0;
  GetKey:=Key;
  end;

procedure Peek(Address:MyAddress;Bits:Integer;var Num:MyWord);
Var
  t:Integer;
begin
  for t:=0 to Bits-1 do Num[t]:=MEM[Mad(Address+t)];
  inc(t);
  while t<SizeOfWord do begin        {extend the sign in the Variable}
    Num[t]:=MEM[Mad(Address+Bits-1)];
    inc(t);
    end;
  end;

procedure Poke(Address:MyAddress;Bits:Integer;var Num:MyWord);
Var
  t:Integer;
begin
  for t:=0 to Bits-1 do MEM[Mad(Address+t)]:=Num[t];
  end;


procedure Out(S:String);
var
  tmpW:Wptr;
begin
  tmpW:=CurrW;
  UsingW(ScreenTraceW);
    Write(S);
    UsingW(tmpW^);
  if Trace<>'*Nowhere*' then Write(TraceHandle,S);
  end;


function ZeroFlag(Var W:MyWord):Boolean;
var
  t:Integer;
begin
  ZeroFlag:=True;
  for t:=0 to SizeOfWord-1 do
    if W[t]=1 then ZeroFlag:=False;
  end;

procedure MakeSpaceInRegs; {It is a dup, but it will never be used for that}
var
  t:integer;
begin
  for t:=NumOfRegs-1 Downto 1 do begin
    Reg[t]:=Reg[t-1];
    RegS[t]:=RegS[t-1];
    end;
  RegS[0]:='?';
  end;

procedure DumpTopReg;
var
  t:integer;
begin
  for t:=0 to NumOfRegs-2 do begin
    Reg[t]:=Reg[t+1];
    RegS[t]:=RegS[t+1];
    end;
  for t:=0 to SizeOfWord-1 do Reg[NumOfRegs-1,t]:=0;
  RegS[NumOfRegs-1]:='?';
  end;

procedure MakeSpaceInSubs; {It is a dup, but it will never be used for that}
var
  t:integer;
begin
  for t:=NumOfSubs-1 Downto 1 do Sub[t]:=Sub[t-1];
  end;

procedure DumpTopR;
var
  t:integer;
begin
  for t:=0 to NumOfSubs-2 do Sub[t]:=Sub[t+1];
  Sub[NumOfSubs-1]:=0;
  end;


procedure OpAdd(Var A,B,Res:MyWord); {Res may be A or B}
var
  C,NC:Integer;
  t:Integer;
begin
  C:=0;
  for t:=0 to SizeOfWord-1 do begin
    NC:=Ord((A[t]+B[t]+C)>1);
    Res[t]:=A[t] Xor B[t] Xor C;
    C:=NC;
    end;
  end;

procedure OpXor(Var A,B,Res:MyWord); {A may the same variable as Res}
var
  t:Integer;
begin
  for t:=0 to SizeOfWord-1 do Res[t]:=A[t] Xor B[t];
  end;

procedure Op2Cpl(var Res:MyWord);
var
  tmp1:MyWord;
  t:Integer;
begin
  for t:=0 to SizeOfWord-1 do tmp1[t]:=1;
  OpXor(Res,tmp1,Res);
  for t:=1 to SizeOfWord-1 do tmp1[t]:=0;
  tmp1[0]:=1;
  OpAdd(Res,tmp1,Res);
  end;

procedure OpSub(Var A:MyWord;Sub:MyWord;Var Res:MyWord);
begin                            {Res may be A or Sub}
  Op2Cpl(Sub);
  OpAdd(A,Sub,Res);
  end;


procedure OpPosDiv(Var A,B,Res,Modulus:MyWord);
var
  tmp1,tmp2:MyWord;
  t,t2:Integer;
begin
  for t:=0 to SizeOfWord-1 do tmp1[t]:=0;
  t:=SizeOfWord-1;
  while (t>-1) and (A[t]=0) do begin
    Res[t]:=0;
    dec(t);
    end;
  while (t>-1) do begin
    for t2:=SizeOfWord-1 DownTo 1 do tmp1[t2]:=tmp1[t2-1];
    tmp1[0]:=A[t];
    OpSub(tmp1,B,tmp2);
    if tmp2[SizeOfWord-1]=0 then begin
      tmp1:=tmp2;
      Res[t]:=1;
      end
    else
      Res[t]:=0;
    dec(t);
    end;
  Modulus:=tmp1;
  end;


procedure OpDiv(A,B:MyWord;Var Res,Modulus:MyWord); {Res may be A or B}
var                                          {Modulus may be A or B}
  AisNeg,BisNeg:Boolean;                 {if Modulus is Res then Res is lost}
begin
  AisNeg:=(A[SizeOfWord-1]=1);
  if AisNeg then Op2Cpl(A);
  BisNeg:=(B[SizeOfWord-1]=1);
  if BisNeg then Op2Cpl(B);
  OpPosDiv(A,B,Res,Modulus);
  if AisNeg<>BisNeg then Op2Cpl(Res);
  if AisNeg then Op2Cpl(Modulus);
  end;


function W2S(W:MyWord):String;
var
  S:String;
  Neg:Boolean;
  t:Integer;
  tmp1,tmp2,tmp10:MyWord;
begin
  for t:=0 to SizeOfWord-1 do tmp10[t]:=0;
  tmp10[1]:=1;tmp10[3]:=1;
  S:='';
  Neg:=False;
  if W[SizeOfWord-1]=1 then begin
    Neg:=True;
    Op2Cpl(W);
    end;
  while not ZeroFlag(W) do begin
    OpPosDiv(W,tmp10,tmp1,tmp2);
    S:=chr(48+tmp2[0]+2*tmp2[1]+4*tmp2[2]+8*tmp2[3])+S;
    W:=tmp1;
    end;
  if S='' then S:='0';
  while (length(S)>1) and (S[1]='0') do delete(S,1,1);
  if Neg then S:='-'+S;
  W2S:=AR(S,20);
  end;

procedure GetImm
  (GetSign:Boolean;First,Last:Integer;Var W:MyWord;
  Var N:Integer;Var Dest:MyWord);
var
  t:Integer;
  tmpS:String;
begin
  t:=Last-First+1; while t<SizeOfWord do begin
    Dest[t]:=0;
    inc(t);
    end;
  N:=0;
  for t:=Last Downto First do begin
    Dest[t-First]:=W[t];
    N:=N+N+W[t];
    end;
  if GetSign and (W[Last]=1) then begin
    N:=-(1 SHL (Last-First+1))+N;
    t:=Last-First+1; while t<SizeOfWord do begin
      Dest[t]:=1;
      inc(t);
      end;
    end;
  end;

procedure EnsureDisplayable(N:integer);
var
  t:integer;
begin
  for t:=0 to N-1 do if RegS[t]='?' then RegS[t]:=W2S(Reg[t]);
  end;

procedure RefreshCpuW;
var
  t:integer;
  tmpW:Wptr;
begin
  tmpW:=CurrW;
  UsingW(cpuW);
    TextBackGround(Blue);
    TextColor(Red);
    for t:=0 to NumOfRegs-1 do begin
      gotoXY(8,t+2);
      Write(RegS[t]);
      end;
    for t:=0 to NumOfSubs-1 do begin
      gotoXY(1,5+t);
      write(AR(I2S(Sub[t]),6));
      end;
    gotoXY(1,1);
    Write(AR(I2S(PC),6));
    UsingW(tmpW^);
  end;

procedure ResetCpu;
var
  t,t2:integer;
begin
  for t:=0 to NumOfRegs-1 do begin
    for t2:=0 to SizeOfWord-1 do Reg[t,t2]:=0;
    RegS[t]:='?';
    end;
  PC:=0;
  for t:=0 to NumOfSubs-1 do Sub[t]:=0;
  end;








procedure DisplayInst(InstS,CodeS:String;PC:MyAddress);
var
  tmpW:Wptr;
begin
  tmpW:=CurrW;
  UsingW(cpuW);
    Out(AL(InstS,13));
    ActivateMark(PC,Length(CodeS),Green,White);
    TextBackGround(Black);
    TextColor(DarkGray);
    GotoXY(1,2);
    Write(AR(I2S(PC+length(CodeS)),6));
    TextColor(LightGray);
    gotoXY(2,3);
    Write('Next^');
    TextColor(White);
    GotoXY(8,1);
    Write(AL(CodeS,20));
    Delay(50);
    UsingW(tmpW^);
  end;


procedure UnDisplayInst(CodeS:String);
var
  tmpW:Wptr;
begin
  tmpW:=CurrW;
  UsingW(cpuW);
    DeactivateMark;
    TextBackGround(Black);
    TextColor(DarkGray);
    GotoXY(1,2);
    Write('      ');
    GotoXY(1,3);
    Write('      ');
    gotoXY(8,1);
    Write(AL(CodeS,15));
    TextColor(White);
    UsingW(tmpW^);
  end;

procedure GetS(W:MyWord;a,b:Integer;Var S:String);
var
  t:Integer;
begin
  S:='';
  for t:=a to b do S:=S+chr(48+W[t]);
  end;

procedure DoJump
  (WhatInst:String;Var InstS:String;a,b:Integer;var CodeS:String;Inst:MyWord
  ;Var PC:Integer;IsConditional,Condition,IsRelative,IsSaving:Boolean
  ;Var Key:Integer);
var
  Displacement:Integer;
  nulW:MyWord;
begin
  GetImm(Signed,a,a-1+b,Inst,Displacement,nulW);
  if IsRelative then
    InstS:=WhatInst+' ^'+I2S(PC+Displacement)
  else
    InstS:=WhatInst+' '+I2S(Displacement);
  GetS(Inst,0,a-1+b,CodeS);
  DisplayInst(InstS,CodeS,PC);
  Repeat Key:=GetKey
  until not StepModeIsWalking or (Key>0);
  UnDisplayInst(CodeS);

  if IsConditional then DumpTopReg;
  if Condition then begin
    if IsSaving then begin
      MakeSpaceInSubs;
      Sub[0]:=PC+length(CodeS);
      end;
    if IsRelative then PC:=PC+Displacement
    else PC:=Displacement;
    end
  else
    PC:=PC+length(CodeS);
  end;

procedure DoOut(WhatInst,WhatMsg:String;b:Integer;Inst:MyWord
  ;Var InstS,CodeS:String;PC:MyAddress;Var Key:Integer);
var
  tmpW:Wptr;
begin
  GetS(Inst,0,b,CodeS);
  InstS:=WhatInst;
  DisplayInst(InstS,CodeS,PC);
  Repeat Key:=GetKey
  until not StepModeIsWalking or (Key>0);
  UnDisPlayInst(CodeS);
  tmpW:=CurrW;
  UsingW(ioW);
    Write(WhatMsg);
    UsingW(tmpW^);
  end;

function GetString(Var Key:Integer):String;
var
  S:String;
begin
  S:='';
  Repeat
    Repeat Key:=GetKey until Key>0;
    case Key of
      13,27:;
      32..127:
        if length(S)<30 then begin
          S:=S+chr(Key);
          Write(chr(Key));
          end
        else write(chr(7));
      8,-75:
        if length(S)>0 then begin
          delete(S,length(S),1);
          gotoXY(WhereX-1,WhereY);
          Write(' ');
          gotoXY(WhereX-1,WhereY);
          end
        else write(chr(7));
      else write(chr(7));
      end;
    until (Key=13) or (Key=27);
  WriteLn;
  GetString:=S;
  end;

function Match(W:MyWord;S:String):Boolean;
var
  t:Integer;
begin
  Match:=True;
  for t:=1 to Length(S) do
    if W[t-1]<>(ord(S[t]) AND 1) then Match:=False;
  end;


procedure DoInInteger(Var t,Key:integer);
var
  tmpW:Wptr;
  S:String;
  errorcode:Integer;
begin
  tmpW:=CurrW;
  UsingW(ioW);
    WriteLn;
    repeat
      gotoXY(WhereX,WhereY-1);
      DelLine;
      Write('Please input a integer: ');
      S:=GetString(Key);
      if Key=27 then exit;
      Val(S,t,errorcode);
      if errorcode<>0 then write(chr(7),chr(7));
      until errorcode=0;
    UsingW(tmpW^);
  end;

procedure DoCommon(WhatInst:String;b:Integer
  ;Var InstS,CodeS:String;Inst:MyWord;Var Key:Integer);
begin
  InstS:=WhatInst;
  GetS(Inst,0,b,CodeS);
  DisplayInst(InstS,CodeS,PC);
  Repeat Key:=GetKey
  until not StepModeIsWalking or (Key>0);
  UnDisplayInst(CodeS);
  end;

procedure run;
var
  InstS,CodeS,S:String;
  Key,t,t2,t3,OldPC:integer;
  tmpW,tmpW2:Wptr;
  Inst,tmpR,tmpR2,nulW:MyWord;
  IsJump:Boolean;

begin
  CpuIsActive:=True;
  Key:=0;
  WriteLn('    Remember the Hotkeys:');
  WriteLn('    <Up>,<DOWN> to move the memory display');
  WriteLn('    <F1> to change the mode');
  WriteLn('    <ESC> to break');
  ResetCpu;
  EnsureDisplayable(NumOfRegs);
  RefreshCpuW;
  RefreshConstW;
  RefreshMemW(DisplayedMem);
  tmpW2:=CurrW;
  UsingW(ScreenTraceW);
    ClrScr;
    Write(TitleBar);
    Write(TitleBar2);  {and go on using ScreenTraceW }

  if Trace<>'*Nowhere*' then begin
    Assign(TraceHandle,Trace);
    Append(TraceHandle);
    WriteLn(TraceHandle,TitleBar);
    WriteLn(TraceHandle,TitleBar2);
    end;


  Repeat
    OldPC:=PC;
    CodeS:='';
    PC:=Mad(PC);
    Out(AR(I2S(PC),6)+' ');
    Peek(PC,SizeOfWord,Inst);

    {Ximm(Unsigned,4,Inst,t,tmpV1,CodeS,PC);}

    if Match(Inst,'0000') then { Jr n }
      DoJump('Jr',InstS,4,SofOffset1,CodeS,Inst,PC
        ,UnConditional,Always,Relative,not Saving,Key)
    else if Match(Inst,'100000') then
      DoJump('Jrz',InstS,6,SofOffset1,CodeS,Inst,PC
        ,Conditional,ZeroFlag(Reg[0]),Relative,not Saving,Key)
    else if Match(Inst,'100010') then
      DoJump('Jrnz',InstS,6,SofOffset1,CodeS,Inst,PC
        ,Conditional,not ZeroFlag(Reg[0]),Relative,not Saving,Key)
    else if Match(Inst,'100001') then
      DoJump('Jrn',InstS,6,SofOffset1,CodeS,Inst,PC
        ,Conditional,Reg[0,SizeOfWord-1]=1,Relative,not Saving,Key)
    else if Match(Inst,'100011') then
      DoJump('Jrp',InstS,6,SofOffset1,CodeS,Inst,PC
        ,Conditional,Reg[0,SizeOfWord-1]=0,Relative,not Saving,Key)
    else if Match(Inst,'0100') then
      DoJump('Call',InstS,4,SofOffset2,CodeS,Inst,PC
        ,UnConditional,Always,not Relative,Saving,Key)
    else if Match(Inst,'1100') then
      DoJump('Callr',InstS,4,SofOffset2,CodeS,Inst,PC
        ,UnConditional,Always,Relative,Saving,Key)
    else if Match(Inst,'00100') then begin
      DoCommon('Return',4,InstS,CodeS,Inst,Key);
      PC:=Sub[0];
      DumpTopR;
      end
    else begin {this is no jump .. so pc will be just incremented}
      if Match(Inst,'00101') then
        DoCommon('Halt',4,InstS,CodeS,Inst,Key)
      else if Match(Inst,'1010') then begin
        GetImm(UnSigned,4,5,Inst,t,nulW);
        DoCommon('Bring R'+I2S(t),5,InstS,CodeS,Inst,Key);
        tmpR:=Reg[t];
        S:=RegS[t];
        MakeSpaceInRegs;
        Reg[0]:=tmpR;
        RegS[0]:=S;
        end
      else if Match(Inst,'0110') then begin
        GetImm(UnSigned,4,5,Inst,t,nulW);
        DoCommon('Store R'+I2S(t),5,InstS,CodeS,Inst,Key);
        Reg[t]:=Reg[0];
        RegS[t]:=RegS[0];
        DumpTopReg;
        end
      else if Match(Inst,'1110') then begin
        GetImm(Signed,4,4-1+SofLiteral,Inst,t,tmpR);
        DoCommon('#'+I2S(t),13,InstS,CodeS,Inst,Key);
        MakeSpaceInRegs;
        Reg[0]:=tmpR;
        RegS[0]:='?';
        end
      else if Match(Inst,'0001') then begin
        DoCommon('Add',3,InstS,CodeS,Inst,Key);
        OpAdd(Reg[0],Reg[1],Reg[1]);
        DumpTopReg;
        RegS[0]:='?';
        end
      else if Match(Inst,'1001') then begin
        DoCommon('Sub',3,InstS,CodeS,Inst,Key);
        OpSub(Reg[1],Reg[0],Reg[1]);
        DumpTopReg;
        RegS[0]:='?';
        end
      else if Match(Inst,'0101') then begin
        DoCommon('Xor',3,InstS,CodeS,Inst,Key);
        OpXor(Reg[0],Reg[1],Reg[1]);
        DumpTopReg;
        RegS[0]:='?';
        end
      else if Match(Inst,'1101') then begin
        DoCommon('DivMod',3,InstS,CodeS,Inst,Key);
        OpDiv(Reg[1],Reg[0],tmpR,Reg[1]);
        Reg[0]:=tmpR;
        RegS[0]:='?';
        RegS[1]:='?';
        end
      else if Match(Inst,'001100') then begin
        GetImm(UnSigned,6,6-1+SofOffset3,Inst,t,tmpR);
        GetImm(Signed,0,9,Reg[0],t2,nulW);
        DoCommon('Peek:'+I2S(t+1),11,InstS,CodeS,Inst,Key);
        Peek(t2,t+1,Reg[0]);
        RegS[0]:='?';
        ActivateMark(t2,t+1,Green,Black);
        end
      else if Match(Inst,'001110') then begin
        GetImm(UnSigned,6,11,Inst,t,tmpR);
        GetImm(Signed,6,6-1+SofOffset3,Inst,t2,nulW);
        DoCommon('RPeek:'+I2S(t+1)+' ^'+I2S(Mad(PC+t2)),15
          ,InstS,CodeS,Inst,Key);
        MakeSpaceInRegs;
        Peek(PC+t2,t+1,Reg[0]);
        RegS[0]:='?';
        ActivateMark(PC+t2,t+1,Green,Black);
        end
      else if Match(Inst,'001101') then begin
        GetImm(UnSigned,6,6-1+SofOffset3,Inst,t,tmpR);
        GetImm(Signed,0,9,Reg[0],t2,nulW);
        DoCommon('Poke:'+I2S(t+1),11,InstS,CodeS,Inst,Key);
        Poke(t2,t+1,Reg[0]);
        DumpTopReg;
        ActivateMark(t2,t+1,Red,Black);
        end
      else if Match(Inst,'001111') then begin
        GetImm(UnSigned,6,6-1+SofOffset3,Inst,t,tmpR);
        GetImm(Signed,6,15,Inst,t2,nulW);
        DoCommon('RPoke:'+I2S(t+1)+' ^'+I2S(Mad(PC+t2)),15
          ,InstS,CodeS,Inst,Key);
        Poke(PC+t2,t+1,Reg[0]);
        DumpTopReg;
        ActivateMark(PC+t2,t+1,Red,Black);
        end
      else if Match(Inst,'101100') then begin
        DoCommon('Not',5,InstS,CodeS,Inst,Key);
        for t2:=0 to SizeOfWord-1 do Reg[0,t2]:=Reg[0,t2] XOR 1;
        RegS[0]:='?';
        end
      else if Match(Inst,'101110') then begin
        DoCommon('Cpl',5,InstS,CodeS,Inst,Key);
        Op2Cpl(Reg[0]);
        RegS[0]:='?';
        end
      else if Match(Inst,'101101') then begin
        DoCommon('And',5,InstS,CodeS,Inst,Key);
        for t2:=0 to SizeOfWord-1 do Reg[0,t2]:=Reg[0,t2] and Reg[1,t2];
        RegS[0]:='?';
        DumpTopReg;
        end
      else if Match(Inst,'101111') then begin
        DoCommon('Or',4,InstS,CodeS,Inst,Key);
        for t2:=0 to SizeOfWord-1 do Reg[0,t2]:=Reg[0,t2] or Reg[1,t2];
        RegS[0]:='?';
        DumpTopReg;
        end
      else if Match(Inst,'0111000') then begin
        DoOut('OutNum',W2S(Reg[0]),6,Inst,InstS,CodeS,PC,Key);
        DumpTopReg;
        end
      else if Match(Inst,'0111100') then
        DoOut('OutMsg1','The sum is: ',6,Inst,InstS,CodeS,PC,Key)
      else if Match(Inst,'0111010') then
        DoOut('OutMsg2','The smallest is: ',6,Inst,InstS,CodeS,PC,Key)
      else if Match(Inst,'0111110') then
        DoOut('OutMsg3','The biggest is:',6,Inst,InstS,CodeS,PC,Key)
      else if Match(Inst,'0111001') then
        DoOut('OutCR',#13+#10,6,Inst,InstS,CodeS,PC,Key)
      else if Match(Inst,'1111') then begin
        InstS:='InInt';
        GetS(Inst,0,3,CodeS);
        DisplayInst(InstS,CodeS,PC);
        DoInInteger(t,Key);
        UnDisplayInst(CodeS);
        MakeSpaceInRegs;
        for t2:=0 to 15 do Reg[0,t2]:=ord((t and (1 SHL t2))<>0);
        for t2:=16 to SizeOfWord-1 do Reg[0,t2]:=Reg[0,15];
        end

      else begin
        GetS(Inst,0,19,CodeS);
        DisplayInst('undefined',CodeS,PC);
        if StepModeIsWalking then Repeat until KeyPressed;
        Key:=GetKey;
        UnDisplayInst(CodeS);
        InstS:='Halt';
        end;

      PC:=PC+length(CodeS); {this line is common to all non jumps}
      end;


    EnsureDisplayable(3);
    for t:=0 to 2 do Out(RegS[t]);
    EnsureDisplayable(NumOfRegs);
    RefreshCpuW;
    tmpW:=CurrW;
    UsingW(cpuW);
      TextBackGround(Black);
      TextColor(DarkGray);
      GotoXY(1,2);
      Write('      ');
      GotoXY(1,3);
      Write('      ');
      gotoXY(8,1);
      Write(CodeS);
      TextColor(White);
      UsingW(tmpW^);
    if Key<>27 then
      Repeat Key:=GetKey
      until not StepModeIsWalking or (Key>0);

    delay(50);
    if Mark.Active then DeactivateMark;

    until (Key=27) or (InstS='Halt');

  if Trace<>'*Nowhere*' then close(TraceHandle);
  UsingW(tmpW2^);
  CpuIsActive:=False;
  RefreshConstW;
  end;

procedure XWord(var S,W:String);
begin
  W:='';
  repeat
    if S='' then exit;
    if S[1]=' ' then begin
      if W<>'' then exit
      end
    else
      W:=W+upcase(S[1]);
    delete(S,1,1);
    until false;
  end;

function XString(Var Dest:String;Target:String;Var S:String):Boolean;
begin
  XString:=False;
  if Length(Target)>Length(S) then exit;
  if copy(S,1,Length(Target))<>Target then exit;
  delete(S,1,Length(target));
  Dest:=Dest+Target;
  XString:=True;
  end;

procedure DelSpaces(Var S:String);
begin
  while Length(S)>0 do
    if S[1]=' ' then delete(S,1,1)
    else exit;
  end;

procedure XInt(Var Dest:String;var t:Integer;Var Orig:String
  ;var errorcode:Integer);
Const
  Dig: array[0..2] of String = ('01','0123456789','0123456789ABCDEF');
  BaseVal:array[0..2] of integer = (2,10,16);

var
  Negative:Boolean;
  Base:Integer;
  Num:Longint;
begin
  Base:=1;{decimal number}
  if XString(Dest,'&',Orig) then Base:=2  {hexadecimal number}
  else if XString(Dest,'%',Orig) then Base:=0; { binary number}
  Negative:=XString(Dest,'-',Orig);
  errorcode:=9;
  if pos(Orig[1],Dig[Base])=0 then exit;
  Num:=0;
  while (Orig<>'')
    AND (Num<(Longint(32767)+ord(Negative)))
    AND (pos(Orig[1],Dig[Base])>0) do begin
    {Wow range is -32768..32767 maybe this will not be enough someday}
    Num:=Num*BaseVal[Base]+pos(Orig[1],Dig[Base])-1;
    Dest:=Dest+Orig[1];
    delete(Orig,1,1);
    end;
  if Negative then Num:=-Num;
  t:=Num;
  errorcode:=0;
  end;

procedure XLabel(Var Dest,S:String;var errorcode:Integer);
begin
  errorcode:=7;
  DelSpaces(S);
  if S='' then exit;
  while (S<>'')
    and (pos(S[1],'ABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789')>0) do begin
    Dest:=Dest+S[1];
    Delete(S,1,1);
    errorcode:=0;
    end;
  end;

procedure I2BinS(IsSigned:Boolean;Var Dest:String;Num:Integer;Bits:Integer
  ;var errorcode:Integer);
var
  t:integer;
  Carry,IsNeg:Boolean;
  tmpS:String;
begin
  errorcode:=6;
  if IsSigned then begin
    if (Num<((-1+ 1 SHL Bits) xor -1)) or (Num>(-1+ 1 SHL Bits)) then exit
    end
  else
    if (Num<0) or (Num>(-1+ 1 SHL Bits)) then exit;
  IsNeg:= Num<0;
  if IsNeg then Num:=-Num;
  tmpS:='';
  for t:=0 to Bits-1 do tmpS:=tmpS+chr(48+Ord((Num AND (1 SHL t))<>0));
  Carry:=True;
  if IsNeg then for t:=1 to Bits do begin
    tmpS[t]:=chr(Ord(tmpS[t])xor 1 xor ord(Carry));
    Carry:=Carry and (tmpS[t]='0');
    end;
  errorcode:=0;
  Dest:=Dest+tmpS;
  end;


procedure FindLabel(S:String;var Where:Integer);
var
  t:integer;
begin
  Where:=-1;
  for t:=0 to NumOfLabels-1 do
    if MyLabel[t].Name=S then begin
      Where:=t;
      t:=NumOfLabels-1;
      end;
  end;

procedure XAddress(IsRel:Boolean;Var Dest,CodeS,Orig:String
  ;Bits:Integer;var errorcode:Integer;PC:Integer);
var
  Hit,t,t2:Integer;
  IsNeg:Boolean;
  LabelS:String;
begin
  LabelS:='';
  DelSpaces(Orig);
  XLabel(LabelS,Orig,errorcode);
  Dest:=Dest+LabelS;
  if errorcode<>0 then exit;
  FindLabel(LabelS,Hit);
  if Hit>-1 then
    t:=MyLabel[Hit].Address
  else begin
    CodeS:=CodeS+copy('000000000000000000000',1,Bits);
    {to put zeros into CodeS to Calculate a proper next}
    errorcode:=-1;
    end;
  if errorcode<>0 then exit;
  if IsRel then t:=t-PC;
  I2BinS(Signed,CodeS,t,Bits,errorcode);
  end;

procedure XReg(var Dest,CodeS,Orig:String;Bits:Integer
  ;var errorcode:Integer);
var
  t:Integer;
begin
  errorcode:=8;
  if not XString(Dest,'R',Orig) then exit;
  XInt(Dest,t,Orig,errorcode);
  if errorcode<>0 then exit;
  I2BinS(UnSigned,CodeS,t,Bits,errorcode);
  Dest:=Dest+I2S(t);
  end;

procedure CompileInst(Var InstS,S:String;var NextPC:MyAddress;PC:MyAddress
  ;var errorcode:integer);
var
  t:Integer;
  CodeS,S2:String;
begin
  InstS:='';
  if XString(InstS,'JRNZ ',S) then begin
    CodeS:='100010';
    XAddress(Relative,InstS,CodeS,S,SofOffset1,errorcode,PC);
    end
  else if XString(InstS,'JRZ ',S) then begin
    CodeS:='100000';
    XAddress(Relative,InstS,CodeS,S,SofOffset1,errorcode,PC);
    end
  else if XString(InstS,'JRN ',S) then begin
    CodeS:='100001';
    XAddress(Relative,InstS,CodeS,S,SofOffset1,errorcode,PC);
    end
  else if XString(InstS,'JRP ',S) then begin
    CodeS:='100011';
    XAddress(Relative,InstS,CodeS,S,SofOffset1,errorcode,PC);
    end
  else if XString(InstS,'JR ',S) then begin
    CodeS:='0000';
    XAddress(Relative,InstS,CodeS,S,SofOffset1,errorcode,PC);
    end
  else if XString(InstS,'CALLR ',S) then begin
    CodeS:='1100';
    XAddress(Relative,InstS,CodeS,S,SofOffset2,errorcode,PC);
    end
  else if XString(InstS,'CALL ',S) then begin
    CodeS:='0100';
    XAddress(not Relative,InstS,CodeS,S,SofOffset2,errorcode,PC);
    end
  else if XString(InstS,'RETURN',S) then begin
    CodeS:='00100'
    end
  else if XString(InstS,'HALT',S) then begin
    CodeS:='00101'
    end
  else if XString(InstS,'BRING ',S) then begin
    CodeS:='1010';
    XReg(InstS,CodeS,S,SofReg,errorcode);
    end
  else if XString(InstS,'STORE ',S) then begin
    CodeS:='0110';
    XReg(InstS,CodeS,S,SofReg,errorcode);
    end
  else if XString(InstS,'# ',S) then begin
    CodeS:='1110';
    XInt(InstS,t,S,errorcode);
    if errorcode=0 then I2BinS(Signed,CodeS,t,SofLiteral,errorcode);
    end
  else if XString(InstS,'ADD',S) then begin
    CodeS:='0001'
    end
  else if XString(InstS,'SUB',S) then begin
    CodeS:='1001'
    end
  else if XString(InstS,'XOR',S) then begin
    CodeS:='0101'
    end
  else if XString(InstS,'DIVMOD',S) then begin
    CodeS:='1101'
    end
{
	Final version of this code was lost! ... todo: amend! DM'03
	
  else if XString(InstS,'PEEK:',S) then begin
    CodeS:='001100';
    XInt(InstS,t,S,errorcode);
    if errorcode=0 then
      I2BinS(Unsigned,CodeS,t-1,SofSofWord,errorcode);
  else if XString(InstS,'RPEEK:',S) then begin
    CodeS:='001110';
    XInt(InstS,t,S,errorcode);
    if errorcode=0 then
      I2BinS(Unsigned,CodeS,t-1,SofSofWord,errorcode);


	This part looks like the model for the above lines ... DM'03
	
    Match(Inst,'001100') then begin
    GetImm(UnSigned,6,6-1+SofOffset3,Inst,t,tmpR);
    GetImm(Signed,0,9,Reg[0],t2,nulW);
    DoCommon('Peek:'+I2S(t+1),11,InstS,CodeS,Inst,Key);
    Peek(t2,t+1,Reg[0]);
    RegS[0]:='?';
    ActivateMark(t2,t+1,Green,Black);
    end
 
  else if Match(Inst,'001110') then begin
    GetImm(UnSigned,6,11,Inst,t,tmpR);
    GetImm(Signed,6,6-1+SofOffset3,Inst,t2,nulW);
    DoCommon('RPeek:'+I2S(t+1)+' ^'+I2S(Mad(PC+t2)),15
      ,InstS,CodeS,Inst,Key);
    MakeSpaceInRegs;
    Peek(PC+t2,t+1,Reg[0]);
    RegS[0]:='?';
    ActivateMark(PC+t2,t+1,Green,Black);
    end
  else if Match(Inst,'001101') then begin
    GetImm(UnSigned,6,6-1+SofOffset3,Inst,t,tmpR);
    GetImm(Signed,0,9,Reg[0],t2,nulW);
    DoCommon('Poke:'+I2S(t+1),11,InstS,CodeS,Inst,Key);
    Poke(t2,t+1,Reg[0]);
    DumpTopReg;
    ActivateMark(t2,t+1,Red,Black);
    end
  else if Match(Inst,'001111') then begin
    GetImm(UnSigned,6,6-1+SofOffset3,Inst,t,tmpR);
    GetImm(Signed,6,15,Inst,t2,nulW);
    DoCommon('RPoke:'+I2S(t+1)+' ^'+I2S(Mad(PC+t2)),15
      ,InstS,CodeS,Inst,Key);
    Poke(PC+t2,t+1,Reg[0]);
    DumpTopReg;
    ActivateMark(PC+t2,t+1,Red,Black);
    end


}
   {peeks and pokes
    }

  else if XString(InstS,'NOT',S) then begin
    CodeS:='101100'
    end
  else if XString(InstS,'CPL',S) then begin
    CodeS:='101101'
    end
  else if XString(InstS,'AND',S) then begin
    CodeS:='101101'
    end
  else if XString(InstS,'OR',S) then begin
    CodeS:='101111'
    end
  else if XString(InstS,'OUTNUM',S) then begin
    CodeS:='0111000'
    end
  else if XString(InstS,'OUTMSG1',S) then begin
    CodeS:='0111100'
    end
  else if XString(InstS,'OUTMSG2',S) then begin
    CodeS:='0111010'
    end
  else if XString(InstS,'OUTMSG3',S) then begin
    CodeS:='0111110'
    end
  else if XString(InstS,'OUTCR',S) then begin
    CodeS:='0111001'
    end
  else if XString(InstS,'ININT',S) then begin
    CodeS:='1111'
    end
  else begin
    WriteLn('   ... while compiling "',S,'"');
    errorcode:=2;
    end;
  NextPC:=PC+Length(CodeS);
  if errorcode=0 then begin
    for t:=1 to Length(CodeS) do
      MEM[Mad(PC-1+t)]:=ord(CodeS[t]) and 1;
    ActivateMark(PC,Length(CodeS),Red,Black);
    delay(200);
    DeactivateMark;
    end;
  end;


procedure CompileLine(Var Source:String;var Where:MyAddress
  ;var errorcode:Integer);
var
  t:Integer;
  nulS,LabelS,tmpS:String;
  nulA,tmpA:MyAddress;
begin
  t:=pos(';',Source);
  if t>0 then delete(Source,t,length(Source)-t+1);
  DelSpaces(Source);
  if Source='' then exit;
  for t:=1 to length(Source) do Source[t]:=UpCase(Source[t]);
  if XString(nulS,':',Source) then begin
    LabelS:='';
    XLabel(LabelS,Source,errorcode);
    if errorcode=0 then begin
      FindLabel(LabelS,t);
      if t=-1 then begin
        with MyLabel[NumOfLabels] do begin
          Name:=LabelS;
          Address:=Where;
          end;
        inc(NumOfLabels);
        t:=NumOfUnsolvedInsts-1;
        while (t>-1) and (errorcode<1) do with UnsolvedInst[t] do begin
          tmpS:=InstS;{because its going to be flushed}
          CompileInst(nulS,tmpS,nulA,Address,errorcode);
          if errorcode=0 then begin
            UnsolvedInst[t]:=UnsolvedInst[NumOfUnsolvedInsts];
            dec(NumOfUnsolvedInsts);
            end;
          dec(t);
          end;
        end
      else errorcode:=5; {repeated label}
      end;
    end
  else begin
    CompileInst(tmpS,Source,tmpA,Where,errorcode);
    if errorcode=-1 then begin {there is an unsolved label}
      With UnsolvedInst[NumOfUnsolvedInsts] do begin
        InstS:=tmpS;
        Address:=Where;
        end;
      inc(NumOfUnsolvedInsts);
      end;
    if errorcode<1 then begin
      PC:=tmpA;
      RefreshCpuW;
      end;
    DelSpaces(Source);
    if Source<>'' then
      if Source[1]<>';' then errorcode:=4;
    end;
  end;

  {Main Program}

var
  errorcode,Key,t,t2,OrigMode,nulI:Integer;
  DirInfo:SearchRec;
  S,Word,Path,InstS,nulS:String;
  C:Char;
  SourceHandle:Text;

begin
  NumOfLabels:=0;
  NumOfUnsolvedInsts:=0;
  OrigMode:=LastMode;
  textmode(C80+Font8x8);
  Trace:='*Nowhere*';
  StepModeIsWalking:=True;
  Filename:='*None*';
  CpuIsActive:=False;
  CurrW:=@ScreenTraceW;

  TextBackGround(Black);
  TextColor(LightGray);
  gotoXY(1,11);
  Write(TitleBar);
  With ScreenTraceW do begin
    X1:=1;Y1:=1;X2:=80;Y2:=10;
    end;
  UsingW(ScreenTraceW);
  TextBackGround(Blue);
  TextColor(White);
  ClrScr;
  WriteLn('This is the trace screen,');
  WriteLn(' each instruction executed will be dumped always here');
  WriteLn(' and optionally to a file');

  With cpuW do begin
    X1:=1;Y1:=12;X2:=31;Y2:=21;
    end;
  UsingW(cpuW);
  TextBackGround(Black);
  TextColor(LightGray);
  ClrScr;
  for t:=0 to NumOfVisRegs-1 do begin
    gotoXY(28,t+2);
    Write('R',t);
    end;
  TextColor(LightGray);
  GotoXY(1,4);
  Write('Stack');
  ResetCpu;
  EnsureDisplayable(NumOfRegs);
  RefreshCpuW;


  With ioW do begin
    X1:=31;Y1:=12;X2:=80;Y2:=20;
    end;
  UsingW(ioW);
  TextBackground(Blue);
  TextColor(White);
  ClrScr;
  WriteLn('This is the interface with the CPU');
  WriteLn('This window is only modified');
  WriteLn('  by the IN and OUT intructions');

  Mark.Active:=false;
  for t:=LowestAddress to HighestAddress do
    MEM[t]:=0;
  {above lines needed in TP5.0 DM'03}

  With MemW do begin
    X1:=5;Y1:=21;X2:=75;Y2:=36;
    end;
  UsingW(MemW);
  TextBackGround(MemBck);
  TextColor(MemCol);
  ClrScr;
  gotoXY(10,16);
  Write('Press <UP> or <DOWN> to scroll the display');
  RefreshMemW(0);

  With ConstantsW do begin
    X1:=1;Y1:=37;X2:=20;Y2:=50;
    end;
  RefreshConstW;

  With interfaceW do begin
    X1:=21;Y1:=37;X2:=80;Y2:=50;
    end;
  UsingW(interfaceW);
  TextBackground(Black);
  TextColor(White);
  ClrScr;
  WriteLn('    ** WELCOME TO MORICPU SIMULATOR');
  WriteLn('    ** WRITTEN BY DIEGO MORIARTY 6-11-94');
  WriteLn;
  Writeln('    Type "help" for a list of commands ...');
  WriteLn;
  repeat
    errorcode:=0;
    Write('>');
    S:=GetString(Key);
    if S<>'' then for t:=1 to length(S) do S[t]:=UpCase(S[t]);

    if Key=13 then WriteLn;

    if Key=27 then  {do nothing special}

    else if S='' then  {do nothing special}

    else if XString(nulS,'HELP',S) then begin
      writeLn('    go              -> Execute current program');
      WriteLn('    load path\file  -> Reads program into memory');
      WriteLn('    compile x       -> Compiles instruction x into PC');
      WriteLn('    prog path\file  -> Compiles instructions from a file');
      WriteLn('    trace path\file -> Records the instructions to a file');
      WriteLn('    trace off       -> Stops any further recording');
      WriteLn('    dir (path)      -> Displays all programs in directory');
      WriteLn('    help            -> Gives list of commands');
      WriteLn('    <UP>,<DOWN>     -> Move the memory display');
      WriteLn('    <ESC>           -> Return to DOS');
      end

    else if XString(nulS,'GO',S) then run

    else if XString(nulS,'DIR',S) then begin
      XWord(S,Path);
      XWord(S,Word);
      if Word<>'' then
        errorcode:=1;
      if errorcode=0 then begin
        FindFirst(Path, Archive, DirInfo);
        if DosError=3 then Path:=Path+'*.*'; { Same as DIR *.* }
        FindFirst(Path, Archive, DirInfo);
        while DosError=0 do begin
          Writeln('    ',DirInfo.Name);
          FindNext(DirInfo);
          end;
        if DosError=3 then
          WriteLn('    Directory not found');
        end
      end

    else if XString(nulS,'LOAD',S) then begin
      XWord(S,Path);
      XWord(S,Word);
      if (Path='') or (Word<>'') then errorcode:=1
      else begin
        {$I-}
        Assign(SourceHandle,Path);
        Reset(SourceHandle);
        {$I-}
        errorcode:=IOResult;
        if errorcode=0 then begin
          t:=0;
          While not eof(SourceHandle) do begin
            Read(SourceHandle,C);
            MEM[t]:=Ord(Ord(C) AND 1);
            t:=Mad(t+1);
            end;
          close(SourceHandle);
          FileName:=Path;
          RefreshConstW;
          RefreshMemW(DisplayedMem);
          end;
        end;
      end

    else if XString(nulS,'TRACE',S) then begin
      XWord(S,Path);
      XWord(S,Word);
      if (Path='') or (Word<>'') then errorcode:=1
      else
        if Path<>'OFF' then begin
          {$I-}
          Assign(TraceHandle,Path);
          Append(TraceHandle);
          {$I+}
          if IOResult=0 then begin
            close(TraceHandle);
            Trace:=Path;
            end
          else begin
            rewrite(TraceHandle);
            if IOResult<>0 then errorcode:=1
            else begin
              close(TraceHandle);
              Trace:=Path;
              end;
            end
          end
        else
          Trace:='*Nowhere*';
      RefreshConstW;
      end

    else if XString(nulS,'COMPILE',S) then
      CompileLine(S,PC,errorcode)



    else if XString(nulS,'PROG',S) then begin
      XWord(S,Path);
      XWord(S,Word);
      if (Path='') or (Word<>'') then errorcode:=1
      else begin
        {$I-}
        Assign(SourceHandle,Path);
        Reset(SourceHandle);
        {$I-}
        errorcode:=IOResult;
        if errorcode=0 then begin
          While not eof(SourceHandle) and (errorcode<1) do begin
            ReadLn(SourceHandle,S);
            CompileLine(S,PC,errorcode);
            end;
          close(SourceHandle);
          {at this moment errorcode may be -1}
          if NumOfUnsolvedInsts>0 then begin
            errorcode:=10;
            WriteLn('    Unsolved Instructions: ');
            for t:=1 to NumOfUnsolvedInsts do
              WriteLn('      ',UnsolvedInst[t].InstS
                ,' at memory location ',UnsolvedInst[t].Address);
            end
          else begin
            FileName:=Path;
            RefreshConstW;
            errorcode:=0;
            end
          end;
        end;
      end

    else errorcode:=1;

    case errorcode of
      -1:;
      1:WriteLn('    ERROR ... type "help" for a list of commands');
      2:WriteLn('    ERROR: Assembler instruction not recognised');
      3:WriteLn('    ERROR: Bad offset');
      4:WriteLn('    ERROR: rubbish in string');
      5:WriteLn('    ERROR: Label Already defined');
      6:WriteLn('    ERROR: Out of scope');
      7:WriteLn('    ERROR: Bad label');
      8:WriteLn('    ERROR: Visible register expected');
      9:WriteLn('    ERROR: Bad number');
      10:WriteLn('    ERROR: Unsolved references');
      0:;
      else WriteLn('internal error ... ',errorcode);
      end;
    until Key=27;

  textmode(OrigMode);
  end.

{This is unused code DM'03}
{fgfg}
begin
  OrigMode:=LastMode;
  textmode(C80+Font8x8);
  Trace:='*Nowhere*';
  StepModeIsWalking:=True;
  Filename:='*None*';
  CpuIsActive:=False;
  WCurr:=@WScreenTrace;

  initialise_windows;

  loop_interface;


  textmode(OrigMode);

  end;