Why Not Virtual Machine 1.1

 program wnVM11;  // Why Not Virtual Machine
                // The historical date: 2021.07.01. 3:34:10
 Const
  BASE   = 96;                                       // MEMO merete byte-ban
  PAGES =  6;
  MEMMAX = BASE-1;
  INITIP = BASE DIV PAGES;                           // kodszegmens kezdocime
  CMAX   = 16384;                                    // max. Ciklusszam
 Var
  MEM    : array[0..MEMMAX] of byte;                 // MEMO
  IP     : byte    = 0;                              // MEMO indexe (Instr. Pointer)
  ExIP   : byte    = 0;
  ACCU   : byte    = 0;                              // Munkaregiszter
  ORIGIP : byte;                                     // foprogram startcime
  Flag   : byte    = 0;                              // Compare flag
  Cycle  : integer = 0; running: boolean = false;    // ciklusok

 Procedure Error(s: string);                         // hiba
 begin
  writeln(s);
  halt;
 end;

 Function BinHex(b:  byte):  String;                 // bintohex konverter
 Const
  s:  string = '0123456789ABCDEF';
 Begin
  Binhex[0] := #2; BinHex:= s[(b shr 4)+1]+s[(b and 15)+1];
 End;

 function OpToInstr: string;                     // 'disassembler' fuggv.
 begin
   case MEM[ExIP] of
   $CD : OpToInstr := 'SWAP ACCU-MEM['+BinHex(MEM[ExIP+1])+']';
   $F1 : if (MEM[Exip+1]= 0) then OpToInstr:= 'INC ACCU' else OpToInstr:= 'INC MEM['+BinHex(MEM[ExIP+1])+']';
   $F0 : if (MEM[Exip+1]= 0) then OpToInstr:= 'DEC ACCU' else OpToInstr:= 'DEC MEM['+BinHex(MEM[ExIP+1])+']';
   $AD : OpToInstr := 'ADD '+BinHex(MEM[MEM[ExIP+1]])+'h to ACCU';
   $AA : OpToInstr := 'SUB '+BinHex(MEM[MEM[ExIP+1]])+'h from ACCU';
   $C0 : OpToInstr := 'CMP ACCU-MEM['+BinHex(MEM[ExIP+1])+']';
   $EA : if MEM[ExIP+1]>0 then OpToInstr:='JMP to '+BinHex(MEM[ExIP+1]) else OpToInstr:='JMP to '+BinHex(ORIGIP);
   $E0 : OpToInstr := 'JMP '+BinHex(MEM[ExIP+1])+' if FLG';
   $AB : OpToInstr := 'ACCU <- MEM['+BinHex(MEM[ExIP+1])+']';
   $BA : OpToInstr := 'ACCU -> MEM['+BinHex(MEM[ExIP+1])+']';
   $00 : OpToInstr := 'PROCESS HALTED';
   $FF : OpToInstr := 'RETURN to '+BinHex(MEM[00]);
   else OpToInstr := 'ERROR';
   end;
 end;

 procedure DrawScreen;                               // state documentator ;)
 Var
  i, j: byte;
     s: string;
 begin
  writeln('    0  1  2  3  4  5  6  7  8  9  A  B  C  D  E  F');
  writeln();
  j:= 0;
  s:= BinHex(0);
  s:= s[1]+'  ';
  for i:= 0 to MEMMAX do
  begin
   s:= s+BinHex(MEM[i])+' ';
   inc(j);
   if j = 16 then
    begin
    writeln(s);
    j:=0;
    s:= BinHex(i+1 mod 16);
    s:= s[1]+'  ';
    end;
  end;
  writeln();
  write('   Accu: ',BinHex(ACCU),'  Ip: ',BinHex(ExIP));
  write('  Flg: ',flag,'   I: ',OpToInstr,#13,#10);
  writeln('---------------------------------------------------| ',Cycle+1);
 end;

 procedure OneStep;                                    // soft - CPU
 var
 TMP: byte;
 begin
  ExIP := IP;
  Case MEM[IP] of
   $CD: {SWP} Begin TMP:= ACCU;  ACCU := MEM[MEM[IP+1]];  MEM[MEM[IP+1]]:= TMP;          inc(IP,2); end;
   $F1: {inc} Begin TMP := MEM[IP+1]; if TMP > 0 then Inc(MEM[MEM[TMP]]) else Inc(ACCU); inc(IP,2); end;
   $F0: {dec} Begin TMP := MEM[IP+1]; if TMP > 0 then dec(MEM[MEM[TMP]]) else dec(ACCU); inc(IP,2); end;

   $00: {HLT} begin running := false; end;
   $AA: {SUB} begin ACCU := byte(ACCU-MEM[MEM[IP+1]]); inc(IP,2); end;
   $AD: {ADD} begin ACCU := byte(ACCU+MEM[MEM[IP+1]]); inc(IP,2); end;
   $C0: {CMP} begin if (ACCU = MEM[MEM[IP+1]]) then Flag:= 1 else Flag:= 0; inc(IP,2); end;
   $EA: {JMP} begin
                    if (MEM[IP+1] = 0) then IP := ORIGIP
                    else
                    begin MEM[$00]:= IP+2; IP := MEM[IP+1]; end;
                    end;
   $E0: {JZR} begin if (Flag = 1) then
                    begin
                    MEM[$00]:= IP+2; IP:= MEM[IP+1];
                    Flag := 0;
                    end  else inc(IP,2); end;
   $AB: {LDA} begin ACCU := MEM[MEM[IP+1]]; inc(IP,2); end;
   $BA: {STA} begin MEM[MEM[IP+1]] := ACCU; inc(IP,2); end;
   $FF: {RET} IP := MEM[$00];
   else
    begin write('Unknown instruction: ',MEM[IP]); running:= false; end;
  end; { case }

//  if running then        {<--- decomment it, if You dont need the last state of the CPU}
  DrawScreen;
  if (Cycle < CMAX) then Inc(Cycle) else Running := false;
 end;

 procedure Executor;                        //
 begin
  IP := ORIGIP;                             // Dreams comes true, from here ..
  running := true;
  while running do OneStep;
 end;

 procedure LoadToMem(s: string);            // program betolto
 var
  i    : byte;
  ifile: file of byte;
 begin
  assign(ifile,paramstr(1));
  reset(ifile,1);
  for i:= 0 to MEMMAX do read(ifile,MEM[i]);
  ORIGIP := MEM[00];                        // Yes, now, We have a starting address
  MEM[00]:= 0;                              // First time, clear the STACK segment, Dude!
  close(ifile);
 end;

 begin
  if paramstr(1) <> '' then LoadToMem(paramstr(1))
  else
  begin writeln('Usage: wnVM.exe input.bin >output.txt'); exit; end;
  Executor;
 end.