home *** CD-ROM | disk | FTP | other *** search
/ Vectronix 2 / VECTRONIX2.iso / FILES_01 / KBMONITO.LZH / KBDMON.1_0 / KM_COMDS.PAS < prev    next >
Pascal/Delphi Source File  |  1992-08-30  |  5KB  |  197 lines
  1. unit km_comds;
  2. { Die Befehle das Tastaturmonitors }
  3. {$R-,S-,I+,F+}
  4.  
  5. interface
  6.  
  7. uses km_inout;
  8.  
  9. var  comnames     :array [0..31] of char;     
  10.      comaddrs     :array [0..31] of pointer;
  11.       
  12.      paramcnt     :integer;
  13.      strpars      :array [1..16] of string;
  14.      hexpars      :array [1..16] of longint;
  15.  
  16.  
  17. { Hilfe }
  18. procedure mhelp;
  19.  
  20. implementation { ****************************************************** }
  21.  
  22. {** Fehlermeldung ausgeben **}
  23. procedure merr;
  24. begin  writeln('Falscher oder fehlender Parameter!'); end;
  25.  
  26. {** Help **}
  27. procedure mhelp;
  28. begin
  29.   curoff;
  30.   writeln('Monitorkommandos:');
  31.   writeln('C addr,byte[,byte[,byte..] ....... Bytes im Speicher ändern');
  32.   writeln('D addr ........................... Speicher listen');
  33.   writeln('F saddr,eaddr,byte ............... Speicher mit Byte füllen');
  34.   writeln('G addr ........................... Unterprogramm aufrufen');
  35.   writeln('H ................................ Hilfe (diese hier)');
  36.   writeln('Q ................................ Monitor verlassen');
  37.   writeln('R addr,filename .................. Binärfile in den Speicher laden');
  38.   writeln('S byte[,byte[,byte..] ............ Sende Bytes zum IKBD');
  39.   writeln('T addr[,rate] .................... Speicher tracen (Rate in sec)');
  40.   writeln('W saddr,eaddr,filename ........... Speicher in Binärfile schreiben');
  41.   writeln;
  42.   curon;
  43. end; {* mhelp *}  
  44.  
  45. {** Quit... ***}
  46. procedure mquit;
  47. begin
  48.   restoldvec;
  49.   writeln('Tschüss...'); writeln;
  50.   halt(0);
  51. end; {* mquit *}  
  52.  
  53. {*** Bytes in IKBD senden ***}
  54. procedure msend;
  55. var i :integer;
  56. begin
  57.   if paramcnt<1 then begin merr; exit; end;
  58.   for i:=1 to paramcnt do
  59.     if (hexpars[i]<>-1) then bytebuff[i-1]:=byte(hexpars[i]) 
  60.       else begin merr; exit; end;
  61.   recvd:=false;
  62.   sendbuff(@bytebuff,paramcnt);
  63.   delay(200);
  64.   if recvd then 
  65.   begin
  66.     write('Antwort: ');
  67.     for i:=0 to 6 do wrhex(buffptr^[i],2);
  68.     writeln;
  69.   end;
  70. end; {* msend *}    
  71.       
  72. {** Dump Memory **}
  73. procedure mdump;
  74. var curradr ,i    :word;
  75.     rdchr,cdchr :char;
  76. begin
  77.   if paramcnt<>1 then begin merr; exit; end;
  78.   if hexpars[1]<0 then begin merr; exit; end else curradr:=word(hexpars[1]);
  79.   repeat
  80.     getbytes(curradr,128);
  81.     dumpbuff(@bytebuff,curradr,8);
  82.     inc(curradr,128);
  83.     getcodes(rdchr,cdchr);
  84.   until rdchr<>enter; 
  85.   writeln; 
  86. end; {* mdump *}    
  87.     
  88. {*** Speicher tracen ***}
  89. procedure mtrace;
  90. var wt          :longint;
  91.     adr         :word;
  92.     rdchr,cdchr :char;
  93. begin
  94.   if paramcnt<1 then begin merr; exit; end;
  95.   if hexpars[1]<0 then begin merr; exit; end else adr:=word(hexpars[1]);
  96.   if paramcnt=1 then wt:=1 else wt:=hexpars[2];
  97.   repeat
  98.     getbytes(adr,64);
  99.     dumpbuff(@bytebuff,adr,4);
  100.     delay(wt*1000-600);
  101.     if charavlbl then getcodes(rdchr,cdchr);
  102.     curup(5);
  103.   until rdchr=esc;
  104.   curdown(5);
  105.   writeln;
  106. end; {* mtrace *}    
  107.  
  108. {*** Change Bytes ***}
  109. procedure mchange;
  110. var i :integer;
  111. begin
  112.   if paramcnt<2 then begin merr; exit; end;
  113.   for i:=2 to paramcnt do
  114.     if (hexpars[i]<>-1) then bytebuff[i-2]:=byte(hexpars[i]) 
  115.       else begin merr; exit; end;
  116.   putbytes(word(hexpars[1]),paramcnt-1);
  117. end; {* mchange *}
  118.  
  119. {*** Goto Subroutine ***}
  120. procedure mgoto;
  121. begin
  122.   if (paramcnt<>1) or (hexpars[1]<0) then begin merr; exit; end;
  123.   cmdbuff[0]:=$22;
  124.   cmdbuff[1]:=hi(word(hexpars[1]));
  125.   cmdbuff[2]:=lo(word(hexpars[1]));
  126.   sendbuff(@cmdbuff,3);
  127. end; {* mgoto *}  
  128.      
  129.  
  130. {*** Speicher in File schreiben ***}
  131. procedure mwrite;
  132. var len,i :word;
  133.     binfl :file;
  134. begin
  135.   if (paramcnt<>3) then begin merr; exit; end;
  136.   for i:=1 to 2 do if hexpars[i]<0 then begin merr; exit; end;
  137.   len:=hexpars[2]-hexpars[1]+1;
  138.   if len<1 then begin merr; exit; end;
  139.   if len>8192 then len:=8192;
  140.   getbytes(word(hexpars[1]),len);
  141.   {$I-}
  142.   rewrite(binfl,strpars[3]);
  143.   blockwrite(binfl,bytebuff,len);
  144.   close(binfl);
  145.   if ioresult<>0 then writeln('IO-Fehler beim Speichern!');
  146.   {$I+}
  147. end; {* mwrite *}
  148.  
  149. {*** File in Speicher übertragen (max. 255) ***}
  150. procedure mread;
  151. var len   :word;
  152.     binfl :file;
  153. begin
  154.   if (paramcnt<>2) or (hexpars[1]<0) then begin merr; exit; end;
  155.   {$I-}
  156.   reset(binfl,strpars[2]);
  157.   blockread(binfl,bytebuff,255,len);
  158.   close(binfl);
  159.   if ioresult=0 then putbytes(word(hexpars[1]),len)
  160.     else writeln('IO-Fehler beim Laden!');
  161.   {$I+}
  162. end; {* mread *}      
  163.  
  164. {*** Speicher füllen ***}
  165. procedure mfill;
  166. var len,i :integer;
  167. begin
  168.   if (paramcnt<>3) then begin merr; exit; end;
  169.   for i:=1 to 3 do if hexpars[i]<0 then begin merr; exit; end;
  170.   len:=hexpars[2]-hexpars[1]+1;
  171.   if len<1 then begin merr; exit; end;
  172.   for i:=0 to len-1 do bytebuff[i]:=byte(hexpars[3]);
  173.   putbytes(word(hexpars[1]),len);
  174. end; {* mfill *}  
  175.   
  176.  
  177. {**** Initialisierung der Unit ****}
  178.  
  179. var i :integer;
  180.  
  181. begin
  182.   for i:=0 to 31 do
  183.   begin
  184.     comnames[i]:=' ';
  185.     comaddrs[i]:=nil;
  186.   end;
  187.   comnames[ 0]:='Q'; comaddrs[ 0]:=@mquit;
  188.   comnames[ 1]:='H'; comaddrs[ 1]:=@mhelp;
  189.   comnames[ 2]:='S'; comaddrs[ 2]:=@msend;
  190.   comnames[ 3]:='D'; comaddrs[ 3]:=@mdump;
  191.   comnames[ 4]:='T'; comaddrs[ 4]:=@mtrace;
  192.   comnames[ 5]:='C'; comaddrs[ 5]:=@mchange;
  193.   comnames[ 6]:='G'; comaddrs[ 6]:=@mgoto;
  194.   comnames[ 7]:='W'; comaddrs[ 7]:=@mwrite;
  195.   comnames[ 8]:='R'; comaddrs[ 8]:=@mread;
  196.   comnames[ 9]:='F'; comaddrs[ 9]:=@mfill;
  197. end.