home *** CD-ROM | disk | FTP | other *** search
/ Meeting Pearls 1 / Meeting Pearls Vol 1 (1994).iso / installed_progs / dev / stackmon / stackmon.e < prev    next >
Encoding:
Text File  |  1993-09-21  |  12.0 KB  |  532 lines
  1. /**************************/
  2. /*              */
  3. /* StackMon v1.2      */
  4. /* © 1993-94 David Kinder */
  5. /*              */
  6. /* Written with AmigaE      */
  7. /*              */
  8. /**************************/
  9.  
  10. OPT OSVERSION = 37
  11.  
  12. MODULE 'dos/dosextens',
  13.        'exec/execbase','exec/libraries','exec/lists',
  14.        'exec/nodes','exec/tasks',
  15.        'gadtools','libraries/gadtools',
  16.        'graphics/text',
  17.        'intuition/intuition','intuition/screens',
  18.        'utility/tagitem'
  19.  
  20. OBJECT mynode
  21.   succ : LONG
  22.   pred : LONG
  23.   type : CHAR
  24.   pri : CHAR
  25.   name : LONG
  26.   ptr : LONG
  27. ENDOBJECT
  28.  
  29. ENUM NONE,ER_GAD,ER_SCR,ER_VISUAL,ER_CONTEXT,ER_GADGET,ER_WINDOW
  30.  
  31. DEF scr : PTR TO screen,
  32.     wnd : PTR TO window,
  33.     listv : PTR TO lh,
  34.     currtask : PTR TO tc,
  35.     exec : PTR TO execbase,
  36.     strinfo : PTR TO stringinfo,
  37.     str : PTR TO gadget,
  38.     name[128] : STRING,
  39.     offset,visual,glist,gadg,stk,max,size,mypri,
  40.     version
  41.  
  42. PROC main() HANDLE
  43.   version := '$VER: StackMon 1.2 (23.1.94)'
  44.   changepri()
  45.   openwin()
  46.   handlemsg()
  47.   Raise(NONE)
  48. EXCEPT
  49.   closewin()
  50.   IF exception > 0 THEN error(ListItem(['','open gadtools.library',
  51.     'find screen','get visual info','create context','create gadget',
  52.     'open window'],exception))
  53. ENDPROC
  54.  
  55. PROC openwin()
  56.   DEF font : PTR TO textattr,
  57.       execlib : PTR TO lib,
  58.       high
  59.  
  60.   exec := execbase
  61.   execlib := exec
  62.   high := 80
  63.   IF execlib.version > 37 THEN high := high+6
  64.  
  65.   StrCopy(name,'',ALL)
  66.   IF (gadtoolsbase := OpenLibrary('gadtools.library',37)) = NIL THEN
  67.     Raise(ER_GAD)
  68.   IF (scr := LockPubScreen(NIL)) = NIL THEN Raise(ER_SCR)
  69.   font := scr.font
  70.   offset := font.ysize
  71.   IF (visual := GetVisualInfoA(scr,NIL)) = NIL THEN Raise(ER_VISUAL)
  72.   IF (gadg := CreateContext({glist})) = NIL THEN Raise(ER_CONTEXT)
  73.  
  74.   listv := [0,0,0,0,0]:lh
  75.   listv.head := listv+4; listv.tailpred := listv
  76.  
  77.   gettasks()
  78.   font := ['topaz.font',8,0,0]:textattr
  79.  
  80.   IF (gadg := CreateGadgetA(BUTTON_KIND,gadg,
  81.    [12,offset+141,64,14,'About',font,2,PLACETEXT_IN,visual,0]:newgadget,
  82.     NIL)) = NIL THEN Raise(ER_GADGET)
  83.   IF (gadg := CreateGadgetA(BUTTON_KIND,gadg,
  84.    [206,offset+141,64,14,'Stop',font,3,PLACETEXT_IN,visual,0]:newgadget,
  85.     NIL)) = NIL THEN Raise(ER_GADGET)
  86.   IF (gadg := CreateGadgetA(BUTTON_KIND,gadg,
  87.    [87,offset+141,108,14,'Update list',font,4,PLACETEXT_IN,visual,
  88.     0]:newgadget,NIL)) = NIL THEN Raise(ER_GADGET)
  89.   IF (gadg := CreateGadgetA(STRING_KIND,gadg,
  90.    [12,offset+123,258,14,NIL,font,5,0,visual,0]:newgadget,
  91.     NIL)) = NIL THEN Raise(ER_GADGET)
  92.   str := gadg
  93.   strinfo := str.specialinfo
  94.   IF (gadg := CreateGadgetA(LISTVIEW_KIND,gadg,
  95.    [12,offset+55,258,high,NIL,font,1,0,visual,0]:newgadget,
  96.    [GTLV_SCROLLWIDTH,18,GTLV_LABELS,listv,GTLV_SHOWSELECTED,str,
  97.     TAG_DONE])) = NIL THEN Raise(ER_GADGET)
  98.  
  99.   IF (wnd := OpenWindowTagList(NIL,
  100.    [WA_LEFT,100,
  101.     WA_TOP,25,
  102.     WA_WIDTH,282,
  103.     WA_HEIGHT,offset+161,
  104.     WA_GADGETS,glist,
  105.     WA_IDCMP,IDCMP_CLOSEWINDOW+IDCMP_CHANGEWINDOW+LISTVIEWIDCMP,
  106.     WA_FLAGS,WFLG_DRAGBAR+WFLG_DEPTHGADGET+WFLG_CLOSEGADGET+WFLG_ACTIVATE+
  107.       WFLG_RMBTRAP,
  108.     WA_PUBSCREEN,scr,
  109.     WA_SCREENTITLE,'StackMon v1.2',
  110.     WA_TITLE,'StackMon v1.2',
  111.     WA_ZOOM,[0,offset+55+Mul(282,65536)],
  112.     TAG_DONE])) = NIL THEN Raise(ER_WINDOW)
  113.  
  114.   SetStdRast(wnd.rport)
  115.   SetTopaz(8)
  116.   Gt_RefreshWindow(wnd,NIL)
  117.   DrawBevelBoxA(wnd.rport,12,offset+18,258,12,
  118.     [GT_VISUALINFO,visual,GTBB_RECESSED,TRUE,TAG_DONE])
  119.   Colour(1,0)
  120.   TextF(12,offset+13,'Monitoring:')
  121.   TextF(12,offset+40,'Current:')
  122.   TextF(141,offset+40,'Stack:')
  123.   TextF(12,offset+50, 'Largest:')
  124. ENDPROC
  125.  
  126. PROC closewin()
  127.   IF visual THEN FreeVisualInfo(visual)
  128.   IF wnd THEN CloseWindow(wnd)
  129.   IF glist THEN FreeGadgets(glist)
  130.   IF scr THEN UnlockPubScreen(NIL,scr)
  131.   IF gadtoolsbase THEN CloseLibrary(gadtoolsbase)
  132.   SetTaskPri(FindTask(NIL),mypri)
  133. ENDPROC
  134.  
  135. PROC handlemsg()
  136.   DEF msg : PTR TO intuimessage,
  137.       addr : PTR TO gadget,
  138.       class,code,id
  139.  
  140.   WHILE TRUE
  141.     getinfo()
  142.     Delay(10)
  143.     ActivateGadget(str,wnd,NIL)
  144.     WHILE (msg := Gt_GetIMsg(wnd.userport)) <> NIL
  145.       class := msg.class
  146.       code := msg.code
  147.       addr := msg.iaddress
  148.       Gt_ReplyIMsg(msg)
  149.  
  150.       IF class = IDCMP_CLOSEWINDOW THEN Raise(NONE)
  151.       IF class = IDCMP_CHANGEWINDOW
  152.         Gt_BeginRefresh(wnd)
  153.     Gt_RefreshWindow(wnd,NIL)
  154.         Gt_EndRefresh(wnd,TRUE)
  155.       ENDIF
  156.       IF class = IDCMP_GADGETUP
  157.     id := addr.gadgetid
  158.     SELECT id
  159.       CASE 1
  160.         startmon(code)
  161.       CASE 2
  162.         about()
  163.       CASE 3
  164.         cancel()
  165.       CASE 4
  166.         update()
  167.       CASE 5
  168.         cancel()
  169.         StrCopy(name,strinfo.buffer,128)
  170.         Colour(2,0)
  171.         TextF(100,offset+13,'\s(0,21)',name)
  172.     ENDSELECT
  173.       ENDIF
  174.  
  175.     ENDWHILE
  176.   ENDWHILE
  177. ENDPROC
  178.  
  179. PROC about()
  180.   request('StackMon v1.2\n© 1993-94 David Kinder\n\n"Rise and reverberate"',
  181.     'Continue')
  182. ENDPROC
  183.  
  184. PROC request(body,gadgets)
  185.   EasyRequestArgs(0,[SIZEOF easystruct,0,'StackMon',body,gadgets],0,NIL)
  186. ENDPROC
  187.  
  188. PROC gettasks()
  189.   DEF list : PTR TO lh,
  190.       sort : PTR TO lh,
  191.       node : PTR TO mynode,
  192.       mem : PTR TO mynode
  193.  
  194.   Disable()
  195.   list := exec.taskwait
  196.   scanlist(list.head)
  197.   list := exec.taskready
  198.   scanlist(list.head)
  199.   Enable()
  200.  
  201.   node := listv.head
  202.   sort := [0,0,0,0,0]:lh
  203.   sort.head := sort+4; sort.tail := 0; sort.tailpred := sort
  204.  
  205.   WHILE node.succ <> NIL
  206.     IF (mem := New(SIZEOF mynode)) <> NIL
  207.       mem.name := String(StrLen(node.name))
  208.       IF mem.name <> NIL THEN StrCopy(mem.name,node.name,ALL)
  209.       mem.ptr := node.ptr
  210.       mem.pri := node.pri+sortpos(node)
  211.       Enqueue(sort,mem)
  212.     ENDIF
  213.     node := node.succ
  214.   ENDWHILE
  215.   freelist()
  216.   listv.head := sort.head; listv.tailpred := sort.tailpred
  217. ENDPROC
  218.  
  219. PROC sortpos(node : PTR TO mynode)
  220.   DEF lnode : PTR TO mynode,i
  221.  
  222.   i := 0
  223.   lnode := listv.head
  224.   WHILE lnode.succ <> NIL
  225.     IF compare(node.name,lnode.name) > 0 THEN i++
  226.     lnode := lnode.succ
  227.   ENDWHILE
  228. ENDPROC i
  229.  
  230. PROC compare(str1 : PTR TO CHAR,str2 : PTR TO CHAR)
  231.   DEF ustr1[128] : STRING,
  232.       ustr2[128] : STRING,
  233.       i,diff
  234.  
  235.   StrCopy(ustr1,str1,ALL)
  236.   StrCopy(ustr2,str2,ALL)
  237.   UpperStr(ustr1)
  238.   UpperStr(ustr2)
  239.   i := 0
  240.   LOOP
  241.     IF ustr1[i] = 0 THEN RETURN 1
  242.     IF ustr2[i] = 0 THEN RETURN -1
  243.     diff := ustr1[i]-ustr2[i]
  244.     IF diff < 0 THEN RETURN 1
  245.     IF diff > 0 THEN RETURN -1
  246.     i++
  247.   ENDLOOP
  248. ENDPROC
  249.  
  250. PROC scanlist(pr : PTR TO process)
  251.   DEF node : PTR TO ln,
  252.       cli : PTR TO commandlineinterface,
  253.       name[128] : STRING,
  254.       len 
  255.  
  256.   node := pr
  257.   WHILE node.succ <> NIL
  258.     IF node.type = NT_PROCESS
  259.       IF (cli := Mul(pr.cli,4)) = 0 
  260.         addtolist(node.name,pr,TRUE)
  261.       ELSE
  262.     IF cli.module = 0
  263.       addtolist(node.name,pr,TRUE)
  264.     ELSE      
  265.           len := Char(Mul(cli.commandname,4))
  266.       IF len = 0
  267.         addtolist(node.name,pr,TRUE)
  268.       ELSE
  269.         StrCopy(name,Mul(cli.commandname,4)+1,len)
  270.         addtolist(name,pr,TRUE)
  271.       ENDIF
  272.     ENDIF
  273.       ENDIF
  274.     ELSE
  275.       addtolist(node.name,pr,FALSE)
  276.     ENDIF
  277.     pr := node.succ
  278.     node := pr
  279.   ENDWHILE
  280. ENDPROC
  281.  
  282. PROC addtolist(name,task,process)
  283.   DEF mem : PTR TO mynode
  284.  
  285.   IF (mem := New(SIZEOF mynode)) <> NIL
  286.     mem.name := String(StrLen(name))
  287.     IF mem.name <> NIL THEN StrCopy(mem.name,name,ALL)
  288.     mem.ptr := task
  289.     IF process = FALSE THEN mem.pri := -127
  290.     Enqueue(listv,mem)
  291.   ENDIF
  292. ENDPROC
  293.  
  294. PROC freelist()
  295.   DEF mem : PTR TO mynode
  296.  
  297.   WHILE (mem := RemHead(listv)) <> NIL
  298.     IF mem.name <> NIL THEN DisposeLink(mem.name)
  299.     Dispose(mem)
  300.   ENDWHILE
  301. ENDPROC
  302.  
  303. PROC update()
  304.   freelist()
  305.   gettasks()
  306.   Gt_SetGadgetAttrsA(gadg,wnd,NIL,[GTLV_LABELS,listv,TAG_DONE])
  307.   Gt_RefreshWindow(wnd,NIL)
  308. ENDPROC
  309.  
  310. PROC startmon(id)
  311.   DEF pos : PTR TO mynode,
  312.       list : PTR TO lh,
  313.       status
  314.  
  315.   pos := listv.head
  316.   WHILE id > 0
  317.     pos := pos.succ
  318.     id--
  319.   ENDWHILE
  320.  
  321.   StrCopy(name,'',ALL)
  322.   currtask := pos.ptr
  323.   stk := 0
  324.   TextF(100,offset+13,'                     ')
  325.   TextF(189,offset+40,'        ')
  326.   TextF(76,offset+40,'        ')
  327.   TextF(76,offset+50,'        ')
  328.   TextF(141,offset+50,'               ')
  329.  
  330.   status := FALSE
  331.   list := exec.taskwait
  332.   IF searchlist(list.head,currtask) = FALSE
  333.     list := exec.taskready
  334.     IF searchlist(list.head,currtask) = FALSE
  335.       currtask := NIL
  336.       Colour(2,0)
  337.       TextF(141,offset+50,'Task not found')
  338.       Colour(0,0)
  339.       RectFill(wnd.rport,14,offset+19,267,offset+28)
  340.     ELSE
  341.       status := TRUE
  342.     ENDIF
  343.   ELSE
  344.     status := TRUE
  345.   ENDIF
  346.  
  347.   IF status = TRUE
  348.     Forbid()
  349.     size := currtask.spupper-currtask.splower
  350.     max := currtask.spupper-currtask.spreg
  351.     Permit()
  352.     Colour(2,0)
  353.     TextF(100,offset+13,'\s(0,21)',pos.name)
  354.     show(189,40,size)
  355.     show(76,50,max)
  356.   ENDIF
  357. ENDPROC
  358.  
  359. PROC cancel()
  360.   currtask := NIL
  361.   TextF(100,offset+13,'                     ')
  362.   TextF(189,offset+40,'        ')
  363.   TextF(76,offset+40,'        ')
  364.   TextF(76,offset+50,'        ')
  365.   TextF(141,offset+50,'               ')
  366.   Colour(0,0)
  367.   RectFill(wnd.rport,14,offset+19,267,offset+28)
  368.   StrCopy(name,'',ALL)
  369. ENDPROC
  370.  
  371. PROC getinfo()
  372.   DEF list : PTR TO lh,
  373.       newstk,newsize,gauge
  374.  
  375.   IF currtask <> NIL
  376.     Forbid()
  377.     list := exec.taskwait
  378.     IF searchlist(list.head,currtask) = FALSE
  379.       list := exec.taskready
  380.       IF searchlist(list.head,currtask) = FALSE
  381.     currtask := NIL
  382.     Colour(2,0)
  383.     TextF(76,offset+40,'        ')
  384.     TextF(141,offset+50,'Task not found')
  385.       ENDIF
  386.     ENDIF
  387.     Permit()
  388.   ELSE
  389.     IF StrCmp(name,'',ALL) = FALSE
  390.       Forbid()
  391.       list := exec.taskwait
  392.       currtask := searchlistname(list.head)
  393.       list := exec.taskready
  394.       IF currtask = NIL THEN currtask := searchlistname(list.head)
  395.       Permit()
  396.       IF currtask <> NIL
  397.     StrCopy(name,'',ALL)
  398.     stk := 0
  399.     TextF(189,offset+40,'        ')
  400.     TextF(76,offset+40,'        ')
  401.     TextF(76,offset+50,'        ')
  402.     TextF(141,offset+50,'               ')
  403.     Forbid()
  404.     size := currtask.spupper-currtask.splower
  405.     max := currtask.spupper-currtask.spreg
  406.     Permit()
  407.     Colour(2,0)
  408.     TextF(100,offset+13,'\s(0,21)',name)
  409.     show(189,40,size)
  410.     show(76,50,max)
  411.       ELSE
  412.     Colour(2,0)
  413.     TextF(141,offset+50,'Task not found')
  414.       ENDIF
  415.     ENDIF
  416.   ENDIF
  417.  
  418.   IF currtask <> NIL
  419.     Forbid()
  420.     newstk := currtask.spupper-currtask.spreg
  421.     newsize := currtask.spupper-currtask.splower
  422.     Permit()
  423.  
  424.     IF newsize <> size
  425.       size := newsize
  426.       Colour(2,0)
  427.       TextF(189,offset+40,'        ')
  428.       show(189,40,size)
  429.     ENDIF
  430.  
  431.     IF stk <> newstk
  432.       stk := newstk
  433.       Colour(2,0)
  434.       TextF(76,offset+40,'        ')
  435.       show(76,40,stk)
  436.       IF stk > max
  437.     max := stk
  438.         Colour(2,0)
  439.     TextF(76,offset+50,'        ')
  440.     show(76,50,max)
  441.       ENDIF
  442.       IF stk > size
  443.     Colour(2,0)
  444.     TextF(141,offset+50,'Stack Overflow')
  445.       ENDIF
  446.       gauge := Div(Mul(stk,254),size)
  447.       IF (stk < 0) OR (stk > 999999) THEN gauge := -1
  448.       IF gauge > 253 THEN gauge := 253
  449.       IF gauge > 0
  450.     Colour(3,0)
  451.     RectFill(wnd.rport,14,offset+19,gauge+14,offset+28)
  452.       ENDIF
  453.       IF gauge < 253
  454.     Colour(0,0)
  455.     RectFill(wnd.rport,gauge+15,offset+19,267,offset+28)
  456.       ENDIF
  457.     ENDIF
  458.   ENDIF
  459. ENDPROC
  460.  
  461. PROC searchlist(pr : PTR TO ln,lookfor)
  462.   DEF rval
  463.  
  464.   Disable()
  465.   rval := FALSE
  466.   WHILE pr.succ <> NIL
  467.     IF pr = lookfor THEN rval := TRUE
  468.     pr := pr.succ
  469.   ENDWHILE
  470.   Enable()
  471. ENDPROC rval
  472.  
  473. PROC searchlistname(pr : PTR TO ln)
  474.   DEF proc : PTR TO process,
  475.       cli : PTR TO commandlineinterface,
  476.       rval,len
  477.  
  478.   rval := NIL
  479.   Disable()
  480.   WHILE pr.succ <> NIL
  481.     IF pr.type = NT_PROCESS
  482.       proc := pr
  483.       IF (cli := Mul(proc.cli,4)) = 0
  484.     IF StrCmp(pr.name,name,ALL) THEN rval := pr
  485.       ELSE
  486.     IF cli.module = 0
  487.       IF StrCmp(pr.name,name,ALL) THEN rval := pr
  488.     ELSE
  489.       len := Char(Mul(cli.commandname,4))
  490.       IF len = 0
  491.         IF StrCmp(pr.name,name,ALL) THEN rval := pr
  492.       ELSE
  493.         IF StrCmp(Mul(cli.commandname,4)+1,name,len) THEN rval := pr
  494.       ENDIF
  495.     ENDIF
  496.       ENDIF
  497.     ELSE
  498.       IF StrCmp(pr.name,name,ALL) THEN rval := pr
  499.     ENDIF
  500.     pr := pr.succ
  501.   ENDWHILE
  502.   Enable()
  503. ENDPROC rval
  504.  
  505. PROC changepri()
  506.   DEF mypr : PTR TO ln
  507.  
  508.   mypr := FindTask(NIL)
  509.   mypri := mypr.pri
  510.   IF mypri < 1 THEN SetTaskPri(mypr,1)
  511. ENDPROC
  512.  
  513. PROC error(errstring)
  514.   DEF str[60] : STRING
  515.  
  516.   IF stdout = NIL
  517.     StrCopy(str,'Could not ',ALL)
  518.     StrAdd(str,errstring,ALL)
  519.     request(str,'Abort')
  520.   ELSE
  521.     WriteF('Could not \s\n',errstring)
  522.   ENDIF
  523. ENDPROC
  524.  
  525. PROC show(x,y,var)
  526.   IF (var >= 0) AND (var <= 999999)
  527.     TextF(x,offset+y,'\d',var)
  528.   ELSE
  529.     TextF(x,offset+y,'???')
  530.   ENDIF
  531. ENDPROC
  532.