unit km_comds;
{ Die Befehle das Tastaturmonitors }
{$R-,S-,I+,F+}

interface

uses km_inout;

var  comnames     :array [0..31] of char;     
     comaddrs     :array [0..31] of pointer;
      
     paramcnt     :integer;
     strpars      :array [1..16] of string;
     hexpars      :array [1..16] of longint;


{ Hilfe }
procedure mhelp;

implementation { ****************************************************** }

{** Fehlermeldung ausgeben **}
procedure merr;
begin  writeln('Falscher oder fehlender Parameter!'); end;

{** Help **}
procedure mhelp;
begin
  curoff;
  writeln('Monitorkommandos:');
  writeln('C addr,byte[,byte[,byte..] ....... Bytes im Speicher ndern');
  writeln('D addr ........................... Speicher listen');
  writeln('F saddr,eaddr,byte ............... Speicher mit Byte fllen');
  writeln('G addr ........................... Unterprogramm aufrufen');
  writeln('H ................................ Hilfe (diese hier)');
  writeln('Q ................................ Monitor verlassen');
  writeln('R addr,filename .................. Binrfile in den Speicher laden');
  writeln('S byte[,byte[,byte..] ............ Sende Bytes zum IKBD');
  writeln('T addr[,rate] .................... Speicher tracen (Rate in sec)');
  writeln('W saddr,eaddr,filename ........... Speicher in Binrfile schreiben');
  writeln;
  curon;
end; {* mhelp *}  

{** Quit... ***}
procedure mquit;
begin
  restoldvec;
  writeln('Tschss...'); writeln;
  halt(0);
end; {* mquit *}  

{*** Bytes in IKBD senden ***}
procedure msend;
var i :integer;
begin
  if paramcnt<1 then begin merr; exit; end;
  for i:=1 to paramcnt do
    if (hexpars[i]<>-1) then bytebuff[i-1]:=byte(hexpars[i]) 
      else begin merr; exit; end;
  recvd:=false;
  sendbuff(@bytebuff,paramcnt);
  delay(200);
  if recvd then 
  begin
    write('Antwort: ');
    for i:=0 to 6 do wrhex(buffptr^[i],2);
    writeln;
  end;
end; {* msend *}    
      
{** Dump Memory **}
procedure mdump;
var curradr ,i    :word;
    rdchr,cdchr :char;
begin
  if paramcnt<>1 then begin merr; exit; end;
  if hexpars[1]<0 then begin merr; exit; end else curradr:=word(hexpars[1]);
  repeat
    getbytes(curradr,128);
    dumpbuff(@bytebuff,curradr,8);
    inc(curradr,128);
    getcodes(rdchr,cdchr);
  until rdchr<>enter; 
  writeln; 
end; {* mdump *}    
    
{*** Speicher tracen ***}
procedure mtrace;
var wt          :longint;
    adr         :word;
    rdchr,cdchr :char;
begin
  if paramcnt<1 then begin merr; exit; end;
  if hexpars[1]<0 then begin merr; exit; end else adr:=word(hexpars[1]);
  if paramcnt=1 then wt:=1 else wt:=hexpars[2];
  repeat
    getbytes(adr,64);
    dumpbuff(@bytebuff,adr,4);
    delay(wt*1000-600);
    if charavlbl then getcodes(rdchr,cdchr);
    curup(5);
  until rdchr=esc;
  curdown(5);
  writeln;
end; {* mtrace *}    

{*** Change Bytes ***}
procedure mchange;
var i :integer;
begin
  if paramcnt<2 then begin merr; exit; end;
  for i:=2 to paramcnt do
    if (hexpars[i]<>-1) then bytebuff[i-2]:=byte(hexpars[i]) 
      else begin merr; exit; end;
  putbytes(word(hexpars[1]),paramcnt-1);
end; {* mchange *}

{*** Goto Subroutine ***}
procedure mgoto;
begin
  if (paramcnt<>1) or (hexpars[1]<0) then begin merr; exit; end;
  cmdbuff[0]:=$22;
  cmdbuff[1]:=hi(word(hexpars[1]));
  cmdbuff[2]:=lo(word(hexpars[1]));
  sendbuff(@cmdbuff,3);
end; {* mgoto *}  
     

{*** Speicher in File schreiben ***}
procedure mwrite;
var len,i :word;
    binfl :file;
begin
  if (paramcnt<>3) then begin merr; exit; end;
  for i:=1 to 2 do if hexpars[i]<0 then begin merr; exit; end;
  len:=hexpars[2]-hexpars[1]+1;
  if len<1 then begin merr; exit; end;
  if len>8192 then len:=8192;
  getbytes(word(hexpars[1]),len);
  {$I-}
  rewrite(binfl,strpars[3]);
  blockwrite(binfl,bytebuff,len);
  close(binfl);
  if ioresult<>0 then writeln('IO-Fehler beim Speichern!');
  {$I+}
end; {* mwrite *}

{*** File in Speicher bertragen (max. 255) ***}
procedure mread;
var len   :word;
    binfl :file;
begin
  if (paramcnt<>2) or (hexpars[1]<0) then begin merr; exit; end;
  {$I-}
  reset(binfl,strpars[2]);
  blockread(binfl,bytebuff,255,len);
  close(binfl);
  if ioresult=0 then putbytes(word(hexpars[1]),len)
    else writeln('IO-Fehler beim Laden!');
  {$I+}
end; {* mread *}      

{*** Speicher fllen ***}
procedure mfill;
var len,i :integer;
begin
  if (paramcnt<>3) then begin merr; exit; end;
  for i:=1 to 3 do if hexpars[i]<0 then begin merr; exit; end;
  len:=hexpars[2]-hexpars[1]+1;
  if len<1 then begin merr; exit; end;
  for i:=0 to len-1 do bytebuff[i]:=byte(hexpars[3]);
  putbytes(word(hexpars[1]),len);
end; {* mfill *}  
  

{**** Initialisierung der Unit ****}

var i :integer;

begin
  for i:=0 to 31 do
  begin
    comnames[i]:=' ';
    comaddrs[i]:=nil;
  end;
  comnames[ 0]:='Q'; comaddrs[ 0]:=@mquit;
  comnames[ 1]:='H'; comaddrs[ 1]:=@mhelp;
  comnames[ 2]:='S'; comaddrs[ 2]:=@msend;
  comnames[ 3]:='D'; comaddrs[ 3]:=@mdump;
  comnames[ 4]:='T'; comaddrs[ 4]:=@mtrace;
  comnames[ 5]:='C'; comaddrs[ 5]:=@mchange;
  comnames[ 6]:='G'; comaddrs[ 6]:=@mgoto;
  comnames[ 7]:='W'; comaddrs[ 7]:=@mwrite;
  comnames[ 8]:='R'; comaddrs[ 8]:=@mread;
  comnames[ 9]:='F'; comaddrs[ 9]:=@mfill;
end.