Difference between revisions of "TMGIDE.m"

From VistApedia
Jump to: navigation, search
Line 1: Line 1:
−
        ;"------------------------------------------------------------
+
;"------------------------------------------------------------
−
        ;"------------------------------------------------------------
+
;"------------------------------------------------------------
−
        ;"
+
;"
−
        ;" GT.M STEP TRAP
+
;" GT.M Debug Tracer
−
        ;"
+
;"
−
        ;" K. Toppenberg
+
;" K. Toppenberg
−
        ;" 4-13-2005
+
;" 4-13-2005
−
        ;" License: GPL Applies
+
;" License: GPL Applies
−
        ;"  
+
;"
−
        ;" This code module will allow tracing through code.
+
;"
−
        ;" It is used as follows:
+
;" This program will launch a shell for the TMG STEP TRAP debugger
−
        ;"
+
;" It provides the user with a prompt, like this:
−
        ;" set $ZSTEP="do STEPTRAP^TMGTRSTP($ZPOS) zstep into zcontinue"
+
;"
−
        ;" zstep into
+
;"     (^ to quit) IDE>
−
        ;" do ^MyFunction  ;"<--- put the function you want to trace here
+
;"
−
        ;"
+
;" Any valid M code may be entered here.  To use the tracing
−
        ;" set $ZSTEP="" ;"<---turn off step capture
+
;" ability, launch a function, like this:
−
        ;" quit
+
  ;"
−
        ;"
+
;"     (^ to quit) IDE>do ^MyFunction
−
        ;"
+
;"
−
        ;" Dependencies:
+
;"
−
        ;"   Uses TMGTERM
+
;" Dependancies:
−
        ;"
+
;"     Uses TMGTRSTP,TMGTERM
−
        ;"Notes:
+
  ;"
−
        ;"  This function will be called inbetween lines of the main
+
  ;"------------------------------------------------------------
−
        ;"  program that is being traced.  Thus is function can't do
+
;"------------------------------------------------------------
−
        ;" anything that might change the environment of the main
+
−
        ;" program.  This includes accessing global variables --
+
−
        ;" because it will mess up the "naked reference".
+
Start
−
        ;"------------------------------------------------------------
+
      set TMGScrWidth=70
−
        ;"------------------------------------------------------------
+
      set TMGScrHeight=10
−
       
+
   
−
    STEPTRAP(Pos)
+
      do SetGlobals^TMGTERM
−
                ;"Purpose: This is the line that is called by GT.M for each zstep event.
+
      set TMGNlFGColor=TMGcWhite
−
                ;" It will be used to display the current code execution point, and
+
      set TMGNlBGColor=TMGcBlack
−
                ;" query user as to plans for future execution: run/step/ etc.
+
      set TMGDbFGColor=TMGcBlack
−
       
+
      set TMGDbBFColor=TMGcWhite
−
        new tpBlankLine
+
−
        new tpAction
+
      set ^TMP("TMGIDE",$J,"Normal Foreground Color")=TMGcBlack
−
        new tpKeyIn
+
      set ^TMP("TMGIDE",$J,"Normal Background Color")=TMGcWhite
−
        new tpRunMode,tpStepMode
+
      set ^TMP("TMGIDE",$J,"Debug Foreground Color")=TMGcWhite
−
        new tpI
+
      set ^TMP("TMGIDE",$J,"Debug Background Color")=TMGcBlack
−
        new tpDone
+
 
−
        new result set result=1 ;1=step into, 2=step over
+
      for i=1:1:80 write !
−
       
+
      write !,"Welcome to the TMG debugging environment",!
−
        ;"Run modes: 0=running mode 
+
      write "Enter any valid M command...",!
−
        ;"          1=stepping mode
+
      set $ZTRAP="do ErrTrap^TMGTPSTP($ZPOS) break"
−
        ;"          2=Don't show code
+
      set $ZSTATUS=""
−
        ;"     3=running SLOW mode
+
   
−
        ;"          -1=quit
+
      do Prompt
−
       
+
Done
−
        set tpRunMode=$get(TMGRunMode,1)
+
      do ShutDown
−
        set tpStepMode=$get(TMGStepMode,"into")
+
      quit
−
       
+
−
        new ScrHeight,ScrWidth
+
;"-------------------------------------------------------------------
−
        set ScrHeight=$get(TMGScrHeight,10)
