Difference between revisions of "TMGTPSTP.m"

From VistApedia
Jump to: navigation, search
(Added a glossary link to Action~)
 
(6 intermediate revisions by 2 users not shown)
Line 1: Line 1:
−
        ;"------------------------------------------------------------
+
;"------------------------------------------------------------
−
        ;"------------------------------------------------------------
+
;"------------------------------------------------------------
−
        ;"
+
;"
−
        ;" GT.M STEP TRAP
+
;" GT.M STEP TRAP
−
        ;"
+
;"
−
        ;" K. Toppenberg
+
;" K. Toppenberg
−
        ;" 4-13-2005
+
;" 4-13-2005
−
        ;" License: GPL Applies
+
;" License: GPL Applies
−
        ;"  
+
;"  
−
        ;" This code module will allow tracing through code.
+
;" This code module will allow tracing through code.
−
        ;" It is used as follows:
+
;" It is used as follows:
−
        ;"
+
;"
−
        ;" set $ZSTEP="do STEPTRAP^TMGTRSTP($ZPOS) zstep into zcontinue"
+
;" set $ZSTEP="do STEPTRAP^TMGTRSTP($ZPOS) zstep into zcontinue"
−
        ;" zstep into
+
;" zstep into
−
        ;" do ^MyFunction  ;"<--- put the function you want to trace here
+
;" do ^MyFunction  ;"<--- put the function you want to trace here
−
        ;"
+
;"
−
        ;" set $ZSTEP=""  ;"<---turn off step capture
+
;" set $ZSTEP=""  ;"<---turn off step capture
−
        ;" quit
+
;" quit
−
        ;"
+
;"
−
        ;"
+
;"
−
        ;" Dependencies:
+
;" Dependencies:
−
        ;"  Uses TMGTERM
+
;"  Uses TMGTERM
−
        ;"
+
;"
−
        ;"Notes:
+
;"Notes:
−
        ;"  This function will be called inbetween lines of the main  
+
;"  This function will be called inbetween lines of the main  
−
        ;"  program that is being traced.  Thus is function can't do
+
;"  program that is being traced.  Thus is function can't do
−
        ;"  anything that might change the environment of the main
+
;"  anything that might change the environment of the main
−
        ;"  program. This includes accessing global variables --
+
;"  program.  
−
        ;" because it will mess up the "naked reference".
+
  ;"------------------------------------------------------------
−
        ;"------------------------------------------------------------
+
;"------------------------------------------------------------
−
        ;"------------------------------------------------------------
 
 
          
 
          
−
    STEPTRAP(Pos)
+
STEPTRAP(idePos,Msg)
−
                ;"Purpose: This is the line that is called by GT.M for each zstep event.
+
;"Purpose: This is the line that is called by GT.M for each zstep event.
−
                ;" It will be used to display the current code execution point, and  
+
;" It will be used to display the current code execution point, and  
−
                ;" query user as to plans for future execution: run/step/ etc.
