home *** CD-ROM | disk | FTP | other *** search
/ The CDPD Public Domain Collection for CDTV 4 / CDPD_IV.bin / fish / 931-950 / ff932 / stackmon / stackmon.e < prev    next >
Text File  |  1993-12-22  |  9KB  |  389 lines
  1. /*************************/
  2. /*             */
  3. /*  StackMon v1.0     */
  4. /*  © 1993 David Kinder  */
  5. /*             */
  6. /*  Written with AmigaE  */
  7. /*             */
  8. /*************************/
  9.  
  10. OPT OSVERSION = 37
  11.  
  12. MODULE 'dos/dosextens',
  13.        'exec/execbase','exec/lists','exec/nodes','exec/tasks',
  14.        'gadtools','libraries/gadtools',
  15.        'graphics/text',
  16.        'intuition/intuition','intuition/screens',
  17.        'utility/tagitem'
  18.  
  19. OBJECT mynode
  20.   succ : LONG
  21.   pred : LONG
  22.   type : CHAR
  23.   pri : CHAR
  24.   name : LONG
  25.   ptr : LONG
  26. ENDOBJECT
  27.  
  28. ENUM NONE,ER_GAD,ER_SCR,ER_VISUAL,ER_CONTEXT,ER_GADGET,ER_WINDOW
  29.  
  30. DEF scr : PTR TO screen,
  31.     wnd : PTR TO window,
  32.     listv : PTR TO lh,
  33.     currtask : PTR TO tc,
  34.     exec : PTR TO execbase,
  35.     offset,visual,glist,gadg,stk,max,size,mypri,
  36.     version
  37.  
  38. PROC main() HANDLE
  39.   version := '$VER: StackMon 1.0 (6.9.93)'
  40.   changepri()
  41.   openwin()
  42.   handlemsg()
  43.   Raise(NONE)
  44. EXCEPT
  45.   closewin()
  46.   IF exception > 0 THEN error(ListItem(['','open gadtools.library',
  47.     'find screen','get visual info','create context','create gadget',
  48.     'open window'],exception))
  49. ENDPROC
  50.  
  51. PROC openwin()
  52.   DEF font : PTR TO textattr
  53.  
  54.   exec := execbase
  55.   IF (gadtoolsbase := OpenLibrary('gadtools.library',37)) = NIL THEN
  56.     Raise(ER_GAD)
  57.   IF (scr := LockPubScreen(NIL)) = NIL THEN Raise(ER_SCR)
  58.   font := scr.font
  59.   offset := font.ysize
  60.   IF (visual := GetVisualInfoA(scr,NIL)) = NIL THEN Raise(ER_VISUAL)
  61.   IF (gadg := CreateContext({glist})) = NIL THEN Raise(ER_CONTEXT)
  62.  
  63.   listv := [0,0,0,0,0]:lh
  64.   listv.head := listv+4; listv.tail := 0; listv.tailpred := listv
  65.  
  66.   gettasks()
  67.   font := ['topaz.font',8,0,0]:textattr
  68.  
  69.   IF (gadg := CreateGadgetA(BUTTON_KIND,gadg,
  70.     [12,offset+127,64,14,'_About',font,2,PLACETEXT_IN,visual,0]:newgadget,
  71.     [GT_UNDERSCORE,"_",TAG_DONE])) = NIL THEN Raise(ER_GADGET)
  72.   IF (gadg := CreateGadgetA(BUTTON_KIND,gadg,
  73.     [206,offset+127,64,14,'_Cancel',font,3,PLACETEXT_IN,visual,
  74.      0]:newgadget,[GT_UNDERSCORE,"_",TAG_DONE])) = NIL THEN Raise(ER_GADGET)
  75.   IF (gadg := CreateGadgetA(BUTTON_KIND,gadg,
  76.     [87,offset+127,108,14,'_Update list',font,4,PLACETEXT_IN,visual,
  77.      0]:newgadget,[GT_UNDERSCORE,"_",TAG_DONE])) = NIL THEN Raise(ER_GADGET)
  78.   IF (gadg := CreateGadgetA(LISTVIEW_KIND,gadg,
  79.     [12,offset+55,258,72,NIL,font,1,0,visual,0]:newgadget,[GTLV_SCROLLWIDTH,
  80.      18,GTLV_LABELS,listv,TAG_DONE])) = NIL THEN Raise(ER_GADGET)
  81.  
  82.   IF (wnd := OpenWindowTagList(NIL,
  83.    [WA_LEFT,100,
  84.     WA_TOP,30,
  85.     WA_WIDTH,282,
  86.     WA_HEIGHT,offset+147,
  87.     WA_GADGETS,glist,
  88.     WA_IDCMP,IDCMP_CLOSEWINDOW+IDCMP_VANILLAKEY+IDCMP_CHANGEWINDOW+
  89.       LISTVIEWIDCMP,
  90.     WA_FLAGS,WFLG_DRAGBAR+WFLG_DEPTHGADGET+WFLG_CLOSEGADGET+WFLG_ACTIVATE+
  91.       WFLG_RMBTRAP,
  92.     WA_PUBSCREEN,scr,
  93.     WA_SCREENTITLE,'StackMon v1.0',
  94.     WA_TITLE,'StackMon v1.0',
  95.     WA_ZOOM,[0,offset+55+Mul(282,65536)],
  96.     TAG_DONE])) = NIL THEN Raise(ER_WINDOW)
  97.  
  98.   SetStdRast(wnd.rport)
  99.   SetTopaz(8)
  100.   Gt_RefreshWindow(wnd,NIL)
  101.   DrawBevelBoxA(wnd.rport,12,offset+18,258,12,
  102.     [GT_VISUALINFO,visual,GTBB_RECESSED,TRUE,TAG_DONE])
  103.   Colour(1,0)
  104.   TextF(12,offset+13,'Monitoring:')
  105.   TextF(12,offset+40,'Current:')
  106.   TextF(141,offset+40,'Stack:')
  107.   TextF(12,offset+50, 'Largest:')
  108. ENDPROC
  109.  
  110. PROC closewin()
  111.   IF visual THEN FreeVisualInfo(visual)
  112.   IF wnd THEN CloseWindow(wnd)
  113.   IF glist THEN FreeGadgets(glist)
  114.   IF scr THEN UnlockPubScreen(NIL,scr)
  115.   IF gadtoolsbase THEN CloseLibrary(gadtoolsbase)
  116.   SetTaskPri(FindTask(NIL),mypri)
  117. ENDPROC
  118.  
  119. PROC handlemsg()
  120.   DEF msg : PTR TO intuimessage,
  121.       addr : PTR TO gadget,
  122.       class,code,id
  123.  
  124.   WHILE TRUE
  125.     getinfo()
  126.     Delay(10)
  127.     REPEAT
  128.       msg := Gt_GetIMsg(wnd.userport)
  129.       class := msg.class
  130.       code := msg.code
  131.       addr := msg.iaddress
  132.       Gt_ReplyIMsg(msg)
  133.  
  134.       IF class = IDCMP_CLOSEWINDOW THEN Raise(NONE)
  135.       IF class = IDCMP_CHANGEWINDOW
  136.         Gt_BeginRefresh(wnd)
  137.     Gt_RefreshWindow(wnd,NIL)
  138.         Gt_EndRefresh(wnd,TRUE)
  139.       ENDIF
  140.       IF class = IDCMP_GADGETUP
  141.     id := addr.gadgetid
  142.     SELECT id
  143.       CASE 1
  144.         startmon(code)
  145.       CASE 2
  146.         about()
  147.       CASE 3
  148.         cancel()
  149.       CASE 4
  150.         update()
  151.     ENDSELECT
  152.       ENDIF
  153.       IF class = IDCMP_VANILLAKEY
  154.     SELECT code
  155.       CASE "a"
  156.         about()
  157.       CASE "c"
  158.         cancel()
  159.       CASE "u"
  160.         update()
  161.     ENDSELECT
  162.       ENDIF
  163.  
  164.     UNTIL msg = NIL
  165.   ENDWHILE
  166. ENDPROC
  167.  
  168. PROC about()
  169.   request('StackMon v1.0\n© 1993 David Kinder\n\n"Rise and reverberate"',
  170.     'Continue')
  171. ENDPROC
  172.  
  173. PROC request(body,gadgets)
  174.   EasyRequestArgs(0,[SIZEOF easystruct,0,'StackMon',body,gadgets],0,NIL)
  175. ENDPROC
  176.  
  177. PROC gettasks()
  178.   DEF list : PTR TO lh
  179.  
  180.   Forbid()
  181.   Disable()
  182.   list := exec.taskwait
  183.   scanlist(list.head)
  184.   list := exec.taskready
  185.   scanlist(list.head)
  186.   Enable()
  187.   Permit()
  188. ENDPROC
  189.  
  190. PROC scanlist(pr : PTR TO process)
  191.   DEF node : PTR TO ln,
  192.       cli : PTR TO commandlineinterface,
  193.       name[128] : STRING,
  194.       len 
  195.  
  196.   node := pr
  197.   WHILE node.succ <> NIL
  198.     IF node.type = NT_PROCESS
  199.       IF (cli := Mul(pr.cli,4)) = 0 
  200.         addtolist(node.name,pr,TRUE)
  201.       ELSE
  202.     IF cli.module = 0
  203.       addtolist(node.name,pr,TRUE)
  204.     ELSE
  205.           len := Char(Mul(cli.commandname,4))
  206.           StrCopy(name,Mul(cli.commandname,4)+1,len)
  207.           addtolist(name,pr,TRUE)
  208.     ENDIF
  209.       ENDIF
  210.     ENDIF
  211.     IF node.type = NT_TASK THEN addtolist(node.name,pr,FALSE)
  212.     pr := node.succ
  213.     node := pr
  214.   ENDWHILE
  215. ENDPROC
  216.  
  217. PROC addtolist(name,task,process)
  218.   DEF mem : PTR TO mynode
  219.  
  220.   mem := New(SIZEOF mynode)
  221.   IF mem <> NIL
  222.     mem.name := String(StrLen(name))
  223.     IF mem.name <> NIL THEN StrCopy(mem.name,name,ALL)
  224.     mem.ptr := task
  225.     IF process = TRUE THEN mem.pri := 1
  226.     Enqueue(listv,mem)
  227.   ENDIF
  228. ENDPROC
  229.  
  230. PROC freelist()
  231.   DEF mem : PTR TO mynode
  232.  
  233.   WHILE (mem := RemHead(listv)) <> NIL
  234.     IF mem.name <> NIL THEN DisposeLink(mem.name)
  235.     Dispose(mem)
  236.   ENDWHILE
  237. ENDPROC
  238.  
  239. PROC update()
  240.   freelist()
  241.   gettasks()
  242.   Gt_SetGadgetAttrsA(gadg,wnd,NIL,[GTLV_LABELS,listv,TAG_DONE])
  243.   Gt_RefreshWindow(wnd,NIL)
  244. ENDPROC
  245.  
  246. PROC startmon(id)
  247.   DEF pos : PTR TO mynode,
  248.       list : PTR TO lh,
  249.       status
  250.  
  251.   pos := listv.head
  252.   WHILE id > 0
  253.     pos := pos.succ
  254.     id--
  255.   ENDWHILE
  256.  
  257.   currtask := pos.ptr
  258.   stk := 0
  259.   TextF(100,offset+13,'                     ')
  260.   TextF(189,offset+40,'        ')
  261.   TextF(76,offset+40,'        ')
  262.   TextF(76,offset+50,'        ')
  263.   TextF(141,offset+50,'               ')
  264.  
  265.   status := FALSE
  266.   list := exec.taskwait
  267.   IF searchlist(list.head,currtask) = FALSE
  268.     list := exec.taskready
  269.     IF searchlist(list.head,currtask) = FALSE
  270.       currtask := NIL
  271.       Colour(2,0)
  272.       TextF(141,offset+50,'Task Terminated')
  273.       Colour(0,0)
  274.       RectFill(wnd.rport,14,offset+19,267,offset+28)
  275.     ELSE
  276.       status := TRUE
  277.     ENDIF
  278.   ELSE
  279.     status := TRUE
  280.   ENDIF
  281.  
  282.   IF status = TRUE
  283.     Forbid()
  284.     size := currtask.spupper-currtask.splower
  285.     max := currtask.spupper-currtask.spreg
  286.     Permit()
  287.     Colour(2,0)
  288.     TextF(100,offset+13,'\s(0,21)',pos.name)
  289.     TextF(189,offset+40,'\d',size)
  290.     TextF(76,offset+50,'\d',max)
  291.   ENDIF
  292. ENDPROC
  293.  
  294. PROC cancel()
  295.   currtask := NIL
  296.   TextF(100,offset+13,'                     ')
  297.   TextF(189,offset+40,'        ')
  298.   TextF(76,offset+40,'        ')
  299.   TextF(76,offset+50,'        ')
  300.   TextF(141,offset+50,'               ')
  301.   Colour(0,0)
  302.   RectFill(wnd.rport,14,offset+19,267,offset+28)
  303. ENDPROC
  304.  
  305. PROC getinfo()
  306.   DEF list : PTR TO lh,
  307.       newstk,gauge
  308.  
  309.   IF currtask <> NIL
  310.     list := exec.taskwait
  311.     IF searchlist(list.head,currtask) = FALSE
  312.       list := exec.taskready
  313.       IF searchlist(list.head,currtask) = FALSE
  314.     currtask := NIL
  315.     Colour(2,0)
  316.     TextF(76,offset+40,'        ')
  317.     TextF(141,offset+50,'Task Terminated')
  318.       ENDIF
  319.     ENDIF
  320.   ENDIF
  321.  
  322.   IF currtask <> NIL
  323.     Forbid()
  324.     newstk := currtask.spupper-currtask.spreg
  325.     Permit()
  326.  
  327.     IF stk <> newstk
  328.       stk := newstk
  329.       Colour(2,0)
  330.       TextF(76,offset+40,'        ')
  331.       TextF(76,offset+40,'\d',stk)
  332.       IF stk > max
  333.     max := stk
  334.         Colour(2,0)
  335.     TextF(76,offset+50,'        ')
  336.     TextF(76,offset+50,'\d',max)
  337.       ENDIF
  338.       IF stk > size
  339.     Colour(2,0)
  340.     TextF(141,offset+50,'Stack Overflow')
  341.       ENDIF
  342.       gauge := Div(Mul(stk,254),size)
  343.       IF gauge > 253 THEN gauge := 253
  344.       IF gauge > 0
  345.     Colour(3,0)
  346.     RectFill(wnd.rport,14,offset+19,gauge+14,offset+28)
  347.       ENDIF
  348.       IF gauge < 253
  349.     Colour(0,0)
  350.     RectFill(wnd.rport,gauge+15,offset+19,267,offset+28)
  351.       ENDIF
  352.     ENDIF
  353.   ENDIF
  354. ENDPROC
  355.  
  356. PROC searchlist(pr : PTR TO ln,lookfor)
  357.   DEF rval
  358.  
  359.   Forbid()
  360.   Disable()
  361.   rval := FALSE
  362.   WHILE pr.succ <> NIL
  363.     IF pr = lookfor THEN rval := TRUE
  364.     pr := pr.succ
  365.   ENDWHILE
  366.   Enable()
  367.   Permit()
  368. ENDPROC rval
  369.  
  370. PROC changepri()
  371.   DEF mypr : PTR TO ln
  372.  
  373.   mypr := FindTask(NIL)
  374.   mypri := mypr.pri
  375.   IF mypri < 1 THEN SetTaskPri(mypr,1)
  376. ENDPROC
  377.  
  378. PROC error(errstring)
  379.   DEF str[60] : STRING
  380.  
  381.   IF stdout = NIL
  382.     StrCopy(str,'Could not ',ALL)
  383.     StrAdd(str,errstring,ALL)
  384.     request(str,'Abort')
  385.   ELSE
  386.     WriteF('Could not \s\n',errstring)
  387.   ENDIF
  388. ENDPROC
  389.