+
 
−
        set ScrWidth=$get(TMGScrWidth,80)
+
  Prompt
−
       
+
      new Line
−
        set tpBlankLine=" "
+
      read !,"(^ to quit) IDE>",Line,!
−
        for tpI=1:1:ScrWidth-1 set tpBlankLine=tpBlankLine_" "
+
−
       
+
      if Line="^" set $ZSTEP="" quit
−
        do VCUSAV2^TMGTERM
+
      set $ZSTEP="N TMGTrap S TMGTrap=$$STEPTRAP^TMGTPSTP($ZPOS) zstep:(TMGTrap=1) into zstep:(TMGTrap=2) over zcontinue"
−
        if tpRunMode'=2 do
+
      ;set $ZSTEP="do STEPTRAP^TMGTPSTP($ZPOS) zstep into zcontinue"
−
        . do ShowCodePos(Pos,ScrWidth,ScrHeight)
+
   
−
        else  do
+
      set TMGRunMode=1  ;"1=Step-by-step mode
−
        . do CUP^TMGTERM(1,2)
+
      zstep into
−
        write tpBlankLine,!
+
      xecute Line
−
        write tpBlankLine,!
+
      set $ZSTEP=""  ;"turn off step capture
−
        do CUU^TMGTERM(2)
+
      goto Prompt
−
       
+
   
−
        if (tpRunMode=0)!(tpRunMode=3)!(tpRunMode=2) do
+
   
−
        . write tpBlankLine,!
+
  ShutDown
−
        . do CUU^TMGTERM(1)
+
      ;"do ShowCode("",80,15,1)
−
        . write "(Press any key to pause)",!
+
      do KillGlobals^TMGTERM
−
        . read *tpKeyIn:0
+
       kill TMGNlFGColor
−
        . if (tpKeyIn>0) set tpRunMode=1
+
      kill TMGNlBGColor
−
        . else  if tpRunMode=3 hang 1
+
      kill TMGDbFGColor
−
       
+
      kill TMGDbBFColor
−
        if tpRunMode=2 goto SPDone ;"Don't showmode --> goto SPDone
+
−
       
+
      quit
−
        set tpDone=0
+
   
−
        if tpRunMode=1 for  do  quit:tpDone=1
+
  BKPT
−
        . new DefAction set DefAction="O"
+
         read "Enter breakpoint (e.g. Label+8^MyFunct): ",Pos,!
−
        . do ShowCodePos(Pos,ScrWidth,ScrHeight)
+
         set Pos=Pos_":""n tmg s tmg=$$STEPTRAP^TMGTPSTP($ZPOS,1)"""
−
        . do CUP^TMGTERM(1,ScrHeight+4) ;"Cursor to line (x,y)
+
         ZBREAK @Pos
−
        . write tpBlankLine,!
+
         write "ZBREAK ",Pos,!
−
        . do CUU^TMGTERM(1)
+
   
−
        . write "Action (? for help): "
 
−
        . if tpStepMode="into" write "step INTO// " set DefAction="I"
 
−
        . else write "step OVER// " set DefAction="O"
 
−
        . read tpAction,!
 
−
        . if tpAction="" set tpAction=DefAction
 
