home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Club Amiga de Montreal - CAM
/
CAM_CD_1.iso
/
files
/
230.lha
/
SPY
/
Sources
/
Snoop.Mod
< prev
next >
Wrap
Text File
|
1989-04-08
|
11KB
|
360 lines
IMPLEMENTATION MODULE Snoop;
(************************************************)
(* Snoop : The core of the Spy program *)
(* *)
(* Written by Steve Faiwiszewski, June 1988 *)
(* *)
(* Not to be used for commercial purpose *)
(************************************************)
FROM IntuiCommon IMPORT OpenSimpleWindow;
FROM Conversions IMPORT ConvStringToNumber, ConvNumberToString;
FROM TermInOut IMPORT WriteLn, WriteString, WriteCard, Write;
FROM Strings IMPORT StringLength;
FROM Tasks IMPORT Task, TaskPtr, CurrentTask, TaskState,
FindTask, SignalSet, Wait;
FROM Interrupts IMPORT Forbid, Permit;
FROM Nodes IMPORT Node, NodePtr, NTProcess;
FROM Ports IMPORT MsgPortPtr, GetMsg, ReplyMsg, WaitPort,
MessagePtr;
FROM Text IMPORT Text, TextLength;
FROM Drawing IMPORT Move, Draw, SetAPen, SetBPen,
WritePixel, RectFill;
FROM Rasters IMPORT RastPortPtr;
FROM Intuition IMPORT WindowFlags, WindowFlagsSet,
IDCMPFlagsSet, IDCMPFlags,
WindowPtr, CloseWindow,
SetWindowTitles, IntuiMessagePtr;
FROM AmigaDOSProcess
IMPORT ProcessPtr, Delay;
FROM AmigaDOSExt IMPORT CommandLineInterfacePtr;
FROM SYSTEM IMPORT ADDRESS, ADR, WORD, LONGWORD, BYTE,
TSIZE;
CONST
MaxStringSize = 26;
LetterHeight = 9;
HorizOffs = 9;
TYPE
LongPtr = POINTER TO LONGCARD;
WordPtr = POINTER TO WORD;
StringPointer = POINTER TO ARRAY[0..255] OF CHAR;
CoordRec = RECORD
X,Y : CARDINAL;
END;
RegRec = RECORD
Value : LONGWORD;
Name : ARRAY[0..2] OF CHAR;
Loc : CoordRec;
END;
VAR
rPort : RastPortPtr;
CurLine : CARDINAL;
Regs : ARRAY[0..14] OF RegRec;
PcLoc,
SrLoc,
StateLoc,
ProcNameLoc,
TaskNameLoc : CoordRec;
WindowTitleString : ARRAY[0..26] OF CHAR;
TaskIsProcess : BOOLEAN;
CmdLineLenPtr : POINTER TO BYTE;
CmdLineStrPtr : StringPointer;
(* +++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
PROCEDURE NewLine;
BEGIN
INC(CurLine,LetterHeight);
Move(rPort^,HorizOffs,CurLine);
END NewLine;
(* +++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
PROCEDURE ClearLine(X,Y : CARDINAL);
BEGIN
SetAPen(rPort^,0);
RectFill(rPort^,X,Y+2-LetterHeight,WIDTH-3,Y);
SetAPen(rPort^,1);
END ClearLine;
(* +++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
(*$D-*) (* all arguments are really passed by reference *)
(* for efficiency *)
PROCEDURE SetupString(Str : ARRAY OF CHAR;
VAR Coord : CoordRec; NL : BOOLEAN);
VAR length : CARDINAL;
BEGIN
length := StringLength(Str);
Text(rPort^,ADR(Str), length);
Coord.X := TextLength(rPort^,ADR(Str), length);
Coord.Y := CurLine;
IF NL THEN NewLine END;
END SetupString;
(*$D+*) (* go back to normal parameter passing *)
(* +++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
PROCEDURE IsItAprocess(TargetTask : TaskPtr) : BOOLEAN;
(* Check if the target task is also a process. If that *)
(* is so, then get the pointer to the process name. *)
VAR
pp : ProcessPtr;
CliPtr : CommandLineInterfacePtr;
BEGIN
IF CHAR(TargetTask^.tcNode.lnType) = CHAR(NTProcess) THEN
pp := ProcessPtr(TargetTask);
IF pp^.prCLI <> NIL THEN
CliPtr := ADDRESS(LONGCARD(pp^.prCLI)*4D);
CmdLineLenPtr :=
ADDRESS(LONGCARD(CliPtr^.cliCommandName) * 4D);
CmdLineStrPtr :=
ADDRESS(LONGCARD(CmdLineLenPtr) + 1D);
RETURN TRUE
END;
END;
RETURN FALSE
END IsItAprocess;
(* +++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
PROCEDURE SetupWindow(TargetTask : TaskPtr);
(* Create the text for all the fields that will be *)
(* displayed. Keep track of their location in the window. *)
CONST
TaskNameStr = 'Task Name: ';
ProcNameStr = 'Proc Name: ';
StateStr = 'State: ';
PcStr = 'PC: ';
SrStr = 'SR: ';
SpaceStr = ' ';
ColonStr = ': ';
VAR
i,tmp,
length : CARDINAL;
DummyLoc : CoordRec;
HexStr : ARRAY[0..7] OF CHAR;
BEGIN
WindowTitleString := 'Spying on Task 0x????????';
ConvNumberToString(HexStr,TargetTask,FALSE,16,8,'0');
FOR i := 0 TO 7 DO
WindowTitleString[i+17] := HexStr[i]
END;
SetWindowTitles(SpyWindow^,ADR(WindowTitleString),
ADR('Spy, written by Steve Faiwiszewski'));
rPort := SpyWindow^.RPort;
CurLine := 17;
SetAPen(rPort^,0);
SetBPen(rPort^,0);
RectFill(rPort^,5,10,WIDTH-3,HEIGHT-2);
SetAPen(rPort^,1);
Move(rPort^,HorizOffs,CurLine);
SetupString(TaskNameStr,TaskNameLoc,TRUE);
TaskIsProcess := IsItAprocess(TargetTask);
IF TaskIsProcess THEN
SetupString(ProcNameStr,ProcNameLoc,TRUE);
END;
SetupString(StateStr,StateLoc,TRUE);
SetupString(PcStr,PcLoc,TRUE);
SetupString(SrStr,SrLoc,TRUE);
length := StringLength(SpaceStr);
tmp := TextLength(rPort^,ADR(SpaceStr), length);
FOR i := 0 TO 7 DO
WITH Regs[i] DO
SetupString(Name,Loc,FALSE);
SetupString(ColonStr,DummyLoc,FALSE);
INC(Loc.X,DummyLoc.X);
END;
IF i < 7 THEN
WITH Regs[i+8] DO
Text(rPort^,ADR(SpaceStr), length);
SetupString(Name,Loc,FALSE);
SetupString(ColonStr,DummyLoc,TRUE);
Loc.X :=
Loc.X + tmp + Regs[i].Loc.X + DummyLoc.X;
END
END;
END;
END SetupWindow;
(* +++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
PROCEDURE ShowProcessName;
VAR
length : CARDINAL;
CharPtr : StringPointer;
BEGIN
IF CHAR(CmdLineLenPtr^) = 0C THEN
CharPtr := ADR('(No Command)');
length := 12;
ELSE
CharPtr := CmdLineStrPtr;
length := CARDINAL(CmdLineLenPtr^)
END;
IF length > MaxStringSize THEN
length := MaxStringSize
END;
WITH ProcNameLoc DO
ClearLine(X,Y);
Move(rPort^,X,Y);
END;
Text(rPort^,CharPtr, length);
END ShowProcessName;
(* +++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
PROCEDURE ShowTaskName(CharPtr : StringPointer);
VAR
length : CARDINAL;
BEGIN
length := StringLength(CharPtr^);
IF length > MaxStringSize THEN
length := MaxStringSize
END;
WITH TaskNameLoc DO
ClearLine(X,Y);
Move(rPort^,X,Y);
END;
Text(rPort^,CharPtr, length);
END ShowTaskName;
(* +++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
PROCEDURE ShowTaskState(tstate : TaskState);
BEGIN
WITH StateLoc DO
ClearLine(X,Y);
Move(rPort^,X,Y);
END;
CASE tstate OF
TSInvalid : Text(rPort^,ADR('Invalid '),8) |
TSAdded : Text(rPort^,ADR('Added '),6) |
TSRun : Text(rPort^,ADR('Run '),4) |
TSReady : Text(rPort^,ADR('Ready '),6) |
TSWait : Text(rPort^,ADR('Wait '),5) |
TSExcept : Text(rPort^,ADR('Except '),7) |
TSRemoved : Text(rPort^,ADR('Removed '),8)
END;
END ShowTaskState;
(* +++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
PROCEDURE Spy(target : TaskPtr);
(* This is the actual code that looks up all the info *)
(* on the given task, and then displays it. *)
VAR
Str : ARRAY[0..8] OF CHAR;
mp : IntuiMessagePtr;
tstate: TaskState;
Stack : LongPtr;
stack2: WordPtr;
i : CARDINAL;
stop : BOOLEAN;
pc,sr : LONGWORD;
CharPtr : StringPointer;
BEGIN
REPEAT
stop := FALSE;
(* Get all important info, but first make sure the rug *)
(* doesn't get pulled from under our feet. *)
Forbid;
WITH target^ DO
CharPtr := tcNode.lnName;
tstate := TaskState(tcState);
Stack := tcSPReg;
pc := Stack^;
stack2 := WordPtr(LONGCARD(Stack) + 4D);
sr := LONGWORD(stack2^);
Stack := LongPtr(LONGCARD(Stack) + 6D);
FOR i := 0 TO 14 DO
Regs[i].Value := Stack^;
Stack := LongPtr(LONGCARD(Stack) + 4D);
END;
END; (* with *)
Permit; (* got everything we needed! *)
ShowTaskName(CharPtr);
IF TaskIsProcess THEN
ShowProcessName;
END;
ShowTaskState(tstate);
(* Display the Program Counter *)
Move(rPort^,PcLoc.X,PcLoc.Y);
ConvNumberToString(Str,pc,FALSE,16,8,'0');
Text(rPort^,ADR(Str),8);
(* Display the Status Register *)
Move(rPort^,SrLoc.X,SrLoc.Y);
ConvNumberToString(Str,sr,FALSE,16,4,'0');
Text(rPort^,ADR(Str),4);
(* Display all other registers *)
FOR i := 0 TO 14 DO
WITH Regs[i] DO
Move(rPort^,Loc.X,Loc.Y);
ConvNumberToString(Str,Value,FALSE,16,8,'0');
Text(rPort^,ADR(Str),8);
END;
END;
mp := GetMsg(SpyWindow^.UserPort^);
IF mp <> NIL THEN
stop := Closewindow IN mp^.Class;
ReplyMsg(mp);
END;
Delay(5)
UNTIL stop;
END Spy;
(* +++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
PROCEDURE Observe(TargetTask : TaskPtr);
(* Display various things about the target task *)
BEGIN
IF SpyWindow = NIL THEN
SpyWindow := OpenSimpleWindow(WIDTH,HEIGHT,WINDOWLEFT,
WINDOWTOP,NIL,
WindowFlagsSet{WindowDrag,WindowDepth,
WindowClose, NoCareRefresh},
IDCMPFlagsSet{Closewindow},NIL,NIL);
END;
IF SpyWindow = NIL THEN
WriteString('Could not open window!'); WriteLn
ELSE
SetupWindow(TargetTask);
Spy(TargetTask);
CloseWindow(SpyWindow^);
SpyWindow := NIL;
END;
END Observe;
(* +++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
PROCEDURE InitRegNames;
BEGIN
Regs[0].Name := 'D0';
Regs[1].Name := 'D1';
Regs[2].Name := 'D2';
Regs[3].Name := 'D3';
Regs[4].Name := 'D4';
Regs[5].Name := 'D5';
Regs[6].Name := 'D6';
Regs[7].Name := 'D7';
Regs[8].Name := 'A0';
Regs[9].Name := 'A1';
Regs[10].Name := 'A2';
Regs[11].Name := 'A3';
Regs[12].Name := 'A4';
Regs[13].Name := 'A5';
Regs[14].Name := 'A6';
END InitRegNames;
(* +++++++++++++++++++++++++++++++++++++++++++++++++++++ *)
BEGIN
InitRegNames;
SpyWindow := NIL;
END Snoop.