PACKET info DEFINES info:
(**********************************************************************)
(** **)
(** M i n i - I N F O Autor: G. Szalay Stand: 87-04-03 **)
(** **)
(**********************************************************************)
LET charset = "1234567890ß'qwertzuiopü+asdfghjklöä#<yxcvbnm,.-
!""§$%&/()=?`QWERTZUIOPÜ*ASDFGHJKLÖÄ^>YXCVBNM;:_ ",
hextab = "0123456789abcdef", stdds = 0,
cr = ""13"", cr rubout = ""13""12"",
up down left right = ""3""10""8""2"";
TEXT VAR buf, linebuf, bytes, hexbytes, char,
search param := ""255"", search buffer,
first byte, hex search param := "ff", search mode := "h";
INT VAR drid := stdds, adr hi := 2, adr lo := 0, lines := 4,
begin hi := adr hi, begin lo := adr lo, first word,
saddr hi, saddr lo,
no of found bytes, cur xx, cur x, cur y, ymin, ymax,
xmin := 9, xmidlo := xmin + 21,
xmidhi := xmidlo + 5, xmax := xmidhi + 21,
word, byte, i, l;
INT CONST mask 00ff := dec ("00ff"),
mask ff00 := dec ("ff00"),
offs mask := dec ("0007"),
addr mask := dec ("fff8");
BOOL VAR found, low byte flag := TRUE, interrupted,
area 2 nonchangeable := id (1) <> 4 (*i.e. other than 68000*);
PROC wait for (TEXT CONST chars):
inchar (char);
WHILE pos (chars, char) = 0
REP out (""7""); inchar (char) PER
END PROC wait for;
PROC info:
info (drid, begin hi, begin lo, lines)
END PROC info;
PROC info (INT CONST start drid, start addr hi, start addr lo, start len):
drid := start drid;
begin hi := start addr hi;
begin lo := start addr lo;
lines := start len;
line; line; show dump;
command loop.
command loop:
REP
zeige kommandoliste;
kommando lesen und ausfuehren
PER.
zeige kommandoliste:
putline (""15"INFO: more, address, dsid, lines, find, or quit"14"").
kommando lesen und ausfuehren:
inchar (char);
SELECT pos ("damlfq"3"", char) OF
CASE 1: drid command
CASE 2: addr command
CASE 3: more command
CASE 4: len command
CASE 5: find command
CASE 6: quit command
CASE 7: up command
OTHERWISE more command
END SELECT.
quit command: LEAVE command loop.
drid command:
out ("dsid="); gethex (buf); drid := dec (buf);
IF drid > 0 AND drid < 4 OR drid > 255
THEN beep; drid := stdds
ELIF drid = 4
THEN drid := stdds
FI;
found := FALSE;
show dump.
len command:
out ("lines="); gethex (buf); lines := dec (buf); show dump.
addr command:
out ("address=");
gethex (buf);
IF LENGTH buf < 5
THEN begin hi := 0; begin lo := dec (buf)
ELSE begin hi := dec (subtext (buf, 1, LENGTH buf - 4));
begin lo := dec (subtext (buf, LENGTH buf - 3))
FI;
low byte flag := TRUE; found := FALSE;
show dump.
more command:
begin hi := adr hi; begin lo := adr lo;
low byte flag := TRUE; found := FALSE;
line; show dump.
show dump:
interrupted := FALSE;
get cursor (cur x, cur y);
cursor (1, cur y - 2);
out ("---------------------------- dsid=");
IF drid = stdds THEN out ("04") ELSE outsubtext (hex (drid), 3) FI;
putline (" --------------------");
adr hi := begin hi;
adr lo := begin lo AND addr mask;
FOR l FROM 1 UPTO lines REP
buf := " "; linebuf := " "; bytes := "";
out (txt (adr hi)); out (hex (adr lo) CT ": ");
IF adr hi = 8
THEN out ("_________e_n_d___o_f___d_a_t_a_s_p_a_c_e_________");
line; beep; LEAVE show dump
FI;
FOR i FROM 1 UPTO 8 REP
word := dsgetw (drid, adr hi, adr lo);
replace (buf, 1, word); rotate (word, 8); hexbytes := hex (word);
IF adr lo <> begin lo
THEN outsubtext (hexbytes, 1, 2); out (" ");
outsubtext (hexbytes, 3) ; out (" ")
ELIF low byte flag
THEN out (""8"-"); outsubtext (hexbytes, 1, 2); out ("-");
outsubtext (hexbytes, 3); out (" ")
ELSE outsubtext (hexbytes, 1, 2); out ("-");
outsubtext (hexbytes, 3); out ("-")
FI;
IF i = 4 THEN out (" ") FI;
bytes CAT buf;
incl (adr hi, adr lo, 1)
PER;
FOR i FROM 1 UPTO 16 REP
IF pos (charset, bytes SUB i) = 0 THEN replace (bytes, i, ".") FI
PER;
out (" "); outsubtext (bytes, 1, 8);
out (" "); outsubtext (bytes, 9); line;
IF incharety <> "" THEN interrupted := TRUE; LEAVE show dump FI
PER.
up command:
IF change not allowed THEN beep; reposit cursor; LEAVE up command FI;
get cursor (cur x, cur y);
ymax := cur y - 2; ymin := ymax - lines + 1;
cur x := xmin + (begin lo AND offs mask) * 6;
IF cur x > xmidlo THEN cur x INCR 2 FI;
IF NOT low byte flag THEN cur x INCR 3 FI;
cur y := ymin;
cursor (cur x, cur y);
REP inchar (char);
IF pos (up down left right, char) > 0 THEN move cursor
ELIF pos (hextab, char) > 0 THEN read byte and move cursor
ELIF char <> cr THEN beep
FI
UNTIL char = cr PER;
cursor (1, ymax + 2); line; show dump.
change not allowed:
interrupted OR area 2 nonchangeable AND area 2 of stdds in window.
area 2 of stdds in window:
drid = stdds AND
(begin hi = 2 OR
begin hi = 1 AND begin lo < 0 AND lines * 8 + begin lo > 0).
read byte and move cursor:
out (char); byte := pos (hextab, char) - 1;
wait for (hextab);
out (char); byte := pos (hextab, char) - 1 + 16 * byte;
out (""8""8"");
eval cursor address and modify word;
char := ""2""; move cursor.
eval cursor address and modify word:
adr hi := begin hi; adr lo := begin lo AND addr mask;
incl (adr hi, adr lo, ((cur y - ymin)*8 + (cur x - xmin) DIV 6));
word := dsgetw (drid, adr hi, adr lo);
IF high byte read
THEN rotate (byte, 8); word := (word AND mask 00ff) OR byte
ELSE word := (word AND mask ff00) OR byte
FI;
dsputw (drid, adr hi, adr lo, word).
high byte read:
cur xx := cur x; IF cur xx > xmidlo THEN cur xx DECR 2 FI;
cur xx MOD 6 < 3.
move cursor:
SELECT pos (up down left right, char) OF
CASE 1: IF cur y = ymin THEN beep ELSE cur y DECR 1 FI
CASE 2: IF cur y = ymax THEN beep ELSE cur y INCR 1 FI
CASE 3: IF cur x = xmin THEN IF cur y = ymin THEN beep
ELSE cur y DECR 1; cur x := xmax
FI
ELIF cur x = xmidhi THEN cur x DECR 5
ELSE cur x DECR 3 FI
CASE 4: IF cur x = xmax THEN IF cur y = ymax THEN beep
ELSE cur y INCR 1; cur x := xmin
FI
ELIF cur x = xmidlo THEN cur x INCR 5
ELSE cur x INCR 3 FI
ENDSELECT;
cursor (cur x, cur y).
beep: out (""7"").
reposit cursor: out (""3"").
find command:
out ("find: hex, char, or last param? (h/H/c/C/<CR>)");
wait for ("hHcC"13"");
saddr hi := begin hi; saddr lo := begin lo;
IF char = "c" OR char = "C"
THEN out (char); get char string; low byte flag := NOT low byte flag
ELIF char = "h" OR char = "H"
THEN out (char); get hex string; low byte flag := NOT low byte flag
ELSE out (search mode);
IF pos ("cC", search mode) > 0
THEN out (search param)
ELSE out (hex search param)
FI;
IF NOT found THEN low byte flag := NOT low byte flag
ELIF NOT low byte flag OR pos ("CH", search mode) > 0
THEN incl (saddr hi, saddr lo, 1)
FI
FI;
out (cr); (*acknowledge CR*)
search string;
line; show dump.
get char string:
search mode := char;
search param := "";
REP inchar (char);
SELECT pos (cr rubout, char) OF
CASE 1: IF search param = "" THEN beep ELSE LEAVE get char string FI
CASE 2: delete last char
OTHERWISE search param CAT char; out (char)
ENDSELECT
PER.
delete last char:
IF search param = ""
THEN beep
ELSE search param := subtext (search param, 1, LENGTH search param - 1);
out (""8" "8"")
FI.
get hex string:
search mode := char;
search param := "";
REP wait for (hextab CT cr rubout);
SELECT pos (cr rubout, char) OF
CASE 1: IF NOT regular hex string THEN beep; char :="" FI
CASE 2: delete last char
OTHERWISE search param CAT char; out (char)
ENDSELECT
UNTIL char = cr PER;
hex search param := search param;
search param := "";
FOR i FROM 1 UPTO LENGTH hex search param DIV 2 REP
char := hex search param SUB i;
word := pos (hextab, hex search param SUB (2*i-1)) - 1;
word := word * 16 + pos (hextab, hex search param SUB (2*i)) - 1;
search param CAT code (word)
PER.
regular hex string:
LENGTH search param > 0 AND (LENGTH search param AND 1) = 0.
search string:
first byte := search param SUB 1; buf := " ";
IF LENGTH search param > 1 THEN first word := search param ISUB 1 FI;
REP IF pos ("ch", search mode) > 0
THEN search first byte or word
ELSE search first word
FI;
search rest if any;
IF found THEN begin hi := saddr hi; begin lo := saddr lo;
LEAVE search string
FI;
IF NOT low byte flag THEN incl (saddr hi, saddr lo, 1) FI
PER.
search first byte or word:
REP
IF saddr hi = 8 THEN LEAVE search first byte or word FI;
word := dsgetw (drid, saddr hi, saddr lo);
replace (buf, 1, word);
IF NOT low byte flag AND (buf SUB 1) = first byte
THEN IF LENGTH search param = 1
THEN low byte flag := TRUE; no of found bytes := 1;
LEAVE search first byte or word
ELIF (buf SUB 2) = (search param SUB 2)
THEN low byte flag := TRUE; no of found bytes := 2;
LEAVE search first byte or word
ELSE look in high byte
FI
ELSE look in high byte
FI;
low byte flag := FALSE;
incr search address and provide for interaction
PER.
search first word:
REP
IF saddr hi = 8 THEN LEAVE search first word FI;
word := dsgetw (drid, saddr hi, saddr lo);
IF LENGTH search param = 1
THEN replace (buf, 1, word);
IF (buf SUB 1) = first byte
THEN low byte flag := TRUE; no of found bytes := 1;
LEAVE search first word
FI
ELSE IF word = first word
THEN low byte flag := TRUE; no of found bytes := 2;
LEAVE search first word
FI
FI;
incr search address and provide for interaction
PER.
look in high byte:
IF (buf SUB 2) = first byte
THEN low byte flag := FALSE; no of found bytes := 1;
LEAVE search first byte or word
FI.
incr search address and provide for interaction:
incl (saddr hi, saddr lo, 1);
IF incharety <> ""
THEN cursor (64, 24); out ("--- interrupted"); line; line;
begin hi := saddr hi; begin lo := saddr lo;
LEAVE search string
FI.
search rest if any:
found := TRUE;
IF LENGTH search param = no of found bytes OR saddr hi = 8
THEN LEAVE search rest if any
FI;
IF low byte flag
THEN search buffer := subtext (search param, 3)
ELSE search buffer := subtext (search param, 2)
FI;
adr hi := saddr hi; adr lo := saddr lo;
FOR i FROM 1 UPTO (LENGTH search param - no of found bytes) DIV 2 REP
incl (adr hi, adr lo, 1);
word := dsgetw (drid, adr hi, adr lo);
IF (search buffer ISUB i) = word
THEN no of found bytes INCR 2
ELSE found := FALSE
FI
UNTIL NOT found PER;
IF found AND LENGTH search param > no of found bytes
THEN search last byte
FI.
search last byte:
incl (adr hi, adr lo, 1);
word := dsgetw (drid, adr hi, adr lo);
replace (buf, 1, word);
found := (buf SUB 1) = (search param SUB length (search param)).
END PROC info;
(* info *) (****)
END PACKET info;