−
        . if "rR"[tpAction do quit
 
−
        . . set tpRunMode=0
 
−
        . . set tpDone=1
 
−
        . if "lL"[tpAction do  quit
 
−
        . . set tpRunMode=3
 
−
        . . set tpDone=1
 
−
        . if "mM"[tpAction do quit
 
−
        . . write tpBlankLine,!
 
−
        . . do CUU^TMGTERM(1)
 
−
        . . new tpLine
 
−
        . . read " enter M code: ",tpLine,!
 
−
        . . xecute tpLine
 
−
        . if "iI"[tpAction do  quit
 
−
        . . set tpStepMode="into"
 
−
        . . ;"set $ZSTEP="do STEPTRAP^TMGTPSTP($ZPOS) zstep into zcontinue"
 
−
        . . set tpDone=1
 
−
        . if "Oo"[tpAction do  quit
 
−
        . . set tpStepMode="over"
 
−
        . . ;"set $ZSTEP="do STEPTRAP^TMGTPSTP($ZPOS) zstep over zcontinue"
 
−
        . . set tpDone=1
 
−
        . if "Hh"[tpAction do quit
 
−
        . . set tpRunMode=2
 
−
        . . set tpDone=1
 
−
        . else do  quit
 
−
        . . new tpNLines
 
−
        . . for tpNLines=1:1:5 write tpBlankLine,!
 
−
        . . do CUU^TMGTERM(5)
 
−
        . . write " L  -- run in sLow mode",!
 
−
        . . write " M -- enter any line of M code",!
 
−
        . . write " O -- step OVER line",!
 
−
        . . write " I -- step INTO line",!
 
−
        . . write " R -- run",!
 
−
        . . write " H  -- Hide debug code",!
 
−
       
 
−
    SPDone
 
−
        do VCULOAD2^TMGTERM
 
−
        set TMGRunMode=tpRunMode
 
−
        if tpStepMode="into" set result=1
 
−
        else  set result=2
 
−
        set TMGStepMode=tpStepMode
 
−
        quit result
 
−
       
 
−
       
 
−
    ErrTrap(Pos)
 
−
                ;"Purpose: This is the line that is called by GT.M for each ztrap event.
 
−
                ;" It will be used to display the current code execution point
 
−
       
 
−
        new ScrHeight,ScrWidth
 
−
        set ScrHeight=$get(TMGScrHeight,10)
 
−
        set ScrWidth=$get(TMGScrWidth,70)
 
−
       
 
−
        do VCUSAV2^TMGTERM
 
−
        do ShowCodePos(Pos,ScrWidth,ScrHeight)
 
−
       
 
−
        ETDone
 
−
        do VCULOAD2^TMGTERM
 
−
        quit
 
−
       
 
−
       
 
−
       
 
−
       
 
−
    ShowCode(Pos,ScrWidth,ScrHeight,Wipe)
 
−
        ;"Purpose: This will display code at the top of the screen
 
−
        ;"Input: Pos -- string like this: X+2^ROUTINE[$DMOD]
 
−
        ;"      ScrWidth -- width of code display (Num of columns)
 
−
        ;
 
−
        ;"      Wipe -- OPTIONAL.  if 1, then code area is wiped blank
 
−
       
 
−
        new i
 
−
        new Routine,Label,Offest,s
 
−
        new LastRou,LastLabel,LastOffset
 
−
        new dbFGColor,bBGColor,nlFGColor,nlBGColor
 
−
        new BlankLine        
 
−
        new StartOffset
 
−
       
 
−
        set ScrWidth=$get(ScrWidth,80)
 
−
        set ScrHeight=$get(ScrHeight,10)
 
−
       
 
−
        set nlFGColor=$get(TMGNlFGColor,3)
 
−
        set nlBGColor=$get(TMGNlBGColor,0)
 
−
        set dbFGColor=$get(TMGDbFGColor,0)
 
−
        set dbBGColor=$get(TMGDbBGColor,3)
 
−
       
 
−
        set BlankLine=" "
 
−
        for i=1:1:ScrWidth-1 set BlankLine=BlankLine_" "
 
−
       
 
−
        do VCOLORS^TMGTERM(dbFGColor,dbBGColor)
 
−
       
 
−
        do CUP^TMGTERM(1,1) ;"Cursor to line (1,1)
 
−
        write BlankLine,! ;"This is needed for some reason...
 
−
        do CUU^TMGTERM(2)
 
−
       
 
−
        if $get(Wipe)=1 do goto SCDone
 
−
         . do VCOLORS^TMGTERM(nlFGColor,nlBGColor)
 
−
        . for i=0:1:ScrHeight+1 write BlankLine
 
−
       
 
−
        set s=$piece(Pos,"$",1)  ;"e.g. X+2^ROUTINE$DMOD-->X+2^ROUTINE
 
−
        set Routine=$piece(s,"^",2)
 
−
        set Label=$piece(s,"^",1)
 
−
        set Offset=+$piece(Label,"+",2)
 
−
         set Label=$piece(Label,"+",1)
 
−
       
 
−
        set s="=== Routine: ^"_Routine_" " write s
 
−
        for i=1:1:ScrWidth-$length(s) write "="
 
−
        write !
 
−
       
 
−
        if Offset>(ScrHeight) do
 
−
                set StartOffset=(Offset-ScrHeight)
 
−
        else  set StartOffset=0
 
−
       
 
−
        for i=StartOffset:1:(ScrHeight+StartOffset) do
 
−
        . new line,Bl,ref,LoopOffset
 
−
        . set ref=Label_"+"_i_"^"_Routine
 
−
         . set line=$text(@ref)
 
−
        . if (i=Offset) do
 
−
        . . do VCOLORS^TMGTERM(nlFGColor,nlBGColor)
 
−
        . . write ">"
 
−
         . else  write " "
 
−
        . if $length(line)>(ScrWidth-1) do
 
−
        . . write $extract(line,1,ScrWidth-4),"...",!
 
−
        . else do
 
−
        . . write $extract(line,1,ScrWidth-1)
 
−
        . . write $extract(BlankLine,1,ScrWidth-$length(line)-1),!
 
−
        . if (i=Offset) do VCOLORS^TMGTERM(dbFGColor,dbBGColor)
 
−
       
 
−
        for i=1:1:ScrWidth write "~"
 
−
        write !
 
−
       
 
−
    SCDone
 
−
        ;"do VCULOAD^TMGTERM
 
−
        do VCOLORS^TMGTERM(nlFGColor,nlBGColor)
 
−
       
 
−
        ;"do CUD^TMGTERM(2)
 
−
       
 
 
         quit
 
         quit

Revision as of 16:42, 21 June 2005

;"------------------------------------------------------------
;"------------------------------------------------------------
;"
;" GT.M Debug Tracer
;"
;" K. Toppenberg
;" 4-13-2005
;" License: GPL Applies
;"
;"
;" This program will launch a shell for the TMG STEP TRAP debugger
;" It provides the user with a prompt, like this:
;"
;"      (^ to quit) IDE>
;"
;" Any valid M code may be entered here.  To use the tracing
;" ability, launch a function, like this:
;"
;"      (^ to quit) IDE>do ^MyFunction
;"
;"
;" Dependancies:
;"     Uses TMGTRSTP,TMGTERM
;"
;"------------------------------------------------------------
;"------------------------------------------------------------  


Start
      set TMGScrWidth=70
      set TMGScrHeight=10

      do SetGlobals^TMGTERM
      set TMGNlFGColor=TMGcWhite
      set TMGNlBGColor=TMGcBlack
      set TMGDbFGColor=TMGcBlack
      set TMGDbBFColor=TMGcWhite

      set ^TMP("TMGIDE",$J,"Normal Foreground Color")=TMGcBlack
      set ^TMP("TMGIDE",$J,"Normal Background Color")=TMGcWhite
      set ^TMP("TMGIDE",$J,"Debug Foreground Color")=TMGcWhite
      set ^TMP("TMGIDE",$J,"Debug Background Color")=TMGcBlack
 
      for i=1:1:80 write !
      write !,"Welcome to the TMG debugging environment",!
      write "Enter any valid M command...",!
      set $ZTRAP="do ErrTrap^TMGTPSTP($ZPOS) break"
      set $ZSTATUS=""

      do Prompt
Done
      do ShutDown
      quit

;"-------------------------------------------------------------------

Prompt
      new Line
      read !,"(^ to quit) IDE>",Line,!

      if Line="^" set $ZSTEP="" quit
      set $ZSTEP="N TMGTrap S TMGTrap=$$STEPTRAP^TMGTPSTP($ZPOS) zstep:(TMGTrap=1) into zstep:(TMGTrap=2) over zcontinue"
      ;set $ZSTEP="do STEPTRAP^TMGTPSTP($ZPOS) zstep into zcontinue"

      set TMGRunMode=1  ;"1=Step-by-step mode
      zstep into
      xecute Line
      set $ZSTEP=""  ;"turn off step capture
      goto Prompt


ShutDown
      ;"do ShowCode("",80,15,1)
      do KillGlobals^TMGTERM
      kill TMGNlFGColor
      kill TMGNlBGColor
      kill TMGDbFGColor
      kill TMGDbBFColor

      quit

BKPT
       read "Enter breakpoint (e.g. Label+8^MyFunct): ",Pos,!
       set Pos=Pos_":""n tmg s tmg=$$STEPTRAP^TMGTPSTP($ZPOS,1)"""
       ZBREAK @Pos
       write "ZBREAK ",Pos,!

       quit
Retrieved from "https://vistapedia.com/index.php?title=TMGIDE.m&oldid=503"