TMGTPSTP.m

;" ;" ;" 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