From 04e68443040c7abad84d66477e98f93bed701760 Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Mon, 4 Feb 2019 13:09:03 +0100 Subject: Initial import --- devel/debug/1/src/info | 371 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 371 insertions(+) create mode 100644 devel/debug/1/src/info (limited to 'devel/debug/1/src/info') diff --git a/devel/debug/1/src/info b/devel/debug/1/src/info new file mode 100644 index 0000000..31099c6 --- /dev/null +++ b/devel/debug/1/src/info @@ -0,0 +1,371 @@ +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;:_ ", + 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/)"); + 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; + -- cgit v1.2.3