home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Vectronix 2
/
VECTRONIX2.iso
/
FILES_01
/
KBMONITO.LZH
/
KBDMON.1_0
/
KM_COMDS.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-08-30
|
5KB
|
197 lines
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 füllen');
writeln('G addr ........................... Unterprogramm aufrufen');
writeln('H ................................ Hilfe (diese hier)');
writeln('Q ................................ Monitor verlassen');
writeln('R addr,filename .................. Binärfile 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 Binärfile schreiben');
writeln;
curon;
end; {* mhelp *}
{** Quit... ***}
procedure mquit;
begin
restoldvec;
writeln('Tschüss...'); 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 füllen ***}
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.