+
;" query user as to plans for future execution: run/step/ etc.
 +
      ;"Input: idePos -- a text line containing position, as returned bye $ZPOS
 +
      ;"     Msg -- OPTIONAL -- can be used by programs to pass in info.
 +
      ;" If Msg=1, then this function was called without the
 +
      ;" $ZSTEP value set, so this function should set it.
 +
 +
        new NakedRef set NakedRef=$$LGR^%ZOSV ;"save naked reference
 +
             
 +
      new tpBlankLine
 +
      new tp[[Action~|Action]]
 +
      new tpKeyIn
 +
      new tpRunMode,tpStepMode
 +
      new tpI
 +
      new tpDone
 +
      new result set result=1  ;1=step into, 2=step over
 +
      new ViewOffset set ViewOffset=0
 +
     
 +
      ;"Run modes: 0=running mode 
 +
      ;"          1=stepping mode
 +
      ;"          2=Don't show code
 +
      ;"     3=running SLOW mode
 +
      ;"          -1=quit
 +
     
 +
      set tpRunMode=$get(TMGRunMode,1)
 +
      set tpStepMode=$get(TMGStepMode,"into")
 +
     
 +
      new ScrHeight,ScrWidth
 +
      set ScrHeight=$get(TMGScrHeight,10)
 +
      set ScrWidth=$get(TMGScrWidth,80)
 +
     
 +
      set tpBlankLine=" "
 +
      for tpI=1:1:ScrWidth-1 set tpBlankLine=tpBlankLine_" "
 +
     
 +
      new ArrayName set ArrayName="^TMP(""TMGIDE"",$J,""MODULES"")"
 +
      set idePos=$$ConvertPos(idePos,ArrayName)
 +
     
 +
      do VCUSAV2^TMGTERM
 +
      if tpRunMode'=2 do
 +
      . do ShowCodePos(idePos,ScrWidth,ScrHeight)
 +
      else  do
 +
      . do CUP^TMGTERM(1,2)
 +
      write tpBlankLine,!
 +
      write tpBlankLine,!
 +
      do CUU^TMGTERM(2)
 +
 +
      if (tpRunMode=0)!(tpRunMode=3)!(tpRunMode=2) do
 +
      . write tpBlankLine,!
 +
      . do CUU^TMGTERM(1)
 +
      . write "(Press any key to pause)",!
 +
      . read *tpKeyIn:0
 +
      . if (tpKeyIn>0) set tpRunMode=1
 +
      . else  if tpRunMode=3 hang 1
 +
     
 +
      if tpRunMode=2 goto SPDone ;"Don't showmode --> goto SPDone
 +
     
 +
      set tpDone=0
 +
      if tpRunMode=1 for  do  quit:tpDone=1
 +
      . new Def[[Action~|Action]] set Def[[Action~|Action]]="O"
 +
      . do ShowCodePos(idePos,ScrWidth,ScrHeight,,ViewOffset)
 +
      . do CUP^TMGTERM(1,ScrHeight+4) ;"Cursor to line (x,y)
 +
      . write tpBlankLine,!
 +
      . do CUU^TMGTERM(2)
 +
      . if tpWatchLine'="" do     
 +
      . . new $etrap set $etrap="write ""(Invalid M Code!.  Error Trapped.)"" set $etrap="""",$ecode="""""
 +
      . . xecute tpWatchLine
 +
      . . write !
 +
      . write tpBlankLine,!
 +
      . do VTATRIB^TMGTERM(7)  ;"reverse text
 +
      . for i=1:1:ScrWidth write "~"
 +
      . do VTATRIB^TMGTERM(0)  ;"reset text
 +
      . write !
 +
      . do CUU^TMGTERM(2)
 +
      . write "[[Action~|Action]] (? for help): "
 +
      . if tpStepMode="into" write "step INTO// " set Def[[Action~|Action]]="I"
 +
      . else  write "step OVER// " set Def[[Action~|Action]]="O"
 +
      . new loop
 +
      . for loop=1:1:20 write " "
 +
      . for loop=1:1:20 write $char(8) ;"backspace
 +
      . set tp[[Action~|Action]]=$$READ^XGF(1) write !
 +
      . ;"read tp[[Action~|Action]],!
 +
      . if tp[[Actio~|Action]]n="" set tpAction=DefAction
 +
      . if "rR"[tpAction do  quit
 +
      . . set tpRunMode=0
 +
      . . set tpDone=1
 +
      . if "lL"[tp[[Action~|Action]] do  quit
 +
      . . set tpRunMode=3
 +
      . . set tpDone=1
 +
      . if "mM"[tp[[Action~|Action]] do  quit
 +
      . . new temp
 +
      . . do CUU^TMGTERM(1)
 +
      . . do CHA^TMGTERM(1) ;"move to x=1 on this line
 +
      . . write tpBlankLine,!
 +
      . . do CUU^TMGTERM(1)
 +
      . . read " enter M code (^ to cancel): ",tpLine,!
 +
      . . if (tpLine'="^") do
 +
      . . . new $etrap set $etrap="write ""(Invalid M Code!.  Error Trapped.)"",! set $etrap="""",$ecode="""""
 +
      . . . write !  ;"get below bottom line for output.
 +
      . . . xecute tpLine
 +
      . if "iI"[tp[[Action~|Action]] do  quit
 +
      . . set tpStepMode="into"
 +
      . . ;"set $ZSTEP="do STEPTRAP^TMGTPSTP($ZPOS) zstep into zcontinue"
 +
      . . set tpDone=1
 +
      . if "Oo"[tp[[Action~|Action]] do  quit
 +
      . . set tpStepMode="over"
 +
      . . ;"set $ZSTEP="do STEPTRAP^TMGTPSTP($ZPOS) zstep over zcontinue"
 +
      . . set tpDone=1
 +
      . if "Bb"[tp[[Action~|Action]] do  quit
 +
      . . new idePos
 +
      . . read "Enter breakpoint (e.g. Label+8^MyFunct): ",idePos,!
 +
      . . set idePos=Pos_":""n tmg s tmg=$$STEPTRAP^TMGTPSTP($ZPOS,1)"""
 +
      . . ZBREAK @idePos
 +
      . if "Hh"[tp[[Action~|Action]] do  quit
 +
      . . set tpRunMode=2
 +
      . . set tpDone=1
 +
      . if "Ww"[tp[[Action~|Action]] do  quit
 +
      . . new temp
 +
      . . do CUU^TMGTERM(1)
 +
      . . do CHA^TMGTERM(1) ;"move to x=1 on this line
 +
      . . write tpBlankLine,!
 +
      . . do CUU^TMGTERM(1)
 +
      . . read "Enter M code (^ to cancel): ",temp,!
 +
      . . if temp'="^" set tpWatchLine=temp
 +
      . if "Aa"[tp[[Action~|Action]] do  quit
 +
      . . set ViewOffset=ViewOffset-1
 +
      . if "Zz"[tp[[Action~|Action]] do  quit
 +
      . . set ViewOffset=ViewOffset+1
 +
      . else  do  quit
 +
      . . write !
 +
      . . new tpNLines
 +
      . . for tpNLines=1:1:5 write tpBlankLine,!
 +
      . . do CUU^TMGTERM(5)
 +
      . . write " L  -- run in sLow mode    M  -- enter any line of M code",!
 +
      . . write " O  -- step OVER line      I  -- step INTO line",!
 +
      . . write " R  -- run                  H  -- Hide debug code",!
 +
      . . write " B  -- set Breakpoint      W - enter variable watch code ",!
 +
      . . write " A -- scroll upward        Z -- scroll downward",!
 +
     
 +
SPDone
 +
      do VCULOAD2^TMGTERM
 +
      set TMGRunMode=tpRunMode
 +
      if tpStepMode="into" set result=1
 +
      else  set result=2
 +
      set TMGStepMode=tpStepMode
 +
     
 +
      if $get(Msg)=1 do
 +
      . set $ZSTEP="N TMGTrap S TMGTrap=$$STEPTRAP^TMGTPSTP($ZPOS) zstep:(TMGTrap=1) into zstep:(TMGTrap=2) over zcontinue"
 +
      . zstep:(result=1) into zstep:(result=2) over
 +
     
 +
        new discard set discard=$get(@NakedRef) ;"reset naked reference.
 +
     
 +
      quit result
 +
     
 +
     
 +
BlankLine
 +
        write tpBlankLine
 +
        do CHA^TMGTERM(1) ;"move to x=1 on this line
 +
        quit
 +
     
 +
ErrTrap(idePos)
 +
;"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(idePos,ScrWidth,ScrHeight)
 +
     
 +
ETDone
 +
      do VCULOAD2^TMGTERM
 +
      quit
 +
     
 +
     
 +
     
 
          
 
          
−
        new tpBlankLine
+
ShowCode(idePos,ScrWidth,ScrHeight,Wipe,ViewOffset)
−
        new tpAction
+
      ;"Purpose: This will display code at the top of the screen
−
        new tpKeyIn
+
      ;"Input: idePos -- string like this: X+2^ROUTINE[$DMOD]
−
        new tpRunMode,tpStepMode
+
      ;"      ScrWidth -- width of code display (Num of columns)
−
        new tpI
+
      ;"      ScrHeight -- height of code display (number of rows)
−
         new tpDone
+
      ;"      Wipe -- OPTIONAL.  if 1, then code area is wiped blank
−
         new result set result=1  ;1=step into, 2=step over
+
      ;"      ViewOffset -- OPTIONAL.  If a value is supplied, then
 +
      ;"              the display will be shifted up or down (i.e. to view
 +
      ;"              code other than at the point of execution)
 +
      ;"              Positive numbers will scroll page downward.
 +
 +
      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 BlankLine=" "
 +
      for i=1:1:ScrWidth-1 set BlankLine=BlankLine_" "
 +
     
 +
         do VTATRIB^TMGTERM(7)  ;"reverse text
 +
     
 +
      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 VTATRIB^TMGTERM(0)  ;"reset colors
 +
      . for i=0:1:ScrHeight+1 write BlankLine
 +
     
 +
      set s=$piece(idePos,"$",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)+2
 +
      else  set StartOffset=0
 +
      set StartOffset=StartOffset+$get(ViewOffset)
 +
     
 +
      for i=StartOffset:1:(ScrHeight+StartOffset) do
 +
      . new line,Bl,ref,LoopOffset
 +
      . set ref=Label_"+"_i_"^"_Routine
 +
      . set line=$text(@ref)
 +
      . set line=$$Substitute^TMGSTUTL(line,$Char(9),"        ")
 +
      . if (i=Offset) do
 +
      . . do VTATRIB^TMGTERM(0)  ;"reset colors
 +
      . . 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 VTATRIB^TMGTERM(7) ;"reverse colors
 +
     
 +
      for i=1:1:ScrWidth write "~"
 +
      write !
 +
     
 +
SCDone
 +
        do VTATRIB^TMGTERM(0)  ;"reset colors
 +
     
 +
      quit
 +
 +
 +
ScanMod(Module,pArray)
 +
        ;"Purpose: To scan a module and find all the labels/entry points/Entry points
 +
        ;"Input: Module -- The name of the module, like "XGF" (not "XGF.m" or "^XGF")             
 +
        ;"        pArray -- pointer to (name of) array Will be filled like this
 +
        ;"              pArray(1,"TAG")="Label1"
 +
        ;"              pArray(1,"OFFSET")=1
 +
        ;"              pArray(2,"TAG")="Label2"
 +
        ;"              pArray(2,"OFFSET")=9
 +
        ;"              pArray(3,"TAG")="Label3"  etc.
 +
        ;"              pArray(3,"OFFSET")=15
 +
        ;"              pArray("Label1")=1
 +
        ;"              pArray("Label2")=2
 +
        ;"              pArray("Label3")=3
 +
        ;"Output: Results are put into array
 +
        ;"Result: none
 +
 +
        new i set i=1
 +
        new LabelNum set LabelNum=0
 +
        new line set line=""
 +
        if $get(Module)="" goto SMDone
 
          
 
          
−
         ;"Run modes: 0=running mode 
+
         for  do  quit:(line="")
−
         ;"           1=stepping mode
+
        . new ch
−
         ;"           2=Don't show code
+
        . set line=$text(+i^@Module)
−
         ;"     3=running SLOW mode
+
        . if line="" quit
−
         ;"          -1=quit
+
        . set line=$$Substitute^TMGSTUTL(line,$Char(9),"  ") ;"replace tabs for spaces
 +
        . set ch=$extract(line,1)
 +
         . if (ch'=" ")&(ch'=";") do
 +
        . . new label
 +
        . . set label=$piece(line," ",1)
 +
        . . set LabelNum=LabelNum+1
 +
         . . set @pArray@(LabelNum,"TAG")=label
 +
         . . set @pArray@(LabelNum,"OFFSET")=i
 +
        . . set @pArray@(label)=LabelNum
 +
         . set i=i+1
 
          
 
          
−
        set tpRunMode=$get(TMGRunMode,1)
+
SMDone       
−
         set tpStepMode=$get(TMGStepMode,"into")
+
         quit
 
          
 
          
−
        new ScrHeight,ScrWidth
 
−
        set ScrHeight=$get(TMGScrHeight,10)
 
−
        set ScrWidth=$get(TMGScrWidth,80)
 
 
          
 
          
−
         set tpBlankLine=" "
+
ConvertPos(Pos,pArray)
−
         for tpI=1:1:ScrWidth-1 set tpBlankLine=tpBlankLine_" "
+
         ;"Purpose: to convert a text positioning line from one that is relative to the last tag/label, into
−
          
+
         ;"             one that is relative to the start of the file
−
        do VCUSAV2^TMGTERM
+
         ;"              e.g. START+8^MYFUNCT --> +32^MYFUNCT       
−
         if tpRunMode'=2 do
+
         ;"Input: Pos -- a position, as returned from $ZPOS
−
         . do ShowCodePos(Pos,ScrWidth,ScrHeight)
+
         ;"        pArray -- pointer to (name of).  Array holding  holding tag offsets
−
         else  do
+
         ;"              pArray will be in this format:
−
         . do CUP^TMGTERM(1,2)
+
         ;"              pArray("ModuleA",1,"TAG")="ALabel1"
−
         write tpBlankLine,!
+
         ;"              pArray("ModuleA",1,"OFFSET")=1
−
        write tpBlankLine,!
+
         ;"              pArray("ModuleA",2,"TAG")="ALabel2"
−
         do CUU^TMGTERM(2)
+
         ;"              pArray("ModuleA",2,"OFFSET")=9
−
          
+
         ;"              pArray("ModuleA","Label1")=1
−
        if (tpRunMode=0)!(tpRunMode=3)!(tpRunMode=2) do
+
         ;"              pArray("ModuleA","Label2")=2
−
         . write tpBlankLine,!
+
         ;"             pArray("ModuleA","Label3")=3
−
         . do CUU^TMGTERM(1)
+
         ;"             pArray("ModuleB",1,"TAG")="BLabel1"
−
         . write "(Press any key to pause)",!
+
         ;"              pArray("ModuleB",1,"OFFSET")=4
−
        . read *tpKeyIn:0
+
         ;"              pArray("ModuleB",2,"TAG")="BLabel2"
−
        . if (tpKeyIn>0) set tpRunMode=1
+
         ;"              pArray("ModuleB",2,"OFFSET")=23
−
        . else  if tpRunMode=3 hang 1
+
         ;"             pArray("ModuleB","Label1")=1
−
          
+
         ;"             pArray("ModuleB","Label2")=2
−
        if tpRunMode=2 goto SPDone ;"Don't showmode --> goto SPDone
+
         ;"              pArray("ModuleB","Label3")=3
−
       
+
         ;"            NOTE: -- if array passed is empty, then this function will call ScanModule to fill it
−
        set tpDone=0
+
         ;"Result: returns the new position line, relative to the start of the file/module
−
         if tpRunMode=1 for  do  quit:tpDone=1
+
         ;"
−
         . new DefAction set DefAction="O"
+
   
−
         . do ShowCodePos(Pos,ScrWidth,ScrHeight)
+
         new s       
−
         . do CUP^TMGTERM(1,ScrHeight+4) ;"Cursor to line (x,y)  
+
         new result set result=""
−
        . write tpBlankLine,!
+
         new Routine,Label,Offset
−
        . do CUU^TMGTERM(1)
+
                       
−
         . write "Action (? for help): "
+
      set s=$piece(Pos,"$",1) ;"e.g. X+2^ROUTINE$DMOD-->X+2^ROUTINE
−
        . if tpStepMode="into" write "step INTO// " set DefAction="I"
+
      if s="" goto CPDone
−
         . else  write "step OVER// " set DefAction="O"
+
     
−
         . read tpAction,!
+
      set Routine=$piece(s,"^",2)
−
         . if tpAction="" set tpAction=DefAction
+
      if Routine="" goto CPDone
−
         . if "rR"[tpAction do quit
+
     
−
         . . set tpRunMode=0
+
      set s=$piece(s,"^",1)
−
         . . set tpDone=1
+
      set Offset=$piece(s,"+",2)
−
        . if "lL"[tpAction do  quit
+
      if Offset="" set Offset=1
−
         . . set tpRunMode=3
+
      else set Offset=+Offset
−
        . . set tpDone=1
+
      set Label=$piece(s,"+",1)
−
        . if "mM"[tpAction do  quit
+
     
−
        . . write tpBlankLine,!
+
      if $data(@pArray@(Routine))=0 do
−
        . . do CUU^TMGTERM(1)
+
      . new p2Array set p2Array=$name(@pArray@(Routine))
−
        . . new tpLine
+
      . do ScanMod(Routine,p2Array)
−
        . . read " enter M code: ",tpLine,!
+
     
−
        . . xecute tpLine
+
      new i set i=+$get(@pArray@(Routine,Label))
−
        . if "iI"[tpAction do  quit
+
      if i=0 goto CPDone
−
        . . set tpStepMode="into"
+
      new GOffset set GOffset=@pArray@(Routine,i,"OFFSET")
−
        . . ;"set $ZSTEP="do STEPTRAP^TMGTPSTP($ZPOS) zstep into zcontinue"
+
      set result="+"_+(GOffset+Offset)_"^"_Routine
−
        . . set tpDone=1
+
     
−
        . if "Oo"[tpAction do  quit
+
  CPDone
−
        . . 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
 
         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
 

Latest revision as of 08:56, 10 July 2012

;"------------------------------------------------------------
;"------------------------------------------------------------
;"
;" GT.M STEP TRAP
;"
;" K. Toppenberg
;" 4-13-2005
;" License: GPL Applies
;" 
;" This code module will allow tracing through code.
;" It is used as follows:
;"
;" set $ZSTEP="do STEPTRAP^TMGTRSTP($ZPOS) zstep into zcontinue"
;" zstep into
;" do ^MyFunction   ;"<--- put the function you want to trace here
;"
;" set $ZSTEP=""  ;"<---turn off step capture
;" quit
;"
;"
;" Dependencies:
;"   Uses 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. 
;"------------------------------------------------------------
;"------------------------------------------------------------
       
STEPTRAP(idePos,Msg)
	;"Purpose: This is the line that is called by GT.M for each zstep event.
	;"	It will be used to display the current code execution point, and 
	;"	query user as to plans for future execution: run/step/ etc.
     ;"Input: idePos -- a text line containing position, as returned bye $ZPOS
     ;"	    Msg -- OPTIONAL -- can be used by programs to pass in info.
     ;"			If Msg=1, then this function was called without the 
     ;"				$ZSTEP value set, so this function should set it.

       new NakedRef set NakedRef=$$LGR^%ZOSV ;"save naked reference
              
      new tpBlankLine
      new tpAction
      new tpKeyIn
      new tpRunMode,tpStepMode
      new tpI
      new tpDone
      new result set result=1  ;1=step into, 2=step over
      new ViewOffset set ViewOffset=0
      
      ;"Run modes: 0=running mode  
      ;"           1=stepping mode 
      ;"           2=Don't show code 
      ;"	    3=running SLOW mode
      ;"          -1=quit
      
      set tpRunMode=$get(TMGRunMode,1)
      set tpStepMode=$get(TMGStepMode,"into")
      
      new ScrHeight,ScrWidth
      set ScrHeight=$get(TMGScrHeight,10)
      set ScrWidth=$get(TMGScrWidth,80)
      
      set tpBlankLine=" "
      for tpI=1:1:ScrWidth-1 set tpBlankLine=tpBlankLine_" "
      
      new ArrayName set ArrayName="^TMP(""TMGIDE"",$J,""MODULES"")"
      set idePos=$$ConvertPos(idePos,ArrayName)
      
      do VCUSAV2^TMGTERM
      if tpRunMode'=2 do
      . do ShowCodePos(idePos,ScrWidth,ScrHeight)
      else  do
      . do CUP^TMGTERM(1,2)
      write tpBlankLine,!
      write tpBlankLine,!
      do CUU^TMGTERM(2)

      if (tpRunMode=0)!(tpRunMode=3)!(tpRunMode=2) do
      . write tpBlankLine,!
      . do CUU^TMGTERM(1)
      . write "(Press any key to pause)",!
      . read *tpKeyIn:0
      . if (tpKeyIn>0) set tpRunMode=1
      . else  if tpRunMode=3 hang 1
      
      if tpRunMode=2 goto SPDone ;"Don't showmode --> goto SPDone
      
      set tpDone=0
      if tpRunMode=1 for  do  quit:tpDone=1
      . new DefAction set DefAction="O"
      . do ShowCodePos(idePos,ScrWidth,ScrHeight,,ViewOffset)
      . do CUP^TMGTERM(1,ScrHeight+4) ;"Cursor to line (x,y) 
      . write tpBlankLine,!
      . do CUU^TMGTERM(2)
      . if tpWatchLine'="" do       
      . . new $etrap set $etrap="write ""(Invalid M Code!.  Error Trapped.)"" set $etrap="""",$ecode="""""
      . . xecute tpWatchLine
      . . write !
      . write tpBlankLine,!
      . do VTATRIB^TMGTERM(7)  ;"reverse text
      . for i=1:1:ScrWidth write "~"
      . do VTATRIB^TMGTERM(0)  ;"reset text
      . write !
      . do CUU^TMGTERM(2)
      . write "Action (? for help): "
      . if tpStepMode="into" write "step INTO// " set DefAction="I"
      . else  write "step OVER// " set DefAction="O"
      . new loop
      . for loop=1:1:20 write " "
      . for loop=1:1:20 write $char(8) ;"backspace
      . set tpAction=$$READ^XGF(1) write !
      . ;"read tpAction,!
      . if tpActionn="" 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
      . . new temp
      . . do CUU^TMGTERM(1)
      . . do CHA^TMGTERM(1) ;"move to x=1 on this line
      . . write tpBlankLine,!
      . . do CUU^TMGTERM(1)
      . . read " enter M code (^ to cancel): ",tpLine,!
      . . if (tpLine'="^") do
      . . . new $etrap set $etrap="write ""(Invalid M Code!.  Error Trapped.)"",! set $etrap="""",$ecode="""""
      . . . write !  ;"get below bottom line for output.
      . . . 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 "Bb"[tpAction do  quit
      . . new idePos
      . . read "Enter breakpoint (e.g. Label+8^MyFunct): ",idePos,!
      . . set idePos=Pos_":""n tmg s tmg=$$STEPTRAP^TMGTPSTP($ZPOS,1)"""
      . . ZBREAK @idePos
      . if "Hh"[tpAction do  quit
      . . set tpRunMode=2
      . . set tpDone=1
      . if "Ww"[tpAction do  quit
      . . new temp
      . . do CUU^TMGTERM(1)
      . . do CHA^TMGTERM(1) ;"move to x=1 on this line
      . . write tpBlankLine,!
      . . do CUU^TMGTERM(1)
      . . read "Enter M code (^ to cancel): ",temp,!
      . . if temp'="^" set tpWatchLine=temp
      . if "Aa"[tpAction do  quit
      . . set ViewOffset=ViewOffset-1
      . if "Zz"[tpAction do  quit
      . . set ViewOffset=ViewOffset+1
      . else  do  quit
      . . write !
      . . new tpNLines
      . . for tpNLines=1:1:5 write tpBlankLine,!
      . . do CUU^TMGTERM(5)
      . . write " L  -- run in sLow mode     M  -- enter any line of M code",!
      . . write " O  -- step OVER line       I  -- step INTO line",!
      . . write " R  -- run                  H  -- Hide debug code",!
      . . write " B  -- set Breakpoint       W - enter variable watch code ",!
      . . write " A -- scroll upward         Z -- scroll downward",!
      
SPDone
      do VCULOAD2^TMGTERM
      set TMGRunMode=tpRunMode
      if tpStepMode="into" set result=1
      else  set result=2
      set TMGStepMode=tpStepMode
      
      if $get(Msg)=1 do
      . set $ZSTEP="N TMGTrap S TMGTrap=$$STEPTRAP^TMGTPSTP($ZPOS) zstep:(TMGTrap=1) into zstep:(TMGTrap=2) over zcontinue"
      . zstep:(result=1) into zstep:(result=2) over
      
       new discard set discard=$get(@NakedRef) ;"reset naked reference.
      
      quit result
      
      
BlankLine
       write tpBlankLine
       do CHA^TMGTERM(1) ;"move to x=1 on this line
       quit
      
ErrTrap(idePos)
	;"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(idePos,ScrWidth,ScrHeight)
     
ETDone
      do VCULOAD2^TMGTERM
      quit 
      
      
      
       
ShowCode(idePos,ScrWidth,ScrHeight,Wipe,ViewOffset)
      ;"Purpose: This will display code at the top of the screen
      ;"Input: idePos -- string like this: X+2^ROUTINE[$DMOD]
      ;"      ScrWidth -- width of code display (Num of columns)
      ;"      ScrHeight -- height of code display (number of rows) 
      ;"      Wipe -- OPTIONAL.  if 1, then code area is wiped blank
      ;"      ViewOffset -- OPTIONAL.  If a value is supplied, then
      ;"               the display will be shifted up or down (i.e. to view
      ;"               code other than at the point of execution)
      ;"               Positive numbers will scroll page downward.

      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 BlankLine=" "
      for i=1:1:ScrWidth-1 set BlankLine=BlankLine_" "
      
       do VTATRIB^TMGTERM(7)  ;"reverse text
      
      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 VTATRIB^TMGTERM(0)  ;"reset colors
      . for i=0:1:ScrHeight+1 write BlankLine
      
      set s=$piece(idePos,"$",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)+2
      else  set StartOffset=0
      set StartOffset=StartOffset+$get(ViewOffset)
      
      for i=StartOffset:1:(ScrHeight+StartOffset) do
      . new line,Bl,ref,LoopOffset
      . set ref=Label_"+"_i_"^"_Routine
      . set line=$text(@ref)
      . set line=$$Substitute^TMGSTUTL(line,$Char(9),"        ")
      . if (i=Offset) do 
      . . do VTATRIB^TMGTERM(0)  ;"reset colors
      . . 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 VTATRIB^TMGTERM(7)  ;"reverse colors
      
      for i=1:1:ScrWidth write "~"
      write !
      
SCDone
       do VTATRIB^TMGTERM(0)  ;"reset colors
      
      quit


ScanMod(Module,pArray)
       ;"Purpose: To scan a module and find all the labels/entry points/Entry points
       ;"Input: Module -- The name of the module, like "XGF" (not "XGF.m" or "^XGF")               
       ;"         pArray -- pointer to (name of) array Will be filled like this
       ;"              pArray(1,"TAG")="Label1"
       ;"              pArray(1,"OFFSET")=1
       ;"              pArray(2,"TAG")="Label2"
       ;"              pArray(2,"OFFSET")=9
       ;"              pArray(3,"TAG")="Label3"  etc.
       ;"              pArray(3,"OFFSET")=15
       ;"              pArray("Label1")=1
       ;"              pArray("Label2")=2
       ;"              pArray("Label3")=3
       ;"Output: Results are put into array
       ;"Result: none

       new i set i=1
       new LabelNum set LabelNum=0
       new line set line=""
       if $get(Module)="" goto SMDone
       
       for  do  quit:(line="")
       . new ch
       . set line=$text(+i^@Module)
       . if line="" quit
       . set line=$$Substitute^TMGSTUTL(line,$Char(9),"  ") ;"replace tabs for spaces
       . set ch=$extract(line,1)
       . if (ch'=" ")&(ch'=";") do
       . . new label
       . . set label=$piece(line," ",1)
       . . set LabelNum=LabelNum+1
       . . set @pArray@(LabelNum,"TAG")=label
       . . set @pArray@(LabelNum,"OFFSET")=i
       . . set @pArray@(label)=LabelNum
       . set i=i+1
       
SMDone        
       quit
       
       
ConvertPos(Pos,pArray)
       ;"Purpose: to convert a text positioning line from one that is relative to the last tag/label, into
       ;"              one that is relative to the start of the file
       ;"              e.g. START+8^MYFUNCT --> +32^MYFUNCT        
       ;"Input: Pos -- a position, as returned from $ZPOS
       ;"        pArray -- pointer to (name of).  Array holding  holding tag offsets
       ;"              pArray will be in this format:
       ;"              pArray("ModuleA",1,"TAG")="ALabel1"
       ;"              pArray("ModuleA",1,"OFFSET")=1
       ;"              pArray("ModuleA",2,"TAG")="ALabel2"
       ;"              pArray("ModuleA",2,"OFFSET")=9
       ;"              pArray("ModuleA","Label1")=1
       ;"              pArray("ModuleA","Label2")=2
       ;"              pArray("ModuleA","Label3")=3
       ;"              pArray("ModuleB",1,"TAG")="BLabel1"
       ;"              pArray("ModuleB",1,"OFFSET")=4
       ;"              pArray("ModuleB",2,"TAG")="BLabel2"
       ;"              pArray("ModuleB",2,"OFFSET")=23
       ;"              pArray("ModuleB","Label1")=1
       ;"              pArray("ModuleB","Label2")=2
       ;"              pArray("ModuleB","Label3")=3
       ;"            NOTE: -- if array passed is empty, then this function will call ScanModule to fill it
       ;"Result: returns the new position line, relative to the start of the file/module
       ;"

       new s        
       new result set result=""
       new Routine,Label,Offset
                       
      set s=$piece(Pos,"$",1)  ;"e.g. X+2^ROUTINE$DMOD-->X+2^ROUTINE
      if s="" goto CPDone
      
      set Routine=$piece(s,"^",2)
      if Routine="" goto CPDone
      
      set s=$piece(s,"^",1)
      set Offset=$piece(s,"+",2)
      if Offset="" set Offset=1
      else  set Offset=+Offset
      set Label=$piece(s,"+",1)
      
      if $data(@pArray@(Routine))=0 do
      . new p2Array set p2Array=$name(@pArray@(Routine))
      . do ScanMod(Routine,p2Array)
      
      new i set i=+$get(@pArray@(Routine,Label))
      if i=0 goto CPDone
      new GOffset set GOffset=@pArray@(Routine,i,"OFFSET")
      set result="+"_+(GOffset+Offset)_"^"_Routine
      
CPDone
       quit result
Retrieved from "https://vistapedia.com/index.php?title=TMGTPSTP.m&oldid=14794"